From f915ef0b06c2eeec6d46a20a60cf1303e8154994 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Fri, 14 Apr 2017 15:54:20 +0200
Subject: [PATCH] Philippe 14/04/2017: IO: add IO_WRITE_HEADER subroutine
---
src/LIB/SURCOUCHE/src/fmwrit_ll.f90 | 30 +++++++++++++++++++++++++++
src/LIB/SURCOUCHE/src/mode_netcdf.f90 | 4 ++--
src/MNH/diag.f90 | 2 ++
src/MNH/modd_lunit.f90 | 3 ++-
src/MNH/modeln.f90 | 5 +++--
src/MNH/open_nestpgd_files.f90 | 9 ++++++--
src/MNH/prep_nest_pgd.f90 | 15 ++------------
src/MNH/prep_pgd.f90 | 20 +++++++-----------
src/MNH/write_lfifmn_fordiachron.f90 | 7 -------
src/MNH/write_lfin.f90 | 8 -------
10 files changed, 55 insertions(+), 48 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90 b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
index 91174fc06..678318990 100644
--- a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
+++ b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
@@ -223,6 +223,7 @@ MODULE MODE_FMWRIT
& FMWRITL0_ll,FMWRITL1_ll,FMWRITC0_ll,FMWRITC1_ll,FMWRITT0_ll,FMWRITBOXX2_ll,&
& FMWRITBOXX3_ll,FMWRITBOXX4_ll,FMWRITBOXX5_ll,FMWRITBOXX6_ll
PUBLIC IO_WRITE_FIELD, IO_WRITE_FIELD_BOX, IO_WRITE_FIELD_LB
+ PUBLIC IO_WRITE_HEADER
!INCLUDE 'mpif.h'
@@ -255,6 +256,35 @@ CONTAINS
END SUBROUTINE FM_WRIT_ERR
+ SUBROUTINE IO_WRITE_HEADER(TPFILE,HLUOUT)
+ !
+ USE MODD_CONF
+ USE MODD_CONF_n, ONLY : CSTORAGE_TYPE
+ USE MODD_IO_ll, ONLY: TFILEDATA
+ !
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File structure
+ CHARACTER(LEN=*),INTENT(IN) :: HLUOUT ! File for prints in FM
+ !
+ INTEGER :: IRESP
+ !
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_HEADER','called')
+ !
+ CALL IO_WRITE_HEADER_NC4(TPFILE,HLUOUT)
+ !
+ CALL IO_WRITE_FIELD(TPFILE,'MASDEV', HLUOUT,IRESP,NMASDEV)
+ CALL IO_WRITE_FIELD(TPFILE,'BUGFIX', HLUOUT,IRESP,NBUGFIX)
+ CALL IO_WRITE_FIELD(TPFILE,'BIBUSER', HLUOUT,IRESP,CBIBUSER)
+ CALL IO_WRITE_FIELD(TPFILE,'PROGRAM', HLUOUT,IRESP,CPROGRAM)
+ CALL IO_WRITE_FIELD(TPFILE,'STORAGE_TYPE',HLUOUT,IRESP,CSTORAGE_TYPE)
+ CALL IO_WRITE_FIELD(TPFILE,'MY_NAME', HLUOUT,IRESP,TPFILE%CNAME)
+ IF ( ASSOCIATED(TPFILE%TDADFILE) ) THEN
+ CALL IO_WRITE_FIELD(TPFILE,'DAD_NAME',HLUOUT,IRESP,TPFILE%TDADFILE%CNAME)
+ ELSE
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_HEADER','TPFILE%TDADFILE not associated')
+ CALL IO_WRITE_FIELD(TPFILE,'DAD_NAME',HLUOUT,IRESP,'')
+ ENDIF
+ !
+ END SUBROUTINE IO_WRITE_HEADER
SUBROUTINE FMWRITX0_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
KLENCH,HCOMMENT,KRESP)
diff --git a/src/LIB/SURCOUCHE/src/mode_netcdf.f90 b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
index 29b23fcd1..ab1c88d05 100644
--- a/src/LIB/SURCOUCHE/src/mode_netcdf.f90
+++ b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
@@ -155,8 +155,8 @@ USE MODD_IO_ll, ONLY: ISP,TFILEDATA
!
USE MODE_FD_ll
!
-TYPE(TFILEDATA),POINTER,INTENT(IN) :: TPFILE ! File structure
-CHARACTER(LEN=*), INTENT(IN) :: HFIPRI ! File for prints in FM
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File structure
+CHARACTER(LEN=*),INTENT(IN) :: HFIPRI ! File for prints in FM
!
INTEGER(KIND=IDCDF_KIND) :: ISTATUS
TYPE(FD_ll), POINTER :: TZFD
diff --git a/src/MNH/diag.f90 b/src/MNH/diag.f90
index 3b06c8376..e03bc3860 100644
--- a/src/MNH/diag.f90
+++ b/src/MNH/diag.f90
@@ -139,6 +139,7 @@ USE MODI_WRITE_AIRCRAFT_BALLOON
USE MODE_POS
USE MODE_TIME
USE MODE_FM
+USE MODE_FMWRIT, ONLY : IO_WRITE_HEADER
USE MODE_IO_ll
USE MODE_ll
USE MODE_MODELN_HANDLER
@@ -585,6 +586,7 @@ IF ( LAIRCRAFT_BALLOON ) THEN
TXDTBAL%TDATE%DAY, &
TXDTBAL%TIME )
ENDDO
+ CALL IO_WRITE_HEADER(TZDIACFILE,CLUOUT)
CALL WRITE_LFIFMN_FORDIACHRO_n(TZDIACFILE)
CALL WRITE_AIRCRAFT_BALLOON(TZDIACFILE)
CALL MENU_DIACHRO(TZDIACFILE,CLUOUT,'END')
diff --git a/src/MNH/modd_lunit.f90 b/src/MNH/modd_lunit.f90
index d82f841bc..fe133c538 100644
--- a/src/MNH/modd_lunit.f90
+++ b/src/MNH/modd_lunit.f90
@@ -35,7 +35,8 @@
!! MODIFICATIONS
!! -------------
!! Original 05/05/94
-!! V. Masson 01/2004 add file names for use in externalized surface!-------------------------------------------------------------------------------
+!! V. Masson 01/2004 add file names for use in externalized surface
+!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index 13ca3cf59..59edda8b1 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -603,6 +603,7 @@ IF (KTCOUNT == 1) THEN
!
CALL IO_FILE_OPEN_ll(TDIAFILE,CLUOUT,IRESP)
!
+ CALL IO_WRITE_HEADER(TDIAFILE,CLUOUT)
CALL WRITE_DESFM_n(IMI,TRIM(TDIAFILE%CNAME)//'.des',CLUOUT)
CALL WRITE_LFIFMN_FORDIACHRO_n(TDIAFILE)
!
@@ -912,7 +913,7 @@ IF (IBAK < NBAK_NUMB ) THEN
CALL IO_FILE_OPEN_ll(TZBAKFILE,CLUOUT,IRESP)
!
CALL WRITE_DESFM_n(IMI,TRIM(TZBAKFILE%CNAME)//'.des',CLUOUT)
- CALL IO_WRITE_HEADER_NC4(TBACKUPN(IBAK)%TFILE,CLUOUT)
+ CALL IO_WRITE_HEADER(TBACKUPN(IBAK)%TFILE,CLUOUT)
CALL WRITE_LFIFM_n(TBACKUPN(IBAK)%TFILE,TBACKUPN(IBAK)%TFILE%TDADFILE%CNAME)
COUTFMFILE = TZBAKFILE%CNAME
CALL MNHWRITE_ZS_DUMMY_n(TZBAKFILE)
@@ -954,7 +955,7 @@ IF (IOUT < NOUT_NUMB ) THEN
!
CALL IO_FILE_OPEN_ll(TZOUTFILE,CLUOUT,IRESP)
!
- CALL IO_WRITE_HEADER_NC4(TZOUTFILE,CLUOUT)
+ CALL IO_WRITE_HEADER(TZOUTFILE,CLUOUT)
CALL IO_WRITE_FIELDLIST(TOUTPUTN(IOUT),CLUOUT)
CALL IO_WRITE_FIELD_USER(TOUTPUTN(IOUT),CLUOUT)
!
diff --git a/src/MNH/open_nestpgd_files.f90 b/src/MNH/open_nestpgd_files.f90
index a3413c3fc..39024a02f 100644
--- a/src/MNH/open_nestpgd_files.f90
+++ b/src/MNH/open_nestpgd_files.f90
@@ -105,8 +105,8 @@ IMPLICIT NONE
!* 0.1 Declaration of arguments
! ------------------------
!
-TYPE(TFILEDATA),DIMENSION(:),ALLOCATABLE,INTENT(OUT) :: TPFILEPGD ! Input PGD files
-TYPE(TFILEDATA),DIMENSION(:),ALLOCATABLE,INTENT(OUT) :: TPFILENESTPGD ! Output PGD files
+TYPE(TFILEDATA),DIMENSION(:),ALLOCATABLE, INTENT(OUT) :: TPFILEPGD ! Input PGD files
+TYPE(TFILEDATA),DIMENSION(:),ALLOCATABLE,TARGET,INTENT(OUT) :: TPFILENESTPGD ! Output PGD files
!
!* 0.2 Declaration of local variables
! ------------------------------
@@ -305,6 +305,11 @@ IF (NMODEL>=8) TPFILEPGD(8)%CNAME = TRIM(YPGD8)
!
DO JPGD=1,NMODEL
TPFILENESTPGD(JPGD)%CNAME = TRIM(TPFILEPGD(JPGD)%CNAME)//'.nest'//ADJUSTL(YNEST)
+ IF (NDAD(JPGD)>=1) THEN
+ TPFILENESTPGD(JPGD)%TDADFILE => TPFILENESTPGD(NDAD(JPGD))
+ ELSE
+ NULLIFY(TPFILENESTPGD(JPGD)%TDADFILE)
+ END IF
END DO
!
TPFILEPGD(:) %CTYPE = 'PREPPGD'
diff --git a/src/MNH/prep_nest_pgd.f90 b/src/MNH/prep_nest_pgd.f90
index b14396842..41f2b91e9 100644
--- a/src/MNH/prep_nest_pgd.f90
+++ b/src/MNH/prep_nest_pgd.f90
@@ -364,19 +364,8 @@ END DO
!
!
DO JPGD=1,NMODEL
- CALL IO_WRITE_FIELD(TZFILENESTPGD(JPGD),'MASDEV', CLUOUT0,IRESP,NMASDEV)
- CALL IO_WRITE_FIELD(TZFILENESTPGD(JPGD),'BUGFIX', CLUOUT0,IRESP,NBUGFIX)
- CALL IO_WRITE_FIELD(TZFILENESTPGD(JPGD),'BIBUSER', CLUOUT0,IRESP,CBIBUSER)
- CALL IO_WRITE_FIELD(TZFILENESTPGD(JPGD),'PROGRAM', CLUOUT0,IRESP,CPROGRAM)
- CALL IO_WRITE_FIELD(TZFILENESTPGD(JPGD),'STORAGE_TYPE',CLUOUT0,IRESP,CSTORAGE_TYPE)
- CALL IO_WRITE_FIELD(TZFILENESTPGD(JPGD),'MY_NAME', CLUOUT0,IRESP,TZFILENESTPGD(JPGD)%CNAME)
- IF (NDAD(JPGD)>=1) THEN
- YDAD_NAME = TZFILENESTPGD(NDAD(JPGD))%CNAME
- ELSE
- YDAD_NAME = ' '
- END IF
- CALL IO_WRITE_FIELD(TZFILENESTPGD(JPGD),'DAD_NAME', CLUOUT0,IRESP,YDAD_NAME)
- IF (LEN_TRIM(YDAD_NAME)>0) THEN
+ CALL IO_WRITE_HEADER(TZFILENESTPGD(JPGD),CLUOUT0)
+ IF ( ASSOCIATED(TZFILENESTPGD(JPGD)%TDADFILE) ) THEN
CALL IO_WRITE_FIELD(TZFILENESTPGD(JPGD),'DXRATIO',CLUOUT0,IRESP,NDXRATIO_ALL(JPGD))
CALL IO_WRITE_FIELD(TZFILENESTPGD(JPGD),'DYRATIO',CLUOUT0,IRESP,NDYRATIO_ALL(JPGD))
CALL IO_WRITE_FIELD(TZFILENESTPGD(JPGD),'XOR', CLUOUT0,IRESP,NXOR_ALL(JPGD))
diff --git a/src/MNH/prep_pgd.f90 b/src/MNH/prep_pgd.f90
index dc5c4cda2..bba967b26 100644
--- a/src/MNH/prep_pgd.f90
+++ b/src/MNH/prep_pgd.f90
@@ -75,8 +75,7 @@
!* 0. DECLARATION
! -----------
!
-USE MODD_CONF, ONLY : CPROGRAM, NMASDEV, NBUGFIX, CBIBUSER, &
- L1D, L2D, LPACK , LCARTESIAN
+USE MODD_CONF, ONLY : CPROGRAM, L1D, L2D, LPACK, LCARTESIAN
USE MODD_CONF_n,ONLY : CSTORAGE_TYPE
USE MODD_LUNIT, ONLY : CLUOUT0
USE MODD_PARAMETERS, ONLY : XUNDEF
@@ -259,17 +258,12 @@ TZFILE%NLFIVERB = 5
!
CALL IO_FILE_OPEN_ll(TZFILE,CLUOUT0,IRESP,OPARALLELIO=.FALSE.)
!
-CALL IO_WRITE_FIELD(TZFILE,'MASDEV', CLUOUT0,IRESP,NMASDEV)
-CALL IO_WRITE_FIELD(TZFILE,'BUGFIX', CLUOUT0,IRESP,NBUGFIX)
-CALL IO_WRITE_FIELD(TZFILE,'BIBUSER', CLUOUT0,IRESP,CBIBUSER)
-CALL IO_WRITE_FIELD(TZFILE,'PROGRAM', CLUOUT0,IRESP,CPROGRAM)
-CALL IO_WRITE_FIELD(TZFILE,'STORAGE_TYPE',CLUOUT0,IRESP,CSTORAGE_TYPE)
-CALL IO_WRITE_FIELD(TZFILE,'MY_NAME', CLUOUT0,IRESP,TZFILE%CNAME)
-CALL IO_WRITE_FIELD(TZFILE,'DAD_NAME', CLUOUT0,IRESP,YDAD)
-CALL IO_WRITE_FIELD(TZFILE,'SURF', CLUOUT0,IRESP,'EXTE')
-CALL IO_WRITE_FIELD(TZFILE,'L1D', CLUOUT0,IRESP,L1D)
-CALL IO_WRITE_FIELD(TZFILE,'L2D', CLUOUT0,IRESP,L2D)
-CALL IO_WRITE_FIELD(TZFILE,'PACK', CLUOUT0,IRESP,LPACK)
+CALL IO_WRITE_HEADER(TZFILE,CLUOUT0)
+!
+CALL IO_WRITE_FIELD(TZFILE,'SURF',CLUOUT0,IRESP,'EXTE')
+CALL IO_WRITE_FIELD(TZFILE,'L1D', CLUOUT0,IRESP,L1D)
+CALL IO_WRITE_FIELD(TZFILE,'L2D', CLUOUT0,IRESP,L2D)
+CALL IO_WRITE_FIELD(TZFILE,'PACK',CLUOUT0,IRESP,LPACK)
IF ( NDXRATIO <= 0 .AND. NDYRATIO <= 0 ) THEN
NDXRATIO = 1
NDYRATIO = 1
diff --git a/src/MNH/write_lfifmn_fordiachron.f90 b/src/MNH/write_lfifmn_fordiachron.f90
index ef608331e..611c3c022 100644
--- a/src/MNH/write_lfifmn_fordiachron.f90
+++ b/src/MNH/write_lfifmn_fordiachron.f90
@@ -136,18 +136,11 @@ LPACK=.FALSE.
!
!* 1.0 Version :
!
-CALL IO_WRITE_FIELD(TPFILE,'MASDEV', CLUOUT,IRESP,NMASDEV)
-CALL IO_WRITE_FIELD(TPFILE,'BUGFIX', CLUOUT,IRESP,NBUGFIX)
-CALL IO_WRITE_FIELD(TPFILE,'BIBUSER',CLUOUT,IRESP,CBIBUSER)
-CALL IO_WRITE_FIELD(TPFILE,'PROGRAM',CLUOUT,IRESP,CPROGRAM)
-!
CALL IO_WRITE_FIELD(TPFILE,'L1D', CLUOUT,IRESP,L1D)
CALL IO_WRITE_FIELD(TPFILE,'L2D', CLUOUT,IRESP,L2D)
CALL IO_WRITE_FIELD(TPFILE,'PACK',CLUOUT,IRESP,LPACK)
CALL IO_WRITE_FIELD(TPFILE,'SURF',CLUOUT,IRESP,CSURF)
!
-CALL IO_WRITE_FIELD(TPFILE,'STORAGE_TYPE',CLUOUT,IRESP,CSTORAGE_TYPE)
-!
!* 1.1 Dimensions :
!
CALL IO_WRITE_FIELD(TPFILE,'IMAX',CLUOUT,IRESP,NIMAX_ll)
diff --git a/src/MNH/write_lfin.f90 b/src/MNH/write_lfin.f90
index 38e101917..3a50f97a1 100644
--- a/src/MNH/write_lfin.f90
+++ b/src/MNH/write_lfin.f90
@@ -347,13 +347,7 @@ IKE=IKU-JPVEXT
!
!* 1.0 YFMFILE and HDADFILE writing :
!
-CALL IO_WRITE_FIELD(TPFILE,'MASDEV', CLUOUT,IRESP,NMASDEV)
-CALL IO_WRITE_FIELD(TPFILE,'BUGFIX', CLUOUT,IRESP,NBUGFIX)
-CALL IO_WRITE_FIELD(TPFILE,'BIBUSER', CLUOUT,IRESP,CBIBUSER)
-CALL IO_WRITE_FIELD(TPFILE,'PROGRAM', CLUOUT,IRESP,CPROGRAM)
CALL IO_WRITE_FIELD(TPFILE,'FILETYPE',CLUOUT,IRESP,TPFILE%CTYPE)
-CALL IO_WRITE_FIELD(TPFILE,'MY_NAME', CLUOUT,IRESP,TPFILE%CNAME)
-CALL IO_WRITE_FIELD(TPFILE,'DAD_NAME',CLUOUT,IRESP,HDADFILE)
!
IF (LEN_TRIM(HDADFILE)>0) THEN
CALL IO_WRITE_FIELD(TPFILE,'DXRATIO',CLUOUT,IRESP,NDXRATIO_ALL(IMI))
@@ -364,8 +358,6 @@ END IF
!
!* 1.1 Type and Dimensions :
!
-CALL IO_WRITE_FIELD(TPFILE,'STORAGE_TYPE',CLUOUT,IRESP,CSTORAGE_TYPE)
-!
CALL IO_WRITE_FIELD(TPFILE,'IMAX',CLUOUT,IRESP,NIMAX_ll)
CALL IO_WRITE_FIELD(TPFILE,'JMAX',CLUOUT,IRESP,NJMAX_ll)
CALL IO_WRITE_FIELD(TPFILE,'KMAX',CLUOUT,IRESP,NKMAX)
--
GitLab