/[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

trunk/libf/dyn3d/leapfrog.f90 revision 25 by guez, Fri Mar 5 16:43:45 2010 UTC trunk/dyn3d/leapfrog.f revision 129 by guez, Fri Feb 13 18:22:38 2015 UTC
# Line 4  module leapfrog_m Line 4  module leapfrog_m
4    
5  contains  contains
6    
7    SUBROUTINE leapfrog(ucov, vcov, teta, ps, masse, phis, q, time_0)    SUBROUTINE leapfrog(ucov, vcov, teta, ps, masse, phis, q)
8    
9      ! 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 revision 616
10      ! Auteurs : P. Le Van, L. Fairhead, F. Hourdin      ! Authors: P. Le Van, L. Fairhead, F. Hourdin
11    
12      USE dimens_m, ONLY : iim, llm, nqmx      ! IntĂ©gration temporelle du modèle : Matsuno-leapfrog scheme.
13      USE paramet_m, ONLY : iip1, ip1jm, ip1jmp1, jjp1  
14      USE comconst, ONLY : daysec, dtphys, dtvr      use addfi_m, only: addfi
15      USE comvert, ONLY : ap, bp      use bilan_dyn_m, only: bilan_dyn
16      USE conf_gcm_m, ONLY : day_step, iconser, idissip, iperiod, iphysiq, &      use caladvtrac_m, only: caladvtrac
17           nday, offline, periodav      use caldyn_m, only: caldyn
18      USE logic, ONLY : iflag_phys, ok_guide      USE calfis_m, ONLY: calfis
19      USE comgeom, ONLY : aire, apoln, apols      USE comconst, ONLY: daysec, dtvr
20      USE temps, ONLY : dt, itaufin      USE comgeom, ONLY: aire_2d, apoln, apols
21      USE dynetat0_m, ONLY : day_ini      USE disvert_m, ONLY: ap, bp
22      USE iniprint, ONLY : prt_level      USE conf_gcm_m, ONLY: day_step, iconser, iperiod, iphysiq, nday, offline, &
23      USE com_io_dyn, ONLY : histaveid           iflag_phys, iecri
24      USE calfis_m, ONLY : calfis      USE conf_guide_m, ONLY: ok_guide
25      USE exner_hyb_m, ONLY : exner_hyb      USE dimens_m, ONLY: iim, jjm, llm, nqmx
26      USE guide_m, ONLY : guide      use dissip_m, only: dissip
27      USE pression_m, ONLY : pression      USE dynetat0_m, ONLY: day_ini
28      USE pressure_var, ONLY : p3d      use dynredem1_m, only: dynredem1
29        USE exner_hyb_m, ONLY: exner_hyb
30        use filtreg_m, only: filtreg
31        use fluxstokenc_m, only: fluxstokenc
32        use geopot_m, only: geopot
33        USE guide_m, ONLY: guide
34        use inidissip_m, only: idissip
35        use integrd_m, only: integrd
36        use nr_util, only: assert
37        USE pressure_var, ONLY: p3d
38        USE temps, ONLY: itau_dyn
39        use writedynav_m, only: writedynav
40        use writehist_m, only: writehist
41    
42      ! Variables dynamiques:      ! Variables dynamiques:
43      REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm) ! vents covariants      REAL, intent(inout):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm) vent covariant
44      REAL teta(ip1jmp1, llm) ! temperature potentielle      REAL, intent(inout):: vcov(:, :, :) ! (iim + 1, jjm, llm) ! vent covariant
     REAL ps(ip1jmp1) ! pression au sol, en Pa  
   
     REAL masse(ip1jmp1, llm) ! masse d'air  
     REAL phis(ip1jmp1) ! geopotentiel au sol  
     REAL q(ip1jmp1, llm, nqmx) ! mass fractions of advected fields  
     REAL, intent(in):: time_0  
45    
46      ! Variables local to the procedure:      REAL, intent(inout):: teta(:, :, :) ! (iim + 1, jjm + 1, llm)
47        ! potential temperature
48    
49      ! Variables dynamiques:      REAL, intent(inout):: ps(:, :) ! (iim + 1, jjm + 1) pression au sol, en Pa
50        REAL, intent(inout):: masse(:, :, :) ! (iim + 1, jjm + 1, llm) masse d'air
51        REAL, intent(in):: phis(:, :) ! (iim + 1, jjm + 1) surface geopotential
52    
53      REAL pks(ip1jmp1) ! exner au sol      REAL, intent(inout):: q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nqmx)
54      REAL pk(ip1jmp1, llm) ! exner au milieu des couches      ! mass fractions of advected fields
     REAL pkf(ip1jmp1, llm) ! exner filt.au milieu des couches  
     REAL phi(ip1jmp1, llm) ! geopotential  
     REAL w(ip1jmp1, llm) ! vitesse verticale  
   
     ! variables dynamiques intermediaire pour le transport  
     REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm) !flux de masse  
   
     ! variables dynamiques au pas - 1  
     REAL vcovm1(ip1jm, llm), ucovm1(ip1jmp1, llm)  
     REAL tetam1(ip1jmp1, llm), psm1(ip1jmp1)  
     REAL massem1(ip1jmp1, llm)  
   
     ! tendances dynamiques  
     REAL dv(ip1jm, llm), du(ip1jmp1, llm)  
     REAL dteta(ip1jmp1, llm), dq(ip1jmp1, llm, nqmx), dp(ip1jmp1)  
   
     ! tendances de la dissipation  
     REAL dvdis(ip1jm, llm), dudis(ip1jmp1, llm)  
     REAL dtetadis(ip1jmp1, llm)  
   
     ! tendances physiques  
     REAL dvfi(ip1jm, llm), dufi(ip1jmp1, llm)  
     REAL dtetafi(ip1jmp1, llm), dqfi(ip1jmp1, llm, nqmx), dpfi(ip1jmp1)  
55    
56      ! variables pour le fichier histoire      ! Local:
57    
58        ! Variables dynamiques:
59    
60      REAL tppn(iim), tpps(iim), tpn, tps      REAL pks(iim + 1, jjm + 1) ! exner au sol
61        REAL pk(iim + 1, jjm + 1, llm) ! exner au milieu des couches
62        REAL pkf(iim + 1, jjm + 1, llm) ! exner filtr\'e au milieu des couches
63        REAL phi(iim + 1, jjm + 1, llm) ! geopotential
64        REAL w(iim + 1, jjm + 1, llm) ! vitesse verticale
65    
66        ! Variables dynamiques intermediaire pour le transport
67        ! Flux de masse :
68        REAL pbaru(iim + 1, jjm + 1, llm), pbarv(iim + 1, jjm, llm)
69    
70        ! Variables dynamiques au pas - 1
71        REAL vcovm1(iim + 1, jjm, llm), ucovm1(iim + 1, jjm + 1, llm)
72        REAL tetam1(iim + 1, jjm + 1, llm), psm1(iim + 1, jjm + 1)
73        REAL massem1(iim + 1, jjm + 1, llm)
74    
75        ! Tendances dynamiques
76        REAL dv((iim + 1) * jjm, llm), dudyn(iim + 1, jjm + 1, llm)
77        REAL dteta(iim + 1, jjm + 1, llm)
78        real dp((iim + 1) * (jjm + 1))
79    
80        ! Tendances de la dissipation :
81        REAL dvdis(iim + 1, jjm, llm), dudis(iim + 1, jjm + 1, llm)
82        REAL dtetadis(iim + 1, jjm + 1, llm)
83    
84        ! Tendances physiques
85        REAL dvfi(iim + 1, jjm, llm), dufi(iim + 1, jjm + 1, llm)
86        REAL dtetafi(iim + 1, jjm + 1, llm), dqfi(iim + 1, jjm + 1, llm, nqmx)
87    
88        ! Variables pour le fichier histoire
89      INTEGER itau ! index of the time step of the dynamics, starts at 0      INTEGER itau ! index of the time step of the dynamics, starts at 0
90      INTEGER iday ! jour julien      INTEGER itaufin
91      REAL time ! time of day, as a fraction of day length      REAL time ! time of day, as a fraction of day length
92      real finvmaold(ip1jmp1, llm)      real finvmaold(iim + 1, jjm + 1, llm)
93      LOGICAL :: lafin=.false.      INTEGER l
     INTEGER ij, l  
   
     REAL rdayvrai, rdaym_ini  
   
     ! Variables test conservation energie  
     REAL ecin(ip1jmp1, llm), ecin0(ip1jmp1, llm)  
     ! Tendance de la temp. potentiel d (theta) / d t due a la  
     ! tansformation d'energie cinetique en energie thermique  
     ! cree par la dissipation  
     REAL dtetaecdt(ip1jmp1, llm)  
     REAL vcont(ip1jm, llm), ucont(ip1jmp1, llm)  
     CHARACTER*15 ztit  
     INTEGER:: ip_ebil_dyn = 0 ! PRINT level for energy conserv. diag.  
94    
95      logical:: dissip_conservative = .true.      ! Variables test conservation \'energie
96      logical forward, leapf, apphys, conser, apdiss      REAL ecin(iim + 1, jjm + 1, llm), ecin0(iim + 1, jjm + 1, llm)
97    
98        REAL vcont((iim + 1) * jjm, llm), ucont((iim + 1) * (jjm + 1), llm)
99        logical leapf
100        real dt ! time step, in s
101    
102      !---------------------------------------------------      !---------------------------------------------------
103    
104      print *, "Call sequence information: leapfrog"      print *, "Call sequence information: leapfrog"
105        call assert(shape(ucov) == (/iim + 1, jjm + 1, llm/), "leapfrog")
106    
107      itaufin = nday * day_step      itaufin = nday * day_step
108      itau = 0      ! "day_step" is a multiple of "iperiod", therefore so is "itaufin".
109      iday = day_ini  
     time = time_0  
     dq = 0.  
110      ! On initialise la pression et la fonction d'Exner :      ! On initialise la pression et la fonction d'Exner :
111      CALL pression(ip1jmp1, ap, bp, ps, p3d)      forall (l = 1: llm + 1) p3d(:, :, l) = ap(l) + bp(l) * ps
112      CALL exner_hyb(ps, p3d, pks, pk, pkf)      CALL exner_hyb(ps, p3d, pks, pk, pkf)
113    
114      ! Debut de l'integration temporelle:      time_integration: do itau = 0, itaufin - 1
115      outer_loop:do         leapf = mod(itau, iperiod) /= 0
116         if (ok_guide .and. (itaufin - itau - 1) * dtvr > 21600.) &         if (leapf) then
117              call guide(itau, ucov, vcov, teta, q, masse, ps)            dt = 2 * dtvr
118         vcovm1 = vcov         else
119         ucovm1 = ucov            ! Matsuno
120         tetam1 = teta            dt = dtvr
121         massem1 = masse            if (ok_guide) call guide(itau, ucov, vcov, teta, q(:, :, :, 1), ps)
122         psm1 = ps            vcovm1 = vcov
123         forward = .TRUE.            ucovm1 = ucov
124         leapf = .FALSE.            tetam1 = teta
125         dt = dtvr            massem1 = masse
126         finvmaold = masse            psm1 = ps
127         CALL filtreg(finvmaold, jjp1, llm, - 2, 2, .TRUE., 1)            finvmaold = masse
128              CALL filtreg(finvmaold, direct = .false., intensive = .false.)
129         do         end if
130            ! gestion des appels de la physique et des dissipations:  
131            apphys = MOD(itau + 1, iphysiq) == 0 .AND. iflag_phys /= 0         ! Calcul des tendances dynamiques:
132            conser = MOD(itau, iconser) == 0         CALL geopot(teta, pk, pks, phis, phi)
133            apdiss = MOD(itau + 1, idissip) == 0         CALL caldyn(itau, ucov, vcov, teta, ps, masse, pk, pkf, phis, phi, &
134                dudyn, dv, dteta, dp, w, pbaru, pbarv, &
135            ! calcul des tendances dynamiques:              conser = MOD(itau, iconser) == 0)
136            CALL geopot(ip1jmp1, teta, pk, pks, phis, phi)  
137            CALL caldyn(itau, ucov, vcov, teta, ps, masse, pk, pkf, phis, phi, &         CALL caladvtrac(q, pbaru, pbarv, p3d, masse, teta, pk)
138                 conser, du, dv, dteta, dp, w, pbaru, pbarv, &  
139                 time + iday - day_ini)         ! Stokage du flux de masse pour traceurs offline:
140           IF (offline) CALL fluxstokenc(pbaru, pbarv, masse, teta, phi, phis, &
141            IF (forward .OR. leapf) THEN              dtvr, itau)
142               ! calcul des tendances advection des traceurs (dont l'humidite)  
143               CALL caladvtrac(q, pbaru, pbarv, p3d, masse, dq, teta, pk)         ! Int\'egrations dynamique et traceurs:
144               IF (offline) THEN         CALL integrd(vcovm1, ucovm1, tetam1, psm1, massem1, dv, dudyn, dteta, &
145                  ! Stokage du flux de masse pour traceurs off-line              dp, vcov, ucov, teta, q(:, :, :, :2), ps, masse, finvmaold, dt, &
146                  CALL fluxstokenc(pbaru, pbarv, masse, teta, phi, phis, dtvr, &              leapf)
147                       itau)  
148               ENDIF         forall (l = 1: llm + 1) p3d(:, :, l) = ap(l) + bp(l) * ps
149            ENDIF         CALL exner_hyb(ps, p3d, pks, pk, pkf)
150    
151           if (.not. leapf) then
152              ! Matsuno backward
153              ! Calcul des tendances dynamiques:
154              CALL geopot(teta, pk, pks, phis, phi)
155              CALL caldyn(itau + 1, ucov, vcov, teta, ps, masse, pk, pkf, phis, &
156                   phi, dudyn, dv, dteta, dp, w, pbaru, pbarv, conser = .false.)
157    
158            ! integrations dynamique et traceurs:            ! integrations dynamique et traceurs:
159            CALL integrd(2, vcovm1, ucovm1, tetam1, psm1, massem1, dv, du, &            CALL integrd(vcovm1, ucovm1, tetam1, psm1, massem1, dv, dudyn, &
160                 dteta, dq, dp, vcov, ucov, teta, q, ps, masse, phis, &                 dteta, dp, vcov, ucov, teta, q(:, :, :, :2), ps, masse, &
161                 finvmaold, leapf)                 finvmaold, dtvr, leapf=.false.)
   
           IF (apphys) THEN  
              ! calcul des tendances physiques:  
              IF (itau + 1 == itaufin) lafin = .TRUE.  
   
              CALL pression(ip1jmp1, ap, bp, ps, p3d)  
              CALL exner_hyb(ps, p3d, pks, pk, pkf)  
   
              rdaym_ini = itau * dtvr / daysec  
              rdayvrai = rdaym_ini + day_ini  
   
              ! Diagnostique de conservation de l'énergie : initialisation  
              IF (ip_ebil_dyn >= 1) THEN  
                 ztit='bil dyn'  
                 CALL diagedyn(ztit, 2, 1, 1, dtphys, ucov, vcov, ps, p3d, pk, &  
                      teta, q(:, :, 1), q(:, :, 2))  
              ENDIF  
   
              CALL calfis(nqmx, lafin, rdayvrai, time, ucov, vcov, teta, q, &  
                   masse, ps, pk, phis, phi, du, dv, dteta, dq, w, &  
                   dufi, dvfi, dtetafi, dqfi, dpfi)  
   
              ! ajout des tendances physiques:  
              CALL addfi(nqmx, dtphys, &  
                   ucov, vcov, teta, q, ps, &  
                   dufi, dvfi, dtetafi, dqfi, dpfi)  
   
              ! Diagnostique de conservation de l'énergie : difference  
              IF (ip_ebil_dyn >= 1) THEN  
                 ztit = 'bil phys'  
                 CALL diagedyn(ztit, 2, 1, 1, dtphys, ucov, vcov, ps, p3d, pk, &  
                      teta, q(:, :, 1), q(:, :, 2))  
              ENDIF  
           ENDIF  
162    
163            CALL pression(ip1jmp1, ap, bp, ps, p3d)            forall (l = 1: llm + 1) p3d(:, :, l) = ap(l) + bp(l) * ps
164            CALL exner_hyb(ps, p3d, pks, pk, pkf)            CALL exner_hyb(ps, p3d, pks, pk, pkf)
165           end if
166    
167            IF (apdiss) THEN         IF (MOD(itau + 1, iphysiq) == 0 .AND. iflag_phys /= 0) THEN
168               ! dissipation horizontale et verticale des petites echelles:            ! Calcul des tendances physiques :
169              time = REAL(mod(itau, day_step)) / day_step
170               ! calcul de l'energie cinetique avant dissipation            IF (time > 1.) time = time - 1.
171               call covcont(llm, ucov, vcov, ucont, vcont)            CALL calfis(itau * dtvr / daysec + day_ini, time, ucov, vcov, teta, &
172               call enercin(vcov, ucov, vcont, ucont, ecin0)                 q, pk, phis, phi, w, dufi, dvfi, dtetafi, dqfi, &
173                   lafin = itau + 1 == itaufin)
174               ! dissipation  
175               CALL dissip(vcov, ucov, teta, p3d, dvdis, dudis, dtetadis)            CALL addfi(ucov, vcov, teta, q, dufi, dvfi, dtetafi, dqfi)
176               ucov=ucov + dudis         ENDIF
177               vcov=vcov + dvdis  
178           IF (MOD(itau + 1, idissip) == 0) THEN
179               if (dissip_conservative) then            ! Dissipation horizontale et verticale des petites \'echelles
180                  ! On rajoute la tendance due a la transform. Ec -> E  
181                  ! therm. cree lors de la dissipation            ! calcul de l'\'energie cin\'etique avant dissipation
182                  call covcont(llm, ucov, vcov, ucont, vcont)            call covcont(llm, ucov, vcov, ucont, vcont)
183                  call enercin(vcov, ucov, vcont, ucont, ecin)            call enercin(vcov, ucov, vcont, ucont, ecin0)
184                  dtetaecdt= (ecin0 - ecin) / pk  
185                  dtetadis=dtetadis + dtetaecdt            ! dissipation
186               endif            CALL dissip(vcov, ucov, teta, p3d, dvdis, dudis, dtetadis)
187               teta=teta + dtetadis            ucov = ucov + dudis
188              vcov = vcov + dvdis
189               ! Calcul de la valeur moyenne, unique de h aux poles .....  
190               DO l = 1, llm            ! On ajoute la tendance due \`a la transformation \'energie
191                  DO ij = 1, iim            ! cin\'etique en \'energie thermique par la dissipation
192                     tppn(ij) = aire(ij) * teta(ij, l)            call covcont(llm, ucov, vcov, ucont, vcont)
193                     tpps(ij) = aire(ij + ip1jm) * teta(ij + ip1jm, l)            call enercin(vcov, ucov, vcont, ucont, ecin)
194                  ENDDO            dtetadis = dtetadis + (ecin0 - ecin) / pk
195                  tpn = SUM(tppn) / apoln            teta = teta + dtetadis
196                  tps = SUM(tpps) / apols  
197              ! Calcul de la valeur moyenne aux p\^oles :
198                  DO ij = 1, iip1            forall (l = 1: llm)
199                     teta(ij, l) = tpn               teta(:, 1, l) = SUM(aire_2d(:iim, 1) * teta(:iim, 1, l)) &
200                     teta(ij + ip1jm, l) = tps                    / apoln
201                  ENDDO               teta(:, jjm + 1, l) = SUM(aire_2d(:iim, jjm+1) &
202               ENDDO                    * teta(:iim, jjm + 1, l)) / apols
203              END forall
204               DO ij = 1, iim         END IF
205                  tppn(ij) = aire(ij) * ps(ij)  
206                  tpps(ij) = aire(ij + ip1jm) * ps(ij + ip1jm)         IF (MOD(itau + 1, iperiod) == 0) THEN
207               ENDDO            ! \'Ecriture du fichier histoire moyenne:
208               tpn = SUM(tppn) / apoln            CALL writedynav(vcov, ucov, teta, pk, phi, q, masse, ps, phis, &
209               tps = SUM(tpps) / apols                 time = itau + 1)
210              call bilan_dyn(ps, masse, pk, pbaru, pbarv, teta, phi, ucov, vcov, &
211               DO ij = 1, iip1                 q(:, :, :, 1))
212                  ps(ij) = tpn         ENDIF
213                  ps(ij + ip1jm) = tps  
214               ENDDO         IF (MOD(itau + 1, iecri * day_step) == 0) THEN
215            END IF            CALL geopot(teta, pk, pks, phis, phi)
216              CALL writehist(itau, vcov, ucov, teta, phi, q, masse, ps)
217            ! fin de l'intégration dynamique et physique pour le pas "itau"         END IF
218            ! préparation du pas d'intégration suivant      end do time_integration
219    
220            ! schema matsuno + leapfrog      CALL dynredem1("restart.nc", vcov, ucov, teta, q, masse, ps, &
221            IF (forward .OR. leapf) THEN           itau = itau_dyn + itaufin)
222               itau = itau + 1  
223               iday = day_ini + itau / day_step      ! Calcul des tendances dynamiques:
224               time = REAL(itau - (iday - day_ini) * day_step) / day_step &      CALL geopot(teta, pk, pks, phis, phi)
225                    + time_0      CALL caldyn(itaufin, ucov, vcov, teta, ps, masse, pk, pkf, phis, phi, &
226               IF (time > 1.) THEN           dudyn, dv, dteta, dp, w, pbaru, pbarv, &
227                  time = time - 1.           conser = MOD(itaufin, iconser) == 0)
                 iday = iday + 1  
              ENDIF  
           ENDIF  
   
           IF (itau == itaufin + 1) exit outer_loop  
   
           IF (MOD(itau, iperiod) == 0 .OR. itau == itaufin) THEN  
              ! ecriture du fichier histoire moyenne:  
              CALL writedynav(histaveid, nqmx, itau, vcov, &  
                   ucov, teta, pk, phi, q, masse, ps, phis)  
              call bilan_dyn(2, dtvr * iperiod, dtvr * day_step * periodav, &  
                   ps, masse, pk, pbaru, pbarv, teta, phi, ucov, vcov, q)  
           ENDIF  
   
           IF (itau == itaufin) THEN  
              CALL dynredem1("restart.nc", vcov, ucov, teta, q, masse, ps)  
           ENDIF  
   
           ! gestion de l'integration temporelle:  
           IF (MOD(itau, iperiod) == 0) exit  
           IF (MOD(itau - 1, iperiod) == 0) THEN  
              IF (forward) THEN  
                 ! fin du pas forward et debut du pas backward  
                 forward = .FALSE.  
                 leapf = .FALSE.  
              ELSE  
                 ! fin du pas backward et debut du premier pas leapfrog  
                 leapf = .TRUE.  
                 dt = 2. * dtvr  
              END IF  
           ELSE  
              ! pas leapfrog  
              leapf = .TRUE.  
              dt = 2. * dtvr  
           END IF  
        end do  
     end do outer_loop  
228    
229    END SUBROUTINE leapfrog    END SUBROUTINE leapfrog
230    

Legend:
Removed from v.25  
changed lines
  Added in v.129

  ViewVC Help
Powered by ViewVC 1.1.21