From 7147a17f3fb8efef1c09071db48ece1b97237f93 Mon Sep 17 00:00:00 2001
From: Gaelle DELAUTIER <gaelle.delautier@meteo.fr>
Date: Tue, 19 Sep 2017 10:20:20 +0200
Subject: [PATCH] Q.Rodier 19/09/2017 : add LTEND_UV_FRC
---
src/MNH/default_desfmn.f90 | 2 +
src/MNH/forcing.f90 | 102 +++++++++++++++++++++++++++++--------
src/MNH/ini_modeln.f90 | 6 +++
src/MNH/modd_frc.f90 | 4 ++
src/MNH/modeln.f90 | 13 ++++-
src/MNH/modn_frc.f90 | 2 +
src/MNH/read_field.f90 | 14 +++++
src/MNH/set_frc.f90 | 32 +++++++++++-
8 files changed, 151 insertions(+), 24 deletions(-)
diff --git a/src/MNH/default_desfmn.f90 b/src/MNH/default_desfmn.f90
index e687622a5..925eb22fc 100644
--- a/src/MNH/default_desfmn.f90
+++ b/src/MNH/default_desfmn.f90
@@ -220,6 +220,7 @@ END MODULE MODI_DEFAULT_DESFM_n
!! 10/2016 (R.Honnert and S.Riette) : Improvement of EDKF and adaptation to the grey zone
!! 10/2016 (F Brosse) add prod/loss terms computation for chemistry
!! 07/2017 (V. Masson) adds time step for output files writing.
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -979,6 +980,7 @@ IF (KMI == 1) THEN
LGEOST_UV_FRC = .FALSE.
LGEOST_TH_FRC = .FALSE.
LTEND_THRV_FRC = .FALSE.
+ LTEND_UV_FRC = .FALSE.
LVERT_MOTION_FRC = .FALSE.
LRELAX_THRV_FRC = .FALSE.
LRELAX_UV_FRC = .FALSE.
diff --git a/src/MNH/forcing.f90 b/src/MNH/forcing.f90
index 3aac75017..165bb966e 100644
--- a/src/MNH/forcing.f90
+++ b/src/MNH/forcing.f90
@@ -19,7 +19,7 @@ INTERFACE
PUFRC_PAST, PVFRC_PAST, &
PUT, PVT, PWT, PTHT, PTKET, PRT, PSVT, &
PRUS, PRVS, PRWS, PRTHS, PRTKES, PRRS, PRSVS, &
- KMI)
+ KMI,PJ)
!
USE MODD_TIME, ONLY: DATE_TIME
!
@@ -46,6 +46,8 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS ! moist variables at time t+1
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS! scalar variables at time t+1
!
INTEGER, INTENT(IN) :: KMI ! Model index
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PJ
+
!
END SUBROUTINE FORCING
!
@@ -59,7 +61,7 @@ END MODULE MODI_FORCING
PUFRC_PAST, PVFRC_PAST, &
PUT, PVT, PWT, PTHT, PTKET, PRT, PSVT, &
PRUS, PRVS, PRWS, PRTHS, PRTKES, PRRS, PRSVS, &
- KMI)
+ KMI,PJ)
! ######################################################################
!
!!*** *FORCING* - routine to compute the forced terms
@@ -145,6 +147,7 @@ END MODULE MODI_FORCING
!! forcing
!! 06/2012 V. Masson Adds tendency of geostrophic wind itself to wind tendency
!! 01/2014 J. escobar correction for // initialisation geostrophic ZUF,ZVF,ZWF
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -160,6 +163,7 @@ USE MODD_LUNIT
USE MODD_PARAMETERS
USE MODD_TIME
USE MODD_BUDGET
+USE MODD_CST
!
USE MODI_SHUMAN
USE MODI_UPSTREAM_Z
@@ -196,6 +200,7 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS ! moist variables at time t+1
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS! scalar variables at time t+1
!
INTEGER, INTENT(IN) :: KMI ! Model index
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PJ
!
!* 0.2 Declarations of local variables
!
@@ -207,6 +212,7 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWF, ZUF, ZVF ! 3D forcing fields on
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHF, ZRVF ! the model grid mesh
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZGXTHF, ZGYTHF ! at
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTENDTHF, ZTENDRVF ! time t
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTENDVF, ZTENDUF
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDUF, ZDVF ! evolution of geostrophic wind
! ! during the time step
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCOEF ! coefficient to take into
@@ -223,7 +229,9 @@ REAL, DIMENSION(SIZE(PUT,3)) :: ZXWFRC, ZXUFRC, ZXVFRC! 1D forcing fields
REAL, DIMENSION(SIZE(PUT,3)) :: ZXTHFRC, ZXRVFRC ! after
REAL, DIMENSION(SIZE(PUT,3)) :: ZXGXTHFRC, ZXGYTHFRC ! time
REAL, DIMENSION(SIZE(PUT,3)) :: ZXTENDTHFRC, ZXTENDRVFRC ! interpolation
+REAL, DIMENSION(SIZE(PUT,3)) :: ZXTENDUFRC, ZXTENDVFRC
REAL :: ZXPGROUNDFRC ! ground fields interpol.
+REAL,DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZOMEGA ! vertical velocity forcing (Pa/s)
!
LOGICAL, SAVE :: GSFIRSTCALL = .TRUE. ! control switch for the first call
!
@@ -350,6 +358,20 @@ IF (GSFIRSTCALL) THEN
WRITE(UNIT=ILUOUT0,FMT='(I10,99(/8E10.3))') &
JK, (XTENDRVFRC(JK,JL), JL=1, NFRC)
END DO
+!
+ WRITE(UNIT=ILUOUT0,FMT='(A)') &
+ "XTENDUFRC : wind advection tendency in X"
+ DO JK = 1, IKU
+ WRITE(UNIT=ILUOUT0,FMT='(I10,99(/8E10.3))') &
+ JK, (XTENDUFRC(JK,JL), JL=1, NFRC)
+ END DO
+!
+ WRITE(UNIT=ILUOUT0,FMT='(A)') &
+ "XTENDVFRC : wind advection tendency in Y"
+ DO JK = 1, IKU
+ WRITE(UNIT=ILUOUT0,FMT='(I10,99(/8E10.3))') &
+ JK, (XTENDVFRC(JK,JL), JL=1, NFRC)
+ END DO
!
WRITE(UNIT=ILUOUT0,FMT='(A)') &
"XPGROUNDFRC: SURF PRESSURE FORCING"
@@ -373,6 +395,8 @@ IF( TEMPORAL_LT ( TPDTCUR, TDTFRC(1) ) ) THEN
ZXTENDRVFRC(:) = XTENDRVFRC(:,1)
ZXGXTHFRC(:) = XGXTHFRC(:,1)
ZXGYTHFRC(:) = XGYTHFRC(:,1)
+ ZXTENDUFRC(:) = XTENDUFRC(:,1)
+ ZXTENDVFRC(:) = XTENDVFRC(:,1)
ZXPGROUNDFRC = XPGROUNDFRC(1)
ELSE IF ( .NOT. TEMPORAL_LT ( TPDTCUR, TDTFRC(NFRC) ) ) THEN
ZXUFRC(:) = XUFRC(:,NFRC)
@@ -384,6 +408,8 @@ ELSE IF ( .NOT. TEMPORAL_LT ( TPDTCUR, TDTFRC(NFRC) ) ) THEN
ZXTENDRVFRC(:) = XTENDRVFRC(:,NFRC)
ZXGXTHFRC(:) = XGXTHFRC(:,NFRC)
ZXGYTHFRC(:) = XGYTHFRC(:,NFRC)
+ ZXTENDUFRC(:) = XTENDUFRC(:,NFRC)
+ ZXTENDVFRC(:) = XTENDVFRC(:,NFRC)
ZXPGROUNDFRC = XPGROUNDFRC(NFRC)
ELSE
JXP = JSX + 1
@@ -415,6 +441,8 @@ ELSE
ZXRVFRC(:) = XRVFRC(:,JSX) +(XRVFRC(:,JXP)-XRVFRC(:,JSX))*ZALPHA
ZXTENDTHFRC(:) = XTENDTHFRC(:,JSX)+(XTENDTHFRC(:,JXP)-XTENDTHFRC(:,JSX))*ZALPHA
ZXTENDRVFRC(:) = XTENDRVFRC(:,JSX)+(XTENDRVFRC(:,JXP)-XTENDRVFRC(:,JSX))*ZALPHA
+ ZXTENDUFRC(:) = XTENDUFRC(:,JSX)+(XTENDUFRC(:,JXP)-XTENDUFRC(:,JSX))*ZALPHA
+ ZXTENDVFRC(:) = XTENDVFRC(:,JSX)+(XTENDVFRC(:,JXP)-XTENDVFRC(:,JSX))*ZALPHA
ZXGXTHFRC(:) = XGXTHFRC(:,JSX)+(XGXTHFRC(:,JXP)-XGXTHFRC(:,JSX))*ZALPHA
ZXGYTHFRC(:) = XGYTHFRC(:,JSX)+(XGYTHFRC(:,JXP)-XGYTHFRC(:,JSX))*ZALPHA
ZXPGROUNDFRC = XPGROUNDFRC(JSX) +(XPGROUNDFRC(JXP)-XPGROUNDFRC(JSX))*ZALPHA
@@ -436,6 +464,8 @@ ALLOCATE(ZTENDTHF(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
ALLOCATE(ZTENDRVF(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
ALLOCATE(ZDUF(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)))
ALLOCATE(ZDVF(SIZE(PVT,1),SIZE(PVT,2),SIZE(PVT,3)))
+ALLOCATE(ZTENDUF(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)))
+ALLOCATE(ZTENDVF(SIZE(PVT,1),SIZE(PVT,2),SIZE(PVT,3)))
!
IF (LFLAT) THEN
!
@@ -448,6 +478,8 @@ IF (LFLAT) THEN
ZRVF(:,:,:) = SPREAD( SPREAD( ZXRVFRC(:),1,IIU ) ,2,IJU )
ZTENDTHF(:,:,:) = SPREAD( SPREAD( ZXTENDTHFRC(:),1,IIU ),2,IJU )
ZTENDRVF(:,:,:) = SPREAD( SPREAD( ZXTENDRVFRC(:),1,IIU ),2,IJU )
+ ZTENDUF(:,:,:) = SPREAD( SPREAD( ZXTENDUFRC(:),1,IIU ),2,IJU )
+ ZTENDVF(:,:,:) = SPREAD( SPREAD( ZXTENDVFRC(:),1,IIU ),2,IJU )
ZGXTHF(:,:,:) = SPREAD( SPREAD( ZXGXTHFRC(:),1,IIU ),2,IJU )
ZGYTHF(:,:,:) = SPREAD( SPREAD( ZXGYTHFRC(:),1,IIU ),2,IJU )
ELSE
@@ -542,6 +574,8 @@ ELSE
ZGYTHF(JI,JJ,JK) = ZXGYTHFRC(JL+1)*ZDZ + ZXGYTHFRC(JL)*(1-ZDZ)
ZTENDTHF(JI,JJ,JK) = ZXTENDTHFRC(JL+1)*ZDZ + ZXTENDTHFRC(JL)*(1-ZDZ)
ZTENDRVF(JI,JJ,JK) = ZXTENDRVFRC(JL+1)*ZDZ + ZXTENDRVFRC(JL)*(1-ZDZ)
+ ZTENDUF(JI,JJ,JK) = ZXTENDUFRC(JL+1)*ZDZ + ZXTENDUFRC(JL)*(1-ZDZ)
+ ZTENDVF(JI,JJ,JK) = ZXTENDVFRC(JL+1)*ZDZ + ZXTENDVFRC(JL)*(1-ZDZ)
ELSE IF( ZZF(JI,JJ,JK) > PZHAT(IKU) ) THEN
ZDZ = (ZZF(JI,JJ,JK)-PZHAT(IKU)) * ZDZHAT_INV_IKU
ZTHF(JI,JJ,JK) = ZXTHFRC(IKU)*ZDZ + ZXTHFRC(IKU-1)*(1-ZDZ)
@@ -550,6 +584,8 @@ ELSE
ZGYTHF(JI,JJ,JK) = ZXGYTHFRC(IKU)*ZDZ + ZXGYTHFRC(IKU-1)*(1-ZDZ)
ZTENDTHF(JI,JJ,JK) = ZXTENDTHFRC(IKU)*ZDZ + ZXTENDTHFRC(IKU-1)*(1-ZDZ)
ZTENDRVF(JI,JJ,JK) = ZXTENDRVFRC(IKU)*ZDZ + ZXTENDRVFRC(IKU-1)*(1-ZDZ)
+ ZTENDUF(JI,JJ,JK) = ZXTENDUFRC(IKU)*ZDZ + ZXTENDUFRC(IKU-1)*(1-ZDZ)
+ ZTENDVF(JI,JJ,JK) = ZXTENDVFRC(IKU)*ZDZ + ZXTENDVFRC(IKU-1)*(1-ZDZ)
END IF
END DO
END DO
@@ -557,6 +593,15 @@ ELSE
END DO
END IF
!
+!!============================
+!!
+!! Ligne to add if you want W in Pa/s in namelist instead of m/s (omega = - w/(rho*g))
+!!
+!ZWF(:,:,:) = - ZWF(:,:,:)/(XG*MZM(1,IKU,1,(PRHODJ(:,:,:)/PJ(:,:,:))))
+!
+!!============================
+!
+!
!
! under the ground, forcings do not exist.
!
@@ -570,6 +615,8 @@ DO JK=1,JPVEXT
ZGYTHF(:,:,JK) = 0.
ZTENDTHF(:,:,JK) = 0.
ZTENDRVF(:,:,JK) = 0.
+ ZTENDUF(:,:,JK) = 0.
+ ZTENDVF(:,:,JK) = 0.
END DO
!
! store large scale w in module to be used later
@@ -658,6 +705,13 @@ IF ( LTEND_THRV_FRC ) THEN
END IF
END IF
!
+!* 4.2.1 integration of the tendency forcing for uv
+!
+IF ( LTEND_UV_FRC ) THEN
+ PRUS(:,:,:) = PRUS(:,:,:) + MXM(PRHODJ) * ZTENDUF(:,:,:)
+ PRVS(:,:,:) = PRVS(:,:,:) + MYM(PRHODJ) * ZTENDVF(:,:,:)
+END IF
+!
!* 4.3 integration of the thermal and geostrophic wind
!
IF( LCORIO ) THEN
@@ -681,27 +735,29 @@ IF( LCORIO ) THEN
! adds tendency of geostrophic wind to force wind in the free troposphere to
! follow the geostrophic wind when the latter changes.
! When winds differs from the geotrophic wind, the impact of this tendency is reduced.
- ALLOCATE(ZCOEF(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)))
- ZCOEF(:,:,:) = (MXF(PUT **2)+MYF(PVT **2)) &
- /MAX(MXF(PUFRC_PAST**2)+MYF(PVFRC_PAST**2), 1.E-3)
- !
- ZCOEF(:,:,:) = MIN(1.,SQRT(ZCOEF))
- !
- ZDUT(:,:,:) = ZDUF(:,:,:) * MXM(ZCOEF)
- ZDVT(:,:,:) = ZDVF(:,:,:) * MYM(ZCOEF)
- !
- PRUS(:,:,:) = PRUS(:,:,:) + ZDUT(:,:,:) * MXM(PRHODJ) / PTSTEP
+ IF ( .NOT. LTEND_UV_FRC ) THEN
+ ALLOCATE(ZCOEF(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)))
+ ZCOEF(:,:,:) = (MXF(PUT **2)+MYF(PVT **2)) &
+ /MAX(MXF(PUFRC_PAST**2)+MYF(PVFRC_PAST**2), 1.E-3)
+ !
+ ZCOEF(:,:,:) = MIN(1.,SQRT(ZCOEF))
+ !
+ ZDUT(:,:,:) = ZDUF(:,:,:) * MXM(ZCOEF)
+ ZDVT(:,:,:) = ZDVF(:,:,:) * MYM(ZCOEF)
+ !
+ PRUS(:,:,:) = PRUS(:,:,:) + ZDUT(:,:,:) * MXM(PRHODJ) / PTSTEP
+ !
+ PRVS(:,:,:) = PRVS(:,:,:) + ZDVT(:,:,:) * MYM(PRHODJ) / PTSTEP
+ !
+ !
+ ! Takes into acount the Coriolis force due to this evolution
+ PRUS(:,:,:) = PRUS(:,:,:) &
+ + MXM( MYF(ZDVT(:,:,:))*PRHODJ(:,:,:)*SPREAD(PCORIOZ(:,:),3,IKU))
+ PRVS(:,:,:) = PRVS(:,:,:) &
+ - MYM( MXF(ZDUT(:,:,:))*PRHODJ(:,:,:)*SPREAD(PCORIOZ(:,:),3,IKU))
!
- PRVS(:,:,:) = PRVS(:,:,:) + ZDVT(:,:,:) * MYM(PRHODJ) / PTSTEP
- !
- !
- ! Takes into acount the Coriolis force due to this evolution
- PRUS(:,:,:) = PRUS(:,:,:) &
- + MXM( MYF(ZDVT(:,:,:))*PRHODJ(:,:,:)*SPREAD(PCORIOZ(:,:),3,IKU))
- PRVS(:,:,:) = PRVS(:,:,:) &
- - MYM( MXF(ZDUT(:,:,:))*PRHODJ(:,:,:)*SPREAD(PCORIOZ(:,:),3,IKU))
- !
- DEALLOCATE(ZCOEF)
+ DEALLOCATE(ZCOEF)
+ END IF
END IF
!
END IF
@@ -818,6 +874,8 @@ DEALLOCATE(ZGXTHF)
DEALLOCATE(ZGYTHF)
DEALLOCATE(ZTENDTHF)
DEALLOCATE(ZTENDRVF)
+DEALLOCATE(ZTENDUF)
+DEALLOCATE(ZTENDVF)
DEALLOCATE(ZDZZ)
DEALLOCATE(ZRWCF)
DEALLOCATE(ZDUF)
diff --git a/src/MNH/ini_modeln.f90 b/src/MNH/ini_modeln.f90
index 9aafd74a8..669404ea6 100644
--- a/src/MNH/ini_modeln.f90
+++ b/src/MNH/ini_modeln.f90
@@ -274,6 +274,7 @@ END MODULE MODI_INI_MODEL_n
!! M.Leriche 2016 Chemistry
!! M.Leriche 10/02/17 prevent negative values in LBX(Y)SVS
!! M.Leriche 01/07/2017 Add DIAG chimical surface fluxes
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
!---------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -1394,6 +1395,8 @@ IF (KMI == 1) THEN
ALLOCATE(XGXTHFRC(IKU,NFRC))
ALLOCATE(XGYTHFRC(IKU,NFRC))
ALLOCATE(XPGROUNDFRC(NFRC))
+ ALLOCATE(XTENDUFRC(IKU,NFRC))
+ ALLOCATE(XTENDVFRC(IKU,NFRC))
ELSE
ALLOCATE(TDTFRC(0))
ALLOCATE(XUFRC(0,0))
@@ -1406,6 +1409,8 @@ IF (KMI == 1) THEN
ALLOCATE(XGXTHFRC(0,0))
ALLOCATE(XGYTHFRC(0,0))
ALLOCATE(XPGROUNDFRC(0))
+ ALLOCATE(XTENDUFRC(0,0))
+ ALLOCATE(XTENDVFRC(0,0))
END IF
IF ( LFORCING ) THEN
ALLOCATE(XWTFRC(IIU,IJU,IKU))
@@ -1616,6 +1621,7 @@ CALL READ_FIELD(HINIFILE,HLUOUT,IMASDEV, IIU,IJU,IKU,XTSTEP, &
NFRC,TDTFRC,XUFRC,XVFRC,XWFRC,XTHFRC,XRVFRC, &
XTENDTHFRC,XTENDRVFRC,XGXTHFRC,XGYTHFRC, &
XPGROUNDFRC, XATC, &
+ XTENDUFRC, XTENDVFRC, &
NADVFRC,TDTADVFRC,XDTHFRC,XDRVFRC, &
NRELFRC,TDTRELFRC,XTHREL,XRVREL, &
XVTH_FLUX_M,XWTH_FLUX_M,XVU_FLUX_M, &
diff --git a/src/MNH/modd_frc.f90 b/src/MNH/modd_frc.f90
index 82eeabe7e..a2dfc1c56 100644
--- a/src/MNH/modd_frc.f90
+++ b/src/MNH/modd_frc.f90
@@ -49,6 +49,7 @@
!! 27/01/98 P. Bechtold use tendency forcing
!! add SST and surface pressure forcing
!! 01/2004 V. Masson surface externalization: removes SST forcing
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -79,6 +80,8 @@ REAL, SAVE :: XUTRANS, &! horizontal components of
XVTRANS ! a constant
! Galilean TRANSlation
REAL, SAVE, DIMENSION(:), ALLOCATABLE :: XPGROUNDFRC! surf. pressure
+REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XTENDUFRC ! large scale U tendency
+REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XTENDVFRC ! large scale V tendency
!
!* control parameters for FORCING
! ------------------------------
@@ -86,6 +89,7 @@ REAL, SAVE, DIMENSION(:), ALLOCATABLE :: XPGROUNDFRC! surf. pressure
LOGICAL, SAVE :: LGEOST_UV_FRC ! enables geostrophic wind term
LOGICAL, SAVE :: LGEOST_TH_FRC ! enables thermal wind advection
LOGICAL, SAVE :: LTEND_THRV_FRC ! enables tendency forcing
+LOGICAL, SAVE :: LTEND_UV_FRC ! enables tendency forcing of the wind
LOGICAL, SAVE :: LVERT_MOTION_FRC ! enables prescribed a forced vertical
! transport for all prognostic variables
LOGICAL, SAVE :: LRELAX_THRV_FRC ! enables temp. and humidity relaxation
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index 5dca40ac1..c12f9d2b1 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -245,6 +245,7 @@ END MODULE MODI_MODEL_n
!! _ Add OSPLIT_WENO
!! _ Add droplet deposition
!! 10/2016 (M.Mazoyer) New KHKO output fields
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -372,6 +373,8 @@ USE MODI_TURB_CLOUD_INDEX
USE MODI_INI_LG
USE MODI_INI_MEAN_FIELD
!
+USE MODE_GRIDCART
+USE MODE_GRIDPROJ
USE MODE_MODELN_HANDLER
!
USE MODD_2D_FRC
@@ -525,6 +528,7 @@ INTEGER :: IGRID ! C-grid indicator in LFIFM file
INTEGER :: ILENCH ! Length of comment string in LFIFM file
!
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZRUS,ZRVS,ZRWS
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZJ
!
! for various testing
INTEGER :: IK
@@ -1137,12 +1141,19 @@ XT_2WAY = XT_2WAY + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
ZTIME1 = ZTIME2
XTIME_BU_PROCESS = 0.
XTIME_LES_BU_PROCESS = 0.
+IF (LCARTESIAN) THEN
+ CALL SM_GRIDCART(CLUOUT,XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XDXHAT,XDYHAT,XZZ,ZJ)
+ XMAP=1.
+ELSE
+ CALL SM_GRIDPROJ(CLUOUT,XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XLATORI,XLONORI, &
+ XMAP,XLAT,XLON,XDXHAT,XDYHAT,XZZ,ZJ)
+END IF
!
IF ( LFORCING ) THEN
CALL FORCING(XTSTEP,LUSERV,XRHODJ,XCORIOZ,XZHAT,XZZ,TDTCUR,&
XUFRC_PAST, XVFRC_PAST, &
XUT,XVT,XWT,XTHT,XTKET,XRT,XSVT, &
- XRUS,XRVS,XRWS,XRTHS,XRTKES,XRRS,XRSVS,IMI)
+ XRUS,XRVS,XRWS,XRTHS,XRTKES,XRRS,XRSVS,IMI,ZJ)
END IF
!
IF ( L2D_ADV_FRC ) THEN
diff --git a/src/MNH/modn_frc.f90 b/src/MNH/modn_frc.f90
index 0207d7579..685ee4f24 100644
--- a/src/MNH/modn_frc.f90
+++ b/src/MNH/modn_frc.f90
@@ -47,6 +47,7 @@
!! 27/01/98 (P. Bechtold) use tendency forcing
!! add SST and surf pressure forcing
!! 06/2003 (V. Masson) removes SST forcing (externalisation of surface)
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
!-------------------------------------------------------------------------------
USE MODD_FRC
!
@@ -55,6 +56,7 @@ IMPLICIT NONE
NAMELIST /NAM_FRC/ LGEOST_UV_FRC , &
LGEOST_TH_FRC , &
LTEND_THRV_FRC , &
+ LTEND_UV_FRC , &
LVERT_MOTION_FRC , &
LRELAX_THRV_FRC , &
LRELAX_UV_FRC , &
diff --git a/src/MNH/read_field.f90 b/src/MNH/read_field.f90
index 2676b6c8e..4f9375a70 100644
--- a/src/MNH/read_field.f90
+++ b/src/MNH/read_field.f90
@@ -24,6 +24,7 @@ INTERFACE
PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
KFRC,TPDTFRC,PUFRC,PVFRC,PWFRC,PTHFRC,PRVFRC, &
PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC,PPGROUNDFRC,PATC, &
+ PTENDUFRC,PTENDVFRC, &
KADVFRC,TPDTADVFRC,PDTHFRC,PDRVFRC, &
KRELFRC,TPDTRELFRC, PTHREL, PRVREL, &
PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M, &
@@ -104,6 +105,7 @@ INTEGER, INTENT(IN) :: KFRC ! number of forcing
TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTFRC ! date of forcing profs.
REAL, DIMENSION(:,:), INTENT(OUT) :: PUFRC,PVFRC,PWFRC ! forcing variables
REAL, DIMENSION(:,:), INTENT(OUT) :: PTHFRC,PRVFRC
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTENDUFRC,PTENDVFRC
REAL, DIMENSION(:,:), INTENT(OUT) :: PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC
REAL, DIMENSION(:), INTENT(OUT) :: PPGROUNDFRC
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PATC
@@ -141,6 +143,7 @@ END MODULE MODI_READ_FIELD
PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
KFRC,TPDTFRC,PUFRC,PVFRC,PWFRC,PTHFRC,PRVFRC, &
PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC,PPGROUNDFRC,PATC, &
+ PTENDUFRC,PTENDVFRC, &
KADVFRC,TPDTADVFRC,PDTHFRC,PDRVFRC, &
KRELFRC,TPDTRELFRC, PTHREL, PRVREL, &
PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M, &
@@ -234,6 +237,7 @@ END MODULE MODI_READ_FIELD
!! Modification 01/2016 (JP Pinty) Add LIMA
!! M. Leriche 02/16 treat gas and aq. chemicals separately
!! C.Lac 10/16 CEN4TH with RKC4 + Correction on RK loop
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -356,6 +360,7 @@ INTEGER, INTENT(IN) :: KFRC ! number of forcing
TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTFRC ! date of forcing profs.
REAL, DIMENSION(:,:), INTENT(OUT) :: PUFRC,PVFRC,PWFRC ! forcing variables
REAL, DIMENSION(:,:), INTENT(OUT) :: PTHFRC,PRVFRC
+REAL, DIMENSION(:,:), INTENT(OUT) :: PTENDUFRC,PTENDVFRC
REAL, DIMENSION(:,:), INTENT(OUT) :: PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC
REAL, DIMENSION(:), INTENT(OUT) :: PPGROUNDFRC
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PATC
@@ -1236,6 +1241,15 @@ IF ( LFORCING ) THEN
YDIR='--'
CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,PPGROUNDFRC(JT),IGRID,ILENCH,YCOMMENT,IRESP)
!
+ YRECFM='TENDUFRC'//YFRC
+ YDIR='--'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z1D,IGRID,ILENCH,YCOMMENT,IRESP)
+ PTENDUFRC(:,JT)=Z1D(:)
+!
+ YRECFM='TENDVFRC'//YFRC
+ YDIR='--'
+ CALL FMREAD(HINIFILE,YRECFM,HLUOUT,YDIR,Z1D,IGRID,ILENCH,YCOMMENT,IRESP)
+ PTENDVFRC(:,JT)=Z1D(:)
END DO
END IF
!
diff --git a/src/MNH/set_frc.f90 b/src/MNH/set_frc.f90
index 1e5a1f2e4..c219771b1 100644
--- a/src/MNH/set_frc.f90
+++ b/src/MNH/set_frc.f90
@@ -94,6 +94,7 @@ END MODULE MODI_SET_FRC
!! add SST and ground pressure forcing
!! 06/12 (Masson) Removes extrapolations below or above forcing
!! data. Reproduces the same data instead.
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
!!
!-------------------------------------------------------------------------------
!
@@ -144,6 +145,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZWF,ZUF,ZVF ! Local variables for
REAL, DIMENSION(:), ALLOCATABLE :: ZTHF,ZRVF ! the data reading
REAL, DIMENSION(:), ALLOCATABLE :: ZGXRF,ZGYRF ! "
REAL, DIMENSION(:), ALLOCATABLE :: ZHEIGHTF ! "
+REAL, DIMENSION(:), ALLOCATABLE :: ZTUF, ZTVF
REAL, DIMENSION(:), ALLOCATABLE :: ZPRESSUF ! "
REAL, DIMENSION(:), ALLOCATABLE :: ZPRESSMF ! "
REAL, DIMENSION(:), ALLOCATABLE :: ZTHVUF ! Thetav at wind levels
@@ -217,6 +219,8 @@ ALLOCATE(XTENDRVFRC(IKU,NFRC))
ALLOCATE(XGXTHFRC(IKU,NFRC))
ALLOCATE(XGYTHFRC(IKU,NFRC))
ALLOCATE(XPGROUNDFRC(NFRC))
+ALLOCATE(XTENDUFRC(IKU,NFRC))
+ALLOCATE(XTENDVFRC(IKU,NFRC))
!
! Reading the forcing sounding written in prep_idea1.nam
!
@@ -244,6 +248,8 @@ DO JKT = 1,NFRC
DEALLOCATE(ZRVF)
DEALLOCATE(ZGXRF)
DEALLOCATE(ZGYRF)
+ DEALLOCATE(ZTUF)
+ DEALLOCATE(ZTVF)
ENDIF
ALLOCATE(ZHEIGHTF(ILEVELF))
ALLOCATE(ZUF(ILEVELF))
@@ -253,11 +259,15 @@ DO JKT = 1,NFRC
ALLOCATE(ZRVF(ILEVELF))
ALLOCATE(ZGXRF(ILEVELF))
ALLOCATE(ZGYRF(ILEVELF))
+ ALLOCATE(ZTUF(ILEVELF))
+ ALLOCATE(ZTVF(ILEVELF))
!
DO JKU =1,ILEVELF
READ(ILUPRE,*) ZHEIGHTF(JKU) &
,ZUF(JKU),ZVF(JKU),ZTHF(JKU),ZRVF(JKU) &
- ,ZWF(JKU),ZGXRF(JKU),ZGYRF(JKU)
+ ,ZWF(JKU),ZGXRF(JKU),ZGYRF(JKU),ZTUF(JKU)&
+ ,ZTVF(JKU)
+
END DO
END IF
!
@@ -390,6 +400,8 @@ DO JKT = 1,NFRC
XRVFRC(JK,JKT) = ZRVF(1)
XTENDTHFRC(JK,JKT) = ZGXRF(1)
XTENDRVFRC(JK,JKT) = ZGYRF(1)
+ XTENDUFRC(JK,JKT) = ZTUF(1)
+ XTENDVFRC(JK,JKT) = ZTVF(1)
ELSE IF (ZZHATM(JK) > ZHEIGHTF(ILEVELF) ) THEN
!
! copy above the last level
@@ -400,6 +412,8 @@ DO JKT = 1,NFRC
XRVFRC(JK,JKT) = ZRVF(ILEVELF)
XTENDTHFRC(JK,JKT)=ZGXRF(ILEVELF)
XTENDRVFRC(JK,JKT)=ZGYRF(ILEVELF)
+ XTENDUFRC(JK,JKT)=ZTUF(ILEVELF)
+ XTENDVFRC(JK,JKT)=ZTVF(ILEVELF)
ELSE
!
! interpolation between first and last levels
@@ -416,6 +430,8 @@ DO JKT = 1,NFRC
XRVFRC(JK,JKT) = ZRVF(JKLEV)*ZDZ2SDH + ZRVF(JKLEV+1)*ZDZ1SDH
XTENDTHFRC(JK,JKT)=ZGXRF(JKLEV)*ZDZ2SDH + ZGXRF(JKLEV+1)*ZDZ1SDH
XTENDRVFRC(JK,JKT)=ZGYRF(JKLEV)*ZDZ2SDH + ZGYRF(JKLEV+1)*ZDZ1SDH
+ XTENDUFRC(JK,JKT)=ZTUF(JKLEV)*ZDZ2SDH + ZTUF(JKLEV+1)*ZDZ1SDH
+ XTENDVFRC(JK,JKT)=ZTVF(JKLEV)*ZDZ2SDH + ZTVF(JKLEV+1)*ZDZ1SDH
END IF
END DO
END IF
@@ -583,6 +599,20 @@ IF (NVERB >= 10) THEN
WRITE(UNIT=ILUOUT,FMT='(I10,99(/8E10.3))') &
JK, (XTENDRVFRC(JK,JL), JL=1, NFRC)
END DO
+!
+ WRITE(UNIT=ILUOUT,FMT='(A)') &
+ "XTENDUFRC : wind advection tendency in X"
+ DO JK = 1, IKU
+ WRITE(UNIT=ILUOUT,FMT='(I10,99(/8E10.3))') &
+ JK, (XTENDUFRC(JK,JL), JL=1, NFRC)
+ END DO
+!
+ WRITE(UNIT=ILUOUT,FMT='(A)') &
+ "XTENDVFRC : wind advection tendency in Y"
+ DO JK = 1, IKU
+ WRITE(UNIT=ILUOUT,FMT='(I10,99(/8E10.3))') &
+ JK, (XTENDVFRC(JK,JL), JL=1, NFRC)
+ END DO
!
WRITE(UNIT=ILUOUT,FMT='(A)') &
"XPGROUNDFRC: SURF PRESSURE FORCING"
--
GitLab