source: LMDZ6/trunk/libf/phylmd/acama_gwd_rando_m.F90 @ 3324

Last change on this file since 3324 was 3198, checked in by fhourdin, 7 years ago

Retour vers l'insensibilite au decoupage en sous domaine.
Les routines gwd_rando incluait le calcul de niveaux de reference
sur la base d'un profile pris au milieu du domaine (en klon/2).
Rempace par un test en presnivs.

Une autre intercation entre routines concernant la tke a fait apparaitre
que la tke n'était pas passee correctement au niveau klev+1 au moment
du regroupement des mailles sous les sous surface.

Ces changements garantissent la convergence numerique si
addtkeoro=0
iflag_pbl<12
et
ok_gwd_rando=n
La convergence n'est pas garantie pour les dernieres versions des physiq.def
mais les differences devraient etre mineures.

File size: 18.6 KB
RevLine 
[2333]1module ACAMA_GWD_rando_m
2
3  implicit none
4
5contains
6
7  SUBROUTINE ACAMA_GWD_rando(DTIME, pp, plat, tt, uu, vv, rot, &
8       zustr, zvstr, d_u, d_v,east_gwstress,west_gwstress)
9
10    ! Parametrization of the momentum flux deposition due to a discrete
11    ! number of gravity waves.
12    ! Author: F. Lott, A. de la Camara
13    ! July, 24th, 2014
14    ! Gaussian distribution of the source, source is vorticity squared
15    ! Reference: de la Camara and Lott (GRL, 2015, vol 42, 2071-2078 )
16    ! Lott et al (JAS, 2010, vol 67, page 157-170)
17    ! Lott et al (JAS, 2012, vol 69, page 2134-2151)
18
19!  ONLINE:
20    use dimphy, only: klon, klev
21    use assert_m, only: assert
[3198]22    USE ioipsl_getin_p_mod, ONLY : getin_p
23    USE vertical_layers_mod, ONLY : presnivs
24
[2333]25    include "YOMCST.h"
26    include "clesphys.h"
27!  OFFLINE:
28!   include "dimensions.h"
29!   include "dimphy.h"
30!END DIFFERENCE
31    include "YOEGWD.h"
32
33    ! 0. DECLARATIONS:
34
35    ! 0.1 INPUTS
36    REAL, intent(in)::DTIME ! Time step of the Physics
37    REAL, intent(in):: PP(:, :) ! (KLON, KLEV) Pressure at full levels
38    REAL, intent(in):: ROT(:,:) ! Relative vorticity             
39    REAL, intent(in):: TT(:, :) ! (KLON, KLEV) Temp at full levels
40    REAL, intent(in):: UU(:, :) ! (KLON, KLEV) Zonal wind at full levels
41    REAL, intent(in):: VV(:, :) ! (KLON, KLEV) Merid wind at full levels
42    REAL, intent(in):: PLAT(:) ! (KLON) LATITUDE                   
43
44    ! 0.2 OUTPUTS
45    REAL, intent(out):: zustr(:), zvstr(:) ! (KLON) Surface Stresses
46
47    REAL, intent(inout):: d_u(:, :), d_v(:, :)
48    REAL, intent(inout):: east_gwstress(:, :) !  Profile of eastward stress
49    REAL, intent(inout):: west_gwstress(:, :) !  Profile of westward stress
50    ! (KLON, KLEV) tendencies on winds
51
52    ! O.3 INTERNAL ARRAYS
53    REAL BVLOW(klon)  !  LOW LEVEL BV FREQUENCY
54    REAL ROTBA(KLON),CORIO(KLON)  !  BAROTROPIC REL. VORTICITY AND PLANETARY
55    REAL UZ(KLON, KLEV + 1)
56
57    INTEGER II, JJ, LL
58
59    ! 0.3.0 TIME SCALE OF THE LIFE CYCLE OF THE WAVES PARAMETERIZED
60
61    REAL DELTAT
62
63    ! 0.3.1 GRAVITY-WAVES SPECIFICATIONS
64
65    INTEGER, PARAMETER:: NK = 2, NP = 2, NO = 2, NW = NK * NP * NO
66    INTEGER JK, JP, JO, JW
67    INTEGER, PARAMETER:: NA = 5  !number of realizations to get the phase speed
68    REAL KMIN, KMAX ! Min and Max horizontal wavenumbers
69    REAL CMIN, CMAX ! Min and Max absolute ph. vel.
70    REAL CPHA ! absolute PHASE VELOCITY frequency
71    REAL ZK(NW, KLON) ! Horizontal wavenumber amplitude
72    REAL ZP(NW, KLON) ! Horizontal wavenumber angle
73    REAL ZO(NW, KLON) ! Absolute frequency !
74
75    ! Waves Intr. freq. at the 1/2 lev surrounding the full level
76    REAL ZOM(NW, KLON), ZOP(NW, KLON)
77
78    ! Wave EP-fluxes at the 2 semi levels surrounding the full level
79    REAL WWM(NW, KLON), WWP(NW, KLON)
80
81    REAL RUW0(NW, KLON) ! Fluxes at launching level
82
83    REAL RUWP(NW, KLON), RVWP(NW, KLON)
84    ! Fluxes X and Y for each waves at 1/2 Levels
85
86    INTEGER LAUNCH, LTROP ! Launching altitude and tropo altitude
87
88    REAL XLAUNCH ! Controle the launching altitude
89    REAL XTROP ! SORT of Tropopause altitude
90    REAL RUW(KLON, KLEV + 1) ! Flux x at semi levels
91    REAL RVW(KLON, KLEV + 1) ! Flux y at semi levels
92
93    REAL PRMAX ! Maximum value of PREC, and for which our linear formula
94    ! for GWs parameterisation apply
95
96    ! 0.3.2 PARAMETERS OF WAVES DISSIPATIONS
97
98    REAL RDISS, ZOISEC ! COEFF DE DISSIPATION, SECURITY FOR INTRINSIC FREQ
99    REAL CORSEC ! SECURITY FOR INTRINSIC CORIOLIS
100    REAL RUWFRT,SATFRT
101
102    ! 0.3.3 BACKGROUND FLOW AT 1/2 LEVELS AND VERTICAL COORDINATE
103
104    REAL H0 ! Characteristic Height of the atmosphere
105    REAL DZ ! Characteristic depth of the source!
106    REAL PR, TR ! Reference Pressure and Temperature
107
108    REAL ZH(KLON, KLEV + 1) ! Log-pressure altitude
109
110    REAL UH(KLON, KLEV + 1), VH(KLON, KLEV + 1) ! Winds at 1/2 levels
111    REAL PH(KLON, KLEV + 1) ! Pressure at 1/2 levels
112    REAL PSEC ! Security to avoid division by 0 pressure
113    REAL PHM1(KLON, KLEV + 1) ! 1/Press at 1/2 levels
114    REAL BV(KLON, KLEV + 1) ! Brunt Vaisala freq. (BVF) at 1/2 levels
115    REAL BVSEC ! Security to avoid negative BVF
116
[3198]117    REAL, DIMENSION(klev+1) ::HREF
118    LOGICAL, SAVE :: gwd_reproductibilite_mpiomp=.true.
119    LOGICAL, SAVE :: firstcall = .TRUE.
120  !$OMP THREADPRIVATE(firstcall,gwd_reproductibilite_mpiomp)
121
122    CHARACTER (LEN=20) :: modname='flott_gwd_rando'
123    CHARACTER (LEN=80) :: abort_message
124
125
126
127  IF (firstcall) THEN
128    ! Cle introduite pour resoudre un probleme de non reproductibilite
129    ! Le but est de pouvoir tester de revenir a la version precedenete
130    ! A eliminer rapidement
131    CALL getin_p('gwd_reproductibilite_mpiomp',gwd_reproductibilite_mpiomp)
132    IF (NW+4*(NA-1)+NA>=KLEV) THEN
133       abort_message = 'NW+3*NA>=KLEV Probleme pour generation des ondes'
134       CALL abort_physic (modname,abort_message,1)
135    ENDIF
136    firstcall=.false.
137!    CALL iophys_ini
138  ENDIF
139
[2333]140    !-----------------------------------------------------------------
141
142    ! 1. INITIALISATIONS
143
144    ! 1.1 Basic parameter
145
146    ! Are provided from elsewhere (latent heat of vaporization, dry
147    ! gaz constant for air, gravity constant, heat capacity of dry air
148    ! at constant pressure, earth rotation rate, pi).
149
150    ! 1.2 Tuning parameters of V14
151
152! Values for linear in rot (recommended):
153!   RUWFRT=0.005 ! As RUWMAX but for frontal waves
154!   SATFRT=1.00  ! As SAT    but for frontal waves
155! Values when rot^2 is used                         
156!    RUWFRT=0.02  ! As RUWMAX but for frontal waves
157!    SATFRT=1.00  ! As SAT    but for frontal waves
158!    CMAX = 30.   ! Characteristic phase speed
159! Values when rot^2*EXP(-pi*sqrt(J)) is used                         
[2357]160!   RUWFRT=2.5   ! As RUWMAX but for frontal waves ~ N0*F0/4*DZ
161!   SATFRT=0.60   ! As SAT    but for frontal waves
162    RUWFRT=gwd_front_ruwmax 
163    SATFRT=gwd_front_sat
[2665]164    CMAX = 50.    ! Characteristic phase speed
[2333]165! Phase speed test
166!   RUWFRT=0.01
167!   CMAX = 50.   ! Characteristic phase speed (TEST)
168! Values when rot^2 and exp(-m^2*dz^2) are used     
169!   RUWFRT=0.03  ! As RUWMAX but for frontal waves
170!   SATFRT=1.00  ! As SAT    but for frontal waves
171! CRUCIAL PARAMETERS FOR THE WIND FILTERING
172    XLAUNCH=0.95 ! Parameter that control launching altitude
[2665]173    RDISS = 0.5  ! Diffusion parameter
[2333]174
175    ! maximum of rain for which our theory applies (in kg/m^2/s)
176
177    DZ = 1000. ! Characteristic depth of the source
178    XTROP=0.2 ! Parameter that control tropopause altitude
179    DELTAT=24.*3600. ! Time scale of the waves (first introduced in 9b)
180!   DELTAT=DTIME     ! No AR-1 Accumulation, OR OFFLINE             
181
182    KMIN = 2.E-5
183    ! minimum horizontal wavenumber (inverse of the subgrid scale resolution)
184
185    KMAX = 1.E-3  ! Max horizontal wavenumber
186    CMIN = 1.     ! Min phase velocity
187
188    TR = 240. ! Reference Temperature
189    PR = 101300. ! Reference pressure
190    H0 = RD * TR / RG ! Characteristic vertical scale height
191
192    BVSEC = 5.E-3 ! Security to avoid negative BVF
193    PSEC = 1.E-6 ! Security to avoid division by 0 pressure
194    ZOISEC = 1.E-6 ! Security FOR 0 INTRINSIC FREQ
195    CORSEC = ROMEGA*2.*SIN(2.*RPI/180.)! Security for CORIO
196
197!  ONLINE
198    call assert(klon == (/size(pp, 1), size(tt, 1), size(uu, 1), &
199         size(vv, 1), size(rot,1), size(zustr), size(zvstr), size(d_u, 1), &
200         size(d_v, 1), &
201        size(east_gwstress,1), size(west_gwstress,1) /), &
202        "ACAMA_GWD_RANDO klon")
203    call assert(klev == (/size(pp, 2), size(tt, 2), size(uu, 2), &
204         size(vv, 2), size(d_u, 2), size(d_v, 2), &
205         size(east_gwstress,2), size(west_gwstress,2) /), &
206         "ACAMA_GWD_RANDO klev")
207!  END ONLINE
208
209    IF(DELTAT < DTIME)THEN
210       PRINT *, 'flott_gwd_rando: deltat < dtime!'
211       STOP 1
212    ENDIF
213
214    IF (KLEV < NW) THEN
215       PRINT *, 'flott_gwd_rando: you will have problem with random numbers'
216       STOP 1
217    ENDIF
218
219    ! 2. EVALUATION OF THE BACKGROUND FLOW AT SEMI-LEVELS
220
221    ! Pressure and Inv of pressure
222    DO LL = 2, KLEV
223       PH(:, LL) = EXP((LOG(PP(:, LL)) + LOG(PP(:, LL - 1))) / 2.)
224       PHM1(:, LL) = 1. / PH(:, LL)
225    end DO
226
227    PH(:, KLEV + 1) = 0.
228    PHM1(:, KLEV + 1) = 1. / PSEC
229    PH(:, 1) = 2. * PP(:, 1) - PH(:, 2)
230
231    ! Launching altitude
232
[3198]233    IF (gwd_reproductibilite_mpiomp) THEN
234       ! Reprend la formule qui calcule PH en fonction de PP=play
235       DO LL = 2, KLEV
236          HREF(LL) = EXP((LOG(presnivs(LL)) + LOG(presnivs(LL - 1))) / 2.)
237       end DO
238       HREF(KLEV + 1) = 0.
239       HREF(1) = 2. * presnivs(1) - HREF(2)
240    ELSE
241       HREF(1:KLEV)=PH(KLON/2,1:KLEV)
242    ENDIF
243
[2333]244    LAUNCH=0
245    LTROP =0
246    DO LL = 1, KLEV
[3198]247       IF (HREF(LL) / HREF(1) > XLAUNCH) LAUNCH = LL
[2333]248    ENDDO
249    DO LL = 1, KLEV
[3198]250       IF (HREF(LL) / HREF(1) > XTROP) LTROP = LL
[2333]251    ENDDO
[3198]252    !LAUNCH=22 ; LTROP=33
253!   print*,'LAUNCH=',LAUNCH,'LTROP=',LTROP
[2333]254
[3198]255
[2333]256!   PRINT *,'LAUNCH IN ACAMARA:',LAUNCH
257
258    ! Log pressure vert. coordinate
259    DO LL = 1, KLEV + 1
260       ZH(:, LL) = H0 * LOG(PR / (PH(:, LL) + PSEC))
261    end DO
262
263    ! BV frequency
264    DO LL = 2, KLEV
265       ! BVSEC: BV Frequency (UH USED IS AS A TEMPORARY ARRAY DOWN TO WINDS)
266       UH(:, LL) = 0.5 * (TT(:, LL) + TT(:, LL - 1)) &
267            * RD**2 / RCPD / H0**2 + (TT(:, LL) &
268            - TT(:, LL - 1)) / (ZH(:, LL) - ZH(:, LL - 1)) * RD / H0
269    end DO
270    BVLOW = 0.5 * (TT(:, LTROP )+ TT(:, LAUNCH)) &
271         * RD**2 / RCPD / H0**2 + (TT(:, LTROP ) &
272         - TT(:, LAUNCH))/(ZH(:, LTROP )- ZH(:, LAUNCH)) * RD / H0
273
274    UH(:, 1) = UH(:, 2)
275    UH(:, KLEV + 1) = UH(:, KLEV)
276    BV(:, 1) = UH(:, 2)
277    BV(:, KLEV + 1) = UH(:, KLEV)
278    ! SMOOTHING THE BV HELPS
279    DO LL = 2, KLEV
280       BV(:, LL)=(UH(:, LL+1)+2.*UH(:, LL)+UH(:, LL-1))/4.
281    end DO
282
283    BV=MAX(SQRT(MAX(BV, 0.)), BVSEC)
284    BVLOW=MAX(SQRT(MAX(BVLOW, 0.)), BVSEC)
285
286    ! WINDS
287    DO LL = 2, KLEV
288       UH(:, LL) = 0.5 * (UU(:, LL) + UU(:, LL - 1)) ! Zonal wind
289       VH(:, LL) = 0.5 * (VV(:, LL) + VV(:, LL - 1)) ! Meridional wind
290       UZ(:, LL) = ABS((SQRT(UU(:, LL)**2+VV(:, LL)**2) &
291          - SQRT(UU(:,LL-1)**2+VV(:, LL-1)**2)) &
292          /(ZH(:, LL)-ZH(:, LL-1)) )
293    end DO
294    UH(:, 1) = 0.
295    VH(:, 1) = 0.
296    UH(:, KLEV + 1) = UU(:, KLEV)
297    VH(:, KLEV + 1) = VV(:, KLEV)
298
299    UZ(:, 1) = UZ(:, 2)
300    UZ(:, KLEV + 1) = UZ(:, KLEV)
301    UZ(:, :) = MAX(UZ(:,:), PSEC)
302
303   ! BAROTROPIC VORTICITY AND INTEGRATED CORIOLIS PARAMETER
304   
305    CORIO(:) = MAX(ROMEGA*2.*ABS(SIN(PLAT(:)*RPI/180.)),CORSEC)
306    ROTBA(:)=0.
307    DO LL = 1,KLEV-1
308        !ROTBA(:) = ROTBA(:) + (ROT(:,LL)+ROT(:,LL+1))/2./RG*(PP(:,LL)-PP(:,LL+1))
309        ! Introducing the complete formula (exp of Richardson number):
310        ROTBA(:) = ROTBA(:) + &
311                !((ROT(:,LL)+ROT(:,LL+1))/2.)**2 &
312                (CORIO(:)*TANH(ABS(ROT(:,LL)+ROT(:,LL+1))/2./CORIO(:)))**2 &
313                /RG*(PP(:,LL)-PP(:,LL+1)) &
314                * EXP(-RPI*BV(:,LL+1)/UZ(:,LL+1)) &
315!               * DZ*BV(:,LL+1)/4./ABS(CORIO(:))
316                * DZ*BV(:,LL+1)/4./1.E-4           !  Changes after 1991
317!ARRET
318    ENDDO
319    !   PRINT *,'MAX ROTBA:',MAXVAL(ROTBA)
320    !   ROTBA(:)=(1.*ROTBA(:)  & ! Testing zone
321    !           +0.15*CORIO(:)**2                &
322    !           /(COS(PLAT(:)*RPI/180.)+0.02)  &
323    !           )*DZ*0.01/0.0001/4. ! & ! Testing zone
324    !   MODIF GWD4 AFTER 1985
325    !            *(1.25+SIN(PLAT(:)*RPI/180.))/(1.05+SIN(PLAT(:)*RPI/180.))/1.25
326    !          *1./(COS(PLAT(:)*RPI/180.)+0.02)
327    !    CORIO(:) = MAX(ROMEGA*2.*ABS(SIN(PLAT(:)*RPI/180.)),ZOISEC)/RG*PP(:,1)
328
329    ! 3 WAVES CHARACTERISTICS CHOSEN RANDOMLY AT THE LAUNCH ALTITUDE
330
331    ! The mod functions of weird arguments are used to produce the
332    ! waves characteristics in an almost stochastic way
333
334    JW = 0
[3198]335    DO JW = 1, NW
[2333]336             ! Angle
337             DO II = 1, KLON
338                ! Angle (0 or PI so far)
339                ! ZP(JW, II) = (SIGN(1., 0.5 - MOD(TT(II, JW) * 10., 1.)) + 1.) &
340                !      * RPI / 2.
341                ! Angle between 0 and pi
342                  ZP(JW, II) = MOD(TT(II, JW) * 10., 1.) * RPI
343! TEST WITH POSITIVE WAVES ONLY (Part I/II)
344!               ZP(JW, II) = 0.
345                ! Horizontal wavenumber amplitude
346                ZK(JW, II) = KMIN + (KMAX - KMIN) * MOD(TT(II, JW) * 100., 1.)
347                ! Horizontal phase speed
348                CPHA = 0.
349                DO JJ = 1, NA
350                    CPHA = CPHA + &
351         CMAX*2.*(MOD(TT(II, JW+4*(JJ-1)+JJ)**2, 1.)-0.5)*SQRT(3.)/SQRT(NA*1.)
352                END DO
353                IF (CPHA.LT.0.)  THEN
354                   CPHA = -1.*CPHA
355                   ZP(JW,II) = ZP(JW,II) + RPI
356! TEST WITH POSITIVE WAVES ONLY (Part II/II)
357!               ZP(JW, II) = 0.
358                ENDIF
359                CPHA = CPHA + CMIN !we dont allow |c|<1m/s
360                ! Absolute frequency is imposed
361                ZO(JW, II) = CPHA * ZK(JW, II)
362                ! Intrinsic frequency is imposed
363                ZO(JW, II) = ZO(JW, II) &
364                     + ZK(JW, II) * COS(ZP(JW, II)) * UH(II, LAUNCH) &
365                     + ZK(JW, II) * SIN(ZP(JW, II)) * VH(II, LAUNCH)
366                ! Momentum flux at launch lev
367                ! LAUNCHED RANDOM WAVES WITH LOG-NORMAL AMPLITUDE
368                !  RIGHT IN THE SH (GWD4 after 1990)
369                  RUW0(JW, II) = 0.
370                 DO JJ = 1, NA
371                    RUW0(JW, II) = RUW0(JW,II) + &
372         2.*(MOD(TT(II, JW+4*(JJ-1)+JJ)**2, 1.)-0.5)*SQRT(3.)/SQRT(NA*1.)
373                END DO
374                RUW0(JW, II) = RUWFRT &
375                          * EXP(RUW0(JW,II))/1250. &  ! 2 mpa at south pole
376       *((1.05+SIN(PLAT(II)*RPI/180.))/(1.01+SIN(PLAT(II)*RPI/180.))-2.05/2.01)
377                ! RUW0(JW, II) = RUWFRT
378             ENDDO
379    end DO
380
381    ! 4. COMPUTE THE FLUXES
382
383    ! 4.0
384
385    ! 4.1 Vertical velocity at launching altitude to ensure
386    ! the correct value to the imposed fluxes.
387
388    DO JW = 1, NW
389
390       ! Evaluate intrinsic frequency at launching altitude:
391       ZOP(JW, :) = ZO(JW, :) &
392            - ZK(JW, :) * COS(ZP(JW, :)) * UH(:, LAUNCH) &
393            - ZK(JW, :) * SIN(ZP(JW, :)) * VH(:, LAUNCH)
394
395       ! VERSION WITH FRONTAL SOURCES
396
397       ! Momentum flux at launch level imposed by vorticity sources
398
399       ! tanh limitation for values above CORIO (inertial instability).
400       ! WWP(JW, :) = RUW0(JW, :) &
401       WWP(JW, :) = RUWFRT      &
402       !     * (CORIO(:)*TANH(ROTBA(:)/CORIO(:)))**2 &
403       !    * ABS((CORIO(:)*TANH(ROTBA(:)/CORIO(:)))*CORIO(:)) &
404       !  CONSTANT FLUX
405       !    * (CORIO(:)*CORIO(:)) &
406       ! MODERATION BY THE DEPTH OF THE SOURCE (DZ HERE)
407       !      *EXP(-BVLOW(:)**2/MAX(ABS(ZOP(JW, :)),ZOISEC)**2 &
408       !      *ZK(JW, :)**2*DZ**2) &
409       ! COMPLETE FORMULA:
410            !* CORIO(:)**2*TANH(ROTBA(:)/CORIO(:)**2) &
411            * ROTBA(:) &
412       !  RESTORE DIMENSION OF A FLUX
413       !     *RD*TR/PR
[2665]414       !     *1. + RUW0(JW, :)
415             *1.
[2333]416
417       ! Factor related to the characteristics of the waves: NONE
418
419       ! Moderation by the depth of the source (dz here): NONE
420
421       ! Put the stress in the right direction:
422
423        RUWP(JW, :) = SIGN(1., ZOP(JW, :))*COS(ZP(JW, :)) * WWP(JW, :)
424        RVWP(JW, :) = SIGN(1., ZOP(JW, :))*SIN(ZP(JW, :)) * WWP(JW, :)
425
426    end DO
427
428    ! 4.2 Uniform values below the launching altitude
429
430    DO LL = 1, LAUNCH
431       RUW(:, LL) = 0
432       RVW(:, LL) = 0
433       DO JW = 1, NW
434          RUW(:, LL) = RUW(:, LL) + RUWP(JW, :)
435          RVW(:, LL) = RVW(:, LL) + RVWP(JW, :)
436       end DO
437    end DO
438
439    ! 4.3 Loop over altitudes, with passage from one level to the next
440    ! done by i) conserving the EP flux, ii) dissipating a little,
441    ! iii) testing critical levels, and vi) testing the breaking.
442
443    DO LL = LAUNCH, KLEV - 1
444       ! Warning: all the physics is here (passage from one level
445       ! to the next)
446       DO JW = 1, NW
447          ZOM(JW, :) = ZOP(JW, :)
448          WWM(JW, :) = WWP(JW, :)
449          ! Intrinsic Frequency
450          ZOP(JW, :) = ZO(JW, :) - ZK(JW, :) * COS(ZP(JW, :)) * UH(:, LL + 1) &
451               - ZK(JW, :) * SIN(ZP(JW, :)) * VH(:, LL + 1)
452
453          ! No breaking (Eq.6)
454          ! Dissipation (Eq. 8)
[2665]455          WWP(JW, :) = WWM(JW, :) * EXP(- 4. * RDISS * PR / (PH(:, LL + 1) &
[2333]456               + PH(:, LL)) * ((BV(:, LL + 1) + BV(:, LL)) / 2.)**3 &
457               / MAX(ABS(ZOP(JW, :) + ZOM(JW, :)) / 2., ZOISEC)**4 &
458               * ZK(JW, :)**3 * (ZH(:, LL + 1) - ZH(:, LL)))
459
460          ! Critical levels (forced to zero if intrinsic frequency changes sign)
461          ! Saturation (Eq. 12)
462          WWP(JW, :) = min(WWP(JW, :), MAX(0., &
463               SIGN(1., ZOP(JW, :) * ZOM(JW, :))) * ABS(ZOP(JW, :))**3 &
464          !    / BV(:, LL + 1) * EXP(- ZH(:, LL + 1) / H0) * SATFRT**2 * KMIN**2 &
465               / BV(:, LL + 1) * EXP(- ZH(:, LL + 1) / H0) * KMIN**2 &
466!              *(SATFRT*(2.5+1.5*TANH((ZH(:,LL+1)/H0-8.)/2.)))**2 &
467               *SATFRT**2       &
468               / ZK(JW, :)**4)
469       end DO
470
471       ! Evaluate EP-flux from Eq. 7 and give the right orientation to
472       ! the stress
473
474       DO JW = 1, NW
475          RUWP(JW, :) = SIGN(1., ZOP(JW, :))*COS(ZP(JW, :)) * WWP(JW, :)
476          RVWP(JW, :) = SIGN(1., ZOP(JW, :))*SIN(ZP(JW, :)) * WWP(JW, :)
477       end DO
478
479       RUW(:, LL + 1) = 0.
480       RVW(:, LL + 1) = 0.
481
482       DO JW = 1, NW
483          RUW(:, LL + 1) = RUW(:, LL + 1) + RUWP(JW, :)
484          RVW(:, LL + 1) = RVW(:, LL + 1) + RVWP(JW, :)
485          EAST_GWSTRESS(:, LL)=EAST_GWSTRESS(:, LL)+MAX(0.,RUWP(JW,:))/FLOAT(NW)
486          WEST_GWSTRESS(:, LL)=WEST_GWSTRESS(:, LL)+MIN(0.,RUWP(JW,:))/FLOAT(NW)
487       end DO
488    end DO
489
490    ! 5 CALCUL DES TENDANCES:
491
492    ! 5.1 Rectification des flux au sommet et dans les basses couches
493
494    RUW(:, KLEV + 1) = 0.
495    RVW(:, KLEV + 1) = 0.
496    RUW(:, 1) = RUW(:, LAUNCH)
497    RVW(:, 1) = RVW(:, LAUNCH)
498    DO LL = 1, LAUNCH
499       RUW(:, LL) = RUW(:, LAUNCH+1)
500       RVW(:, LL) = RVW(:, LAUNCH+1)
501       EAST_GWSTRESS(:, LL)=EAST_GWSTRESS(:, LAUNCH)
502       WEST_GWSTRESS(:, LL)=WEST_GWSTRESS(:, LAUNCH)
503    end DO
504
505    ! AR-1 RECURSIVE FORMULA (13) IN VERSION 4
506    DO LL = 1, KLEV
507       D_U(:, LL) = (1.-DTIME/DELTAT) * D_U(:, LL) + DTIME/DELTAT/REAL(NW) * &
508            RG * (RUW(:, LL + 1) - RUW(:, LL)) &
509            / (PH(:, LL + 1) - PH(:, LL)) * DTIME
510!  NO AR1 FOR MERIDIONAL TENDENCIES
511!      D_V(:, LL) = (1.-DTIME/DELTAT) * D_V(:, LL) + DTIME/DELTAT/REAL(NW) * &
512       D_V(:, LL) =                                            1./REAL(NW) * &
513            RG * (RVW(:, LL + 1) - RVW(:, LL)) &
514            / (PH(:, LL + 1) - PH(:, LL)) * DTIME
515    ENDDO
516
517    ! Cosmetic: evaluation of the cumulated stress
518    ZUSTR = 0.
519    ZVSTR = 0.
520    DO LL = 1, KLEV
521       ZUSTR = ZUSTR + D_U(:, LL) / RG * (PH(:, LL + 1) - PH(:, LL))/DTIME
522!      ZVSTR = ZVSTR + D_V(:, LL) / RG * (PH(:, LL + 1) - PH(:, LL))/DTIME
523    ENDDO
524! COSMETICS TO VISUALIZE ROTBA
525    ZVSTR = ROTBA
526
527  END SUBROUTINE ACAMA_GWD_RANDO
528
529end module ACAMA_GWD_rando_m
Note: See TracBrowser for help on using the repository browser.