/[lmdze]/trunk/dyn3d/calfis.f90
ViewVC logotype

Annotation of /trunk/dyn3d/calfis.f90

Parent Directory Parent Directory | Revision Log Revision Log


Revision 339 - (hide annotations)
Thu Sep 26 17:08:42 2019 UTC (4 years, 8 months ago) by guez
File size: 8569 byte(s)
Simplify newmicro and rename dummy arguments

Rename dummy argument ucov of procedure advect to ang_3d. Rename dummy
argument radliq of procedure fisrtilp to cldliq. Rename dummy argument
qlwp of procedure newmicro to cldliq. Motivation: same name across
procedures.

Remove useless intermediary local variable rel in procedure
newmicro. The value of rad_chaud can be used instead of 1 in the
computation of cldtau if zflwp is 0: it does not matter.

1 guez 3 module calfis_m
2    
3     IMPLICIT NONE
4    
5     contains
6    
7 guez 162 SUBROUTINE calfis(ucov, vcov, teta, q, p3d, pk, phis, phi, w, dufi, dvfi, &
8 guez 154 dtetafi, dqfi, dayvrai, time, lafin)
9 guez 3
10 guez 90 ! From dyn3d/calfis.F, version 1.3, 2005/05/25 13:10:09
11 guez 40 ! Authors: P. Le Van, F. Hourdin
12 guez 3
13 guez 90 ! 1. R\'earrangement des tableaux et transformation des variables
14 guez 40 ! dynamiques en variables physiques
15 guez 70
16 guez 130 ! 2. Calcul des tendances physiques
17 guez 40 ! 3. Retransformation des tendances physiques en tendances dynamiques
18 guez 3
19 guez 40 ! Remarques:
20 guez 3
21 guez 90 ! - Les vents sont donn\'es dans la physique par leurs composantes
22 guez 40 ! naturelles.
23 guez 3
24 guez 40 ! - La variable thermodynamique de la physique est une variable
25     ! intensive : T.
26 guez 91 ! Pour la dynamique on prend T * (preff / p)**kappa
27 guez 3
28 guez 90 ! - Les deux seules variables d\'ependant de la g\'eom\'etrie
29     ! n\'ecessaires pour la physique sont la latitude (pour le
30     ! rayonnement) et l'aire de la maille (quand on veut int\'egrer une
31     ! grandeur horizontalement).
32 guez 3
33 guez 154 use comconst, only: kappa, cpp, g
34 guez 139 use comgeom, only: apoln, cu_2d, cv_2d, unsaire_2d, apols
35 guez 265 use dimensions, only: iim, jjm, llm, nqmx
36 guez 70 use dimphy, only: klon
37     use disvert_m, only: preff
38 guez 139 use dynetat0_m, only: rlonu, rlonv
39 guez 70 use grid_change, only: dyn_phy, gr_fi_dyn
40     use nr_util, only: pi
41     use physiq_m, only: physiq
42    
43 guez 91 REAL, intent(in):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm)
44     ! covariant zonal velocity
45 guez 90
46 guez 91 REAL, intent(in):: vcov(:, :, :) ! (iim + 1, jjm, llm)
47     !covariant meridional velocity
48 guez 3
49 guez 91 REAL, intent(in):: teta(:, :, :) ! (iim + 1, jjm + 1, llm)
50     ! potential temperature
51 guez 90
52 guez 91 REAL, intent(in):: q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nqmx)
53 guez 90 ! mass fractions of advected fields
54 guez 3
55 guez 212 REAL, intent(in):: p3d(:, :, :) ! (iim + 1, jjm + 1, llm + 1)
56 guez 162 ! pressure at layer interfaces, in Pa
57     ! ("p3d(i, j, l)" is at longitude "rlonv(i)", latitude "rlatu(j)",
58     ! for interface "l")
59    
60 guez 91 REAL, intent(in):: pk(:, :, :) ! (iim + 1, jjm + 1, llm)
61 guez 90 ! Exner = cp * (p / preff)**kappa
62    
63 guez 91 REAL, intent(in):: phis(:, :) ! (iim + 1, jjm + 1)
64     REAL, intent(in):: phi(:, :, :) ! (iim + 1, jjm + 1, llm)
65 guez 71
66 guez 339 REAL, intent(in):: w(:, :, :) ! (iim + 1, jjm + 1, llm)
67     ! vertical mass flux, in kg / s
68    
69 guez 91 REAL, intent(out):: dufi(:, :, :) ! (iim + 1, jjm + 1, llm)
70 guez 71 ! tendency for the covariant zonal velocity (m2 s-2)
71    
72 guez 91 REAL, intent(out):: dvfi(:, :, :) ! (iim + 1, jjm, llm)
73 guez 90 ! tendency for the natural meridional velocity
74    
75 guez 91 REAL, intent(out):: dtetafi(:, :, :) ! (iim + 1, jjm + 1, llm)
76 guez 90 ! tendency for the potential temperature
77    
78 guez 91 REAL, intent(out):: dqfi(:, :, :, :) ! (iim + 1, jjm + 1, llm, nqmx)
79 guez 154
80     integer, intent(in):: dayvrai
81     ! current day number, based at value 1 on January 1st of annee_ref
82    
83     REAL, intent(in):: time ! time of day, as a fraction of day length
84 guez 70 LOGICAL, intent(in):: lafin
85 guez 3
86 guez 90 ! Local:
87 guez 95 INTEGER i, j, l, ig0, iq
88 guez 91 REAL paprs(klon, llm + 1) ! aux interfaces des couches
89     REAL play(klon, llm) ! aux milieux des couches
90 guez 47 REAL pphi(klon, llm), pphis(klon)
91     REAL u(klon, llm), v(klon, llm)
92 guez 35 real zvfi(iim + 1, jjm + 1, llm)
93 guez 91 REAL t(klon, llm) ! temperature, in K
94 guez 34 real qx(klon, llm, nqmx) ! mass fractions of advected fields
95 guez 47 REAL omega(klon, llm)
96 guez 71 REAL d_u(klon, llm), d_v(klon, llm) ! tendances physiques du vent (m s-2)
97 guez 47 REAL d_t(klon, llm), d_qx(klon, llm, nqmx)
98 guez 35 REAL z1(iim)
99 guez 34 REAL pksurcp(iim + 1, jjm + 1)
100 guez 3
101     !-----------------------------------------------------------------------
102    
103     !!print *, "Call sequence information: calfis"
104    
105 guez 91 ! 40. Transformation des variables dynamiques en variables physiques :
106 guez 3
107 guez 91 ! 42. Pression intercouches :
108     forall (l = 1: llm + 1) paprs(:, l) = pack(p3d(:, :, l), dyn_phy)
109 guez 3
110 guez 91 ! 43. Température et pression milieu couche
111     DO l = 1, llm
112 guez 47 pksurcp = pk(:, :, l) / cpp
113 guez 162 play(:, l) = pack(preff * pksurcp**(1./ kappa), dyn_phy)
114 guez 47 t(:, l) = pack(teta(:, :, l) * pksurcp, dyn_phy)
115 guez 3 ENDDO
116    
117 guez 91 ! 43.bis Traceurs :
118     forall (iq = 1: nqmx, l = 1: llm) &
119     qx(:, l, iq) = pack(q(:, :, l, iq), dyn_phy)
120 guez 3
121 guez 91 ! Geopotentiel calcule par rapport a la surface locale :
122     forall (l = 1 :llm) pphi(:, l) = pack(phi(:, :, l), dyn_phy)
123 guez 47 pphis = pack(phis, dyn_phy)
124 guez 91 forall (l = 1: llm) pphi(:, l) = pphi(:, l) - pphis
125 guez 3
126 guez 91 ! Calcul de la vitesse verticale :
127     forall (l = 1: llm)
128     omega(1, l) = w(1, 1, l) * g / apoln
129     omega(2: klon - 1, l) &
130     = pack(w(:iim, 2: jjm, l) * g * unsaire_2d(:iim, 2: jjm), .true.)
131     omega(klon, l) = w(1, jjm + 1, l) * g / apols
132     END forall
133 guez 3
134 guez 40 ! 45. champ u:
135 guez 3
136 guez 91 DO l = 1, llm
137     DO j = 2, jjm
138     ig0 = 1 + (j - 2) * iim
139     u(ig0 + 1, l) = 0.5 &
140 guez 71 * (ucov(iim, j, l) / cu_2d(iim, j) + ucov(1, j, l) / cu_2d(1, j))
141 guez 91 DO i = 2, iim
142     u(ig0 + i, l) = 0.5 * (ucov(i - 1, j, l) / cu_2d(i - 1, j) &
143     + ucov(i, j, l) / cu_2d(i, j))
144 guez 3 end DO
145     end DO
146     end DO
147    
148 guez 40 ! 46.champ v:
149 guez 3
150 guez 91 forall (j = 2: jjm, l = 1: llm) zvfi(:iim, j, l) = 0.5 &
151     * (vcov(:iim, j - 1, l) / cv_2d(:iim, j - 1) &
152 guez 47 + vcov(:iim, j, l) / cv_2d(:iim, j))
153 guez 35 zvfi(iim + 1, 2:jjm, :) = zvfi(1, 2:jjm, :)
154 guez 3
155 guez 90 ! 47. champs de vents au p\^ole nord
156 guez 40 ! U = 1 / pi * integrale [ v * cos(long) * d long ]
157     ! V = 1 / pi * integrale [ v * sin(long) * d long ]
158 guez 3
159 guez 91 DO l = 1, llm
160     z1(1) = (rlonu(1) - rlonu(iim) + 2. * pi) * vcov(1, 1, l) / cv_2d(1, 1)
161     DO i = 2, iim
162     z1(i) = (rlonu(i) - rlonu(i - 1)) * vcov(i, 1, l) / cv_2d(i, 1)
163 guez 3 ENDDO
164    
165 guez 47 u(1, l) = SUM(COS(rlonv(:iim)) * z1) / pi
166 guez 40 zvfi(:, 1, l) = SUM(SIN(rlonv(:iim)) * z1) / pi
167 guez 3 ENDDO
168    
169 guez 90 ! 48. champs de vents au p\^ole sud:
170 guez 40 ! U = 1 / pi * integrale [ v * cos(long) * d long ]
171     ! V = 1 / pi * integrale [ v * sin(long) * d long ]
172 guez 3
173 guez 91 DO l = 1, llm
174     z1(1) = (rlonu(1) - rlonu(iim) + 2. * pi) * vcov(1, jjm, l) &
175 guez 34 /cv_2d(1, jjm)
176 guez 91 DO i = 2, iim
177     z1(i) = (rlonu(i) - rlonu(i - 1)) * vcov(i, jjm, l) / cv_2d(i, jjm)
178 guez 3 ENDDO
179    
180 guez 47 u(klon, l) = SUM(COS(rlonv(:iim)) * z1) / pi
181 guez 40 zvfi(:, jjm + 1, l) = SUM(SIN(rlonv(:iim)) * z1) / pi
182 guez 35 ENDDO
183 guez 3
184 guez 91 forall(l = 1: llm) v(:, l) = pack(zvfi(:, :, l), dyn_phy)
185 guez 3
186 guez 154 CALL physiq(lafin, dayvrai, time, paprs, play, pphi, pphis, u, v, t, qx, &
187     omega, d_u, d_v, d_t, d_qx)
188 guez 3
189 guez 40 ! transformation des tendances physiques en tendances dynamiques:
190 guez 3
191 guez 40 ! 62. enthalpie potentielle
192 guez 91 do l = 1, llm
193 guez 47 dtetafi(:, :, l) = cpp * gr_fi_dyn(d_t(:, l)) / pk(:, :, l)
194     end do
195 guez 3
196 guez 40 ! 63. traceurs
197 guez 91 DO iq = 1, nqmx
198     DO l = 1, llm
199     DO i = 1, iim + 1
200     dqfi(i, 1, l, iq) = d_qx(1, l, iq)
201     dqfi(i, jjm + 1, l, iq) = d_qx(klon, l, iq)
202 guez 3 ENDDO
203 guez 91 DO j = 2, jjm
204     ig0 = 1 + (j - 2) * iim
205     DO i = 1, iim
206     dqfi(i, j, l, iq) = d_qx(ig0 + i, l, iq)
207 guez 3 ENDDO
208 guez 91 dqfi(iim + 1, j, l, iq) = dqfi(1, j, l, iq)
209 guez 3 ENDDO
210     ENDDO
211     ENDDO
212    
213 guez 40 ! 65. champ u:
214 guez 91 DO l = 1, llm
215     DO i = 1, iim + 1
216 guez 47 dufi(i, 1, l) = 0.
217     dufi(i, jjm + 1, l) = 0.
218 guez 3 ENDDO
219    
220 guez 91 DO j = 2, jjm
221     ig0 = 1 + (j - 2) * iim
222     DO i = 1, iim - 1
223 guez 212 dufi(i, j, l) = 0.5 * (d_u(ig0 + i, l) + d_u(ig0 + i + 1, l)) &
224 guez 91 * cu_2d(i, j)
225 guez 3 ENDDO
226 guez 91 dufi(iim, j, l) = 0.5 * (d_u(ig0 + 1, l) + d_u(ig0 + iim, l)) &
227     * cu_2d(iim, j)
228     dufi(iim + 1, j, l) = dufi(1, j, l)
229 guez 3 ENDDO
230     ENDDO
231    
232 guez 40 ! 67. champ v:
233 guez 3
234 guez 91 DO l = 1, llm
235     DO j = 2, jjm - 1
236     ig0 = 1 + (j - 2) * iim
237     DO i = 1, iim
238 guez 212 dvfi(i, j, l) = 0.5 * (d_v(ig0 + i, l) + d_v(ig0 + i + iim, l)) &
239 guez 91 * cv_2d(i, j)
240 guez 3 ENDDO
241 guez 47 dvfi(iim + 1, j, l) = dvfi(1, j, l)
242 guez 3 ENDDO
243     ENDDO
244    
245 guez 90 ! 68. champ v pr\`es des p\^oles:
246 guez 40 ! v = U * cos(long) + V * SIN(long)
247 guez 3
248 guez 91 DO l = 1, llm
249     DO i = 1, iim
250     dvfi(i, 1, l) = d_u(1, l) * COS(rlonv(i)) + d_v(1, l) * SIN(rlonv(i))
251     dvfi(i, jjm, l) = d_u(klon, l) * COS(rlonv(i)) &
252     + d_v(klon, l) * SIN(rlonv(i))
253     dvfi(i, 1, l) = 0.5 * (dvfi(i, 1, l) + d_v(i + 1, l)) * cv_2d(i, 1)
254     dvfi(i, jjm, l) = 0.5 &
255 guez 71 * (dvfi(i, jjm, l) + d_v(klon - iim - 1 + i, l)) * cv_2d(i, jjm)
256 guez 3 ENDDO
257    
258 guez 47 dvfi(iim + 1, 1, l) = dvfi(1, 1, l)
259 guez 91 dvfi(iim + 1, jjm, l) = dvfi(1, jjm, l)
260 guez 3 ENDDO
261    
262     END SUBROUTINE calfis
263    
264     end module calfis_m

  ViewVC Help
Powered by ViewVC 1.1.21