source: LMDZ6/branches/Amaury_dev/libf/phylmd/acama_gwd_rando_m.F90 @ 5143

Last change on this file since 5143 was 5143, checked in by abarral, 3 months ago

Put YOEGWD.h, FCTTRE.h into modules

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