From 31d55bf3fa1e80d6aed1d2c82ea6907f8846b6ad Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Thu, 12 Jan 2023 09:13:37 +0100
Subject: [PATCH] Philippe 12/01/2023: flyers: manage them only on the
processes where they are physically located
---
src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90 | 16 +-
src/MNH/aircraft_balloon.f90 | 831 ++++++++++++++++++--
src/MNH/aircraft_balloon_evol.f90 | 354 +++------
src/MNH/ini_aircraft.f90 | 27 +-
src/MNH/ini_aircraft_balloon.f90 | 430 ++++++----
src/MNH/ini_balloon.f90 | 89 ++-
src/MNH/ini_modeln.f90 | 6 +-
src/MNH/modd_aircraft_balloon.f90 | 13 +-
src/MNH/modeln.f90 | 4 +-
src/MNH/read_desfmn.f90 | 15 +-
src/MNH/write_aircraft_balloon.f90 | 108 ++-
src/MNH/write_balloonn.f90 | 43 +-
src/MNH/write_diachro.f90 | 20 +-
src/MNH/write_lfin.f90 | 3 +-
14 files changed, 1383 insertions(+), 576 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90
index ff1782c84..1858061ac 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -1861,12 +1861,22 @@ if ( tpfile%lmaster ) then
end if
if ( lflyer ) then
+ ! Remark: to work flyer data must be on the file master rank
+ ! This is currently ensured in WRITE_AIRCRAFT_BALLOON subroutine
do ji = 1, nballoons
- call Write_flyer_time_coord( tballoons(ji)%tballoon )
+ if ( associated( tballoons(ji)%tballoon ) ) then
+ call Write_flyer_time_coord( tballoons(ji)%tballoon )
+ else
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Coordvar_write_nc4','tballoon not associated' )
+ end if
end do
do ji = 1, naircrafts
- call Write_flyer_time_coord( taircrafts(ji)%taircraft )
+ if ( associated( taircrafts(ji)%taircraft ) ) then
+ call Write_flyer_time_coord( taircrafts(ji)%taircraft )
+ else
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Coordvar_write_nc4','taircraft not associated' )
+ end if
end do
end if
diff --git a/src/MNH/aircraft_balloon.f90 b/src/MNH/aircraft_balloon.f90
index 068d03cb2..f8ff487e0 100644
--- a/src/MNH/aircraft_balloon.f90
+++ b/src/MNH/aircraft_balloon.f90
@@ -1,12 +1,22 @@
-!MNH_LIC Copyright 2000-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
+! Author: Valery Masson (Meteo-France)
+! Original 15/05/2000
+! Modifications:
+! P. Lacarrere 03/2008: add 3D fluxes
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! P. Wautelet 06/2022: reorganize flyers
+!-----------------------------------------------------------------
! #####################
MODULE MODE_AIRCRAFT_BALLOON
! #####################
+USE MODE_MSG
+
IMPLICIT NONE
PRIVATE
@@ -15,6 +25,20 @@ 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
+
+INTEGER, PARAMETER :: NMODEL_FIX = 1
+INTEGER, PARAMETER :: NMODEL_MOB = 2
+
+INTEGER, PARAMETER :: NTYPE_AIRCRA = 0
+INTEGER, PARAMETER :: NTYPE_CVBALL = 1
+INTEGER, PARAMETER :: NTYPE_ISODEN = 2
+INTEGER, PARAMETER :: NTYPE_RADIOS = 4
+
+
CONTAINS
!
! #################################################################
@@ -23,56 +47,15 @@ CONTAINS
PU, PV, PW, PP, PTH, PR, PSV, PTKE, &
PTS, PRHODREF, PCIT, PSEA )
! #################################################################
-!
-!
-!!**** *AIRCRAFT_BALLOON* - monitor for balloons and aircrafts
-!!
-!! PURPOSE
-!! -------
-!
-!
-!!** METHOD
-!! ------
-!!
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! Valery Masson * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 15/05/2000
-!!
-!! March, 2008 (P.Lacarrere) Add 3D fluxes
-! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
-! P. Wautelet 06/2022: reorganize flyers
-! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
+! *AIRCRAFT_BALLOON* - monitor for balloons and aircrafts
+
USE MODD_AIRCRAFT_BALLOON
-!
USE MODD_TURB_FLUX_AIRCRAFT_BALLOON
-!
+
USE MODE_AIRCRAFT_BALLOON_EVOL, ONLY: AIRCRAFT_BALLOON_EVOL
-USE MODE_ll
-!
-!
+
IMPLICIT NONE
!
-!
!* 0.1 declarations of arguments
!
!
@@ -98,36 +81,216 @@ REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA
!
! 0.2 declaration of local variables
!
-INTEGER :: JI
+INTEGER :: JI
+LOGICAL, SAVE :: GFIRSTCALL = .TRUE.
!----------------------------------------------------------------------------
-IF(.NOT. ALLOCATED(XTHW_FLUX)) &
-ALLOCATE(XTHW_FLUX(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)))
-IF(.NOT. ALLOCATED(XRCW_FLUX)) &
-ALLOCATE(XRCW_FLUX(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)))
-IF(.NOT. ALLOCATED(XSVW_FLUX)) &
-ALLOCATE(XSVW_FLUX(SIZE(PSV,1),SIZE(PSV,2),SIZE(PSV,3),SIZE(PSV,4)))
-!
-DO JI = 1, NBALLOONS
- CALL AIRCRAFT_BALLOON_EVOL( PTSTEP, PZ, PMAP, PLONOR, PLATOR, &
- PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
- TBALLOONS(JI)%TBALLOON, PSEA )
-END DO
+
+CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'AIRCRAFT_BALLOON', 'called' )
+
+IF(.NOT. ALLOCATED(XTHW_FLUX)) ALLOCATE(XTHW_FLUX(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)))
+IF(.NOT. ALLOCATED(XRCW_FLUX)) ALLOCATE(XRCW_FLUX(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)))
+IF(.NOT. ALLOCATED(XSVW_FLUX)) ALLOCATE(XSVW_FLUX(SIZE(PSV,1),SIZE(PSV,2),SIZE(PSV,3),SIZE(PSV,4)))
+
+IF ( NBALLOONS > 0 ) THEN
+ IF ( GFIRSTCALL ) CALL BALLOONS_INIT_POSITIONS()
+ NRANKCUR_BALLOON(:) = NRANKNXT_BALLOON(:)
+ NRANKNXT_BALLOON(:) = 0
+
+ DO JI = 1, NBALLOONS
+ IF ( ASSOCIATED( TBALLOONS(JI)%TBALLOON ) ) THEN
+ CALL AIRCRAFT_BALLOON_EVOL( PTSTEP, PZ, PMAP, PLONOR, PLATOR, &
+ PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
+ TBALLOONS(JI)%TBALLOON, NRANKCUR_BALLOON(JI), NRANKNXT_BALLOON(JI), &
+ PSEA )
+ END IF
+ END DO
+
+ CALL BALLOONS_MOVE_TO_NEW_RANKS()
+
+END IF
!
+IF ( NAIRCRAFTS > 0 ) THEN
+ IF ( GFIRSTCALL ) CALL AIRCRAFTS_INIT_POSITIONS()
+ NRANKCUR_AIRCRAFT(:) = NRANKNXT_AIRCRAFT(:)
+ NRANKNXT_AIRCRAFT(:) = 0
+
+ DO JI = 1, NAIRCRAFTS
+ IF ( ASSOCIATED( TAIRCRAFTS(JI)%TAIRCRAFT ) ) THEN
+ CALL AIRCRAFT_BALLOON_EVOL( PTSTEP, PZ, PMAP, PLONOR, PLATOR, &
+ PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
+ TAIRCRAFTS(JI)%TAIRCRAFT, NRANKCUR_AIRCRAFT(JI), NRANKNXT_AIRCRAFT(JI), &
+ PSEA )
+ END IF
+ END DO
+
+ CALL AIRCRAFTS_MOVE_TO_NEW_RANKS()
+END IF
+
+GFIRSTCALL = .FALSE.
+
+CONTAINS
+
+!----------------------------------------------------------------------------
+SUBROUTINE AIRCRAFTS_INIT_POSITIONS()
+
+USE MODD_DYN_n, ONLY: DYN_MODEL
+USE MODD_IO, ONLY: ISP
+USE MODD_TIME_n, ONLY: TDTCUR
+
+USE MODE_AIRCRAFT_BALLOON_EVOL, ONLY: AIRCRAFT_COMPUTE_POSITION, FLYER_GET_RANK_MODEL_ISCRASHED
+USE MODE_DATETIME
+
+INTEGER :: IMODEL
+REAL :: ZDELTATIME
+TYPE(DATE_TIME) :: TZDATE
+TYPE(TAIRCRAFTDATA), POINTER :: TZAIRCRAFT
+
+! Set next rank to 0 (necessary for MPI_ALLREDUCE)
+NRANKNXT_AIRCRAFT(:) = 0
+
+IF ( ISP == NFLYER_DEFAULT_RANK ) THEN
+ DO JI = 1, NAIRCRAFTS
+ IF ( .NOT. ASSOCIATED( TAIRCRAFTS(JI)%TAIRCRAFT ) ) &
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'AIRCRAFT_BALLOON', 'aircraft structure not associated' )
+
+ ! Compute position at take-off (or at first timestep in flight)
+ TZAIRCRAFT => TAIRCRAFTS(JI)%TAIRCRAFT
+
+ ! Determine moment of the first positioning
+ ! This is done at first call of this subroutine and therefore not necessarily on the correct model
+ IF ( TDTCUR < TZAIRCRAFT%TLAUNCH ) THEN
+ ! Moment is the first timestep since launch date
+ ZDELTATIME = TZAIRCRAFT%TLAUNCH - TDTCUR + 1.E-8
+ IF ( TZAIRCRAFT%CMODEL == 'FIX' ) THEN
+ IMODEL = TZAIRCRAFT%NMODEL
+ ELSE ! 'MOB'
+ IMODEL = 1
+ END IF
+ TZDATE = TDTCUR + INT( ZDELTATIME / DYN_MODEL(IMODEL)%XTSTEP ) * DYN_MODEL(IMODEL)%XTSTEP
+ ELSE IF ( TDTCUR > TZAIRCRAFT%TLAND ) THEN
+ ! Nothing to do
+ ! Aircraft will never be in flight in this run. Data will remain on the initial process.
+ ELSE
+ ! Aircraft is already in flight at the beginning of the run
+ TZDATE = TDTCUR
+ END IF
+
+ CALL AIRCRAFT_COMPUTE_POSITION( TZDATE, TZAIRCRAFT )
+
+ ! Get rank of the process where the aircraft is at this moment and the model number
+ CALL FLYER_GET_RANK_MODEL_ISCRASHED( TZAIRCRAFT )
+
+ NRANKNXT_AIRCRAFT(JI) = TZAIRCRAFT%NRANK_CUR
+ END DO
+END IF
+
+CALL AIRCRAFTS_MOVE_TO_NEW_RANKS()
+
+END SUBROUTINE AIRCRAFTS_INIT_POSITIONS
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+SUBROUTINE AIRCRAFTS_MOVE_TO_NEW_RANKS()
+
+USE MODD_IO, ONLY: ISP
+USE MODD_MPIF
+USE MODD_PRECISION, ONLY: MNHINT_MPI
+USE MODD_VAR_ll, ONLY: NMNH_COMM_WORLD
+
+INTEGER :: IERR
+
+CALL MPI_ALLREDUCE( MPI_IN_PLACE, NRANKNXT_AIRCRAFT, NAIRCRAFTS, MNHINT_MPI, MPI_MAX, NMNH_COMM_WORLD, IERR )
DO JI = 1, NAIRCRAFTS
- CALL AIRCRAFT_BALLOON_EVOL( PTSTEP, PZ, PMAP, PLONOR, PLATOR, &
- PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
- TAIRCRAFTS(JI)%TAIRCRAFT, PSEA )
+ 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) )
+ 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) )
+ END IF
+ END IF
END DO
-!
+
+END SUBROUTINE AIRCRAFTS_MOVE_TO_NEW_RANKS
!----------------------------------------------------------------------------
-!
-END SUBROUTINE AIRCRAFT_BALLOON
+!----------------------------------------------------------------------------
+SUBROUTINE BALLOONS_INIT_POSITIONS()
+
+USE MODD_IO, ONLY: ISP
+
+USE MODE_AIRCRAFT_BALLOON_EVOL, ONLY: FLYER_GET_RANK_MODEL_ISCRASHED
+TYPE(TBALLOONDATA), POINTER :: TZBALLOON
+! Set next rank to 0 (necessary for MPI_ALLREDUCE)
+NRANKNXT_BALLOON(:) = 0
+
+IF ( ISP == NFLYER_DEFAULT_RANK ) THEN
+ DO JI = 1, NBALLOONS
+ IF ( .NOT. ASSOCIATED( TBALLOONS(JI)%TBALLOON ) ) &
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'AIRCRAFT_BALLOON', 'balloon structure not associated' )
+
+ TZBALLOON => TBALLOONS(JI)%TBALLOON
+
+ ! Initialize model number (and rank)
+ ! This is not done in initialisation phase because some data is not yet available at this early stage
+ ! (XXHAT_ll of all models are needed by FIND_PROCESS_AND_MODEL_FROM_XY_POS)
+ IF ( .NOT. TZBALLOON%LPOSITION_INIT ) THEN
+ TZBALLOON%LPOSITION_INIT = .TRUE.
+ ! Get rank of the process where the balloon is and the model number
+ CALL FLYER_GET_RANK_MODEL_ISCRASHED( TZBALLOON, PX = TZBALLOON%XXLAUNCH, PY = TZBALLOON%XYLAUNCH )
+ IF ( TZBALLOON%LCRASH ) THEN
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON', 'balloon ' // TRIM( TZBALLOON%CTITLE ) &
+ // ': launch coordinates are outside of horizontal physical domain' )
+ END IF
+ ELSE
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'AIRCRAFT_BALLOON', 'balloon ' // TRIM( TZBALLOON%CTITLE ) &
+ // ': position has already been initialized' )
+ END IF
+
+ NRANKNXT_BALLOON(JI) = TZBALLOON%NRANK_CUR
+ END DO
+END IF
+
+CALL BALLOONS_MOVE_TO_NEW_RANKS()
+
+END SUBROUTINE BALLOONS_INIT_POSITIONs
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+SUBROUTINE BALLOONS_MOVE_TO_NEW_RANKS()
+
+USE MODD_IO, ONLY: ISP
+USE MODD_MPIF
+USE MODD_PRECISION, ONLY: MNHINT_MPI
+USE MODD_VAR_ll, ONLY: NMNH_COMM_WORLD
+
+INTEGER :: IERR
+
+CALL MPI_ALLREDUCE( MPI_IN_PLACE, NRANKNXT_BALLOON, NBALLOONS, MNHINT_MPI, MPI_MAX, NMNH_COMM_WORLD, IERR )
+
+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) )
+ 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) )
+ END IF
+ END IF
+END DO
+
+END SUBROUTINE BALLOONS_MOVE_TO_NEW_RANKS
+!----------------------------------------------------------------------------
+END SUBROUTINE AIRCRAFT_BALLOON
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
SUBROUTINE AIRCRAFT_BALLOON_LONGTYPE_GET( TPFLYER, HLONGTYPE )
USE MODD_AIRCRAFT_BALLOON, ONLY: taircraftdata, tballoondata, TFLYERDATA
-USE MODE_MSG
+IMPLICIT NONE
CLASS(TFLYERDATA), INTENT(IN) :: TPFLYER
CHARACTER(LEN=*), INTENT(OUT) :: HLONGTYPE
@@ -162,5 +325,541 @@ if ( Len_trim( ytype ) > Len( HLONGTYPE ) ) &
HLONGTYPE = Trim( ytype )
END SUBROUTINE AIRCRAFT_BALLOON_LONGTYPE_GET
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+
+SUBROUTINE FLYER_SEND( TPFLYER, KTO )
+
+USE MODD_AIRCRAFT_BALLOON, ONLY: TAIRCRAFTDATA, TBALLOONDATA, TFLYERDATA
+USE MODD_CONF_n, ONLY: NRR
+USE MODD_DIM_n, ONLY: NKMAX
+USE MODD_IO, ONLY: ISP
+USE MODD_MPIF
+USE MODD_NSV, ONLY: NSV
+USE MODD_PARAMETERS, ONLY: JPVEXT
+USE MODD_PARAM_n, ONLY: CCLOUD
+USE MODD_PRECISION, ONLY: MNHINT_MPI, MNHREAL_MPI
+USE MODD_VAR_LL, ONLY: NMNH_COMM_WORLD
+
+USE MODE_DATETIME
+
+IMPLICIT NONE
+
+CLASS(TFLYERDATA), INTENT(INOUT) :: TPFLYER
+INTEGER, INTENT(IN) :: KTO ! Process to which to send flyer data
+
+CHARACTER(LEN=10) :: YFROM, YTO
+INTEGER :: IERR
+INTEGER :: IKU ! number of vertical levels
+INTEGER :: IPACKSIZE ! Size of the ZPACK buffer
+INTEGER :: IPOS ! Position in the ZPACK buffer
+INTEGER :: IPOSAIR
+INTEGER :: ISTORE_CUR
+INTEGER :: JI
+INTEGER, DIMENSION(3) :: ISTORES
+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%CTITLE)//': '//TRIM(YFROM)//'->'//TRIM(YTO), &
+ OLOCAL = .TRUE. )
+
+IKU = NKMAX + 2 * JPVEXT
+
+ISTORE_CUR = TPFLYER%TFLYER_TIME%N_CUR
+
+! Prepare data to send
+
+! Determine size of data to send
+! Characters, integers and logicals will be converted to reals. CMODEL and CTYPE will be coded by 1 real
+IPACKSIZE = 16 + LEN(TPFLYER%CTITLE) + ISTORE_CUR * ( 18 + NSV * 2 + IKU * ( 9 + NRR * 2 ) )
+IF ( CCLOUD == 'LIMA' ) IPACKSIZE = IPACKSIZE + ISTORE_CUR * IKU * 2
+
+SELECT TYPE ( TPFLYER )
+ CLASS IS ( TAIRCRAFTDATA )
+ IPACKSIZE = IPACKSIZE + 5 + TPFLYER%NPOS * 6
+
+ CLASS IS ( TBALLOONDATA )
+ IPACKSIZE = IPACKSIZE + 15
+END SELECT
+
+! Communication is in 2 phases:
+! 1) first send the ISTORE dimension (optimisation: only what has already been written = N_CUR)
+! 2) send data
+ISTORES(1) = ISTORE_CUR ! Number of currently used store positions
+ISTORES(2) = SIZE( TPFLYER%NMODELHIST ) ! Total number of store positions
+ISTORES(3) = IPACKSIZE
+CALL MPI_SEND( ISTORES, 3, MNHINT_MPI, KTO-1, NTAG_NCUR, NMNH_COMM_WORLD, IERR )
+
+ALLOCATE( ZPACK(IPACKSIZE) )
+
+! Fill buffer / pack data
+IPOS = 1
+IF ( TPFLYER%CMODEL == 'FIX' ) THEN
+ ZPACK(IPOS) = NMODEL_FIX
+ELSE
+ ZPACK(IPOS) = NMODEL_MOB
+END IF
+IPOS = IPOS + 1
+
+ZPACK(IPOS) = TPFLYER%NMODEL; IPOS = IPOS + 1
+ZPACK(IPOS) = TPFLYER%NID; IPOS = IPOS + 1
+
+SELECT CASE( TPFLYER%CTYPE )
+ CASE( 'AIRCRA' )
+ ZPACK(IPOS) = NTYPE_AIRCRA
+ CASE( 'CVBALL' )
+ ZPACK(IPOS) = NTYPE_CVBALL
+ CASE( 'ISODEN' )
+ ZPACK(IPOS) = NTYPE_ISODEN
+ CASE( 'RADIOS' )
+ ZPACK(IPOS) = NTYPE_RADIOS
+ CASE DEFAULT
+ CALL PRINT_MSG( NVERB_FATAL, 'FLYER_SEND', 'invalid CTYPE for flyer' )
+END SELECT
+IPOS = IPOS + 1
+
+! Convert title characters to integers
+DO JI = 1, LEN(TPFLYER%CTITLE)
+ ZPACK(IPOS) = ICHAR( TPFLYER%CTITLE(JI:JI) )
+ IPOS = IPOS + 1
+END DO
+
+ZPACK(IPOS) = TPFLYER%TLAUNCH - TPREFERENCE_DATE; IPOS = IPOS + 1
+IF ( TPFLYER%LCRASH ) THEN
+ ZPACK(IPOS) = 1.d0
+ELSE
+ ZPACK(IPOS) = 0.d0
+END IF
+IPOS = IPOS + 1
+
+ZPACK(IPOS) = TPFLYER%NCRASH; IPOS = IPOS + 1
+
+IF ( TPFLYER%LFLY ) THEN
+ ZPACK(IPOS) = 1.d0
+ELSE
+ ZPACK(IPOS) = 0.d0
+END IF
+IPOS = IPOS + 1
+
+IF ( TPFLYER%LSTORE ) THEN
+ ZPACK(IPOS) = 1.d0
+ELSE
+ ZPACK(IPOS) = 0.d0
+END IF
+IPOS = IPOS + 1
+
+ZPACK(IPOS) = TPFLYER%TFLYER_TIME%N_CUR; IPOS = IPOS + 1
+ZPACK(IPOS) = TPFLYER%TFLYER_TIME%XTSTEP; IPOS = IPOS + 1
+DO JI = 1, ISTORE_CUR
+ ZPACK(IPOS) = TPFLYER%TFLYER_TIME%TPDATES(JI) - TPREFERENCE_DATE; IPOS = IPOS + 1
+END DO
+
+ZPACK(IPOS) = TPFLYER%XX_CUR; IPOS = IPOS + 1
+ZPACK(IPOS) = TPFLYER%XY_CUR; IPOS = IPOS + 1
+ZPACK(IPOS) = TPFLYER%XZ_CUR; IPOS = IPOS + 1
+ZPACK(IPOS) = TPFLYER%XP_CUR; IPOS = IPOS + 1
+
+ZPACK(IPOS) = TPFLYER%NRANK_CUR; IPOS = IPOS + 1
+
+ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%NMODELHIST(1:ISTORE_CUR); IPOS = IPOS + ISTORE_CUR
+
+ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XX(1:ISTORE_CUR) ; IPOS = IPOS + ISTORE_CUR
+ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XY(1:ISTORE_CUR) ; IPOS = IPOS + ISTORE_CUR
+ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XZ(1:ISTORE_CUR) ; IPOS = IPOS + ISTORE_CUR
+ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XLAT(1:ISTORE_CUR) ; IPOS = IPOS + ISTORE_CUR
+ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XLON(1:ISTORE_CUR) ; IPOS = IPOS + ISTORE_CUR
+ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XZON(1:ISTORE_CUR) ; IPOS = IPOS + ISTORE_CUR
+ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XMER(1:ISTORE_CUR) ; IPOS = IPOS + ISTORE_CUR
+ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XW(1:ISTORE_CUR) ; IPOS = IPOS + ISTORE_CUR
+ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XP(1:ISTORE_CUR) ; IPOS = IPOS + ISTORE_CUR
+ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XTKE(1:ISTORE_CUR) ; IPOS = IPOS + ISTORE_CUR
+ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XTKE_DISS(1:ISTORE_CUR) ; IPOS = IPOS + ISTORE_CUR
+ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XTH(1:ISTORE_CUR) ; IPOS = IPOS + ISTORE_CUR
+
+ZPACK(IPOS:IPOS+ISTORE_CUR*NRR-1) = RESHAPE( TPFLYER%XR(1:ISTORE_CUR,1:NRR), [ISTORE_CUR*NRR] ) ; IPOS = IPOS + ISTORE_CUR * NRR
+ZPACK(IPOS:IPOS+ISTORE_CUR*NSV-1) = RESHAPE( TPFLYER%XSV(1:ISTORE_CUR,1:NSV), [ISTORE_CUR*NSV] ) ; IPOS = IPOS + ISTORE_CUR * NSV
+ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1) = RESHAPE( TPFLYER%XRTZ(1:ISTORE_CUR,1:IKU), [ISTORE_CUR*IKU] ) ; IPOS = IPOS + ISTORE_CUR * IKU
+
+ZPACK(IPOS:IPOS+ISTORE_CUR*IKU*NRR-1) = RESHAPE( TPFLYER%XRZ(1:ISTORE_CUR,1:IKU,1:NRR), [ISTORE_CUR*IKU*NRR] )
+IPOS = IPOS + ISTORE_CUR * IKU * NRR
+
+ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1) = RESHAPE( TPFLYER%XFFZ(1:ISTORE_CUR,1:IKU), [ISTORE_CUR*IKU] ) ; IPOS = IPOS + ISTORE_CUR * IKU
+ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1) = RESHAPE( TPFLYER%XIWCZ(1:ISTORE_CUR,1:IKU), [ISTORE_CUR*IKU] ); IPOS = IPOS + ISTORE_CUR * IKU
+ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1) = RESHAPE( TPFLYER%XLWCZ(1:ISTORE_CUR,1:IKU), [ISTORE_CUR*IKU] ); IPOS = IPOS + ISTORE_CUR * IKU
+ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1) = RESHAPE( TPFLYER%XCIZ(1:ISTORE_CUR,1:IKU), [ISTORE_CUR*IKU] ) ; IPOS = IPOS + ISTORE_CUR * IKU
+IF ( CCLOUD == 'LIMA' ) THEN
+ ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1) = RESHAPE( TPFLYER%XCCZ(1:ISTORE_CUR,1:IKU), [ISTORE_CUR*IKU] );IPOS = IPOS + ISTORE_CUR * IKU
+ ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1) = RESHAPE( TPFLYER%XCRZ(1:ISTORE_CUR,1:IKU), [ISTORE_CUR*IKU] );IPOS = IPOS + ISTORE_CUR * IKU
+END IF
+ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1) = RESHAPE( TPFLYER%XCRARE(1:ISTORE_CUR,1:IKU), [ISTORE_CUR*IKU] );IPOS = IPOS + ISTORE_CUR * IKU
+
+ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1) = RESHAPE( TPFLYER%XCRARE_ATT(1:ISTORE_CUR,1:IKU), [ISTORE_CUR*IKU] )
+IPOS = IPOS + ISTORE_CUR * IKU
+
+ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1) = RESHAPE( TPFLYER%XWZ(1:ISTORE_CUR,1:IKU), [ISTORE_CUR*IKU] ) ; IPOS = IPOS + ISTORE_CUR * IKU
+ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1) = RESHAPE( TPFLYER%XZZ(1:ISTORE_CUR,1:IKU), [ISTORE_CUR*IKU] ) ; IPOS = IPOS + ISTORE_CUR * IKU
+
+ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XZS(1:ISTORE_CUR); IPOS = IPOS + ISTORE_CUR
+ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XTSRAD(1:ISTORE_CUR); IPOS = IPOS + ISTORE_CUR
+
+ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XTHW_FLUX(1:ISTORE_CUR); IPOS = IPOS + ISTORE_CUR
+ZPACK(IPOS:IPOS+ISTORE_CUR-1) = TPFLYER%XRCW_FLUX(1:ISTORE_CUR); IPOS = IPOS + ISTORE_CUR
+
+ZPACK(IPOS:IPOS+ISTORE_CUR*NSV-1) = RESHAPE( TPFLYER%XSVW_FLUX(1:ISTORE_CUR,1:NSV), [ISTORE_CUR*NSV] )
+IPOS = IPOS + ISTORE_CUR * NSV
+
+SELECT TYPE ( TPFLYER )
+ CLASS IS ( TAIRCRAFTDATA )
+ IF ( TPFLYER%LTOOKOFF ) THEN
+ ZPACK(IPOS) = 1.d0
+ ELSE
+ ZPACK(IPOS) = 0.d0
+ END IF
+ IPOS = IPOS + 1
+
+ IF ( TPFLYER%LALTDEF ) THEN
+ ZPACK(IPOS) = 1.d0
+ ELSE
+ ZPACK(IPOS) = 0.d0
+ END IF
+ IPOS = IPOS + 1
+
+ ZPACK(IPOS) = TPFLYER%NPOS; IPOS = IPOS + 1
+ ZPACK(IPOS) = TPFLYER%NPOSCUR; IPOS = IPOS + 1
+
+ IPOSAIR = TPFLYER%NPOS
+
+ ZPACK(IPOS:IPOS+IPOSAIR-1) = TPFLYER%XPOSLAT(1:IPOSAIR) ; IPOS = IPOS + IPOSAIR
+ ZPACK(IPOS:IPOS+IPOSAIR-1) = TPFLYER%XPOSLON(1:IPOSAIR) ; IPOS = IPOS + IPOSAIR
+ ZPACK(IPOS:IPOS+IPOSAIR-1) = TPFLYER%XPOSX(1:IPOSAIR) ; IPOS = IPOS + IPOSAIR
+ ZPACK(IPOS:IPOS+IPOSAIR-1) = TPFLYER%XPOSY(1:IPOSAIR) ; IPOS = IPOS + IPOSAIR
+ IF ( TPFLYER%LALTDEF ) THEN
+ ZPACK(IPOS:IPOS+IPOSAIR-1) = TPFLYER%XPOSP(1:IPOSAIR) ; IPOS = IPOS + IPOSAIR
+ ELSE
+ ZPACK(IPOS:IPOS+IPOSAIR-1) = TPFLYER%XPOSZ(1:IPOSAIR) ; IPOS = IPOS + IPOSAIR
+ ENDIF
+ ZPACK(IPOS:IPOS+IPOSAIR-1) = TPFLYER%XPOSTIME(1:IPOSAIR) ; IPOS = IPOS + IPOSAIR
+
+ ZPACK(IPOS) = TPFLYER%TLAND - TPREFERENCE_DATE; IPOS = IPOS + 1
+
+ CLASS IS ( TBALLOONDATA )
+ IF ( TPFLYER%LPOSITION_INIT ) THEN
+ ZPACK(IPOS) = 1.d0
+ ELSE
+ ZPACK(IPOS) = 0.d0
+ END IF
+ IPOS = IPOS + 1
+
+ ZPACK(IPOS) = TPFLYER%XLATLAUNCH ; IPOS = IPOS + 1
+ ZPACK(IPOS) = TPFLYER%XLONLAUNCH ; IPOS = IPOS + 1
+ ZPACK(IPOS) = TPFLYER%XXLAUNCH ; IPOS = IPOS + 1
+ ZPACK(IPOS) = TPFLYER%XYLAUNCH ; IPOS = IPOS + 1
+ ZPACK(IPOS) = TPFLYER%XALTLAUNCH ; IPOS = IPOS + 1
+ ZPACK(IPOS) = TPFLYER%XWASCENT ; IPOS = IPOS + 1
+ ZPACK(IPOS) = TPFLYER%XRHO ; IPOS = IPOS + 1
+ ZPACK(IPOS) = TPFLYER%XPRES ; IPOS = IPOS + 1
+ ZPACK(IPOS) = TPFLYER%XDIAMETER ; IPOS = IPOS + 1
+ ZPACK(IPOS) = TPFLYER%XAERODRAG ; IPOS = IPOS + 1
+ ZPACK(IPOS) = TPFLYER%XINDDRAG ; IPOS = IPOS + 1
+ ZPACK(IPOS) = TPFLYER%XVOLUME ; IPOS = IPOS + 1
+ ZPACK(IPOS) = TPFLYER%XMASS ; IPOS = IPOS + 1
+
+ ZPACK(IPOS) = TPFLYER%TPOS_CUR - TPREFERENCE_DATE; IPOS = IPOS + 1
+
+END SELECT
+
+IF ( IPOS-1 /= IPACKSIZE ) &
+ call Print_msg( NVERB_WARNING, 'IO', 'FLYER_SEND', 'IPOS-1 /= IPACKSIZE (sender side)', OLOCAL = .TRUE. )
+
+! Send packed data
+CALL MPI_SEND( ZPACK, IPACKSIZE, MNHREAL_MPI, KTO-1, NTAG_PACK, NMNH_COMM_WORLD, IERR )
+
+END SUBROUTINE FLYER_SEND
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+SUBROUTINE FLYER_SEND_AND_DEALLOCATE( TPFLYER, KTO )
+
+USE MODD_AIRCRAFT_BALLOON, ONLY: TFLYERDATA
+USE MODD_IO, ONLY: ISP
+
+USE MODE_INI_AIRCRAFT_BALLOON, ONLY: DEALLOCATE_FLYER
+
+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%CTITLE)//': '//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 DEALLOCATE_FLYER( TPFLYER )
+
+END SUBROUTINE FLYER_SEND_AND_DEALLOCATE
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+SUBROUTINE FLYER_RECV_AND_ALLOCATE( TPFLYER, KFROM )
+
+USE MODD_AIRCRAFT_BALLOON, ONLY: TAIRCRAFTDATA, TBALLOONDATA, TFLYERDATA
+USE MODD_CONF_n, ONLY: NRR
+USE MODD_DIM_n, ONLY: NKMAX
+USE MODD_IO, ONLY: ISP
+USE MODD_MPIF
+USE MODD_NSV, ONLY: NSV
+USE MODD_PARAMETERS, ONLY: JPVEXT
+USE MODD_PARAM_n, ONLY: CCLOUD
+USE MODD_PRECISION, ONLY: MNHINT_MPI, MNHREAL_MPI
+USE MODD_VAR_LL, ONLY: NMNH_COMM_WORLD
+
+USE MODE_DATETIME
+USE MODE_INI_AIRCRAFT_BALLOON, ONLY: ALLOCATE_FLYER
+
+IMPLICIT NONE
+
+CLASS(TFLYERDATA), INTENT(INOUT) :: TPFLYER
+INTEGER, INTENT(IN) :: KFROM ! Process from which to receive flyer data
+
+CHARACTER(LEN=10) :: YFROM, YTO
+INTEGER :: IERR
+INTEGER :: IKU ! number of vertical levels
+INTEGER :: IPOSAIR
+INTEGER :: ISTORE_CUR
+INTEGER :: ISTORE_TOT
+INTEGER :: IPACKSIZE ! Size of the ZPACK buffer
+INTEGER :: IPOS ! Position in the ZPACK buffer
+INTEGER :: JI
+INTEGER, DIMENSION(3) :: ISTORES
+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. )
+
+IKU = NKMAX + 2 * JPVEXT
+
+! Receive data (useful dimensions)
+CALL MPI_RECV( ISTORES, 3, MNHINT_MPI, KFROM-1, NTAG_NCUR, NMNH_COMM_WORLD, MPI_STATUS_IGNORE, IERR )
+
+ISTORE_CUR = ISTORES(1)
+ISTORE_TOT = ISTORES(2)
+IPACKSIZE = ISTORES(3)
+
+! Allocate receive buffer
+ALLOCATE( ZPACK(IPACKSIZE) )
+
+! Receive packed data
+CALL MPI_RECV( ZPACK, IPACKSIZE, MNHREAL_MPI, KFROM-1, NTAG_PACK, NMNH_COMM_WORLD, MPI_STATUS_IGNORE, IERR )
+
+! Allocation of flyer must be done only once number of stores is known
+CALL ALLOCATE_FLYER( TPFLYER, ISTORE_TOT )
+
+! Unpack data
+IPOS = 1
+
+IF ( NINT( ZPACK(IPOS) ) == NMODEL_FIX ) THEN
+ TPFLYER%CMODEL = 'FIX'
+ELSE
+ TPFLYER%CMODEL = 'MOB'
+END IF
+IPOS = IPOS + 1
+
+TPFLYER%NMODEL = NINT( ZPACK(IPOS) ); IPOS = IPOS + 1
+TPFLYER%NID = NINT( ZPACK(IPOS) ); IPOS = IPOS + 1
+
+SELECT CASE( NINT( ZPACK(IPOS) ) )
+ CASE(NTYPE_AIRCRA )
+ TPFLYER%CTYPE = 'AIRCRA'
+ CASE( NTYPE_CVBALL )
+ TPFLYER%CTYPE = 'CVBALL'
+ CASE( NTYPE_ISODEN )
+ TPFLYER%CTYPE = 'ISODEN'
+ CASE( NTYPE_RADIOS )
+ TPFLYER%CTYPE = 'RADIOS'
+ CASE DEFAULT
+ CALL PRINT_MSG( NVERB_FATAL, 'FLYER_RECV_AND_ALLOCATE', 'invalid CTYPE for flyer' )
+END SELECT
+IPOS = IPOS + 1
+
+! Convert integers to characters for title
+DO JI = 1, LEN(TPFLYER%CTITLE)
+ TPFLYER%CTITLE(JI:JI) = ACHAR( NINT( ZPACK(IPOS) ) )
+ IPOS = IPOS + 1
+END DO
+
+! Print full message only now (flyer title was not yet known)
+CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'FLYER_RECV_AND_ALLOCATE', &
+ 'receive flyer '//TRIM(TPFLYER%CTITLE)//': '//TRIM(YFROM)//'->'//TRIM(YTO), OLOCAL = .TRUE. )
+
+TPFLYER%TLAUNCH = TPREFERENCE_DATE + ZPACK(IPOS); IPOS = IPOS + 1
+
+IF ( NINT( ZPACK(IPOS) ) == 0 ) THEN
+ TPFLYER%LCRASH = .FALSE.
+ELSE
+ TPFLYER%LCRASH = .TRUE.
+END IF
+IPOS = IPOS + 1
+
+TPFLYER%NCRASH = NINT( ZPACK(IPOS) ); IPOS = IPOS + 1
+
+IF ( NINT( ZPACK(IPOS) ) == 0 ) THEN
+ TPFLYER%LFLY = .FALSE.
+ELSE
+ TPFLYER%LFLY = .TRUE.
+END IF
+IPOS = IPOS + 1
+
+IF ( NINT( ZPACK(IPOS) ) == 0 ) THEN
+ TPFLYER%LSTORE = .FALSE.
+ELSE
+ TPFLYER%LSTORE = .TRUE.
+END IF
+IPOS = IPOS + 1
+
+TPFLYER%TFLYER_TIME%N_CUR = NINT( ZPACK(IPOS) ); IPOS = IPOS + 1
+TPFLYER%TFLYER_TIME%XTSTEP = ZPACK(IPOS); IPOS = IPOS + 1
+
+DO JI = 1, ISTORE_CUR
+ TPFLYER%TFLYER_TIME%TPDATES(JI) = TPREFERENCE_DATE + ZPACK(IPOS); IPOS = IPOS + 1
+END DO
+
+TPFLYER%XX_CUR = ZPACK(IPOS); IPOS = IPOS + 1
+TPFLYER%XY_CUR = ZPACK(IPOS); IPOS = IPOS + 1
+TPFLYER%XZ_CUR = ZPACK(IPOS); IPOS = IPOS + 1
+TPFLYER%XP_CUR = ZPACK(IPOS); IPOS = IPOS + 1
+
+TPFLYER%NRANK_CUR = NINT( ZPACK(IPOS) ); IPOS = IPOS + 1
+
+TPFLYER%NMODELHIST(1:ISTORE_CUR) = NINT( ZPACK(IPOS:IPOS+ISTORE_CUR-1) ) ; IPOS = IPOS + ISTORE_CUR
+
+TPFLYER%XX(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
+TPFLYER%XY(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
+TPFLYER%XZ(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
+TPFLYER%XLAT(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
+TPFLYER%XLON(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
+TPFLYER%XZON(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
+TPFLYER%XMER(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
+TPFLYER%XW(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
+TPFLYER%XP(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
+TPFLYER%XTKE(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
+TPFLYER%XTKE_DISS(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
+TPFLYER%XTH(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
+
+TPFLYER%XR(1:ISTORE_CUR,1:NRR) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*NRR-1), [ISTORE_CUR,NRR] ) ; IPOS = IPOS + ISTORE_CUR * NRR
+TPFLYER%XSV(1:ISTORE_CUR,1:NSV) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*NSV-1), [ISTORE_CUR,NSV] ) ; IPOS = IPOS + ISTORE_CUR * NSV
+TPFLYER%XRTZ(1:ISTORE_CUR,1:IKU) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1), [ISTORE_CUR,IKU] ) ; IPOS = IPOS + ISTORE_CUR * IKU
+
+TPFLYER%XRZ(1:ISTORE_CUR,1:IKU,1:NRR) = RESHAPE( ZPACK(IPOS:IPOS+(ISTORE_CUR*IKU*NRR)-1), [ISTORE_CUR,IKU,NRR] )
+IPOS = IPOS + ISTORE_CUR * IKU * NRR
+
+TPFLYER%XFFZ(1:ISTORE_CUR,1:IKU) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1), [ISTORE_CUR,IKU] ) ; IPOS = IPOS + ISTORE_CUR * IKU
+TPFLYER%XIWCZ(1:ISTORE_CUR,1:IKU) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1), [ISTORE_CUR,IKU] ) ; IPOS = IPOS + ISTORE_CUR * IKU
+TPFLYER%XLWCZ(1:ISTORE_CUR,1:IKU) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1), [ISTORE_CUR,IKU] ) ; IPOS = IPOS + ISTORE_CUR * IKU
+TPFLYER%XCIZ(1:ISTORE_CUR,1:IKU) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1), [ISTORE_CUR,IKU] ) ; IPOS = IPOS + ISTORE_CUR * IKU
+IF ( CCLOUD == 'LIMA' ) THEN
+ TPFLYER%XCCZ(1:ISTORE_CUR,1:IKU) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1), [ISTORE_CUR,IKU] ); IPOS = IPOS + ISTORE_CUR * IKU
+ TPFLYER%XCRZ(1:ISTORE_CUR,1:IKU) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1), [ISTORE_CUR,IKU] ); IPOS = IPOS + ISTORE_CUR * IKU
+END IF
+TPFLYER%XCRARE(1:ISTORE_CUR,1:IKU) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1), [ISTORE_CUR,IKU] ); IPOS = IPOS + ISTORE_CUR * IKU
+
+TPFLYER%XCRARE_ATT(1:ISTORE_CUR,1:IKU) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1), [ISTORE_CUR,IKU] )
+IPOS = IPOS + ISTORE_CUR * IKU
+
+TPFLYER%XWZ(1:ISTORE_CUR,1:IKU) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1), [ISTORE_CUR,IKU] ) ; IPOS = IPOS + ISTORE_CUR * IKU
+TPFLYER%XZZ(1:ISTORE_CUR,1:IKU) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*IKU-1), [ISTORE_CUR,IKU] ) ; IPOS = IPOS + ISTORE_CUR * IKU
+
+TPFLYER%XZS(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
+TPFLYER%XTSRAD(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
+
+TPFLYER%XTHW_FLUX(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
+TPFLYER%XRCW_FLUX(1:ISTORE_CUR) = ZPACK(IPOS:IPOS+ISTORE_CUR-1) ; IPOS = IPOS + ISTORE_CUR
+
+TPFLYER%XSVW_FLUX(1:ISTORE_CUR,1:NSV) = RESHAPE( ZPACK(IPOS:IPOS+ISTORE_CUR*NSV-1), [ISTORE_CUR,NSV] )
+IPOS = IPOS + ISTORE_CUR * NSV
+
+SELECT TYPE ( TPFLYER )
+ CLASS IS ( TAIRCRAFTDATA )
+ IF ( NINT( ZPACK(IPOS) ) == 0 ) THEN
+ TPFLYER%LTOOKOFF = .FALSE.
+ ELSE
+ TPFLYER%LTOOKOFF = .TRUE.
+ END IF
+ IPOS = IPOS + 1
+
+ IF ( NINT( ZPACK(IPOS) ) == 0 ) THEN
+ TPFLYER%LALTDEF = .FALSE.
+ ELSE
+ TPFLYER%LALTDEF = .TRUE.
+ END IF
+ IPOS = IPOS + 1
+
+ TPFLYER%NPOS = NINT( ZPACK(IPOS) ); IPOS = IPOS + 1
+ TPFLYER%NPOSCUR = NINT( ZPACK(IPOS) ); IPOS = IPOS + 1
+
+ IPOSAIR = TPFLYER%NPOS
+
+ ALLOCATE( TPFLYER%XPOSLAT(IPOSAIR) )
+ ALLOCATE( TPFLYER%XPOSLON(IPOSAIR) )
+ ALLOCATE( TPFLYER%XPOSX(IPOSAIR) )
+ ALLOCATE( TPFLYER%XPOSY(IPOSAIR) )
+ IF ( TPFLYER%LALTDEF ) THEN
+ ALLOCATE( TPFLYER%XPOSP(IPOSAIR) )
+ ELSE
+ ALLOCATE( TPFLYER%XPOSZ(IPOSAIR) )
+ END IF
+ ALLOCATE( TPFLYER%XPOSTIME(IPOSAIR) )
+
+ TPFLYER%XPOSLAT(1:IPOSAIR) = ZPACK(IPOS:IPOS+IPOSAIR-1) ; IPOS = IPOS + IPOSAIR
+ TPFLYER%XPOSLON(1:IPOSAIR) = ZPACK(IPOS:IPOS+IPOSAIR-1) ; IPOS = IPOS + IPOSAIR
+ TPFLYER%XPOSX(1:IPOSAIR) = ZPACK(IPOS:IPOS+IPOSAIR-1) ; IPOS = IPOS + IPOSAIR
+ TPFLYER%XPOSY(1:IPOSAIR) = ZPACK(IPOS:IPOS+IPOSAIR-1) ; IPOS = IPOS + IPOSAIR
+ IF ( TPFLYER%LALTDEF ) THEN
+ TPFLYER%XPOSP(1:IPOSAIR) = ZPACK(IPOS:IPOS+IPOSAIR-1) ; IPOS = IPOS + IPOSAIR
+ ELSE
+ TPFLYER%XPOSZ(1:IPOSAIR) = ZPACK(IPOS:IPOS+IPOSAIR-1) ; IPOS = IPOS + IPOSAIR
+ END IF
+ TPFLYER%XPOSTIME(1:IPOSAIR) = ZPACK(IPOS:IPOS+IPOSAIR-1) ; IPOS = IPOS + IPOSAIR
+
+ TPFLYER%TLAND = TPREFERENCE_DATE + ZPACK(IPOS); IPOS = IPOS + 1
+
+ CLASS IS ( TBALLOONDATA )
+ IF ( NINT( ZPACK(IPOS) ) == 0 ) THEN
+ TPFLYER%LPOSITION_INIT = .FALSE.
+ ELSE
+ TPFLYER%LPOSITION_INIT = .TRUE.
+ END IF
+ IPOS = IPOS + 1
+
+ TPFLYER%XLATLAUNCH = ZPACK(IPOS); IPOS = IPOS + 1
+ TPFLYER%XLONLAUNCH = ZPACK(IPOS); IPOS = IPOS + 1
+ TPFLYER%XXLAUNCH = ZPACK(IPOS); IPOS = IPOS + 1
+ TPFLYER%XYLAUNCH = ZPACK(IPOS); IPOS = IPOS + 1
+ TPFLYER%XALTLAUNCH = ZPACK(IPOS); IPOS = IPOS + 1
+ TPFLYER%XWASCENT = ZPACK(IPOS); IPOS = IPOS + 1
+ TPFLYER%XRHO = ZPACK(IPOS); IPOS = IPOS + 1
+ TPFLYER%XPRES = ZPACK(IPOS); IPOS = IPOS + 1
+ TPFLYER%XDIAMETER = ZPACK(IPOS); IPOS = IPOS + 1
+ TPFLYER%XAERODRAG = ZPACK(IPOS); IPOS = IPOS + 1
+ TPFLYER%XINDDRAG = ZPACK(IPOS); IPOS = IPOS + 1
+ TPFLYER%XVOLUME = ZPACK(IPOS); IPOS = IPOS + 1
+ TPFLYER%XMASS = ZPACK(IPOS); IPOS = IPOS + 1
+
+ TPFLYER%TPOS_CUR = TPREFERENCE_DATE + ZPACK(IPOS); IPOS = IPOS + 1
+
+END SELECT
+
+IF ( IPOS-1 /= IPACKSIZE ) &
+ call Print_msg( NVERB_WARNING, '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 f38d3953a..26968c75e 100644
--- a/src/MNH/aircraft_balloon_evol.f90
+++ b/src/MNH/aircraft_balloon_evol.f90
@@ -1,8 +1,31 @@
-!MNH_LIC Copyright 2000-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
+! Author: Valery Masson (Meteo-France *)
+! Original 15/05/2000
+! Modifications:
+! G. Jaubert 19/04/2001: add CVBALL type
+! P. Lacarrere 03/2008: add 3D fluxes
+! M. Leriche 12/12/2008: move ZTDIST out from if.not.(tpflyer%fly)
+! V. Masson 15/12/2008: correct do while aircraft move
+! O. Caumont 03/2013: add radar reflectivities
+! C. Lac 04/2014: allow RARE calculation only if CCLOUD=ICE3
+! O. Caumont 05/2014: modify RARE for hydrometeors containing ice + add bright band calculation for RARE
+! C. Lac 02/2015: correction to prevent aircraft crash
+! O. Nuissier/F. Duffourg 07/2015: add microphysics diagnostic for aircraft, ballon and profiler
+! G. Delautier 10/2016: LIMA
+! P. Wautelet 28/03/2018: replace TEMPORAL_DIST by DATETIME_DISTANCE
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! P. Wautelet 01/10/2020: bugfix: initialize GSTORE
+! P. Wautelet 14/01/2021: bugfixes: -ZXCOEF and ZYCOEF were not computed if CVBALL
+! -PCIT was used if CCLOUD/=ICEx (not allocated)
+! -PSEA was always used even if not allocated (CSURF/=EXTE)
+! -do not use PMAP if cartesian domain
+! P. Wautelet 06/2022: reorganize flyers
+!-----------------------------------------------------------------
! ##########################
MODULE MODE_AIRCRAFT_BALLOON_EVOL
! ##########################
@@ -15,12 +38,17 @@ PRIVATE
PUBLIC :: AIRCRAFT_BALLOON_EVOL
+PUBLIC :: AIRCRAFT_COMPUTE_POSITION
+
+PUBLIC :: FLYER_GET_RANK_MODEL_ISCRASHED
+
CONTAINS
! ########################################################
SUBROUTINE AIRCRAFT_BALLOON_EVOL(PTSTEP, &
PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, &
- PTS, PRHODREF, PCIT,TPFLYER, PSEA )
+ PTS, PRHODREF, PCIT, TPFLYER, &
+ KRANK_CUR, KRANK_NXT, PSEA )
! ########################################################
!
!
@@ -68,60 +96,19 @@ CONTAINS
!! REFERENCE
!! ---------
!!
-!! AUTHOR
-!! ------
-!! Valery Masson * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 15/05/2000
-!! Apr,19, 2001 (G.Jaubert) add CVBALL type
-!! March, 2008 (P.Lacarrere) Add 3D fluxes
-!! Dec,12, 2008 (M. Leriche) move ZTDIST out from if.not.(tpflyer%fly)
-!! Dec,15, 2008 (V. Masson) correct do while aircraft move
-!! March, 2013 (O.Caumont) add radar reflectivities
-!! April, 2014 (C.Lac) allow RARE calculation only if CCLOUD=ICE3
-!! May, 2014 (O.Caumont) modify RARE for hydrometeors containing ice
-!! add bright band calculation for RARE
-!! Feb, 2015 (C.Lac) Correction to prevent aircraft crash
-!! July, 2015 (O.Nuissier/F.Duffourg) Add microphysics diagnostic for
-!! aircraft, ballon and profiler
-!! October, 2016 (G.DELAUTIER) LIMA
-!! March,28, 2018 (P. Wautelet) replace TEMPORAL_DIST by DATETIME_DISTANCE
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
-! P. Wautelet 01/10/2020: bugfix: initialize GSTORE
-! P. Wautelet 14/01/2021: bugfixes: -ZXCOEF and ZYCOEF were not computed if CVBALL
-! -PCIT was used if CCLOUD/=ICEx (not allocated)
-! -PSEA was always used even if not allocated (CSURF/=EXTE)
-! -do not use PMAP if cartesian domain
-! P. Wautelet 06/2022: reorganize flyers
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_AIRCRAFT_BALLOON
-USE MODD_CONF, ONLY: LCARTESIAN
-USE MODD_CST
-USE MODD_DIAG_IN_RUN
-USE MODD_GRID
-USE MODD_GRID_n
+USE MODD_CST, ONLY: XCPD, XLVTT
USE MODD_IO, ONLY: ISP
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_NESTING
-USE MODD_PARAMETERS
-USE MODD_PARAM_n, ONLY: CCLOUD, CSURF
-USE MODD_REF_n, ONLY: XRHODREF
-USE MODD_TIME, only: TDTSEG
-USE MODD_TIME_n, only: tdtcur
-USE MODD_TURB_FLUX_AIRCRAFT_BALLOON
+USE MODD_TIME_n, ONLY: TDTCUR
+USE MODD_TURB_FLUX_AIRCRAFT_BALLOON, ONLY: XRCW_FLUX, XSVW_FLUX, XTHW_FLUX
!
USE MODE_DATETIME
-USE MODE_FGAU, ONLY: GAULAG
-USE MODE_FSCATTER, ONLY: QEPSW,QEPSI,BHMIE,MOMG,MG
-USE MODE_GRIDPROJ
-USE MODE_ll
+USE MODE_NEST_ll, ONLY: GET_MODEL_NUMBER_ll
!
IMPLICIT NONE
!
@@ -146,7 +133,9 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PTS ! surface temperature
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! dry air density of the reference state
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! pristine ice concentration
!
-CLASS(TFLYERDATA), INTENT(INOUT) :: TPFLYER! balloon/aircraft
+CLASS(TFLYERDATA), INTENT(INOUT) :: TPFLYER ! balloon/aircraft
+INTEGER, INTENT(IN) :: KRANK_CUR
+INTEGER, INTENT(OUT) :: KRANK_NXT
REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA
!
!-------------------------------------------------------------------------------
@@ -155,36 +144,30 @@ REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA
!
!
INTEGER :: IMI ! model index
-REAL :: ZTHIS_PROC ! 1 if balloon is currently treated by this proc., else 0
-!
INTEGER :: IKB ! vertical domain sizes
INTEGER :: IKE
INTEGER :: IKU
!
-INTEGER :: JK ! loop index
-!
REAL, DIMENSION(2,2,SIZE(PZ,3)) :: ZZM ! mass point coordinates
REAL, DIMENSION(2,2,SIZE(PZ,3)) :: ZZU ! U points z coordinates
REAL, DIMENSION(2,2,SIZE(PZ,3)) :: ZZV ! V points z coordinates
REAL, DIMENSION(2,2,SIZE(PZ,3)) :: ZWM ! mass point wind
!
-REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZTEMP ! temperature
REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZEXN ! Exner function
REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZRHO ! air density
REAL :: ZFLYER_EXN ! balloon/aircraft Exner func.
REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZTHW_FLUX !
REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZRCW_FLUX !
-REAL, DIMENSION(2,2,SIZE(PSV,3),SIZE(PSV,4)) :: ZSVW_FLUX
+REAL, DIMENSION(2,2,SIZE(PSV,3),SIZE(PSV,4)) :: ZSVW_FLUX
!
LOGICAL :: GLAUNCH ! launch/takeoff is effective at this time-step (if true)
LOGICAL :: GSTORE ! storage occurs at this time step
+LOGICAL :: GOWNER_CUR ! The process is the current owner of the flyer
!
INTEGER :: II_M ! mass balloon position (x index)
INTEGER :: IJ_M ! mass balloon position (y index)
INTEGER :: II_U ! U flux point balloon position (x index)
INTEGER :: IJ_V ! V flux point balloon position (y index)
-INTEGER :: IDU ! difference between II_U and II_M
-INTEGER :: IDV ! difference between IJ_V and IJ_M
!
INTEGER :: IK00 ! balloon position for II_M , IJ_M
INTEGER :: IK01 ! balloon position for II_M , IJ_M+1
@@ -218,18 +201,7 @@ REAL :: ZVCOEF10 ! Z direction interpolation coefficient for II_M+1, IJ_V
REAL :: ZVCOEF11 ! Z direction interpolation coefficient for II_M+1, IJ_V+1
!
INTEGER :: ISTORE ! time index for storage
-INTEGER :: JLOOP,JLOOP2 ! loop counter
-!
-REAL :: ZU_BAL ! horizontal wind speed at balloon location (along x)
-REAL :: ZV_BAL ! horizontal wind speed at balloon location (along y)
-REAL :: ZW_BAL ! vertical wind speed at balloon location (along z)
-REAL :: ZMAP ! map factor at balloon location
-REAL :: ZGAM ! rotation between meso-nh base and spherical lat-lon base.
-REAL :: ZRO_BAL ! air density at balloon location
-!
-INTEGER :: IINFO_ll ! return code
!
-INTEGER :: IMODEL
REAL :: ZTSTEP
TYPE(DATE_TIME) :: TZNEXT ! Time for next position
!----------------------------------------------------------------------------
@@ -237,6 +209,17 @@ IKU = SIZE(PZ,3)
CALL GET_MODEL_NUMBER_ll(IMI)
+! Set initial value for KRANK_NXT
+! It needs to be 0 on all processes except the one where it is when this subroutine is called
+! If the flyer flies to an other process, KRANK_NXT will be set accordingly by the current owner
+IF ( TPFLYER%NRANK_CUR == ISP ) THEN
+ GOWNER_CUR = .TRUE. ! This variable is set and used because NRANK_CUR could change in this subroutine
+ KRANK_NXT = ISP
+ELSE
+ GOWNER_CUR = .FALSE.
+ KRANK_NXT = 0
+END IF
+
SELECT TYPE ( TPFLYER )
CLASS IS ( TAIRCRAFTDATA)
! Take-off?
@@ -249,20 +232,12 @@ SELECT TYPE ( TPFLYER )
IF ( TDTCUR >= TPFLYER%TLAUNCH .AND. TDTCUR <= TPFLYER%TLAND ) THEN
TPFLYER%LFLY = .TRUE.
TPFLYER%LTOOKOFF = .TRUE.
-
- ! Compute current position
- CALL AIRCRAFT_COMPUTE_POSITION( TDTCUR, TPFLYER )
-
- ! Get rank of the process where the aircraft is and the model number
- CALL FLYER_GET_RANK_MODEL_ISCRASHED( TPFLYER )
END IF
END IF
END IF TAKEOFF
- IF ( IMI == TPFLYER%NMODEL ) THEN
- !Do we have to store aircraft data?
- CALL FLYER_CHECK_STORESTEP( TPFLYER )
- END IF
+ !Do we have to store aircraft data?
+ IF ( IMI == TPFLYER%NMODEL ) CALL FLYER_CHECK_STORESTEP( TPFLYER )
! For aircrafts, data has only to be computed at store moments
ISTORE = TPFLYER%TFLYER_TIME%N_CUR
@@ -270,8 +245,6 @@ SELECT TYPE ( TPFLYER )
! Check if it is the right moment to store data
IF ( ABS( TDTCUR - TPFLYER%TFLYER_TIME%TPDATES(ISTORE) ) < 1e-10 ) THEN
ISOWNERAIR: IF ( TPFLYER%NRANK_CUR == ISP ) THEN
- ZTHIS_PROC = 1.
-
CALL FLYER_INTERP_TO_MASSPOINTS()
ZEXN(:,:,:) = FLYER_COMPUTE_EXNER( )
@@ -289,13 +262,8 @@ SELECT TYPE ( TPFLYER )
CALL FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE2( )
CALL FLYER_RECORD_DATA( )
- ELSE ISOWNERAIR
- !Not owner branch
- ZTHIS_PROC = 0.
END IF ISOWNERAIR
- CALL FLYER_COMMUNICATE_DATA( )
-
! Store has been done
TPFLYER%LSTORE = .FALSE.
END IF
@@ -325,23 +293,11 @@ SELECT TYPE ( TPFLYER )
END IF
END IF
+ IF ( GOWNER_CUR ) KRANK_NXT = TPFLYER%NRANK_CUR
CLASS IS ( TBALLOONDATA)
GLAUNCH = .FALSE. !Set to true only at the launch instant (set to false in flight after launch)
- ! Initialize model number (and rank)
- ! This is not done in initialisation phase because some data is not yet available at this early stage
- ! (XXHAT_ll of all models are needed by FIND_PROCESS_AND_MODEL_FROM_XY_POS)
- IF ( .NOT. TPFLYER%LPOSITION_INIT ) THEN
- TPFLYER%LPOSITION_INIT = .TRUE.
- ! Get rank of the process where the balloon is and the model number
- CALL FLYER_GET_RANK_MODEL_ISCRASHED( TPFLYER, PX = TPFLYER%XXLAUNCH, PY = TPFLYER%XYLAUNCH )
- IF ( TPFLYER%LCRASH ) THEN
- CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', 'balloon ' // TRIM( TPFLYER%CTITLE ) &
- // ': launch coordinates are outside of horizontal physical domain' )
- END IF
- END IF
-
! Launch?
LAUNCH: IF ( .NOT. TPFLYER%LFLY .AND. .NOT. TPFLYER%LCRASH .AND. TPFLYER%NMODEL == IMI ) THEN
! Check if it is launchtime
@@ -352,15 +308,6 @@ SELECT TYPE ( TPFLYER )
TPFLYER%XX_CUR = TPFLYER%XXLAUNCH
TPFLYER%XY_CUR = TPFLYER%XYLAUNCH
TPFLYER%TPOS_CUR = TDTCUR
-
- ! Get rank of the process where the balloon is and the model number
- CALL FLYER_GET_RANK_MODEL_ISCRASHED( TPFLYER )
- IF ( TPFLYER%LCRASH ) THEN
- WRITE( CMNHMSG(1), "( 'Balloon ', A, ' crashed the ', I2, '/', I2, '/', I4, ' at ', F18.12, &
- 's (out of the horizontal boundaries)' )" ) &
- TRIM( TPFLYER%CTITLE ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
- CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL' )
- END IF
END IF LAUNCHTIME
END IF LAUNCH
@@ -376,8 +323,6 @@ SELECT TYPE ( TPFLYER )
INFLIGHTONMODEL: IF ( TPFLYER%LFLY .AND. .NOT. TPFLYER%LCRASH .AND. TPFLYER%NMODEL == IMI &
.AND. ABS( TPFLYER%TPOS_CUR - TDTCUR ) < 1.e-8 ) THEN
ISOWNERBAL: IF ( TPFLYER%NRANK_CUR == ISP ) THEN
- ZTHIS_PROC = 1.
-
CALL FLYER_INTERP_TO_MASSPOINTS()
ZEXN(:,:,:) = FLYER_COMPUTE_EXNER( )
@@ -423,23 +368,20 @@ SELECT TYPE ( TPFLYER )
TPFLYER%TPOS_CUR = TDTCUR + ZTSTEP
END IF CRASH_VERT !end of no vertical crash branch
- ELSE ISOWNERBAL
- !The balloon is not present on this MPI process
- ZTHIS_PROC = 0.
END IF ISOWNERBAL
-
- CALL FLYER_COMMUNICATE_DATA( )
END IF INFLIGHTONMODEL
+ IF ( GOWNER_CUR ) KRANK_NXT = TPFLYER%NRANK_CUR
END SELECT
-
CONTAINS
-!
+
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
SUBROUTINE BALLOON_COMPUTE_INITIAL_VERTICAL_POSITION( TPBALLOON )
+USE MODD_CST, ONLY: XCPD, XP00, XRD
+
IMPLICIT NONE
CLASS(TBALLOONDATA), INTENT(INOUT) :: TPBALLOON
@@ -554,15 +496,23 @@ END SUBROUTINE BALLOON_COMPUTE_INITIAL_VERTICAL_POSITION
SUBROUTINE BALLOON_ADVECTION_HOR( TPBALLOON )
USE MODD_AIRCRAFT_BALLOON, ONLY: TBALLOONDATA
+USE MODD_CONF, ONLY: LCARTESIAN
+USE MODD_NESTING, ONLY: NDAD, NDTRATIO
+USE MODD_TIME, only: TDTSEG
+USE MODD_TIME_n, ONLY: TDTCUR
IMPLICIT NONE
CLASS(TBALLOONDATA), INTENT(INOUT) :: TPBALLOON
+INTEGER :: IMODEL
INTEGER :: IMODEL_OLD
REAL :: ZX_OLD, ZY_OLD
REAL :: ZDELTATIME
REAL :: ZDIVTMP
+REAL :: ZMAP ! map factor at balloon location
+REAL :: ZU_BAL ! horizontal wind speed at balloon location (along x)
+REAL :: ZV_BAL ! horizontal wind speed at balloon location (along y)
ZTSTEP = PTSTEP
@@ -668,11 +618,16 @@ END SUBROUTINE BALLOON_ADVECTION_HOR
SUBROUTINE BALLOON_ADVECTION_VER( TPBALLOON )
USE MODD_AIRCRAFT_BALLOON, ONLY: TBALLOONDATA
+USE MODD_CST, ONLY: XG
IMPLICIT NONE
CLASS(TBALLOONDATA), INTENT(INOUT) :: TPBALLOON
+INTEGER :: JK ! loop index
+REAL :: ZRO_BAL ! air density at balloon location
+REAL :: ZW_BAL ! vertical wind speed at balloon location (along z)
+
IF ( TPBALLOON%CTYPE == 'RADIOS' ) THEN
ZW_BAL = FLYER_INTERP(ZWM)
TPBALLOON%XZ_CUR = TPBALLOON%XZ_CUR + ( ZW_BAL + TPBALLOON%XWASCENT ) * ZTSTEP
@@ -709,8 +664,14 @@ END SUBROUTINE BALLOON_ADVECTION_VER
!----------------------------------------------------------------------------
SUBROUTINE FLYER_INTERP_TO_MASSPOINTS()
+USE MODD_GRID_n, ONLY: XXHAT, XXHATM, XYHAT, XYHATM
+USE MODD_PARAMETERS, ONLY: JPVEXT
+
IMPLICIT NONE
+INTEGER :: IDU ! difference between II_U and II_M
+INTEGER :: IDV ! difference between IJ_V and IJ_M
+
! Indices
IKB = 1 + JPVEXT
IKE = SIZE(PZ,3) - JPVEXT
@@ -748,6 +709,8 @@ END SUBROUTINE FLYER_INTERP_TO_MASSPOINTS
!----------------------------------------------------------------------------
PURE FUNCTION FLYER_COMPUTE_EXNER( ) RESULT( PEXN )
+USE MODD_CST, ONLY: XCPD, XP00, XRD
+
IMPLICIT NONE
REAL, DIMENSION(2,2,SIZE(PTH,3)) :: PEXN
@@ -767,6 +730,8 @@ END FUNCTION FLYER_COMPUTE_EXNER
!----------------------------------------------------------------------------
PURE FUNCTION FLYER_COMPUTE_RHO( ) RESULT( PRHO )
+USE MODD_CST, ONLY: XRD, XRV
+
USE MODI_WATER_SUM
IMPLICIT NONE
@@ -795,6 +760,8 @@ END FUNCTION FLYER_COMPUTE_RHO
SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE1( )
! Compute coefficents for horizontal interpolations (1st stage)
+USE MODD_GRID_n, ONLY: XXHAT, XXHATM, XYHAT, XYHATM
+
IMPLICIT NONE
! Interpolation coefficient for X
@@ -819,6 +786,9 @@ END SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE1
SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_VER( )
! Compute coefficent for vertical interpolations
+USE MODD_CST, ONLY: XCPD, XP00, XRD
+USE MODD_TIME_n, ONLY: TDTCUR
+
IMPLICIT NONE
! Find indices surrounding the vertical box where the flyer is
@@ -950,7 +920,11 @@ END SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE2
!----------------------------------------------------------------------------
SUBROUTINE FLYER_RECORD_DATA( )
+USE MODD_CST, ONLY: XCPD, XLAM_CRAD, XLIGHTSPEED, XP00, XPI, XRD, XRHOLW, XTT
+USE MODD_DIAG_IN_RUN, ONLY: LDIAG_IN_RUN, XCURRENT_TKE_DISS
+USE MODD_GRID, ONLY: XBETA, XLON0, XRPK
USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_NI
+USE MODD_PARAMETERS, ONLY: JPVEXT
USE MODD_PARAM_LIMA, ONLY: XALPHAR_L => XALPHAR, XNUR_L => XNUR, XALPHAS_L => XALPHAS, XNUS_L => XNUS, &
XALPHAG_L => XALPHAG, XNUG_L => XNUG, XALPHAI_L => XALPHAI, XNUI_L => XNUI, &
XRTMIN_L => XRTMIN, XALPHAC_L => XALPHAC, XNUC_L => XNUC
@@ -958,6 +932,7 @@ USE MODD_PARAM_LIMA_COLD, ONLY: XAI_L => XAI, XBI_L => XBI, XLBEXS_L => XLBEXS,
XAS_L => XAS, XBS_L => XBS, XCXS_L => XCXS
USE MODD_PARAM_LIMA_MIXED, ONLY: XLBEXG_L => XLBEXG, XLBG_L => XLBG, XCCG_L => XCCG, XAG_L => XAG, XBG_L => XBG, XCXG_L => XCXG
USE MODD_PARAM_LIMA_WARM, ONLY: XAC_L => XAC, XAR_L => XAR, XBC_L => XBC, XBR_L => XBR
+USE MODD_PARAM_n, ONLY: CCLOUD, CSURF
USE MODD_RAIN_ICE_DESCR, ONLY: XALPHAR_I => XALPHAR, XNUR_I => XNUR, XLBEXR_I => XLBEXR, &
XLBR_I => XLBR, XCCR_I => XCCR, XBR_I => XBR, XAR_I => XAR, &
XALPHAC_I => XALPHAC, XNUC_I => XNUC, XBC_I => XBC, XAC_I => XAC, &
@@ -970,12 +945,18 @@ USE MODD_RAIN_ICE_DESCR, ONLY: XALPHAR_I => XALPHAR, XNUR_I => XNUR, XLBEXR_I
XLBI_I => XLBI, XAI_I => XAI, XBI_I => XBI, &
XRTMIN_I => XRTMIN, XCONC_LAND, XCONC_SEA
+USE MODE_FGAU, ONLY: GAULAG
+USE MODE_FSCATTER, ONLY: BHMIE, MOMG, MG, QEPSI, QEPSW
+USE MODE_GRIDPROJ, ONLY: SM_LATLON
+
USE MODI_GAMMA, ONLY: GAMMA
IMPLICIT NONE
INTEGER, PARAMETER :: JPTS_GAULAG = 7 ! number of points for Gauss-Laguerre quadrature
+INTEGER :: JK ! loop index
+INTEGER :: JLOOP ! loop counter
REAL, DIMENSION(SIZE(PR,3)) :: ZTEMPZ! vertical profile of temperature
REAL, DIMENSION(SIZE(PR,3)) :: ZRHODREFZ ! vertical profile of dry air density of the reference state
REAL, DIMENSION(SIZE(PR,3)) :: ZCIT ! pristine ice concentration
@@ -994,6 +975,9 @@ REAL :: ZFPW ! weight for mixed-phase reflectivity
REAL,DIMENSION(:),ALLOCATABLE :: ZX,ZW ! Gauss-Laguerre points and weights
REAL,DIMENSION(:),ALLOCATABLE :: ZRTMIN ! local values for XRTMIN
LOGICAL :: GCALC
+REAL :: ZGAM ! rotation between meso-nh base and spherical lat-lon base.
+REAL :: ZU_BAL ! horizontal wind speed at balloon location (along x)
+REAL :: ZV_BAL ! horizontal wind speed at balloon location (along y)
TPFLYER%NMODELHIST(ISTORE) = TPFLYER%NMODEL
@@ -1350,101 +1334,6 @@ END DO
END SUBROUTINE FLYER_RECORD_DATA
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
-SUBROUTINE FLYER_COMMUNICATE_DATA( )
-! Exchange of information between processes
-
-IMPLICIT NONE
-
-SELECT TYPE ( TPFLYER )
- CLASS IS ( TBALLOONDATA)
- IF ( TPFLYER%CMODEL == 'MOB' ) THEN
- CALL DISTRIBUTE_FLYER_N(TPFLYER%NMODEL)
- END IF
- CALL DISTRIBUTE_FLYER_N(TPFLYER%NRANK_CUR)
- CALL DISTRIBUTE_FLYER_L(TPFLYER%LFLY)
- CALL DISTRIBUTE_FLYER_L(TPFLYER%LCRASH)
- CALL DISTRIBUTE_FLYER_L(TPFLYER%LSTORE)
- CALL DISTRIBUTE_FLYER(TPFLYER%XX_CUR)
- CALL DISTRIBUTE_FLYER(TPFLYER%XY_CUR)
- CALL DISTRIBUTE_FLYER_N(TPFLYER%TPOS_CUR%NYEAR)
- CALL DISTRIBUTE_FLYER_N(TPFLYER%TPOS_CUR%NMONTH)
- CALL DISTRIBUTE_FLYER_N(TPFLYER%TPOS_CUR%NDAY)
- CALL DISTRIBUTE_FLYER (TPFLYER%TPOS_CUR%XTIME)
-
- CALL DISTRIBUTE_FLYER_N(TPFLYER%TFLYER_TIME%N_CUR)
-
- IF ( TPFLYER%CTYPE == 'CVBALL' ) THEN
- CALL DISTRIBUTE_FLYER(TPFLYER%XZ_CUR)
- CALL DISTRIBUTE_FLYER(TPFLYER%XWASCENT)
- ELSE IF ( TPFLYER%CTYPE == 'RADIOS' ) THEN
- CALL DISTRIBUTE_FLYER(TPFLYER%XZ_CUR)
- ELSE IF ( TPFLYER%CTYPE == 'ISODEN' ) THEN
- CALL DISTRIBUTE_FLYER(TPFLYER%XRHO)
- END IF
-
-END SELECT
-
-IF ( TPFLYER%LSTORE ) THEN
- ! Data stored
- ISTORE = TPFLYER%TFLYER_TIME%N_CUR
-
- SELECT TYPE ( TPFLYER )
- CLASS IS ( TBALLOONDATA)
- CALL DISTRIBUTE_FLYER_N(TPFLYER%TFLYER_TIME%TPDATES(ISTORE)%NYEAR)
- CALL DISTRIBUTE_FLYER_N(TPFLYER%TFLYER_TIME%TPDATES(ISTORE)%NMONTH)
- CALL DISTRIBUTE_FLYER_N(TPFLYER%TFLYER_TIME%TPDATES(ISTORE)%NDAY)
- CALL DISTRIBUTE_FLYER (TPFLYER%TFLYER_TIME%TPDATES(ISTORE)%XTIME)
- END SELECT
-
- CALL DISTRIBUTE_FLYER_N(TPFLYER%NMODELHIST(ISTORE))
- CALL DISTRIBUTE_FLYER(TPFLYER%XX (ISTORE))
- CALL DISTRIBUTE_FLYER(TPFLYER%XY (ISTORE))
- CALL DISTRIBUTE_FLYER(TPFLYER%XZ (ISTORE))
- CALL DISTRIBUTE_FLYER(TPFLYER%XLON(ISTORE))
- CALL DISTRIBUTE_FLYER(TPFLYER%XLAT(ISTORE))
- CALL DISTRIBUTE_FLYER(TPFLYER%XZON(ISTORE))
- CALL DISTRIBUTE_FLYER(TPFLYER%XMER(ISTORE))
- CALL DISTRIBUTE_FLYER(TPFLYER%XW (ISTORE))
- CALL DISTRIBUTE_FLYER(TPFLYER%XP (ISTORE))
- CALL DISTRIBUTE_FLYER(TPFLYER%XTH (ISTORE))
- DO JLOOP=1,SIZE(PR,4)
- CALL DISTRIBUTE_FLYER(TPFLYER%XR (ISTORE,JLOOP))
- END DO
- DO JLOOP=1,SIZE(PSV,4)
- CALL DISTRIBUTE_FLYER(TPFLYER%XSV (ISTORE,JLOOP))
- END DO
- DO JLOOP=1,IKU
- CALL DISTRIBUTE_FLYER(TPFLYER%XRTZ (ISTORE,JLOOP))
- DO JLOOP2=1,SIZE(PR,4)
- CALL DISTRIBUTE_FLYER(TPFLYER%XRZ (ISTORE,JLOOP,JLOOP2))
- END DO
- CALL DISTRIBUTE_FLYER(TPFLYER%XFFZ (ISTORE,JLOOP))
- CALL DISTRIBUTE_FLYER(TPFLYER%XCIZ (ISTORE,JLOOP))
- IF (CCLOUD== 'LIMA' ) THEN
- CALL DISTRIBUTE_FLYER(TPFLYER%XCRZ (ISTORE,JLOOP))
- CALL DISTRIBUTE_FLYER(TPFLYER%XCCZ (ISTORE,JLOOP))
- END IF
- CALL DISTRIBUTE_FLYER(TPFLYER%XIWCZ (ISTORE,JLOOP))
- CALL DISTRIBUTE_FLYER(TPFLYER%XLWCZ (ISTORE,JLOOP))
- CALL DISTRIBUTE_FLYER(TPFLYER%XCRARE (ISTORE,JLOOP))
- CALL DISTRIBUTE_FLYER(TPFLYER%XCRARE_ATT (ISTORE,JLOOP))
- CALL DISTRIBUTE_FLYER(TPFLYER%XWZ (ISTORE,JLOOP))
- CALL DISTRIBUTE_FLYER(TPFLYER%XZZ (ISTORE,JLOOP))
- END DO
- IF (SIZE(PTKE)>0) CALL DISTRIBUTE_FLYER(TPFLYER%XTKE (ISTORE))
- IF (SIZE(PTS) >0) CALL DISTRIBUTE_FLYER(TPFLYER%XTSRAD(ISTORE))
- IF (LDIAG_IN_RUN) CALL DISTRIBUTE_FLYER(TPFLYER%XTKE_DISS(ISTORE))
- CALL DISTRIBUTE_FLYER(TPFLYER%XZS (ISTORE))
- CALL DISTRIBUTE_FLYER(TPFLYER%XTHW_FLUX(ISTORE))
- CALL DISTRIBUTE_FLYER(TPFLYER%XRCW_FLUX(ISTORE))
- DO JLOOP=1,SIZE(PSV,4)
- CALL DISTRIBUTE_FLYER(TPFLYER%XSVW_FLUX(ISTORE,JLOOP))
- END DO
-END IF
-
-END SUBROUTINE FLYER_COMMUNICATE_DATA
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
FUNCTION FLYER_INTERP(PA) RESULT(PB)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
@@ -1566,51 +1455,6 @@ PB = (1.- ZYCOEF) * (1.-ZXCOEF) * PA(JI ,JJ ) &
!
END FUNCTION FLYER_INTERP_2D
!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-SUBROUTINE DISTRIBUTE_FLYER(PA)
-!
-REAL, INTENT(INOUT) :: PA
-!
-PA = PA * ZTHIS_PROC
-CALL REDUCESUM_ll(PA,IINFO_ll)
-!
-END SUBROUTINE DISTRIBUTE_FLYER
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-SUBROUTINE DISTRIBUTE_FLYER_N(KA)
-!
-INTEGER, INTENT(INOUT) :: KA
-REAL :: ZA
-!
-ZA=KA
-!
-ZA = ZA * ZTHIS_PROC
-CALL REDUCESUM_ll(ZA,IINFO_ll)
-!
-IF (NINT(ZA)/=0) KA=NINT(ZA)
-!
-END SUBROUTINE DISTRIBUTE_FLYER_N
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-SUBROUTINE DISTRIBUTE_FLYER_L(OA)
-!
-LOGICAL, INTENT(INOUT) :: OA
-REAL :: ZA
-!
-ZA=0.
-IF (OA) ZA=1.
-!
-CALL REDUCESUM_ll(ZA,IINFO_ll)
-!
-IF (ZA==0.) THEN
- OA=.FALSE.
-ELSE
- OA=.TRUE.
-END IF
-!
-END SUBROUTINE DISTRIBUTE_FLYER_L
-!----------------------------------------------------------------------------
-
END SUBROUTINE AIRCRAFT_BALLOON_EVOL
!----------------------------------------------------------------------------
diff --git a/src/MNH/ini_aircraft.f90 b/src/MNH/ini_aircraft.f90
index b968be84d..331df58cf 100644
--- a/src/MNH/ini_aircraft.f90
+++ b/src/MNH/ini_aircraft.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2000-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -115,8 +115,6 @@ IMPLICIT NONE
INTEGER :: JI
TYPE(TAIRCRAFTDATA), POINTER :: TZAIRCRAFT
-ALLOCATE( TAIRCRAFTS(NAIRCRAFTS) )
-
!Treat aircraft data read in namelist
DO JI = 1, NAIRCRAFTS
ALLOCATE( TAIRCRAFTS(JI)%TAIRCRAFT )
@@ -129,7 +127,7 @@ DO JI = 1, NAIRCRAFTS
WRITE( CMNHMSG(1), FMT = '( A, I4 )' ) 'no title given to aircraft number ', JI
CMNHMSG(2) = 'title set to ' // TRIM( CTITLE(JI) )
- CALL PRINT_MSG( NVERB_INFO, 'GEN', 'INI_AIRCRAFT' )
+ CALL PRINT_MSG( NVERB_INFO, 'GEN', 'INI_AIRCRAFT', OLOCAL = .TRUE. )
END IF
TZAIRCRAFT%CTITLE = CTITLE(JI)
@@ -137,20 +135,21 @@ DO JI = 1, NAIRCRAFTS
IF ( NMODEL(JI) < 1 .OR. NMODEL(JI) > NMODEL_NEST ) THEN
CMNHMSG(1) = 'invalid NMODEL aircraft ' // TRIM( CTITLE(JI) )
CMNHMSG(2) = 'NMODEL must be between 1 and the last nested model number'
- CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_AIRCRAFT' )
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_AIRCRAFT', OLOCAL = .TRUE. )
NMODEL(JI) = 1
END IF
ELSE IF ( CMODEL(JI) == 'MOB' ) THEN
IF ( NMODEL(JI) /= 0 .AND. NMODEL(JI) /= 1 ) THEN
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'INI_AIRCRAFT', &
- 'NMODEL is set to 1 at start for a CMODEL="MOB" aircraft (aircraft ' // TRIM( CTITLE(JI) ) // ')' )
+ 'NMODEL is set to 1 at start for a CMODEL="MOB" aircraft (aircraft ' // TRIM( CTITLE(JI) ) // ')', &
+ OLOCAL = .TRUE. )
END IF
IF ( NMODEL_NEST == 1 ) CMODEL(JI) = 'FIX' ! If only one model, FIX and MOB are the same
NMODEL(JI) = 1
ELSE
CMNHMSG(1) = 'invalid CMODEL (' // TRIM( CMODEL(JI) ) // ') for aircraft ' // TRIM( CTITLE(JI) )
CMNHMSG(2) = 'CMODEL must be FIX or MOB (default="FIX")'
- CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_AIRCRAFT' )
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_AIRCRAFT', OLOCAL = .TRUE. )
CMODEL(JI) = 'FIX'
NMODEL(JI) = 1
END IF
@@ -161,21 +160,23 @@ DO JI = 1, NAIRCRAFTS
IF ( .NOT. TLAUNCH(JI)%CHECK( TRIM( CTITLE(JI) ) ) ) &
CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_AIRCRAFT', &
- 'problem with TLAUNCH (not set or incorrect values) for aircraft ' // TRIM( CTITLE(JI) ) )
+ 'problem with TLAUNCH (not set or incorrect values) for aircraft ' // TRIM( CTITLE(JI) ), OLOCAL = .TRUE. )
TZAIRCRAFT%TLAUNCH = TLAUNCH(JI)
IF ( XTSTEP(JI) == XNEGUNDEF ) THEN
CALL PRINT_MSG( NVERB_INFO, 'GEN', 'INI_AIRCRAFT', &
- 'data storage frequency not provided for aircraft ' // TRIM( CTITLE(JI) ) // ' => set to 60s' )
+ 'data storage frequency not provided for aircraft ' // TRIM( CTITLE(JI) ) // ' => set to 60s', OLOCAL = .TRUE. )
XTSTEP(JI) = 60.
ELSE IF ( XTSTEP(JI) <=0. ) THEN
- CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_AIRCRAFT', 'invalid data storage frequency for aircraft ' // TRIM( CTITLE(JI) ) )
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_AIRCRAFT', 'invalid data storage frequency for aircraft ' // TRIM( CTITLE(JI) ), &
+ OLOCAL = .TRUE. )
XTSTEP(JI) = 60.
END IF
TZAIRCRAFT%TFLYER_TIME%XTSTEP = XTSTEP(JI)
IF ( NPOS(JI) < 2 ) THEN
- CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_AIRCRAFT', 'NPOS should be at least 2 for aircraft ' // TRIM( CTITLE(JI) ) )
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_AIRCRAFT', 'NPOS should be at least 2 for aircraft ' // TRIM( CTITLE(JI) ), &
+ OLOCAL = .TRUE. )
END IF
TZAIRCRAFT%NPOS = NPOS(JI)
@@ -183,7 +184,7 @@ DO JI = 1, NAIRCRAFTS
IF ( CFILE(JI) == '' ) &
CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'INI_AIRCRAFT', 'name of CSV file with trajectory not provided for aircraft ' &
- // TRIM( CTITLE(JI) ) )
+ // TRIM( CTITLE(JI) ), OLOCAL = .TRUE. )
! Allocate trajectory data
ALLOCATE( TZAIRCRAFT%XPOSTIME(TZAIRCRAFT%NPOS) ); TZAIRCRAFT%XPOSTIME(:) = XNEGUNDEF
@@ -252,7 +253,7 @@ END DO
CLOSE( ILU )
IF ( JI < TPAIRCRAFT%NPOS ) &
- CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'AIRCRAFT_CSV_READ', 'Data not found in file ' // TRIM( HFILE ) )
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'AIRCRAFT_CSV_READ', 'Data not found in file ' // TRIM( HFILE ), OLOCAL = .TRUE. )
TPAIRCRAFT%TLAND = TPAIRCRAFT%TLAUNCH + TPAIRCRAFT%XPOSTIME(TPAIRCRAFT%NPOS)
diff --git a/src/MNH/ini_aircraft_balloon.f90 b/src/MNH/ini_aircraft_balloon.f90
index 2b9ef0f6c..5fa73b17a 100644
--- a/src/MNH/ini_aircraft_balloon.f90
+++ b/src/MNH/ini_aircraft_balloon.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2000-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -13,20 +13,21 @@
MODULE MODE_INI_AIRCRAFT_BALLOON
!###############################
+USE MODE_MSG
+
IMPLICIT NONE
PRIVATE
+PUBLIC :: ALLOCATE_FLYER, DEALLOCATE_FLYER
+
PUBLIC :: INI_AIRCRAFT_BALLOON
CONTAINS
-! ###############################################################
- SUBROUTINE INI_AIRCRAFT_BALLOON(TPINIFILE, &
- PTSTEP, TPDTSEG, PSEGLEN, &
- KRR, KSV, KKU, OUSETKE, &
- PLATOR, PLONOR )
-! ###############################################################
+! ############################################################
+ SUBROUTINE INI_AIRCRAFT_BALLOON( TPINIFILE, PLATOR, PLONOR )
+! ############################################################
!
!
!!**** *INI_AIRCRAFT_BALLOON* -
@@ -67,22 +68,17 @@ CONTAINS
! ------------
!
USE MODD_AIRCRAFT_BALLOON
-USE MODD_CONF
-USE MODD_DIAG_FLAG
-USE MODD_DYN_n
-use modd_field, only: tfieldmetadata, TYPEREAL
-USE MODD_GRID
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_PARAM_n, ONLY: CCLOUD
-USE MODD_PARAMETERS
+USE MODD_CONF, ONLY: CPROGRAM
+USE MODD_DIAG_FLAG, ONLY: LAIRCRAFT_BALLOON, NTIME_AIRCRAFT_BALLOON, &
+ XALT_BALLOON, XLAT_BALLOON, XLON_BALLOON, XSTEP_AIRCRAFT_BALLOON
+USE MODD_DYN_n, ONLY: DYN_MODEL
+USE MODD_IO, ONLY: ISP, TFILEDATA
+USE MODD_PARAMETERS, ONLY: NUNDEF
!
-USE MODE_GRIDPROJ
-USE MODE_INI_AIRCRAFT
-USE MODE_INI_BALLOON
-USE MODE_ll
-USE MODE_MODELN_HANDLER
-USE MODE_MSG
+USE MODE_GRIDPROJ, ONLY: SM_XYHAT
+USE MODE_INI_AIRCRAFT, ONLY: INI_AIRCRAFT
+USE MODE_INI_BALLOON, ONLY: INI_BALLOON
+USE MODE_MODELN_HANDLER, ONLY: GET_CURRENT_MODEL_INDEX
!
!
IMPLICIT NONE
@@ -90,13 +86,6 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE !Initial file
-REAL, INTENT(IN) :: PTSTEP ! time step
-TYPE(DATE_TIME), INTENT(IN) :: TPDTSEG ! segment date and time
-REAL, INTENT(IN) :: PSEGLEN ! segment length
-INTEGER, INTENT(IN) :: KRR ! number of moist variables
-INTEGER, INTENT(IN) :: KSV ! number of scalar variables
-INTEGER, INTENT(IN) :: KKU ! number of vertical levels
-LOGICAL, INTENT(IN) :: OUSETKE ! flag to use tke
REAL, INTENT(IN) :: PLATOR ! latitude of origine point
REAL, INTENT(IN) :: PLONOR ! longitude of origine point
!
@@ -105,16 +94,11 @@ REAL, INTENT(IN) :: PLONOR ! longitude of origine point
! 0.2 declaration of local variables
!
INTEGER :: IMI ! current model index
-INTEGER :: ISTORE ! number of storage instants
-INTEGER :: ILUOUT ! logical unit
-INTEGER :: IRESP ! return code
INTEGER :: JI
-TYPE(TFIELDMETADATA) :: TZFIELD
!
!----------------------------------------------------------------------------
!
IMI=GET_CURRENT_MODEL_INDEX()
-ILUOUT = TLUOUT%NLU
!----------------------------------------------------------------------------
!
!* 1. Default values
@@ -123,165 +107,86 @@ ILUOUT = TLUOUT%NLU
IF ( CPROGRAM == 'DIAG ') THEN
IF ( .NOT. LAIRCRAFT_BALLOON ) RETURN
IF (NTIME_AIRCRAFT_BALLOON == NUNDEF .OR. XSTEP_AIRCRAFT_BALLOON == XUNDEF) THEN
- WRITE(ILUOUT,*) "NTIME_AIRCRAFT_BALLOON and/or XSTEP_AIRCRAFT_BALLOON not initialized in DIAG "
- WRITE(ILUOUT,*) "No calculations for Balloons and Aircraft"
+ CMNHMSG(1) = "NTIME_AIRCRAFT_BALLOON and/or XSTEP_AIRCRAFT_BALLOON not initialized in DIAG "
+ CMNHMSG(2) = "No calculations for Balloons and Aircraft"
+ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'INI_AIRCRAFT_BALLOON' )
+
LAIRCRAFT_BALLOON=.FALSE.
RETURN
ENDIF
ENDIF
-!
+
+IF ( NAIRCRAFTS > 0 .OR. NBALLOONS > 0 ) LFLYER = .TRUE.
!
!----------------------------------------------------------------------------
!
!* 2. Balloon initialization
! ----------------------
-IF (IMI == 1) CALL INI_BALLOON
-!
-DO JI = 1, NBALLOONS
- CALL INI_LAUNCH( JI, TBALLOONS(JI)%TBALLOON )
-END DO
+IF ( IMI == 1 ) THEN
+ ALLOCATE( NRANKCUR_BALLOON (NBALLOONS) ); NRANKCUR_BALLOON = NFLYER_DEFAULT_RANK
+ ALLOCATE( NRANKNXT_BALLOON (NBALLOONS) ); NRANKNXT_BALLOON = NFLYER_DEFAULT_RANK
+
+ ALLOCATE( TBALLOONS(NBALLOONS) )
+END IF
+
+! Flyers are at first only initialized on 1 process. Data will be transfered later on the right processes
+IF ( ISP == NFLYER_DEFAULT_RANK ) THEN
+ IF ( IMI == 1 ) CALL INI_BALLOON
+
+ DO JI = 1, NBALLOONS
+ CALL INI_LAUNCH( JI, TBALLOONS(JI)%TBALLOON )
+ END DO
+END IF
!
!----------------------------------------------------------------------------
!
!* 3. Aircraft initialization
! -----------------------
!
-IF (IMI == 1) CALL INI_AIRCRAFT
-!
-DO JI = 1, NAIRCRAFTS
- CALL INI_FLIGHT( JI, TAIRCRAFTS(JI)%TAIRCRAFT )
-END DO
+IF ( IMI == 1 ) THEN
+ ALLOCATE( NRANKCUR_AIRCRAFT(NAIRCRAFTS) ); NRANKCUR_AIRCRAFT = NFLYER_DEFAULT_RANK
+ ALLOCATE( NRANKNXT_AIRCRAFT(NAIRCRAFTS) ); NRANKNXT_AIRCRAFT = NFLYER_DEFAULT_RANK
+
+ ALLOCATE( TAIRCRAFTS(NAIRCRAFTS) )
+END IF
+
+! Flyers are at first only initialized on 1 process. Data will be transfered later on the right processes
+IF ( ISP == NFLYER_DEFAULT_RANK ) THEN
+ IF ( IMI == 1 ) CALL INI_AIRCRAFT
+
+ DO JI = 1, NAIRCRAFTS
+ CALL INI_FLIGHT( JI, TAIRCRAFTS(JI)%TAIRCRAFT )
+ END DO
+END IF
!
!----------------------------------------------------------------------------
!
!* 4. Allocations of storage arrays
! -----------------------------
!
-IF (.NOT. LFLYER) RETURN
-!
-DO JI = 1, NBALLOONS
- CALL ALLOCATE_FLYER( TBALLOONS(JI)%TBALLOON )
-END DO
-!
-DO JI = 1, NAIRCRAFTS
- CALL ALLOCATE_FLYER( TAIRCRAFTS(JI)%TAIRCRAFT )
-END DO
+IF ( IMI == 1 .AND. ISP == NFLYER_DEFAULT_RANK ) THEN
+ DO JI = 1, NBALLOONS
+ CALL ALLOCATE_FLYER( TBALLOONS(JI)%TBALLOON )
+ END DO
+
+ DO JI = 1, NAIRCRAFTS
+ CALL ALLOCATE_FLYER( TAIRCRAFTS(JI)%TAIRCRAFT )
+ END DO
+END IF
!
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
!
CONTAINS
!
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-SUBROUTINE ALLOCATE_FLYER(TPFLYER)
-!
-USE MODD_SURF_PAR, ONLY: XUNDEF_SFX => XUNDEF
-!
-CLASS(TFLYERDATA), INTENT(INOUT) :: TPFLYER
-!
-IF (TPFLYER%NMODEL > NMODEL) TPFLYER%NMODEL=0
-IF (IMI /= TPFLYER%NMODEL .AND. .NOT. (IMI==1 .AND. TPFLYER%NMODEL==0) ) RETURN
-!
-IF ( CPROGRAM == 'DIAG ' ) THEN
- ISTORE = INT ( NTIME_AIRCRAFT_BALLOON / TPFLYER%TFLYER_TIME%XTSTEP ) + 1
-ELSE
- ISTORE = NINT ( ( PSEGLEN - DYN_MODEL(1)%XTSTEP ) / TPFLYER%TFLYER_TIME%XTSTEP ) + 1
-ENDIF
-!
-IF (TPFLYER%NMODEL == 0) ISTORE=0
-IF (TPFLYER%NMODEL > 0) THEN
- WRITE(ILUOUT,*) 'Aircraft or Balloon:',TPFLYER%CTITLE,' nmodel=',TPFLYER%NMODEL
-ENDIF
-!
-!
-allocate( tpflyer%tflyer_time%tpdates(istore) )
-ALLOCATE(TPFLYER%NMODELHIST(ISTORE))
-ALLOCATE(TPFLYER%XX (ISTORE))
-ALLOCATE(TPFLYER%XY (ISTORE))
-ALLOCATE(TPFLYER%XZ (ISTORE))
-ALLOCATE(TPFLYER%XLON (ISTORE))
-ALLOCATE(TPFLYER%XLAT (ISTORE))
-ALLOCATE(TPFLYER%XZON (ISTORE))
-ALLOCATE(TPFLYER%XMER (ISTORE))
-ALLOCATE(TPFLYER%XW (ISTORE))
-ALLOCATE(TPFLYER%XP (ISTORE))
-ALLOCATE(TPFLYER%XTH (ISTORE))
-ALLOCATE(TPFLYER%XR (ISTORE,KRR))
-ALLOCATE(TPFLYER%XSV (ISTORE,KSV))
-ALLOCATE(TPFLYER%XRTZ (ISTORE,KKU))
-ALLOCATE(TPFLYER%XRZ (ISTORE,KKU,KRR))
-ALLOCATE(TPFLYER%XFFZ (ISTORE,KKU))
-ALLOCATE(TPFLYER%XIWCZ(ISTORE,KKU))
-ALLOCATE(TPFLYER%XLWCZ(ISTORE,KKU))
-ALLOCATE(TPFLYER%XCIZ (ISTORE,KKU))
-IF (CCLOUD=='LIMA') THEN
- ALLOCATE(TPFLYER%XCCZ(ISTORE,KKU))
- ALLOCATE(TPFLYER%XCRZ(ISTORE,KKU))
-ENDIF
-ALLOCATE(TPFLYER%XCRARE (ISTORE,KKU))
-ALLOCATE(TPFLYER%XCRARE_ATT(ISTORE,KKU))
-ALLOCATE(TPFLYER%XWZ (ISTORE,KKU))
-ALLOCATE(TPFLYER%XZZ (ISTORE,KKU))
-IF (OUSETKE) THEN
- ALLOCATE(TPFLYER%XTKE(ISTORE))
-ELSE
- ALLOCATE(TPFLYER%XTKE(0))
-END IF
-ALLOCATE(TPFLYER%XTKE_DISS(ISTORE))
-ALLOCATE(TPFLYER%XTSRAD (ISTORE))
-ALLOCATE(TPFLYER%XZS (ISTORE))
-!
-ALLOCATE(TPFLYER%XTHW_FLUX(ISTORE))
-ALLOCATE(TPFLYER%XRCW_FLUX(ISTORE))
-ALLOCATE(TPFLYER%XSVW_FLUX(ISTORE,KSV))
-!
-TPFLYER%NMODELHIST = NNEGUNDEF
-TPFLYER%XX = XUNDEF
-TPFLYER%XY = XUNDEF
-TPFLYER%XZ = XUNDEF
-TPFLYER%XLON = XUNDEF
-TPFLYER%XLAT = XUNDEF
-TPFLYER%XZON = XUNDEF
-TPFLYER%XMER = XUNDEF
-TPFLYER%XW = XUNDEF
-TPFLYER%XP = XUNDEF
-TPFLYER%XTH = XUNDEF
-TPFLYER%XR = XUNDEF
-TPFLYER%XSV = XUNDEF
-TPFLYER%XRTZ = XUNDEF
-TPFLYER%XRZ = XUNDEF
-TPFLYER%XFFZ = XUNDEF
-TPFLYER%XCIZ = XUNDEF
-IF (CCLOUD=='LIMA') THEN
- TPFLYER%XCRZ = XUNDEF
- TPFLYER%XCCZ = XUNDEF
-ENDIF
-TPFLYER%XIWCZ = XUNDEF
-TPFLYER%XLWCZ = XUNDEF
-TPFLYER%XCRARE = XUNDEF
-TPFLYER%XCRARE_ATT = XUNDEF
-TPFLYER%XWZ = XUNDEF
-TPFLYER%XZZ = XUNDEF
-TPFLYER%XTKE = XUNDEF
-TPFLYER%XTSRAD = XUNDEF_SFX
-TPFLYER%XZS = XUNDEF
-TPFLYER%XTKE_DISS = XUNDEF
-!
-TPFLYER%XTHW_FLUX = XUNDEF
-TPFLYER%XRCW_FLUX = XUNDEF
-TPFLYER%XSVW_FLUX = XUNDEF
-
-END SUBROUTINE ALLOCATE_FLYER
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
SUBROUTINE INI_LAUNCH(KNBR,TPFLYER)
#ifdef MNH_IOCDF4
USE NETCDF, ONLY: NF90_INQ_NCID, NF90_NOERR
#endif
-USE MODD_IO, ONLY: ISP, TFILEDATA
+use modd_field, only: tfieldmetadata, TYPEREAL
+USE MODD_IO, ONLY: GSMONOPROC, ISP, TFILEDATA
#ifdef MNH_IOCDF4
USE MODD_MPIF
USE MODD_PRECISION, ONLY: CDFINT, CDFINT_MPI
@@ -291,11 +196,7 @@ use MODE_IO_FIELD_READ, only: IO_Field_read
INTEGER, INTENT(IN) :: KNBR
CLASS(TBALLOONDATA), INTENT(INOUT) :: TPFLYER
-!
-!
-!
-!* 0.2 declaration of local variables
-!
+
#ifdef MNH_IOCDF4
INTEGER :: IERR
INTEGER(KIND=CDFINT) :: IGROUPID
@@ -303,19 +204,25 @@ INTEGER(KIND=CDFINT) :: ISTATUS
INTEGER(KIND=CDFINT), DIMENSION(2) :: IDATA ! Intermediate array to allow merge of 2 MPI broadcasts
#endif
INTEGER :: IMODEL
+INTEGER :: IRESP ! return code
+LOGICAL :: OMONOPROC_SAVE ! Copy of true value of GSMONOPROC
LOGICAL :: GREAD ! True if balloon position was read in synchronous file
REAL :: ZLAT ! latitude of the balloon
REAL :: ZLON ! longitude of the balloon
#ifdef MNH_IOCDF4
TYPE(TFILEDATA) :: TZFILE
#endif
+TYPE(TFIELDMETADATA) :: TZFIELD
IF ( IMI /= TPFLYER%NMODEL ) RETURN
-LFLYER = .TRUE.
-
GREAD = .FALSE.
+! Save GSMONOPROC value
+OMONOPROC_SAVE = GSMONOPROC
+! Force GSMONOPROC to true to allow IO_Field_read on only 1 process! (not very clean hack)
+GSMONOPROC = .TRUE.
+
CALL SM_XYHAT( PLATOR, PLONOR, TPFLYER%XLATLAUNCH, TPFLYER%XLONLAUNCH, TPFLYER%XXLAUNCH, TPFLYER%XYLAUNCH )
IF ( CPROGRAM == 'MESONH' .OR. CPROGRAM == 'SPAWN ' .OR. CPROGRAM == 'REAL ' ) THEN
@@ -536,11 +443,14 @@ ELSE IF ( CPROGRAM == 'DIAG ' ) THEN
END IF
END IF
+! Restore correct value of GSMONOPROC
+GSMONOPROC = OMONOPROC_SAVE
+
END SUBROUTINE INI_LAUNCH
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
SUBROUTINE INI_FLIGHT(KNBR,TPFLYER)
-!
+
INTEGER, INTENT(IN) :: KNBR
CLASS(TAIRCRAFTDATA), INTENT(INOUT) :: TPFLYER
@@ -549,8 +459,6 @@ INTEGER :: JSEG ! loop counter
IF ( IMI /= TPFLYER%NMODEL ) RETURN
-LFLYER=.TRUE.
-
! Correct timestep if necessary
! This has to be done at first pass (when IMI=1) to have the correct value as soon as possible
! If 'MOB', set balloon store timestep to be at least the timestep of the coarser model (IMI=1) (with higher timestep)
@@ -602,4 +510,186 @@ END SUBROUTINE FLYER_TIMESTEP_CORRECT
!
END SUBROUTINE INI_AIRCRAFT_BALLOON
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+SUBROUTINE ALLOCATE_FLYER( TPFLYER, KSTORE )
+
+USE MODD_AIRCRAFT_BALLOON, ONLY: TFLYERDATA
+USE MODD_CONF, ONLY: CPROGRAM
+USE MODD_CONF_n, ONLY: NRR
+USE MODD_DIAG_FLAG, ONLY: NTIME_AIRCRAFT_BALLOON
+USE MODD_DIM_n, ONLY: NKMAX
+USE MODD_DYN, ONLY: XSEGLEN
+USE MODD_DYN_n, ONLY: DYN_MODEL
+USE MODD_NSV, ONLY: NSV
+USE MODD_PARAMETERS, ONLY: JPVEXT, NNEGUNDEF, XUNDEF
+USE MODD_PARAM_n, ONLY: CCLOUD, CTURB
+USE MODD_SURF_PAR, ONLY: XUNDEF_SFX => XUNDEF
+
+IMPLICIT NONE
+
+CLASS(TFLYERDATA), INTENT(INOUT) :: TPFLYER
+INTEGER, OPTIONAL, INTENT(IN) :: KSTORE
+
+INTEGER :: IKU ! number of vertical levels
+INTEGER :: ISTORE ! number of storage instants
+
+CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'ALLOCATE_FLYER', 'flyer: ' // TRIM(TPFLYER%CTITLE), OLOCAL = .TRUE. )
+
+IKU = NKMAX + 2 * JPVEXT
+
+IF ( PRESENT( KSTORE ) ) THEN
+ ISTORE = KSTORE
+ELSE
+ IF ( CPROGRAM == 'DIAG ' ) THEN
+ ISTORE = INT ( NTIME_AIRCRAFT_BALLOON / TPFLYER%TFLYER_TIME%XTSTEP ) + 1
+ ELSE
+ ISTORE = NINT ( ( XSEGLEN - DYN_MODEL(1)%XTSTEP ) / TPFLYER%TFLYER_TIME%XTSTEP ) + 1
+ ENDIF
+END IF
+!
+ALLOCATE( TPFLYER%TFLYER_TIME%TPDATES(ISTORE) )
+ALLOCATE( TPFLYER%NMODELHIST(ISTORE) )
+ALLOCATE( TPFLYER%XX (ISTORE) )
+ALLOCATE( TPFLYER%XY (ISTORE) )
+ALLOCATE( TPFLYER%XZ (ISTORE) )
+ALLOCATE( TPFLYER%XLON (ISTORE) )
+ALLOCATE( TPFLYER%XLAT (ISTORE) )
+ALLOCATE( TPFLYER%XZON (ISTORE) )
+ALLOCATE( TPFLYER%XMER (ISTORE) )
+ALLOCATE( TPFLYER%XW (ISTORE) )
+ALLOCATE( TPFLYER%XP (ISTORE) )
+ALLOCATE( TPFLYER%XTH (ISTORE) )
+ALLOCATE( TPFLYER%XR (ISTORE, NRR) )
+ALLOCATE( TPFLYER%XSV (ISTORE, NSV) )
+ALLOCATE( TPFLYER%XRTZ (ISTORE, IKU) )
+ALLOCATE( TPFLYER%XRZ (ISTORE, IKU, NRR) )
+ALLOCATE( TPFLYER%XFFZ (ISTORE, IKU) )
+ALLOCATE( TPFLYER%XIWCZ(ISTORE, IKU) )
+ALLOCATE( TPFLYER%XLWCZ(ISTORE, IKU) )
+ALLOCATE( TPFLYER%XCIZ (ISTORE, IKU) )
+IF ( CCLOUD == 'LIMA' ) THEN
+ ALLOCATE( TPFLYER%XCCZ(ISTORE, IKU) )
+ ALLOCATE( TPFLYER%XCRZ(ISTORE, IKU) )
+ELSE
+ ALLOCATE( TPFLYER%XCCZ(0, 0) )
+ ALLOCATE( TPFLYER%XCRZ(0, 0) )
+ENDIF
+ALLOCATE( TPFLYER%XCRARE (ISTORE, IKU) )
+ALLOCATE( TPFLYER%XCRARE_ATT(ISTORE, IKU) )
+ALLOCATE( TPFLYER%XWZ (ISTORE, IKU) )
+ALLOCATE( TPFLYER%XZZ (ISTORE, IKU) )
+IF ( CTURB == 'TKEL' ) THEN
+ ALLOCATE( TPFLYER%XTKE(ISTORE) )
+ELSE
+ ALLOCATE( TPFLYER%XTKE(0) )
+END IF
+ALLOCATE( TPFLYER%XTKE_DISS(ISTORE) )
+ALLOCATE( TPFLYER%XTSRAD (ISTORE) )
+ALLOCATE( TPFLYER%XZS (ISTORE) )
+
+ALLOCATE( TPFLYER%XTHW_FLUX(ISTORE) )
+ALLOCATE( TPFLYER%XRCW_FLUX(ISTORE) )
+ALLOCATE( TPFLYER%XSVW_FLUX(ISTORE, NSV) )
+
+TPFLYER%NMODELHIST = NNEGUNDEF
+TPFLYER%XX = XUNDEF
+TPFLYER%XY = XUNDEF
+TPFLYER%XZ = XUNDEF
+TPFLYER%XLON = XUNDEF
+TPFLYER%XLAT = XUNDEF
+TPFLYER%XZON = XUNDEF
+TPFLYER%XMER = XUNDEF
+TPFLYER%XW = XUNDEF
+TPFLYER%XP = XUNDEF
+TPFLYER%XTH = XUNDEF
+TPFLYER%XR = XUNDEF
+TPFLYER%XSV = XUNDEF
+TPFLYER%XRTZ = XUNDEF
+TPFLYER%XRZ = XUNDEF
+TPFLYER%XFFZ = XUNDEF
+TPFLYER%XIWCZ = XUNDEF
+TPFLYER%XLWCZ = XUNDEF
+TPFLYER%XCIZ = XUNDEF
+TPFLYER%XCCZ = XUNDEF
+TPFLYER%XCRZ = XUNDEF
+TPFLYER%XCRARE = XUNDEF
+TPFLYER%XCRARE_ATT = XUNDEF
+TPFLYER%XWZ = XUNDEF
+TPFLYER%XZZ = XUNDEF
+TPFLYER%XTKE = XUNDEF
+TPFLYER%XTKE_DISS = XUNDEF
+TPFLYER%XTSRAD = XUNDEF_SFX
+TPFLYER%XZS = XUNDEF
+
+TPFLYER%XTHW_FLUX = XUNDEF
+TPFLYER%XRCW_FLUX = XUNDEF
+TPFLYER%XSVW_FLUX = XUNDEF
+
+END SUBROUTINE ALLOCATE_FLYER
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+SUBROUTINE DEALLOCATE_FLYER( TPFLYER )
+
+USE MODD_AIRCRAFT_BALLOON, ONLY: TAIRCRAFTDATA, TFLYERDATA
+
+IMPLICIT NONE
+
+CLASS(TFLYERDATA), INTENT(INOUT) :: TPFLYER
+
+CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'DEALLOCATE_FLYER', 'flyer: ' // TRIM(TPFLYER%CTITLE), OLOCAL = .TRUE. )
+
+DEALLOCATE( TPFLYER%TFLYER_TIME%TPDATES )
+DEALLOCATE( TPFLYER%NMODELHIST )
+DEALLOCATE( TPFLYER%XX )
+DEALLOCATE( TPFLYER%XY )
+DEALLOCATE( TPFLYER%XZ )
+DEALLOCATE( TPFLYER%XLON )
+DEALLOCATE( TPFLYER%XLAT )
+DEALLOCATE( TPFLYER%XZON )
+DEALLOCATE( TPFLYER%XMER )
+DEALLOCATE( TPFLYER%XW )
+DEALLOCATE( TPFLYER%XP )
+DEALLOCATE( TPFLYER%XTH )
+DEALLOCATE( TPFLYER%XR )
+DEALLOCATE( TPFLYER%XSV )
+DEALLOCATE( TPFLYER%XRTZ )
+DEALLOCATE( TPFLYER%XRZ )
+DEALLOCATE( TPFLYER%XFFZ )
+DEALLOCATE( TPFLYER%XIWCZ )
+DEALLOCATE( TPFLYER%XLWCZ )
+DEALLOCATE( TPFLYER%XCIZ )
+DEALLOCATE( TPFLYER%XCCZ )
+DEALLOCATE( TPFLYER%XCRZ )
+DEALLOCATE( TPFLYER%XCRARE )
+DEALLOCATE( TPFLYER%XCRARE_ATT )
+DEALLOCATE( TPFLYER%XWZ )
+DEALLOCATE( TPFLYER%XZZ )
+DEALLOCATE( TPFLYER%XTKE )
+DEALLOCATE( TPFLYER%XTKE_DISS )
+DEALLOCATE( TPFLYER%XTSRAD )
+DEALLOCATE( TPFLYER%XZS )
+
+DEALLOCATE( TPFLYER%XTHW_FLUX )
+DEALLOCATE( TPFLYER%XRCW_FLUX )
+DEALLOCATE( TPFLYER%XSVW_FLUX )
+
+SELECT TYPE( TPFLYER )
+ CLASS IS ( TAIRCRAFTDATA )
+ DEALLOCATE( TPFLYER%XPOSLAT )
+ DEALLOCATE( TPFLYER%XPOSLON )
+ DEALLOCATE( TPFLYER%XPOSX )
+ DEALLOCATE( TPFLYER%XPOSY )
+ IF ( TPFLYER%LALTDEF ) THEN
+ DEALLOCATE( TPFLYER%XPOSP )
+ ELSE
+ DEALLOCATE( TPFLYER%XPOSZ )
+ END IF
+ DEALLOCATE( TPFLYER%XPOSTIME )
+END SELECT
+
+END SUBROUTINE DEALLOCATE_FLYER
+!----------------------------------------------------------------------------
+!----------------------------------------------------------------------------
+
END MODULE MODE_INI_AIRCRAFT_BALLOON
diff --git a/src/MNH/ini_balloon.f90 b/src/MNH/ini_balloon.f90
index 7e268fb43..342eb5abf 100644
--- a/src/MNH/ini_balloon.f90
+++ b/src/MNH/ini_balloon.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2000-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -119,8 +119,6 @@ IMPLICIT NONE
INTEGER :: JI
TYPE(TBALLOONDATA), POINTER :: TZBALLOON
-ALLOCATE( TBALLOONS(NBALLOONS) )
-
!Treat balloon data read in namelist
DO JI = 1, NBALLOONS
ALLOCATE( TBALLOONS(JI)%TBALLOON )
@@ -133,7 +131,7 @@ DO JI = 1, NBALLOONS
WRITE( CMNHMSG(1), FMT = '( A, I4 )' ) 'no title given to balloon number ', JI
CMNHMSG(2) = 'title set to ' // TRIM( CTITLE(JI) )
- CALL PRINT_MSG( NVERB_INFO, 'GEN', 'INI_BALLOON' )
+ CALL PRINT_MSG( NVERB_INFO, 'GEN', 'INI_BALLOON', OLOCAL = .TRUE. )
END IF
TZBALLOON%CTITLE = CTITLE(JI)
@@ -141,13 +139,14 @@ DO JI = 1, NBALLOONS
IF ( NMODEL(JI) < 1 .OR. NMODEL(JI) > NMODEL_NEST ) THEN
CMNHMSG(1) = 'invalid NMODEL balloon ' // TRIM( CTITLE(JI) )
CMNHMSG(2) = 'NMODEL must be between 1 and the last nested model number'
- CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_BALLOON' )
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_BALLOON', OLOCAL = .TRUE. )
NMODEL(JI) = 1
END IF
ELSE IF ( CMODEL(JI) == 'MOB' ) THEN
IF ( NMODEL(JI) /= 0 .AND. NMODEL(JI) /= 1 ) THEN
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'INI_BALLOON', &
- 'NMODEL is set to 1 at start for a CMODEL="MOB" balloon (balloon ' // TRIM( CTITLE(JI) ) // ')' )
+ 'NMODEL is set to 1 at start for a CMODEL="MOB" balloon (balloon ' // TRIM( CTITLE(JI) ) // ')', &
+ OLOCAL = .TRUE.)
END IF
IF ( NMODEL_NEST == 1 ) CMODEL(JI) = 'FIX' ! If only one model, FIX and MOB are the same
! NMODEL set temporarily to 1. Will be set to the launch model in INI_LAUNCH
@@ -155,7 +154,7 @@ DO JI = 1, NBALLOONS
ELSE
CMNHMSG(1) = 'invalid CMODEL (' // TRIM( CMODEL(JI) ) // ') for balloon ' // TRIM( CTITLE(JI) )
CMNHMSG(2) = 'CMODEL must be FIX or MOB (default="FIX")'
- CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_BALLOON' )
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_BALLOON', OLOCAL = .TRUE. )
CMODEL(JI) = 'FIX'
NMODEL(JI) = 1
END IF
@@ -166,23 +165,26 @@ DO JI = 1, NBALLOONS
IF ( .NOT. TLAUNCH(JI)%CHECK( TRIM( CTITLE(JI) ) ) ) &
CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_BALLOON', &
- 'problem with TLAUNCH (not set or incorrect values) for balloon ' // TRIM( CTITLE(JI) ) )
+ 'problem with TLAUNCH (not set or incorrect values) for balloon ' // TRIM( CTITLE(JI) ), OLOCAL = .TRUE. )
TZBALLOON%TLAUNCH = TLAUNCH(JI)
IF ( XLATLAUNCH(JI) == XUNDEF ) &
- CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_BALLOON', 'XLATLAUNCH not provided for balloon ' // TRIM( CTITLE(JI) ) )
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_BALLOON', 'XLATLAUNCH not provided for balloon ' // TRIM( CTITLE(JI) ), &
+ OLOCAL = .TRUE. )
TZBALLOON%XLATLAUNCH = XLATLAUNCH(JI)
IF ( XLONLAUNCH(JI) == XUNDEF ) &
- CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_BALLOON', 'XLONLAUNCH not provided for balloon ' // TRIM( CTITLE(JI) ) )
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_BALLOON', 'XLONLAUNCH not provided for balloon ' // TRIM( CTITLE(JI) ), &
+ OLOCAL = .TRUE. )
TZBALLOON%XLONLAUNCH = XLONLAUNCH(JI)
IF ( XTSTEP(JI) == XNEGUNDEF ) THEN
CALL PRINT_MSG( NVERB_INFO, 'GEN', 'INI_BALLOON', &
- 'data storage frequency not provided for balloon ' // TRIM( CTITLE(JI) ) // ' => set to 60s' )
+ 'data storage frequency not provided for balloon ' // TRIM( CTITLE(JI) ) // ' => set to 60s', OLOCAL = .TRUE. )
XTSTEP(JI) = 60.
ELSE IF ( XTSTEP(JI) <=0. ) THEN
- CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_BALLOON', 'invalid data storage frequency for balloon ' // TRIM( CTITLE(JI) ) )
+ CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_BALLOON', 'invalid data storage frequency for balloon ' // TRIM( CTITLE(JI) ), &
+ OLOCAL = .TRUE. )
XTSTEP(JI) = 60.
END IF
TZBALLOON%TFLYER_TIME%XTSTEP = XTSTEP(JI)
@@ -192,17 +194,19 @@ DO JI = 1, NBALLOONS
IF ( XALTLAUNCH(JI) == XNEGUNDEF .AND. XPRES(JI) == XNEGUNDEF ) THEN
CMNHMSG(1) = 'altitude or pressure at launch not provided for CVBALL balloon ' // TRIM( CTITLE(JI) )
CMNHMSG(2) = 'altitude with same air density than balloon will be used for the launch position'
- CALL PRINT_MSG( NVERB_INFO, 'GEN', 'INI_BALLOON' )
+ CALL PRINT_MSG( NVERB_INFO, 'GEN', 'INI_BALLOON' , OLOCAL = .TRUE.)
END IF
IF ( XALTLAUNCH(JI) /= XNEGUNDEF .AND. XPRES(JI) /= XNEGUNDEF ) &
CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_BALLOON', &
- 'altitude or pressure at launch (not both) must be provided for ISODEN balloon ' // TRIM( CTITLE(JI) ) )
+ 'altitude or pressure at launch (not both) must be provided for ISODEN balloon ' // TRIM( CTITLE(JI) ), &
+ OLOCAL = .TRUE. )
TZBALLOON%XALTLAUNCH = XALTLAUNCH(JI)
TZBALLOON%XPRES = XPRES(JI)
IF ( XWASCENT(JI) == XNEGUNDEF ) THEN
CALL PRINT_MSG( NVERB_INFO, 'GEN', 'INI_BALLOON', &
- 'initial vertical speed not provided for CVBALL balloon ' // TRIM( CTITLE(JI) ) // ' => set to 0.' )
+ 'initial vertical speed not provided for CVBALL balloon ' // TRIM( CTITLE(JI) ) // ' => set to 0.' , &
+ OLOCAL = .TRUE.)
XWASCENT(JI) = 0.
END IF
TZBALLOON%XWASCENT = XWASCENT(JI)
@@ -210,25 +214,28 @@ DO JI = 1, NBALLOONS
IF ( XAERODRAG(JI) == XNEGUNDEF ) THEN
CALL PRINT_MSG( NVERB_INFO, 'GEN', 'INI_BALLOON', &
- 'aerodynamic drag coefficient not provided for CVBALL balloon ' // TRIM( CTITLE(JI) ) // ' => set to 0.44' )
+ 'aerodynamic drag coefficient not provided for CVBALL balloon ' // TRIM( CTITLE(JI) ) &
+ // ' => set to 0.44', OLOCAL = .TRUE.)
XAERODRAG(JI) = 0.44
END IF
TZBALLOON%XAERODRAG = XAERODRAG(JI)
IF ( XINDDRAG(JI) == XNEGUNDEF ) THEN
CALL PRINT_MSG( NVERB_INFO, 'GEN', 'INI_BALLOON', &
- 'induced drag coefficient not provided for CVBALL balloon ' // TRIM( CTITLE(JI) ) // ' => set to 0.014' )
+ 'induced drag coefficient not provided for CVBALL balloon ' // TRIM( CTITLE(JI) ) // ' => set to 0.014', &
+ OLOCAL = .TRUE.)
XINDDRAG(JI) = 0.014
END IF
TZBALLOON%XINDDRAG = XINDDRAG(JI)
IF ( XMASS(JI) == XNEGUNDEF ) &
- CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'INI_BALLOON', 'mass not provided for CVBALL balloon ' // TRIM( CTITLE(JI) ) )
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'INI_BALLOON', 'mass not provided for CVBALL balloon ' // TRIM( CTITLE(JI) ), &
+ OLOCAL = .TRUE. )
TZBALLOON%XMASS = XMASS(JI)
IF ( XDIAMETER(JI) <= 0. .AND. XVOLUME(JI) <= 0. ) &
CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'INI_BALLOON', &
- 'diameter or volume not provided for CVBALL balloon ' // TRIM( CTITLE(JI) ) )
+ 'diameter or volume not provided for CVBALL balloon ' // TRIM( CTITLE(JI) ), OLOCAL = .TRUE. )
IF ( XDIAMETER(JI) <= 0. ) THEN
TZBALLOON%XVOLUME = XVOLUME(JI)
@@ -238,23 +245,27 @@ DO JI = 1, NBALLOONS
TZBALLOON%XVOLUME = XPI / 6 * XDIAMETER(JI)**3
ELSE
CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_BALLOON', &
- 'diameter or volume (not both) must be provided for CVBALL balloon ' // TRIM( CTITLE(JI) ) )
+ 'diameter or volume (not both) must be provided for CVBALL balloon ' // TRIM( CTITLE(JI) ), &
+ OLOCAL = .TRUE. )
END IF
CASE ( 'ISODEN' )
IF ( XALTLAUNCH(JI) == XNEGUNDEF .AND. XPRES(JI) == XNEGUNDEF ) &
CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'INI_BALLOON', &
- 'altitude or pressure at launch must be provided for ISODEN balloon ' // TRIM( CTITLE(JI) ) )
+ 'altitude or pressure at launch must be provided for ISODEN balloon ' // TRIM( CTITLE(JI) ), &
+ OLOCAL = .TRUE. )
IF ( XALTLAUNCH(JI) /= XNEGUNDEF .AND. XPRES(JI) /= XNEGUNDEF ) &
CALL PRINT_MSG( NVERB_ERROR, 'GEN', 'INI_BALLOON', &
- 'altitude or pressure at launch (not both) must be provided for ISODEN balloon ' // TRIM( CTITLE(JI) ) )
+ 'altitude or pressure at launch (not both) must be provided for ISODEN balloon ' // TRIM( CTITLE(JI) ), &
+ OLOCAL = .TRUE.)
TZBALLOON%XALTLAUNCH = XALTLAUNCH(JI)
TZBALLOON%XPRES = XPRES(JI)
IF ( XWASCENT(JI) /= XNEGUNDEF ) THEN
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'INI_BALLOON', &
- 'initial vertical speed is not needed for ISODEN balloon ' // TRIM( CTITLE(JI) ) // ' => ignored' )
+ 'initial vertical speed is not needed for ISODEN balloon ' // TRIM( CTITLE(JI) ) // ' => ignored', &
+ OLOCAL = .TRUE. )
XWASCENT(JI) = XNEGUNDEF
END IF
TZBALLOON%XWASCENT = XWASCENT(JI)
@@ -262,35 +273,37 @@ DO JI = 1, NBALLOONS
IF ( XAERODRAG(JI) /= XNEGUNDEF ) THEN
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'INI_BALLOON', &
- 'aerodynamic drag coefficient is not needed for ISODEN balloon ' // TRIM( CTITLE(JI) ) // ' => ignored' )
+ 'aerodynamic drag coefficient is not needed for ISODEN balloon ' // TRIM( CTITLE(JI) ) // ' => ignored', &
+ OLOCAL = .TRUE. )
XAERODRAG(JI) = XNEGUNDEF
END IF
TZBALLOON%XAERODRAG = XAERODRAG(JI)
IF ( XINDDRAG(JI) /= XNEGUNDEF ) THEN
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'INI_BALLOON', &
- 'induced drag coefficient is not needed for ISODEN balloon ' // TRIM( CTITLE(JI) ) // ' => ignored' )
+ 'induced drag coefficient is not needed for ISODEN balloon ' // TRIM( CTITLE(JI) ) // ' => ignored' , &
+ OLOCAL = .TRUE.)
XINDDRAG(JI) = XNEGUNDEF
END IF
TZBALLOON%XINDDRAG = XINDDRAG(JI)
IF ( XMASS(JI) /= XNEGUNDEF ) THEN
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'INI_BALLOON', &
- 'mass is not needed for ISODEN balloon ' // TRIM( CTITLE(JI) ) // ' => ignored' )
+ 'mass is not needed for ISODEN balloon ' // TRIM( CTITLE(JI) ) // ' => ignored', OLOCAL = .TRUE. )
XMASS(JI) = XNEGUNDEF
END IF
TZBALLOON%XMASS = XMASS(JI)
IF ( XDIAMETER(JI) /= XNEGUNDEF ) THEN
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'INI_BALLOON', &
- 'diameter is not needed for ISODEN balloon ' // TRIM( CTITLE(JI) ) // ' => ignored' )
+ 'diameter is not needed for ISODEN balloon ' // TRIM( CTITLE(JI) ) // ' => ignored', OLOCAL = .TRUE. )
XDIAMETER(JI) = XNEGUNDEF
END IF
TZBALLOON%XDIAMETER = XDIAMETER(JI)
IF ( XVOLUME(JI) /= XNEGUNDEF ) THEN
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'INI_BALLOON', &
- 'volume is not needed for ISODEN balloon ' // TRIM( CTITLE(JI) ) // ' => ignored' )
+ 'volume is not needed for ISODEN balloon ' // TRIM( CTITLE(JI) ) // ' => ignored', OLOCAL = .TRUE. )
XVOLUME(JI) = XNEGUNDEF
END IF
TZBALLOON%XVOLUME = XVOLUME(JI)
@@ -299,12 +312,13 @@ DO JI = 1, NBALLOONS
CASE ( 'RADIOS' )
IF ( XALTLAUNCH(JI) == XNEGUNDEF ) &
CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'INI_BALLOON', &
- 'altitude of launch must be provided for radiosounding balloon ' // TRIM( CTITLE(JI) ) )
+ 'altitude of launch must be provided for radiosounding balloon ' // TRIM( CTITLE(JI) ), OLOCAL = .TRUE. )
TZBALLOON%XALTLAUNCH = XALTLAUNCH(JI)
IF ( XWASCENT(JI) == XNEGUNDEF ) THEN
CALL PRINT_MSG( NVERB_INFO, 'GEN', 'INI_BALLOON', &
- 'initial vertical speed not provided for balloon ' // TRIM( CTITLE(JI) ) // ' => set to 5.' )
+ 'initial vertical speed not provided for balloon ' // TRIM( CTITLE(JI) ) // ' => set to 5.', &
+ OLOCAL = .TRUE. )
XWASCENT(JI) = 5.
END IF
TZBALLOON%XWASCENT = XWASCENT(JI)
@@ -312,7 +326,7 @@ DO JI = 1, NBALLOONS
IF ( XPRES(JI) /= XNEGUNDEF ) THEN
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'INI_BALLOON', &
'initial pressure is not needed for radiosounding balloon ' &
- // TRIM( CTITLE(JI) ) // ' => ignored' )
+ // TRIM( CTITLE(JI) ) // ' => ignored', OLOCAL = .TRUE. )
XPRES(JI) = XNEGUNDEF
END IF
TZBALLOON%XAERODRAG = XAERODRAG(JI)
@@ -320,7 +334,7 @@ DO JI = 1, NBALLOONS
IF ( XAERODRAG(JI) /= XNEGUNDEF ) THEN
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'INI_BALLOON', &
'aerodynamic drag coefficient is not needed for radiosounding balloon ' &
- // TRIM( CTITLE(JI) ) // ' => ignored' )
+ // TRIM( CTITLE(JI) ) // ' => ignored', OLOCAL = .TRUE. )
XAERODRAG(JI) = XNEGUNDEF
END IF
TZBALLOON%XAERODRAG = XAERODRAG(JI)
@@ -328,28 +342,29 @@ DO JI = 1, NBALLOONS
IF ( XINDDRAG(JI) /= XNEGUNDEF ) THEN
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'INI_BALLOON', &
'induced drag coefficient is not needed for radiosounding balloon ' &
- // TRIM( CTITLE(JI) ) // ' => ignored' )
+ // TRIM( CTITLE(JI) ) // ' => ignored', OLOCAL = .TRUE. )
XINDDRAG(JI) = XNEGUNDEF
END IF
TZBALLOON%XINDDRAG = XINDDRAG(JI)
IF ( XMASS(JI) /= XNEGUNDEF ) THEN
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'INI_BALLOON', &
- 'mass is not needed for radiosounding balloon ' // TRIM( CTITLE(JI) ) // ' => ignored' )
+ 'mass is not needed for radiosounding balloon ' // TRIM( CTITLE(JI) ) // ' => ignored', OLOCAL = .TRUE. )
XMASS(JI) = XNEGUNDEF
END IF
TZBALLOON%XMASS = XMASS(JI)
IF ( XDIAMETER(JI) /= XNEGUNDEF ) THEN
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'INI_BALLOON', &
- 'diameter is not needed for radiosounding balloon ' // TRIM( CTITLE(JI) ) // ' => ignored' )
+ 'diameter is not needed for radiosounding balloon ' // TRIM( CTITLE(JI) ) // ' => ignored', &
+ OLOCAL = .TRUE. )
XDIAMETER(JI) = XNEGUNDEF
END IF
TZBALLOON%XDIAMETER = XDIAMETER(JI)
IF ( XVOLUME(JI) /= XNEGUNDEF ) THEN
CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'INI_BALLOON', &
- 'volume is not needed for radiosounding balloon ' // TRIM( CTITLE(JI) ) // ' => ignored' )
+ 'volume is not needed for radiosounding balloon ' // TRIM( CTITLE(JI) ) // ' => ignored', OLOCAL = .TRUE. )
XVOLUME(JI) = XNEGUNDEF
END IF
TZBALLOON%XVOLUME = XVOLUME(JI)
@@ -357,7 +372,7 @@ DO JI = 1, NBALLOONS
CASE DEFAULT
CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'INI_BALLOON', 'invalid balloon type (CTYPE=' &
- // TRIM( CTYPE(JI ) ) // ') for balloon ' // TRIM( CTITLE(JI) ) )
+ // TRIM( CTYPE(JI ) ) // ') for balloon ' // TRIM( CTITLE(JI) ), OLOCAL = .TRUE. )
END SELECT
END DO
diff --git a/src/MNH/ini_modeln.f90 b/src/MNH/ini_modeln.f90
index 81161434a..902d21e1c 100644
--- a/src/MNH/ini_modeln.f90
+++ b/src/MNH/ini_modeln.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -2557,9 +2557,7 @@ DEALLOCATE(XSPOWATM)
!* 23. BALLOON and AIRCRAFT initializations
! ------------------------------------
!
-CALL INI_AIRCRAFT_BALLOON(TPINIFILE,XTSTEP, TDTSEG, XSEGLEN, NRR, NSV, &
- IKU,CTURB=="TKEL" , &
- XLATORI, XLONORI )
+CALL INI_AIRCRAFT_BALLOON( TPINIFILE, XLATORI, XLONORI )
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/modd_aircraft_balloon.f90 b/src/MNH/modd_aircraft_balloon.f90
index 92d1ade55..9383f1451 100644
--- a/src/MNH/modd_aircraft_balloon.f90
+++ b/src/MNH/modd_aircraft_balloon.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2000-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -56,6 +56,8 @@ INTEGER, PARAMETER :: NCRASH_OUT_HORIZ = 1 ! Flyer is outside of horizontal doma
INTEGER, PARAMETER :: NCRASH_OUT_LOW = 2 ! Flyer crashed on ground (or sea!)
INTEGER, PARAMETER :: NCRASH_OUT_HIGH = 3 ! Flyer is too high (outside of domain)
+INTEGER, PARAMETER :: NFLYER_DEFAULT_RANK = 1
+
LOGICAL :: LFLYER = .FALSE. ! flag to use aircraft/balloons
TYPE :: TFLYERDATA
@@ -90,7 +92,7 @@ TYPE :: TFLYERDATA
REAL :: XY_CUR = XNEGUNDEF ! current y
REAL :: XZ_CUR = XNEGUNDEF ! current z (if 'RADIOS' or 'AIRCRA' and 'ALTDEF' = T)
REAL :: XP_CUR = XNEGUNDEF ! current p (if 'AIRCRA' and 'ALTDEF' = F)
- INTEGER :: NRANK_CUR = NNEGUNDEF ! Rank of the process where the flyer is
+ INTEGER :: NRANK_CUR = NFLYER_DEFAULT_RANK ! Rank of the process where the flyer is
!
!* data records
!
@@ -121,8 +123,6 @@ TYPE :: TFLYERDATA
REAL, DIMENSION(:,:), ALLOCATABLE :: XCRARE_ATT ! attenuated (= more realistic) cloud radar reflectivity
REAL, DIMENSION(:,:), ALLOCATABLE :: XWZ ! vertical profile of vertical velocity
REAL, DIMENSION(:,:), ALLOCATABLE :: XZZ ! vertical profile of mass point altitude (above sea)
- REAL, DIMENSION(:,:), ALLOCATABLE :: XAER ! Extinction at 550 nm
- REAL, DIMENSION(:,:), ALLOCATABLE :: XDST_WL ! Extinction by wavelength
REAL, DIMENSION(:), ALLOCATABLE :: XZS ! zs(n)
REAL, DIMENSION(:), ALLOCATABLE :: XTSRAD ! Ts(n)
!
@@ -190,5 +190,10 @@ TYPE(TAIRCRAFT_PTR), DIMENSION(:), ALLOCATABLE :: TAIRCRAFTS ! characteristics a
TYPE(TBALLOON_PTR), DIMENSION(:), ALLOCATABLE :: TBALLOONS ! characteristics and records of the balloons
+INTEGER, DIMENSION(:), ALLOCATABLE :: NRANKCUR_AIRCRAFT ! Array to store the rank of the process where a given aircraft is present
+INTEGER, DIMENSION(:), ALLOCATABLE :: NRANKNXT_AIRCRAFT ! Array to store the rank of the process where a given aircraft is going
+
+INTEGER, DIMENSION(:), ALLOCATABLE :: NRANKCUR_BALLOON ! Array to store the rank of the process where a given ballon is present
+INTEGER, DIMENSION(:), ALLOCATABLE :: NRANKNXT_BALLOON ! Array to store the rank of the process where a given ballon is going
END MODULE MODD_AIRCRAFT_BALLOON
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index 8d9b03f17..a0d66c654 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -2232,6 +2232,8 @@ IF (OEXIT) THEN
CALL MENU_DIACHRO(TDIAFILE,'END')
#endif
CALL IO_File_close(TDIAFILE)
+ ! Free memory of flyer that is not present on the master process of the file (was allocated in WRITE_AIRCRAFT_BALLOON)
+ CALL AIRCRAFT_BALLOON_FREE_NONLOCAL( TDIAFILE )
END IF
!
CALL IO_File_close(TINIFILE)
diff --git a/src/MNH/read_desfmn.f90 b/src/MNH/read_desfmn.f90
index cc91eec5f..fb645f295 100644
--- a/src/MNH/read_desfmn.f90
+++ b/src/MNH/read_desfmn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -268,6 +268,7 @@ USE MODN_PROFILER_n
USE MODN_STATION_n
!
USE MODN_PARAM_LIMA
+! USE MODN_FLYERS
!
USE MODE_MSG
USE MODE_POS
@@ -546,7 +547,7 @@ IF (KMI == 1) THEN
READ(UNIT=ILUDES,NML=NAM_OUTPUT)
END IF
! Note: it is not useful to read the budget namelists in the .des files
-! The value here (if present in file) don't need to be compared with the ones in the EXSEGn files
+! The values here (if present in file) don't need to be compared with the ones in the EXSEGn files
! CALL POSNAM(ILUDES,'NAM_BUDGET',GFOUND)
! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BUDGET)
! CALL POSNAM(ILUDES,'NAM_BU_RU',GFOUND)
@@ -622,7 +623,15 @@ IF (KMI == 1) THEN
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_LATZ_EDFLX)
CALL POSNAM(ILUDES,'NAM_VISC',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_VISC)
-END IF
+! Note: it is not useful to read the FLYERS/AIRCRAFTS/BALLOONS namelists in the .des files
+! The values here (if present in file) don't need to be compared with the ones in the EXSEGn files
+! CALL POSNAM(ILUDES,'NAM_FLYERS',GFOUND,ILUOUT)
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_FLYERS)
+! CALL POSNAM(ILUSEG,'NAM_AIRCRAFTS',GFOUND,ILUOUT)
+! IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_AIRCRAFTS)
+! CALL POSNAM(ILUSEG,'NAM_BALLOONS',GFOUND,ILUOUT)
+! IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BALLOONS)
+END IF
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/write_aircraft_balloon.f90 b/src/MNH/write_aircraft_balloon.f90
index decf8c040..2284be8ea 100644
--- a/src/MNH/write_aircraft_balloon.f90
+++ b/src/MNH/write_aircraft_balloon.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2000-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -9,10 +9,13 @@ MODULE MODE_WRITE_AIRCRAFT_BALLOON
use modd_parameters, only: NCOMMENTLGTMAX, NMNHNAMELGTMAX, NUNITLGTMAX
+use mode_msg
+
implicit none
private
+PUBLIC :: AIRCRAFT_BALLOON_FREE_NONLOCAL
public :: WRITE_AIRCRAFT_BALLOON
CHARACTER(LEN=NCOMMENTLGTMAX), DIMENSION(:), ALLOCATABLE :: CCOMMENT ! comment string(
@@ -80,7 +83,9 @@ SUBROUTINE WRITE_AIRCRAFT_BALLOON(TPDIAFILE)
! ------------
!
USE MODD_AIRCRAFT_BALLOON
-USE MODD_IO, ONLY: TFILEDATA
+USE MODD_IO, ONLY: ISP, TFILEDATA
+!
+USE MODE_AIRCRAFT_BALLOON, ONLY: FLYER_RECV_AND_ALLOCATE, FLYER_SEND
!
IMPLICIT NONE
!
@@ -96,17 +101,100 @@ TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
INTEGER :: JI
!
!----------------------------------------------------------------------------
-!
+
DO JI = 1, NBALLOONS
- CALL FLYER_DIACHRO( TPDIAFILE, TBALLOONS(JI)%TBALLOON )
+ ! 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 FLYER_SEND( TBALLOONS(JI)%TBALLOON, TPDIAFILE%NMASTER_RANK )
+ END IF
+
+ IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
+ ! Receive data from owner if not available on the writer process
+ IF ( NRANKCUR_BALLOON(JI) /= TPDIAFILE%NMASTER_RANK ) THEN
+ 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) )
+ END IF
+
+ ! Write data
+ 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
+ ! file master process at this last stage (coordinates writing)
+ END IF
END DO
DO JI = 1, NAIRCRAFTS
- CALL FLYER_DIACHRO( TPDIAFILE, TAIRCRAFTS(JI)%TAIRCRAFT )
+ ! The aircraft 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_AIRCRAFT(JI) .AND. NRANKCUR_AIRCRAFT(JI) /= TPDIAFILE%NMASTER_RANK ) THEN
+ CALL FLYER_SEND( TAIRCRAFTS(JI)%TAIRCRAFT, TPDIAFILE%NMASTER_RANK )
+ END IF
+
+ IF ( ISP == TPDIAFILE%NMASTER_RANK ) THEN
+ ! Receive data from owner if not available on the writer process (need to be done only for the first model)
+ IF ( NRANKCUR_AIRCRAFT(JI) /= TPDIAFILE%NMASTER_RANK ) THEN
+ 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) )
+ END IF
+
+ ! Write data
+ 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
+ ! file master process at this last stage (coordinates writing)
+ END IF
END DO
-!
+
END SUBROUTINE WRITE_AIRCRAFT_BALLOON
-!
+
+
+! ####################################################
+SUBROUTINE AIRCRAFT_BALLOON_FREE_NONLOCAL( TPDIAFILE )
+! ####################################################
+
+USE MODD_AIRCRAFT_BALLOON, ONLY: NAIRCRAFTS, NBALLOONS, NRANKCUR_AIRCRAFT, NRANKCUR_BALLOON, TAIRCRAFTS, TBALLOONS
+USE MODD_IO, ONLY: ISP, TFILEDATA
+
+USE MODE_INI_AIRCRAFT_BALLOON, ONLY: DEALLOCATE_FLYER
+
+IMPLICIT NONE
+
+TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE
+
+INTEGER :: JI
+
+CALL PRINT_MSG( NVERB_DEBUG, 'GEN', 'AIRCRAFT_BALLOON_FREE_NONLOCAL', 'called for ' // TRIM(TPDIAFILE%CNAME) )
+
+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 DEALLOCATE_FLYER( TBALLOONS(JI)%TBALLOON )
+ DEALLOCATE( TBALLOONS(JI)%TBALLOON )
+ END IF
+ END DO
+
+ DO JI = 1, NAIRCRAFTS
+ ! Free aircraft data if it was not stored on this process
+ IF ( NRANKCUR_AIRCRAFT(JI) /= TPDIAFILE%NMASTER_RANK ) THEN
+ CALL DEALLOCATE_FLYER( TAIRCRAFTS(JI)%TAIRCRAFT )
+ DEALLOCATE( TAIRCRAFTS(JI)%TAIRCRAFT )
+ END IF
+ END DO
+END IF
+
+END SUBROUTINE AIRCRAFT_BALLOON_FREE_NONLOCAL
+
+
! ############################################
SUBROUTINE FLYER_DIACHRO( TPDIAFILE, TPFLYER )
! ############################################
@@ -128,7 +216,6 @@ USE MODE_AERO_PSD
use mode_aircraft_balloon, only: Aircraft_balloon_longtype_get
USE MODE_DUST_PSD
USE MODE_MODELN_HANDLER, ONLY: GET_CURRENT_MODEL_INDEX
-use mode_msg
use mode_write_diachro, only: Write_diachro
@@ -634,9 +721,8 @@ DEALLOCATE (CUNIT )
contains
-subroutine Add_profile( htitle, hcomment, hunits, pfield )
-use mode_msg
+subroutine Add_profile( htitle, hcomment, hunits, pfield )
character(len=*), intent(in) :: htitle
character(len=*), intent(in) :: hcomment
@@ -662,8 +748,6 @@ end subroutine Add_profile
subroutine Add_point( htitle, hcomment, hunits, pfield )
-use mode_msg
-
character(len=*), intent(in) :: htitle
character(len=*), intent(in) :: hcomment
character(len=*), intent(in) :: hunits
diff --git a/src/MNH/write_balloonn.f90 b/src/MNH/write_balloonn.f90
index 2b1b55417..6855ece50 100644
--- a/src/MNH/write_balloonn.f90
+++ b/src/MNH/write_balloonn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2001-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2001-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -44,7 +44,7 @@ CONTAINS
!!
!! AUTHOR
!! ------
-!! G.Jaubert *Meteo France*
+!! G.Jaubert *Meteo France*
!!
!! MODIFICATIONS
!! -------------
@@ -57,9 +57,11 @@ CONTAINS
!* 0. DECLARATIONS
! ------------
!
-USE MODD_AIRCRAFT_BALLOON, only: NBALLOONS, TBALLOONS
-USE MODD_IO, ONLY: TFILEDATA
+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_INI_AIRCRAFT_BALLOON, ONLY: DEALLOCATE_FLYER
!
IMPLICIT NONE
!
@@ -71,11 +73,42 @@ TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics
!
!
INTEGER :: JI
+LOGICAL :: OMONOPROC_SAVE ! Copy of true value of GSMONOPROC
+
+! Save GSMONOPROC value
+OMONOPROC_SAVE = GSMONOPROC
+! Force GSMONOPROC to true to allow IO_Field_write on only 1 process! (not very clean hack)
+GSMONOPROC = .TRUE.
DO JI = 1, NBALLOONS
- IF ( TBALLOONS(JI)%TBALLOON%LFLY ) CALL WRITE_BALLOON_POSITION( TPFILE, TBALLOONS(JI)%TBALLOON )
+ ! 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) /= TPFILE%NMASTER_RANK ) THEN
+ CALL FLYER_SEND( TBALLOONS(JI)%TBALLOON, TPFILE%NMASTER_RANK )
+ 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) )
+ END IF
+
+ ! Write data
+ IF ( TBALLOONS(JI)%TBALLOON%LFLY ) 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 DEALLOCATE_FLYER( TBALLOONS(JI)%TBALLOON )
+ DEALLOCATE( TBALLOONS(JI)%TBALLOON )
+ END IF
+ END IF
END DO
+! Restore correct value of GSMONOPROC
+GSMONOPROC = OMONOPROC_SAVE
+
END SUBROUTINE WRITE_BALLOON_n
!-------------------------------------------------------------------------------
diff --git a/src/MNH/write_diachro.f90 b/src/MNH/write_diachro.f90
index 21be258ef..bde51d154 100644
--- a/src/MNH/write_diachro.f90
+++ b/src/MNH/write_diachro.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1996-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -100,7 +100,7 @@ use modd_aircraft_balloon, only: tflyerdata
use modd_budget, only: tbudiachrometadata
use modd_conf, only: lpack
use modd_field, only: tfieldmetadata_base
-use modd_io, only: tfiledata
+use modd_io, only: gsmonoproc, tfiledata
use modd_type_date, only: date_time
!
IMPLICIT NONE
@@ -117,6 +117,7 @@ class(tflyerdata), intent(in), optional :: tpfl
!
!* 0.1 Local variables
! ---------------
+logical :: omonoproc_save ! Copy of true value of gsmonoproc
logical :: gpack
!------------------------------------------------------------------------------
@@ -125,6 +126,15 @@ call Print_msg( NVERB_DEBUG, 'BUD', 'Write_diachro', 'called' )
gpack = lpack
lpack = .false.
+if ( present( tpflyer ) ) then
+ ! Save gsmonoproc value
+ omonoproc_save = gsmonoproc
+
+ ! Force gsmonoproc to true to allow IO_Field_write on only 1 process! (not very clean hack)
+ ! This is necessary for flyers because their data is local to 1 one process (and has been copied on the master rank of the file)
+ gsmonoproc = .true.
+end if
+
#ifdef MNH_IOLFI
if ( tpdiafile%cformat == 'LFI' .or. tpdiafile%cformat == 'LFICDF4' ) &
call Write_diachro_lfi( tpdiafile, tpbudiachro, tpfields, tpdates, pvar, tpflyer )
@@ -137,6 +147,12 @@ if ( tpdiafile%cformat == 'NETCDF4' .or. tpdiafile%cformat == 'LFICDF4' ) &
lpack = gpack
+if ( present( tpflyer ) ) then
+ ! Restore correct value of gsmonoproc
+ gsmonoproc = omonoproc_save
+end if
+
+! end subroutine Write_diachro_1
end subroutine Write_diachro
#ifdef MNH_IOLFI
diff --git a/src/MNH/write_lfin.f90 b/src/MNH/write_lfin.f90
index 1b48d9b9b..9daf40c08 100644
--- a/src/MNH/write_lfin.f90
+++ b/src/MNH/write_lfin.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -1795,6 +1795,7 @@ IF ( LUV_FLX) CALL IO_Field_write(TPFILE,'VU_FLX',XVU_FLUX_M)
!* 1.14 Balloon variables
!
!
+! Write balloon coordinates in backup file to allow restart with current balloon position
IF (LFLYER) CALL WRITE_BALLOON_n(TPFILE)
!
!
--
GitLab