Directory: | ./ |
---|---|
File: | dyn3d_common/exner_hyb_m.f90 |
Date: | 2022-01-11 19:19:34 |
Exec | Total | Coverage | |
---|---|---|---|
Lines: | 24 | 24 | 100.0% |
Branches: | 22 | 24 | 91.7% |
Line | Branch | Exec | Source |
---|---|---|---|
1 | module exner_hyb_m | ||
2 | |||
3 | IMPLICIT NONE | ||
4 | |||
5 | contains | ||
6 | |||
7 | 3842 | SUBROUTINE exner_hyb ( ngrid, ps, p, pks, pk, pkf ) | |
8 | |||
9 | ! Auteurs : P.Le Van , Fr. Hourdin . | ||
10 | ! .......... | ||
11 | ! | ||
12 | ! .... ngrid, ps,p sont des argum.d'entree au sous-prog ... | ||
13 | ! .... pks,pk,pkf sont des argum.de sortie au sous-prog ... | ||
14 | ! | ||
15 | ! ************************************************************************ | ||
16 | ! Calcule la fonction d'Exner pk = Cp * (p/preff) ** kappa , aux milieux des | ||
17 | ! couches . Pk(l) sera calcule aux milieux des couches l ,entre les | ||
18 | ! pressions p(l) et p(l+1) ,definis aux interfaces des llm couches . | ||
19 | ! ************************************************************************ | ||
20 | ! .. N.B : Au sommet de l'atmosphere, p(llm+1) = 0. , et ps et pks sont | ||
21 | ! la pression et la fonction d'Exner au sol . | ||
22 | ! | ||
23 | ! -------- z | ||
24 | ! A partir des relations ( 1 ) p*dz(pk) = kappa *pk*dz(p) et | ||
25 | ! ( 2 ) pk(l) = alpha(l)+ beta(l)*pk(l-1) | ||
26 | ! ( voir note de Fr.Hourdin ) , | ||
27 | ! | ||
28 | ! on determine successivement , du haut vers le bas des couches, les | ||
29 | ! coef. alpha(llm),beta(llm) .,.,alpha(l),beta(l),,,alpha(2),beta(2), | ||
30 | ! puis pk(ij,1). Ensuite ,on calcule,du bas vers le haut des couches, | ||
31 | ! pk(ij,l) donne par la relation (2), pour l = 2 a l = llm . | ||
32 | ! | ||
33 | ! | ||
34 | ! | ||
35 | USE comconst_mod, ONLY: jmp1, cpp, kappa, r | ||
36 | USE comvert_mod, ONLY: preff | ||
37 | |||
38 | IMPLICIT NONE | ||
39 | |||
40 | include "dimensions.h" | ||
41 | include "paramet.h" | ||
42 | include "comgeom.h" | ||
43 | |||
44 | INTEGER ngrid | ||
45 | REAL p(ngrid,llmp1),pk(ngrid,llm) | ||
46 | real, optional:: pkf(ngrid,llm) | ||
47 | 7684 | REAL ps(ngrid),pks(ngrid), alpha(ngrid,llm),beta(ngrid,llm) | |
48 | |||
49 | ! .... variables locales ... | ||
50 | |||
51 | INTEGER l, ij | ||
52 | REAL unpl2k,dellta | ||
53 | |||
54 | logical,save :: firstcall=.true. | ||
55 | character(len=*),parameter :: modname="exner_hyb" | ||
56 | |||
57 | ! Sanity check | ||
58 |
2/2✓ Branch 0 taken 1 times.
✓ Branch 1 taken 3841 times.
|
3842 | if (firstcall) then |
59 | ! sanity checks for Shallow Water case (1 vertical layer) | ||
60 | if (llm.eq.1) then | ||
61 | if (kappa.ne.1) then | ||
62 | call abort_gcm(modname, & | ||
63 | "kappa!=1 , but running in Shallow Water mode!!",42) | ||
64 | endif | ||
65 | if (cpp.ne.r) then | ||
66 | call abort_gcm(modname, & | ||
67 | "cpp!=r , but running in Shallow Water mode!!",42) | ||
68 | endif | ||
69 | endif ! of if (llm.eq.1) | ||
70 | |||
71 | 1 | firstcall=.false. | |
72 | endif ! of if (firstcall) | ||
73 | |||
74 | ! Specific behaviour for Shallow Water (1 vertical layer) case: | ||
75 | if (llm.eq.1) then | ||
76 | |||
77 | ! Compute pks(:),pk(:),pkf(:) | ||
78 | |||
79 | DO ij = 1, ngrid | ||
80 | pks(ij) = (cpp/preff) * ps(ij) | ||
81 | pk(ij,1) = .5*pks(ij) | ||
82 | ENDDO | ||
83 | |||
84 | if (present(pkf)) then | ||
85 | pkf = pk | ||
86 | CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 ) | ||
87 | end if | ||
88 | |||
89 | ! our work is done, exit routine | ||
90 | return | ||
91 | endif ! of if (llm.eq.1) | ||
92 | |||
93 | ! General case: | ||
94 | |||
95 | 3842 | unpl2k = 1.+ 2.* kappa | |
96 | |||
97 | ! ------------- | ||
98 | ! Calcul de pks | ||
99 | ! ------------- | ||
100 | |||
101 |
2/2✓ Branch 0 taken 4183938 times.
✓ Branch 1 taken 3842 times.
|
4187780 | DO ij = 1, ngrid |
102 | 4187780 | pks(ij) = cpp * ( ps(ij)/preff ) ** kappa | |
103 | ENDDO | ||
104 | |||
105 | ! .... Calcul des coeff. alpha et beta pour la couche l = llm .. | ||
106 | ! | ||
107 |
2/2✓ Branch 0 taken 4183938 times.
✓ Branch 1 taken 3842 times.
|
4187780 | DO ij = 1, ngrid |
108 | 4183938 | alpha(ij,llm) = 0. | |
109 | 4187780 | beta (ij,llm) = 1./ unpl2k | |
110 | ENDDO | ||
111 | ! | ||
112 | ! ... Calcul des coeff. alpha et beta pour l = llm-1 a l = 2 ... | ||
113 | ! | ||
114 |
2/2✓ Branch 0 taken 142154 times.
✓ Branch 1 taken 3842 times.
|
145996 | DO l = llm -1 , 2 , -1 |
115 | ! | ||
116 |
2/2✓ Branch 0 taken 154805706 times.
✓ Branch 1 taken 142154 times.
|
154951702 | DO ij = 1, ngrid |
117 | 154805706 | dellta = p(ij,l)* unpl2k + p(ij,l+1)* ( beta(ij,l+1)-unpl2k ) | |
118 | 154805706 | alpha(ij,l) = - p(ij,l+1) / dellta * alpha(ij,l+1) | |
119 | 154947860 | beta (ij,l) = p(ij,l ) / dellta | |
120 | ENDDO | ||
121 | ENDDO | ||
122 | |||
123 | ! *********************************************************************** | ||
124 | ! ..... Calcul de pk pour la couche 1 , pres du sol .... | ||
125 | ! | ||
126 |
2/2✓ Branch 0 taken 4183938 times.
✓ Branch 1 taken 3842 times.
|
4187780 | DO ij = 1, ngrid |
127 | pk(ij,1) = ( p(ij,1)*pks(ij) - 0.5*alpha(ij,2)*p(ij,2) ) / & | ||
128 | 4187780 | ( p(ij,1)* (1.+kappa) + 0.5*( beta(ij,2)-unpl2k )* p(ij,2) ) | |
129 | ENDDO | ||
130 | ! | ||
131 | ! ..... Calcul de pk(ij,l) , pour l = 2 a l = llm ........ | ||
132 | ! | ||
133 |
2/2✓ Branch 0 taken 145996 times.
✓ Branch 1 taken 3842 times.
|
149838 | DO l = 2, llm |
134 |
2/2✓ Branch 0 taken 158989644 times.
✓ Branch 1 taken 145996 times.
|
159139482 | DO ij = 1, ngrid |
135 | 159135640 | pk(ij,l) = alpha(ij,l) + beta(ij,l) * pk(ij,l-1) | |
136 | ENDDO | ||
137 | ENDDO | ||
138 | |||
139 |
1/2✓ Branch 0 taken 3842 times.
✗ Branch 1 not taken.
|
3842 | if (present(pkf)) then |
140 | ! calcul de pkf | ||
141 |
4/4✓ Branch 0 taken 149838 times.
✓ Branch 1 taken 3842 times.
✓ Branch 2 taken 163173582 times.
✓ Branch 3 taken 149838 times.
|
163327262 | pkf = pk |
142 | 3842 | CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 ) | |
143 | end if | ||
144 | |||
145 |
1/2✓ Branch 0 taken 3842 times.
✗ Branch 1 not taken.
|
3842 | END SUBROUTINE exner_hyb |
146 | |||
147 | end module exner_hyb_m | ||
148 |