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

Annotation of /trunk/dyn3d/calfis.f

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.21