From e1f8dc6891deff2d7b6091e3a9b936b572110718 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Fri, 5 May 2017 15:00:19 +0200
Subject: [PATCH] Philippe 05/05/2017: IO: optional HDAD_NAME argument for
IO_WRITE_HEADER to correct some problems + write the header for
PREP_REAL_CASE and SPAWNING
---
src/LIB/SURCOUCHE/src/fmwrit_ll.f90 | 17 +++++++++++++----
src/MNH/prep_real_case.f90 | 2 ++
src/MNH/spawn_model2.f90 | 2 ++
3 files changed, 17 insertions(+), 4 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90 b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
index 054a02f50..b374ee4e6 100644
--- a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
+++ b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
@@ -256,19 +256,26 @@ CONTAINS
END SUBROUTINE FM_WRIT_ERR
- SUBROUTINE IO_WRITE_HEADER(TPFILE,HLUOUT)
+ SUBROUTINE IO_WRITE_HEADER(TPFILE,HLUOUT,HDAD_NAME)
!
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
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File structure
+ CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! File for prints in FM
+ CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: HDAD_NAME
!
INTEGER :: IRESP
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_HEADER','called')
!
+ IF ( ASSOCIATED(TPFILE%TDADFILE) .AND. PRESENT(HDAD_NAME) ) THEN
+ IF ( TRIM(TPFILE%TDADFILE%CNAME) /= TRIM(HDAD_NAME) ) THEN
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_HEADER','TPFILE%TDADFILE%CNAME /= HDAD_NAME')
+ END IF
+ END IF
+ !
CALL IO_WRITE_HEADER_NC4(TPFILE,HLUOUT)
!
CALL IO_WRITE_FIELD(TPFILE,'MASDEV', HLUOUT,IRESP,NMASDEV)
@@ -279,8 +286,10 @@ CONTAINS
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 IF (PRESENT(HDAD_NAME)) THEN
+ CALL IO_WRITE_FIELD(TPFILE,'DAD_NAME',HLUOUT,IRESP,HDAD_NAME)
ELSE
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_HEADER','TPFILE%TDADFILE not associated')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_HEADER','TPFILE%TDADFILE not associated and HDAD_NAME not provided')
CALL IO_WRITE_FIELD(TPFILE,'DAD_NAME',HLUOUT,IRESP,' ')
ENDIF
!
diff --git a/src/MNH/prep_real_case.f90 b/src/MNH/prep_real_case.f90
index 6a9256cdf..100ce5193 100644
--- a/src/MNH/prep_real_case.f90
+++ b/src/MNH/prep_real_case.f90
@@ -391,6 +391,7 @@ USE MODE_GRIDPROJ ! executive modules
USE MODE_GRIDCART
USE MODE_POS
USE MODE_FM
+USE MODE_FMWRIT, ONLY : IO_WRITE_HEADER
USE MODE_IO_ll
USE MODE_ll
USE MODE_MODELN_HANDLER
@@ -1067,6 +1068,7 @@ END IF
!
YDESFM=ADJUSTL(ADJUSTR(CINIFILE)//'.des')
CALL WRITE_DESFM_n(1,YDESFM,CLUOUT0)
+CALL IO_WRITE_HEADER(TZFILE,CLUOUT0,HDAD_NAME=YDAD_NAME)
CALL WRITE_LFIFM_n(TZFILE,YDAD_NAME)
!
CALL SECOND_MNH(ZTIME2)
diff --git a/src/MNH/spawn_model2.f90 b/src/MNH/spawn_model2.f90
index e2dae103f..80ddb4e8f 100644
--- a/src/MNH/spawn_model2.f90
+++ b/src/MNH/spawn_model2.f90
@@ -257,6 +257,7 @@ USE MODI_CH_INIT_SCHEME_n
USE MODI_UPDATE_METRICS
!
USE MODE_FM
+USE MODE_FMWRIT, ONLY : IO_WRITE_HEADER
USE MODE_IO_ll
USE MODE_MODELN_HANDLER
USE MODE_FMREAD
@@ -1499,6 +1500,7 @@ ELSE
CDAD_NAME(2)=CMY_NAME(1) ! model 1 becomes the DAD of model 2 (spawned one)
ENDIF
!
+CALL IO_WRITE_HEADER(TZFILE,CLUOUT,HDAD_NAME=CDAD_NAME(2))
CALL WRITE_LFIFM_n(TZFILE,CDAD_NAME(2))
!
CALL SECOND_MNH(ZTIME2)
--
GitLab