From 2ef392a7be2970e65dc14b228d6a328a70bd89c4 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Fri, 30 Jun 2017 15:44:47 +0200
Subject: [PATCH] Philippe 30/06/2017: IO: * added IO_READ_FIELD_BYNAME_X1 and
IO_READ_FIELD_BYFIELD_X1 subroutines to IO_READ_FIELD procedure * added
IO_READ_FIELD_LFI_X1 subroutine to IO_READ_FIELD_LFI procedure * added
IO_READ_FIELD_NC4_X1 subroutine to IO_READ_FIELD_NC4 procedure * bug
corrections in IO_READ_CHECK_FIELD_ATTR_NC4 * use IO_READ_FIELD in
INI_MODEL_n
---
src/LIB/SURCOUCHE/src/fmread_ll.f90 | 123 +++++++++++++++++++++++++-
src/LIB/SURCOUCHE/src/fmreadwrit.f90 | 41 ++++++++-
src/LIB/SURCOUCHE/src/mode_netcdf.f90 | 77 ++++++++++++++--
src/MNH/ini_modeln.f90 | 91 +++++++++----------
src/MNH/init_mnh.f90 | 2 +-
5 files changed, 273 insertions(+), 61 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/fmread_ll.f90 b/src/LIB/SURCOUCHE/src/fmread_ll.f90
index f0d01558e..39546557b 100644
--- a/src/LIB/SURCOUCHE/src/fmread_ll.f90
+++ b/src/LIB/SURCOUCHE/src/fmread_ll.f90
@@ -41,13 +41,15 @@ IMPLICIT NONE
PRIVATE
INTERFACE IO_READ_FIELD
- MODULE PROCEDURE IO_READ_FIELD_BYNAME_N0, &
+ MODULE PROCEDURE IO_READ_FIELD_BYNAME_X1, &
+ IO_READ_FIELD_BYNAME_N0, &
IO_READ_FIELD_BYNAME_L0, &
IO_READ_FIELD_BYNAME_C0, &
+ IO_READ_FIELD_BYFIELD_X1, &
IO_READ_FIELD_BYFIELD_N0, &
IO_READ_FIELD_BYFIELD_L0, &
IO_READ_FIELD_BYFIELD_C0
-! IO_READ_FIELD_BYNAME_X0, IO_READ_FIELD_BYNAME_X1, &
+! IO_READ_FIELD_BYNAME_X0, &
! IO_READ_FIELD_BYNAME_X2, IO_READ_FIELD_BYNAME_X3, &
! IO_READ_FIELD_BYNAME_X4, IO_READ_FIELD_BYNAME_X5, &
! IO_READ_FIELD_BYNAME_X6, &
@@ -56,7 +58,7 @@ INTERFACE IO_READ_FIELD
! IO_READ_FIELD_BYNAME_L1, &
! IO_READ_FIELD_BYNAME_C1, &
! IO_READ_FIELD_BYNAME_T0, &
-! IO_READ_FIELD_BYFIELD_X0,IO_READ_FIELD_BYFIELD_X1, &
+! IO_READ_FIELD_BYFIELD_X0, &
! IO_READ_FIELD_BYFIELD_X2,IO_READ_FIELD_BYFIELD_X3, &
! IO_READ_FIELD_BYFIELD_X4,IO_READ_FIELD_BYFIELD_X5, &
! IO_READ_FIELD_BYFIELD_X6, &
@@ -334,6 +336,121 @@ RETURN
!------------------------------------------------------------------
END SUBROUTINE FMREADX1_ll
+SUBROUTINE IO_READ_FIELD_BYNAME_X1(TPFILE,HNAME,PFIELD,KRESP,KIMAX_ll,KJMAX_ll,TPSPLITTING)
+!
+USE MODD_IO_ll, ONLY : ISNPROC
+USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
+REAL,DIMENSION(:),INTENT(INOUT) :: PFIELD ! array containing the data field
+INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+INTEGER,OPTIONAL, INTENT(IN) :: KIMAX_ll
+INTEGER,OPTIONAL, INTENT(IN) :: KJMAX_ll
+TYPE(ZONE_ll),DIMENSION(ISNPROC),OPTIONAL,INTENT(IN) :: TPSPLITTING ! splitting of the domain
+!
+INTEGER :: ID ! Index of the field
+INTEGER :: IRESP ! return_code
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_X1',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
+!
+CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
+!
+IF(IRESP==0) CALL IO_READ_FIELD(TPFILE,TFIELDLIST(ID),PFIELD,IRESP,KIMAX_ll,KJMAX_ll,TPSPLITTING)
+!
+IF (PRESENT(KRESP)) KRESP = IRESP
+!
+END SUBROUTINE IO_READ_FIELD_BYNAME_X1
+
+SUBROUTINE IO_READ_FIELD_BYFIELD_X1(TPFILE,TPFIELD,PFIELD,KRESP,KIMAX_ll,KJMAX_ll,TPSPLITTING)
+!
+USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,ISNPROC
+USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
+!
+USE MODE_SCATTER_ll
+USE MODE_ALLOCBUFFER_ll
+USE MODE_FD_ll, ONLY : GETFD,FD_LL
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+REAL,DIMENSION(:),INTENT(INOUT) :: PFIELD ! array containing the data field
+INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+INTEGER,OPTIONAL, INTENT(IN) :: KIMAX_ll
+INTEGER,OPTIONAL, INTENT(IN) :: KJMAX_ll
+TYPE(ZONE_ll),DIMENSION(ISNPROC),OPTIONAL,INTENT(IN) :: TPSPLITTING ! splitting of the domain
+!
+INTEGER :: IERR
+TYPE(FD_ll), POINTER :: TZFD
+REAL,DIMENSION(:),POINTER :: ZFIELDP
+LOGICAL :: GALLOC
+INTEGER :: IRESP
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_X1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+!
+GALLOC = .FALSE.
+IRESP = 0
+!
+TZFD=>GETFD(TRIM(ADJUSTL(TPFILE%CNAME))//'.lfi')
+IF (ASSOCIATED(TZFD)) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (TPFILE%CFORMAT=='NETCDF4') THEN
+ CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,PFIELD,IRESP)
+ ELSE IF (TPFILE%CFORMAT=='LFI') THEN
+ CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,PFIELD,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_READ_FIELD_BYFIELD_X1',&
+ TRIM(TPFILE%CNAME)//': invalid fileformat ('//TRIM(TPFILE%CFORMAT)//')')
+ END IF
+ ELSE
+ IF (ISP == TZFD%OWNER) THEN
+ IF( PRESENT(KIMAX_ll) .AND. PRESENT(KJMAX_ll) ) THEN
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,TPFIELD%CDIR,GALLOC, KIMAX_ll, KJMAX_ll)
+ ELSE
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,TPFIELD%CDIR,GALLOC)
+ ENDIF
+ IF (TPFILE%CFORMAT=='NETCDF4') THEN
+ CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ ELSE IF (TPFILE%CFORMAT=='LFI') THEN
+ CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_READ_FIELD_BYFIELD_X1',&
+ TRIM(TPFILE%CNAME)//': invalid fileformat ('//TRIM(TPFILE%CFORMAT)//')')
+ END IF
+ ELSE
+ ALLOCATE(ZFIELDP(0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+ !
+ !Broadcast header only if IRESP==-111
+ !because metadata of field has been modified in IO_READ_FIELD_xxx
+ IF (IRESP==-111) CALL IO_BCAST_FIELD_METADATA(TZFD,TPFIELD)
+ !
+ IF (TPFIELD%CDIR /= 'XX' .AND. TPFIELD%CDIR /='YY') THEN
+ ! Broadcast Field
+ CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
+ ELSE
+ !Scatter Field
+ IF( PRESENT(TPSPLITTING) ) THEN
+ CALL SCATTER_XXFIELD(TPFIELD%CDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM,TPSPLITTING)
+ ELSE
+ CALL SCATTER_XXFIELD(TPFIELD%CDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
+ ENDIF
+ END IF
+ END IF
+ELSE
+ IRESP = -61
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_BYFIELD_X1','file '//TRIM(TPFILE%CNAME)//' not found')
+END IF
+!
+IF (GALLOC) DEALLOCATE (ZFIELDP)
+!
+IF (PRESENT(KRESP)) KRESP = IRESP
+!
+END SUBROUTINE IO_READ_FIELD_BYFIELD_X1
+
+
SUBROUTINE FMREADX2_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
KLENCH,HCOMMENT,KRESP, KIMAX_ll, KJMAX_ll, TPSPLITTING)
USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D , ISNPROC
diff --git a/src/LIB/SURCOUCHE/src/fmreadwrit.f90 b/src/LIB/SURCOUCHE/src/fmreadwrit.f90
index 44d49aee6..e51eb98c9 100644
--- a/src/LIB/SURCOUCHE/src/fmreadwrit.f90
+++ b/src/LIB/SURCOUCHE/src/fmreadwrit.f90
@@ -272,10 +272,11 @@ IMPLICIT NONE
PRIVATE
!
INTERFACE IO_READ_FIELD_LFI
- MODULE PROCEDURE IO_READ_FIELD_LFI_N0, &
+ MODULE PROCEDURE IO_READ_FIELD_LFI_X1, &
+ IO_READ_FIELD_LFI_N0, &
IO_READ_FIELD_LFI_L0, &
IO_READ_FIELD_LFI_C0
-! IO_READ_FIELD_LFI_X0,IO_READ_FIELD_LFI_X1, &
+! IO_READ_FIELD_LFI_X0, &
! IO_READ_FIELD_LFI_X2,IO_READ_FIELD_LFI_X3, &
! IO_READ_FIELD_LFI_X4,IO_READ_FIELD_LFI_X5, &
! IO_READ_FIELD_LFI_X6, &
@@ -301,6 +302,42 @@ PUBLIC IO_READ_FIELD_LFI,IO_WRITE_FIELD_LFI
!
CONTAINS
!
+SUBROUTINE IO_READ_FIELD_LFI_X1(TPFILE,TPFIELD,PFIELD,KRESP)
+USE MODD_FM
+USE MODD_CONFZ, ONLY : NZ_VERB
+USE MODE_MSG
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+REAL,DIMENSION(:),INTENT(OUT) :: PFIELD ! array containing the data field
+INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
+!
+!* 0.2 Declarations of local variables
+!
+INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL
+INTEGER :: ILENG
+INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
+LOGICAL :: GGOOD
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+!
+ILENG = SIZE(PFIELD)
+!
+CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
+!
+IF (GGOOD) CALL TRANSFR(PFIELD,IWORK(IWORK(2)+3),ILENG)
+!
+KRESP=IRESP
+!
+IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
+!
+END SUBROUTINE IO_READ_FIELD_LFI_X1
+!
+!
SUBROUTINE IO_READ_FIELD_LFI_N0(TPFILE,TPFIELD,KFIELD,KRESP)
USE MODD_FM
USE MODD_CONFZ, ONLY : NZ_VERB
diff --git a/src/LIB/SURCOUCHE/src/mode_netcdf.f90 b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
index c0c3fbbc0..cf0b1e65c 100644
--- a/src/LIB/SURCOUCHE/src/mode_netcdf.f90
+++ b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
@@ -35,10 +35,11 @@ INTERFACE IO_WRITE_FIELD_NC4
END INTERFACE IO_WRITE_FIELD_NC4
INTERFACE IO_READ_FIELD_NC4
- MODULE PROCEDURE IO_READ_FIELD_NC4_N0, &
+ MODULE PROCEDURE IO_READ_FIELD_NC4_X1, &
+ IO_READ_FIELD_NC4_N0, &
IO_READ_FIELD_NC4_L0, &
IO_READ_FIELD_NC4_C0
-! IO_READ_FIELD_NC4_X0,IO_READ_FIELD_NC4_X1, &
+! IO_READ_FIELD_NC4_X0, &
! IO_READ_FIELD_NC4_X2,IO_READ_FIELD_NC4_X3, &
! IO_READ_FIELD_NC4_X4,IO_READ_FIELD_NC4_X5, &
! IO_READ_FIELD_NC4_X6, &
@@ -2192,10 +2193,10 @@ END IF
!
! UNITS
!
-STATUS = NF90_INQUIRE_ATTRIBUTE(KNCID, KVARID, 'UNITS', LEN=ILEN)
+STATUS = NF90_INQUIRE_ATTRIBUTE(KNCID, KVARID, 'units', LEN=ILEN)
IF (STATUS == NF90_NOERR) THEN
ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
- STATUS = NF90_GET_ATT(KNCID, KVARID, 'UNITS', YVALUE)
+ STATUS = NF90_GET_ATT(KNCID, KVARID, 'units', YVALUE)
IF (TRIM(YVALUE)/=TRIM(TPFIELD%CUNITS)) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4','expected UNITS ('//TRIM(TPFIELD%CUNITS)// &
') is different than found ('//TRIM(YVALUE)//')in file for field '//TRIM(TPFIELD%CMNHNAME))
@@ -2219,10 +2220,10 @@ END IF
! CALENDAR
!
IF(PRESENT(HCALENDAR)) THEN
-STATUS = NF90_INQUIRE_ATTRIBUTE(KNCID, KVARID, 'CALENDAR', LEN=ILEN)
+STATUS = NF90_INQUIRE_ATTRIBUTE(KNCID, KVARID, 'calendar', LEN=ILEN)
IF (STATUS == NF90_NOERR) THEN
ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
- STATUS = NF90_GET_ATT(KNCID, KVARID, 'CALENDAR', YVALUE)
+ STATUS = NF90_GET_ATT(KNCID, KVARID, 'calendar', YVALUE)
IF (TRIM(YVALUE)/=TRIM(HCALENDAR)) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4','expected CALENDAR ('//TRIM(HCALENDAR)// &
') is different than found ('//TRIM(YVALUE)//')in file for field '//TRIM(TPFIELD%CMNHNAME))
@@ -2357,6 +2358,70 @@ KRESP = IRESP
END SUBROUTINE NCREADX1
+SUBROUTINE IO_READ_FIELD_NC4_X1(TPFILE, TPFIELD, PFIELD, KRESP)
+USE MODD_FM, ONLY : FMHEADER, JPXKRK
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+REAL,DIMENSION(:),INTENT(OUT) :: PFIELD
+INTEGER, INTENT(OUT) :: KRESP ! return-code
+
+INTEGER(KIND=IDCDF_KIND) :: STATUS
+INTEGER(KIND=IDCDF_KIND) :: INCID
+INTEGER(KIND=IDCDF_KIND) :: IVARID
+INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
+INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
+INTEGER(KIND=IDCDF_KIND),DIMENSION(1) :: IVDIMS
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER :: IDIMLEN
+INTEGER :: IRESP
+
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_X1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+
+IRESP = 0
+! Get the Netcdf file ID
+INCID = TPFILE%NNCID
+
+CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+
+! Get variable ID, NDIMS and TYPE
+STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X1[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+END IF
+STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
+IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_X1[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
+
+IF (IDIMS == 1 .AND. ITYPE == NF90_DOUBLE) THEN
+ ! Check size of variable before reading
+ STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN)
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X1[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+
+ IF (IDIMLEN == SIZE(PFIELD)) THEN
+ ! Read variable
+ STATUS = NF90_GET_VAR(INCID, IVARID, PFIELD)
+ IF (STATUS /= NF90_NOERR) THEN
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_X1[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
+ GOTO 1000
+ END IF
+ ! Read and check attributes of variable
+ CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFIELD,INCID,IVARID,IRESP)
+ ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong size)')
+ IRESP = -3
+ END IF
+ELSE
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ ' not read (wrong number of dimensions or wrong type)')
+ IRESP = -3
+END IF
+
+1000 CONTINUE
+KRESP = IRESP
+
+END SUBROUTINE IO_READ_FIELD_NC4_X1
+
SUBROUTINE NCREADX2(KNCID, HVARNAME, PFIELD, TPFMH, KRESP)
USE MODD_FM, ONLY : FMHEADER, JPXKRK
INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
diff --git a/src/MNH/ini_modeln.f90 b/src/MNH/ini_modeln.f90
index 5503b0981..3d5c33b50 100644
--- a/src/MNH/ini_modeln.f90
+++ b/src/MNH/ini_modeln.f90
@@ -10,12 +10,14 @@
!
INTERFACE
!
- SUBROUTINE INI_MODEL_n(KMI,HLUOUT,HINIFILE,HINIFILEPGD)
+ SUBROUTINE INI_MODEL_n(KMI,HLUOUT,TPINIFILE,HINIFILEPGD)
+!
+ USE MODD_IO_ll, ONLY : TFILEDATA
!
INTEGER, INTENT(IN) :: KMI ! Model index
CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing
! of nested models
- CHARACTER (LEN=28), INTENT(IN) :: HINIFILE ! name of
+ TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE !Initial file
CHARACTER (LEN=28), INTENT(IN) :: HINIFILEPGD
!
END SUBROUTINE INI_MODEL_n
@@ -24,7 +26,7 @@ END INTERFACE
!
END MODULE MODI_INI_MODEL_n
! ######################################################
- SUBROUTINE INI_MODEL_n(KMI,HLUOUT,HINIFILE,HINIFILEPGD)
+ SUBROUTINE INI_MODEL_n(KMI,HLUOUT,TPINIFILE,HINIFILEPGD)
! ######################################################
!
!!**** *INI_MODEL_n* - routine to initialize the nested model _n
@@ -417,7 +419,7 @@ USE MODD_ADVFRC_n
USE MODD_RELFRC_n
USE MODD_2D_FRC
USE MODD_IO_SURF_MNH, ONLY : IO_SURF_MNH_MODEL
-USE MODD_IO_ll, ONLY : LIOCDF4,LLFIOUT
+USE MODD_IO_ll, ONLY : LIOCDF4,LLFIOUT,TFILEDATA
!
USE MODD_CH_PRODLOSSTOT_n
USE MODI_CH_INIT_PRODLOSSTOT_n
@@ -438,8 +440,7 @@ INTEGER, INTENT(IN) :: KMI ! Model Index
CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing
! of nested models
-CHARACTER (LEN=28), INTENT(IN) :: HINIFILE ! name of
- ! the initial file
+TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE !Initial file
CHARACTER (LEN=28), INTENT(IN) :: HINIFILEPGD
!
!* 0.2 declarations of local variables
@@ -447,9 +448,9 @@ CHARACTER (LEN=28), INTENT(IN) :: HINIFILEPGD
INTEGER :: JSV ! Loop index
INTEGER :: IRESP ! Return code of FM routines
INTEGER :: ININAR ! File management variable
-INTEGER :: IMASDEV ! version of MESOHN in the input file
+INTEGER :: IMASDEV ! version of MESONH in the input file
INTEGER :: ILUOUT ! Logical unit number of output-listing
-CHARACTER(LEN=2) :: YDIR ! Type of the data field in LFIFM file
+CHARACTER(LEN=2) :: YDIR ! Type of the data field in LFIFM file
INTEGER :: IGRID ! C-grid indicator in LFIFM file
INTEGER :: ILENCH ! Length of comment string in LFIFM file
CHARACTER (LEN=100) :: YCOMMENT!comment string in LFIFM file
@@ -539,10 +540,10 @@ NULLIFY(TZINITHALO3D_ll)
!
CALL FMLOOK_ll(HLUOUT,HLUOUT,ILUOUT,IRESP)
CLUOUT = HLUOUT
-CINIFILE=HINIFILE
+CINIFILE=TPINIFILE%CNAME
CINIFILEPGD=HINIFILEPGD
!
-CALL FMREAD(HINIFILE,'MASDEV',HLUOUT,'--',IMASDEV,IGRID,ILENCH,YCOMMENT,IRESP)
+CALL IO_READ_FIELD(TPINIFILE,'MASDEV',IMASDEV)
!-------------------------------------------------------------------------------
!
!* 2. END OF READING
@@ -550,13 +551,11 @@ CALL FMREAD(HINIFILE,'MASDEV',HLUOUT,'--',IMASDEV,IGRID,ILENCH,YCOMMENT,IRESP)
!* 2.1 Read number of forcing fields
!
IF (LFORCING) THEN ! Retrieve the number of time-dependent forcings.
- YRECFM='FRC'
- YDIR='--'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,NFRC,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL IO_READ_FIELD(TPINIFILE,'FRC',NFRC,IRESP)
IF ( (IRESP /= 0) .OR. (NFRC <=0) ) THEN
WRITE(ILUOUT,'(A/A)') &
"INI_MODEL_n ERROR: you want to read forcing variables from FMfile", &
- " but no fields have been found by FMREAD"
+ " but no fields have been found by IO_READ_FIELD"
!callabortstop
CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
CALL ABORT
@@ -567,13 +566,11 @@ END IF
! Modif PP for time evolving adv forcing
IF ( L2D_ADV_FRC ) THEN ! Retrieve the number of time-dependent forcings.
WRITE(ILUOUT,FMT=*) "INI_MODEL_n ENTER ADV_FORCING"
- YRECFM='NADVFRC1'
- YDIR='--'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,NADVFRC,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL IO_READ_FIELD(TPINIFILE,'NADVFRC1',NADVFRC,IRESP)
IF ( (IRESP /= 0) .OR. (NADVFRC <=0) ) THEN
WRITE(ILUOUT,'(A/A)') &
"INI_MODELn ERROR: you want to read forcing ADV variables from FMfile", &
- " but no fields have been found by FMREAD"
+ " but no fields have been found by IO_READ_FIELD"
!callabortstop
CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
CALL ABORT
@@ -584,13 +581,11 @@ END IF
!
IF ( L2D_REL_FRC ) THEN ! Retrieve the number of time-dependent forcings.
WRITE(ILUOUT,FMT=*) "INI_MODEL_n ENTER REL_FORCING"
- YRECFM='NRELFRC1'
- YDIR='--'
- CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,NRELFRC,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL IO_READ_FIELD(TPINIFILE,'NRELFRC1',NRELFRC,IRESP)
IF ( (IRESP /= 0) .OR. (NRELFRC <=0) ) THEN
WRITE(ILUOUT,'(A/A)') &
"INI_MODELn ERROR: you want to read forcing REL variables from FMfile", &
- " but no fields have been found by FMREAD"
+ " but no fields have been found by IO_READ_FIELD"
!callabortstop
CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
CALL ABORT
@@ -602,10 +597,8 @@ END IF
!
IKU=NKMAX+2*JPVEXT
!
-YRECFM = 'ZHAT'
ALLOCATE(XZHAT(IKU))
- YDIR='--'
-CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,XZHAT,IGRID,ILENCH,YCOMMENT,IRESP)
+CALL IO_READ_FIELD(TPINIFILE,'ZHAT',XZHAT)
IF (XALZBOT>=XZHAT(IKU) .AND. LVE_RELAX) THEN
WRITE(ILUOUT,FMT=*) "INI_MODEL_n ERROR: you want to use vertical relaxation"
WRITE(ILUOUT,FMT=*) " but bottom of layer XALZBOT(",XALZBOT,")"
@@ -1580,7 +1573,7 @@ END IF
!* 7. INITIALIZE GRIDS AND METRIC COEFFICIENTS
! ----------------------------------------
!
-CALL SET_GRID(KMI,HINIFILE,HLUOUT,IIU,IJU,IKU,NIMAX_ll,NJMAX_ll, &
+CALL SET_GRID(KMI,TPINIFILE%CNAME,HLUOUT,IIU,IJU,IKU,NIMAX_ll,NJMAX_ll, &
XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
NXOR_ALL(KMI),NYOR_ALL(KMI),NXEND_ALL(KMI),NYEND_ALL(KMI), &
@@ -1639,7 +1632,7 @@ IF (CCLOUD=='LIMA') CALL INIT_AEROSOL_PROPERTIES
! --------------------------------
!
CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-before read_field::XUT",PRECISION)
-CALL READ_FIELD(HINIFILE,HLUOUT,IMASDEV, IIU,IJU,IKU,XTSTEP, &
+CALL READ_FIELD(TPINIFILE%CNAME,HLUOUT,IMASDEV, IIU,IJU,IKU,XTSTEP, &
CGETTKET,CGETRVT,CGETRCT,CGETRRT,CGETRIT,CGETCIT, &
CGETRST,CGETRGT,CGETRHT,CGETSVT,CGETSRCT,CGETSIGS,CGETCLDFR, &
CGETBL_DEPTH,CGETSBL_DEPTH,CGETPHC,CGETPHR,CUVW_ADV_SCHEME, &
@@ -1670,10 +1663,10 @@ CALL READ_FIELD(HINIFILE,HLUOUT,IMASDEV, IIU,IJU,IKU,XTSTEP, &
! ---------------------------
!
!
-CALL SET_REF(KMI,HINIFILE,HLUOUT, &
- XZZ,XZHAT,ZJ,XDXX,XDYY,CLBCX,CLBCY, &
- XREFMASS,XMASS_O_PHI0,XLINMASS, &
- XRHODREF,XTHVREF,XRVREF,XEXNREF,XRHODJ )
+CALL SET_REF(KMI,TPINIFILE%CNAME,HLUOUT, &
+ XZZ,XZHAT,ZJ,XDXX,XDYY,CLBCX,CLBCY, &
+ XREFMASS,XMASS_O_PHI0,XLINMASS, &
+ XRHODREF,XTHVREF,XRVREF,XEXNREF,XRHODJ )
!
!-------------------------------------------------------------------------------
!
@@ -1906,7 +1899,7 @@ IF (CRAD /= 'NONE') THEN
ELSE
GINIRAD =.FALSE.
END IF
- CALL INI_RADIATIONS(HINIFILE,HLUOUT,GINIRAD,TDTCUR,TDTEXP,XZZ, &
+ CALL INI_RADIATIONS(TPINIFILE%CNAME,HLUOUT,GINIRAD,TDTCUR,TDTEXP,XZZ, &
XDXX, XDYY, &
XSINDEL,XCOSDEL,XTSIDER,XCORSOL, &
XSLOPANG,XSLOPAZI, &
@@ -1963,7 +1956,7 @@ ALLOCATE(ZEMIS (IIU,IJU))
ALLOCATE(ZTSRAD (IIU,IJU))
!
IF (IMASDEV>=46) THEN
- CALL FMREAD(HINIFILE,'SURF',HLUOUT,'--',CSURF,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL IO_READ_FIELD(TPINIFILE,'SURF',CSURF)
ELSE
CSURF = "EXTE"
END IF
@@ -1983,7 +1976,7 @@ IF (CSURF=='EXTE' .AND. (CPROGRAM=='MESONH' .OR. CPROGRAM=='DIAG ')) THEN
ENDIF
ELSE
! case after a spawning
- CINIFILEPGD = HINIFILE
+ CINIFILEPGD = TPINIFILE%CNAME
END IF
!
CALL GOTO_SURFEX(KMI)
@@ -2036,7 +2029,7 @@ DEALLOCATE(ZCO2)
!* in a RESTART case, reads surface radiative quantities in the MESONH file
!
IF (CRAD == 'ECMW' .AND. CGETRAD=='READ') THEN
- CALL INI_SURF_RAD(HINIFILE, CLUOUT, XDIR_ALB, XSCA_ALB, XEMIS, XTSRAD)
+ CALL INI_SURF_RAD(TPINIFILE%CNAME, CLUOUT, XDIR_ALB, XSCA_ALB, XEMIS, XTSRAD)
END IF
!
!
@@ -2067,10 +2060,10 @@ IF (CRAD == 'ECMW') THEN
ZBARE(:,:) = 0.
END IF
!
- CALL INI_RADIATIONS_ECMWF (HINIFILE,HLUOUT, &
- XZHAT,XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP, &
- CLW,NDLON,NFLEV,NFLUX,NRAD,NSWB,CAER,NAER,NSTATM, &
- XSTATM,ZSEA,ZTOWN,ZBARE,XOZON, XAER,XDST_WL, LSUBG_COND )
+ CALL INI_RADIATIONS_ECMWF (TPINIFILE%CNAME,HLUOUT, &
+ XZHAT,XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP, &
+ CLW,NDLON,NFLEV,NFLUX,NRAD,NSWB,CAER,NAER,NSTATM, &
+ XSTATM,ZSEA,ZTOWN,ZBARE,XOZON, XAER,XDST_WL, LSUBG_COND )
!
DEALLOCATE(ZSEA,ZTOWN,ZBARE)
ALLOCATE (XAER_CLIM(SIZE(XAER,1),SIZE(XAER,2),SIZE(XAER,3),SIZE(XAER,4)))
@@ -2100,14 +2093,14 @@ IF (CDCONV /= 'NONE' .OR. CSCONV == 'KAFR') THEN
IF (NVERB>=10) THEN
WRITE(ILUOUT,*) 'XDTCONV has been set to : ',XDTCONV
END IF
- CALL INI_DEEP_CONVECTION (HINIFILE,HLUOUT,GINIDCONV,TDTCUR, &
- NCOUNTCONV,XDTHCONV,XDRVCONV,XDRCCONV, &
- XDRICONV,XPRCONV,XPRSCONV,XPACCONV, &
+ CALL INI_DEEP_CONVECTION (TPINIFILE%CNAME,HLUOUT,GINIDCONV,TDTCUR, &
+ NCOUNTCONV,XDTHCONV,XDRVCONV,XDRCCONV, &
+ XDRICONV,XPRCONV,XPRSCONV,XPACCONV, &
XUMFCONV,XDMFCONV,XMFCONV,XPRLFLXCONV,XPRSFLXCONV,&
- XCAPE,NCLTOPCONV,NCLBASCONV, &
- TDTDCONV, CGETSVCONV, XDSVCONV, &
- LCH_CONV_LINOX, XIC_RATE, XCG_RATE, &
- XIC_TOTAL_NUMBER, XCG_TOTAL_NUMBER )
+ XCAPE,NCLTOPCONV,NCLBASCONV, &
+ TDTDCONV, CGETSVCONV, XDSVCONV, &
+ LCH_CONV_LINOX, XIC_RATE, XCG_RATE, &
+ XIC_TOTAL_NUMBER, XCG_TOTAL_NUMBER )
END IF
!
@@ -2162,9 +2155,9 @@ DEALLOCATE(XSPOWATM)
!* 23. BALLOON and AIRCRAFT initializations
! ------------------------------------
!
-CALL INI_AIRCRAFT_BALLOON(HINIFILE,CLUOUT,XTSTEP, TDTSEG, XSEGLEN, NRR, NSV, &
- IKU,CTURB=="TKEL" , &
- XLATORI, XLONORI )
+CALL INI_AIRCRAFT_BALLOON(TPINIFILE%CNAME,CLUOUT,XTSTEP, TDTSEG, XSEGLEN, NRR, NSV, &
+ IKU,CTURB=="TKEL" , &
+ XLATORI, XLONORI )
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/init_mnh.f90 b/src/MNH/init_mnh.f90
index 1e623dffe..f7219dbb2 100644
--- a/src/MNH/init_mnh.f90
+++ b/src/MNH/init_mnh.f90
@@ -237,7 +237,7 @@ DO JMI=1,NMODEL
CALL GO_TOMODEL_ll(JMI,IINFO_ll)
CALL GOTO_MODEL(JMI)
IF (CPROGRAM/='SPEC ') THEN
- CALL INI_MODEL_n(JMI,YLUOUT(JMI),TZINIFILE(JMI)%CNAME,YINIFILEPGD(JMI))
+ CALL INI_MODEL_n(JMI,YLUOUT(JMI),TZINIFILE(JMI),YINIFILEPGD(JMI))
!Call necessary to update the TFIELDLIST pointers to the data
CALL FIELDLIST_GOTO_MODEL(JMI,JMI)
ELSE
--
GitLab