From 0e20cfe5462659ce5659d6527fe4637b6bc31187 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Mon, 12 Dec 2016 09:49:47 +0100
Subject: [PATCH] Philippe 12/12/2016: added FIELDLIST_GOTO_MODEL subroutine
---
src/LIB/SURCOUCHE/src/mode_field.f90 | 39 ++++++++++++++++++++++++++++
src/MNH/goto_model_wrapper.f90 | 5 +++-
src/MNH/ini_micron.f90 | 4 ---
src/MNH/ini_modeln.f90 | 8 ------
src/MNH/init_mnh.f90 | 2 ++
src/MNH/modd_fieldn.f90 | 34 +++++-------------------
src/MNH/modd_precipn.f90 | 14 ++--------
7 files changed, 53 insertions(+), 53 deletions(-)
diff --git a/src/LIB/SURCOUCHE/src/mode_field.f90 b/src/LIB/SURCOUCHE/src/mode_field.f90
index 525569ab6..057e6d4b4 100644
--- a/src/LIB/SURCOUCHE/src/mode_field.f90
+++ b/src/LIB/SURCOUCHE/src/mode_field.f90
@@ -225,4 +225,43 @@ END IF
!
END SUBROUTINE FIND_FIELD_ID_FROM_MNHNAME
!
+SUBROUTINE FIELDLIST_GOTO_MODEL(KFROM, KTO)
+!
+USE MODD_FIELD_n
+USE MODD_PRECIP_n
+!
+INTEGER, INTENT(IN) :: KFROM, KTO
+!
+INTEGER :: IID,IRESP
+!
+IF (.NOT.LFIELDLIST_ISINIT) THEN
+ RETURN
+END IF
+!
+! Save current state for allocated arrays
+!
+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('THT',IID,IRESP)
+TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>XTHT
+CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRR',IID,IRESP)
+TFIELDLIST(IID)%TFIELD_X2D(KFROM)%DATA=>XACPRR
+!
+! Current model is set to model KTO
+!
+IF( KFROM/=KTO) THEN
+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('THT',IID,IRESP)
+XTHT=>TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRR',IID,IRESP)
+XACPRR=>TFIELDLIST(IID)%TFIELD_X2D(KTO)%DATA
+END IF
+!
+END SUBROUTINE FIELDLIST_GOTO_MODEL
+!
END MODULE MODE_FIELD
diff --git a/src/MNH/goto_model_wrapper.f90 b/src/MNH/goto_model_wrapper.f90
index bf39783db..0199b28e5 100644
--- a/src/MNH/goto_model_wrapper.f90
+++ b/src/MNH/goto_model_wrapper.f90
@@ -113,6 +113,7 @@ USE MODD_ADVFRC_n
!
USE MODD_CH_PRODLOSSTOT_n
USE MODD_CH_BUDGET_n
+USE MODE_FIELD
!
IMPLICIT NONE
INTEGER,INTENT(IN) :: KFROM, KTO
@@ -201,5 +202,7 @@ CALL ADVFRC_GOTO_MODEL(KFROM, KTO)
CALL RELFRC_GOTO_MODEL(KFROM, KTO)
CALL CH_PRODLOSSTOT_GOTO_MODEL(KFROM,KTO)
CALL CH_BUDGET_GOTO_MODEL(KFROM,KTO)
-
+!
+CALL FIELDLIST_GOTO_MODEL(KFROM, KTO)
+!
END SUBROUTINE GOTO_MODEL_WRAPPER
diff --git a/src/MNH/ini_micron.f90 b/src/MNH/ini_micron.f90
index cac673733..17154b38c 100644
--- a/src/MNH/ini_micron.f90
+++ b/src/MNH/ini_micron.f90
@@ -106,7 +106,6 @@ USE MODD_LIMA_PRECIP_SCAVENGING_n
USE MODI_INIT_AEROSOL_CONCENTRATION
USE MODI_INI_LIMA
USE MODI_SET_CONC_LIMA
-USE MODE_FIELD
!
IMPLICIT NONE
!
@@ -129,7 +128,6 @@ INTEGER :: IKB,IKE
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDZ ! mesh size
REAL :: ZDZMIN
INTEGER :: IMI
-INTEGER :: IID,IRESP
!
!-------------------------------------------------------------------------------
!
@@ -316,7 +314,5 @@ IMI = GET_CURRENT_MODEL_INDEX()
! XDXX,XDYY,XDZZ,XDZX,XDZY )
!END IF
!
-CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRR',IID,IRESP)
-TFIELDLIST(IID)%TFIELD_X2D(IMI)%DATA=>XACPRR
!
END SUBROUTINE INI_MICRO_n
diff --git a/src/MNH/ini_modeln.f90 b/src/MNH/ini_modeln.f90
index 9c74e2a99..deb55ee7d 100644
--- a/src/MNH/ini_modeln.f90
+++ b/src/MNH/ini_modeln.f90
@@ -421,7 +421,6 @@ USE MODI_CH_INIT_PRODLOSSTOT_n
USE MODD_CH_BUDGET_n
USE MODI_CH_INIT_BUDGET_n
USE MODD_CH_M9_n, ONLY:NNONZEROTERMS
-USE MODE_FIELD
!
USE MODE_MPPDB
USE MODI_INIT_AEROSOL_PROPERTIES
@@ -516,7 +515,6 @@ REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSTH
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS,DPTR_XLSTHS,DPTR_XLSRVS
!
INTEGER :: IIB,IJB,IIE,IJE,IDIMX,IDIMY,IMI
-INTEGER :: IID
!
!-------------------------------------------------------------------------------
!
@@ -725,15 +723,9 @@ IF ((CUVW_ADV_SCHEME(1:3)=='CEN') .AND. (CTEMP_SCHEME == 'LEFR') ) THEN
END IF
!
ALLOCATE(XUT(IIU,IJU,IKU)) ; XUT = 0.0
-CALL FIND_FIELD_ID_FROM_MNHNAME('UT',IID,IRESP)
-TFIELDLIST(IID)%TFIELD_X3D(KMI)%DATA=>XUT
ALLOCATE(XVT(IIU,IJU,IKU)) ; XVT = 0.0
-CALL FIND_FIELD_ID_FROM_MNHNAME('VT',IID,IRESP)
-TFIELDLIST(IID)%TFIELD_X3D(KMI)%DATA=>XVT
ALLOCATE(XWT(IIU,IJU,IKU)) ; XWT = 0.0
ALLOCATE(XTHT(IIU,IJU,IKU)) ; XTHT = 0.0
-CALL FIND_FIELD_ID_FROM_MNHNAME('THT',IID,IRESP)
-TFIELDLIST(IID)%TFIELD_X3D(KMI)%DATA=>XTHT
ALLOCATE(XRUS(IIU,IJU,IKU)) ; XRUS = 0.0
ALLOCATE(XRVS(IIU,IJU,IKU)) ; XRVS = 0.0
ALLOCATE(XRWS(IIU,IJU,IKU)) ; XRWS = 0.0
diff --git a/src/MNH/init_mnh.f90 b/src/MNH/init_mnh.f90
index d3f36461c..9405e8e55 100644
--- a/src/MNH/init_mnh.f90
+++ b/src/MNH/init_mnh.f90
@@ -232,6 +232,8 @@ DO JMI=1,NMODEL
CALL GOTO_MODEL(JMI)
IF (CPROGRAM/='SPEC ') THEN
CALL INI_MODEL_n(JMI,YLUOUT(JMI),YINIFILE(JMI),YINIFILEPGD(JMI))
+ !Call necessary to update the TFIELDLIST pointers to the data
+ CALL FIELDLIST_GOTO_MODEL(JMI,JMI)
ELSE
CALL INI_SPECTRE_n(JMI,YLUOUT(JMI),YINIFILE(JMI))
END IF
diff --git a/src/MNH/modd_fieldn.f90 b/src/MNH/modd_fieldn.f90
index 3c21b1d8e..9e2abed9e 100644
--- a/src/MNH/modd_fieldn.f90
+++ b/src/MNH/modd_fieldn.f90
@@ -147,21 +147,13 @@ CONTAINS
SUBROUTINE FIELD_GOTO_MODEL(KFROM, KTO)
!
-USE MODE_FIELD
-!
INTEGER, INTENT(IN) :: KFROM, KTO
!
INTEGER :: IID,IRESP
!
! Save current state for allocated arrays
-!FIELD_MODEL(KFROM)%XUT=>XUT
-!FIELD_MODEL(KFROM)%XVT=>XVT
-IF( KFROM/=1 .AND. KTO/=1) THEN
-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
-END IF
+!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)%XRUS=>XRUS
FIELD_MODEL(KFROM)%XRVS=>XRVS
@@ -169,11 +161,7 @@ FIELD_MODEL(KFROM)%XRWS=>XRWS
FIELD_MODEL(KFROM)%XRUS_PRES=>XRUS_PRES
FIELD_MODEL(KFROM)%XRVS_PRES=>XRVS_PRES
FIELD_MODEL(KFROM)%XRWS_PRES=>XRWS_PRES
-!FIELD_MODEL(KFROM)%XTHT=>XTHT
-IF( KFROM/=1 .AND. KTO/=1) THEN
-CALL FIND_FIELD_ID_FROM_MNHNAME('THT',IID,IRESP)
-TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>XTHT
-END IF
+!FIELD_MODEL(KFROM)%XTHT=>XTHT !Done in FIELDLIST_GOTO_MODEL
FIELD_MODEL(KFROM)%XRTHS=>XRTHS
FIELD_MODEL(KFROM)%XRTHS_CLD=>XRTHS_CLD
FIELD_MODEL(KFROM)%XSUPSAT=>XSUPSAT
@@ -199,14 +187,8 @@ FIELD_MODEL(KFROM)%XPABSM=>XPABSM
FIELD_MODEL(KFROM)%XRCM=>XRCM
!
! Current model is set to model KTO
-!XUT=>FIELD_MODEL(KTO)%XUT
-!XVT=>FIELD_MODEL(KTO)%XVT
-IF( KFROM/=1 .AND. KTO/=1) THEN
-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
-END IF
+!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
XRUS=>FIELD_MODEL(KTO)%XRUS
XRVS=>FIELD_MODEL(KTO)%XRVS
@@ -214,11 +196,7 @@ XRWS=>FIELD_MODEL(KTO)%XRWS
XRUS_PRES=>FIELD_MODEL(KTO)%XRUS_PRES
XRVS_PRES=>FIELD_MODEL(KTO)%XRVS_PRES
XRWS_PRES=>FIELD_MODEL(KTO)%XRWS_PRES
-!XTHT=>FIELD_MODEL(KTO)%XTHT
-IF( KFROM/=1 .AND. KTO/=1) THEN
-CALL FIND_FIELD_ID_FROM_MNHNAME('THT',IID,IRESP)
-XTHT=>TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
-END IF
+!XTHT=>FIELD_MODEL(KTO)%XTHT !Done in FIELDLIST_GOTO_MODEL
XRTHS=>FIELD_MODEL(KTO)%XRTHS
XRTHS_CLD=>FIELD_MODEL(KTO)%XRTHS_CLD
XSUPSAT=>FIELD_MODEL(KTO)%XSUPSAT
diff --git a/src/MNH/modd_precipn.f90 b/src/MNH/modd_precipn.f90
index 5413147dd..13572802d 100644
--- a/src/MNH/modd_precipn.f90
+++ b/src/MNH/modd_precipn.f90
@@ -75,8 +75,6 @@ CONTAINS
SUBROUTINE PRECIP_GOTO_MODEL(KFROM, KTO)
!
-USE MODE_FIELD
-!
INTEGER, INTENT(IN) :: KFROM, KTO
!
INTEGER :: IID,IRESP
@@ -89,11 +87,7 @@ PRECIP_MODEL(KFROM)%XACDEP=>XACDEP
PRECIP_MODEL(KFROM)%XINPRR=>XINPRR
PRECIP_MODEL(KFROM)%XINPRR3D=>XINPRR3D
PRECIP_MODEL(KFROM)%XEVAP3D=>XEVAP3D
-!PRECIP_MODEL(KFROM)%XACPRR=>XACPRR
-IF( KFROM/=1 .AND. KTO/=1) THEN
-CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRR',IID,IRESP)
-TFIELDLIST(IID)%TFIELD_X2D(KFROM)%DATA=>XACPRR
-END IF
+!PRECIP_MODEL(KFROM)%XACPRR=>XACPRR !Done in FIELDLIST_GOTO_MODEL
PRECIP_MODEL(KFROM)%XINPRS=>XINPRS
PRECIP_MODEL(KFROM)%XACPRS=>XACPRS
PRECIP_MODEL(KFROM)%XINPRG=>XINPRG
@@ -109,11 +103,7 @@ XACDEP=>PRECIP_MODEL(KTO)%XACDEP
XINPRR=>PRECIP_MODEL(KTO)%XINPRR
XINPRR3D=>PRECIP_MODEL(KTO)%XINPRR3D
XEVAP3D=>PRECIP_MODEL(KTO)%XEVAP3D
-!XACPRR=>PRECIP_MODEL(KTO)%XACPRR
-IF( KFROM/=1 .AND. KTO/=1) THEN
-CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRR',IID,IRESP)
-XACPRR=>TFIELDLIST(IID)%TFIELD_X2D(KTO)%DATA
-END IF
+!XACPRR=>PRECIP_MODEL(KTO)%XACPRR !Done in FIELDLIST_GOTO_MODEL
XINPRS=>PRECIP_MODEL(KTO)%XINPRS
XACPRS=>PRECIP_MODEL(KTO)%XACPRS
XINPRG=>PRECIP_MODEL(KTO)%XINPRG
--
GitLab