From 2811e7418929ab00c4366e1a8c54b046f7c8a4ea Mon Sep 17 00:00:00 2001
From: Quentin Rodier <quentin.rodier@meteo.fr>
Date: Mon, 2 Dec 2019 15:42:42 +0100
Subject: [PATCH] Robert S. 02/12/2019: Large scale vertical wind forcing
allowed for grid nesting ideal simulations
---
src/MNH/deallocate_model1.f90 | 3 ---
src/MNH/forcing.f90 | 10 +++++++---
src/MNH/ini_modeln.f90 | 21 +++++++++++----------
src/MNH/modd_frc.f90 | 1 -
src/MNH/modd_frcn.f90 | 12 ++++++++----
src/MNH/modeln.f90 | 2 +-
src/MNH/phys_paramn.f90 | 1 +
7 files changed, 28 insertions(+), 22 deletions(-)
diff --git a/src/MNH/deallocate_model1.f90 b/src/MNH/deallocate_model1.f90
index dc3107d54..113521daf 100644
--- a/src/MNH/deallocate_model1.f90
+++ b/src/MNH/deallocate_model1.f90
@@ -455,9 +455,6 @@ IF ( ALLOCATED(XUFRC) .AND. KCALL == 4 ) THEN
DEALLOCATE(XGYTHFRC)
DEALLOCATE(XPGROUNDFRC)
END IF
-IF ( ALLOCATED(XWTFRC) .AND. KCALL == 4 ) THEN
- DEALLOCATE(XWTFRC)
-END IF
!
!* 12. Module MODD_ICE_CONC$n
!
diff --git a/src/MNH/forcing.f90 b/src/MNH/forcing.f90
index ebb2873db..13e295bb5 100644
--- a/src/MNH/forcing.f90
+++ b/src/MNH/forcing.f90
@@ -11,7 +11,7 @@ INTERFACE
!
SUBROUTINE FORCING ( PTSTEP, OUSERV, PRHODJ, PCORIOZ, &
PZHAT, PZZ, TPDTCUR, &
- PUFRC_PAST, PVFRC_PAST, &
+ PUFRC_PAST, PVFRC_PAST, PWTFRC, &
PUT, PVT, PWT, PTHT, PTKET, PRT, PSVT, &
PRUS, PRVS, PRWS, PRTHS, PRTKES, PRRS, PRSVS, &
KMI,PJ)
@@ -29,6 +29,8 @@ TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! current date and time
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUFRC_PAST, PVFRC_PAST
! ! forcing at previous time-step
!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTFRC ! large scale vertical wind
+!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT,PWT,PTHT,PTKET
! wind, potential temperature and
! TKE at time t
@@ -53,7 +55,7 @@ END MODULE MODI_FORCING
! ######################################################################
SUBROUTINE FORCING ( PTSTEP, OUSERV, PRHODJ, PCORIOZ, &
PZHAT, PZZ, TPDTCUR, &
- PUFRC_PAST, PVFRC_PAST, &
+ PUFRC_PAST, PVFRC_PAST, PWTFRC, &
PUT, PVT, PWT, PTHT, PTKET, PRT, PSVT, &
PRUS, PRVS, PRWS, PRTHS, PRTKES, PRRS, PRSVS, &
KMI,PJ)
@@ -186,6 +188,8 @@ TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! current date and time
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUFRC_PAST, PVFRC_PAST
! ! forcing at previous time-step
!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTFRC ! large scale vertical wind
+!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT,PWT,PTHT,PTKET
! wind, potential temperature and
! TKE at time t
@@ -610,7 +614,7 @@ END DO
!
! store large scale w in module to be used later
! in convection scheme
-XWTFRC(:,:,:) = ZWF(:,:,:)
+PWTFRC(:,:,:) = ZWF(:,:,:)
!
!* computes evolution of forcing wind
WHERE(PUFRC_PAST==XUNDEF) PUFRC_PAST = ZUF(:,:,:)
diff --git a/src/MNH/ini_modeln.f90 b/src/MNH/ini_modeln.f90
index 63ef283bf..e195ef603 100644
--- a/src/MNH/ini_modeln.f90
+++ b/src/MNH/ini_modeln.f90
@@ -1485,7 +1485,17 @@ ALLOCATE(XRI_MF(IIU,IJU,IKU)) ; XRI_MF=0.0
!
ALLOCATE(ZJ(IIU,IJU,IKU))
!
-!* 3.10 Forcing variables (Module MODD_FRC)
+!* 3.10 Forcing variables (Module MODD_FRC and MODD_FRCn)
+!
+IF ( LFORCING ) THEN
+ ALLOCATE(XWTFRC(IIU,IJU,IKU)) ; XWTFRC = XUNDEF
+ ALLOCATE(XUFRC_PAST(IIU,IJU,IKU)) ; XUFRC_PAST = XUNDEF
+ ALLOCATE(XVFRC_PAST(IIU,IJU,IKU)) ; XVFRC_PAST = XUNDEF
+ELSE
+ ALLOCATE(XWTFRC(0,0,0))
+ ALLOCATE(XUFRC_PAST(0,0,0))
+ ALLOCATE(XVFRC_PAST(0,0,0))
+END IF
!
IF (KMI == 1) THEN
IF ( LFORCING ) THEN
@@ -1517,15 +1527,6 @@ IF (KMI == 1) THEN
ALLOCATE(XTENDUFRC(0,0))
ALLOCATE(XTENDVFRC(0,0))
END IF
- IF ( LFORCING ) THEN
- ALLOCATE(XWTFRC(IIU,IJU,IKU))
- ALLOCATE(XUFRC_PAST(IIU,IJU,IKU)) ; XUFRC_PAST = XUNDEF
- ALLOCATE(XVFRC_PAST(IIU,IJU,IKU)) ; XVFRC_PAST = XUNDEF
- ELSE
- ALLOCATE(XWTFRC(0,0,0))
- ALLOCATE(XUFRC_PAST(0,0,0))
- ALLOCATE(XVFRC_PAST(0,0,0))
- END IF
ELSE
!Do not allocate because they are the same on all grids (not 'n' variables)
END IF
diff --git a/src/MNH/modd_frc.f90 b/src/MNH/modd_frc.f90
index a2dfc1c56..57d78f87e 100644
--- a/src/MNH/modd_frc.f90
+++ b/src/MNH/modd_frc.f90
@@ -69,7 +69,6 @@ TYPE (DATE_TIME), SAVE, DIMENSION(:), ALLOCATABLE :: TDTFRC ! date of
REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XUFRC, &! geostrophic wind
XVFRC, &! components U and V
XWFRC ! large scale vertical wind
-REAL, SAVE, DIMENSION(:,:,:),ALLOCATABLE:: XWTFRC ! large scale vertical wind
REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XTHFRC, &! large scale TH profile
XRVFRC ! large scale RV profile
REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XGXTHFRC,&! large scale TH gradient
diff --git a/src/MNH/modd_frcn.f90 b/src/MNH/modd_frcn.f90
index 3a01de69f..fc9c68362 100644
--- a/src/MNH/modd_frcn.f90
+++ b/src/MNH/modd_frcn.f90
@@ -35,11 +35,12 @@
!
USE MODD_PARAMETERS, ONLY: JPMODELMAX
IMPLICIT NONE
-
+!
TYPE FRC_t
!
- REAL, DIMENSION(:,:,:), POINTER :: XUFRC_PAST=>NULL()! Forcing wind components
- REAL, DIMENSION(:,:,:), POINTER :: XVFRC_PAST=>NULL()! at previous time-step
+ REAL, DIMENSION(:,:,:), POINTER :: XUFRC_PAST=>NULL() ! Forcing wind components
+ REAL, DIMENSION(:,:,:), POINTER :: XVFRC_PAST=>NULL() ! at previous time-step
+ REAL, DIMENSION(:,:,:), POINTER :: XWTFRC=>NULL() ! large scale vertical wind
!
END TYPE FRC_t
@@ -47,6 +48,7 @@ TYPE(FRC_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: FRC_MODEL
REAL, DIMENSION(:,:,:), POINTER :: XUFRC_PAST=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XVFRC_PAST=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XWTFRC=>NULL()
CONTAINS
@@ -56,11 +58,13 @@ INTEGER, INTENT(IN) :: KFROM, KTO
! Save current state for allocated arrays
FRC_MODEL(KFROM)%XUFRC_PAST=>XUFRC_PAST
FRC_MODEL(KFROM)%XVFRC_PAST=>XVFRC_PAST
+FRC_MODEL(KFROM)%XWTFRC=>XWTFRC
!
! Current model is set to model KTO
XUFRC_PAST=>FRC_MODEL(KTO)%XUFRC_PAST
XVFRC_PAST=>FRC_MODEL(KTO)%XVFRC_PAST
-
+XWTFRC=>FRC_MODEL(KTO)%XWTFRC
+!
END SUBROUTINE FRC_GOTO_MODEL
END MODULE MODD_FRC_n
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index a2884c77f..c1db82d4d 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -1150,7 +1150,7 @@ END IF
!
IF ( LFORCING ) THEN
CALL FORCING(XTSTEP,LUSERV,XRHODJ,XCORIOZ,XZHAT,XZZ,TDTCUR,&
- XUFRC_PAST, XVFRC_PAST, &
+ XUFRC_PAST, XVFRC_PAST,XWTFRC, &
XUT,XVT,XWT,XTHT,XTKET,XRT,XSVT, &
XRUS,XRVS,XRWS,XRTHS,XRTKES,XRRS,XRSVS,IMI,ZJ)
END IF
diff --git a/src/MNH/phys_paramn.f90 b/src/MNH/phys_paramn.f90
index 9854052e4..9a7dc40d9 100644
--- a/src/MNH/phys_paramn.f90
+++ b/src/MNH/phys_paramn.f90
@@ -249,6 +249,7 @@ USE MODD_BLANK
USE MODD_CST
USE MODD_DYN
USE MODD_CONF
+USE MODD_FRC_n
USE MODD_FRC
USE MODD_IO_ll, ONLY: TFILEDATA
USE MODD_PARAMETERS
--
GitLab