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

Annotation of /trunk/dyn3d/calfis.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 95 - (hide annotations)
Wed Apr 2 12:59:54 2014 UTC (10 years, 1 month ago) by guez
File size: 8343 byte(s)
Removed argument ps of calfis (was not done in revision 91, error in
log message).

Removed optional actual argument pkf of the call to exner_hyb before
calfis, in leapfrog. pkf was not used before the next call to
exner_hyb.

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

  ViewVC Help
Powered by ViewVC 1.1.21