From 29eac313a7690dba51b43d479a2cfa79adfb8d4a Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Fri, 10 Mar 2017 10:10:03 +0100
Subject: [PATCH] Philippe 10/03/2017: bug corrections and (partial) use of
file structures in apps * several errors and problems corrected in
mode_field.f90 * moved INI_FIELD_LIST call earlier in init_mnh.f90 * IO now
works for: DIAG, PREP_IDEAL_CASE, PREP_NEST_PGD, PREP_PGD, PREP_REAL_CASE
and SPAWNING
---
src/LIB/SURCOUCHE/src/mode_field.f90 | 56 +++++++-------
src/LIB/SURCOUCHE/src/mode_fm.f90 | 19 ++++-
src/MNH/diag.f90 | 30 +++++++-
src/MNH/init_mnh.f90 | 25 ++++---
src/MNH/open_nestpgd_files.f90 | 107 +++++++++++++++++----------
src/MNH/prep_ideal_case.f90 | 47 +++++++++---
src/MNH/prep_nest_pgd.f90 | 84 +++++++++++----------
src/MNH/prep_pgd.f90 | 33 ++++++++-
src/MNH/prep_real_case.f90 | 45 ++++++++---
src/MNH/spawn_model2.f90 | 46 +++++++++---
src/MNH/write_surf_mnh.f90 | 44 +++++------
11 files changed, 353 insertions(+), 183 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/mode_field.f90 b/src/LIB/SURCOUCHE/src/mode_field.f90
index 6f2dc6936..cf38d78bd 100644
--- a/src/LIB/SURCOUCHE/src/mode_field.f90
+++ b/src/LIB/SURCOUCHE/src/mode_field.f90
@@ -1898,6 +1898,7 @@ END SUBROUTINE FIND_FIELD_ID_FROM_MNHNAME
SUBROUTINE ALLOC_FIELD_SCALARS
!
USE MODD_DYN_n
+USE MODD_PARAM_n
!
CALL PRINT_MSG(NVERB_DEBUG,'GEN','ALLOC_FIELD_SCALARS','called')
!
@@ -1922,6 +1923,10 @@ IF (.NOT.ASSOCIATED(LHORELAX_TKE)) THEN
CALL PRINT_MSG(NVERB_DEBUG,'GEN','ALLOC_FIELD_SCALARS',' LHORELAX_TKE was not associated')
ALLOCATE(LHORELAX_TKE)
END IF
+IF (.NOT.ASSOCIATED(CSURF)) THEN
+ CALL PRINT_MSG(NVERB_DEBUG,'GEN','ALLOC_FIELD_SCALARS',' CSURF was not associated')
+ ALLOCATE(CHARACTER(LEN=4) :: CSURF)
+END IF
!
END SUBROUTINE ALLOC_FIELD_SCALARS
!
@@ -2002,9 +2007,9 @@ END IF
IF (.NOT.ASSOCIATED(CSURF)) THEN
CALL PRINT_MSG(NVERB_DEBUG,'GEN','INI_FIELD_SCALARS',' CSURF was not associated')
ALLOCATE(CHARACTER(LEN=4) :: CSURF)
- CALL FIND_FIELD_ID_FROM_MNHNAME('SURF',IID,IRESP)
- TFIELDLIST(IID)%TFIELD_C0D(1)%DATA=>CSURF
END IF
+CALL FIND_FIELD_ID_FROM_MNHNAME('SURF',IID,IRESP)
+TFIELDLIST(IID)%TFIELD_C0D(1)%DATA=>CSURF
!
IF (.NOT.ASSOCIATED(XDRYMASST)) THEN
CALL PRINT_MSG(NVERB_DEBUG,'GEN','INI_FIELD_SCALARS',' XDRYMASST was not associated')
@@ -2089,13 +2094,13 @@ END IF
! Initialize some pointers
!
IF (KFROM == KTO) THEN
- IF (.NOT.ALLOCATED(XRHODREFZ) .AND. CPROGRAM/='NESPGD') THEN
+ IF (.NOT.ALLOCATED(XRHODREFZ) .AND. CPROGRAM/='NESPGD' .AND. CPROGRAM/='PGD') THEN
CALL PRINT_MSG(NVERB_FATAL,'GEN','FIELDLIST_GOTO_MODEL','XRHODREFZ not yet allocated')
END IF
CALL FIND_FIELD_ID_FROM_MNHNAME('RHOREFZ',IID,IRESP)
TFIELDLIST(IID)%TFIELD_X1D(KFROM)%DATA=>XRHODREFZ
!
- IF (.NOT.ALLOCATED(XTHVREFZ) .AND. CPROGRAM/='NESPGD') THEN
+ IF (.NOT.ALLOCATED(XTHVREFZ) .AND. CPROGRAM/='NESPGD' .AND. CPROGRAM/='PGD') THEN
CALL PRINT_MSG(NVERB_FATAL,'GEN','FIELDLIST_GOTO_MODEL','XTHVREFZ not yet allocated')
END IF
CALL FIND_FIELD_ID_FROM_MNHNAME('THVREFZ',IID,IRESP)
@@ -2215,7 +2220,6 @@ CALL FIND_FIELD_ID_FROM_MNHNAME('YHAT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X1D(K
CALL FIND_FIELD_ID_FROM_MNHNAME('ZHAT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X1D(KFROM)%DATA => XZHAT
CALL FIND_FIELD_ID_FROM_MNHNAME('DXHAT',IID,IRESP); TFIELDLIST(IID)%TFIELD_X1D(KFROM)%DATA => XDXHAT
CALL FIND_FIELD_ID_FROM_MNHNAME('DYHAT',IID,IRESP); TFIELDLIST(IID)%TFIELD_X1D(KFROM)%DATA => XDYHAT
-CALL FIND_FIELD_ID_FROM_MNHNAME('DYHAT',IID,IRESP); TFIELDLIST(IID)%TFIELD_X1D(KFROM)%DATA => XDYHAT
CALL FIND_FIELD_ID_FROM_MNHNAME('ALT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XZZ
CALL FIND_FIELD_ID_FROM_MNHNAME('DIRCOSXW',IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KFROM)%DATA => XDIRCOSXW
CALL FIND_FIELD_ID_FROM_MNHNAME('DIRCOSYW',IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KFROM)%DATA => XDIRCOSYW
@@ -2238,37 +2242,37 @@ END IF
!
! MODD_TURB_n variables
!
-CALL FIND_FIELD_ID_FROM_MNHNAME('WTHVMF',IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA => XWTHVMF
+CALL FIND_FIELD_ID_FROM_MNHNAME('WTHVMF',IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XWTHVMF
!
! MODD_RADIATIONS_n variables
!
IF (CPROGRAM=='MESONH') THEN
IF (CRAD /= 'NONE') THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('DTHRAD', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA => XDTHRAD
- CALL FIND_FIELD_ID_FROM_MNHNAME('FLALWD', IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KTO)%DATA => XFLALWD
- CALL FIND_FIELD_ID_FROM_MNHNAME('DIRFLASWD', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA => XDIRFLASWD
- CALL FIND_FIELD_ID_FROM_MNHNAME('SCAFLASWD', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA => XSCAFLASWD
- CALL FIND_FIELD_ID_FROM_MNHNAME('DIRSRFSWD', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA => XDIRSRFSWD
- CALL FIND_FIELD_ID_FROM_MNHNAME('CLEARCOL_TM1',IID,IRESP); TFIELDLIST(IID)%TFIELD_N2D(KTO)%DATA => NCLEARCOL_TM1
- CALL FIND_FIELD_ID_FROM_MNHNAME('ZENITH', IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KTO)%DATA => XZENITH
- CALL FIND_FIELD_ID_FROM_MNHNAME('AZIM', IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KTO)%DATA => XAZIM
- CALL FIND_FIELD_ID_FROM_MNHNAME('DIR_ALB', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA => XDIR_ALB
- CALL FIND_FIELD_ID_FROM_MNHNAME('SCA_ALB', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA => XSCA_ALB
- CALL FIND_FIELD_ID_FROM_MNHNAME('EMIS', IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KTO)%DATA => XEMIS
- CALL FIND_FIELD_ID_FROM_MNHNAME('TSRAD', IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KTO)%DATA => XTSRAD
+ CALL FIND_FIELD_ID_FROM_MNHNAME('DTHRAD', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XDTHRAD
+ CALL FIND_FIELD_ID_FROM_MNHNAME('FLALWD', IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KFROM)%DATA => XFLALWD
+ CALL FIND_FIELD_ID_FROM_MNHNAME('DIRFLASWD', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XDIRFLASWD
+ CALL FIND_FIELD_ID_FROM_MNHNAME('SCAFLASWD', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XSCAFLASWD
+ CALL FIND_FIELD_ID_FROM_MNHNAME('DIRSRFSWD', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XDIRSRFSWD
+ CALL FIND_FIELD_ID_FROM_MNHNAME('CLEARCOL_TM1',IID,IRESP); TFIELDLIST(IID)%TFIELD_N2D(KFROM)%DATA => NCLEARCOL_TM1
+ CALL FIND_FIELD_ID_FROM_MNHNAME('ZENITH', IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KFROM)%DATA => XZENITH
+ CALL FIND_FIELD_ID_FROM_MNHNAME('AZIM', IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KFROM)%DATA => XAZIM
+ CALL FIND_FIELD_ID_FROM_MNHNAME('DIR_ALB', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XDIR_ALB
+ CALL FIND_FIELD_ID_FROM_MNHNAME('SCA_ALB', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XSCA_ALB
+ CALL FIND_FIELD_ID_FROM_MNHNAME('EMIS', IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KFROM)%DATA => XEMIS
+ CALL FIND_FIELD_ID_FROM_MNHNAME('TSRAD', IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KFROM)%DATA => XTSRAD
END IF
END IF
!
! MODD_GR_FIELD_n variables
!
-CALL FIND_FIELD_ID_FROM_MNHNAME('SSO_ANIS', IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KTO)%DATA => XSSO_ANISOTROPY
-CALL FIND_FIELD_ID_FROM_MNHNAME('SSO_SLOPE',IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KTO)%DATA => XSSO_SLOPE
-CALL FIND_FIELD_ID_FROM_MNHNAME('SSO_DIR', IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KTO)%DATA => XSSO_DIRECTION
-CALL FIND_FIELD_ID_FROM_MNHNAME('AVG_ZS', IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KTO)%DATA => XAVG_ZS
-CALL FIND_FIELD_ID_FROM_MNHNAME('SIL_ZS', IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KTO)%DATA => XSIL_ZS
-CALL FIND_FIELD_ID_FROM_MNHNAME('MAX_ZS', IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KTO)%DATA => XMAX_ZS
-CALL FIND_FIELD_ID_FROM_MNHNAME('MIN_ZS', IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KTO)%DATA => XMIN_ZS
-CALL FIND_FIELD_ID_FROM_MNHNAME('SSO_STDEV',IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KTO)%DATA => XSSO_STDEV
+CALL FIND_FIELD_ID_FROM_MNHNAME('SSO_ANIS', IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KFROM)%DATA => XSSO_ANISOTROPY
+CALL FIND_FIELD_ID_FROM_MNHNAME('SSO_SLOPE',IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KFROM)%DATA => XSSO_SLOPE
+CALL FIND_FIELD_ID_FROM_MNHNAME('SSO_DIR', IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KFROM)%DATA => XSSO_DIRECTION
+CALL FIND_FIELD_ID_FROM_MNHNAME('AVG_ZS', IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KFROM)%DATA => XAVG_ZS
+CALL FIND_FIELD_ID_FROM_MNHNAME('SIL_ZS', IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KFROM)%DATA => XSIL_ZS
+CALL FIND_FIELD_ID_FROM_MNHNAME('MAX_ZS', IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KFROM)%DATA => XMAX_ZS
+CALL FIND_FIELD_ID_FROM_MNHNAME('MIN_ZS', IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KFROM)%DATA => XMIN_ZS
+CALL FIND_FIELD_ID_FROM_MNHNAME('SSO_STDEV',IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KFROM)%DATA => XSSO_STDEV
!
! MODD_PRECIP_n variables
!
diff --git a/src/LIB/SURCOUCHE/src/mode_fm.f90 b/src/LIB/SURCOUCHE/src/mode_fm.f90
index f60f9fb4c..57fc85553 100644
--- a/src/LIB/SURCOUCHE/src/mode_fm.f90
+++ b/src/LIB/SURCOUCHE/src/mode_fm.f90
@@ -132,7 +132,7 @@ END IF
END SUBROUTINE FMLOOK_ll
-SUBROUTINE IO_FILE_OPEN_ll(TPFILE,HFIPRI,KRESP)
+SUBROUTINE IO_FILE_OPEN_ll(TPFILE,HFIPRI,KRESP,OPARALLELIO)
!
USE MODD_IO_ll, ONLY: ISP,LIOCDF4,TFILEDATA
USE MODE_FD_ll, ONLY: FD_ll,GETFD
@@ -141,6 +141,7 @@ USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_FIND_BYNAME
TYPE(TFILEDATA), INTENT(INOUT) :: TPFILE ! File structure
CHARACTER(LEN=*), INTENT(IN) :: HFIPRI ! File for prints in FM
INTEGER, INTENT(OUT) :: KRESP ! Return code
+LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
!
INTEGER :: ININAR ! Number of articles present in LFI file (unused here)
INTEGER :: JI,IRESP
@@ -155,7 +156,12 @@ IF (TPFILE%LOPENED) THEN
RETURN
END IF
!
-CALL FMOPEN_ll(TPFILE%CNAME,TPFILE%CMODE,HFIPRI,TPFILE%NLFINPRAR,TPFILE%NLFITYPE,TPFILE%NLFIVERB,ININAR,KRESP,TPFILE=TPFILE)
+IF (.NOT.PRESENT(OPARALLELIO)) THEN
+ CALL FMOPEN_ll(TPFILE%CNAME,TPFILE%CMODE,HFIPRI,TPFILE%NLFINPRAR,TPFILE%NLFITYPE,TPFILE%NLFIVERB,ININAR,KRESP,TPFILE=TPFILE)
+ELSE
+ CALL FMOPEN_ll(TPFILE%CNAME,TPFILE%CMODE,HFIPRI,TPFILE%NLFINPRAR,TPFILE%NLFITYPE,TPFILE%NLFIVERB,ININAR,KRESP,&
+ TPFILE=TPFILE,OPARALLELIO=OPARALLELIO)
+END IF
!
TPFILE%LOPENED = .TRUE.
TPFILE%NOPEN = TPFILE%NOPEN + 1
@@ -404,7 +410,7 @@ KRESP=IRESP
RETURN
END SUBROUTINE FMOPEN_ll
-SUBROUTINE IO_FILE_CLOSE_ll(TPFILE,HFIPRI,KRESP)
+SUBROUTINE IO_FILE_CLOSE_ll(TPFILE,HFIPRI,KRESP,OPARALLELIO)
!
USE MODD_IO_ll, ONLY: TFILEDATA
USE MODE_FD_ll, ONLY: FD_ll,GETFD
@@ -413,6 +419,7 @@ USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_FIND_BYNAME
TYPE(TFILEDATA), INTENT(INOUT) :: TPFILE ! File structure
CHARACTER(LEN=*), INTENT(IN) :: HFIPRI ! File for prints in FM
INTEGER, INTENT(OUT) :: KRESP ! Return code
+LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
!
INTEGER :: INB_PROCIO, IRESP, JI
CHARACTER (LEN=3) :: YNUMBER ! Character string for Z-level
@@ -430,7 +437,11 @@ ENDIF
TZFDLFI=>GETFD(ADJUSTL(TRIM(TPFILE%CNAME)//'.lfi'))
INB_PROCIO=TZFDLFI%NB_PROCIO
!
-CALL FMCLOS_ll(TPFILE%CNAME,'KEEP',HFIPRI,KRESP,TPFILE=TPFILE)
+IF (.NOT.PRESENT(OPARALLELIO)) THEN
+ CALL FMCLOS_ll(TPFILE%CNAME,'KEEP',HFIPRI,KRESP,TPFILE=TPFILE)
+ELSE
+ CALL FMCLOS_ll(TPFILE%CNAME,'KEEP',HFIPRI,KRESP,OPARALLELIO=OPARALLELIO,TPFILE=TPFILE)
+END IF
!
TPFILE%LOPENED = .FALSE.
TPFILE%NCLOSE = TPFILE%NCLOSE + 1
diff --git a/src/MNH/diag.f90 b/src/MNH/diag.f90
index 73e49a0be..a172b73d0 100644
--- a/src/MNH/diag.f90
+++ b/src/MNH/diag.f90
@@ -124,6 +124,7 @@ USE MODD_LES_BUDGET
USE MODD_BUDGET
USE MODD_RADAR
USE MODD_PARAM_LIMA, ONLY : LLIMA_DIAG
+USE MODD_IO_ll, ONLY: TFILEDATA,TFILE_SURFEX
!
USE MODN_DIAG_BLANK
!
@@ -141,6 +142,7 @@ USE MODE_FM
USE MODE_IO_ll
USE MODE_ll
USE MODE_MODELN_HANDLER
+USE MODE_MSG
!
USE MODD_AIRCRAFT_BALLOON
USE MODD_PROFILER_n
@@ -200,6 +202,8 @@ INTEGER :: IIU, IJU, IKU
INTEGER :: IINFO_ll ! return code for _ll routines
REAL, DIMENSION(:,:),ALLOCATABLE :: ZSEA,ZTOWN
!
+TYPE(TFILEDATA),TARGET :: TZFILE
+!
NAMELIST/NAM_DIAG/ CISO, LVAR_RS, LVAR_LS, &
NCONV_KF, NRAD_3D, CRAD_SAT, NRTTOVINFO, LRAD_SUBG_COND, &
LVAR_TURB,LTURBFLX,LTURBDIAG,LMFFLX,XDTSTEP, &
@@ -446,9 +450,29 @@ ENDIF
!
INPRAR = 24 +2*(4+NRR+NSV)
YFMFILE=ADJUSTL(ADJUSTR(CINIFILE)//YSUFFIX)
-CALL FMOPEN_ll(YFMFILE,'WRITE',CLUOUT,INPRAR,ITYPE,NVERB,INPRAR,IRESP)
COUTFMFILE=YFMFILE
!
+TZFILE%CNAME = TRIM(YFMFILE)
+TZFILE%CTYPE = 'DIAG'
+IF (LCDF4) THEN
+ IF (.NOT.LLFIOUT) THEN
+ TZFILE%CFORMAT='NETCDF4'
+ ELSE
+ TZFILE%CFORMAT='LFICDF4'
+ TZFILE%NLFINPRAR= INPRAR
+ END IF
+ELSE IF (LLFIOUT) THEN
+ TZFILE%CFORMAT='LFI'
+ TZFILE%NLFINPRAR= INPRAR
+ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','DIAG','unknown backup/output fileformat')
+ENDIF
+TZFILE%CMODE = 'WRITE'
+TZFILE%NLFITYPE = ITYPE
+TZFILE%NLFIVERB = NVERB
+!
+CALL IO_FILE_OPEN_ll(TZFILE,CLUOUT,IRESP)
+!
CALL SECOND_MNH2(ZTIME2)
ZSTART=ZTIME2-ZTIME1
ZTIME1=ZTIME2
@@ -695,11 +719,13 @@ ZTIME1=ZTIME2
!
IF (CSURF=='EXTE') THEN
CALL GOTO_SURFEX(1)
+ TFILE_SURFEX => TZFILE
CALL WRITE_SURF_ATM_n(YSURF_CUR,'MESONH','ALL',.FALSE.)
CALL DIAG_SURF_ATM_n(YSURF_CUR%IM%DGEI, YSURF_CUR%FM%DGF, YSURF_CUR%DGL, YSURF_CUR%IM%DGI, &
YSURF_CUR%SM%DGS, YSURF_CUR%DGU, YSURF_CUR%TM%DGT, YSURF_CUR%WM%DGW, &
YSURF_CUR%U, YSURF_CUR%USS,'MESONH')
CALL WRITE_DIAG_SURF_ATM_n(YSURF_CUR,'MESONH','ALL')
+ NULLIFY(TFILE_SURFEX)
WRITE(ILUOUT0,*) ' '
WRITE(ILUOUT0,*) 'DIAG AFTER WRITE_DIAG_SURF_ATM_n'
ENDIF
@@ -735,7 +761,7 @@ ZTIME1=ZTIME2
DEALLOCATE(GMASKkids)
IF (GCLOSE_OUT) THEN
GCLOSE_OUT=.FALSE.
- CALL FMCLOS_ll(YFMFILE,'KEEP',CLUOUT,IRESP)
+ CALL IO_FILE_CLOSE_ll(TZFILE,CLUOUT,IRESP)
END IF
!
CALL CLOSE_ll (CLUOUT,IOSTAT=IRESP)
diff --git a/src/MNH/init_mnh.f90 b/src/MNH/init_mnh.f90
index 22875c5e9..9d533aa6c 100644
--- a/src/MNH/init_mnh.f90
+++ b/src/MNH/init_mnh.f90
@@ -173,11 +173,23 @@ IF (CPROGRAM=='SPAWN ' .OR. CPROGRAM=='DIAG ' .OR. CPROGRAM=='SPEC ' .OR. CPRO
CALL ALLOC_FIELD_SCALARS()
END IF
!
-DO JMI=1,JPMODELMAX
+CALL GOTO_MODEL(1)
+CALL INI_SEG_n(1,YLUOUT(1),YINIFILE(1),YINIFILEPGD(1),ZTSTEP_ALL)
+!
+IF (CPROGRAM=='SPAWN ') THEN
+ CALL INI_FIELD_LIST(2)
+ELSE IF (CPROGRAM/='REAL ' .AND. CPROGRAM/='IDEAL ' ) THEN
+ CALL INI_FIELD_LIST()
+END IF
+IF (CPROGRAM=='SPAWN ' .OR. CPROGRAM=='DIAG ' .OR. CPROGRAM=='SPEC ' .OR. CPROGRAM=='MESONH') THEN
+ CALL INI_FIELD_SCALARS()
+END IF
+!
+DO JMI=2,NMODEL
CALL GOTO_MODEL(JMI)
CALL INI_SEG_n(JMI,YLUOUT(JMI),YINIFILE(JMI),YINIFILEPGD(JMI),ZTSTEP_ALL)
- IF (JMI.EQ.NMODEL) EXIT
END DO
+!
IF (CPROGRAM=='SPAWN ') THEN
!bypass
NHALO = 1
@@ -214,15 +226,6 @@ CALL INI_PARAZ_ll(IINFO_ll)
! Allocations of Surfex Types
CALL SURFEX_ALLOC_LIST(NMODEL)
!
-IF (CPROGRAM=='SPAWN ') THEN
- CALL INI_FIELD_LIST(2)
-ELSE IF (CPROGRAM/='REAL ' .AND. CPROGRAM/='IDEAL ' ) THEN
- CALL INI_FIELD_LIST()
-END IF
-IF (CPROGRAM=='SPAWN ' .OR. CPROGRAM=='DIAG ' .OR. CPROGRAM=='SPEC ' .OR. CPROGRAM=='MESONH') THEN
- CALL INI_FIELD_SCALARS()
-END IF
-!
DO JMI=1,NMODEL
YSURF_CUR => YSURF_LIST(JMI)
!
diff --git a/src/MNH/open_nestpgd_files.f90 b/src/MNH/open_nestpgd_files.f90
index 08e9a6e1c..a3413c3fc 100644
--- a/src/MNH/open_nestpgd_files.f90
+++ b/src/MNH/open_nestpgd_files.f90
@@ -12,16 +12,19 @@ MODULE MODI_OPEN_NESTPGD_FILES
!#############################
!
INTERFACE
- SUBROUTINE OPEN_NESTPGD_FILES(HPGD,HNESTPGD)
+ SUBROUTINE OPEN_NESTPGD_FILES(TPFILEPGD,TPFILENESTPGD)
+!
+USE MODD_IO_ll, ONLY : TFILEDATA
+!
+TYPE(TFILEDATA),DIMENSION(:),ALLOCATABLE,INTENT(OUT) :: TPFILEPGD ! Input PGD files
+TYPE(TFILEDATA),DIMENSION(:),ALLOCATABLE,INTENT(OUT) :: TPFILENESTPGD ! Output PGD files
!
-CHARACTER(LEN=28), DIMENSION(:), INTENT(OUT) :: HPGD ! name of the input pgd files
-CHARACTER(LEN=28), DIMENSION(:), INTENT(OUT) :: HNESTPGD ! name of the output pgd files
END SUBROUTINE OPEN_NESTPGD_FILES
END INTERFACE
END MODULE MODI_OPEN_NESTPGD_FILES
-! ############################################
- SUBROUTINE OPEN_NESTPGD_FILES(HPGD,HNESTPGD)
-! ############################################
+! ######################################################
+ SUBROUTINE OPEN_NESTPGD_FILES(TPFILEPGD,TPFILENESTPGD)
+! ######################################################
!
!!**** *OPEN_NESTPGD_FILES* - openning of the files used in PREP_NEST_PGD
!!
@@ -78,6 +81,7 @@ USE MODD_LUNIT
USE MODD_CONF
USE MODD_NESTING
USE MODD_PARAMETERS
+USE MODD_IO_ll, ONLY : TFILEDATA
!
USE MODI_OPEN_LUOUTn
!
@@ -85,6 +89,7 @@ USE MODE_FIELD, ONLY : INI_FIELD_LIST
USE MODE_IO_ll
USE MODE_FM
USE MODE_POS
+USE MODE_MSG
!
USE MODE_MODELN_HANDLER
!
@@ -100,34 +105,32 @@ IMPLICIT NONE
!* 0.1 Declaration of arguments
! ------------------------
!
-CHARACTER(LEN=28), DIMENSION(:), INTENT(OUT) :: HPGD ! name of the input pgd files
-CHARACTER(LEN=28), DIMENSION(:), INTENT(OUT) :: HNESTPGD ! name of the output pgd files
+TYPE(TFILEDATA),DIMENSION(:),ALLOCATABLE,INTENT(OUT) :: TPFILEPGD ! Input PGD files
+TYPE(TFILEDATA),DIMENSION(:),ALLOCATABLE,INTENT(OUT) :: TPFILENESTPGD ! Output PGD files
!
!* 0.2 Declaration of local variables
! ------------------------------
!
INTEGER :: IRESP ! return-code if problems eraised
INTEGER :: ILUOUT0 ! logical unit for listing file
-INTEGER :: ININAR ! number of articles initially present in a FM file
LOGICAL :: GFOUND ! Return code when searching namelist
!
CHARACTER(LEN=28) :: HPRE_NEST_PGD ! name of namelist file
INTEGER :: IPRE_NEST_PGD ! logical unit of namelist file
!
-CHARACTER(LEN=28) :: YPGD ! name of the pgd file for each model
-CHARACTER(LEN=28) :: YLUOUT ! name of output listing file for each model
-CHARACTER(LEN=2) :: YNEST ! to define the output pgd file names
-CHARACTER(LEN=28) :: YPGD1, YPGD2, YPGD3, YPGD4, &
- YPGD5, YPGD6, YPGD7, YPGD8
-! ! name of all pgd files
-! ! in the namelist
-INTEGER :: IDAD ! father of one model
-INTEGER :: JPGD ! loop counter
-LOGICAL :: GADD !
-CHARACTER(LEN=21), DIMENSION(JPMODELMAX) :: YSHORTPGD
-INTEGER :: NHALO_MNH
-!
-INTEGER :: ILUNAM,ILUOUT ! Logical unit number for the EXSPA file
+CHARACTER(LEN=28) :: YPGD ! name of the pgd file for each model
+CHARACTER(LEN=28) :: YLUOUT ! name of output listing file for each model
+CHARACTER(LEN=2) :: YNEST ! to define the output pgd file names
+CHARACTER(LEN=28) :: YPGD1, YPGD2, YPGD3, YPGD4, &
+ YPGD5, YPGD6, YPGD7, YPGD8
+! ! name of all pgd files
+! ! in the namelist
+INTEGER :: IDAD ! father of one model
+INTEGER :: JPGD ! loop counter
+LOGICAL :: GADD !
+INTEGER :: NHALO_MNH
+!
+INTEGER :: ILUOUT ! Logical unit number for the EXSPA file
!
!* 0.3 Declaration of namelists
! ------------------------
@@ -147,11 +150,6 @@ NAMELIST/NAM_CONF_NEST/JPHEXT, NHALO_MNH
!* 1. SET DEFAULT NAMES
! -----------------
!
-DO JPGD=1,JPMODELMAX
- HPGD (JPGD)=' '
- HNESTPGD(JPGD)=' '
-END DO
-!
HPRE_NEST_PGD='PRE_NEST_PGD1.nam'
CLUOUT0='OUTPUT_LISTING0'
!
@@ -278,7 +276,6 @@ DO JPGD=1,JPMODELMAX
END IF
!
NDAD(JPGD)=IDAD
- HPGD(JPGD)=YPGD
END IF
END DO
!
@@ -289,18 +286,50 @@ END DO
!
CALL POSNAM(IPRE_NEST_PGD,'NAM_NEST_PGD',GFOUND,ILUOUT0)
IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_NEST_PGD)
-HNESTPGD(:) = ' '
-!
-YSHORTPGD(:)=HPGD(:)
-DO JPGD=1,NMODEL
- HNESTPGD(JPGD) = ADJUSTR( YSHORTPGD(JPGD))//'.nest'//ADJUSTL(YNEST)
- HNESTPGD(JPGD) = ADJUSTL(HNESTPGD(JPGD))
-END DO
!
CALL POSNAM(IPRE_NEST_PGD,'NAM_CONFIO',GFOUND,ILUOUT0)
IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_CONFIO)
CALL SET_CONFIO_ll(LCDF4, LLFIOUT, LLFIREAD)
!
+ALLOCATE(TPFILEPGD (NMODEL))
+ALLOCATE(TPFILENESTPGD(NMODEL))
+!
+IF (NMODEL>=1) TPFILEPGD(1)%CNAME = TRIM(YPGD1)
+IF (NMODEL>=2) TPFILEPGD(2)%CNAME = TRIM(YPGD2)
+IF (NMODEL>=3) TPFILEPGD(3)%CNAME = TRIM(YPGD3)
+IF (NMODEL>=4) TPFILEPGD(4)%CNAME = TRIM(YPGD4)
+IF (NMODEL>=5) TPFILEPGD(5)%CNAME = TRIM(YPGD5)
+IF (NMODEL>=6) TPFILEPGD(6)%CNAME = TRIM(YPGD6)
+IF (NMODEL>=7) TPFILEPGD(7)%CNAME = TRIM(YPGD7)
+IF (NMODEL>=8) TPFILEPGD(8)%CNAME = TRIM(YPGD8)
+!
+DO JPGD=1,NMODEL
+ TPFILENESTPGD(JPGD)%CNAME = TRIM(TPFILEPGD(JPGD)%CNAME)//'.nest'//ADJUSTL(YNEST)
+END DO
+!
+TPFILEPGD(:) %CTYPE = 'PREPPGD'
+TPFILENESTPGD(:)%CTYPE = 'PREPNESTPGD'
+IF (LCDF4) THEN
+ IF (.NOT.LLFIOUT) THEN
+ TPFILEPGD(:) %CFORMAT = 'NETCDF4'
+ TPFILENESTPGD(:)%CFORMAT = 'NETCDF4'
+ ELSE
+ TPFILEPGD(:) %CFORMAT = 'LFICDF4'
+ TPFILENESTPGD(:)%CFORMAT = 'LFICDF4'
+ END IF
+ELSE IF (LLFIOUT) THEN
+ TPFILEPGD(:) %CFORMAT = 'LFI'
+ TPFILENESTPGD(:)%CFORMAT = 'LFI'
+ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','OPEN_NESTPGD_FILES','unknown backup/output fileformat')
+ENDIF
+TPFILEPGD(:) %CMODE = 'READ'
+TPFILENESTPGD(:)%CMODE = 'WRITE'
+TPFILEPGD(:) %NLFITYPE = 2
+TPFILENESTPGD(:)%NLFITYPE = 1
+TPFILEPGD(:) %NLFIVERB = NVERB
+TPFILENESTPGD(:)%NLFIVERB = NVERB
+!
!-------------------------------------------------------------------------------
CALL CLOSE_ll(HPRE_NEST_PGD)
!-------------------------------------------------------------------------------
@@ -309,13 +338,13 @@ CALL CLOSE_ll(HPRE_NEST_PGD)
! -------------------------------------
!
DO JPGD=1,NMODEL
- CALL FMOPEN_ll(HPGD(JPGD),'READ',CLUOUT0,0,2,NVERB,ININAR,IRESP,OPARALLELIO=.FALSE.)
- CALL FMOPEN_ll(HNESTPGD(JPGD),'WRITE',CLUOUT0,0,1,NVERB,ININAR,IRESP,OPARALLELIO=.FALSE.)
+ CALL IO_FILE_OPEN_ll(TPFILEPGD(JPGD), CLUOUT0,IRESP,OPARALLELIO=.FALSE.)
+ CALL IO_FILE_OPEN_ll(TPFILENESTPGD(JPGD),CLUOUT0,IRESP,OPARALLELIO=.FALSE.)
END DO
!
!-------------------------------------------------------------------------------
!
-!* 7. OPENING OF OUPUT LISTING FILES FOR ALL MODELS
+!* 7. OPENING OF OUTPUT LISTING FILES FOR ALL MODELS
! ----------------------------------------------
!
CALL INI_FIELD_LIST()
diff --git a/src/MNH/prep_ideal_case.f90 b/src/MNH/prep_ideal_case.f90
index ffa22a9ef..808cb2ba8 100644
--- a/src/MNH/prep_ideal_case.f90
+++ b/src/MNH/prep_ideal_case.f90
@@ -362,6 +362,7 @@ USE MODE_ll
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
USE MODE_MODELN_HANDLER
USE MODE_FIELD
+USE MODE_MSG
!
USE MODI_DEFAULT_DESFM_n ! Interface modules
USE MODI_DEFAULT_EXPRE
@@ -422,10 +423,12 @@ USE MODE_FMWRIT
USE MODI_WRITE_HGRID
USE MODD_MPIF
USE MODD_VAR_ll
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO_ll, ONLY: TFILEDATA,TFILE_SURFEX
!
USE MODE_MPPDB
!
+USE MODD_GET_n
+!
IMPLICIT NONE
!
!* 0.1 Declarations of global variables not declared in the modules
@@ -571,7 +574,7 @@ REAL :: XHSLOP=1.2 ! if LHSLOP filtering of slopes higher
REAL :: ZZS_MAX, ZZS_MAX_ll
INTEGER :: IJPHEXT
!
-TYPE(TFILEDATA) :: TZFILE
+TYPE(TFILEDATA),TARGET :: TZFILE
!
!
!* 0.2 Namelist declarations
@@ -837,13 +840,34 @@ ELSE
END IF
!
NRR=0
-IF (LUSERV) NRR=NRR+1
-IF (LUSERC) NRR=NRR+1
-IF (LUSERR) NRR=NRR+1
-IF (LUSERI) NRR=NRR+1
-IF (LUSERS) NRR=NRR+1
-IF (LUSERG) NRR=NRR+1
-IF (LUSERH) NRR=NRR+1
+IF (LUSERV) THEN
+ NRR=NRR+1
+ IDX_RVT = NRR
+END IF
+IF (LUSERC) THEN
+ NRR=NRR+1
+ IDX_RCT = NRR
+END IF
+IF (LUSERR) THEN
+ NRR=NRR+1
+ IDX_RRT = NRR
+END IF
+IF (LUSERI) THEN
+ NRR=NRR+1
+ IDX_RIT = NRR
+END IF
+IF (LUSERS) THEN
+ NRR=NRR+1
+ IDX_RST = NRR
+END IF
+IF (LUSERG) THEN
+ NRR=NRR+1
+ IDX_RGT = NRR
+END IF
+IF (LUSERH) THEN
+ NRR=NRR+1
+ IDX_RHT = NRR
+END IF
!
! NRR=4 for RSOU case because RI and Rc always computed
IF (CIDEAL == 'RSOU' .AND. NRR < 4 ) NRR=4
@@ -1748,8 +1772,7 @@ ELSE IF (LLFIOUT) THEN
TZFILE%CFORMAT='LFI'
TZFILE%NLFINPRAR= NNPRAR
ELSE
- PRINT *,'Error: unknown backup/output fileformat'
- CALL ABORT
+ CALL PRINT_MSG(NVERB_FATAL,'IO','PREP_IDEAL_CASE','unknown backup/output fileformat')
ENDIF
TZFILE%CMODE = 'WRITE'
TZFILE%NLFITYPE = NTYPE
@@ -1829,7 +1852,9 @@ IF (CSURF =='EXTE') THEN
!* rereading of physiographic fields and definition of prognostic fields
!* writing of all surface fields
COUTFMFILE = CINIFILE
+ TFILE_SURFEX => TZFILE
CALL PREP_SURF_MNH(' ',' ')
+ NULLIFY(TFILE_SURFEX)
CALL SURFEX_DEALLO_LIST
ELSE
CSURF = "NONE"
diff --git a/src/MNH/prep_nest_pgd.f90 b/src/MNH/prep_nest_pgd.f90
index b82bc4d0b..8a9c9577a 100644
--- a/src/MNH/prep_nest_pgd.f90
+++ b/src/MNH/prep_nest_pgd.f90
@@ -105,6 +105,7 @@ USE MODD_CST
USE MODD_LUNIT
USE MODD_NESTING
USE MODD_CONF_n
+USE MODD_IO_ll, ONLY : TFILEDATA, TFILE_SURFEX
!
USE MODI_OPEN_NESTPGD_FILES
USE MODI_RETRIEVE1_NEST_INFO_n
@@ -141,9 +142,6 @@ IMPLICIT NONE
!* 0.1 Declaration of local variables
! ------------------------------
!
-CHARACTER(LEN=28), DIMENSION(JPMODELMAX) :: CPGD ! name of input pgd files
-CHARACTER(LEN=28), DIMENSION(JPMODELMAX) :: CNESTPGD ! name of output pgd files
-!
INTEGER, DIMENSION(JPMODELMAX) :: NXSIZE ! number of grid points for each model
INTEGER, DIMENSION(JPMODELMAX) :: NYSIZE ! in x and y-directions
! relatively to its father grid
@@ -158,7 +156,6 @@ INTEGER :: IGRID, ILENCH
LOGICAL, DIMENSION(JPMODELMAX) :: L1D_ALL ! Flag for 1D conf. for each PGD
LOGICAL, DIMENSION(JPMODELMAX) :: L2D_ALL ! Flag for 2D conf. for each PGD
LOGICAL, DIMENSION(JPMODELMAX) :: LPACK_ALL! Flag for packing conf. for each PGD
-
!
INTEGER :: JTIME,ITIME
INTEGER :: IIMAX,IJMAX,IKMAX
@@ -167,6 +164,9 @@ INTEGER :: IDAD
INTEGER :: II
LOGICAL :: GISINIT
!
+TYPE(TFILEDATA),DIMENSION(:),ALLOCATABLE :: TZFILEPGD ! Input PGD files
+TYPE(TFILEDATA),DIMENSION(:),ALLOCATABLE,TARGET :: TZFILENESTPGD ! Output PGD files
+!
!-------------------------------------------------------------------------------
!
CALL MPPDB_INIT()
@@ -191,7 +191,7 @@ CALL INI_CST
!
NVERB=1
!
-CALL OPEN_NESTPGD_FILES(CPGD,CNESTPGD)
+CALL OPEN_NESTPGD_FILES(TZFILEPGD,TZFILENESTPGD)
CALL SET_JP_ll(JPMODELMAX,JPHEXT,JPVEXT,JPHEXT)
!
CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT0,IRESP)
@@ -218,14 +218,14 @@ CALL MPI_COMM_SIZE(NMNH_COMM_WORLD, NPROC, IINFO_ll)
CALL SET_DAD0_ll()
DO JPGD=1,NMODEL
! read and set dimensions and ratios of model JPGD
- CALL FMREAD(CPGD(JPGD),'IMAX',CLUOUT0,'--',IIMAX,IGRID,ILENCH,YCOMMENT,IRESP)
- CALL FMREAD(CPGD(JPGD),'JMAX',CLUOUT0,'--',IJMAX,IGRID,ILENCH,YCOMMENT,IRESP)
- CALL FMREAD(CPGD(JPGD),'DXRATIO',CLUOUT0,'--',NDXRATIO_ALL(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
- CALL FMREAD(CPGD(JPGD),'DYRATIO',CLUOUT0,'--',NDYRATIO_ALL(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
- CALL FMREAD(CPGD(JPGD),'XSIZE',CLUOUT0,'--',NXSIZE(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
- CALL FMREAD(CPGD(JPGD),'YSIZE',CLUOUT0,'--',NYSIZE(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
- CALL FMREAD(CPGD(JPGD),'XOR',CLUOUT0,'--',NXOR_ALL(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
- CALL FMREAD(CPGD(JPGD),'YOR',CLUOUT0,'--',NYOR_ALL(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(TZFILEPGD(JPGD)%CNAME,'IMAX',CLUOUT0,'--',IIMAX,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(TZFILEPGD(JPGD)%CNAME,'JMAX',CLUOUT0,'--',IJMAX,IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(TZFILEPGD(JPGD)%CNAME,'DXRATIO',CLUOUT0,'--',NDXRATIO_ALL(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(TZFILEPGD(JPGD)%CNAME,'DYRATIO',CLUOUT0,'--',NDYRATIO_ALL(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(TZFILEPGD(JPGD)%CNAME,'XSIZE',CLUOUT0,'--',NXSIZE(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(TZFILEPGD(JPGD)%CNAME,'YSIZE',CLUOUT0,'--',NYSIZE(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(TZFILEPGD(JPGD)%CNAME,'XOR',CLUOUT0,'--',NXOR_ALL(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(TZFILEPGD(JPGD)%CNAME,'YOR',CLUOUT0,'--',NYOR_ALL(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
CALL SET_DIM_ll(IIMAX, IJMAX, 1)
! compute origin and end of local subdomain of model JPGD
! initialize variables from MODD_NESTING, origin and end of global model JPGD in coordinates of its father
@@ -262,11 +262,11 @@ DO JPGD=1,NMODEL
CALL GOTO_MODEL(JPGD)
CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
CALL GOTO_SURFEX(JPGD)
- CALL FMREAD(CPGD(JPGD),'L1D ',CLUOUT0,'--',L1D_ALL(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
- CALL FMREAD(CPGD(JPGD),'L2D ',CLUOUT0,'--',L2D_ALL(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
- CALL FMREAD(CPGD(JPGD),'PACK ',CLUOUT0,'--',LPACK_ALL(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(TZFILEPGD(JPGD)%CNAME,'L1D ',CLUOUT0,'--',L1D_ALL(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(TZFILEPGD(JPGD)%CNAME,'L2D ',CLUOUT0,'--',L2D_ALL(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
+ CALL FMREAD(TZFILEPGD(JPGD)%CNAME,'PACK ',CLUOUT0,'--',LPACK_ALL(JPGD),IGRID,ILENCH,YCOMMENT,IRESP)
CALL SET_FMPACK_ll(L1D_ALL(JPGD),L2D_ALL(JPGD),LPACK_ALL(JPGD))
- CALL READ_HGRID(JPGD,CPGD(JPGD),YMY_NAME,YDAD_NAME,YSTORAGE_TYPE)
+ CALL READ_HGRID(JPGD,TZFILEPGD(JPGD)%CNAME,YMY_NAME,YDAD_NAME,YSTORAGE_TYPE)
CSTORAGE_TYPE='PG'
END DO
CALL INI_PARAZ_ll(IINFO_ll)
@@ -317,9 +317,9 @@ END DO
! ----------------------
!
DO JPGD=1,NMODEL
- IF (LEN_TRIM(CPGD(JPGD))>0) THEN
+ IF (LEN_TRIM(TZFILEPGD(JPGD)%CNAME)>0) THEN
CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
- CPGDFILE = CPGD(JPGD)
+ CPGDFILE = TZFILEPGD(JPGD)%CNAME
CALL GOTO_MODEL(JPGD)
CALL GOTO_SURFEX(JPGD)
CALL INIT_PGD_SURF_ATM(YSURF_CUR,'MESONH','PGD', &
@@ -347,12 +347,14 @@ END DO
!
DO JPGD=1,NMODEL
CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
- CPGDFILE = CPGD(JPGD)
- COUTFMFILE = CNESTPGD(JPGD)
+ CPGDFILE = TZFILEPGD(JPGD)%CNAME
+ COUTFMFILE = TZFILENESTPGD(JPGD)%CNAME
CALL GOTO_MODEL(JPGD)
CALL GOTO_SURFEX(JPGD)
+ TFILE_SURFEX => TZFILENESTPGD(JPGD)
CALL WRITE_PGD_SURF_ATM_n(YSURF_CUR,'MESONH')
- CALL WRITE_ZSMT_n(CNESTPGD(JPGD))
+ NULLIFY(TFILE_SURFEX)
+ CALL WRITE_ZSMT_n(TZFILENESTPGD(JPGD)%CNAME)
END DO
!
!-------------------------------------------------------------------------------
@@ -362,29 +364,29 @@ END DO
!
!
DO JPGD=1,NMODEL
- CALL FMWRIT(CNESTPGD(JPGD),'MASDEV ',CLUOUT0,'--',NMASDEV,0,1,' ',IRESP)
- CALL FMWRIT(CNESTPGD(JPGD),'BUGFIX ',CLUOUT0,'--',NBUGFIX,0,1,' ',IRESP)
- CALL FMWRIT(CNESTPGD(JPGD),'BIBUSER ',CLUOUT0,'--',CBIBUSER,0,1,' ',IRESP)
- CALL FMWRIT(CNESTPGD(JPGD),'PROGRAM ',CLUOUT0,'--',CPROGRAM,0,1,' ',IRESP)
- CALL FMWRIT(CNESTPGD(JPGD),'STORAGE_TYPE',CLUOUT0,'--',CSTORAGE_TYPE,0,1,' ',IRESP)
- CALL FMWRIT(CNESTPGD(JPGD),'MY_NAME ',CLUOUT0,'--',CNESTPGD(JPGD),0,1,' ',IRESP)
+ CALL FMWRIT(TZFILENESTPGD(JPGD)%CNAME,'MASDEV ',CLUOUT0,'--',NMASDEV,0,1,' ',IRESP)
+ CALL FMWRIT(TZFILENESTPGD(JPGD)%CNAME,'BUGFIX ',CLUOUT0,'--',NBUGFIX,0,1,' ',IRESP)
+ CALL FMWRIT(TZFILENESTPGD(JPGD)%CNAME,'BIBUSER ',CLUOUT0,'--',CBIBUSER,0,1,' ',IRESP)
+ CALL FMWRIT(TZFILENESTPGD(JPGD)%CNAME,'PROGRAM ',CLUOUT0,'--',CPROGRAM,0,1,' ',IRESP)
+ CALL FMWRIT(TZFILENESTPGD(JPGD)%CNAME,'STORAGE_TYPE',CLUOUT0,'--',CSTORAGE_TYPE,0,1,' ',IRESP)
+ CALL FMWRIT(TZFILENESTPGD(JPGD)%CNAME,'MY_NAME ',CLUOUT0,'--',TZFILENESTPGD(JPGD)%CNAME,0,1,' ',IRESP)
IF (NDAD(JPGD)>=1) THEN
- YDAD_NAME = CNESTPGD(NDAD(JPGD))
+ YDAD_NAME = TZFILENESTPGD(NDAD(JPGD))%CNAME
ELSE
YDAD_NAME = ' '
END IF
- CALL FMWRIT(CNESTPGD(JPGD),'DAD_NAME ',CLUOUT0,'--',YDAD_NAME,0,1,' ',IRESP)
+ CALL FMWRIT(TZFILENESTPGD(JPGD)%CNAME,'DAD_NAME ',CLUOUT0,'--',YDAD_NAME,0,1,' ',IRESP)
IF (LEN_TRIM(YDAD_NAME)>0) THEN
- CALL FMWRIT(CNESTPGD(JPGD),'DXRATIO ',CLUOUT0,'--',NDXRATIO_ALL(JPGD),0,1,' ',IRESP)
- CALL FMWRIT(CNESTPGD(JPGD),'DYRATIO ',CLUOUT0,'--',NDYRATIO_ALL(JPGD),0,1,' ',IRESP)
- CALL FMWRIT(CNESTPGD(JPGD),'XOR ',CLUOUT0,'--',NXOR_ALL(JPGD),0,1,' ',IRESP)
- CALL FMWRIT(CNESTPGD(JPGD),'YOR ',CLUOUT0,'--',NYOR_ALL(JPGD),0,1,' ',IRESP)
+ CALL FMWRIT(TZFILENESTPGD(JPGD)%CNAME,'DXRATIO ',CLUOUT0,'--',NDXRATIO_ALL(JPGD),0,1,' ',IRESP)
+ CALL FMWRIT(TZFILENESTPGD(JPGD)%CNAME,'DYRATIO ',CLUOUT0,'--',NDYRATIO_ALL(JPGD),0,1,' ',IRESP)
+ CALL FMWRIT(TZFILENESTPGD(JPGD)%CNAME,'XOR ',CLUOUT0,'--',NXOR_ALL(JPGD),0,1,' ',IRESP)
+ CALL FMWRIT(TZFILENESTPGD(JPGD)%CNAME,'YOR ',CLUOUT0,'--',NYOR_ALL(JPGD),0,1,' ',IRESP)
END IF
- CALL FMWRIT(CNESTPGD(JPGD),'SURF ',CLUOUT0,'--','EXTE',0,1,' ',IRESP)
- CALL FMWRIT(CNESTPGD(JPGD),'L1D ',CLUOUT0,'--',L1D_ALL(JPGD),0,1,' ',IRESP)
- CALL FMWRIT(CNESTPGD(JPGD),'L2D ',CLUOUT0,'--',L2D_ALL(JPGD),0,1,' ',IRESP)
- CALL FMWRIT(CNESTPGD(JPGD),'PACK ',CLUOUT0,'--',LPACK_ALL(JPGD),0,1,' ',IRESP)
- CALL FMWRIT(CNESTPGD(JPGD),'JPHEXT ',CLUOUT0,'--',JPHEXT,0,1,' ',IRESP)
+ CALL FMWRIT(TZFILENESTPGD(JPGD)%CNAME,'SURF ',CLUOUT0,'--','EXTE',0,1,' ',IRESP)
+ CALL FMWRIT(TZFILENESTPGD(JPGD)%CNAME,'L1D ',CLUOUT0,'--',L1D_ALL(JPGD),0,1,' ',IRESP)
+ CALL FMWRIT(TZFILENESTPGD(JPGD)%CNAME,'L2D ',CLUOUT0,'--',L2D_ALL(JPGD),0,1,' ',IRESP)
+ CALL FMWRIT(TZFILENESTPGD(JPGD)%CNAME,'PACK ',CLUOUT0,'--',LPACK_ALL(JPGD),0,1,' ',IRESP)
+ CALL FMWRIT(TZFILENESTPGD(JPGD)%CNAME,'JPHEXT ',CLUOUT0,'--',JPHEXT,0,1,' ',IRESP)
END DO
!
!-------------------------------------------------------------------------------
@@ -393,8 +395,8 @@ END DO
! --------------------
!
DO JPGD=1,NMODEL
- CALL FMCLOS_ll(CPGD (JPGD),'KEEP',CLUOUT0,IRESP,OPARALLELIO=.FALSE.)
- CALL FMCLOS_ll(CNESTPGD(JPGD),'KEEP',CLUOUT0,IRESP,OPARALLELIO=.FALSE.)
+ CALL IO_FILE_CLOSE_ll(TZFILEPGD(JPGD), CLUOUT0,IRESP,OPARALLELIO=.FALSE.)
+ CALL IO_FILE_CLOSE_ll(TZFILENESTPGD(JPGD),CLUOUT0,IRESP,OPARALLELIO=.FALSE.)
END DO
!
!* loop to spare enough time to transfer commands before end of program
diff --git a/src/MNH/prep_pgd.f90 b/src/MNH/prep_pgd.f90
index 0bbe1ca7a..b3a322d17 100644
--- a/src/MNH/prep_pgd.f90
+++ b/src/MNH/prep_pgd.f90
@@ -80,7 +80,7 @@ USE MODD_CONF, ONLY : CPROGRAM, NMASDEV, NBUGFIX, CBIBUSER, &
USE MODD_CONF_n,ONLY : CSTORAGE_TYPE
USE MODD_LUNIT, ONLY : CLUOUT0, COUTFMFILE
USE MODD_PARAMETERS, ONLY : XUNDEF
-USE MODD_IO_ll, ONLY : GSMONOPROC
+USE MODD_IO_ll, ONLY : GSMONOPROC, TFILEDATA, TFILE_SURFEX
USE MODD_IO_SURF_MNH, ONLY : NHALO
USE MODD_SPAWN, ONLY : NDXRATIO,NDYRATIO,NXSIZE,NYSIZE,NXOR,NYOR
!
@@ -89,6 +89,8 @@ USE MODE_FMWRIT
USE MODE_IO_ll
USE MODE_FM
USE MODE_MODELN_HANDLER
+USE MODE_MSG
+USE MODE_FIELD
!
USE MODI_ZSMT_PGD
!
@@ -138,6 +140,7 @@ INTEGER :: ILENCH ! length of comment string
CHARACTER(LEN=100):: YCOMMENT ! comment string
INTEGER :: IIMAX, IJMAX
INTEGER :: NHALO_MNH
+TYPE(TFILEDATA),TARGET :: TZFILE
!
NAMELIST/NAM_PGDFILE/CPGDFILE, NHALO
NAMELIST/NAM_ZSFILTER/NZSFILTER,LHSLOP,XHSLOP
@@ -202,6 +205,8 @@ CALL SURFEX_ALLOC_LIST(1)
YSURF_CUR => YSURF_LIST(1)
CALL READ_ALL_NAMELISTS(YSURF_CUR,'MESONH','PRE',.FALSE.)
!
+CALL INI_FIELD_LIST(1)
+!
CALL GOTO_MODEL(1)
CALL GOTO_SURFEX(1)
!
@@ -233,8 +238,28 @@ CALL PGD_SURF_ATM(YSURF_CUR,'MESONH',' ',' ',.FA
!* 3. Writes the physiographic fields
! -------------------------------
!
+TZFILE%CNAME = CPGDFILE
+TZFILE%CTYPE = 'PREPPGD'
+IF (LCDF4) THEN
+ IF (.NOT.LLFIOUT) THEN
+ TZFILE%CFORMAT= 'NETCDF4'
+ ELSE
+ TZFILE%CFORMAT= 'LFICDF4'
+ TZFILE%NLFINPRAR= 1
+ END IF
+ELSE IF (LLFIOUT) THEN
+ TZFILE%CFORMAT = 'LFI'
+ TZFILE%NLFINPRAR= 1
+ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'IO','PREP_PGD','unknown backup/output fileformat')
+ENDIF
+TZFILE%CMODE = 'WRITE'
+TZFILE%NLFITYPE = 1
+TZFILE%NLFIVERB = 5
+!
+CALL IO_FILE_OPEN_ll(TZFILE,CLUOUT0,IRESP,OPARALLELIO=.FALSE.)
+!
COUTFMFILE = CPGDFILE
-CALL FMOPEN_ll(COUTFMFILE,'WRITE',CLUOUT0,1,1,5,ININAR,IRESP,OPARALLELIO=.FALSE.)
!
CALL FMWRIT(COUTFMFILE,'MASDEV ',CLUOUT0,'--',NMASDEV,0,1,' ',IRESP)
CALL FMWRIT(COUTFMFILE,'BUGFIX ',CLUOUT0,'--',NBUGFIX,0,1,' ',IRESP)
@@ -267,7 +292,9 @@ CALL FMWRIT(COUTFMFILE,'XOR ',CLUOUT0,'--',NXOR,0,1,' ',IRESP)
CALL FMWRIT(COUTFMFILE,'YOR ',CLUOUT0,'--',NYOR,0,1,' ',IRESP)
CALL FMWRIT(COUTFMFILE,'JPHEXT ',CLUOUT0,'--',JPHEXT,0,1,' ',IRESP)
!
+TFILE_SURFEX => TZFILE
CALL WRITE_PGD_SURF_ATM_n(YSURF_CUR,'MESONH')
+NULLIFY(TFILE_SURFEX) !Probably not necessary
!* 4. Computes and writes smooth orography for SLEVE coordinate
! ---------------------------------------------------------
!CALL ZSMT_PGD(COUTFMFILE,NZSFILTER,NSLEVE,XSMOOTH_ZS,LHSLOP,XHSLOP)
@@ -323,7 +350,7 @@ WRITE(ILUOUT0,*) '***************************'
! ----------------------
!
CALL CLOSE_ll(CLUOUT0,IOSTAT=IRESP,OPARALLELIO=.FALSE.)
-CALL FMCLOS_ll(COUTFMFILE,'KEEP',CLUOUT0,IRESP,OPARALLELIO=.FALSE.)
+CALL IO_FILE_CLOSE_ll(TZFILE,CLUOUT0,IRESP,OPARALLELIO=.FALSE.)
!
CALL END_PARA_ll(IINFO_ll)
!
diff --git a/src/MNH/prep_real_case.f90 b/src/MNH/prep_real_case.f90
index dc93b290b..0280429b7 100644
--- a/src/MNH/prep_real_case.f90
+++ b/src/MNH/prep_real_case.f90
@@ -446,7 +446,7 @@ USE MODD_CH_AEROSOL, ONLY: LORILAM, LINITPM, XINIRADIUSI, XINIRADIUSJ,&
XINISIGI, XINISIGJ, XN0IMIN, XN0JMIN, CRGUNIT
USE MODD_DUST, ONLY: LDUST, NMODE_DST, CRGUNITD, XINISIG, XINIRADIUS, XN0MIN
USE MODD_SALT, ONLY: LSALT, NMODE_SLT, CRGUNITS, XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT
-USE MODD_IO_ll, ONLY : GSMONOPROC,TFILEDATA,LIOCDF4,LLFIOUT
+USE MODD_IO_ll, ONLY : GSMONOPROC,TFILEDATA,LIOCDF4,LLFIOUT, TFILE_SURFEX
USE MODD_PREP_REAL
USE MODD_CH_MNHC_n, ONLY: LUSECHAQ_n=>LUSECHAQ,LUSECHIC_n=>LUSECHIC, LUSECHEM_n=>LUSECHEM
USE MODI_READ_VER_GRID
@@ -512,7 +512,7 @@ LOGICAL :: LUSECHAQ
LOGICAL :: LUSECHIC
LOGICAL :: LUSECHEM
!
-TYPE(TFILEDATA) :: TZFILE
+TYPE(TFILEDATA),TARGET :: TZFILE
!
!
!* 0.3 Declaration of namelists
@@ -561,6 +561,7 @@ CALL ALLOC_FIELD_SCALARS()
!
CALL DEFAULT_DESFM_n(1)
NRR=1
+IDX_RVT = 1
!
!-------------------------------------------------------------------------------
!
@@ -588,8 +589,7 @@ ELSE IF (LLFIOUT) THEN
TZFILE%CFORMAT='LFI'
TZFILE%NLFINPRAR= 0
ELSE
- PRINT *,'Error: unknown backup/output fileformat'
- CALL ABORT
+ CALL PRINT_MSG(NVERB_FATAL,'IO','PREP_REAL_CASE','unknown backup/output fileformat')
ENDIF
TZFILE%CMODE = 'WRITE'
TZFILE%NLFITYPE = 1
@@ -1034,13 +1034,34 @@ CSTORAGE_TYPE='TT'
IF (YATMFILETYPE=='GRIBEX') THEN
CSURF = "EXTE"
DO JRR=1,NRR
- IF (JRR==1) LUSERV=.TRUE.
- IF (JRR==2) LUSERC=.TRUE.
- IF (JRR==3) LUSERR=.TRUE.
- IF (JRR==4) LUSERI=.TRUE.
- IF (JRR==5) LUSERS=.TRUE.
- IF (JRR==6) LUSERG=.TRUE.
- IF (JRR==7) LUSERH=.TRUE.
+ IF (JRR==1) THEN
+ LUSERV=.TRUE.
+ IDX_RVT = JRR
+ END IF
+ IF (JRR==2) THEN
+ LUSERC=.TRUE.
+ IDX_RCT = JRR
+ END IF
+ IF (JRR==3) THEN
+ LUSERR=.TRUE.
+ IDX_RRT = JRR
+ END IF
+ IF (JRR==4) THEN
+ LUSERI=.TRUE.
+ IDX_RIT = JRR
+ END IF
+ IF (JRR==5) THEN
+ LUSERS=.TRUE.
+ IDX_RST = JRR
+ END IF
+ IF (JRR==6) THEN
+ LUSERG=.TRUE.
+ IDX_RGT = JRR
+ END IF
+ IF (JRR==7) THEN
+ LUSERH=.TRUE.
+ IDX_RHT = JRR
+ END IF
END DO
END IF
!
@@ -1083,7 +1104,9 @@ IF (.NOT. LCOUPLING ) THEN
CALL READ_ALL_NAMELISTS(YSURF_CUR,'MESONH','PRE',.FALSE.)
ENDIF
CALL GOTO_SURFEX(1)
+ TFILE_SURFEX => TZFILE
CALL PREP_SURF_MNH(YSURFFILE,YSURFFILETYPE)
+ NULLIFY(TFILE_SURFEX)
CALL SURFEX_DEALLO_LIST
ENDIF
!
diff --git a/src/MNH/spawn_model2.f90 b/src/MNH/spawn_model2.f90
index 023138a47..e2dae103f 100644
--- a/src/MNH/spawn_model2.f90
+++ b/src/MNH/spawn_model2.f90
@@ -228,11 +228,12 @@ USE MODD_CH_MNHC_n
USE MODD_PASPOL_n
!$20140515
USE MODD_VAR_ll, ONLY : NPROC
-USE MODD_IO_ll, ONLY: TFILEDATA,LIOCDF4,LLFIOUT
+USE MODD_IO_ll, ONLY: TFILEDATA,LIOCDF4,LLFIOUT,TFILE_SURFEX
!
USE MODE_GRIDCART ! Executive modules
USE MODE_GRIDPROJ
USE MODE_ll
+USE MODE_MSG
!
USE MODI_READ_HGRID
USE MODI_SPAWN_GRID2
@@ -388,7 +389,7 @@ INTEGER,DIMENSION(:,:),ALLOCATABLE :: IJCOUNT
!
REAL :: ZZS_MAX, ZZS_MAX_ll
!
-TYPE(TFILEDATA) :: TZFILE
+TYPE(TFILEDATA),TARGET :: TZFILE
!-------------------------------------------------------------------------------
!
! Save model index and switch to model 2 variables
@@ -608,13 +609,35 @@ ENDIF
CALL INI_NSV(2) ! NSV* are set equal for model 2 and model 1.
! NSV is set to the total number of SV for model 2
!
-IF (NRR==0) LUSERV=.FALSE. ! as the default is .T.
-IF (NRR>1) LUSERC=.TRUE.
-IF (NRR>2) LUSERR=.TRUE.
-IF (NRR>3) LUSERI=.TRUE.
-IF (NRR>4) LUSERS=.TRUE.
-IF (NRR>5) LUSERG=.TRUE.
-IF (NRR>6) LUSERH=.TRUE.
+IF (NRR==0) THEN
+ LUSERV=.FALSE. ! as the default is .T.
+ELSE
+ IDX_RVT = 1
+END IF
+IF (NRR>1) THEN
+ LUSERC=.TRUE.
+ IDX_RCT = 2
+END IF
+IF (NRR>2) THEN
+ LUSERR=.TRUE.
+ IDX_RRT = 2
+END IF
+IF (NRR>3) THEN
+ LUSERI=.TRUE.
+ IDX_RIT = 2
+END IF
+IF (NRR>4) THEN
+ LUSERS=.TRUE.
+ IDX_RST = 2
+END IF
+IF (NRR>5) THEN
+ LUSERG=.TRUE.
+ IDX_RGT = 2
+END IF
+IF (NRR>6) THEN
+ LUSERH=.TRUE.
+ IDX_RHT = 2
+END IF
!
!
!
@@ -1442,8 +1465,7 @@ ELSE IF (LLFIOUT) THEN
TZFILE%CFORMAT='LFI'
TZFILE%NLFINPRAR= INPRAR
ELSE
- PRINT *,'Error: unknown backup/output fileformat'
- CALL ABORT
+ CALL PRINT_MSG(NVERB_FATAL,'IO','SPAWN_MODEL2','unknown backup/output fileformat')
ENDIF
TZFILE%CMODE = 'WRITE'
TZFILE%NLFITYPE = ITYPE
@@ -1489,7 +1511,9 @@ ZWRITE = ZTIME2 - ZTIME1
!
ZTIME1 = ZTIME2
!
+TFILE_SURFEX => TZFILE
CALL SPAWN_SURF(HINIFILE,HINIFILEPGD,OSPAWN_SURF)
+NULLIFY(TFILE_SURFEX)
!
CALL SECOND_MNH(ZTIME2)
!
diff --git a/src/MNH/write_surf_mnh.f90 b/src/MNH/write_surf_mnh.f90
index 8fa02f488..ec451e3bf 100644
--- a/src/MNH/write_surf_mnh.f90
+++ b/src/MNH/write_surf_mnh.f90
@@ -11,12 +11,12 @@
SUBROUTINE WRITE_SURFX0_MNH(HREC,PFIELD,KRESP,HCOMMENT)
! #############################################################
!
-!!**** *READX0* - routine to read a real scalar
+!!**** *WRITEX0* - routine to write a real scalar
!!
!! PURPOSE
!! -------
!
-! The purpose of READX0 is
+! The purpose of WRITEX0 is
!
!!** METHOD
!! ------
@@ -112,7 +112,7 @@ END SUBROUTINE WRITE_SURFX0_MNH
SUBROUTINE WRITE_SURFX1_MNH(HREC,KL,PFIELD,KRESP,HCOMMENT,HDIR)
! #############################################################
!
-!!**** *READX1* - routine to fill a real 1D array for the externalised surface
+!!**** *WRITEX1* - routine to fill a real 1D array for the externalised surface
!!
!! PURPOSE
!! -------
@@ -411,7 +411,7 @@ END SUBROUTINE WRITE_SURFX1_MNH
SUBROUTINE WRITE_SURFX2COV_MNH(HREC,KL1,KL2,PFIELD,OFLAG,KRESP,HCOMMENT,HDIR)
! #############################################################
!
-!!**** *READX1* - routine to fill a real 1D array for the externalised surface
+!!**** *WRITEX1* - routine to fill a real 1D array for the externalised surface
!!
!! PURPOSE
!! -------
@@ -612,7 +612,7 @@ END SUBROUTINE WRITE_SURFX2COV_MNH
SUBROUTINE WRITE_SURFX2_MNH(HREC,KL1,KL2,PFIELD,KRESP,HCOMMENT,HDIR)
! #############################################################
!
-!!**** *READX2* - routine to fill a real 2D array for the externalised surface
+!!**** *WRITEX2* - routine to fill a real 2D array for the externalised surface
!!
!! PURPOSE
!! -------
@@ -786,12 +786,12 @@ END SUBROUTINE WRITE_SURFX2_MNH
SUBROUTINE WRITE_SURFN0_MNH(HREC,KFIELD,KRESP,HCOMMENT)
! #############################################################
!
-!!**** *READN0* - routine to read an integer
+!!**** *WRITEN0* - routine to write an integer
!!
!! PURPOSE
!! -------
!
-! The purpose of READN0 is
+! The purpose of WRITEN0 is
!
!!** METHOD
!! ------
@@ -884,12 +884,12 @@ END SUBROUTINE WRITE_SURFN0_MNH
SUBROUTINE WRITE_SURFN1_MNH(HREC,KL,KFIELD,KRESP,HCOMMENT,HDIR)
! #############################################################
!
-!!**** *READN0* - routine to read an integer
+!!**** *WRITEN0* - routine to write an integer
!!
!! PURPOSE
!! -------
!
-! The purpose of READN0 is
+! The purpose of WRITEN0 is
!
!!** METHOD
!! ------
@@ -967,9 +967,7 @@ IF (HDIR=='-') THEN
TZFIELD%NGRID = 0
TZFIELD%NTYPE = TYPEINT
TZFIELD%NDIMS = 1
-CALL PRINT_MSG(NVERB_ERROR,'IO','WRITE_SURFN1_MNH','not yet fully implemented')
-RETURN
-!PW: TODO ! CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,COUT,KRESP,KFIELD)
+ CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,COUT,KRESP,KFIELD)
!
ELSE IF (HDIR=='H') THEN
!
@@ -1003,12 +1001,12 @@ END SUBROUTINE WRITE_SURFN1_MNH
SUBROUTINE WRITE_SURFC0_MNH(HREC,HFIELD,KRESP,HCOMMENT)
! #############################################################
!
-!!**** *READC0* - routine to read an integer
+!!**** *WRITEC0* - routine to write an integer
!!
!! PURPOSE
!! -------
!
-! The purpose of READC0 is
+! The purpose of WRITEC0 is
!
!!** METHOD
!! ------
@@ -1109,12 +1107,12 @@ END SUBROUTINE WRITE_SURFC0_MNH
SUBROUTINE WRITE_SURFL1_MNH(HREC,KL,OFIELD,KRESP,HCOMMENT,HDIR)
! #############################################################
!
-!!**** *READL1* - routine to read a logical array
+!!**** *WRITEL1* - routine to write a logical array
!!
!! PURPOSE
!! -------
!
-! The purpose of READL1 is
+! The purpose of WRITEL1 is
!
!!** METHOD
!! ------
@@ -1197,9 +1195,7 @@ IF (HDIR=='-') THEN
TZFIELD%NGRID = 0
TZFIELD%NTYPE = TYPELOG
TZFIELD%NDIMS = 1
-CALL PRINT_MSG(NVERB_ERROR,'IO','WRITE_SURFL1_MNH','not yet fully implemented')
-RETURN
-!PW: TODO ! CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,COUT,KRESP,OFIELD(:))
+ CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,COUT,KRESP,OFIELD(:))
END IF
!
ELSE IF (HDIR=='H') THEN
@@ -1241,7 +1237,7 @@ END SUBROUTINE WRITE_SURFL1_MNH
SUBROUTINE WRITE_SURFL0_MNH(HREC,OFIELD,KRESP,HCOMMENT)
! #############################################################
!
-!!**** *WRITEL1* - routine to read a logical
+!!**** *WRITEL1* - routine to write a logical
!!
!! PURPOSE
!! -------
@@ -1329,12 +1325,12 @@ END SUBROUTINE WRITE_SURFL0_MNH
SUBROUTINE WRITE_SURFT0_MNH(HREC,KYEAR,KMONTH,KDAY,PTIME,KRESP,HCOMMENT)
! #############################################################
!
-!!**** *READT0* - routine to read a MESO-NH date_time scalar
+!!**** *WRITET0* - routine to write a MESO-NH date_time scalar
!!
!! PURPOSE
!! -------
!
-! The purpose of READT0 is
+! The purpose of WRITET0 is
!
!!** METHOD
!! ------
@@ -1378,7 +1374,7 @@ IMPLICIT NONE
!
!* 0.1 Declarations of arguments
!
-CHARACTER(LEN=LEN_HREC), INTENT(IN) :: HREC ! name of the article to be read
+CHARACTER(LEN=LEN_HREC), INTENT(IN) :: HREC ! name of the article to be written
INTEGER, INTENT(IN) :: KYEAR ! year
INTEGER, INTENT(IN) :: KMONTH ! month
INTEGER, INTENT(IN) :: KDAY ! day
@@ -1476,7 +1472,7 @@ IMPLICIT NONE
!
!* 0.1 Declarations of arguments
!
-CHARACTER(LEN=LEN_HREC), INTENT(IN) :: HREC ! name of the article to be read
+CHARACTER(LEN=LEN_HREC), INTENT(IN) :: HREC ! name of the article to be written
INTEGER, INTENT(IN) :: KL1 ! number of points
INTEGER, DIMENSION(KL1), INTENT(IN) :: KYEAR ! year
INTEGER, DIMENSION(KL1), INTENT(IN) :: KMONTH ! month
--
GitLab