Skip to content
Snippets Groups Projects
Commit e85637ff authored by WAUTELET Philippe's avatar WAUTELET Philippe
Browse files

Philippe 22/09/2023: sensors: send/recv: allow possibility to not exchange the...

Philippe 22/09/2023: sensors: send/recv: allow possibility to not exchange the sensor data (reduce communications)
parent fa27bdc0
No related branches found
No related tags found
No related merge requests found
......@@ -21,6 +21,8 @@ MODULE MODD_SENSOR
INTEGER, PARAMETER :: NTAG_NCUR = 145
INTEGER, PARAMETER :: NTAG_PACK = 245
INTEGER, PARAMETER :: NEMPTYDATA = -1 ! Size to communicate if exchange of no sensor data
TYPE :: TSENSORTIME
INTEGER :: N_CUR = 0 ! current step of storage
REAL :: XTSTEP = 60. ! storage time step (default reset later)
......@@ -71,6 +73,7 @@ MODULE MODD_SENSOR
INTEGER :: NV01 = NNEGUNDEF ! Z position for ni_m , nj_v+1
INTEGER :: NV10 = NNEGUNDEF ! Z position for ni_m+1, nj_v
INTEGER :: NV11 = NNEGUNDEF ! Z position for ni_m+1, nj_v+1
! Coefficient to interpolate values (sensors are usually not exactly on mesh points)
REAL :: XXMCOEF = XUNDEF ! Interpolation coefficient for X (mass-point)
REAL :: XYMCOEF = XUNDEF ! Interpolation coefficient for Y (mass-point)
......@@ -1251,9 +1254,9 @@ MODULE MODD_SENSOR
END SUBROUTINE BUFFER_RECV
! ##################################################################
SUBROUTINE SENSOR_COMM_SEND( TPSENSOR, KTO, OSEND_SIZE_TO_RECEIVER )
! ##################################################################
! ##############################################################################
SUBROUTINE SENSOR_COMM_SEND( TPSENSOR, KTO, OSEND_SIZE_TO_RECEIVER, OEMPTYSEND )
! ##############################################################################
USE MODD_IO, ONLY: ISP
......@@ -1262,10 +1265,12 @@ MODULE MODD_SENSOR
CLASS(TSENSOR), INTENT(INOUT) :: TPSENSOR
INTEGER, INTENT(IN) :: KTO ! Process to which to send data
LOGICAL, OPTIONAL, INTENT(IN) :: OSEND_SIZE_TO_RECEIVER ! If the buffer size has to be send to the receiver
LOGICAL, OPTIONAL, INTENT(IN) :: OEMPTYSEND ! True if the sensor data has not to be sent
CHARACTER(LEN=10) :: YFROM, YTO
INTEGER :: IPACKSIZE
INTEGER :: IPOS
LOGICAL :: GEMPTYSEND
LOGICAL :: GSEND_SIZE_TO_RECEIVER
REAL, DIMENSION(:), ALLOCATABLE :: ZPACK ! buffer to store raw data of the sensor
......@@ -1274,27 +1279,45 @@ MODULE MODD_SENSOR
CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'Sensor_comm_send', &
'send sensor ' // TRIM(TPSENSOR%CNAME) // ': ' // TRIM(YFROM) // '->' // TRIM(YTO), OLOCAL = .TRUE. )
IF ( PRESENT( OEMPTYSEND ) ) THEN
GEMPTYSEND = OEMPTYSEND
ELSE
GEMPTYSEND = .FALSE.
END IF
IF ( PRESENT( OSEND_SIZE_TO_RECEIVER ) ) THEN
GSEND_SIZE_TO_RECEIVER = OSEND_SIZE_TO_RECEIVER
ELSE
GSEND_SIZE_TO_RECEIVER = .FALSE.
END IF
IPACKSIZE = TPSENSOR%BUFFER_SIZE_COMPUTE( TPSENSOR%NSTORE_CUR )
IF ( GEMPTYSEND .AND. .NOT.GSEND_SIZE_TO_RECEIVER ) &
CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Sensor_comm_send', &
'incompatible options: gemptysend=T and gsend_size_to_receiver=F', OLOCAL = .TRUE. )
IF ( GEMPTYSEND ) THEN
! If 'empty send', ipacksize is set to NEMPTYDATA
! This will allow the receiver to know that no sensor data will be sent
IPACKSIZE = NEMPTYDATA
ELSE
IPACKSIZE = TPSENSOR%BUFFER_SIZE_COMPUTE( TPSENSOR%NSTORE_CUR )
END IF
IF ( GSEND_SIZE_TO_RECEIVER ) CALL TPSENSOR%BUFFER_SIZE_SEND( TPSENSOR%NSTORE_CUR, IPACKSIZE, KTO )
ALLOCATE( ZPACK(IPACKSIZE) )
IF ( .NOT. GEMPTYSEND ) THEN
ALLOCATE( ZPACK(IPACKSIZE) )
IPOS = 1
CALL TPSENSOR%BUFFER_PACK( ZPACK, IPOS, TPSENSOR%NSTORE_CUR )
IPOS = 1
CALL TPSENSOR%BUFFER_PACK( ZPACK, IPOS, TPSENSOR%NSTORE_CUR )
IF ( IPOS-1 /= IPACKSIZE ) &
CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Sensor_comm_send', 'IPOS-1 /= IPACKSIZE', OLOCAL = .TRUE. )
IF ( IPOS-1 /= IPACKSIZE ) &
CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Sensor_comm_send', 'IPOS-1 /= IPACKSIZE', OLOCAL = .TRUE. )
CALL TPSENSOR%BUFFER_SEND( ZPACK, KTO )
CALL TPSENSOR%BUFFER_SEND( ZPACK, KTO )
DEALLOCATE( ZPACK )
DEALLOCATE( ZPACK )
END IF
END SUBROUTINE SENSOR_COMM_SEND
......@@ -1313,26 +1336,28 @@ MODULE MODD_SENSOR
END SUBROUTINE SENSOR_COMM_SEND_DEALLOCATE
! ####################################################################################################
SUBROUTINE SENSOR_COMM_RECV_ALLOCATE( TPSENSOR, KFROM, KSTORE_CUR, KSTORE_MAX, ORECV_SIZE_FROM_OWNER )
! ####################################################################################################
! ################################################################################################################
SUBROUTINE SENSOR_COMM_RECV_ALLOCATE( TPSENSOR, KFROM, KSTORE_CUR, KSTORE_MAX, ORECV_SIZE_FROM_OWNER, OEMPTYRECV )
! ################################################################################################################
USE MODD_IO, ONLY: ISP
USE MODE_MSG
CLASS(TSENSOR), INTENT(INOUT) :: TPSENSOR
INTEGER, INTENT(IN) :: KFROM ! Process from which to receive data
INTEGER, INTENT(IN) :: KFROM ! Process from which to receive data
INTEGER, OPTIONAL, INTENT(IN) :: KSTORE_CUR ! Number of storage steps to receive
INTEGER, OPTIONAL, INTENT(IN) :: KSTORE_MAX ! Maximum number of storage steps to store in sensor
! (if not provided, kstore_* size must be given by the sender)
LOGICAL, OPTIONAL, INTENT(IN) :: ORECV_SIZE_FROM_OWNER ! If the buffer size has to be send to the receiver
LOGICAL, OPTIONAL, INTENT(OUT) :: OEMPTYRECV ! True if the sensor data has not been received
CHARACTER(LEN=10) :: YFROM, YTO
INTEGER :: IPACKSIZE
INTEGER :: IPOS
INTEGER :: ISTORE_CUR
INTEGER :: ISTORE_MAX
LOGICAL :: GEMPTYRECV
LOGICAL :: GRECV_SIZE_FROM_OWNER
REAL, DIMENSION(:), ALLOCATABLE :: ZPACK ! buffer to store raw data of the sensor
......@@ -1341,6 +1366,8 @@ MODULE MODD_SENSOR
CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'Sensor_comm_recv_allocate', &
'receive sensor (name not yet known): ' // TRIM(YFROM) // '->' // TRIM(YTO), OLOCAL = .TRUE. )
GEMPTYRECV = .FALSE.
IF ( PRESENT( ORECV_SIZE_FROM_OWNER ) ) THEN
GRECV_SIZE_FROM_OWNER = ORECV_SIZE_FROM_OWNER
ELSE
......@@ -1380,19 +1407,29 @@ MODULE MODD_SENSOR
IPACKSIZE = TPSENSOR%BUFFER_SIZE_COMPUTE( ISTORE_CUR )
END IF
! Allocate receive buffer
ALLOCATE( ZPACK(IPACKSIZE) )
IF ( IPACKSIZE == NEMPTYDATA ) THEN
GEMPTYRECV = .TRUE.
!call Print_msg( NVERB_DEBUG, 'GEN', 'Sensor_comm_recv_allocate', 'empty receive', olocal = .true. )
IF ( .NOT. PRESENT( OEMPTYRECV) ) &
CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Sensor_comm_recv_allocate', &
'optional dummy argument oemptyrecv must be provided in case of empty communication', OLOCAL = .TRUE. )
ELSE
! Allocate receive buffer
ALLOCATE( ZPACK(IPACKSIZE) )
! Allocation of sensor must be done only once the total number of stores is known (and only if not yet allocated)
IF (TPSENSOR%NSTORE_MAX < 0 ) CALL TPSENSOR%DATA_ARRAYS_ALLOCATE( ISTORE_MAX )
! Allocation of sensor must be done only once the total number of stores is known (and only if not yet allocated)
IF (TPSENSOR%NSTORE_MAX < 0 ) CALL TPSENSOR%DATA_ARRAYS_ALLOCATE( ISTORE_MAX )
CALL TPSENSOR%BUFFER_RECV( ZPACK, KFROM )
CALL TPSENSOR%BUFFER_RECV( ZPACK, KFROM )
IPOS = 1
CALL TPSENSOR%BUFFER_UNPACK( ZPACK, IPOS, ISTORE_CUR )
IPOS = 1
CALL TPSENSOR%BUFFER_UNPACK( ZPACK, IPOS, ISTORE_CUR )
IF ( IPOS-1 /= IPACKSIZE ) &
CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Sensor_comm_recv_allocate', 'IPOS-1 /= IPACKSIZE', OLOCAL = .TRUE. )
END IF
IF ( IPOS-1 /= IPACKSIZE ) &
CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Sensor_comm_recv_allocate', 'IPOS-1 /= IPACKSIZE', OLOCAL = .TRUE. )
IF ( PRESENT( OEMPTYRECV) ) OEMPTYRECV = GEMPTYRECV
END SUBROUTINE SENSOR_COMM_RECV_ALLOCATE
......
......@@ -78,7 +78,9 @@ SUBROUTINE WRITE_AIRCRAFT_BALLOON(TPDIAFILE)
!
USE MODD_AIRCRAFT_BALLOON
USE MODD_IO, ONLY: ISP, TFILEDATA
!
USE MODE_MODELN_HANDLER, ONLY: GET_CURRENT_MODEL_INDEX
IMPLICIT NONE
!
!
......@@ -90,16 +92,21 @@ TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
!
! 0.2 declaration of local variables
!
INTEGER :: IMI
INTEGER :: JI
LOGICAL :: GEMPTYCOMM ! if TRUE, the communication is empty (no data is exchanged)
!
!----------------------------------------------------------------------------
IMI = GET_CURRENT_MODEL_INDEX()
DO JI = 1, NBALLOONS
! The balloon data is only available on the process where it is physically located => transfer it if necessary
! Send data from owner to writer if necessary
IF ( ISP == NRANKCUR_BALLOON(JI) .AND. NRANKCUR_BALLOON(JI) /= TPDIAFILE%NMASTER_RANK ) THEN
CALL TBALLOONS(JI)%TBALLOON%SEND( KTO = TPDIAFILE%NMASTER_RANK, OSEND_SIZE_TO_RECEIVER = .TRUE. )
GEMPTYCOMM = ( TBALLOONS(JI)%TBALLOON%NMODEL /= IMI )
CALL TBALLOONS(JI)%TBALLOON%SEND( KTO = TPDIAFILE%NMASTER_RANK, OSEND_SIZE_TO_RECEIVER = .TRUE., OEMPTYSEND = GEMPTYCOMM )
END IF
IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
......@@ -108,11 +115,12 @@ DO JI = 1, NBALLOONS
IF ( ASSOCIATED( TBALLOONS(JI)%TBALLOON ) ) &
call Print_msg( NVERB_FATAL, 'GEN', 'WRITE_AIRCRAFT_BALLOON', 'balloon already associated' )
ALLOCATE( TBALLOONS(JI)%TBALLOON )
CALL TBALLOONS(JI)%TBALLOON%RECV_ALLOCATE( KFROM = NRANKCUR_BALLOON(JI), ORECV_SIZE_FROM_OWNER = .TRUE. )
CALL TBALLOONS(JI)%TBALLOON%RECV_ALLOCATE( KFROM = NRANKCUR_BALLOON(JI), ORECV_SIZE_FROM_OWNER = .TRUE., &
OEMPTYRECV = GEMPTYCOMM )
END IF
! Write data
CALL FLYER_DIACHRO( TPDIAFILE, TBALLOONS(JI)%TBALLOON )
! Write data (if balloon is on this model (GEMPTYCOMM=F))
IF ( .NOT. GEMPTYCOMM ) CALL FLYER_DIACHRO( TPDIAFILE, TBALLOONS(JI)%TBALLOON )
! Remark: release of memory is done later by a call to AIRCRAFT_BALLOON_FREE_NONLOCAL
! This call must be done after the file is closed because flyer data is needed on the
......@@ -125,7 +133,8 @@ DO JI = 1, NAIRCRAFTS
! Send data from owner to writer if necessary
IF ( ISP == NRANKCUR_AIRCRAFT(JI) .AND. NRANKCUR_AIRCRAFT(JI) /= TPDIAFILE%NMASTER_RANK ) THEN
CALL TAIRCRAFTS(JI)%TAIRCRAFT%SEND( KTO = TPDIAFILE%NMASTER_RANK, OSEND_SIZE_TO_RECEIVER = .TRUE. )
GEMPTYCOMM = ( TAIRCRAFTS(JI)%TAIRCRAFT%NMODEL /= IMI )
CALL TAIRCRAFTS(JI)%TAIRCRAFT%SEND( KTO = TPDIAFILE%NMASTER_RANK, OSEND_SIZE_TO_RECEIVER = .TRUE., OEMPTYSEND = GEMPTYCOMM )
END IF
IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
......@@ -134,11 +143,12 @@ DO JI = 1, NAIRCRAFTS
IF ( ASSOCIATED( TAIRCRAFTS(JI)%TAIRCRAFT ) ) &
call Print_msg( NVERB_FATAL, 'GEN', 'WRITE_AIRCRAFT_BALLOON', 'aircraft already associated' )
ALLOCATE( TAIRCRAFTS(JI)%TAIRCRAFT )
CALL TAIRCRAFTS(JI)%TAIRCRAFT%RECV_ALLOCATE( KFROM = NRANKCUR_AIRCRAFT(JI), ORECV_SIZE_FROM_OWNER = .TRUE. )
CALL TAIRCRAFTS(JI)%TAIRCRAFT%RECV_ALLOCATE( KFROM = NRANKCUR_AIRCRAFT(JI), ORECV_SIZE_FROM_OWNER = .TRUE., &
OEMPTYRECV = GEMPTYCOMM )
END IF
! Write data
CALL FLYER_DIACHRO( TPDIAFILE, TAIRCRAFTS(JI)%TAIRCRAFT )
! Write data (if aircraft is on this model (GEMPTYCOMM=F))
IF ( .NOT. GEMPTYCOMM ) CALL FLYER_DIACHRO( TPDIAFILE, TAIRCRAFTS(JI)%TAIRCRAFT )
! Remark: release of memory is done later by a call to AIRCRAFT_BALLOON_FREE_NONLOCAL
! This call must be done after the file is closed because flyer data is needed on the
......@@ -168,7 +178,7 @@ IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
DO JI = 1, NBALLOONS
! Free ballon data if it was not stored on this process
IF ( NRANKCUR_BALLOON(JI) /= TPDIAFILE%NMASTER_RANK ) THEN
CALL TBALLOONS(JI)%TBALLOON%DATA_ARRAYS_DEALLOCATE()
IF ( TBALLOONS(JI)%TBALLOON%NSTORE_MAX >= 0 ) CALL TBALLOONS(JI)%TBALLOON%DATA_ARRAYS_DEALLOCATE()
DEALLOCATE( TBALLOONS(JI)%TBALLOON )
END IF
END DO
......@@ -176,7 +186,7 @@ IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
DO JI = 1, NAIRCRAFTS
! Free aircraft data if it was not stored on this process
IF ( NRANKCUR_AIRCRAFT(JI) /= TPDIAFILE%NMASTER_RANK ) THEN
CALL TAIRCRAFTS(JI)%TAIRCRAFT%DATA_ARRAYS_DEALLOCATE()
IF ( TAIRCRAFTS(JI)%TAIRCRAFT%NSTORE_MAX >= 0 ) CALL TAIRCRAFTS(JI)%TAIRCRAFT%DATA_ARRAYS_DEALLOCATE()
DEALLOCATE( TAIRCRAFTS(JI)%TAIRCRAFT )
END IF
END DO
......
......@@ -73,12 +73,13 @@ TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics
!
INTEGER :: IMI
INTEGER :: JI
LOGICAL :: OMONOPROC_SAVE ! Copy of true value of GSMONOPROC
LOGICAL :: GEMPTYCOMM ! if TRUE, the communication is empty (no data is exchanged)
LOGICAL :: GMONOPROC_SAVE ! Copy of true value of GSMONOPROC
IMI = GET_CURRENT_MODEL_INDEX()
! Save GSMONOPROC value
OMONOPROC_SAVE = GSMONOPROC
GMONOPROC_SAVE = GSMONOPROC
! Force GSMONOPROC to true to allow IO_Field_write on only 1 process! (not very clean hack)
GSMONOPROC = .TRUE.
......@@ -87,30 +88,33 @@ DO JI = 1, NBALLOONS
! Send data from owner to writer if necessary
IF ( ISP == NRANKCUR_BALLOON(JI) .AND. NRANKCUR_BALLOON(JI) /= TPFILE%NMASTER_RANK ) THEN
CALL TBALLOONS(JI)%TBALLOON%SEND( KTO = TPFILE%NMASTER_RANK, OSEND_SIZE_TO_RECEIVER = .TRUE. )
GEMPTYCOMM = ( TBALLOONS(JI)%TBALLOON%NMODEL /= IMI )
CALL TBALLOONS(JI)%TBALLOON%SEND( KTO = TPFILE%NMASTER_RANK, OSEND_SIZE_TO_RECEIVER = .TRUE., OEMPTYSEND = GEMPTYCOMM )
END IF
IF ( ISP == TPFILE%NMASTER_RANK ) THEN
! Receive data from owner if not available on the writer process
IF ( NRANKCUR_BALLOON(JI) /= TPFILE%NMASTER_RANK ) THEN
ALLOCATE( TBALLOONS(JI)%TBALLOON )
CALL TBALLOONS(JI)%TBALLOON%RECV_ALLOCATE( KFROM = NRANKCUR_BALLOON(JI), ORECV_SIZE_FROM_OWNER = .TRUE. )
CALL TBALLOONS(JI)%TBALLOON%RECV_ALLOCATE( KFROM = NRANKCUR_BALLOON(JI), ORECV_SIZE_FROM_OWNER = .TRUE., &
OEMPTYRECV = GEMPTYCOMM )
END IF
! Write data (only if flyer is on the current model)
! It will also be written in the ancestry model files
IF ( TBALLOONS(JI)%TBALLOON%NMODEL == IMI ) CALL WRITE_BALLOON_POSITION( TPFILE, TBALLOONS(JI)%TBALLOON )
! if GEMPTYCOMM=FALSE => flyer is on the current model (equivalent to TBALLOONS(JI)%TBALLOON%NMODEL==IMI)
IF ( .NOT. GEMPTYCOMM ) CALL WRITE_BALLOON_POSITION( TPFILE, TBALLOONS(JI)%TBALLOON )
! Free ballon data if it was not stored on this process
IF ( NRANKCUR_BALLOON(JI) /= TPFILE%NMASTER_RANK ) THEN
CALL TBALLOONS(JI)%TBALLOON%DATA_ARRAYS_DEALLOCATE()
IF ( TBALLOONS(JI)%TBALLOON%NSTORE_MAX >= 0 ) CALL TBALLOONS(JI)%TBALLOON%DATA_ARRAYS_DEALLOCATE()
DEALLOCATE( TBALLOONS(JI)%TBALLOON )
END IF
END IF
END DO
! Restore correct value of GSMONOPROC
GSMONOPROC = OMONOPROC_SAVE
GSMONOPROC = GMONOPROC_SAVE
END SUBROUTINE WRITE_BALLOON_n
!-------------------------------------------------------------------------------
......@@ -151,7 +155,7 @@ REAL :: ZLON ! longitude of the balloon
type(tfiledata) :: tzfile
TYPE(TFIELDMETADATA) :: TZFIELD
! Do not write balloon position if not yet in fly or crashed
! Do not write balloon position if not yet in flight or crashed
IF ( .NOT.TPFLYER%LFLY .OR. TPFLYER%LCRASH ) RETURN
! Check if current model time is the same as the time corresponding to the balloon position
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment