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

Annotation of /trunk/dyn3d/calfis.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 91 - (hide annotations)
Wed Mar 26 17:18:58 2014 UTC (10 years, 2 months ago) by guez
File size: 8444 byte(s)
Removed unused variables lock_startdate and time_stamp of module
calendar.

Noticed that physiq does not change the surface pressure. So removed
arguments ps and dpfi of subroutine addfi. dpfi was always 0. The
computation of ps in addfi included some averaging at the poles. In
principle, this does not change ps but in practice it does because of
finite numerical precision. So the results of the simulation are
changed. Removed arguments ps and dpfi of calfis. Removed argument
d_ps of physiq.

du at the poles is not computed by dudv1, so declare only the
corresponding latitudes in dudv1. caldyn passes only a section of the
array dudyn as argument.

Removed variable niadv of module iniadvtrac_m.

Declared arguments of exner_hyb as assumed-shape arrays and made all
other horizontal sizes in exner_hyb dynamic. This allows the external
program test_disvert to use exner_hyb at a single horizontal position.

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

  ViewVC Help
Powered by ViewVC 1.1.21