From 7ed19725ebd802146d8f425633368b6f4b9441b5 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Thu, 15 Dec 2016 15:01:17 +0100
Subject: [PATCH] Philippe 15/12/2016: added several fields to TFIELDLIST Added
fields: MY_NAME, DAD_NAME, DXRATIO, DYRATIO, XOR, YOR, WT
---
src/LIB/SURCOUCHE/src/mode_field.f90 | 106 ++++++++++++++++++++++++++-
src/MNH/modd_fieldn.f90 | 5 +-
src/MNH/modd_spawn.f90 | 1 +
src/MNH/set_mask.f90 | 7 +-
src/MNH/spawn_field2.f90 | 10 +--
src/MNH/spawning.f90 | 1 +
src/MNH/write_lfin.f90 | 33 +++------
7 files changed, 125 insertions(+), 38 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/mode_field.f90 b/src/LIB/SURCOUCHE/src/mode_field.f90
index 057e6d4b4..443cc90c8 100644
--- a/src/LIB/SURCOUCHE/src/mode_field.f90
+++ b/src/LIB/SURCOUCHE/src/mode_field.f90
@@ -8,7 +8,7 @@ USE MODD_PARAMETERS
!
IMPLICIT NONE
!
-INTEGER,PRIVATE,PARAMETER :: MAXFIELDS = 9
+INTEGER,PRIVATE,PARAMETER :: MAXFIELDS = 100
INTEGER,PARAMETER :: TYPEUNDEF = -1, TYPEINT = 1, TYPELOG = 2, TYPEREAL = 3, TYPECHAR = 4
!
TYPE TFIELDPTR_X2D
@@ -98,7 +98,7 @@ TFIELDLIST(IDX)%CDIR = ''
TFIELDLIST(IDX)%CCOMMENT = ''
TFIELDLIST(IDX)%NGRID = 0
TFIELDLIST(IDX)%NTYPE = TYPECHAR
-TFIELDLIST(IDX)%NDIMS = 0
+TFIELDLIST(IDX)%NDIMS = 1
IDX = IDX+1
!
TFIELDLIST(IDX)%CMNHNAME = 'PROGRAM'
@@ -109,17 +109,83 @@ TFIELDLIST(IDX)%CDIR = ''
TFIELDLIST(IDX)%CCOMMENT = ''
TFIELDLIST(IDX)%NGRID = 0
TFIELDLIST(IDX)%NTYPE = TYPECHAR
-TFIELDLIST(IDX)%NDIMS = 0
+TFIELDLIST(IDX)%NDIMS = 1
IDX = IDX+1
!
TFIELDLIST(IDX)%CMNHNAME = 'FILETYPE'
TFIELDLIST(IDX)%CSTDNAME = ''
-TFIELDLIST(IDX)%CLONGNAME = 'Type of this file for MesoNH'
+TFIELDLIST(IDX)%CLONGNAME = 'MesoNH: type of this file'
+TFIELDLIST(IDX)%CUNITS = ''
+TFIELDLIST(IDX)%CDIR = ''
+TFIELDLIST(IDX)%CCOMMENT = ''
+TFIELDLIST(IDX)%NGRID = 0
+TFIELDLIST(IDX)%NTYPE = TYPECHAR
+TFIELDLIST(IDX)%NDIMS = 1
+IDX = IDX+1
+!
+TFIELDLIST(IDX)%CMNHNAME = 'MY_NAME'
+TFIELDLIST(IDX)%CSTDNAME = ''
+TFIELDLIST(IDX)%CLONGNAME = 'MesoNH: filename (no extension)'
+TFIELDLIST(IDX)%CUNITS = ''
+TFIELDLIST(IDX)%CDIR = ''
+TFIELDLIST(IDX)%CCOMMENT = ''
+TFIELDLIST(IDX)%NGRID = 0
+TFIELDLIST(IDX)%NTYPE = TYPECHAR
+TFIELDLIST(IDX)%NDIMS = 1
+IDX = IDX+1
+!
+TFIELDLIST(IDX)%CMNHNAME = 'DAD_NAME'
+TFIELDLIST(IDX)%CSTDNAME = ''
+TFIELDLIST(IDX)%CLONGNAME = 'MesoNH: filename of the dad file'
TFIELDLIST(IDX)%CUNITS = ''
TFIELDLIST(IDX)%CDIR = ''
TFIELDLIST(IDX)%CCOMMENT = ''
TFIELDLIST(IDX)%NGRID = 0
TFIELDLIST(IDX)%NTYPE = TYPECHAR
+TFIELDLIST(IDX)%NDIMS = 1
+IDX = IDX+1
+!
+TFIELDLIST(IDX)%CMNHNAME = 'DXRATIO'
+TFIELDLIST(IDX)%CSTDNAME = ''
+TFIELDLIST(IDX)%CLONGNAME = 'MesoNH: DXRATIO'
+TFIELDLIST(IDX)%CUNITS = ''
+TFIELDLIST(IDX)%CDIR = '--'
+TFIELDLIST(IDX)%CCOMMENT = 'Resolution ratio between this mesh and its father in x-direction'
+TFIELDLIST(IDX)%NGRID = 0
+TFIELDLIST(IDX)%NTYPE = TYPEINT
+TFIELDLIST(IDX)%NDIMS = 0
+IDX = IDX+1
+!
+TFIELDLIST(IDX)%CMNHNAME = 'DYRATIO'
+TFIELDLIST(IDX)%CSTDNAME = ''
+TFIELDLIST(IDX)%CLONGNAME = 'MesoNH: DYRATIO'
+TFIELDLIST(IDX)%CUNITS = ''
+TFIELDLIST(IDX)%CDIR = '--'
+TFIELDLIST(IDX)%CCOMMENT = 'Resolution ratio between this mesh and its father in y-direction'
+TFIELDLIST(IDX)%NGRID = 0
+TFIELDLIST(IDX)%NTYPE = TYPEINT
+TFIELDLIST(IDX)%NDIMS = 0
+IDX = IDX+1
+!
+TFIELDLIST(IDX)%CMNHNAME = 'XOR'
+TFIELDLIST(IDX)%CSTDNAME = ''
+TFIELDLIST(IDX)%CLONGNAME = 'MesoNH: XOR'
+TFIELDLIST(IDX)%CUNITS = ''
+TFIELDLIST(IDX)%CDIR = '--'
+TFIELDLIST(IDX)%CCOMMENT = 'Horizontal position of this mesh relative to its father'
+TFIELDLIST(IDX)%NGRID = 0
+TFIELDLIST(IDX)%NTYPE = TYPEINT
+TFIELDLIST(IDX)%NDIMS = 0
+IDX = IDX+1
+!
+TFIELDLIST(IDX)%CMNHNAME = 'YOR'
+TFIELDLIST(IDX)%CSTDNAME = ''
+TFIELDLIST(IDX)%CLONGNAME = 'MesoNH: YOR'
+TFIELDLIST(IDX)%CUNITS = ''
+TFIELDLIST(IDX)%CDIR = '--'
+TFIELDLIST(IDX)%CCOMMENT = 'Vertical position of this mesh relative to its father'
+TFIELDLIST(IDX)%NGRID = 0
+TFIELDLIST(IDX)%NTYPE = TYPEINT
TFIELDLIST(IDX)%NDIMS = 0
IDX = IDX+1
!
@@ -147,6 +213,18 @@ TFIELDLIST(IDX)%NDIMS = 3
ALLOCATE(TFIELDLIST(IDX)%TFIELD_X3D(IMODEL))
IDX = IDX+1
!
+TFIELDLIST(IDX)%CMNHNAME = 'WT'
+TFIELDLIST(IDX)%CSTDNAME = 'upward_air_velocity'
+TFIELDLIST(IDX)%CLONGNAME = ''
+TFIELDLIST(IDX)%CUNITS = 'm s-1'
+TFIELDLIST(IDX)%CDIR = 'XY'
+TFIELDLIST(IDX)%CCOMMENT = 'X_Y_Z_vertical wind (m/s)'
+TFIELDLIST(IDX)%NGRID = 4
+TFIELDLIST(IDX)%NTYPE = TYPEREAL
+TFIELDLIST(IDX)%NDIMS = 3
+ALLOCATE(TFIELDLIST(IDX)%TFIELD_X3D(IMODEL))
+IDX = IDX+1
+!
TFIELDLIST(IDX)%CMNHNAME = 'THT'
TFIELDLIST(IDX)%CSTDNAME = 'air_potential_temperature'
TFIELDLIST(IDX)%CLONGNAME = ''
@@ -172,6 +250,8 @@ TFIELDLIST(IDX)%NDIMS = 2
ALLOCATE(TFIELDLIST(IDX)%TFIELD_X2D(IMODEL))
IDX = IDX+1
!
+PRINT *,'INFO: INI_FIELD_LIST: number of used fields=',IDX-1,' out of ',MAXFIELDS
+!
#if 0
!
TFIELDLIST(IDX)%CMNHNAME = ''
@@ -211,6 +291,7 @@ KID = 0
KRESP = 0
!
DO JI = 1,MAXFIELDS
+ IF (TRIM(TFIELDLIST(JI)%CMNHNAME)=='') EXIT !Last entry
IF (TRIM(TFIELDLIST(JI)%CMNHNAME)==TRIM(HMNHNAME)) THEN
KID = JI
EXIT
@@ -232,9 +313,22 @@ USE MODD_PRECIP_n
!
INTEGER, INTENT(IN) :: KFROM, KTO
!
+!LOGICAL,SAVE :: GFIRST_CALL=.TRUE.
INTEGER :: IID,IRESP
!
+PRINT *,'PW: FIELDLIST_GOTO_MODEL: ',KFROM,'->',KTO
+!
+! IF (GFIRST_CALL) THEN
+! !This is necessary because the first time this subroutine is called
+! !the TFIELDLIST is not yet initialized.
+! !The use of this subroutine is not useful the first timebecause the
+! !data for the fields has not yet been allocated.
+! GFIRST_CALL = .FALSE.
+! RETURN
+! END IF
+!
IF (.NOT.LFIELDLIST_ISINIT) THEN
+ PRINT *,'WARNING: FIELDLIST_GOTO_MODEL: TFIELDLIST not yet initialized'
RETURN
END IF
!
@@ -244,6 +338,8 @@ CALL FIND_FIELD_ID_FROM_MNHNAME('UT',IID,IRESP)
TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>XUT
CALL FIND_FIELD_ID_FROM_MNHNAME('VT',IID,IRESP)
TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>XVT
+CALL FIND_FIELD_ID_FROM_MNHNAME('WT',IID,IRESP)
+TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>XWT
CALL FIND_FIELD_ID_FROM_MNHNAME('THT',IID,IRESP)
TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>XTHT
CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRR',IID,IRESP)
@@ -256,6 +352,8 @@ CALL FIND_FIELD_ID_FROM_MNHNAME('UT',IID,IRESP)
XUT=>TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
CALL FIND_FIELD_ID_FROM_MNHNAME('VT',IID,IRESP)
XVT=>TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('WT',IID,IRESP)
+XWT=>TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
CALL FIND_FIELD_ID_FROM_MNHNAME('THT',IID,IRESP)
XTHT=>TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRR',IID,IRESP)
diff --git a/src/MNH/modd_fieldn.f90 b/src/MNH/modd_fieldn.f90
index 9e2abed9e..4e15f456f 100644
--- a/src/MNH/modd_fieldn.f90
+++ b/src/MNH/modd_fieldn.f90
@@ -64,7 +64,6 @@ IMPLICIT NONE
TYPE FIELD_t
! REAL, DIMENSION(:,:,:), POINTER :: XUT=>NULL(),XVT=>NULL(),XWT=>NULL()
- REAL, DIMENSION(:,:,:), POINTER :: XWT=>NULL()
! U,V,W at time t
REAL, DIMENSION(:,:,:), POINTER :: XRUS=>NULL(),XRVS=>NULL(),XRWS=>NULL()
! Source of (rho U), (rho V), (rho w)
@@ -154,7 +153,7 @@ INTEGER :: IID,IRESP
! Save current state for allocated arrays
!FIELD_MODEL(KFROM)%XUT=>XUT !Done in FIELDLIST_GOTO_MODEL
!FIELD_MODEL(KFROM)%XVT=>XVT !Done in FIELDLIST_GOTO_MODEL
-FIELD_MODEL(KFROM)%XWT=>XWT
+!FIELD_MODEL(KFROM)%XWT=>XWT !Done in FIELDLIST_GOTO_MODEL
FIELD_MODEL(KFROM)%XRUS=>XRUS
FIELD_MODEL(KFROM)%XRVS=>XRVS
FIELD_MODEL(KFROM)%XRWS=>XRWS
@@ -189,7 +188,7 @@ FIELD_MODEL(KFROM)%XRCM=>XRCM
! Current model is set to model KTO
!XUT=>FIELD_MODEL(KTO)%XUT !Done in FIELDLIST_GOTO_MODEL
!XVT=>FIELD_MODEL(KTO)%XVT !Done in FIELDLIST_GOTO_MODEL
-XWT=>FIELD_MODEL(KTO)%XWT
+!XWT=>FIELD_MODEL(KTO)%XWT !Done in FIELDLIST_GOTO_MODEL
XRUS=>FIELD_MODEL(KTO)%XRUS
XRVS=>FIELD_MODEL(KTO)%XRVS
XRWS=>FIELD_MODEL(KTO)%XRWS
diff --git a/src/MNH/modd_spawn.f90 b/src/MNH/modd_spawn.f90
index 88fd2788a..4edb589ff 100644
--- a/src/MNH/modd_spawn.f90
+++ b/src/MNH/modd_spawn.f90
@@ -68,5 +68,6 @@ REAL,DIMENSION(:,:), SAVE,POINTER :: XACPRR1
REAL,DIMENSION(:,:,:),SAVE,POINTER :: XTHT1
REAL,DIMENSION(:,:,:),SAVE,POINTER :: XUT1
REAL,DIMENSION(:,:,:),SAVE,POINTER :: XVT1
+REAL,DIMENSION(:,:,:),SAVE,POINTER :: XWT1
!
END MODULE MODD_SPAWN
diff --git a/src/MNH/set_mask.f90 b/src/MNH/set_mask.f90
index 588000112..20c141265 100644
--- a/src/MNH/set_mask.f90
+++ b/src/MNH/set_mask.f90
@@ -64,6 +64,7 @@
!
USE MODD_BUDGET
USE MODE_ll
+USE MODE_FIELD, ONLY : TFIELDLIST, FIND_FIELD_ID_FROM_MNHNAME
USE MODD_FIELD_n, ONLY : FIELD_MODEL
!
!
@@ -76,7 +77,7 @@ INTEGER :: IIB,IJB ! Lower bounds of the physical
! sub-domain in x and y directions
INTEGER :: IIE,IJE ! Upper bounds of the physical
! sub-domain in x and y directions
-
+INTEGER :: IID, IRESP
!-------------------------------------------------------------------------------
!
!* 1. COMPUTES THE PHYSICAL SUBDOMAIN BOUNDS
@@ -94,7 +95,9 @@ LBU_MASK(:,:,:)=.FALSE.
! Change the following lines to set the criterion for each of the NBUMASK masks
!
! 1st mask on vertical velocity at level k=10
-LBU_MASK(IIB:IIE,IJB:IJE,1)=FIELD_MODEL(NBUMOD)%XWT(IIB:IIE,IJB:IJE,10)>0.
+!LBU_MASK(IIB:IIE,IJB:IJE,1)=FIELD_MODEL(NBUMOD)%XWT(IIB:IIE,IJB:IJE,10)>0.
+CALL FIND_FIELD_ID_FROM_MNHNAME('WT',IID,IRESP)
+LBU_MASK(IIB:IIE,IJB:IJE,1)=TFIELDLIST(IID)%TFIELD_X3D(NBUMOD)%DATA(IIB:IIE,IJB:IJE,10)>0.
!
!2rd mask on rain mixing ratio at level k=2
IF (NBUMASK>=2) &
diff --git a/src/MNH/spawn_field2.f90 b/src/MNH/spawn_field2.f90
index e2ab3cebc..3a54d23db 100644
--- a/src/MNH/spawn_field2.f90
+++ b/src/MNH/spawn_field2.f90
@@ -328,12 +328,12 @@ IF (KDXRATIO == 1 .AND. KDYRATIO == 1 ) THEN
!
PUT (:,:,:) = XUT1(KXOR:KXEND,KYOR:KYEND,:)
PVT (:,:,:) = XVT1(KXOR:KXEND,KYOR:KYEND,:)
- PWT (:,:,:) = FIELD_MODEL(1)%XWT (KXOR:KXEND,KYOR:KYEND,:)
+ PWT (:,:,:) = XWT1(KXOR:KXEND,KYOR:KYEND,:)
PTHVT(:,:,:) = ZTHVT(KXOR:KXEND,KYOR:KYEND,:)
!
- PLSUM (:,:,:) = PUT (:,:,:)
- PLSVM (:,:,:) = PVT (:,:,:)
- PLSWM (:,:,:) = FIELD_MODEL(1)%XWT (KXOR:KXEND,KYOR:KYEND,:)
+ PLSUM (:,:,:) = PUT(:,:,:)
+ PLSVM (:,:,:) = PVT(:,:,:)
+ PLSWM (:,:,:) = PWT(:,:,:)
PLSTHM(:,:,:) = XTHT1(KXOR:KXEND,KYOR:KYEND,:)
!
PLSRVM(:,:,:) = 0.
@@ -476,7 +476,7 @@ ELSE
CALL SET_LSFIELD_1WAY_ll(XVT1(:,:,JI),ZVT_C(:,:,JI),2)
CALL SET_LSFIELD_1WAY_ll(LSFIELD_MODEL(1)%XLSVM(:,:,JI),ZLSVM_C(:,:,JI),2)
!
- CALL SET_LSFIELD_1WAY_ll(FIELD_MODEL(1)%XWT(:,:,JI),ZWT_C(:,:,JI),2)
+ CALL SET_LSFIELD_1WAY_ll(XWT1(:,:,JI),ZWT_C(:,:,JI),2)
CALL SET_LSFIELD_1WAY_ll(LSFIELD_MODEL(1)%XLSWM(:,:,JI),ZLSWM_C(:,:,JI),2)
!
CALL SET_LSFIELD_1WAY_ll(ZTHVT(:,:,JI), ZTHVT_C(:,:,JI),2)
diff --git a/src/MNH/spawning.f90 b/src/MNH/spawning.f90
index ef0371222..f24887195 100644
--- a/src/MNH/spawning.f90
+++ b/src/MNH/spawning.f90
@@ -267,6 +267,7 @@ XACPRR1 => XACPRR
XTHT1 => XTHT
XUT1 => XUT
XVT1 => XVT
+XWT1 => XWT
!
END SUBROUTINE SET_POINTERS_TO_MODEL1
!
diff --git a/src/MNH/write_lfin.f90 b/src/MNH/write_lfin.f90
index 7f3dddc99..4d95b32e3 100644
--- a/src/MNH/write_lfin.f90
+++ b/src/MNH/write_lfin.f90
@@ -348,35 +348,25 @@ IKE=IKU-JPVEXT
!
!* 1.0 YFMFILE and HDADFILE writing :
!
-YDIR='--'
-!
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)
-!
-YRECFM='MY_NAME'
-YCOMMENT=' '
-IGRID=0
-ILENCH=LEN(YCOMMENT)
-CALL FMWRIT(YFMFILE,YRECFM,CLUOUT,YDIR,YFMFILE,IGRID,ILENCH,YCOMMENT,IRESP)
-!
-YRECFM='DAD_NAME'
-YCOMMENT=' '
-IGRID=0
-ILENCH=LEN(YCOMMENT)
-CALL FMWRIT(YFMFILE,YRECFM,CLUOUT,YDIR,HDADFILE,IGRID,ILENCH,YCOMMENT,IRESP)
+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 FMWRIT(YFMFILE,'DXRATIO',CLUOUT,YDIR,NDXRATIO_ALL(IMI),0,ILENCH,YCOMMENT,IRESP)
- CALL FMWRIT(YFMFILE,'DYRATIO',CLUOUT,YDIR,NDYRATIO_ALL(IMI),0,ILENCH,YCOMMENT,IRESP)
- CALL FMWRIT(YFMFILE,'XOR' ,CLUOUT,YDIR,NXOR_ALL(IMI) ,0,ILENCH,YCOMMENT,IRESP)
- CALL FMWRIT(YFMFILE,'YOR' ,CLUOUT,YDIR,NYOR_ALL(IMI) ,0,ILENCH,YCOMMENT,IRESP)
+ CALL IO_WRITE_FIELD(TPFILE,'DXRATIO',CLUOUT,IRESP,NDXRATIO_ALL(IMI))
+ CALL IO_WRITE_FIELD(TPFILE,'DYRATIO',CLUOUT,IRESP,NDYRATIO_ALL(IMI))
+ CALL IO_WRITE_FIELD(TPFILE,'XOR', CLUOUT,IRESP,NXOR_ALL(IMI))
+ CALL IO_WRITE_FIELD(TPFILE,'YOR', CLUOUT,IRESP,NYOR_ALL(IMI))
END IF
!
!* 1.1 Type and Dimensions :
!
+YDIR='--'
+!
YRECFM='STORAGE_TYPE'
YCOMMENT=' '
IGRID=0
@@ -641,12 +631,7 @@ CALL MPPDB_CHECK3D(XUT,"write_lfifmn after IO_WRITE_FIELD::XUT",PRECISION)
CALL MPPDB_CHECK3D(XVT,"write_lfifmn::XVT",PRECISION)
!
CALL IO_WRITE_FIELD(TPFILE,'VT',CLUOUT,IRESP,XVT)
-!
-YRECFM='WT'
-YCOMMENT='X_Y_Z_vertical wind (m/s)'
-IGRID=4
-ILENCH=LEN(YCOMMENT)
-CALL FMWRIT(YFMFILE,YRECFM,CLUOUT,YDIR,XWT,IGRID,ILENCH,YCOMMENT,IRESP)
+CALL IO_WRITE_FIELD(TPFILE,'WT',CLUOUT,IRESP,XWT)
!
CALL IO_WRITE_FIELD(TPFILE,'THT',CLUOUT,IRESP,XTHT)
!
--
GitLab