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

Diff of /trunk/Sources/dyn3d/leapfrog.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 5 by guez, Mon Mar 3 16:32:04 2008 UTC revision 22 by guez, Fri Jul 31 15:18:47 2009 UTC
# Line 6  module leapfrog_m Line 6  module leapfrog_m
6    
7  contains  contains
8    
9    SUBROUTINE leapfrog(ucov, vcov, teta, ps, masse, phis, nq, q, clesphy0, &    SUBROUTINE leapfrog(ucov, vcov, teta, ps, masse, phis, nq, q, time_0)
        time_0)  
10    
11      ! From dyn3d/leapfrog.F, version 1.6 2005/04/13 08:58:34      ! From dyn3d/leapfrog.F, version 1.6 2005/04/13 08:58:34
12    
# Line 22  contains Line 21  contains
21      ! et possibilite d'appeler une fonction f(y) a derivee tangente      ! et possibilite d'appeler une fonction f(y) a derivee tangente
22      ! hyperbolique a la place de la fonction a derivee sinusoidale.      ! hyperbolique a la place de la fonction a derivee sinusoidale.
23    
24      ! ... Possibilite de choisir le shema pour l'advection de      ! ... Possibilité de choisir le schéma pour l'advection de
25      ! q, en modifiant iadv dans "traceur.def" (10/02) .      ! 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)      ! Pour Van-Leer + Vapeur d'eau saturee, iadv(1)=4. (F.Codron, 10/99)
28      ! Pour Van-Leer iadv=10      ! Pour Van-Leer iadv=10
29    
30      use dimens_m, only: iim, llm, nqmx      use dimens_m, only: iim, jjm, llm, nqmx
31      use paramet_m, only: ip1jmp1, ip1jm, llmp1, ijmllm, ijp1llm, jjp1, iip1, &      use paramet_m, only: ip1jmp1, ip1jm, ijmllm, ijp1llm, jjp1, iip1, iip2
          iip2  
32      use comconst, only: dtvr, daysec, dtphys      use comconst, only: dtvr, daysec, dtphys
33      use comvert, only: ap, bp      use comvert, only: ap, bp
34      use conf_gcm_m, only: day_step, iconser, idissip, iphysiq, iperiod, nday, &      use conf_gcm_m, only: day_step, iconser, idissip, iphysiq, iperiod, nday, &
35           offline, periodav           offline, periodav
36      use logic, only: ok_guide, apdiss, apphys, conser, forward, iflag_phys, &      use logic, only: ok_guide, iflag_phys
          leapf, statcl  
37      use comgeom      use comgeom
38      use serre      use serre
39      use temps, only: itaufin, day_ini, dt      use temps, only: itaufin, day_ini, dt
40      use iniprint, only: prt_level      use iniprint, only: prt_level
41      use com_io_dyn      use com_io_dyn
     use abort_gcm_m, only: abort_gcm  
42      use ener      use ener
43      use calfis_m, only: calfis      use calfis_m, only: calfis
44      use exner_hyb_m, only: exner_hyb      use exner_hyb_m, only: exner_hyb
45      use guide_m, only: guide      use guide_m, only: guide
46      use pression_m, only: pression      use pression_m, only: pression
47        use pressure_var, only: p3d
48    
49      integer nq      integer, intent(in):: nq
50    
51      INTEGER longcles      ! Variables dynamiques:
     PARAMETER (longcles = 20)  
     REAL clesphy0(longcles)  
   
     ! variables dynamiques  
52      REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm) ! vents covariants      REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm) ! vents covariants
53      REAL teta(ip1jmp1, llm) ! temperature potentielle      REAL teta(ip1jmp1, llm) ! temperature potentielle
54      REAL q(ip1jmp1, llm, nqmx) ! mass fractions of advected fields      REAL q(ip1jmp1, llm, nqmx) ! mass fractions of advected fields
55      REAL ps(ip1jmp1) ! pression au sol      REAL ps(ip1jmp1) ! pression au sol, en Pa
56      REAL p(ip1jmp1, llmp1) ! pression aux interfac.des couches      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      REAL pks(ip1jmp1) ! exner au sol      REAL pks(ip1jmp1) ! exner au sol
66      REAL pk(ip1jmp1, llm) ! exner au milieu des couches      REAL pk(ip1jmp1, llm) ! exner au milieu des couches
67      REAL pkf(ip1jmp1, llm) ! exner filt.au milieu des couches      REAL pkf(ip1jmp1, llm) ! exner filt.au milieu des couches
     REAL masse(ip1jmp1, llm) ! masse d'air  
     REAL phis(ip1jmp1) ! geopotentiel au sol  
68      REAL phi(ip1jmp1, llm) ! geopotential      REAL phi(ip1jmp1, llm) ! geopotential
69      REAL w(ip1jmp1, llm) ! vitesse verticale      REAL w(ip1jmp1, llm) ! vitesse verticale
70    
# Line 93  contains Line 92  contains
92    
93      REAL tppn(iim), tpps(iim), tpn, tps      REAL tppn(iim), tpps(iim), tpn, tps
94    
95      INTEGER itau, itaufinp1      INTEGER itau ! index of the time step of the dynamics, starts at 0
96        integer itaufinp1
97      INTEGER iday ! jour julien      INTEGER iday ! jour julien
98      REAL time ! Heure de la journee en fraction d'1 jour      REAL time ! time of day, as a fraction of day length
99    
100      REAL SSUM      REAL SSUM
101      REAL time_0, finvmaold(ip1jmp1, llm)      real finvmaold(ip1jmp1, llm)
102    
103      LOGICAL :: lafin=.false.      LOGICAL :: lafin=.false.
104      INTEGER ij, l      INTEGER ij, l
105    
106      REAL rdayvrai, rdaym_ini      REAL rdayvrai, rdaym_ini
107      LOGICAL callinigrads      LOGICAL:: callinigrads = .true.
   
     data callinigrads/.true./  
108    
109      !+jld variables test conservation energie      !+jld variables test conservation energie
110      REAL ecin(ip1jmp1, llm), ecin0(ip1jmp1, llm)      REAL ecin(ip1jmp1, llm), ecin0(ip1jmp1, llm)
# Line 116  contains Line 114  contains
114      REAL dtetaecdt(ip1jmp1, llm)      REAL dtetaecdt(ip1jmp1, llm)
115      REAL vcont(ip1jm, llm), ucont(ip1jmp1, llm)      REAL vcont(ip1jm, llm), ucont(ip1jmp1, llm)
116      CHARACTER*15 ztit      CHARACTER*15 ztit
117      INTEGER ip_ebil_dyn ! PRINT level for energy conserv. diag.      INTEGER:: ip_ebil_dyn = 0 ! PRINT level for energy conserv. diag.
118      SAVE ip_ebil_dyn  
119      DATA ip_ebil_dyn /0/      logical:: dissip_conservative = .true.
120        LOGICAL:: prem = .true.
121      character(len=*), parameter:: modname = "leapfrog"      logical forward, leapf, apphys, conser, apdiss
     character*80 abort_message  
   
     logical dissip_conservative  
     save dissip_conservative  
     data dissip_conservative /.true./  
   
     LOGICAL prem  
     save prem  
     DATA prem /.true./  
122    
123      !---------------------------------------------------      !---------------------------------------------------
124    
# Line 148  contains Line 137  contains
137    
138      ! On initialise la pression et la fonction d'Exner :      ! On initialise la pression et la fonction d'Exner :
139      dq=0.      dq=0.
140      CALL pression(ip1jmp1, ap, bp, ps, p)      CALL pression(ip1jmp1, ap, bp, ps, p3d)
141      CALL exner_hyb(ps, p, pks, pk, pkf)      CALL exner_hyb(ps, p3d, pks, pk, pkf)
142    
143      ! Debut de l'integration temporelle:      ! Debut de l'integration temporelle:
144      do      outer_loop:do
145         if (ok_guide.and.(itaufin - itau - 1) * dtvr > 21600) then         if (ok_guide.and.(itaufin - itau - 1) * dtvr > 21600) then
146            call guide(itau, ucov, vcov, teta, q, masse, ps)            call guide(itau, ucov, vcov, teta, q, masse, ps)
147         else         else
# Line 177  contains Line 166  contains
166            ! gestion des appels de la physique et des dissipations:            ! gestion des appels de la physique et des dissipations:
167    
168            apphys = .FALSE.            apphys = .FALSE.
           statcl = .FALSE.  
169            conser = .FALSE.            conser = .FALSE.
170            apdiss = .FALSE.            apdiss = .FALSE.
171    
# Line 196  contains Line 184  contains
184            ! calcul des tendances advection des traceurs (dont l'humidite)            ! calcul des tendances advection des traceurs (dont l'humidite)
185    
186            IF (forward .OR. leapf) THEN            IF (forward .OR. leapf) THEN
187               CALL caladvtrac(q, pbaru, pbarv, p, masse, dq, teta, pk)               CALL caladvtrac(q, pbaru, pbarv, p3d, masse, dq, teta, pk)
188               IF (offline) THEN               IF (offline) THEN
189                  !maf stokage du flux de masse pour traceurs OFF-LINE                  !maf stokage du flux de masse pour traceurs OFF-LINE
190                  CALL fluxstokenc(pbaru, pbarv, masse, teta, phi, phis, dtvr, &                  CALL fluxstokenc(pbaru, pbarv, masse, teta, phi, phis, dtvr, &
# Line 206  contains Line 194  contains
194    
195            ! integrations dynamique et traceurs:            ! integrations dynamique et traceurs:
196            CALL integrd(2, vcovm1, ucovm1, tetam1, psm1, massem1, dv, du, &            CALL integrd(2, vcovm1, ucovm1, tetam1, psm1, massem1, dv, du, &
197                 dteta, dq, dp, vcov, ucov, teta, q, ps, masse, phis, finvmaold)                 dteta, dq, dp, vcov, ucov, teta, q, ps, masse, phis, &
198                   finvmaold, leapf)
199    
200            ! calcul des tendances physiques:            ! calcul des tendances physiques:
201    
202            IF (apphys) THEN            IF (apphys) THEN
203               IF (itau + 1 == itaufin) lafin = .TRUE.               IF (itau + 1 == itaufin) lafin = .TRUE.
204    
205               CALL pression(ip1jmp1, ap, bp, ps, p)               CALL pression(ip1jmp1, ap, bp, ps, p3d)
206               CALL exner_hyb(ps, p, pks, pk, pkf)               CALL exner_hyb(ps, p3d, pks, pk, pkf)
207    
208               rdaym_ini = itau * dtvr / daysec               rdaym_ini = itau * dtvr / daysec
209               rdayvrai = rdaym_ini + day_ini               rdayvrai = rdaym_ini + day_ini
# Line 224  contains Line 213  contains
213               ! Diagnostique de conservation de l'énergie : initialisation               ! Diagnostique de conservation de l'énergie : initialisation
214               IF (ip_ebil_dyn >= 1) THEN               IF (ip_ebil_dyn >= 1) THEN
215                  ztit='bil dyn'                  ztit='bil dyn'
216                  CALL diagedyn(ztit, 2, 1, 1, dtphys &                  CALL diagedyn(ztit, 2, 1, 1, dtphys, ucov, vcov, ps, p3d, pk, &
217                       , ucov, vcov, ps, p, pk, teta, q(:, :, 1), q(:, :, 2))                       teta, q(:, :, 1), q(:, :, 2))
218               ENDIF               ENDIF
219    
220               CALL calfis(nq, lafin, rdayvrai, time, ucov, vcov, teta, q, &               CALL calfis(nq, lafin, rdayvrai, time, ucov, vcov, teta, q, &
221                    masse, ps, p, pk, phis, phi, du, dv, dteta, dq, w, &                    masse, ps, pk, phis, phi, du, dv, dteta, dq, w, &
222                    clesphy0, dufi, dvfi, dtetafi, dqfi, dpfi)                    dufi, dvfi, dtetafi, dqfi, dpfi)
223    
224               ! ajout des tendances physiques:               ! ajout des tendances physiques:
225               CALL addfi(nqmx, dtphys, &               CALL addfi(nqmx, dtphys, &
# Line 240  contains Line 229  contains
229               ! Diagnostique de conservation de l'énergie : difference               ! Diagnostique de conservation de l'énergie : difference
230               IF (ip_ebil_dyn >= 1) THEN               IF (ip_ebil_dyn >= 1) THEN
231                  ztit = 'bil phys'                  ztit = 'bil phys'
232                  CALL diagedyn(ztit, 2, 1, 1, dtphys, ucov, vcov, ps, p, pk, &                  CALL diagedyn(ztit, 2, 1, 1, dtphys, ucov, vcov, ps, p3d, pk, &
233                       teta, q(:, :, 1), q(:, :, 2))                       teta, q(:, :, 1), q(:, :, 2))
234               ENDIF               ENDIF
235            ENDIF            ENDIF
236    
237            CALL pression(ip1jmp1, ap, bp, ps, p)            CALL pression(ip1jmp1, ap, bp, ps, p3d)
238            CALL exner_hyb(ps, p, pks, pk, pkf)            CALL exner_hyb(ps, p3d, pks, pk, pkf)
239    
240            ! dissipation horizontale et verticale des petites echelles:            ! dissipation horizontale et verticale des petites echelles:
241    
# Line 256  contains Line 245  contains
245               call enercin(vcov, ucov, vcont, ucont, ecin0)               call enercin(vcov, ucov, vcont, ucont, ecin0)
246    
247               ! dissipation               ! dissipation
248               CALL dissip(vcov, ucov, teta, p, dvdis, dudis, dtetadis)               CALL dissip(vcov, ucov, teta, p3d, dvdis, dudis, dtetadis)
249               ucov=ucov + dudis               ucov=ucov + dudis
250               vcov=vcov + dvdis               vcov=vcov + dvdis
251    
# Line 315  contains Line 304  contains
304               ENDIF               ENDIF
305            ENDIF            ENDIF
306    
307            IF (itau == itaufinp1) then            IF (itau == itaufinp1) exit outer_loop
              abort_message = 'Simulation finished'  
              call abort_gcm(modname, abort_message, 0)  
           ENDIF  
308    
309            ! ecriture du fichier histoire moyenne:            ! ecriture du fichier histoire moyenne:
310    
# Line 350  contains Line 336  contains
336                  dt = 2. * dtvr                  dt = 2. * dtvr
337               END IF               END IF
338            ELSE            ELSE
339               ! ...... pas leapfrog .....               ! pas leapfrog
340               leapf = .TRUE.               leapf = .TRUE.
341               dt = 2. * dtvr               dt = 2. * dtvr
342            END IF            END IF
343         end do         end do
344      end do      end do outer_loop
345    
346    END SUBROUTINE leapfrog    END SUBROUTINE leapfrog
347    
Legend:
Removed from v.5  
changed lines
  Added in v.22
  ViewVC Help
Powered by ViewVC 1.1.21