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

Annotation of /trunk/dyn3d/leapfrog.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 22 - (hide annotations)
Fri Jul 31 15:18:47 2009 UTC (14 years, 9 months ago) by guez
Original Path: trunk/libf/dyn3d/leapfrog.f90
File size: 11584 byte(s)
Superficial modifications
1 guez 3 module leapfrog_m
2    
3     ! This module is clean: no C preprocessor directive, no include line.
4    
5     IMPLICIT NONE
6    
7     contains
8    
9 guez 13 SUBROUTINE leapfrog(ucov, vcov, teta, ps, masse, phis, nq, q, time_0)
10 guez 3
11     ! From dyn3d/leapfrog.F, version 1.6 2005/04/13 08:58:34
12    
13     ! Version du 10/01/98, avec coordonnees verticales hybrides, avec
14     ! nouveaux operat. dissipation * (gradiv2, divgrad2, nxgraro2)
15    
16     ! Auteur: P. Le Van /L. Fairhead/F.Hourdin
17     ! Objet:
18     ! GCM LMD nouvelle grille
19    
20     ! ... Dans inigeom, nouveaux calculs pour les elongations cu, cv
21     ! et possibilite d'appeler une fonction f(y) a derivee tangente
22     ! hyperbolique a la place de la fonction a derivee sinusoidale.
23    
24 guez 10 ! ... Possibilité de choisir le schéma pour l'advection de
25 guez 3 ! q, en modifiant iadv dans "traceur.def" (10/02) .
26    
27     ! Pour Van-Leer + Vapeur d'eau saturee, iadv(1)=4. (F.Codron, 10/99)
28     ! Pour Van-Leer iadv=10
29    
30 guez 10 use dimens_m, only: iim, jjm, llm, nqmx
31     use paramet_m, only: ip1jmp1, ip1jm, ijmllm, ijp1llm, jjp1, iip1, iip2
32 guez 3 use comconst, only: dtvr, daysec, dtphys
33     use comvert, only: ap, bp
34     use conf_gcm_m, only: day_step, iconser, idissip, iphysiq, iperiod, nday, &
35     offline, periodav
36 guez 12 use logic, only: ok_guide, iflag_phys
37 guez 3 use comgeom
38     use serre
39     use temps, only: itaufin, day_ini, dt
40     use iniprint, only: prt_level
41     use com_io_dyn
42     use ener
43     use calfis_m, only: calfis
44     use exner_hyb_m, only: exner_hyb
45     use guide_m, only: guide
46     use pression_m, only: pression
47 guez 10 use pressure_var, only: p3d
48 guez 3
49 guez 18 integer, intent(in):: nq
50 guez 3
51 guez 10 ! Variables dynamiques:
52 guez 3 REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm) ! vents covariants
53     REAL teta(ip1jmp1, llm) ! temperature potentielle
54     REAL q(ip1jmp1, llm, nqmx) ! mass fractions of advected fields
55 guez 10 REAL ps(ip1jmp1) ! pression au sol, en Pa
56     REAL masse(ip1jmp1, llm) ! masse d'air
57     REAL phis(ip1jmp1) ! geopotentiel au sol
58    
59     REAL time_0
60    
61     ! Variables local to the procedure:
62    
63     ! Variables dynamiques:
64    
65 guez 3 REAL pks(ip1jmp1) ! exner au sol
66     REAL pk(ip1jmp1, llm) ! exner au milieu des couches
67     REAL pkf(ip1jmp1, llm) ! exner filt.au milieu des couches
68     REAL phi(ip1jmp1, llm) ! geopotential
69     REAL w(ip1jmp1, llm) ! vitesse verticale
70    
71     ! variables dynamiques intermediaire pour le transport
72     REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm) !flux de masse
73    
74     ! variables dynamiques au pas - 1
75     REAL vcovm1(ip1jm, llm), ucovm1(ip1jmp1, llm)
76     REAL tetam1(ip1jmp1, llm), psm1(ip1jmp1)
77     REAL massem1(ip1jmp1, llm)
78    
79     ! tendances dynamiques
80     REAL dv(ip1jm, llm), du(ip1jmp1, llm)
81     REAL dteta(ip1jmp1, llm), dq(ip1jmp1, llm, nqmx), dp(ip1jmp1)
82    
83     ! tendances de la dissipation
84     REAL dvdis(ip1jm, llm), dudis(ip1jmp1, llm)
85     REAL dtetadis(ip1jmp1, llm)
86    
87     ! tendances physiques
88     REAL dvfi(ip1jm, llm), dufi(ip1jmp1, llm)
89     REAL dtetafi(ip1jmp1, llm), dqfi(ip1jmp1, llm, nqmx), dpfi(ip1jmp1)
90    
91     ! variables pour le fichier histoire
92    
93     REAL tppn(iim), tpps(iim), tpn, tps
94    
95 guez 22 INTEGER itau ! index of the time step of the dynamics, starts at 0
96     integer itaufinp1
97 guez 3 INTEGER iday ! jour julien
98 guez 20 REAL time ! time of day, as a fraction of day length
99 guez 3
100     REAL SSUM
101 guez 10 real finvmaold(ip1jmp1, llm)
102 guez 3
103     LOGICAL :: lafin=.false.
104     INTEGER ij, l
105    
106     REAL rdayvrai, rdaym_ini
107 guez 10 LOGICAL:: callinigrads = .true.
108 guez 3
109     !+jld variables test conservation energie
110     REAL ecin(ip1jmp1, llm), ecin0(ip1jmp1, llm)
111     ! Tendance de la temp. potentiel d (theta) / d t due a la
112     ! tansformation d'energie cinetique en energie thermique
113     ! cree par la dissipation
114     REAL dtetaecdt(ip1jmp1, llm)
115     REAL vcont(ip1jm, llm), ucont(ip1jmp1, llm)
116     CHARACTER*15 ztit
117 guez 10 INTEGER:: ip_ebil_dyn = 0 ! PRINT level for energy conserv. diag.
118 guez 3
119 guez 10 logical:: dissip_conservative = .true.
120     LOGICAL:: prem = .true.
121 guez 12 logical forward, leapf, apphys, conser, apdiss
122 guez 3
123     !---------------------------------------------------
124    
125     print *, "Call sequence information: leapfrog"
126    
127     itaufin = nday * day_step
128     itaufinp1 = itaufin + 1
129    
130     itau = 0
131     iday = day_ini
132     time = time_0
133     IF (time > 1.) THEN
134     time = time - 1.
135     iday = iday + 1
136     ENDIF
137    
138     ! On initialise la pression et la fonction d'Exner :
139     dq=0.
140 guez 10 CALL pression(ip1jmp1, ap, bp, ps, p3d)
141     CALL exner_hyb(ps, p3d, pks, pk, pkf)
142 guez 3
143     ! Debut de l'integration temporelle:
144 guez 10 outer_loop:do
145 guez 3 if (ok_guide.and.(itaufin - itau - 1) * dtvr > 21600) then
146     call guide(itau, ucov, vcov, teta, q, masse, ps)
147     else
148     IF (prt_level > 9) print *, &
149     'Attention : on ne guide pas les 6 dernieres heures.'
150     endif
151    
152     CALL SCOPY(ijmllm, vcov, 1, vcovm1, 1)
153     CALL SCOPY(ijp1llm, ucov, 1, ucovm1, 1)
154     CALL SCOPY(ijp1llm, teta, 1, tetam1, 1)
155     CALL SCOPY(ijp1llm, masse, 1, massem1, 1)
156     CALL SCOPY(ip1jmp1, ps, 1, psm1, 1)
157    
158     forward = .TRUE.
159     leapf = .FALSE.
160     dt = dtvr
161    
162     CALL SCOPY(ijp1llm, masse, 1, finvmaold, 1)
163     CALL filtreg(finvmaold, jjp1, llm, - 2, 2, .TRUE., 1)
164    
165     do
166     ! gestion des appels de la physique et des dissipations:
167    
168     apphys = .FALSE.
169     conser = .FALSE.
170     apdiss = .FALSE.
171    
172     IF (MOD(itau, iconser) == 0) conser = .TRUE.
173     IF (MOD(itau + 1, idissip) == 0) apdiss = .TRUE.
174     IF (MOD(itau + 1, iphysiq) == 0 .AND. iflag_phys /= 0) apphys=.TRUE.
175    
176     ! calcul des tendances dynamiques:
177    
178     CALL geopot(ip1jmp1, teta, pk, pks, phis, phi)
179    
180     CALL caldyn(itau, ucov, vcov, teta, ps, masse, pk, pkf, phis, phi, &
181     conser, du, dv, dteta, dp, w, pbaru, pbarv, &
182     time + iday - day_ini)
183    
184     ! calcul des tendances advection des traceurs (dont l'humidite)
185    
186     IF (forward .OR. leapf) THEN
187 guez 10 CALL caladvtrac(q, pbaru, pbarv, p3d, masse, dq, teta, pk)
188 guez 3 IF (offline) THEN
189     !maf stokage du flux de masse pour traceurs OFF-LINE
190     CALL fluxstokenc(pbaru, pbarv, masse, teta, phi, phis, dtvr, &
191     itau)
192     ENDIF
193     ENDIF
194    
195     ! integrations dynamique et traceurs:
196     CALL integrd(2, vcovm1, ucovm1, tetam1, psm1, massem1, dv, du, &
197 guez 12 dteta, dq, dp, vcov, ucov, teta, q, ps, masse, phis, &
198     finvmaold, leapf)
199 guez 3
200     ! calcul des tendances physiques:
201    
202     IF (apphys) THEN
203     IF (itau + 1 == itaufin) lafin = .TRUE.
204    
205 guez 10 CALL pression(ip1jmp1, ap, bp, ps, p3d)
206     CALL exner_hyb(ps, p3d, pks, pk, pkf)
207 guez 3
208     rdaym_ini = itau * dtvr / daysec
209     rdayvrai = rdaym_ini + day_ini
210    
211     ! Interface avec les routines de phylmd (phymars ...)
212    
213     ! Diagnostique de conservation de l'énergie : initialisation
214     IF (ip_ebil_dyn >= 1) THEN
215     ztit='bil dyn'
216 guez 10 CALL diagedyn(ztit, 2, 1, 1, dtphys, ucov, vcov, ps, p3d, pk, &
217     teta, q(:, :, 1), q(:, :, 2))
218 guez 3 ENDIF
219    
220     CALL calfis(nq, lafin, rdayvrai, time, ucov, vcov, teta, q, &
221 guez 10 masse, ps, pk, phis, phi, du, dv, dteta, dq, w, &
222 guez 13 dufi, dvfi, dtetafi, dqfi, dpfi)
223 guez 3
224     ! ajout des tendances physiques:
225     CALL addfi(nqmx, dtphys, &
226     ucov, vcov, teta, q, ps, &
227     dufi, dvfi, dtetafi, dqfi, dpfi)
228    
229     ! Diagnostique de conservation de l'énergie : difference
230     IF (ip_ebil_dyn >= 1) THEN
231     ztit = 'bil phys'
232 guez 10 CALL diagedyn(ztit, 2, 1, 1, dtphys, ucov, vcov, ps, p3d, pk, &
233 guez 3 teta, q(:, :, 1), q(:, :, 2))
234     ENDIF
235     ENDIF
236    
237 guez 10 CALL pression(ip1jmp1, ap, bp, ps, p3d)
238     CALL exner_hyb(ps, p3d, pks, pk, pkf)
239 guez 3
240     ! dissipation horizontale et verticale des petites echelles:
241    
242     IF (apdiss) THEN
243     ! calcul de l'energie cinetique avant dissipation
244     call covcont(llm, ucov, vcov, ucont, vcont)
245     call enercin(vcov, ucov, vcont, ucont, ecin0)
246    
247     ! dissipation
248 guez 10 CALL dissip(vcov, ucov, teta, p3d, dvdis, dudis, dtetadis)
249 guez 3 ucov=ucov + dudis
250     vcov=vcov + dvdis
251    
252     if (dissip_conservative) then
253     ! On rajoute la tendance due a la transform. Ec -> E
254     ! therm. cree lors de la dissipation
255     call covcont(llm, ucov, vcov, ucont, vcont)
256     call enercin(vcov, ucov, vcont, ucont, ecin)
257     dtetaecdt= (ecin0 - ecin) / pk
258     dtetadis=dtetadis + dtetaecdt
259     endif
260     teta=teta + dtetadis
261    
262     ! Calcul de la valeur moyenne, unique de h aux poles .....
263    
264     DO l = 1, llm
265     DO ij = 1, iim
266     tppn(ij) = aire(ij) * teta(ij, l)
267     tpps(ij) = aire(ij + ip1jm) * teta(ij + ip1jm, l)
268     ENDDO
269     tpn = SSUM(iim, tppn, 1) / apoln
270     tps = SSUM(iim, tpps, 1) / apols
271    
272     DO ij = 1, iip1
273     teta(ij, l) = tpn
274     teta(ij + ip1jm, l) = tps
275     ENDDO
276     ENDDO
277    
278     DO ij = 1, iim
279     tppn(ij) = aire(ij) * ps(ij)
280     tpps(ij) = aire(ij + ip1jm) * ps(ij + ip1jm)
281     ENDDO
282     tpn = SSUM(iim, tppn, 1) / apoln
283     tps = SSUM(iim, tpps, 1) / apols
284    
285     DO ij = 1, iip1
286     ps(ij) = tpn
287     ps(ij + ip1jm) = tps
288     ENDDO
289    
290     END IF
291    
292     ! fin de l'intégration dynamique et physique pour le pas "itau"
293     ! préparation du pas d'intégration suivant
294    
295     ! schema matsuno + leapfrog
296     IF (forward .OR. leapf) THEN
297     itau = itau + 1
298     iday = day_ini + itau / day_step
299     time = REAL(itau - (iday - day_ini) * day_step) / day_step &
300     + time_0
301     IF (time > 1.) THEN
302     time = time - 1.
303     iday = iday + 1
304     ENDIF
305     ENDIF
306    
307 guez 10 IF (itau == itaufinp1) exit outer_loop
308 guez 3
309     ! ecriture du fichier histoire moyenne:
310    
311     ! Comment out the following calls when you do not want the output
312     ! files "dyn_hist_ave.nc" and "dynzon.nc"
313     IF (MOD(itau, iperiod) == 0 .OR. itau == itaufin) THEN
314     CALL writedynav(histaveid, nqmx, itau, vcov, &
315     ucov, teta, pk, phi, q, masse, ps, phis)
316     call bilan_dyn(2, dtvr * iperiod, dtvr * day_step * periodav, &
317     ps, masse, pk, pbaru, pbarv, teta, phi, ucov, vcov, q)
318     ENDIF
319    
320     IF (itau == itaufin) THEN
321 guez 5 CALL dynredem1("restart.nc", 0., vcov, ucov, teta, q, masse, ps)
322 guez 3 CLOSE(99)
323     ENDIF
324    
325     ! gestion de l'integration temporelle:
326    
327     IF (MOD(itau, iperiod) == 0) exit
328     IF (MOD(itau - 1, iperiod) == 0) THEN
329     IF (forward) THEN
330     ! fin du pas forward et debut du pas backward
331     forward = .FALSE.
332     leapf = .FALSE.
333     ELSE
334     ! fin du pas backward et debut du premier pas leapfrog
335     leapf = .TRUE.
336     dt = 2. * dtvr
337     END IF
338     ELSE
339 guez 20 ! pas leapfrog
340 guez 3 leapf = .TRUE.
341     dt = 2. * dtvr
342     END IF
343     end do
344 guez 10 end do outer_loop
345 guez 3
346     END SUBROUTINE leapfrog
347    
348     end module leapfrog_m

  ViewVC Help
Powered by ViewVC 1.1.21