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.
! ######################
MODULE MODI_RELAXATION
! ######################
!
INTERFACE
!
SUBROUTINE RELAXATION( OVE_RELAX,OVE_RELAX_GRD, &
OHORELAX_UVWTH,OHORELAX_RV,OHORELAX_RC, &
OHORELAX_RR,OHORELAX_RI,OHORELAX_RS,OHORELAX_RG, &
OHORELAX_RH,OHORELAX_TKE,OHORELAX_SV, &
OHORELAX_SVC2R2,OHORELAX_SVC1R3, &
OHORELAX_SVELEC,OHORELAX_SVLG, &
OHORELAX_SVCHEM,OHORELAX_SVCHIC, OHORELAX_SVAER, &
OHORELAX_SVDST, OHORELAX_SVSLT, OHORELAX_SVPP, &
OHORELAX_SVCS, &
#ifdef MNH_FOREFIRE
OHORELAX_SVFF, &
#endif
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
74
75
76
77
78
PLSUM, PLSVM, PLSWM, PLSTHM, &
PLBXUM, PLBXVM, PLBXWM, PLBXTHM, PLBXRM, PLBXSVM, &
PLBXTKEM, &
PLBYUM, PLBYVM, PLBYWM, PLBYTHM, PLBYRM, PLBYSVM, &
PLBYTKEM, &
KALBOT, PALK, PALKW, &
KALBAS, PALKBAS, PALKWBAS, &
OMASK_RELAX,PKURELAX, PKVRELAX, PKWRELAX, &
KRIMX,KRIMY, &
PRUS,PRVS,PRWS,PRTHS,PRRS,PRSVS,PRTKES )
!
LOGICAL, INTENT(IN) :: OVE_RELAX ! general switch for
! vertical relaxation
LOGICAL, INTENT(IN) :: OVE_RELAX_GRD ! general switch for
! vertical relaxation (ground)
LOGICAL, INTENT(IN) :: OHORELAX_UVWTH ! switch for the
! horizontal relaxation for U,V,W,TH
LOGICAL, INTENT(IN) :: OHORELAX_RV ! switch for the
! horizontal relaxation for Rv
LOGICAL, INTENT(IN) :: OHORELAX_RC ! switch for the
! horizontal relaxation for Rc
LOGICAL, INTENT(IN) :: OHORELAX_RR ! switch for the
! horizontal relaxation for Rr
LOGICAL, INTENT(IN) :: OHORELAX_RI ! switch for the
! horizontal relaxation for Ri
LOGICAL, INTENT(IN) :: OHORELAX_RS ! switch for the
! horizontal relaxation for Rs
LOGICAL, INTENT(IN) :: OHORELAX_RG ! switch for the
! horizontal relaxation for Rg
LOGICAL, INTENT(IN) :: OHORELAX_RH ! switch for the
! horizontal relaxation for Rh
LOGICAL, INTENT(IN) :: OHORELAX_TKE ! switch for the
! horizontal relaxation for tke
LOGICAL,DIMENSION(:),INTENT(IN):: OHORELAX_SV ! switch for the
! horizontal relaxation for sv
LOGICAL, INTENT(IN):: OHORELAX_SVC2R2 ! switch for the
! horizontal relaxation for c2r2 variables
LOGICAL, INTENT(IN):: OHORELAX_SVC1R3 ! switch for the
! horizontal relaxation for c1r3 variables
LOGICAL, INTENT(IN):: OHORELAX_SVELEC ! switch for the
! horizontal relaxation for elec variables
LOGICAL, INTENT(IN):: OHORELAX_SVLG ! switch for the
! horizontal relaxation for lg variables
LOGICAL, INTENT(IN):: OHORELAX_SVCHEM ! switch for the
! horizontal relaxation for chem variables
LOGICAL, INTENT(IN):: OHORELAX_SVCHIC ! switch for the
! horizontal relaxation for ice chem variables
LOGICAL, INTENT(IN):: OHORELAX_SVAER ! switch for the
! horizontal relaxation for aer variables
LOGICAL, INTENT(IN):: OHORELAX_SVDST ! switch for the
! horizontal relaxation for dst variables
LOGICAL, INTENT(IN):: OHORELAX_SVSLT ! switch for the
! horizontal relaxation for slt variables
LOGICAL, INTENT(IN):: OHORELAX_SVPP ! switch for the
! horizontal relaxation for passive scalar
#ifdef MNH_FOREFIRE
LOGICAL, INTENT(IN):: OHORELAX_SVFF ! switch for the
! horizontal relaxation for ForeFire variables
#endif
LOGICAL, INTENT(IN):: OHORELAX_SVCS ! switch for the
! horizontal relaxation for conditional sampling
INTEGER, INTENT(IN) :: KTCOUNT! Temporal loop counter
REAL, INTENT(IN) :: PTSTEP ! Time step
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
INTEGER, INTENT(IN) :: KSV ! Number of scalar variables
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! effective dry rho * Jacobian
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! Variables at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT !
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT !
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT !
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKET
97
98
99
100
101
102
103
104
105
106
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
153
154
155
156
157
158
159
!
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSUM, PLSVM ! Large Scale
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSWM, PLSTHM ! variables
! at t-dt
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUM, PLBXVM, PLBXWM! Lateral
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTHM ! boundarie fields
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRM ! at t-dt
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXSVM ! along the x
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTKEM ! direction
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUM, PLBYVM, PLBYWM! Lateral
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTHM ! boundarie fields
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRM ! at t-dt
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYSVM ! along the y
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTKEM ! direction
!
INTEGER, INTENT(IN) :: KALBOT !Vertical index corresponding
! to the absorbing layer base
REAL, DIMENSION(:), INTENT(IN) :: PALK ! Function of the absorbing
! layer damping coefficient defined for
! u,v,and theta
REAL, DIMENSION(:), INTENT(IN) :: PALKW ! Idem but defined for w
!
INTEGER, INTENT(IN) :: KALBAS !Vertical index corresponding
! to the absorbing layer base
REAL, DIMENSION(:), INTENT(IN) :: PALKBAS! Function of the absorbing
! layer damping coefficient defined for
! u,v,and theta
REAL, DIMENSION(:), INTENT(IN) :: PALKWBAS ! Idem but defined for w
!
LOGICAL, DIMENSION(:,:), INTENT(IN) :: OMASK_RELAX ! Mask for the locations
! where lateral relax. must be performed
!
REAL, DIMENSION(:,:), INTENT(IN) :: PKURELAX ! Horizontal relaxation
REAL, DIMENSION(:,:), INTENT(IN) :: PKVRELAX ! coefficients for the
REAL, DIMENSION(:,:), INTENT(IN) :: PKWRELAX ! u, v and mass locations
INTEGER, INTENT(IN) :: KRIMX, KRIMY ! size of the hor.
! relaxation area
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Source terms
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS !
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS !
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS !
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTKES
!
END SUBROUTINE RELAXATION
!
END INTERFACE
!
END MODULE MODI_RELAXATION
! ######spl
SUBROUTINE RELAXATION( OVE_RELAX,OVE_RELAX_GRD, &
OHORELAX_UVWTH,OHORELAX_RV,OHORELAX_RC, &
OHORELAX_RR,OHORELAX_RI,OHORELAX_RS,OHORELAX_RG, &
OHORELAX_RH,OHORELAX_TKE,OHORELAX_SV, &
OHORELAX_SVC2R2,OHORELAX_SVC1R3, &
OHORELAX_SVELEC,OHORELAX_SVLG, &
OHORELAX_SVCHEM,OHORELAX_SVCHIC, OHORELAX_SVAER, &
OHORELAX_SVDST, OHORELAX_SVSLT, OHORELAX_SVPP, &
OHORELAX_SVCS, &
#ifdef MNH_FOREFIRE
OHORELAX_SVFF, &
#endif
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
206
207
208
209
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
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
PLSUM, PLSVM, PLSWM, PLSTHM, &
PLBXUM, PLBXVM, PLBXWM, PLBXTHM, PLBXRM, PLBXSVM, &
PLBXTKEM, &
PLBYUM, PLBYVM, PLBYWM, PLBYTHM, PLBYRM, PLBYSVM, &
PLBYTKEM, &
KALBOT, PALK, PALKW, &
KALBAS, PALKBAS, PALKWBAS, &
OMASK_RELAX,PKURELAX, PKVRELAX, PKWRELAX, &
KRIMX,KRIMY, &
PRUS,PRVS,PRWS,PRTHS,PRRS,PRSVS,PRTKES )
! ##########################################################################
!
!!**** *RELAXATION * - routine to apply a Rayleigh damping at the top
!! and in the outermost verticals of the domain
!! PURPOSE
!! -------
!! The purpose of this routine is to damp the u, v, w, and theta fields
!! near the top of the domain and in the outermost vertical planes
!! (vapor field added) to prevent spurious reflections on the top and on
!! the side boundaries.
!!
!!
!!** METHOD
!! ------
!! Implicit Rayleigh damping for the absorbing layer
!! upper part:
!! -Kal(zhat)
!! -Kal(zhat)(phi(t+dt)-LSphi)= ------------------ (phi(t-dt)-LSphi)
!! 1 + 2dt Kal(zhat)
!! lateral part:
!! -Krelax
!! -Krelax(phi(t+dt)-LSphi)= ------------------ (phi(t-dt)-LSphi)
!! 1 + 2dt Krelax
!!
!! phi being u, v, w, theta or qv
!! LSphi are the corresponding Larger Scale values or to the lateral
!! boundaries fields.
!! The different sources terms are stored for the budget computations.
!!
!!
!! EXTERNAL
!! --------
!! MXM,MYM,MZM : mean Shuman operators in the x,y,z directions
!! BUDGET : Stores the different budget components
!! GET_INDICE_ll : get physical sub-domain bounds
!! GET_GLOBALDIMS_ll : get physical global domain sizes
!! GET_INTERSECTION_ll : get the indices of the intersection inside the
!! extended global domain
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!!
!! Module MODD_PARAMETERS : JPVEXT
!!
!! Module MODD_CONF : CCONF
!!
!! Module MODD_BUDGET : NBUMOD,LBU_ENABLE,
!! LBU_RU,LBU_RV,LBU_RW,LBU_RTH,LBU_RRV,
!! LBU_RRC,LBU_RRR,LBU_RRI,LBU_RRH,LBU_RRG,
!! LBU_RTKE
!!
!! REFERENCE
!! ---------
!! Book2 of documentation ( routine RELAXATION )
!!
!! AUTHOR
!! ------
!! E. Richard * Laboratoire d'Aerologie*
!! J.-P. Pinty * Laboratoire d'Aerologie*
!!
!! MODIFICATIONS
!! -------------
!! Original 10/10/94
!! Modification
!! 03/11/94 (J.Stein) change the signs of the Rayleigh
!! 07/12/94 (J.-P. Pinty) merge ABS_LAYER and the former
!! RELAXATION routines
!! 07/12/94 (J.Stein) add a 3D mask
!! 20/.3/95 (J.Stein) remove R from the historical var.
!! 01/04/95 (Ph. Hereil J. Nicolau) add the budget computation
!! 16/10/95 (J. Stein) change the budget calls
!! 19/12/96 (J.-P. Pinty) update the budget calls
!! 21/10/97 (J. Stein) separate the vertical relaxation
!! towards the LS fields from the lateral
!! boundaries treatment
!! 24/08/98 (Jabouille) parallelization
!! 06/11/02 (V. Masson) update the budget calls
!! 05/2006 Remove EPS
!! 06/2011 (M.Chong) Case of ELEC
!! 11/2011 (C.Lac) Adaptation to FIT temporal scheme
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_PARAMETERS
USE MODD_CONF
USE MODD_BUDGET
USE MODD_NSV, ONLY : NSV_ELECBEG, NSV_ELECEND
USE MODD_ELEC_DESCR, ONLY: LRELAX2FW_ION
!
USE MODE_ll
!
USE MODI_SHUMAN
USE MODI_BUDGET
!
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
!
LOGICAL, INTENT(IN) :: OVE_RELAX ! general switch for
! vertical relaxation
LOGICAL, INTENT(IN) :: OVE_RELAX_GRD ! general switch for
! vertical relaxation (ground)
LOGICAL, INTENT(IN) :: OHORELAX_UVWTH ! switch for the
! horizontal relaxation for U,V,W,TH
LOGICAL, INTENT(IN) :: OHORELAX_RV ! switch for the
! horizontal relaxation for Rv
LOGICAL, INTENT(IN) :: OHORELAX_RC ! switch for the
! horizontal relaxation for Rc
LOGICAL, INTENT(IN) :: OHORELAX_RR ! switch for the
! horizontal relaxation for Rr
LOGICAL, INTENT(IN) :: OHORELAX_RI ! switch for the
! horizontal relaxation for Ri
LOGICAL, INTENT(IN) :: OHORELAX_RS ! switch for the
! horizontal relaxation for Rs
LOGICAL, INTENT(IN) :: OHORELAX_RG ! switch for the
! horizontal relaxation for Rg
LOGICAL, INTENT(IN) :: OHORELAX_RH ! switch for the
! horizontal relaxation for Rh
LOGICAL, INTENT(IN) :: OHORELAX_TKE ! switch for the
! horizontal relaxation for tke
LOGICAL,DIMENSION(:),INTENT(IN):: OHORELAX_SV ! switch for the
! horizontal relaxation for sv
LOGICAL, INTENT(IN):: OHORELAX_SVC2R2 ! switch for the
! horizontal relaxation for c2r2 variables
LOGICAL, INTENT(IN):: OHORELAX_SVC1R3 ! switch for the
! horizontal relaxation for c1r3 variables
LOGICAL, INTENT(IN):: OHORELAX_SVELEC ! switch for the
! horizontal relaxation for elec variables
LOGICAL, INTENT(IN):: OHORELAX_SVLG ! switch for the
! horizontal relaxation for lg variables
LOGICAL, INTENT(IN):: OHORELAX_SVCHEM ! switch for the
! horizontal relaxation for chem variables
LOGICAL, INTENT(IN):: OHORELAX_SVCHIC ! switch for the
! horizontal relaxation for ice chem variables
LOGICAL, INTENT(IN):: OHORELAX_SVAER ! switch for the
! horizontal relaxation for aer variables
LOGICAL, INTENT(IN):: OHORELAX_SVDST ! switch for the
! horizontal relaxation for dst variables
LOGICAL, INTENT(IN):: OHORELAX_SVSLT ! switch for the
! horizontal relaxation for slt variables
LOGICAL, INTENT(IN):: OHORELAX_SVPP ! switch for the
! horizontal relaxation for passive scalar
#ifdef MNH_FOREFIRE
LOGICAL, INTENT(IN):: OHORELAX_SVFF ! switch for the
! horizontal relaxation for ForeFire variables
#endif
LOGICAL, INTENT(IN):: OHORELAX_SVCS ! switch for the
! horizontal relaxation for conditional sampling
INTEGER, INTENT(IN) :: KTCOUNT! Temporal loop counter
REAL, INTENT(IN) :: PTSTEP ! Time step
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
INTEGER, INTENT(IN) :: KSV ! Number of scalar variables
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! effective dry rho * Jacobian
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! Variables at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT !
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT !
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT !
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKET
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
!
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSUM, PLSVM ! Large Scale
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSWM, PLSTHM ! variables
! at t-dt
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUM, PLBXVM, PLBXWM! Lateral
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTHM ! boundarie fields
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRM ! at t-dt
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXSVM ! along the x
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTKEM ! direction
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUM, PLBYVM, PLBYWM! Lateral
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTHM ! boundarie fields
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRM ! at t-dt
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYSVM ! along the y
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTKEM ! direction
!
INTEGER, INTENT(IN) :: KALBOT !Vertical index corresponding
! to the absorbing layer base
REAL, DIMENSION(:), INTENT(IN) :: PALK ! Function of the absorbing
! layer damping coefficient defined for
! u,v,and theta
REAL, DIMENSION(:), INTENT(IN) :: PALKW ! Idem but defined for w
!
INTEGER, INTENT(IN) :: KALBAS !Vertical index corresponding
! to the absorbing layer base
REAL, DIMENSION(:), INTENT(IN) :: PALKBAS! Function of the absorbing
! layer damping coefficient defined for
! u,v,and theta
REAL, DIMENSION(:), INTENT(IN) :: PALKWBAS ! Idem but defined for w
!
LOGICAL, DIMENSION(:,:), INTENT(IN) :: OMASK_RELAX ! Mask for the locations
! where lateral relax. must be performed
!
REAL, DIMENSION(:,:), INTENT(IN) :: PKURELAX ! Horizontal relaxation
REAL, DIMENSION(:,:), INTENT(IN) :: PKVRELAX ! coefficients for the
REAL, DIMENSION(:,:), INTENT(IN) :: PKWRELAX ! u, v and mass locations
INTEGER, INTENT(IN) :: KRIMX, KRIMY ! size of the hor.
! relaxation area
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Source terms
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS !
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS !
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS !
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTKES
!
!* 0.2 Declarations of local variables :
!
INTEGER :: JK,JRR,JSV ! Loop index
INTEGER :: IIU_ll,IJU_ll ! horizontal size of the extended global domain
INTEGER :: IIB,IJB,IIE,IJE ! Bounds of the physical sub-domain
INTEGER :: IKU,IKE ! size of the array in the z direction and index
! of the last inner mass point
INTEGER :: IIBINT,IJBINT ! Corner of relaxation domain
INTEGER :: IIEINT,IJEINT ! global indices translated to local indices
INTEGER :: IINFO_ll ! return code of parallel routine
INTEGER :: IDIMLB ! size of the LB field
!
REAL, DIMENSION(SIZE(PALK)) :: ZKV ! Function of the upper absorbing
! layer damping coefficient for u,v,theta and qv
REAL, DIMENSION(SIZE(PALK)) :: ZKVW !Idem but for w
!
REAL, DIMENSION(SIZE(PALKBAS)) :: ZKVBAS ! Function of the upper absorbing
! layer damping coefficient for u,v,theta and qv
REAL, DIMENSION(SIZE(PALKBAS)) :: ZKVWBAS !Idem but for w
!
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZKHU,ZKHV,ZKHW, &
! Function of the lateral absorbing layer damping
! for u,v and mass points respectively
ZRHODJU,ZRHODJV,ZRHODJW, &
! averages along x,y,z of the PRHODJ field
ZWORK
! work array used to expand the LB fields
LOGICAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: GMASK3D_RELAX ! 3D
! mask for hor. relax.
LOGICAL, DIMENSION(7) :: GHORELAXR ! local array of logical
#ifdef MNH_FOREFIRE
LOGICAL, DIMENSION(12) :: GHORELAXSV! local array of logical
#else
LOGICAL, DIMENSION(11) :: GHORELAXSV! local array of logical
#endif
!
!-------------------------------------------------------------------------------
!
!
!* 1. PRELIMINARIES
! -------------
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
IKE=IKU-JPVEXT
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
CALL GET_GLOBALDIMS_ll(IIU_ll,IJU_ll)
IIU_ll=IIU_ll+2*JPHEXT
IJU_ll=IJU_ll+2*JPHEXT
!
ZRHODJU(:,:,:) = MXM(PRHODJ)
ZRHODJV(:,:,:) = MYM(PRHODJ)
ZRHODJW(:,:,:) = MZM(1,IKU,1,PRHODJ)
!
GHORELAXR(1) = OHORELAX_RV
GHORELAXR(2) = OHORELAX_RC
GHORELAXR(3) = OHORELAX_RR
GHORELAXR(4) = OHORELAX_RI
GHORELAXR(5) = OHORELAX_RS
GHORELAXR(6) = OHORELAX_RG
GHORELAXR(7) = OHORELAX_RH
!
GHORELAXSV(1) = OHORELAX_SVC2R2
GHORELAXSV(2) = OHORELAX_SVC1R3
GHORELAXSV(3) = OHORELAX_SVELEC
GHORELAXSV(4) = OHORELAX_SVLG
GHORELAXSV(5) = OHORELAX_SVCHEM
GHORELAXSV(6) = OHORELAX_SVAER
GHORELAXSV(7) = OHORELAX_SVDST
GHORELAXSV(8) = OHORELAX_SVSLT
GHORELAXSV(9) = OHORELAX_SVPP
GHORELAXSV(10) = OHORELAX_SVCS
GHORELAXSV(11) = OHORELAX_SVCHIC
#ifdef MNH_FOREFIRE
GHORELAXSV(12) = OHORELAX_SVFF
#endif
!-------------------------------------------------------------------------------
!
!* 2. RELAXATION IN THE UPPER LAYERS
! ------------------------------
!
IF(OVE_RELAX) THEN
!
!* 2.1 SET THE TOP-LEVEL DAMPING COEF. (UPSTREAM OR LEAPFROG)
!
ZKV(:) = PALK(:) /(1. - PTSTEP * PALK(:))
ZKVW(:) = PALKW(:)/(1. - PTSTEP * PALKW(:))
! ELSE
! ZKV(:) = PALK(:)
! ZKVW(:) = PALKW(:)
! ENDIF
!
!
!* 2.2 APPLIES THE DAMPING IN THE UPPERMOST LEVELS
!
DO JK = KALBOT, IKE+1
!
PRUS(:,:,JK) = PRUS(:,:,JK) - ZKV(JK) *(PUT(:,:,JK) -PLSUM(:,:,JK) )&
PRVS(:,:,JK) = PRVS(:,:,JK) - ZKV(JK) *(PVT(:,:,JK) -PLSVM(:,:,JK) )&
PRWS(:,:,JK) = PRWS(:,:,JK) - ZKVW(JK) *(PWT(:,:,JK) -PLSWM(:,:,JK) )&
PRTHS(:,:,JK) = PRTHS(:,:,JK) - ZKV(JK) *(PTHT(:,:,JK) -PLSTHM(:,:,JK) )&
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
* PRHODJ(:,:,JK)
!
END DO
!
END IF
!-------------------------------------------------------------------------------
!
!* 2.bis RELAXATION IN THE GROUND LAYERS
! ------------------------------
!
IF(OVE_RELAX_GRD) THEN
!
!* 2.bis.1 SET THE GROUND-LEVEL DAMPING COEF. (UPSTREAM OR LEAPFROG)
!
IF ((KTCOUNT.EQ.1) .AND. (CCONF.EQ.'START') ) THEN
ZKVBAS(:) = PALKBAS(:) /(1. - PTSTEP * PALKBAS(:))
ZKVWBAS(:) = PALKWBAS(:)/(1. - PTSTEP * PALKWBAS(:))
ELSE
ZKVBAS(:) = PALKBAS(:)
ZKVWBAS(:) = PALKWBAS(:)
ENDIF
!
!
!* 2.bis.2 APPLIES THE DAMPING IN THE GROUND LEVELS
!
DO JK = 1,KALBAS
!
PRUS(:,:,JK) = PRUS(:,:,JK) - ZKVBAS(JK) *(PUT(:,:,JK) -PLSUM(:,:,JK) )&
PRVS(:,:,JK) = PRVS(:,:,JK) - ZKVBAS(JK) *(PVT(:,:,JK) -PLSVM(:,:,JK) )&
PRWS(:,:,JK) = PRWS(:,:,JK) - ZKVWBAS(JK) *(PWT(:,:,JK) -PLSWM(:,:,JK) )&
PRTHS(:,:,JK) = PRTHS(:,:,JK) - ZKVBAS(JK) *(PTHT(:,:,JK) -PLSTHM(:,:,JK) )&
* PRHODJ(:,:,JK)
!
END DO
!
END IF
!
!-------------------------------------------------------------------------------
!
!* 3. RELAXATION IN THE OUTERMOST VERTICAL PLANES
! -------------------------------------------
!
!
!* 3.1 SET THE RIM ZONE DAMPING COEF. (UPSTREAM OR LEAPFROG)
!
IF ( ANY(GHORELAXR) .OR. ANY(GHORELAXSV) .OR. ANY(OHORELAX_SV) &
.OR. OHORELAX_UVWTH .OR. OHORELAX_TKE ) THEN
DO JK=1,IKU
ZKHU(:,:,JK) = PKURELAX(:,:) /(1. - PTSTEP * PKURELAX(:,:))
ZKHV(:,:,JK) = PKVRELAX(:,:) /(1. - PTSTEP * PKVRELAX(:,:))
ZKHW(:,:,JK) = PKWRELAX(:,:) /(1. - PTSTEP * PKWRELAX(:,:))
END DO
! ELSE
! DO JK=1,IKU
! ZKHU(:,:,JK) = PKURELAX(:,:)
! ZKHV(:,:,JK) = PKVRELAX(:,:)
! ZKHW(:,:,JK) = PKWRELAX(:,:)
! END DO
! END IF
ENDIF
!
!
!* 3.2 APPLIES THE DAMPING NEAR THE LATERAL BOUNDARIES
!
ZWORK=0.
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
!
! special treatment is needed to expand LB for U and V because of the C grid
IF ( OHORELAX_UVWTH ) THEN
!
DO JK=1,IKU
GMASK3D_RELAX(:,:,JK)=OMASK_RELAX(:,:)
END DO
!
IDIMLB = SIZE(PLBXUM,1)
IF ( IDIMLB /= 0) THEN
CALL GET_INTERSECTION_ll (1,1,KRIMX+2,IJU_ll, &
IIBINT,IJBINT,IIEINT,IJEINT,"EXTE",IINFO_ll)
IF ( IINFO_ll == 0 ) THEN
ZWORK(2:IIEINT,:,:) = PLBXUM(1:IIEINT-1,:,:)
END IF
CALL GET_INTERSECTION_ll (IIU_ll-KRIMX,1,IIU_ll,IJU_ll, &
IIBINT,IJBINT,IIEINT,IJEINT,"EXTE",IINFO_ll)
IF ( IINFO_ll == 0 ) THEN
ZWORK(IIBINT:IIE+1,:,:) = PLBXUM(IDIMLB-(IIE+1-IIBINT):IDIMLB,:,:)
END IF
ENDIF
!
IDIMLB = SIZE(PLBYUM,2)
IF ( IDIMLB /= 0) THEN
CALL GET_INTERSECTION_ll (1,1,IIU_ll,KRIMY+1, &
IIBINT,IJBINT,IIEINT,IJEINT,"EXTE",IINFO_ll)
IF ( IINFO_ll == 0 ) THEN
ZWORK(:,1:IJEINT,:) = PLBYUM(:,1:IJEINT,:)
END IF
CALL GET_INTERSECTION_ll (1,IJU_ll-KRIMY,IIU_ll,IJU_ll, &
IIBINT,IJBINT,IIEINT,IJEINT,"EXTE",IINFO_ll)
IF ( IINFO_ll == 0 ) THEN
ZWORK(:,IJBINT:IJE+1,:) = PLBYUM(:,IDIMLB-(IJE+1-IJBINT):IDIMLB,:)
END IF
END IF
!
WHERE (GMASK3D_RELAX)
PRUS(:,:,:) = PRUS(:,:,:) - ZKHU(:,:,:)*(PUT(:,:,:)-ZWORK(:,:,:)) &
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
* ZRHODJU(:,:,:)
END WHERE
!
IDIMLB = SIZE(PLBXVM,1)
IF ( IDIMLB /= 0) THEN
CALL GET_INTERSECTION_ll (1,1,KRIMX+1,IJU_ll, &
IIBINT,IJBINT,IIEINT,IJEINT,"EXTE",IINFO_ll)
IF ( IINFO_ll == 0 ) THEN
ZWORK(1:IIEINT,:,:) = PLBXVM(1:IIEINT,:,:)
END IF
CALL GET_INTERSECTION_ll (IIU_ll-KRIMX,1,IIU_ll,IJU_ll, &
IIBINT,IJBINT,IIEINT,IJEINT,"EXTE",IINFO_ll)
IF ( IINFO_ll == 0 ) THEN
ZWORK(IIBINT:IIE+1,:,:) = PLBXVM(IDIMLB-(IIE+1-IIBINT):IDIMLB,:,:)
END IF
ENDIF
!
IDIMLB = SIZE(PLBYVM,2)
IF ( IDIMLB /= 0) THEN
CALL GET_INTERSECTION_ll (1,1,IIU_ll,KRIMY+2, &
IIBINT,IJBINT,IIEINT,IJEINT,"EXTE",IINFO_ll)
IF ( IINFO_ll == 0 ) THEN
ZWORK(:,2:IJEINT,:) = PLBYVM(:,1:IJEINT-1,:)
END IF
CALL GET_INTERSECTION_ll (1,IJU_ll-KRIMY,IIU_ll,IJU_ll, &
IIBINT,IJBINT,IIEINT,IJEINT,"EXTE",IINFO_ll)
IF ( IINFO_ll == 0 ) THEN
ZWORK(:,IJBINT:IJE+1,:) = PLBYVM(:,IDIMLB-(IJE+1-IJBINT):IDIMLB,:)
END IF
ENDIF
!
WHERE (GMASK3D_RELAX)
PRVS(:,:,:) = PRVS(:,:,:) - ZKHV(:,:,:)*(PVT(:,:,:)-ZWORK(:,:,:)) &
* ZRHODJV(:,:,:)
END WHERE
!
IF (SIZE(PLBXWM,1) > 0) CALL EXPAND_LBX (PLBXWM,ZWORK)
IF (SIZE(PLBYWM,2) > 0) CALL EXPAND_LBY (PLBYWM,ZWORK)
!
WHERE (GMASK3D_RELAX)
PRWS(:,:,:) = PRWS(:,:,:) - ZKHW(:,:,:)*(PWT(:,:,:)-ZWORK(:,:,:)) &
* ZRHODJW(:,:,:)
END WHERE
!
!
IF (SIZE(PLBXTHM,1) > 0) CALL EXPAND_LBX (PLBXTHM,ZWORK)
IF (SIZE(PLBYTHM,2) > 0) CALL EXPAND_LBY (PLBYTHM,ZWORK)
!
WHERE (GMASK3D_RELAX)
PRTHS(:,:,:) = PRTHS(:,:,:) - ZKHW(:,:,:)*(PTHT(:,:,:)-ZWORK(:,:,:)) &
* PRHODJ(:,:,:)
END WHERE
END IF
!
DO JRR = 1,KRR
IF ( GHORELAXR(JRR) ) THEN
IF (SIZE(PLBXRM,1) > 0) CALL EXPAND_LBX (PLBXRM(:,:,:,JRR),ZWORK)
IF (SIZE(PLBYRM,2) > 0) CALL EXPAND_LBY (PLBYRM(:,:,:,JRR),ZWORK)
WHERE (GMASK3D_RELAX)
PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) - ZKHW(:,:,:)*(PRT(:,:,:,JRR)-ZWORK(:,:,:)) &
* PRHODJ(:,:,:)
END WHERE
END IF
END DO
!
IF ( OHORELAX_TKE ) THEN
IF (SIZE(PLBXTKEM,1) > 0) CALL EXPAND_LBX (PLBXTKEM,ZWORK)
IF (SIZE(PLBYTKEM,2) > 0) CALL EXPAND_LBY (PLBYTKEM,ZWORK)
WHERE (GMASK3D_RELAX)
PRTKES(:,:,:) = PRTKES(:,:,:) - ZKHW(:,:,:)*(PTKET(:,:,:)-ZWORK(:,:,:)) &
* PRHODJ(:,:,:)
END WHERE
END IF
!
DO JSV=1,KSV
IF ( .NOT. LRELAX2FW_ION .OR. (JSV .NE. NSV_ELECBEG .AND. JSV .NE. NSV_ELECEND)) THEN
IF ( OHORELAX_SV(JSV) ) THEN
IF (SIZE(PLBXSVM,1) > 0) CALL EXPAND_LBX (PLBXSVM(:,:,:,JSV),ZWORK)
IF (SIZE(PLBYSVM,2) > 0) CALL EXPAND_LBY (PLBYSVM(:,:,:,JSV),ZWORK)
WHERE (GMASK3D_RELAX)
PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) - ZKHW(:,:,:)*(PSVT(:,:,:,JSV)-ZWORK(:,:,:)) &
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
* PRHODJ(:,:,:)
END WHERE
END IF
END IF
END DO
!
!
!-------------------------------------------------------------------------------
!
!* 3. STORES FIELDS IN BUDGET ARRAYS
! ------------------------------
!
IF (LBUDGET_U) CALL BUDGET (PRUS,1,'REL_BU_RU')
IF (LBUDGET_V) CALL BUDGET (PRVS,2,'REL_BU_RV')
IF (LBUDGET_W) CALL BUDGET (PRWS,3,'REL_BU_RW')
IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'REL_BU_RTH')
IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'REL_BU_RTKE')
IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6,'REL_BU_RRV')
IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7,'REL_BU_RRC')
IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8,'REL_BU_RRR')
IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9,'REL_BU_RRI')
IF (LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,5),10,'REL_BU_RRS')
IF (LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,6),11,'REL_BU_RRG')
IF (LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),12,'REL_BU_RRH')
IF (LBUDGET_SV) THEN
DO JSV=1,KSV
CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'REL_BU_RSV')
END DO
END IF
!
CONTAINS
! ######################################
SUBROUTINE EXPAND_LB (PLBX,PLBY,PWORK)
! ######################################
!
!!**** *EXPAND_LB * - internal routine to expand the lateral boundarie
!! (non horizontal velocity) fields in a complete 3D array
!! AUTHOR
!! ------
!! P. Jabouille * * Meteo France *
!!
!! MODIFICATIONS
!! -------------
!! Original 14/09/98
!
IMPLICIT NONE
!
!* 0.1 Declarations of arguments :
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBX,PLBY !Lateral boundarie fields
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PWORK !work array used to
!expand the LB fields
IDIMLB = SIZE(PLBX,1)
IF ( IDIMLB /= 0) THEN
CALL GET_INTERSECTION_ll (1,1,KRIMX+1,IJU_ll, &
IIBINT,IJBINT,IIEINT,IJEINT,"EXTE",IINFO_ll)
IF ( IINFO_ll == 0 ) THEN
PWORK(1:IIEINT,:,:) = PLBX(1:IIEINT,:,:)
END IF
CALL GET_INTERSECTION_ll (IIU_ll-KRIMX,1,IIU_ll,IJU_ll, &
IIBINT,IJBINT,IIEINT,IJEINT,"EXTE",IINFO_ll)
IF ( IINFO_ll == 0 ) THEN
PWORK(IIBINT:IIE+1,:,:) = PLBX(IDIMLB-(IIE+1-IIBINT):IDIMLB,:,:)
END IF
ENDIF
!
IDIMLB = SIZE(PLBY,2)
IF ( IDIMLB /= 0) THEN
CALL GET_INTERSECTION_ll (1,1,IIU_ll,KRIMY+1 ,&
IIBINT,IJBINT,IIEINT,IJEINT,"EXTE",IINFO_ll)
IF ( IINFO_ll == 0 ) THEN
PWORK(:,1:IJEINT,:) = PLBY(:,1:IJEINT,:)
END IF
CALL GET_INTERSECTION_ll (1,IJU_ll-KRIMY,IIU_ll,IJU_ll, &
IIBINT,IJBINT,IIEINT,IJEINT,"EXTE",IINFO_ll)
IF ( IINFO_ll == 0 ) THEN
PWORK(:,IJBINT:IJE+1,:) = PLBY(:,IDIMLB-(IJE+1-IJBINT):IDIMLB,:)
END IF
END IF
END SUBROUTINE EXPAND_LB
!
! ######################################
SUBROUTINE EXPAND_LBX (PLBX,PWORK)
! ######################################
!
!!**** *EXPAND_LB * - internal routine to expand the lateral boundarie
!! (non horizontal velocity) fields in a complete 3D array
!! AUTHOR
!! ------
!! P. Jabouille * * Meteo France *
!!
!! MODIFICATIONS
!! -------------
!! Original 14/09/98
!! P. Tulet 06/08/07 - split X and Y LB
!
IMPLICIT NONE
!
!* 0.1 Declarations of arguments :
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBX !Lateral boundarie fields
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PWORK !work array used to
!expand the LB fields
IDIMLB = SIZE(PLBX,1)
IF ( IDIMLB /= 0) THEN
CALL GET_INTERSECTION_ll (1,1,KRIMX+1,IJU_ll, &
IIBINT,IJBINT,IIEINT,IJEINT,"EXTE",IINFO_ll)
IF ( IINFO_ll == 0 ) THEN
PWORK(1:IIEINT,:,:) = PLBX(1:IIEINT,:,:)
END IF
CALL GET_INTERSECTION_ll (IIU_ll-KRIMX,1,IIU_ll,IJU_ll, &
IIBINT,IJBINT,IIEINT,IJEINT,"EXTE",IINFO_ll)
IF ( IINFO_ll == 0 ) THEN
PWORK(IIBINT:IIE+1,:,:) = PLBX(IDIMLB-(IIE+1-IIBINT):IDIMLB,:,:)
END IF
ENDIF
!
END SUBROUTINE EXPAND_LBX
!
! ######################################
SUBROUTINE EXPAND_LBY (PLBY,PWORK)
! ######################################
!
!!**** *EXPAND_LB * - internal routine to expand the lateral boundarie
!! (non horizontal velocity) fields in a complete 3D array
!! AUTHOR
!! ------
!! P. Jabouille * * Meteo France *
!!
!! MODIFICATIONS
!! -------------
!! Original 14/09/98
!! P. Tulet 06/09/07 - split X and Y LB
!
IMPLICIT NONE
!
!* 0.1 Declarations of arguments :
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBY !Lateral boundarie fields
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PWORK !work array used to
!expand the LB fields
IDIMLB = SIZE(PLBY,2)
IF ( IDIMLB /= 0) THEN
CALL GET_INTERSECTION_ll (1,1,IIU_ll,KRIMY+1 ,&
IIBINT,IJBINT,IIEINT,IJEINT,"EXTE",IINFO_ll)
IF ( IINFO_ll == 0 ) THEN
PWORK(:,1:IJEINT,:) = PLBY(:,1:IJEINT,:)
END IF
CALL GET_INTERSECTION_ll (1,IJU_ll-KRIMY,IIU_ll,IJU_ll, &
IIBINT,IJBINT,IIEINT,IJEINT,"EXTE",IINFO_ll)
IF ( IINFO_ll == 0 ) THEN
PWORK(:,IJBINT:IJE+1,:) = PLBY(:,IDIMLB-(IJE+1-IJBINT):IDIMLB,:)
END IF
END IF
END SUBROUTINE EXPAND_LBY
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE RELAXATION