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

Annotation of /trunk/Sources/dyn3d/calfis.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 212 - (hide annotations)
Thu Jan 12 12:31:31 2017 UTC (7 years, 4 months ago) by guez
File size: 8569 byte(s)
Moved variables from module com_io_dyn to module inithist_m, where
they are defined.

Split grid_atob.f into grille_m.f and dist_sphe.f. Extracted ASCCI art
to documentation. In grille_m, use automatic arrays instead of maximum
size. In grille_m, instead of printing data for every problematic
point, print a single diagnostic message.

Removed variables top_height, overlap, lev_histhf, lev_histday,
lev_histmth, type_run, ok_isccp, ok_regdyn, lonmin_ins, lonmax_ins,
latmin_ins, latmax_ins of module clesphys, not used.

Removed variable itap of module histwrite_phy_m, not used. There is a
variable itap in module time_phylmdz.

Added output of tro3.

In physiq, no need to compute wo at every time-step, since we only use
it in radlwsw.

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 70 use dimens_m, only: iim, jjm, llm, nqmx
36     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 35 ! Appel de la physique :
185 guez 154 CALL physiq(lafin, dayvrai, time, paprs, play, pphi, pphis, u, v, t, qx, &
186     omega, d_u, d_v, d_t, d_qx)
187 guez 3
188 guez 40 ! transformation des tendances physiques en tendances dynamiques:
189 guez 3
190 guez 40 ! 62. enthalpie potentielle
191 guez 91 do l = 1, llm
192 guez 47 dtetafi(:, :, l) = cpp * gr_fi_dyn(d_t(:, l)) / pk(:, :, l)
193     end do
194 guez 3
195 guez 40 ! 63. traceurs
196 guez 91 DO iq = 1, nqmx
197     DO l = 1, llm
198     DO i = 1, iim + 1
199     dqfi(i, 1, l, iq) = d_qx(1, l, iq)
200     dqfi(i, jjm + 1, l, iq) = d_qx(klon, l, iq)
201 guez 3 ENDDO
202 guez 91 DO j = 2, jjm
203     ig0 = 1 + (j - 2) * iim
204     DO i = 1, iim
205     dqfi(i, j, l, iq) = d_qx(ig0 + i, l, iq)
206 guez 3 ENDDO
207 guez 91 dqfi(iim + 1, j, l, iq) = dqfi(1, j, l, iq)
208 guez 3 ENDDO
209     ENDDO
210     ENDDO
211    
212 guez 40 ! 65. champ u:
213 guez 91 DO l = 1, llm
214     DO i = 1, iim + 1
215 guez 47 dufi(i, 1, l) = 0.
216     dufi(i, jjm + 1, l) = 0.
217 guez 3 ENDDO
218    
219 guez 91 DO j = 2, jjm
220     ig0 = 1 + (j - 2) * iim
221     DO i = 1, iim - 1
222 guez 212 dufi(i, j, l) = 0.5 * (d_u(ig0 + i, l) + d_u(ig0 + i + 1, l)) &
223 guez 91 * cu_2d(i, j)
224 guez 3 ENDDO
225 guez 91 dufi(iim, j, l) = 0.5 * (d_u(ig0 + 1, l) + d_u(ig0 + iim, l)) &
226     * cu_2d(iim, j)
227     dufi(iim + 1, j, l) = dufi(1, j, l)
228 guez 3 ENDDO
229     ENDDO
230    
231 guez 40 ! 67. champ v:
232 guez 3
233 guez 91 DO l = 1, llm
234     DO j = 2, jjm - 1
235     ig0 = 1 + (j - 2) * iim
236     DO i = 1, iim
237 guez 212 dvfi(i, j, l) = 0.5 * (d_v(ig0 + i, l) + d_v(ig0 + i + iim, l)) &
238 guez 91 * cv_2d(i, j)
239 guez 3 ENDDO
240 guez 47 dvfi(iim + 1, j, l) = dvfi(1, j, l)
241 guez 3 ENDDO
242     ENDDO
243    
244 guez 90 ! 68. champ v pr\`es des p\^oles:
245 guez 40 ! v = U * cos(long) + V * SIN(long)
246 guez 3
247 guez 91 DO l = 1, llm
248     DO i = 1, iim
249     dvfi(i, 1, l) = d_u(1, l) * COS(rlonv(i)) + d_v(1, l) * SIN(rlonv(i))
250     dvfi(i, jjm, l) = d_u(klon, l) * COS(rlonv(i)) &
251     + d_v(klon, l) * SIN(rlonv(i))
252     dvfi(i, 1, l) = 0.5 * (dvfi(i, 1, l) + d_v(i + 1, l)) * cv_2d(i, 1)
253     dvfi(i, jjm, l) = 0.5 &
254 guez 71 * (dvfi(i, jjm, l) + d_v(klon - iim - 1 + i, l)) * cv_2d(i, jjm)
255 guez 3 ENDDO
256    
257 guez 47 dvfi(iim + 1, 1, l) = dvfi(1, 1, l)
258 guez 91 dvfi(iim + 1, jjm, l) = dvfi(1, jjm, l)
259 guez 3 ENDDO
260    
261     END SUBROUTINE calfis
262    
263     end module calfis_m

  ViewVC Help
Powered by ViewVC 1.1.21