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

Annotation of /trunk/dyn3d/calfis.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 265 - (hide annotations)
Tue Mar 20 09:35:59 2018 UTC (6 years, 2 months ago) by guez
File size: 8542 byte(s)
Rename module dimens_m to dimensions.
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     REAL, intent(in):: w(:, :, :) ! (iim + 1, jjm + 1, llm) in kg / s
66 guez 71
67 guez 91 REAL, intent(out):: dufi(:, :, :) ! (iim + 1, jjm + 1, llm)
68 guez 71 ! tendency for the covariant zonal velocity (m2 s-2)
69    
70 guez 91 REAL, intent(out):: dvfi(:, :, :) ! (iim + 1, jjm, llm)
71 guez 90 ! tendency for the natural meridional velocity
72    
73 guez 91 REAL, intent(out):: dtetafi(:, :, :) ! (iim + 1, jjm + 1, llm)
74 guez 90 ! tendency for the potential temperature
75    
76 guez 91 REAL, intent(out):: dqfi(:, :, :, :) ! (iim + 1, jjm + 1, llm, nqmx)
77 guez 154
78     integer, intent(in):: dayvrai
79     ! current day number, based at value 1 on January 1st of annee_ref
80    
81     REAL, intent(in):: time ! time of day, as a fraction of day length
82 guez 70 LOGICAL, intent(in):: lafin
83 guez 3
84 guez 90 ! Local:
85 guez 95 INTEGER i, j, l, ig0, iq
86 guez 91 REAL paprs(klon, llm + 1) ! aux interfaces des couches
87     REAL play(klon, llm) ! aux milieux des couches
88 guez 47 REAL pphi(klon, llm), pphis(klon)
89     REAL u(klon, llm), v(klon, llm)
90 guez 35 real zvfi(iim + 1, jjm + 1, llm)
91 guez 91 REAL t(klon, llm) ! temperature, in K
92 guez 34 real qx(klon, llm, nqmx) ! mass fractions of advected fields
93 guez 47 REAL omega(klon, llm)
94 guez 71 REAL d_u(klon, llm), d_v(klon, llm) ! tendances physiques du vent (m s-2)
95 guez 47 REAL d_t(klon, llm), d_qx(klon, llm, nqmx)
96 guez 35 REAL z1(iim)
97 guez 34 REAL pksurcp(iim + 1, jjm + 1)
98 guez 3
99     !-----------------------------------------------------------------------
100    
101     !!print *, "Call sequence information: calfis"
102    
103 guez 91 ! 40. Transformation des variables dynamiques en variables physiques :
104 guez 3
105 guez 91 ! 42. Pression intercouches :
106     forall (l = 1: llm + 1) paprs(:, l) = pack(p3d(:, :, l), dyn_phy)
107 guez 3
108 guez 91 ! 43. Température et pression milieu couche
109     DO l = 1, llm
110 guez 47 pksurcp = pk(:, :, l) / cpp
111 guez 162 play(:, l) = pack(preff * pksurcp**(1./ kappa), dyn_phy)
112 guez 47 t(:, l) = pack(teta(:, :, l) * pksurcp, dyn_phy)
113 guez 3 ENDDO
114    
115 guez 91 ! 43.bis Traceurs :
116     forall (iq = 1: nqmx, l = 1: llm) &
117     qx(:, l, iq) = pack(q(:, :, l, iq), dyn_phy)
118 guez 3
119 guez 91 ! Geopotentiel calcule par rapport a la surface locale :
120     forall (l = 1 :llm) pphi(:, l) = pack(phi(:, :, l), dyn_phy)
121 guez 47 pphis = pack(phis, dyn_phy)
122 guez 91 forall (l = 1: llm) pphi(:, l) = pphi(:, l) - pphis
123 guez 3
124 guez 91 ! Calcul de la vitesse verticale :
125     forall (l = 1: llm)
126     omega(1, l) = w(1, 1, l) * g / apoln
127     omega(2: klon - 1, l) &
128     = pack(w(:iim, 2: jjm, l) * g * unsaire_2d(:iim, 2: jjm), .true.)
129     omega(klon, l) = w(1, jjm + 1, l) * g / apols
130     END forall
131 guez 3
132 guez 40 ! 45. champ u:
133 guez 3
134 guez 91 DO l = 1, llm
135     DO j = 2, jjm
136     ig0 = 1 + (j - 2) * iim
137     u(ig0 + 1, l) = 0.5 &
138 guez 71 * (ucov(iim, j, l) / cu_2d(iim, j) + ucov(1, j, l) / cu_2d(1, j))
139 guez 91 DO i = 2, iim
140     u(ig0 + i, l) = 0.5 * (ucov(i - 1, j, l) / cu_2d(i - 1, j) &
141     + ucov(i, j, l) / cu_2d(i, j))
142 guez 3 end DO
143     end DO
144     end DO
145    
146 guez 40 ! 46.champ v:
147 guez 3
148 guez 91 forall (j = 2: jjm, l = 1: llm) zvfi(:iim, j, l) = 0.5 &
149     * (vcov(:iim, j - 1, l) / cv_2d(:iim, j - 1) &
150 guez 47 + vcov(:iim, j, l) / cv_2d(:iim, j))
151 guez 35 zvfi(iim + 1, 2:jjm, :) = zvfi(1, 2:jjm, :)
152 guez 3
153 guez 90 ! 47. champs de vents au p\^ole nord
154 guez 40 ! U = 1 / pi * integrale [ v * cos(long) * d long ]
155     ! V = 1 / pi * integrale [ v * sin(long) * d long ]
156 guez 3
157 guez 91 DO l = 1, llm
158     z1(1) = (rlonu(1) - rlonu(iim) + 2. * pi) * vcov(1, 1, l) / cv_2d(1, 1)
159     DO i = 2, iim
160     z1(i) = (rlonu(i) - rlonu(i - 1)) * vcov(i, 1, l) / cv_2d(i, 1)
161 guez 3 ENDDO
162    
163 guez 47 u(1, l) = SUM(COS(rlonv(:iim)) * z1) / pi
164 guez 40 zvfi(:, 1, l) = SUM(SIN(rlonv(:iim)) * z1) / pi
165 guez 3 ENDDO
166    
167 guez 90 ! 48. champs de vents au p\^ole sud:
168 guez 40 ! U = 1 / pi * integrale [ v * cos(long) * d long ]
169     ! V = 1 / pi * integrale [ v * sin(long) * d long ]
170 guez 3
171 guez 91 DO l = 1, llm
172     z1(1) = (rlonu(1) - rlonu(iim) + 2. * pi) * vcov(1, jjm, l) &
173 guez 34 /cv_2d(1, jjm)
174 guez 91 DO i = 2, iim
175     z1(i) = (rlonu(i) - rlonu(i - 1)) * vcov(i, jjm, l) / cv_2d(i, jjm)
176 guez 3 ENDDO
177    
178 guez 47 u(klon, l) = SUM(COS(rlonv(:iim)) * z1) / pi
179 guez 40 zvfi(:, jjm + 1, l) = SUM(SIN(rlonv(:iim)) * z1) / pi
180 guez 35 ENDDO
181 guez 3
182 guez 91 forall(l = 1: llm) v(:, l) = pack(zvfi(:, :, l), dyn_phy)
183 guez 3
184 guez 154 CALL physiq(lafin, dayvrai, time, paprs, play, pphi, pphis, u, v, t, qx, &
185     omega, d_u, d_v, d_t, d_qx)
186 guez 3
187 guez 40 ! transformation des tendances physiques en tendances dynamiques:
188 guez 3
189 guez 40 ! 62. enthalpie potentielle
190 guez 91 do l = 1, llm
191 guez 47 dtetafi(:, :, l) = cpp * gr_fi_dyn(d_t(:, l)) / pk(:, :, l)
192     end do
193 guez 3
194 guez 40 ! 63. traceurs
195 guez 91 DO iq = 1, nqmx
196     DO l = 1, llm
197     DO i = 1, iim + 1
198     dqfi(i, 1, l, iq) = d_qx(1, l, iq)
199     dqfi(i, jjm + 1, l, iq) = d_qx(klon, l, iq)
200 guez 3 ENDDO
201 guez 91 DO j = 2, jjm
202     ig0 = 1 + (j - 2) * iim
203     DO i = 1, iim
204     dqfi(i, j, l, iq) = d_qx(ig0 + i, l, iq)
205 guez 3 ENDDO
206 guez 91 dqfi(iim + 1, j, l, iq) = dqfi(1, j, l, iq)
207 guez 3 ENDDO
208     ENDDO
209     ENDDO
210    
211 guez 40 ! 65. champ u:
212 guez 91 DO l = 1, llm
213     DO i = 1, iim + 1
214 guez 47 dufi(i, 1, l) = 0.
215     dufi(i, jjm + 1, l) = 0.
216 guez 3 ENDDO
217    
218 guez 91 DO j = 2, jjm
219     ig0 = 1 + (j - 2) * iim
220     DO i = 1, iim - 1
221 guez 212 dufi(i, j, l) = 0.5 * (d_u(ig0 + i, l) + d_u(ig0 + i + 1, l)) &
222 guez 91 * cu_2d(i, j)
223 guez 3 ENDDO
224 guez 91 dufi(iim, j, l) = 0.5 * (d_u(ig0 + 1, l) + d_u(ig0 + iim, l)) &
225     * cu_2d(iim, j)
226     dufi(iim + 1, j, l) = dufi(1, j, l)
227 guez 3 ENDDO
228     ENDDO
229    
230 guez 40 ! 67. champ v:
231 guez 3
232 guez 91 DO l = 1, llm
233     DO j = 2, jjm - 1
234     ig0 = 1 + (j - 2) * iim
235     DO i = 1, iim
236 guez 212 dvfi(i, j, l) = 0.5 * (d_v(ig0 + i, l) + d_v(ig0 + i + iim, l)) &
237 guez 91 * cv_2d(i, j)
238 guez 3 ENDDO
239 guez 47 dvfi(iim + 1, j, l) = dvfi(1, j, l)
240 guez 3 ENDDO
241     ENDDO
242    
243 guez 90 ! 68. champ v pr\`es des p\^oles:
244 guez 40 ! v = U * cos(long) + V * SIN(long)
245 guez 3
246 guez 91 DO l = 1, llm
247     DO i = 1, iim
248     dvfi(i, 1, l) = d_u(1, l) * COS(rlonv(i)) + d_v(1, l) * SIN(rlonv(i))
249     dvfi(i, jjm, l) = d_u(klon, l) * COS(rlonv(i)) &
250     + d_v(klon, l) * SIN(rlonv(i))
251     dvfi(i, 1, l) = 0.5 * (dvfi(i, 1, l) + d_v(i + 1, l)) * cv_2d(i, 1)
252     dvfi(i, jjm, l) = 0.5 &
253 guez 71 * (dvfi(i, jjm, l) + d_v(klon - iim - 1 + i, l)) * cv_2d(i, jjm)
254 guez 3 ENDDO
255    
256 guez 47 dvfi(iim + 1, 1, l) = dvfi(1, 1, l)
257 guez 91 dvfi(iim + 1, jjm, l) = dvfi(1, jjm, l)
258 guez 3 ENDDO
259    
260     END SUBROUTINE calfis
261    
262     end module calfis_m

  ViewVC Help
Powered by ViewVC 1.1.21