/[lmdze]/trunk/Sources/phylmd/yamada.f
ViewVC logotype

Contents of /trunk/Sources/phylmd/yamada.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 227 - (show annotations)
Thu Nov 2 15:47:03 2017 UTC (6 years, 6 months ago) by guez
File size: 5062 byte(s)
Rename phisinit to phis in restart.nc: clearer, same name as Fortran variable.

In aaam_bud, use rlat and rlon from phyetat0_m instead of having these
module variables associated to actual arguments in physiq.

In clmain, too many wind variables make the procedure hard to
understand. Use yu(:knon, 1) and yv(:knon, 1) instead of u1lay(:knon)
and v1lay(:knon). Note that when yu(:knon, 1) and yv(:knon, 1) are
used as actual arguments, they are probably copied to new arrays since
the elements are not contiguous. Rename yu10m to wind10m because this
is the norm of wind vector, not its zonal component. Rename yustar to
ustar. Rename uzon and vmer to u1 and v1 since these are wind
components at first layer and u1 and v1 are the names of corresponding
dummy arguments in stdlevvar.

In clmain, rename yzlev to zlev.

In clmain, screenc, stdlevvar and coefcdrag, remove the code
corresponding to zxli true (not used in LMDZ either).

Subroutine ustarhb becomes a function. Simplifications using the fact
that zx_alf2 = 0 and zx_alf1 = 1 (discarding the possibility to change
this).

In procedure vdif_kcay, remove unused dummy argument plev. Remove
useless computations of sss and sssq.

In clouds_gno, exp(100.) would overflow in single precision. Set
maximum to exp(80.) instead.

In physiq, use u(:, 1) and v(:, 1) as arguments to phytrac instead of
creating ad hoc variables yu1 and yv1.

In stdlevvar, rename dummy argument u_10m to wind10m, following the
corresponding modification in clmain. Simplifications using the fact
that ok_pred = 0 and ok_corr = 1 (discarding the possibility to change
this).

1 module yamada_m
2
3 IMPLICIT NONE
4
5 contains
6
7 SUBROUTINE yamada(ngrid, g, zlev, zlay, u, v, teta, q2, km, kn)
8
9 ! From LMDZ4/libf/phylmd/yamada.F, version 1.1 2004/06/22 11:45:36
10
11 USE dimphy, only: klon, klev
12 ! .......................................................................
13 ! .......................................................................
14
15 ! g : g
16 ! zlev : altitude a chaque niveau (interface inferieure de la couche
17 ! de meme indice)
18 ! zlay : altitude au centre de chaque couche
19 ! u,v : vitesse au centre de chaque couche
20 ! (en entree : la valeur au debut du pas de temps)
21 ! teta : temperature potentielle au centre de chaque couche
22 ! (en entree : la valeur au debut du pas de temps)
23 ! q2 : $q^2$ au bas de chaque couche
24 ! (en entree : la valeur au debut du pas de temps)
25 ! (en sortie : la valeur a la fin du pas de temps)
26 ! km : diffusivite turbulente de quantite de mouvement (au bas de chaque
27 ! couche)
28 ! (en sortie : la valeur a la fin du pas de temps)
29 ! kn : diffusivite turbulente des scalaires (au bas de chaque couche)
30 ! (en sortie : la valeur a la fin du pas de temps)
31
32 ! .......................................................................
33 REAL, INTENT(IN):: g
34 REAL zlev(klon, klev+1)
35 REAL zlay(klon, klev)
36 REAL, INTENT(IN):: u(klon, klev)
37 REAL, INTENT(IN):: v(klon, klev)
38 REAL teta(klon, klev)
39 REAL q2(klon, klev+1)
40 REAL km(klon, klev+1)
41 REAL kn(klon, klev+1)
42 INTEGER ngrid
43
44
45 INTEGER nlay
46 PARAMETER (nlay=klev)
47
48 LOGICAL first
49 SAVE first
50 DATA first/.TRUE./
51
52
53 INTEGER ig, k
54
55 REAL ri, zrif, zalpha, zsm
56 REAL rif(klon, klev+1), sm(klon, klev+1), alpha(klon, klev)
57
58 REAL m2(klon, klev+1), dz(klon, klev+1), zq, n2(klon, klev+1)
59 REAL l(klon, klev+1), l0(klon)
60
61 REAL sq(klon), sqz(klon), zz(klon, klev+1)
62 INTEGER iter
63
64 REAL ric, rifc, b1, kap
65 SAVE ric, rifc, b1, kap
66 DATA ric, rifc, b1, kap/0.195, 0.191, 16.6, 0.3/
67
68 IF (0==1 .AND. first) THEN
69 DO ig = 1, 1000
70 ri = (ig-800.)/500.
71 IF (ri<ric) THEN
72 zrif = frif(ri)
73 ELSE
74 zrif = rifc
75 END IF
76 IF (zrif<0.16) THEN
77 zalpha = falpha(zrif)
78 zsm = fsm(zrif)
79 ELSE
80 zalpha = 1.12
81 zsm = 0.085
82 END IF
83 PRINT *, ri, rif, zalpha, zsm
84 END DO
85 first = .FALSE.
86 END IF
87
88 ! Correction d'un bug sauvage a verifier.
89 ! do k=2,nlev
90 DO k = 2, nlay
91 DO ig = 1, ngrid
92 dz(ig, k) = zlay(ig, k) - zlay(ig, k-1)
93 m2(ig, k) = ((u(ig,k)-u(ig,k-1))**2+(v(ig,k)-v(ig, &
94 k-1))**2)/(dz(ig,k)*dz(ig,k))
95 n2(ig, k) = g*2.*(teta(ig,k)-teta(ig,k-1))/(teta(ig,k-1)+teta(ig,k))/ &
96 dz(ig, k)
97 ri = n2(ig, k)/max(m2(ig,k), 1.E-10)
98 IF (ri<ric) THEN
99 rif(ig, k) = frif(ri)
100 ELSE
101 rif(ig, k) = rifc
102 END IF
103 IF (rif(ig,k)<0.16) THEN
104 alpha(ig, k) = falpha(rif(ig,k))
105 sm(ig, k) = fsm(rif(ig,k))
106 ELSE
107 alpha(ig, k) = 1.12
108 sm(ig, k) = 0.085
109 END IF
110 zz(ig, k) = b1*m2(ig, k)*(1.-rif(ig,k))*sm(ig, k)
111 END DO
112 END DO
113
114 ! iterration pour determiner la longueur de melange
115
116 DO ig = 1, ngrid
117 l0(ig) = 100.
118 END DO
119 DO k = 2, klev - 1
120 DO ig = 1, ngrid
121 l(ig, k) = l0(ig)*kap*zlev(ig, k)/(kap*zlev(ig,k)+l0(ig))
122 END DO
123 END DO
124
125 DO iter = 1, 10
126 DO ig = 1, ngrid
127 sq(ig) = 1.E-10
128 sqz(ig) = 1.E-10
129 END DO
130 DO k = 2, klev - 1
131 DO ig = 1, ngrid
132 q2(ig, k) = l(ig, k)**2*zz(ig, k)
133 l(ig, k) = min(l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig, &
134 k)+l0(ig)), 0.5*sqrt(q2(ig,k))/sqrt(max(n2(ig,k),1.E-10)))
135 zq = sqrt(q2(ig,k))
136 sqz(ig) = sqz(ig) + zq*zlev(ig, k)*(zlay(ig,k)-zlay(ig,k-1))
137 sq(ig) = sq(ig) + zq*(zlay(ig,k)-zlay(ig,k-1))
138 END DO
139 END DO
140 DO ig = 1, ngrid
141 l0(ig) = 0.2*sqz(ig)/sq(ig)
142 END DO
143 ! (abd 3 5 2) print*,'ITER=',iter,' L0=',l0
144
145 END DO
146
147 DO k = 2, klev
148 DO ig = 1, ngrid
149 l(ig, k) = min(l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig, &
150 k)+l0(ig)), 0.5*sqrt(q2(ig,k))/sqrt(max(n2(ig,k),1.E-10)))
151 q2(ig, k) = l(ig, k)**2*zz(ig, k)
152 km(ig, k) = l(ig, k)*sqrt(q2(ig,k))*sm(ig, k)
153 kn(ig, k) = km(ig, k)*alpha(ig, k)
154 END DO
155 END DO
156
157 contains
158
159 REAL function frif(ri)
160 real ri
161 frif = 0.6588*(ri+0.1776-sqrt(ri*ri-0.3221*ri+0.03156))
162 end function frif
163
164 REAL function falpha(ri)
165 real ri
166 falpha = 1.318*(0.2231-ri)/(0.2341-ri)
167 end function falpha
168
169 REAL function fsm(ri)
170 real ri
171 fsm = 1.96*(0.1912-ri)*(0.2341-ri)/((1.-ri)*(0.2231-ri))
172 end function fsm
173
174 END SUBROUTINE yamada
175
176 end module yamada_m

  ViewVC Help
Powered by ViewVC 1.1.21