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)

src/MNH/modd_sensor.f90

@@ -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
 

src/MNH/write_aircraft_balloon.f90

@@ -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

src/MNH/write_balloonn.f90

@@ -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