diff --git a/src/MNH/modd_sensor.f90 b/src/MNH/modd_sensor.f90
index 4b052d64412a16337aa33783e9c90014ca233fbf..b780c39137fc86ee7ed5d63c5a9af8921b9b8c04 100644
--- a/src/MNH/modd_sensor.f90
+++ b/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
diff --git a/src/MNH/write_aircraft_balloon.f90 b/src/MNH/write_aircraft_balloon.f90
index 41335da49e79d689be27e647aebea076534b339d..a1b978be286734a3a65d09439ffd0d0792e0300c 100644
--- a/src/MNH/write_aircraft_balloon.f90
+++ b/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
diff --git a/src/MNH/write_balloonn.f90 b/src/MNH/write_balloonn.f90
index 4c0e7d02b4acb61d35441843c96319153e74a333..e519c2b99e0d289941727eb4106293c8abab8ac6 100644
--- a/src/MNH/write_balloonn.f90
+++ b/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