Newer
Older
!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
! #####################
MODULE MODI_ADV_FORCING_n
! #####################
!
INTERFACE
!
SUBROUTINE ADV_FORCING_n ( PRHODJ, TPDTCUR,PTHM,PRM, PZZ,PRTHS, PRRS)
!
USE MODD_TIME, ONLY: DATE_TIME
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! ( rhod J ) = dry density
! for reference state * Jacobian of the GCS transformation.
TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! current date and time
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) ::PRTHS ! potential temperature tendencies at time t
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS ! moist variables tendencies at time t+1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height z
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! moist variables at time t-dt
!
END SUBROUTINE ADV_FORCING_n
!
END INTERFACE
!
END MODULE MODI_ADV_FORCING_n
!
! ######################################################################
SUBROUTINE ADV_FORCING_n ( PRHODJ, TPDTCUR, PTHM,PRM, PZZ,PRTHS, PRRS)
! ######################################################################
!
!!*** *ADV_FORCING* - routine to compute the advecting-forced terms for 2D runs
!!
!! PURPOSE
!! -------
!! The routine prepares (linear interpolations) and integrates each
!! specified advecting-forcing terms which are a tendency in theta and rv
!! (dth/dt, drv/dt) or non homogenous relaxation on theta and rv.
!!
!!** METHOD
!! ------
!! For its first call, the routine looks for a starting advecting-forcing
!! with a date_and_time immediately lower or close to that the current
!! date_and_time of the model. Then the temporal interpolation or extension
!! is performed according to the position of the current date_and_time
!! as compared to that of the advecting-forcing. In case of non-flat
!! terrain, no interpolation is anticipated.
!! All the necessary interpolations are linear.
!!
!! NB: For relaxation forcing, only mask=FIXE has been implemented for simplicity
!!
!! DUMMIES: LDUMMY(2)=T allows ADV forcing
!! LDUMMY3=T ------- REL -------
!! with XDUMMY1=lower limit of relaxation (m)
!! XDUMMY2=top limit of relxation (m)
!! XDUMMY3=relaxation timsescale (s)
!!
!! EXTERNAL
!! --------
!! Temporal_lt function (compare 2 TYPEd date_and_time data)
!! Temporal_dist function (compute the number of seconds between
!! 2 TYPEd date_and_time data)
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODDB_ADVFRCn: declaration of the advecting-forcing variables
!! NADVFRC : number of advecting-forcing variables
!! TDTADVFRC: date of each advecting-forcing profile
!! XUFRC,XVFRC,XWFRC,XTHFRC,XRVFRC: advecting-forcing variables
!! Module MODD_LUNIT : contains logical unit names for all models
!! TLUOUT0 : output-listing
!! Module MODD_PARAMETERS: declaration of parameter variables
!! JPVEXT: define the number of marginal points out of the
!! physical domain along the vertical direction.
!! Module MODD_TIME: contains the structure of the TYPEd date_and_time
!! Module MODD_BLANK: Uses LDUMMY(2)=T to activate the time varying adv frc
!!
!! REFERENCE
!! ---------
!! Peyrille&Lafore JAS 2007 vol64 n°8 An idealized two-dimensional framework to study
!! the west african monsoon. Part II Large-scale advection and the diurnal cycle
!!
!! AUTHOR
!! ------
!! M. Tomasini (CNRM) from forcing.f90
!! and P.Peyrille (CNRM)
!!
!! MODIFICATIONS
!! -------------
!! Original 08/11/10
!! 28/03/2018 P. Wautelet: replace TEMPORAL_DIST by DATETIME_DISTANCE
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODE_DATETIME
USE MODE_FM
USE MODE_IO_ll
!
USE MODD_DYN
USE MODD_LUNIT, ONLY: TLUOUT0
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
USE MODD_PARAMETERS
USE MODD_TIME
USE MODD_BUDGET
!
USE MODI_TEMPORAL_LT
USE MODI_BUDGET
!
USE MODD_ADVFRC_n ! Modules for time evolving advfrc
USE MODI_SHUMAN
!USE MODD_FRC
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! ( rhod J ) = dry density
! for reference state * Jacobian of the GCS transformation.
TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! current date and time
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) ::PRTHS ! potential temperature tendencies at time t
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS ! moist variables tendencies at time t+1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height z
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! moist variables at time t-dt
!
!* 0.2 Declarations of local variables
!
INTEGER :: JN, JK, JXP
INTEGER, SAVE :: JSX_ADV ! saved loop index
LOGICAL, SAVE :: GSFIRSTCALL = .TRUE. ! control switch for the first call
!
REAL :: ZDT, ZALPHA ! height and time rate
REAL, SAVE :: ZSDTJX
!
INTEGER :: ILUOUT0 ! Logical unit number for output-listing
INTEGER :: IRESP ! Return code of FM-routines
!
REAL, DIMENSION(SIZE(PRTHS,1),SIZE(PRTHS,2),SIZE(PRTHS,3)) :: ZXADVTHFRC,ZXADVRVFRC
LOGICAL,DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: GRELAX_MASK_FRC ! MAsk for relaxation
!----------------------------------------------------------------------------
!
!* 1. PREPARATION OF FORCING
! ----------------------
!
ILUOUT0 = TLUOUT0%NLU
!
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
IF (GSFIRSTCALL) THEN
!
GSFIRSTCALL = .FALSE.
!!* 1.1 printout number of forcing profiles
!
WRITE(UNIT=ILUOUT0,FMT='(" THERE ARE ",I2," ADV FORCING FIELDs AT:")') NADVFRC
DO JSX_ADV = 1 , NADVFRC
WRITE(UNIT=ILUOUT0,FMT='(F9.0, "s, date:", I3, "/", I3, "/", I5)') &
TDTADVFRC(JSX_ADV)%TIME, &
TDTADVFRC(JSX_ADV)%TDATE%DAY, &
TDTADVFRC(JSX_ADV)%TDATE%MONTH, &
TDTADVFRC(JSX_ADV)%TDATE%YEAR
END DO
!* 1.2 find first sounding to be used
JSX_ADV = 0
IF( TEMPORAL_LT ( TPDTCUR, TDTADVFRC(1) ) ) THEN
WRITE(UNIT=ILUOUT0,FMT='(" THE INITIAL ADV FORCING FIELDS ARE NULL ")')
ELSE IF( .NOT. TEMPORAL_LT ( TPDTCUR, TDTADVFRC(NADVFRC) ) ) THEN
WRITE(UNIT=ILUOUT0,FMT='(" THE ADV FORCING FIELDS WILL REMAIN STATIONARY ")')
ELSE
TIM1_FOR: DO JN = NADVFRC-1, 1, -1
JSX_ADV = JN
IF( .NOT. TEMPORAL_LT ( TPDTCUR, TDTADVFRC(JSX_ADV) ) ) EXIT TIM1_FOR
END DO TIM1_FOR
!
WRITE(UNIT=ILUOUT0,FMT='(" THE INITIAL FORCING FIELDS ARE INTERPOLATED" , &
& " IN TIME STARTING FROM THE SOUNDING NUMBER ",I2)') JSX_ADV
JSX_ADV = JSX_ADV - 1
END IF
END IF
!
!* 2. INTEGRATION OF TH and RV ADVECTING FORCINGS TENDANCY IN THE SOURCES
! ---------------------------------------------------------------------
!
! 2.1 Temporal interpolation of each term
! ------------------------------------------
IF( TEMPORAL_LT ( TPDTCUR, TDTADVFRC(1) ) ) THEN
ZXADVTHFRC(:,:,:) = 0.
ZXADVRVFRC(:,:,:) = 0.
ELSE IF ( .NOT. TEMPORAL_LT ( TPDTCUR, TDTADVFRC(NADVFRC) ) ) THEN
ZXADVTHFRC(:,:,:) = XDTHFRC(:,:,:,NADVFRC)
ZXADVRVFRC(:,:,:) = XDRVFRC(:,:,:,NADVFRC)
ELSE
JXP = JSX_ADV + 1
IF( .NOT. TEMPORAL_LT ( TPDTCUR, TDTADVFRC(JXP) ) ) THEN
JSX_ADV = JSX_ADV +1
JXP= JSX_ADV +1
WRITE(UNIT=ILUOUT0,FMT='(" THE ADV FORCING FIELDS ARE INTERPOLATED NOW" ,&
& " BETWEEN SOUNDING NUMBER ",I2," AND SOUNDING NUMBER ",I2)') JSX_ADV,JXP
CALL DATETIME_DISTANCE(TDTADVFRC(JSX_ADV),TDTADVFRC(JXP),ZSDTJX)
CALL DATETIME_DISTANCE(TDTADVFRC(JSX_ADV),TPDTCUR,ZDT)
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
!
ZALPHA = ZDT / ZSDTJX
!
! heating and moistening rates depending on time
ZXADVTHFRC(:,:,:) = XDTHFRC(:,:,:,JSX_ADV) +(XDTHFRC(:,:,:,JXP)-XDTHFRC(:,:,:,JSX_ADV))*ZALPHA
ZXADVRVFRC(:,:,:) = XDRVFRC(:,:,:,JSX_ADV) +(XDRVFRC(:,:,:,JXP)-XDRVFRC(:,:,:,JSX_ADV))*ZALPHA
!
END IF
!
! 2.2 Integration of the forcing in the source
! ------------------------------------------
! 2.2.1 Advective forcing in LDUMMY(2)=T
DO JK=1,JPVEXT
ZXADVTHFRC(:,:,JK) = 0.
ZXADVRVFRC(:,:,JK) = 0.
END DO
PRTHS(:,:,:) = PRTHS(:,:,:) + PRHODJ(:,:,:) * ZXADVTHFRC(:,:,:)
PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRHODJ(:,:,:) * ZXADVRVFRC(:,:,:)
!
!
!* 3. BUDGET CALLS
! ------------
IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'2DADV_BU_RTH')
IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6,'2DADV_BU_RRV')
!----------------------------------------------------------------------------
!
END SUBROUTINE ADV_FORCING_n