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
Hide whitespace changes
Inline Side-by-side
src/MNH/modd_sensor.f90
+ 61
− 24
View file @ e85637ff
...@@ -21,6 +21,8 @@ MODULE MODD_SENSOR ...@@ -21,6 +21,8 @@ MODULE MODD_SENSOR
INTEGER, PARAMETER :: NTAG_NCUR = 145 INTEGER, PARAMETER :: NTAG_NCUR = 145
INTEGER, PARAMETER :: NTAG_PACK = 245 INTEGER, PARAMETER :: NTAG_PACK = 245
INTEGER, PARAMETER :: NEMPTYDATA = -1 ! Size to communicate if exchange of no sensor data
TYPE :: TSENSORTIME TYPE :: TSENSORTIME
INTEGER :: N_CUR = 0 ! current step of storage INTEGER :: N_CUR = 0 ! current step of storage
REAL :: XTSTEP = 60. ! storage time step (default reset later) REAL :: XTSTEP = 60. ! storage time step (default reset later)
...@@ -71,6 +73,7 @@ MODULE MODD_SENSOR ...@@ -71,6 +73,7 @@ MODULE MODD_SENSOR
INTEGER :: NV01 = NNEGUNDEF ! Z position for ni_m , nj_v+1 INTEGER :: NV01 = NNEGUNDEF ! Z position for ni_m , nj_v+1
INTEGER :: NV10 = NNEGUNDEF ! Z position for ni_m+1, nj_v INTEGER :: NV10 = NNEGUNDEF ! Z position for ni_m+1, nj_v
INTEGER :: NV11 = NNEGUNDEF ! Z position for ni_m+1, nj_v+1 INTEGER :: NV11 = NNEGUNDEF ! Z position for ni_m+1, nj_v+1
! Coefficient to interpolate values (sensors are usually not exactly on mesh points) ! Coefficient to interpolate values (sensors are usually not exactly on mesh points)
REAL :: XXMCOEF = XUNDEF ! Interpolation coefficient for X (mass-point) REAL :: XXMCOEF = XUNDEF ! Interpolation coefficient for X (mass-point)
REAL :: XYMCOEF = XUNDEF ! Interpolation coefficient for Y (mass-point) REAL :: XYMCOEF = XUNDEF ! Interpolation coefficient for Y (mass-point)
...@@ -1251,9 +1254,9 @@ MODULE MODD_SENSOR ...@@ -1251,9 +1254,9 @@ MODULE MODD_SENSOR
END SUBROUTINE BUFFER_RECV 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 USE MODD_IO, ONLY: ISP
...@@ -1262,10 +1265,12 @@ MODULE MODD_SENSOR ...@@ -1262,10 +1265,12 @@ MODULE MODD_SENSOR
CLASS(TSENSOR), INTENT(INOUT) :: TPSENSOR CLASS(TSENSOR), INTENT(INOUT) :: TPSENSOR
INTEGER, INTENT(IN) :: KTO ! Process to which to send data 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) :: 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 CHARACTER(LEN=10) :: YFROM, YTO
INTEGER :: IPACKSIZE INTEGER :: IPACKSIZE
INTEGER :: IPOS INTEGER :: IPOS
LOGICAL :: GEMPTYSEND
LOGICAL :: GSEND_SIZE_TO_RECEIVER LOGICAL :: GSEND_SIZE_TO_RECEIVER
REAL, DIMENSION(:), ALLOCATABLE :: ZPACK ! buffer to store raw data of the sensor REAL, DIMENSION(:), ALLOCATABLE :: ZPACK ! buffer to store raw data of the sensor
...@@ -1274,27 +1279,45 @@ MODULE MODD_SENSOR ...@@ -1274,27 +1279,45 @@ MODULE MODD_SENSOR
CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'Sensor_comm_send', & CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'Sensor_comm_send', &
'send sensor ' // TRIM(TPSENSOR%CNAME) // ': ' // TRIM(YFROM) // '->' // TRIM(YTO), OLOCAL = .TRUE. ) '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 IF ( PRESENT( OSEND_SIZE_TO_RECEIVER ) ) THEN
GSEND_SIZE_TO_RECEIVER = OSEND_SIZE_TO_RECEIVER GSEND_SIZE_TO_RECEIVER = OSEND_SIZE_TO_RECEIVER
ELSE ELSE
GSEND_SIZE_TO_RECEIVER = .FALSE. GSEND_SIZE_TO_RECEIVER = .FALSE.
END IF 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 ) 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 IPOS = 1
CALL TPSENSOR%BUFFER_PACK( ZPACK, IPOS, TPSENSOR%NSTORE_CUR ) CALL TPSENSOR%BUFFER_PACK( ZPACK, IPOS, TPSENSOR%NSTORE_CUR )
IF ( IPOS-1 /= IPACKSIZE ) & IF ( IPOS-1 /= IPACKSIZE ) &
CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Sensor_comm_send', 'IPOS-1 /= IPACKSIZE', OLOCAL = .TRUE. ) 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 END SUBROUTINE SENSOR_COMM_SEND
...@@ -1313,26 +1336,28 @@ MODULE MODD_SENSOR ...@@ -1313,26 +1336,28 @@ MODULE MODD_SENSOR
END SUBROUTINE SENSOR_COMM_SEND_DEALLOCATE 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 MODD_IO, ONLY: ISP
USE MODE_MSG USE MODE_MSG
CLASS(TSENSOR), INTENT(INOUT) :: TPSENSOR 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_CUR ! Number of storage steps to receive
INTEGER, OPTIONAL, INTENT(IN) :: KSTORE_MAX ! Maximum number of storage steps to store in sensor 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) ! (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(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 CHARACTER(LEN=10) :: YFROM, YTO
INTEGER :: IPACKSIZE INTEGER :: IPACKSIZE
INTEGER :: IPOS INTEGER :: IPOS
INTEGER :: ISTORE_CUR INTEGER :: ISTORE_CUR
INTEGER :: ISTORE_MAX INTEGER :: ISTORE_MAX
LOGICAL :: GEMPTYRECV
LOGICAL :: GRECV_SIZE_FROM_OWNER LOGICAL :: GRECV_SIZE_FROM_OWNER
REAL, DIMENSION(:), ALLOCATABLE :: ZPACK ! buffer to store raw data of the sensor REAL, DIMENSION(:), ALLOCATABLE :: ZPACK ! buffer to store raw data of the sensor
...@@ -1341,6 +1366,8 @@ MODULE MODD_SENSOR ...@@ -1341,6 +1366,8 @@ MODULE MODD_SENSOR
CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'Sensor_comm_recv_allocate', & CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'Sensor_comm_recv_allocate', &
'receive sensor (name not yet known): ' // TRIM(YFROM) // '->' // TRIM(YTO), OLOCAL = .TRUE. ) 'receive sensor (name not yet known): ' // TRIM(YFROM) // '->' // TRIM(YTO), OLOCAL = .TRUE. )
GEMPTYRECV = .FALSE.
IF ( PRESENT( ORECV_SIZE_FROM_OWNER ) ) THEN IF ( PRESENT( ORECV_SIZE_FROM_OWNER ) ) THEN
GRECV_SIZE_FROM_OWNER = ORECV_SIZE_FROM_OWNER GRECV_SIZE_FROM_OWNER = ORECV_SIZE_FROM_OWNER
ELSE ELSE
...@@ -1380,19 +1407,29 @@ MODULE MODD_SENSOR ...@@ -1380,19 +1407,29 @@ MODULE MODD_SENSOR
IPACKSIZE = TPSENSOR%BUFFER_SIZE_COMPUTE( ISTORE_CUR ) IPACKSIZE = TPSENSOR%BUFFER_SIZE_COMPUTE( ISTORE_CUR )
END IF END IF
! Allocate receive buffer IF ( IPACKSIZE == NEMPTYDATA ) THEN
ALLOCATE( ZPACK(IPACKSIZE) ) 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) CALL TPSENSOR%BUFFER_RECV( ZPACK, KFROM )
IF (TPSENSOR%NSTORE_MAX < 0 ) CALL TPSENSOR%DATA_ARRAYS_ALLOCATE( ISTORE_MAX )
CALL TPSENSOR%BUFFER_RECV( ZPACK, KFROM ) IPOS = 1
CALL TPSENSOR%BUFFER_UNPACK( ZPACK, IPOS, ISTORE_CUR )
IPOS = 1 IF ( IPOS-1 /= IPACKSIZE ) &
CALL TPSENSOR%BUFFER_UNPACK( ZPACK, IPOS, ISTORE_CUR ) CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Sensor_comm_recv_allocate', 'IPOS-1 /= IPACKSIZE', OLOCAL = .TRUE. )
END IF
IF ( IPOS-1 /= IPACKSIZE ) & IF ( PRESENT( OEMPTYRECV) ) OEMPTYRECV = GEMPTYRECV
CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Sensor_comm_recv_allocate', 'IPOS-1 /= IPACKSIZE', OLOCAL = .TRUE. )
END SUBROUTINE SENSOR_COMM_RECV_ALLOCATE END SUBROUTINE SENSOR_COMM_RECV_ALLOCATE
......
src/MNH/write_aircraft_balloon.f90
+ 21
− 11
View file @ e85637ff
...@@ -78,7 +78,9 @@ SUBROUTINE WRITE_AIRCRAFT_BALLOON(TPDIAFILE) ...@@ -78,7 +78,9 @@ SUBROUTINE WRITE_AIRCRAFT_BALLOON(TPDIAFILE)
! !
USE MODD_AIRCRAFT_BALLOON USE MODD_AIRCRAFT_BALLOON
USE MODD_IO, ONLY: ISP, TFILEDATA USE MODD_IO, ONLY: ISP, TFILEDATA
!
USE MODE_MODELN_HANDLER, ONLY: GET_CURRENT_MODEL_INDEX
IMPLICIT NONE IMPLICIT NONE
! !
! !
...@@ -90,16 +92,21 @@ TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write ...@@ -90,16 +92,21 @@ TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
! !
! 0.2 declaration of local variables ! 0.2 declaration of local variables
! !
INTEGER :: IMI
INTEGER :: JI INTEGER :: JI
LOGICAL :: GEMPTYCOMM ! if TRUE, the communication is empty (no data is exchanged)
! !
!---------------------------------------------------------------------------- !----------------------------------------------------------------------------
IMI = GET_CURRENT_MODEL_INDEX()
DO JI = 1, NBALLOONS DO JI = 1, NBALLOONS
! The balloon data is only available on the process where it is physically located => transfer it if necessary ! 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 ! Send data from owner to writer if necessary
IF ( ISP == NRANKCUR_BALLOON(JI) .AND. NRANKCUR_BALLOON(JI) /= TPDIAFILE%NMASTER_RANK ) THEN 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 END IF
IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
...@@ -108,11 +115,12 @@ DO JI = 1, NBALLOONS ...@@ -108,11 +115,12 @@ DO JI = 1, NBALLOONS
IF ( ASSOCIATED( TBALLOONS(JI)%TBALLOON ) ) & IF ( ASSOCIATED( TBALLOONS(JI)%TBALLOON ) ) &
call Print_msg( NVERB_FATAL, 'GEN', 'WRITE_AIRCRAFT_BALLOON', 'balloon already associated' ) call Print_msg( NVERB_FATAL, 'GEN', 'WRITE_AIRCRAFT_BALLOON', 'balloon already associated' )
ALLOCATE( TBALLOONS(JI)%TBALLOON ) 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 END IF
! Write data ! Write data (if balloon is on this model (GEMPTYCOMM=F))
CALL FLYER_DIACHRO( TPDIAFILE, TBALLOONS(JI)%TBALLOON ) 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 ! 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 ! 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 ...@@ -125,7 +133,8 @@ DO JI = 1, NAIRCRAFTS
! Send data from owner to writer if necessary ! Send data from owner to writer if necessary
IF ( ISP == NRANKCUR_AIRCRAFT(JI) .AND. NRANKCUR_AIRCRAFT(JI) /= TPDIAFILE%NMASTER_RANK ) THEN 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 END IF
IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
...@@ -134,11 +143,12 @@ DO JI = 1, NAIRCRAFTS ...@@ -134,11 +143,12 @@ DO JI = 1, NAIRCRAFTS
IF ( ASSOCIATED( TAIRCRAFTS(JI)%TAIRCRAFT ) ) & IF ( ASSOCIATED( TAIRCRAFTS(JI)%TAIRCRAFT ) ) &
call Print_msg( NVERB_FATAL, 'GEN', 'WRITE_AIRCRAFT_BALLOON', 'aircraft already associated' ) call Print_msg( NVERB_FATAL, 'GEN', 'WRITE_AIRCRAFT_BALLOON', 'aircraft already associated' )
ALLOCATE( TAIRCRAFTS(JI)%TAIRCRAFT ) 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 END IF
! Write data ! Write data (if aircraft is on this model (GEMPTYCOMM=F))
CALL FLYER_DIACHRO( TPDIAFILE, TAIRCRAFTS(JI)%TAIRCRAFT ) 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 ! 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 ! 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 ...@@ -168,7 +178,7 @@ IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
DO JI = 1, NBALLOONS DO JI = 1, NBALLOONS
! Free ballon data if it was not stored on this process ! Free ballon data if it was not stored on this process
IF ( NRANKCUR_BALLOON(JI) /= TPDIAFILE%NMASTER_RANK ) THEN 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 ) DEALLOCATE( TBALLOONS(JI)%TBALLOON )
END IF END IF
END DO END DO
...@@ -176,7 +186,7 @@ IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN ...@@ -176,7 +186,7 @@ IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
DO JI = 1, NAIRCRAFTS DO JI = 1, NAIRCRAFTS
! Free aircraft data if it was not stored on this process ! Free aircraft data if it was not stored on this process
IF ( NRANKCUR_AIRCRAFT(JI) /= TPDIAFILE%NMASTER_RANK ) THEN 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 ) DEALLOCATE( TAIRCRAFTS(JI)%TAIRCRAFT )
END IF END IF
END DO END DO
......
src/MNH/write_balloonn.f90
+ 12
− 8
View file @ e85637ff
...@@ -73,12 +73,13 @@ TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics ...@@ -73,12 +73,13 @@ TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics
! !
INTEGER :: IMI INTEGER :: IMI
INTEGER :: JI 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() IMI = GET_CURRENT_MODEL_INDEX()
! Save GSMONOPROC value ! 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) ! Force GSMONOPROC to true to allow IO_Field_write on only 1 process! (not very clean hack)
GSMONOPROC = .TRUE. GSMONOPROC = .TRUE.
...@@ -87,30 +88,33 @@ DO JI = 1, NBALLOONS ...@@ -87,30 +88,33 @@ DO JI = 1, NBALLOONS
! Send data from owner to writer if necessary ! Send data from owner to writer if necessary
IF ( ISP == NRANKCUR_BALLOON(JI) .AND. NRANKCUR_BALLOON(JI) /= TPFILE%NMASTER_RANK ) THEN 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 END IF
IF ( ISP == TPFILE%NMASTER_RANK ) THEN IF ( ISP == TPFILE%NMASTER_RANK ) THEN
! Receive data from owner if not available on the writer process ! Receive data from owner if not available on the writer process
IF ( NRANKCUR_BALLOON(JI) /= TPFILE%NMASTER_RANK ) THEN IF ( NRANKCUR_BALLOON(JI) /= TPFILE%NMASTER_RANK ) THEN
ALLOCATE( TBALLOONS(JI)%TBALLOON ) 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 END IF
! Write data (only if flyer is on the current model) ! Write data (only if flyer is on the current model)
! It will also be written in the ancestry model files ! 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 ! Free ballon data if it was not stored on this process
IF ( NRANKCUR_BALLOON(JI) /= TPFILE%NMASTER_RANK ) THEN 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 ) DEALLOCATE( TBALLOONS(JI)%TBALLOON )
END IF END IF
END IF END IF
END DO END DO
! Restore correct value of GSMONOPROC ! Restore correct value of GSMONOPROC
GSMONOPROC = OMONOPROC_SAVE GSMONOPROC = GMONOPROC_SAVE
END SUBROUTINE WRITE_BALLOON_n END SUBROUTINE WRITE_BALLOON_n
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
...@@ -151,7 +155,7 @@ REAL :: ZLON ! longitude of the balloon ...@@ -151,7 +155,7 @@ REAL :: ZLON ! longitude of the balloon
type(tfiledata) :: tzfile type(tfiledata) :: tzfile
TYPE(TFIELDMETADATA) :: TZFIELD 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 IF ( .NOT.TPFLYER%LFLY .OR. TPFLYER%LCRASH ) RETURN
! Check if current model time is the same as the time corresponding to the balloon position ! Check if current model time is the same as the time corresponding to the balloon position
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment

Documentation | Mentions légales | CGU | Accessibilité : non conforme