From bb4d0f98658d8019ba1196f8dd6cff1cce059f1b Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Fri, 7 Jul 2023 16:21:56 +0200
Subject: [PATCH] Philippe 07/07/2023: sensors: add SEND_ALLOCATE and
RECV_DEALLOCATE procedures
---
src/MNH/aircraft_balloon.f90 | 121 +-------------------
src/MNH/aircraft_balloon_evol.f90 | 7 +-
src/MNH/modd_sensor.f90 | 174 ++++++++++++++++++++++++++---
src/MNH/write_aircraft_balloon.f90 | 10 +-
src/MNH/write_balloonn.f90 | 5 +-
src/MNH/write_profilern.f90 | 28 +----
src/MNH/write_stationn.f90 | 30 +----
7 files changed, 186 insertions(+), 189 deletions(-)
diff --git a/src/MNH/aircraft_balloon.f90 b/src/MNH/aircraft_balloon.f90
index 90a129d20..800804710 100644
--- a/src/MNH/aircraft_balloon.f90
+++ b/src/MNH/aircraft_balloon.f90
@@ -25,8 +25,6 @@ PUBLIC :: AIRCRAFT_BALLOON
PUBLIC :: AIRCRAFT_BALLOON_LONGTYPE_GET
-PUBLIC :: FLYER_RECV_AND_ALLOCATE, FLYER_SEND
-
INTEGER, PARAMETER :: NTAG_NCUR = 145
INTEGER, PARAMETER :: NTAG_PACK = 245
@@ -212,13 +210,13 @@ DEALLOCATE( IRANKNXT_AIRCRAFT_TMP )
DO JI = 1, NAIRCRAFTS
IF ( NRANKNXT_AIRCRAFT(JI) /= NRANKCUR_AIRCRAFT(JI) ) THEN
IF ( ISP == NRANKCUR_AIRCRAFT(JI) ) THEN
- CALL FLYER_SEND_AND_DEALLOCATE( TAIRCRAFTS(JI)%TAIRCRAFT, NRANKNXT_AIRCRAFT(JI) )
+ CALL TAIRCRAFTS(JI)%TAIRCRAFT%SEND_DEALLOCATE( KTO = NRANKNXT_AIRCRAFT(JI), OSEND_SIZE_TO_RECEIVER = .TRUE. )
DEALLOCATE( TAIRCRAFTS(JI)%TAIRCRAFT )
ELSE IF ( ISP == NRANKNXT_AIRCRAFT(JI) ) THEN
IF ( ASSOCIATED( TAIRCRAFTS(JI)%TAIRCRAFT ) ) &
call Print_msg( NVERB_FATAL, 'GEN', 'AIRCRAFT_BALLOON', 'aircraft already associated' )
ALLOCATE( TAIRCRAFTS(JI)%TAIRCRAFT )
- CALL FLYER_RECV_AND_ALLOCATE( TAIRCRAFTS(JI)%TAIRCRAFT, NRANKCUR_AIRCRAFT(JI) )
+ CALL TAIRCRAFTS(JI)%TAIRCRAFT%RECV_ALLOCATE( KFROM = NRANKCUR_AIRCRAFT(JI), ORECV_SIZE_FROM_OWNER = .TRUE. )
END IF
END IF
END DO
@@ -297,11 +295,11 @@ DEALLOCATE( IRANKNXT_BALLOON_TMP )
DO JI = 1, NBALLOONS
IF ( NRANKNXT_BALLOON(JI) /= NRANKCUR_BALLOON(JI) ) THEN
IF ( ISP == NRANKCUR_BALLOON(JI) ) THEN
- CALL FLYER_SEND_AND_DEALLOCATE( TBALLOONS(JI)%TBALLOON, NRANKNXT_BALLOON(JI) )
+ CALL TBALLOONS(JI)%TBALLOON%SEND_DEALLOCATE( KTO = NRANKNXT_BALLOON(JI), OSEND_SIZE_TO_RECEIVER = .TRUE. )
DEALLOCATE( TBALLOONS(JI)%TBALLOON )
ELSE IF ( ISP == NRANKNXT_BALLOON(JI) ) THEN
ALLOCATE( TBALLOONS(JI)%TBALLOON )
- CALL FLYER_RECV_AND_ALLOCATE( TBALLOONS(JI)%TBALLOON, NRANKCUR_BALLOON(JI) )
+ CALL TBALLOONS(JI)%TBALLOON%RECV_ALLOCATE( KFROM = NRANKCUR_BALLOON(JI), ORECV_SIZE_FROM_OWNER = .TRUE. )
END IF
END IF
END DO
@@ -352,115 +350,4 @@ END SUBROUTINE AIRCRAFT_BALLOON_LONGTYPE_GET
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
-SUBROUTINE FLYER_SEND( TPFLYER, KTO )
-
-USE MODD_AIRCRAFT_BALLOON, ONLY: TFLYERDATA
-USE MODD_IO, ONLY: ISP
-USE MODD_PARAMETERS, ONLY: JPVEXT
-
-IMPLICIT NONE
-
-CLASS(TFLYERDATA), INTENT(INOUT) :: TPFLYER
-INTEGER, INTENT(IN) :: KTO ! Process to which to send flyer data
-
-CHARACTER(LEN=10) :: YFROM, YTO
-INTEGER :: IPACKSIZE ! Size of the ZPACK buffer
-INTEGER :: IPOS ! Position in the ZPACK buffer
-INTEGER :: ISTORE_CUR
-REAL, DIMENSION(:), ALLOCATABLE :: ZPACK ! Buffer to store raw data of a profiler (used for MPI communication)
-
-WRITE( YFROM, '( I10 )' ) ISP
-WRITE( YTO, '( I10 )' ) KTO
-CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'FLYER_SEND', 'send flyer '//TRIM(TPFLYER%CNAME)//': '//TRIM(YFROM)//'->'//TRIM(YTO), &
- OLOCAL = .TRUE. )
-
-ISTORE_CUR = TPFLYER%TFLYER_TIME%N_CUR
-
-
-IPACKSIZE = TPFLYER%BUFFER_SIZE_COMPUTE( ISTORE_CUR )
-
-CALL TPFLYER%BUFFER_SIZE_SEND( ISTORE_CUR, IPACKSIZE, KTO )
-
-ALLOCATE( ZPACK(IPACKSIZE) )
-
-IPOS = 1
-CALL TPFLYER%BUFFER_PACK( ZPACK, IPOS, ISTORE_CUR )
-
-IF ( IPOS-1 /= IPACKSIZE ) &
- call Print_msg( NVERB_ERROR, 'IO', 'FLYER_SEND', 'IPOS-1 /= IPACKSIZE (sender side)', OLOCAL = .TRUE. )
-
-CALL TPFLYER%BUFFER_SEND( ZPACK, KTO )
-
-DEALLOCATE( ZPACK )
-
-END SUBROUTINE FLYER_SEND
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-SUBROUTINE FLYER_SEND_AND_DEALLOCATE( TPFLYER, KTO )
-
-USE MODD_AIRCRAFT_BALLOON, ONLY: TFLYERDATA
-USE MODD_IO, ONLY: ISP
-
-IMPLICIT NONE
-
-CLASS(TFLYERDATA), INTENT(INOUT) :: TPFLYER
-INTEGER, INTENT(IN) :: KTO ! Process to which to send flyer data
-
-CHARACTER(LEN=10) :: YFROM, YTO
-
-WRITE( YFROM, '( I10 )' ) ISP
-WRITE( YTO, '( I10 )' ) KTO
-CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'FLYER_SEND_AND_DEALLOCATE', &
- 'send flyer '//TRIM(TPFLYER%CNAME)//': '//TRIM(YFROM)//'->'//TRIM(YTO), OLOCAL = .TRUE. )
-
-CALL FLYER_SEND( TPFLYER, KTO )
-
-! Free flyer data (dynamically allocated), scalar data has to be freed outside this subroutine
-CALL TPFLYER%DATA_ARRAYS_DEALLOCATE()
-
-END SUBROUTINE FLYER_SEND_AND_DEALLOCATE
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-SUBROUTINE FLYER_RECV_AND_ALLOCATE( TPFLYER, KFROM )
-
-USE MODD_AIRCRAFT_BALLOON, ONLY: TFLYERDATA
-! USE MODD_IO, ONLY: ISP
-
-IMPLICIT NONE
-
-CLASS(TFLYERDATA), INTENT(INOUT) :: TPFLYER
-INTEGER, INTENT(IN) :: KFROM ! Process from which to receive flyer data
-
-! CHARACTER(LEN=10) :: YFROM, YTO
-INTEGER :: ISTORE_CUR
-INTEGER :: ISTORE_TOT
-INTEGER :: IPACKSIZE ! Size of the ZPACK buffer
-INTEGER :: IPOS ! Position in the ZPACK buffer
-REAL, DIMENSION(:), ALLOCATABLE :: ZPACK ! Buffer to store raw data of a profiler (used for MPI communication)
-
-! WRITE( YFROM, '( I10 )' ) KFROM
-! WRITE( YTO, '( I10 )' ) ISP
-! CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'FLYER_RECV_AND_ALLOCATE', &
-! 'receive flyer (name not yet known): '//TRIM(YFROM)//'->'//TRIM(YTO), OLOCAL = .TRUE. )
-
-CALL TPFLYER%BUFFER_SIZE_RECV( ISTORE_CUR, ISTORE_TOT, IPACKSIZE, KFROM )
-
-! Allocate receive buffer
-ALLOCATE( ZPACK(IPACKSIZE) )
-
-! Allocation of flyer must be done only once number of stores is known
-CALL TPFLYER%DATA_ARRAYS_ALLOCATE( ISTORE_TOT )
-
-CALL TPFLYER%BUFFER_RECV( ZPACK, KFROM )
-
-IPOS = 1
-CALL TPFLYER%BUFFER_UNPACK( ZPACK, IPOS, ISTORE_CUR )
-
-IF ( IPOS-1 /= IPACKSIZE ) &
- call Print_msg( NVERB_ERROR, 'IO', 'FLYER_RECV_AND_ALLOCATE', 'IPOS-1 /= IPACKSIZE (receiver side)', OLOCAL = .TRUE. )
-
-END SUBROUTINE FLYER_RECV_AND_ALLOCATE
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-
END MODULE MODE_AIRCRAFT_BALLOON
diff --git a/src/MNH/aircraft_balloon_evol.f90 b/src/MNH/aircraft_balloon_evol.f90
index 9d5be44c4..e0d7e555b 100644
--- a/src/MNH/aircraft_balloon_evol.f90
+++ b/src/MNH/aircraft_balloon_evol.f90
@@ -207,9 +207,12 @@ SELECT TYPE ( TPFLYER )
END IF TAKEOFF
!Do we have to store aircraft data?
- IF ( IMI == TPFLYER%NMODEL ) TPFLYER%LSTORE = TPFLYER%TFLYER_TIME%STORESTEP_CHECK_AND_SET( ISTORE )
+ IF ( IMI == TPFLYER%NMODEL ) THEN
+ TPFLYER%LSTORE = TPFLYER%TFLYER_TIME%STORESTEP_CHECK_AND_SET( ISTORE )
+ IF ( TPFLYER%LSTORE ) TPFLYER%NSTORE_CUR = ISTORE
+ END IF
+
- IF ( TPFLYER%LSTORE ) TPFLYER%NSTORE_CUR = ISTORE
! For aircrafts, data has only to be computed at store moments
IF ( IMI == TPFLYER%NMODEL .AND. TPFLYER%LFLY .AND. TPFLYER%LSTORE ) THEN
! Check if it is the right moment to store data
diff --git a/src/MNH/modd_sensor.f90 b/src/MNH/modd_sensor.f90
index b0296e02c..be0672788 100644
--- a/src/MNH/modd_sensor.f90
+++ b/src/MNH/modd_sensor.f90
@@ -132,6 +132,9 @@ MODULE MODD_SENSOR
PROCEDURE, NON_OVERRIDABLE :: BUFFER_SIZE_RECV
PROCEDURE, NON_OVERRIDABLE :: BUFFER_SEND
PROCEDURE, NON_OVERRIDABLE :: BUFFER_RECV
+ PROCEDURE, NON_OVERRIDABLE :: SEND => SENSOR_COMM_SEND
+ PROCEDURE, NON_OVERRIDABLE :: SEND_DEALLOCATE => SENSOR_COMM_SEND_DEALLOCATE
+ PROCEDURE, NON_OVERRIDABLE :: RECV_ALLOCATE => SENSOR_COMM_RECV_ALLOCATE
GENERIC :: INTERP_HOR_FROM_MASSPOINT => INTERP_HOR_FROM_MASSPOINT_0D, INTERP_HOR_FROM_MASSPOINT_1D
GENERIC :: INTERP_HOR_FROM_UPOINT => INTERP_HOR_FROM_UPOINT_0D, INTERP_HOR_FROM_UPOINT_1D
@@ -1157,23 +1160,168 @@ MODULE MODD_SENSOR
END SUBROUTINE BUFFER_SEND
- ! ################################################
- SUBROUTINE BUFFER_RECV( TPSENSOR, PBUFFER, KFROM )
- ! ################################################
+ ! ################################################
+ SUBROUTINE BUFFER_RECV( TPSENSOR, PBUFFER, KFROM )
+ ! ################################################
- USE MODD_MPIF, ONLY: MPI_RECV, MPI_STATUS_IGNORE
- USE MODD_PRECISION, ONLY: MNHREAL_MPI
- USE MODD_VAR_LL, ONLY: NMNH_COMM_WORLD
+ USE MODD_MPIF, ONLY: MPI_RECV, MPI_STATUS_IGNORE
+ USE MODD_PRECISION, ONLY: MNHREAL_MPI
+ USE MODD_VAR_LL, ONLY: NMNH_COMM_WORLD
+
+ CLASS(TSENSOR), INTENT(IN) :: TPSENSOR
+ REAL, DIMENSION(:), INTENT(OUT) :: PBUFFER
+ INTEGER, INTENT(IN) :: KFROM ! Process from which to receive buffer
+
+ INTEGER :: IERR
+
+ ! Receive packed data
+ CALL MPI_RECV( PBUFFER, SIZE( PBUFFER ), MNHREAL_MPI, KFROM-1, NTAG_PACK, NMNH_COMM_WORLD, MPI_STATUS_IGNORE, IERR )
+
+ END SUBROUTINE BUFFER_RECV
+
+ ! ##################################################################
+ SUBROUTINE SENSOR_COMM_SEND( TPSENSOR, KTO, OSEND_SIZE_TO_RECEIVER )
+ ! ##################################################################
+
+ USE MODD_IO, ONLY: ISP
+
+ USE MODE_MSG
+
+ 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
+
+ CHARACTER(LEN=10) :: YFROM, YTO
+ INTEGER :: IPACKSIZE
+ INTEGER :: IPOS
+ LOGICAL :: GSEND_SIZE_TO_RECEIVER
+ REAL, DIMENSION(:), ALLOCATABLE :: ZPACK ! buffer to store raw data of the sensor
+
+ WRITE( YFROM, '( i10 )' ) ISP
+ WRITE( YTO, '( i10 )' ) KTO
+ CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'Sensor_comm_send', &
+ 'send sensor ' // TRIM(TPSENSOR%CNAME) // ': ' // TRIM(YFROM) // '->' // TRIM(YTO), OLOCAL = .TRUE. )
+
+ 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 ( GSEND_SIZE_TO_RECEIVER ) CALL TPSENSOR%BUFFER_SIZE_SEND( TPSENSOR%NSTORE_CUR, IPACKSIZE, KTO )
+
+ ALLOCATE( ZPACK(IPACKSIZE) )
+
+ 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. )
+
+ CALL TPSENSOR%BUFFER_SEND( ZPACK, KTO )
+
+ DEALLOCATE( ZPACK )
+
+ END SUBROUTINE SENSOR_COMM_SEND
+
+ ! #############################################################################
+ SUBROUTINE SENSOR_COMM_SEND_DEALLOCATE( TPSENSOR, KTO, OSEND_SIZE_TO_RECEIVER )
+ ! #############################################################################
+
+ 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
+
+ CALL SENSOR_COMM_SEND( TPSENSOR, KTO, OSEND_SIZE_TO_RECEIVER )
+
+ ! Deallocate sensor data once not needed anymore
+ IF ( TPSENSOR%NSTORE_MAX >= 0 ) CALL TPSENSOR%DATA_ARRAYS_DEALLOCATE( )
+
+ END SUBROUTINE SENSOR_COMM_SEND_DEALLOCATE
+
+ ! ####################################################################################################
+ SUBROUTINE SENSOR_COMM_RECV_ALLOCATE( TPSENSOR, KFROM, KSTORE_CUR, KSTORE_MAX, ORECV_SIZE_FROM_OWNER )
+ ! ####################################################################################################
+
+ USE MODD_IO, ONLY: ISP
+
+ USE MODE_MSG
+
+ CLASS(TSENSOR), INTENT(INOUT) :: TPSENSOR
+ 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
+
+ CHARACTER(LEN=10) :: YFROM, YTO
+ INTEGER :: IPACKSIZE
+ INTEGER :: IPOS
+ INTEGER :: ISTORE_CUR
+ INTEGER :: ISTORE_MAX
+ LOGICAL :: GRECV_SIZE_FROM_OWNER
+ REAL, DIMENSION(:), ALLOCATABLE :: ZPACK ! buffer to store raw data of the sensor
+
+ WRITE( YFROM, '( i10 )' ) KFROM
+ WRITE( YTO, '( i10 )' ) ISP
+ CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'Sensor_comm_recv_allocate', &
+ 'receive sensor (name not yet known): ' // TRIM(YFROM) // '->' // TRIM(YTO), OLOCAL = .TRUE. )
+
+ IF ( PRESENT( ORECV_SIZE_FROM_OWNER ) ) THEN
+ GRECV_SIZE_FROM_OWNER = ORECV_SIZE_FROM_OWNER
+ ELSE
+ GRECV_SIZE_FROM_OWNER = .FALSE.
+ END IF
+
+ IF ( PRESENT( KSTORE_CUR ) ) THEN
+ IF ( GRECV_SIZE_FROM_OWNER ) &
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Sensor_comm_recv_allocate', &
+ 'kstore_cur may not be provided if size is received from owner', OLOCAL = .TRUE. )
+ ISTORE_CUR = KSTORE_CUR
+ ELSE
+ IF ( .NOT. GRECV_SIZE_FROM_OWNER ) &
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Sensor_comm_recv_allocate', &
+ 'kstore_cur must be provided if size is not received from owner', OLOCAL = .TRUE. )
+ ! istore_cur will be received from owner
+ ISTORE_CUR = 0
+ END IF
+
+ IF ( PRESENT( KSTORE_MAX ) ) THEN
+ IF ( GRECV_SIZE_FROM_OWNER ) &
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Sensor_comm_recv_allocate', &
+ 'kstore_max may not be provided if size is received from owner', OLOCAL = .TRUE. )
+ ISTORE_MAX = KSTORE_MAX
+ ELSE
+ IF ( .NOT. GRECV_SIZE_FROM_OWNER ) &
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Sensor_comm_recv_allocate', &
+ 'kstore_max must be provided if size is not received from owner', OLOCAL = .TRUE. )
+
+ ! istore_max will be received from owner
+ ISTORE_MAX = 0
+ END IF
+
+ IF ( GRECV_SIZE_FROM_OWNER ) THEN
+ CALL TPSENSOR%BUFFER_SIZE_RECV( ISTORE_CUR, ISTORE_MAX, IPACKSIZE, KFROM )
+ ELSE
+ IPACKSIZE = TPSENSOR%BUFFER_SIZE_COMPUTE( ISTORE_CUR )
+ END IF
+
+ ! 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 )
- CLASS(TSENSOR), INTENT(IN) :: TPSENSOR
- REAL, DIMENSION(:), INTENT(OUT) :: PBUFFER
- INTEGER, INTENT(IN) :: KFROM ! Process from which to receive buffer
+ CALL TPSENSOR%BUFFER_RECV( ZPACK, KFROM )
- INTEGER :: IERR
+ IPOS = 1
+ CALL TPSENSOR%BUFFER_UNPACK( ZPACK, IPOS, ISTORE_CUR )
- ! Receive packed data
- CALL MPI_RECV( PBUFFER, SIZE( PBUFFER ), MNHREAL_MPI, KFROM-1, NTAG_PACK, NMNH_COMM_WORLD, MPI_STATUS_IGNORE, IERR )
+ IF ( IPOS-1 /= IPACKSIZE ) &
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'Sensor_comm_recv_allocate', 'IPOS-1 /= IPACKSIZE', OLOCAL = .TRUE. )
- END SUBROUTINE BUFFER_RECV
+ END SUBROUTINE SENSOR_COMM_RECV_ALLOCATE
END MODULE MODD_SENSOR
diff --git a/src/MNH/write_aircraft_balloon.f90 b/src/MNH/write_aircraft_balloon.f90
index 3ad7fafc5..2e6fc331d 100644
--- a/src/MNH/write_aircraft_balloon.f90
+++ b/src/MNH/write_aircraft_balloon.f90
@@ -85,8 +85,6 @@ SUBROUTINE WRITE_AIRCRAFT_BALLOON(TPDIAFILE)
USE MODD_AIRCRAFT_BALLOON
USE MODD_IO, ONLY: ISP, TFILEDATA
!
-USE MODE_AIRCRAFT_BALLOON, ONLY: FLYER_RECV_AND_ALLOCATE, FLYER_SEND
-!
IMPLICIT NONE
!
!
@@ -107,7 +105,7 @@ DO JI = 1, NBALLOONS
! Send data from owner to writer if necessary
IF ( ISP == NRANKCUR_BALLOON(JI) .AND. NRANKCUR_BALLOON(JI) /= TPDIAFILE%NMASTER_RANK ) THEN
- CALL FLYER_SEND( TBALLOONS(JI)%TBALLOON, TPDIAFILE%NMASTER_RANK )
+ CALL TBALLOONS(JI)%TBALLOON%SEND( KTO = TPDIAFILE%NMASTER_RANK, OSEND_SIZE_TO_RECEIVER = .TRUE. )
END IF
IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
@@ -116,7 +114,7 @@ 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 FLYER_RECV_AND_ALLOCATE( TBALLOONS(JI)%TBALLOON, NRANKCUR_BALLOON(JI) )
+ CALL TBALLOONS(JI)%TBALLOON%RECV_ALLOCATE( KFROM = NRANKCUR_BALLOON(JI), ORECV_SIZE_FROM_OWNER = .TRUE. )
END IF
! Write data
@@ -133,7 +131,7 @@ 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 FLYER_SEND( TAIRCRAFTS(JI)%TAIRCRAFT, TPDIAFILE%NMASTER_RANK )
+ CALL TAIRCRAFTS(JI)%TAIRCRAFT%SEND( KTO = TPDIAFILE%NMASTER_RANK, OSEND_SIZE_TO_RECEIVER = .TRUE. )
END IF
IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
@@ -142,7 +140,7 @@ 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 FLYER_RECV_AND_ALLOCATE( TAIRCRAFTS(JI)%TAIRCRAFT, NRANKCUR_AIRCRAFT(JI) )
+ CALL TAIRCRAFTS(JI)%TAIRCRAFT%RECV_ALLOCATE( KFROM = NRANKCUR_AIRCRAFT(JI), ORECV_SIZE_FROM_OWNER = .TRUE. )
END IF
! Write data
diff --git a/src/MNH/write_balloonn.f90 b/src/MNH/write_balloonn.f90
index 7604e0de0..4c0e7d02b 100644
--- a/src/MNH/write_balloonn.f90
+++ b/src/MNH/write_balloonn.f90
@@ -60,7 +60,6 @@ CONTAINS
USE MODD_AIRCRAFT_BALLOON, only: NBALLOONS, NRANKCUR_BALLOON, TBALLOONS
USE MODD_IO, ONLY: GSMONOPROC, ISP, TFILEDATA
!
-USE MODE_AIRCRAFT_BALLOON, ONLY: FLYER_RECV_AND_ALLOCATE, FLYER_SEND
USE MODE_MODELN_HANDLER, ONLY: GET_CURRENT_MODEL_INDEX
!
IMPLICIT NONE
@@ -88,14 +87,14 @@ 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 FLYER_SEND( TBALLOONS(JI)%TBALLOON, TPFILE%NMASTER_RANK )
+ CALL TBALLOONS(JI)%TBALLOON%SEND( KTO = TPFILE%NMASTER_RANK, OSEND_SIZE_TO_RECEIVER = .TRUE. )
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 FLYER_RECV_AND_ALLOCATE( TBALLOONS(JI)%TBALLOON, NRANKCUR_BALLOON(JI) )
+ CALL TBALLOONS(JI)%TBALLOON%RECV_ALLOCATE( KFROM = NRANKCUR_BALLOON(JI), ORECV_SIZE_FROM_OWNER = .TRUE. )
END IF
! Write data (only if flyer is on the current model)
diff --git a/src/MNH/write_profilern.f90 b/src/MNH/write_profilern.f90
index 46fe8d327..5cd2e0c04 100644
--- a/src/MNH/write_profilern.f90
+++ b/src/MNH/write_profilern.f90
@@ -74,15 +74,12 @@ INTEGER :: IERR
INTEGER :: JP, JS
INTEGER :: IDX
INTEGER :: INUMPROF ! Total number of profilers (for the current model)
-INTEGER :: IPACKSIZE ! Size of the ZPACK buffer
-INTEGER :: IPOS ! Position in the ZPACK buffer
INTEGER :: ISTORE
INTEGER, DIMENSION(:), ALLOCATABLE :: INPROFPRC ! Array to store the number of profilers per process (for the current model)
INTEGER, DIMENSION(:), ALLOCATABLE :: IPROFIDS ! Intermediate array for MPI communication
INTEGER, DIMENSION(:), ALLOCATABLE :: IPROFPRCRANK ! Array to store the ranks of the processes where the profilers are
INTEGER, DIMENSION(:), ALLOCATABLE :: IDS ! Array to store the profiler number to send
INTEGER, DIMENSION(:), ALLOCATABLE :: IDISP ! Array to store the displacements for MPI communications
-REAL, DIMENSION(:), ALLOCATABLE :: ZPACK ! Buffer to store raw data of a profiler (used for MPI communication)
TYPE(TPROFILERDATA) :: TZPROFILER
!
!----------------------------------------------------------------------------
@@ -127,13 +124,6 @@ ISTORE = SIZE( TPROFILERS_TIME%TPDATES )
CALL TZPROFILER%DATA_ARRAYS_ALLOCATE( ISTORE )
-!Determine the size of the ZPACK buffer used to transfer profiler data in 1 MPI communication
-IF ( ISNPROC > 1 ) THEN
- IPACKSIZE = TZPROFILER%BUFFER_SIZE_COMPUTE( ISTORE )
-
- ALLOCATE( ZPACK(IPACKSIZE) )
-END IF
-
IDX = 1
PROFILER: DO JS = 1, INUMPROF
@@ -147,24 +137,12 @@ PROFILER: DO JS = 1, INUMPROF
!The profiler data is not on the writer process
IF ( ISP == IPROFPRCRANK(JS) ) THEN
! This process has the data and needs to send it to the writer process
- IPOS = 1
- CALL TPROFILERS(IDX)%BUFFER_PACK( ZPACK, IPOS, ISTORE )
-
- IF ( IPOS-1 /= IPACKSIZE ) &
- call Print_msg( NVERB_ERROR, 'IO', 'WRITE_PROFILER_n', 'IPOS-1 /= IPACKSIZE (sender side)', OLOCAL = .TRUE. )
-
- CALL TPROFILERS(IDX)%BUFFER_SEND( ZPACK, TPDIAFILE%NMASTER_RANK )
+ CALL TPROFILERS(IDX)%SEND_DEALLOCATE( KTO = TPDIAFILE%NMASTER_RANK, OSEND_SIZE_TO_RECEIVER = .FALSE. )
IDX = IDX + 1
ELSE IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
! This process is the writer and will receive the profiler data from its owner
- CALL TZPROFILER%BUFFER_RECV( ZPACK, IPROFPRCRANK(JS) )
-
- IPOS = 1
- CALL TZPROFILER%BUFFER_UNPACK( ZPACK, IPOS, ISTORE )
-
- IF ( IPOS-1 /= IPACKSIZE ) &
- call Print_msg( NVERB_ERROR, 'IO', 'WRITE_PROFILER_n', 'IPOS-1 /= IPACKSIZE (receiver side)', OLOCAL = .TRUE. )
+ CALL TZPROFILER%RECV_ALLOCATE( KFROM = IPROFPRCRANK(JS), KSTORE_CUR = ISTORE, KSTORE_MAX = ISTORE )
END IF
END IF
@@ -172,6 +150,8 @@ PROFILER: DO JS = 1, INUMPROF
END DO PROFILER
+! Deallocate arrays (if still allocated)
+IF ( TZPROFILER%NSTORE_MAX >= 0 ) CALL TZPROFILER%DATA_ARRAYS_DEALLOCATE( )
END SUBROUTINE WRITE_PROFILER_n
diff --git a/src/MNH/write_stationn.f90 b/src/MNH/write_stationn.f90
index 3279e3175..ecdc90dfd 100644
--- a/src/MNH/write_stationn.f90
+++ b/src/MNH/write_stationn.f90
@@ -67,15 +67,12 @@ INTEGER :: IERR
INTEGER :: JP, JS
INTEGER :: IDX
INTEGER :: INUMSTAT ! Total number of stations (for the current model)
-INTEGER :: IPACKSIZE ! Size of the ZPACK buffer
-INTEGER :: IPOS ! Position in the ZPACK buffer
INTEGER :: ISTORE
INTEGER, DIMENSION(:), ALLOCATABLE :: INSTATPRC ! Array to store the number of stations per process (for the current model)
INTEGER, DIMENSION(:), ALLOCATABLE :: ISTATIDS ! Intermediate array for MPI communication
INTEGER, DIMENSION(:), ALLOCATABLE :: ISTATPRCRANK ! Array to store the ranks of the processes where the stations are
INTEGER, DIMENSION(:), ALLOCATABLE :: IDS ! Array to store the station number to send
INTEGER, DIMENSION(:), ALLOCATABLE :: IDISP ! Array to store the displacements for MPI communications
-REAL, DIMENSION(:), ALLOCATABLE :: ZPACK ! Buffer to store raw data of a station (used for MPI communication)
TYPE(TSTATIONDATA) :: TZSTATION
!
!----------------------------------------------------------------------------
@@ -119,13 +116,6 @@ ISTORE = SIZE( TSTATIONS_TIME%TPDATES )
CALL TZSTATION%DATA_ARRAYS_ALLOCATE( ISTORE )
-!Determine the size of the ZPACK buffer used to transfer station data in 1 MPI communication
-IF ( ISNPROC > 1 ) THEN
- IPACKSIZE = TZSTATION%BUFFER_SIZE_COMPUTE( ISTORE )
-
- ALLOCATE( ZPACK(IPACKSIZE) )
-END IF
-
IDX = 1
STATION: DO JS = 1, INUMSTAT
@@ -139,24 +129,13 @@ STATION: DO JS = 1, INUMSTAT
!The station data is not on the writer process
IF ( ISP == ISTATPRCRANK(JS) ) THEN
! This process has the data and needs to send it to the writer process
- IPOS = 1
- CALL TSTATIONS(IDX)%BUFFER_PACK( ZPACK, IPOS, ISTORE )
-
- IF ( IPOS-1 /= IPACKSIZE ) &
- call Print_msg( NVERB_ERROR, 'IO', 'WRITE_STATION_n', 'IPOS-1 /= IPACKSIZE (sender side)', OLOCAL = .TRUE. )
-
- CALL TSTATIONS(IDX)%BUFFER_SEND( ZPACK, TPDIAFILE%NMASTER_RANK )
+ CALL TSTATIONS(IDX)%SEND_DEALLOCATE( KTO = TPDIAFILE%NMASTER_RANK, OSEND_SIZE_TO_RECEIVER = .FALSE. )
IDX = IDX + 1
ELSE IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
! This process is the writer and will receive the station data from its owner
- CALL TZSTATION%BUFFER_RECV( ZPACK, ISTATPRCRANK(JS) )
-
- IPOS = 1
- CALL TZSTATION%BUFFER_UNPACK( ZPACK, IPOS, ISTORE )
-
- IF ( IPOS-1 /= IPACKSIZE ) &
- call Print_msg( NVERB_WARNING, 'IO', 'WRITE_STATION_n', 'IPOS-1 /= IPACKSIZE (receiver side)', OLOCAL = .TRUE. )
+ ! Remark: allocation is already done and will be skipped in RECV_ALLOCATE
+ CALL TZSTATION%RECV_ALLOCATE( KFROM = ISTATPRCRANK(JS), KSTORE_CUR = ISTORE, KSTORE_MAX = ISTORE )
END IF
END IF
@@ -164,6 +143,9 @@ STATION: DO JS = 1, INUMSTAT
END DO STATION
+! Deallocate arrays (if still allocated)
+IF ( TZSTATION%NSTORE_MAX >= 0 ) CALL TZSTATION%DATA_ARRAYS_DEALLOCATE( )
+
END SUBROUTINE WRITE_STATION_n
! ##################################################
--
GitLab