/[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 23 by guez, Mon Dec 14 15:25:16 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, 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, 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  
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      ! Variables dynamiques:
   
     INTEGER longcles  
     PARAMETER (longcles = 20)  
     REAL clesphy0(longcles)  
   
     ! variables dynamiques  
50      REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm) ! vents covariants      REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm) ! vents covariants
51      REAL teta(ip1jmp1, llm) ! temperature potentielle      REAL teta(ip1jmp1, llm) ! temperature potentielle
52      REAL q(ip1jmp1, llm, nqmx) ! mass fractions of advected fields      REAL q(ip1jmp1, llm, nqmx) ! mass fractions of advected fields
53      REAL ps(ip1jmp1) ! pression au sol      REAL ps(ip1jmp1) ! pression au sol, en Pa
54      REAL p(ip1jmp1, llmp1) ! pression aux interfac.des couches      REAL masse(ip1jmp1, llm) ! masse d'air
55        REAL phis(ip1jmp1) ! geopotentiel au sol
56    
57        REAL time_0
58    
59        ! Variables local to the procedure:
60    
61        ! Variables dynamiques:
62    
63      REAL pks(ip1jmp1) ! exner au sol      REAL pks(ip1jmp1) ! exner au sol
64      REAL pk(ip1jmp1, llm) ! exner au milieu des couches      REAL pk(ip1jmp1, llm) ! exner au milieu des couches
65      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  
66      REAL phi(ip1jmp1, llm) ! geopotential      REAL phi(ip1jmp1, llm) ! geopotential
67      REAL w(ip1jmp1, llm) ! vitesse verticale      REAL w(ip1jmp1, llm) ! vitesse verticale
68    
# Line 93  contains Line 90  contains
90    
91      REAL tppn(iim), tpps(iim), tpn, tps      REAL tppn(iim), tpps(iim), tpn, tps
92    
93      INTEGER itau, itaufinp1      INTEGER itau ! index of the time step of the dynamics, starts at 0
94        integer itaufinp1
95      INTEGER iday ! jour julien      INTEGER iday ! jour julien
96      REAL time ! Heure de la journee en fraction d'1 jour      REAL time ! time of day, as a fraction of day length
97    
98      REAL SSUM      REAL SSUM
99      REAL time_0, finvmaold(ip1jmp1, llm)      real finvmaold(ip1jmp1, llm)
100    
101      LOGICAL :: lafin=.false.      LOGICAL :: lafin=.false.
102      INTEGER ij, l      INTEGER ij, l
103    
104      REAL rdayvrai, rdaym_ini      REAL rdayvrai, rdaym_ini
     LOGICAL callinigrads  
   
     data callinigrads/.true./  
105    
106      !+jld variables test conservation energie      !+jld variables test conservation energie
107      REAL ecin(ip1jmp1, llm), ecin0(ip1jmp1, llm)      REAL ecin(ip1jmp1, llm), ecin0(ip1jmp1, llm)
# Line 116  contains Line 111  contains
111      REAL dtetaecdt(ip1jmp1, llm)      REAL dtetaecdt(ip1jmp1, llm)
112      REAL vcont(ip1jm, llm), ucont(ip1jmp1, llm)      REAL vcont(ip1jm, llm), ucont(ip1jmp1, llm)
113      CHARACTER*15 ztit      CHARACTER*15 ztit
114      INTEGER ip_ebil_dyn ! PRINT level for energy conserv. diag.      INTEGER:: ip_ebil_dyn = 0 ! PRINT level for energy conserv. diag.
115      SAVE ip_ebil_dyn  
116      DATA ip_ebil_dyn /0/      logical:: dissip_conservative = .true.
117        logical forward, leapf, apphys, conser, apdiss
     character(len=*), parameter:: modname = "leapfrog"  
     character*80 abort_message  
   
     logical dissip_conservative  
     save dissip_conservative  
     data dissip_conservative /.true./  
   
     LOGICAL prem  
     save prem  
     DATA prem /.true./  
118    
119      !---------------------------------------------------      !---------------------------------------------------
120    
# Line 148  contains Line 133  contains
133    
134      ! On initialise la pression et la fonction d'Exner :      ! On initialise la pression et la fonction d'Exner :
135      dq=0.      dq=0.
136      CALL pression(ip1jmp1, ap, bp, ps, p)      CALL pression(ip1jmp1, ap, bp, ps, p3d)
137      CALL exner_hyb(ps, p, pks, pk, pkf)      CALL exner_hyb(ps, p3d, pks, pk, pkf)
138    
139      ! Debut de l'integration temporelle:      ! Debut de l'integration temporelle:
140      do      outer_loop:do
141         if (ok_guide.and.(itaufin - itau - 1) * dtvr > 21600) then         if (ok_guide.and.(itaufin - itau - 1) * dtvr > 21600) then
142            call guide(itau, ucov, vcov, teta, q, masse, ps)            call guide(itau, ucov, vcov, teta, q, masse, ps)
143         else         else
# Line 177  contains Line 162  contains
162            ! gestion des appels de la physique et des dissipations:            ! gestion des appels de la physique et des dissipations:
163    
164            apphys = .FALSE.            apphys = .FALSE.
           statcl = .FALSE.  
165            conser = .FALSE.            conser = .FALSE.
166            apdiss = .FALSE.            apdiss = .FALSE.
167    
# Line 196  contains Line 180  contains
180            ! calcul des tendances advection des traceurs (dont l'humidite)            ! calcul des tendances advection des traceurs (dont l'humidite)
181    
182            IF (forward .OR. leapf) THEN            IF (forward .OR. leapf) THEN
183               CALL caladvtrac(q, pbaru, pbarv, p, masse, dq, teta, pk)               CALL caladvtrac(q, pbaru, pbarv, p3d, masse, dq, teta, pk)
184               IF (offline) THEN               IF (offline) THEN
185                  !maf stokage du flux de masse pour traceurs OFF-LINE                  !maf stokage du flux de masse pour traceurs OFF-LINE
186                  CALL fluxstokenc(pbaru, pbarv, masse, teta, phi, phis, dtvr, &                  CALL fluxstokenc(pbaru, pbarv, masse, teta, phi, phis, dtvr, &
# Line 206  contains Line 190  contains
190    
191            ! integrations dynamique et traceurs:            ! integrations dynamique et traceurs:
192            CALL integrd(2, vcovm1, ucovm1, tetam1, psm1, massem1, dv, du, &            CALL integrd(2, vcovm1, ucovm1, tetam1, psm1, massem1, dv, du, &
193                 dteta, dq, dp, vcov, ucov, teta, q, ps, masse, phis, finvmaold)                 dteta, dq, dp, vcov, ucov, teta, q, ps, masse, phis, &
194                   finvmaold, leapf)
195    
196            ! calcul des tendances physiques:            ! calcul des tendances physiques:
197    
198            IF (apphys) THEN            IF (apphys) THEN
199               IF (itau + 1 == itaufin) lafin = .TRUE.               IF (itau + 1 == itaufin) lafin = .TRUE.
200    
201               CALL pression(ip1jmp1, ap, bp, ps, p)               CALL pression(ip1jmp1, ap, bp, ps, p3d)
202               CALL exner_hyb(ps, p, pks, pk, pkf)               CALL exner_hyb(ps, p3d, pks, pk, pkf)
203    
204               rdaym_ini = itau * dtvr / daysec               rdaym_ini = itau * dtvr / daysec
205               rdayvrai = rdaym_ini + day_ini               rdayvrai = rdaym_ini + day_ini
# Line 224  contains Line 209  contains
209               ! Diagnostique de conservation de l'énergie : initialisation               ! Diagnostique de conservation de l'énergie : initialisation
210               IF (ip_ebil_dyn >= 1) THEN               IF (ip_ebil_dyn >= 1) THEN
211                  ztit='bil dyn'                  ztit='bil dyn'
212                  CALL diagedyn(ztit, 2, 1, 1, dtphys &                  CALL diagedyn(ztit, 2, 1, 1, dtphys, ucov, vcov, ps, p3d, pk, &
213                       , ucov, vcov, ps, p, pk, teta, q(:, :, 1), q(:, :, 2))                       teta, q(:, :, 1), q(:, :, 2))
214               ENDIF               ENDIF
215    
216               CALL calfis(nq, lafin, rdayvrai, time, ucov, vcov, teta, q, &               CALL calfis(nqmx, lafin, rdayvrai, time, ucov, vcov, teta, q, &
217                    masse, ps, p, pk, phis, phi, du, dv, dteta, dq, w, &                    masse, ps, pk, phis, phi, du, dv, dteta, dq, w, &
218                    clesphy0, dufi, dvfi, dtetafi, dqfi, dpfi)                    dufi, dvfi, dtetafi, dqfi, dpfi)
219    
220               ! ajout des tendances physiques:               ! ajout des tendances physiques:
221               CALL addfi(nqmx, dtphys, &               CALL addfi(nqmx, dtphys, &
# Line 240  contains Line 225  contains
225               ! Diagnostique de conservation de l'énergie : difference               ! Diagnostique de conservation de l'énergie : difference
226               IF (ip_ebil_dyn >= 1) THEN               IF (ip_ebil_dyn >= 1) THEN
227                  ztit = 'bil phys'                  ztit = 'bil phys'
228                  CALL diagedyn(ztit, 2, 1, 1, dtphys, ucov, vcov, ps, p, pk, &                  CALL diagedyn(ztit, 2, 1, 1, dtphys, ucov, vcov, ps, p3d, pk, &
229                       teta, q(:, :, 1), q(:, :, 2))                       teta, q(:, :, 1), q(:, :, 2))
230               ENDIF               ENDIF
231            ENDIF            ENDIF
232    
233            CALL pression(ip1jmp1, ap, bp, ps, p)            CALL pression(ip1jmp1, ap, bp, ps, p3d)
234            CALL exner_hyb(ps, p, pks, pk, pkf)            CALL exner_hyb(ps, p3d, pks, pk, pkf)
235    
236            ! dissipation horizontale et verticale des petites echelles:            ! dissipation horizontale et verticale des petites echelles:
237    
# Line 256  contains Line 241  contains
241               call enercin(vcov, ucov, vcont, ucont, ecin0)               call enercin(vcov, ucov, vcont, ucont, ecin0)
242    
243               ! dissipation               ! dissipation
244               CALL dissip(vcov, ucov, teta, p, dvdis, dudis, dtetadis)               CALL dissip(vcov, ucov, teta, p3d, dvdis, dudis, dtetadis)
245               ucov=ucov + dudis               ucov=ucov + dudis
246               vcov=vcov + dvdis               vcov=vcov + dvdis
247    
# Line 315  contains Line 300  contains
300               ENDIF               ENDIF
301            ENDIF            ENDIF
302    
303            IF (itau == itaufinp1) then            IF (itau == itaufinp1) exit outer_loop
              abort_message = 'Simulation finished'  
              call abort_gcm(modname, abort_message, 0)  
           ENDIF  
304    
305            ! ecriture du fichier histoire moyenne:            ! ecriture du fichier histoire moyenne:
306    
# Line 332  contains Line 314  contains
314            ENDIF            ENDIF
315    
316            IF (itau == itaufin) THEN            IF (itau == itaufin) THEN
317               CALL dynredem1("restart.nc", 0., vcov, ucov, teta, q, masse, ps)               CALL dynredem1("restart.nc", vcov, ucov, teta, q, masse, ps)
318               CLOSE(99)               CLOSE(99)
319            ENDIF            ENDIF
320    
# Line 350  contains Line 332  contains
332                  dt = 2. * dtvr                  dt = 2. * dtvr
333               END IF               END IF
334            ELSE            ELSE
335               ! ...... pas leapfrog .....               ! pas leapfrog
336               leapf = .TRUE.               leapf = .TRUE.
337               dt = 2. * dtvr               dt = 2. * dtvr
338            END IF            END IF
339         end do         end do
340      end do      end do outer_loop
341    
342    END SUBROUTINE leapfrog    END SUBROUTINE leapfrog
343    
Legend:
Removed from v.5  
changed lines
  Added in v.23
  ViewVC Help
Powered by ViewVC 1.1.21