From 30b3fe3d12991c901038a0095e05bf5db5c425bd Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Fri, 13 Jan 2023 16:19:33 +0100
Subject: [PATCH] Philippe 13/01/2023: manage close of backup files outside of
MODEL_n Useful to close them in reverse model order (child before parent)
This is needed by WRITE_BALLOON_n (future commit)
---
src/MNH/kid_model.f90 | 30 +++++++++++--------
src/MNH/mesonh.f90 | 23 ++++++++++++---
src/MNH/modeln.f90 | 69 ++++++++++++++++++++++---------------------
3 files changed, 71 insertions(+), 51 deletions(-)
diff --git a/src/MNH/kid_model.f90 b/src/MNH/kid_model.f90
index 68fdb5dbc..44c18b9eb 100644
--- a/src/MNH/kid_model.f90
+++ b/src/MNH/kid_model.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1999-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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 adiab 2006/05/18 13:07:25
-!-----------------------------------------------------------------
!####################
MODULE MODI_KID_MODEL
!####################
@@ -76,20 +71,23 @@ RECURSIVE SUBROUTINE KID_MODEL(KMODEL,KTEMP_MODEL,OEXIT)
!! -------------
!!
!! Original 09/04/99
-!!
-!!
+!
+! P. Wautelet 13/01/2023: close backup files outside MODEL_n (to control close order)
+!
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CONF
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_NESTING
+USE MODD_TYPE_DATE, ONLY: DATE_TIME
!
-USE MODI_MODEL_n
+USE MODE_IO_FILE, ONLY: IO_FILE_CLOSE
USE MODE_MODELN_HANDLER
-!
USE MODE_ll
!
+USE MODI_MODEL_n
!
!* 0.1 declarations of arguments
!
@@ -105,6 +103,8 @@ INTEGER :: JTEMP_KID ! nested temporal loop for the kid model
INTEGER :: ITEMP_LOOP ! number of the temporal iteration for the kid model
LOGICAL :: GEXIT ! return value of the EXIT signal from MODEL
INTEGER :: IINFO_ll ! return code of // routines
+TYPE(TFILEDATA), POINTER :: TZBAKFILE ! Backup file
+TYPE(DATE_TIME) :: TZDTMODELN ! Date/time of current model computation
!
!
!-------------------------------------------------------------------------------
@@ -112,7 +112,7 @@ INTEGER :: IINFO_ll ! return code of // routines
!* 1. INITIALIZATION
! --------------
!
-DO JKID=KMODEL+1,NMODEL
+DO JKID=KMODEL+1,NMODEL
!
IF ( NDAD(JKID)==KMODEL ) THEN
!
@@ -127,11 +127,15 @@ DO JKID=KMODEL+1,NMODEL
! call the model$n corresponding to JKID
CALL GO_TOMODEL_ll(JKID,IINFO_ll)
CALL GOTO_MODEL(JKID)
- CALL MODEL_n(ITEMP_LOOP,GEXIT)
+ CALL MODEL_n( ITEMP_LOOP, TZBAKFILE, TZDTMODELN, GEXIT )
!
! call to the kid models of model JKID
CALL KID_MODEL(JKID,ITEMP_LOOP,GEXIT)
!
+ IF ( TZBAKFILE%LOPENED ) THEN
+ CALL IO_FILE_CLOSE( TZBAKFILE, TPDTMODELN = TZDTMODELN )
+ NULLIFY( TZBAKFILE )
+ END IF
END DO
!
END IF
diff --git a/src/MNH/mesonh.f90 b/src/MNH/mesonh.f90
index dd28504bb..a6053e6e9 100644
--- a/src/MNH/mesonh.f90
+++ b/src/MNH/mesonh.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2021 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.
@@ -77,6 +77,7 @@
!! J. Pianezze 01/08/2016 add sfxoasis coupling functions
!! P. Wautelet 05/2016-04/2018 new data structures and calls for I/O
!! P. Wautelet 06/07/2021 use FINALIZE_MNH
+! P. Wautelet 13/01/2023: close backup files outside MODEL_n (to control close order)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -89,14 +90,17 @@
#endif
!
USE MODD_CONF, only: CPROGRAM, NMODEL
-USE MODD_NESTING
USE MODD_CONF_n
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NESTING
+USE MODD_TYPE_DATE, ONLY: DATE_TIME
!
USE MODI_MODEL_n
USE MODI_KID_MODEL
!
USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
USE MODE_IO, only: IO_Init
+USE MODE_IO_FILE, only: IO_FILE_CLOSE
USE MODE_ll
USE MODE_MODELN_HANDLER
!
@@ -121,6 +125,8 @@ INTEGER :: ITEMP_MODEL1 ! loop increment
LOGICAL :: GEXIT ! flag for the end of the
! temporal loop
INTEGER :: IINFO_ll ! return code of // routines
+TYPE(TFILEDATA), POINTER :: TZBAKFILE ! Backup file
+TYPE(DATE_TIME) :: TZDTMODELN ! Date/time of current model computation
!
#ifdef CPLOASIS
CHARACTER(LEN=28) :: CNAMELIST
@@ -190,7 +196,11 @@ DO JMODEL=1,NMODEL
CALL GO_TOMODEL_ll(JMODEL,IINFO_ll)
CALL GOTO_MODEL(JMODEL)
CSTORAGE_TYPE='TT'
- CALL MODEL_n(1,GEXIT)
+ CALL MODEL_n( 1, TZBAKFILE, TZDTMODELN, GEXIT )
+ IF ( TZBAKFILE%LOPENED ) THEN
+ CALL IO_FILE_CLOSE( TZBAKFILE, TPDTMODELN = TZDTMODELN )
+ NULLIFY( TZBAKFILE )
+ END IF
END DO
!
IF(GEXIT) THEN
@@ -205,10 +215,15 @@ DO
!
CALL GO_TOMODEL_ll(1,IINFO_ll)
CALL GOTO_MODEL(1)
- CALL MODEL_n(ITEMP_MODEL1,GEXIT)
+ CALL MODEL_n( ITEMP_MODEL1, TZBAKFILE, TZDTMODELN, GEXIT )
!
CALL KID_MODEL(1,ITEMP_MODEL1,GEXIT)
!
+ IF ( TZBAKFILE%LOPENED ) THEN
+ CALL IO_FILE_CLOSE( TZBAKFILE, TPDTMODELN = TZDTMODELN )
+ NULLIFY( TZBAKFILE )
+ END IF
+ !
IF(GEXIT) EXIT
!
END DO
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index a0d66c654..e3227e2b5 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -9,10 +9,15 @@
!
INTERFACE
!
- SUBROUTINE MODEL_n(KTCOUNT,OEXIT)
+ SUBROUTINE MODEL_n( KTCOUNT, TPBAKFILE, TPDTMODELN, OEXIT )
!
-INTEGER, INTENT(IN) :: KTCOUNT ! temporal loop index of model KMODEL
-LOGICAL, INTENT(INOUT):: OEXIT ! switch for the end of the temporal loop
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_TYPE_DATE, ONLY: DATE_TIME
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop index of model KMODEL
+TYPE(TFILEDATA), POINTER, INTENT(OUT) :: TPBAKFILE ! Pointer for backup file
+TYPE(DATE_TIME), INTENT(OUT) :: TPDTMODELN ! Time of current model computation
+LOGICAL, INTENT(INOUT) :: OEXIT ! Switch for the end of the temporal loop
!
END SUBROUTINE MODEL_n
!
@@ -21,7 +26,7 @@ END INTERFACE
END MODULE MODI_MODEL_n
! ###################################
- SUBROUTINE MODEL_n(KTCOUNT, OEXIT)
+ SUBROUTINE MODEL_n( KTCOUNT, TPBAKFILE, TPDTMODELN, OEXIT )
! ###################################
!
!!**** *MODEL_n * -monitor of the model version _n
@@ -273,6 +278,8 @@ END MODULE MODI_MODEL_n
! P. Wautelet 19/02/2021: add NEGA2 term for SV budgets
! J.L. Redelsperger 03/2021: add Call NHOA_COUPLN (coupling O & A LES version)
! P. Wautelet 08/12/2022: bugfix if no TDADFILE
+! P. Wautelet 13/01/2023: manage close of backup files outside of MODEL_n
+! (useful to close them in reverse model order (child before parent, needed by WRITE_BALLOON_n)
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -362,6 +369,7 @@ USE MODD_TIME_n
USE MODD_TIMEZ
USE MODD_TURB_CLOUD, ONLY: NMODEL_CLOUD,CTURBLEN_CLOUD,XCEI
USE MODD_TURB_n
+USE MODD_TYPE_DATE, ONLY: DATE_TIME
USE MODD_VISCOSITY
!
USE MODE_AIRCRAFT_BALLOON
@@ -460,8 +468,10 @@ IMPLICIT NONE
!
!
!
-INTEGER, INTENT(IN) :: KTCOUNT
-LOGICAL, INTENT(INOUT):: OEXIT
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop index of model KMODEL
+TYPE(TFILEDATA), POINTER, INTENT(OUT) :: TPBAKFILE ! Pointer for backup file
+TYPE(DATE_TIME), INTENT(OUT) :: TPDTMODELN ! Time of current model computation
+LOGICAL, INTENT(INOUT) :: OEXIT ! Switch for the end of the temporal loop
!
!* 0.2 declarations of local variables
!
@@ -551,16 +561,16 @@ LOGICAL :: GCLD ! conditionnal call for dust wet deposition
LOGICAL :: GCLOUD_ONLY ! conditionnal radiation computations for
! the only cloudy columns
REAL, DIMENSION(SIZE(XRSVS,1), SIZE(XRSVS,2), SIZE(XRSVS,3), NSV_AER) :: ZWETDEPAER
-
-
!
-TYPE(TFILEDATA),POINTER :: TZBAKFILE, TZOUTFILE
+TYPE(TFILEDATA),POINTER :: TZOUTFILE
! TYPE(TFILEDATA),SAVE :: TZDIACFILE
!-------------------------------------------------------------------------------
!
-TZBAKFILE=> NULL()
+TPBAKFILE=> NULL()
TZOUTFILE=> NULL()
!
+TPDTMODELN = TDTCUR
+!
!* 0. MICROPHYSICAL SCHEME
! -------------------
SELECT CASE(CCLOUD)
@@ -968,12 +978,12 @@ IF ( nfile_backup_current < NBAK_NUMB ) THEN
IF ( KTCOUNT == TBACKUPN(nfile_backup_current + 1)%NSTEP ) THEN
nfile_backup_current = nfile_backup_current + 1
!
- TZBAKFILE => TBACKUPN(nfile_backup_current)%TFILE
- IVERB = TZBAKFILE%NLFIVERB
+ TPBAKFILE => TBACKUPN(nfile_backup_current)%TFILE
+ IVERB = TPBAKFILE%NLFIVERB
!
- CALL IO_File_open(TZBAKFILE)
+ CALL IO_File_open(TPBAKFILE)
!
- CALL WRITE_DESFM_n(IMI,TZBAKFILE)
+ CALL WRITE_DESFM_n(IMI,TPBAKFILE)
CALL IO_Header_write( TBACKUPN(nfile_backup_current)%TFILE )
IF ( ASSOCIATED( TBACKUPN(nfile_backup_current)%TFILE%TDADFILE ) ) THEN
YDADNAME = TBACKUPN(nfile_backup_current)%TFILE%TDADFILE%CNAME
@@ -982,10 +992,10 @@ IF ( nfile_backup_current < NBAK_NUMB ) THEN
YDADNAME = 'DUMMY'
END IF
CALL WRITE_LFIFM_n( TBACKUPN(nfile_backup_current)%TFILE, TRIM( YDADNAME ) )
- TOUTDATAFILE => TZBAKFILE
- CALL MNHWRITE_ZS_DUMMY_n(TZBAKFILE)
+ TOUTDATAFILE => TPBAKFILE
+ CALL MNHWRITE_ZS_DUMMY_n(TPBAKFILE)
IF (CSURF=='EXTE') THEN
- TFILE_SURFEX => TZBAKFILE
+ TFILE_SURFEX => TPBAKFILE
CALL GOTO_SURFEX(IMI)
CALL WRITE_SURF_ATM_n(YSURF_CUR,'MESONH','ALL',.FALSE.)
IF ( KTCOUNT > 1) THEN
@@ -1000,7 +1010,7 @@ IF ( nfile_backup_current < NBAK_NUMB ) THEN
CALL INI_LG( XXHATM, XYHATM, XZZ, XSVT, XLBXSVM, XLBYSVM )
IF (IVERB>=5) THEN
WRITE(UNIT=ILUOUT,FMT=*) '************************************'
- WRITE(UNIT=ILUOUT,FMT=*) '*** Lagrangian variables refreshed after ',TRIM(TZBAKFILE%CNAME),' backup'
+ WRITE(UNIT=ILUOUT,FMT=*) '*** Lagrangian variables refreshed after ',TRIM(TPBAKFILE%CNAME),' backup'
WRITE(UNIT=ILUOUT,FMT=*) '************************************'
END IF
END IF
@@ -1011,11 +1021,11 @@ IF ( nfile_backup_current < NBAK_NUMB ) THEN
!
ELSE
!Necessary to have a 'valid' CNAME when calling some subroutines
- TZBAKFILE => TFILE_DUMMY
+ TPBAKFILE => TFILE_DUMMY
END IF
ELSE
!Necessary to have a 'valid' CNAME when calling some subroutines
- TZBAKFILE => TFILE_DUMMY
+ TPBAKFILE => TFILE_DUMMY
END IF
!
IF ( nfile_output_current < NOUT_NUMB ) THEN
@@ -1434,7 +1444,7 @@ XT_RELAX = XT_RELAX + ZTIME2 - ZTIME1 &
!
ZTIME1 = ZTIME2
!
-CALL PHYS_PARAM_n( KTCOUNT, TZBAKFILE, &
+CALL PHYS_PARAM_n( KTCOUNT, TPBAKFILE, &
XT_RAD, XT_SHADOWS, XT_DCONV, XT_GROUND, &
XT_MAFL, XT_DRAG, XT_EOL, XT_TURB, XT_TRACER, &
ZTIME, ZWETDEPAER, GMASKkids, GCLOUD_ONLY )
@@ -1609,7 +1619,7 @@ XTIME_LES_BU_PROCESS = 0.
!
CALL MPPDB_CHECK3DM("before ADVEC_METSV:XU/V/W/TH/TKE/T,XRHODJ",PRECISION,&
& XUT, XVT, XWT, XTHT, XTKET,XRHODJ)
- CALL ADVECTION_METSV ( TZBAKFILE, CUVW_ADV_SCHEME, &
+ CALL ADVECTION_METSV ( TPBAKFILE, CUVW_ADV_SCHEME, &
CMET_ADV_SCHEME, CSV_ADV_SCHEME, CCLOUD, NSPLIT, &
LSPLIT_CFL, XSPLIT_CFL, LCFL_WRIT, &
CLBCX, CLBCY, NRR, NSV, TDTCUR, XTSTEP, &
@@ -1711,7 +1721,7 @@ XT_ADVUVW = XT_ADVUVW + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCES
!-------------------------------------------------------------------------------
!
IF (NMODEL_CLOUD==IMI .AND. CTURBLEN_CLOUD/='NONE') THEN
- CALL TURB_CLOUD_INDEX( XTSTEP, TZBAKFILE, &
+ CALL TURB_CLOUD_INDEX( XTSTEP, TPBAKFILE, &
LTURB_DIAG, NRRI, &
XRRS, XRT, XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
XCEI )
@@ -1898,7 +1908,7 @@ IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:),PTOWN=ZTOWN(:,:))
CALL RESOLVED_CLOUD ( CCLOUD, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, &
NSPLITG, IMI, KTCOUNT, &
- CLBCX,CLBCY,TZBAKFILE, CRAD, CTURBDIM, &
+ CLBCX,CLBCY,TPBAKFILE, CRAD, CTURBDIM, &
LSUBG_COND,LSIGMAS,CSUBG_AUCV,XTSTEP, &
XZZ, XRHODJ, XRHODREF, XEXNREF, &
ZPABST, XTHT,XRT,XSIGS,VSIGQSAT,XMFCONV,XTHM,XRCM, &
@@ -1918,7 +1928,7 @@ IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
ELSE
CALL RESOLVED_CLOUD ( CCLOUD, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, &
NSPLITG, IMI, KTCOUNT, &
- CLBCX,CLBCY,TZBAKFILE, CRAD, CTURBDIM, &
+ CLBCX,CLBCY,TPBAKFILE, CRAD, CTURBDIM, &
LSUBG_COND,LSIGMAS,CSUBG_AUCV, &
XTSTEP,XZZ, XRHODJ, XRHODREF, XEXNREF, &
ZPABST, XTHT,XRT,XSIGS,VSIGQSAT,XMFCONV,XTHM,XRCM, &
@@ -2192,15 +2202,6 @@ XT_STEP_BUD = XT_STEP_BUD + ZTIME2 - ZTIME1 + XTIME_BU
!
!-------------------------------------------------------------------------------
!
-!* 26. FM FILE CLOSURE
-! ---------------
-!
-IF ( tzbakfile%lopened ) THEN
- CALL IO_File_close(TZBAKFILE)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
!* 27. CURRENT TIME REFRESH
! --------------------
!
--
GitLab