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

Diff of /trunk/dyn3d/advtrac.f

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

trunk/dyn3d/advtrac.f revision 82 by guez, Wed Mar 5 14:57:53 2014 UTC trunk/Sources/dyn3d/advtrac.f revision 178 by guez, Fri Mar 11 18:47:26 2016 UTC
# Line 11  contains Line 11  contains
11    
12      USE comconst, ONLY : dtvr      USE comconst, ONLY : dtvr
13      USE conf_gcm_m, ONLY : iapp_tracvl      USE conf_gcm_m, ONLY : iapp_tracvl
14      USE dimens_m, ONLY : iim, jjm, llm, nqmx      USE dimens_m, ONLY : jjm, llm, nqmx
15      USE iniadvtrac_m, ONLY : iadv      USE iniadvtrac_m, ONLY : iadv
16      USE paramet_m, ONLY : iip1, iip2, ijmllm, ijp1llm, ip1jm, ip1jmp1, jjp1, &      use massbar_m, only: massbar
17           llmp1      USE paramet_m, ONLY : iip1, iip2, ijmllm, ijp1llm, ip1jm, ip1jmp1, llmp1
18        use vlsplt_m, only: vlsplt
19        use vlspltqs_m, only: vlspltqs
20    
21      REAL, intent(in):: pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)      REAL, intent(in):: pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
22      REAL, intent(in):: p(ip1jmp1, llmp1)      REAL, intent(in):: p(ip1jmp1, llmp1)
# Line 31  contains Line 33  contains
33      REAL, save:: massem(ip1jmp1, llm)      REAL, save:: massem(ip1jmp1, llm)
34      real zdp(ip1jmp1)      real zdp(ip1jmp1)
35      REAL pbarug(ip1jmp1, llm), pbarvg(ip1jm, llm), wg(ip1jmp1, llm)      REAL pbarug(ip1jmp1, llm), pbarvg(ip1jm, llm), wg(ip1jmp1, llm)
     REAL cpuadv(nqmx)  
36    
37      INTEGER:: iadvtr = 0      INTEGER:: iadvtr = 0
38      INTEGER ij, l, iq      INTEGER ij, l, iq
39      REAL zdpmin, zdpmax      REAL zdpmin, zdpmax
40      EXTERNAL minmax      EXTERNAL minmax
41    
     ! Rajouts pour PPM  
   
42      INTEGER indice, n      INTEGER indice, n
43      ! Pas de temps adaptatif pour que CFL < 1      ! Pas de temps adaptatif pour que CFL < 1
44      REAL dtbon      REAL dtbon
     REAL cflmaxz ! CFL maximum  
     real aaa, bbb  
     REAL psppm(iim, jjp1) ! pression au sol  
     REAL unatppm(iim, jjp1, llm), vnatppm(iim, jjp1, llm)  
     REAL qppm(iim*jjp1, llm, nqmx)  
     REAL fluxwppm(iim, jjp1, llm)  
     REAL apppm(llmp1), bpppm(llmp1)  
     LOGICAL:: dum = .TRUE., fill = .TRUE.  
45    
46      !-----------------------------------------------------------      !-----------------------------------------------------------
47    
# Line 81  contains Line 72  contains
72         ! 1. calcul de w         ! 1. calcul de w
73         ! 2. groupement des mailles pres du pole.         ! 2. groupement des mailles pres du pole.
74    
75         CALL groupe(massem, pbaruc, pbarvc, pbarug, pbarvg, wg)         CALL groupe(pbaruc, pbarvc, pbarug, pbarvg, wg)
76    
77         ! test sur l'eventuelle creation de valeurs negatives de la masse         ! test sur l'eventuelle creation de valeurs negatives de la masse
78         DO l = 1, llm - 1         DO l = 1, llm - 1
# Line 103  contains Line 94  contains
94    
95         ! Advection proprement dite         ! Advection proprement dite
96    
97         ! Calcul des moyennes basées sur la masse         ! Calcul des moyennes bas\'ees sur la masse
98         CALL massbar(massem, massebx, masseby)         CALL massbar(massem, massebx, masseby)
99    
100         ! Appel des sous programmes d'advection         ! Appel des sous programmes d'advection
101    
102         DO iq = 1, nqmx         DO iq = 1, nqmx
103            IF (iadv(iq)==0) CYCLE            select case (iadv(iq))
104              case (10)
105            ! Schema de Van Leer I MUSCL               ! Schema de Van Leer I MUSCL
   
           IF (iadv(iq)==10) THEN  
106               CALL vlsplt(q(:, :, iq), 2., massem, wg, pbarug, pbarvg, dtvr)               CALL vlsplt(q(:, :, iq), 2., massem, wg, pbarug, pbarvg, dtvr)
107               ! Schema "pseudo amont" + test sur humidite specifique             case (12)
              ! pour la vapeur d'eau. F. Codron  
           ELSE IF (iadv(iq)==14) THEN  
              CALL vlspltqs(q(1, 1, 1), 2., massem, wg, pbarug, pbarvg, dtvr, &  
                   p, pk, teta)  
108               ! Schema de Frederic Hourdin               ! Schema de Frederic Hourdin
           ELSE IF (iadv(iq)==12) THEN  
109               ! Pas de temps adaptatif               ! Pas de temps adaptatif
110               CALL adaptdt(iadv(iq), dtbon, n, pbarug, massem)               CALL adaptdt(dtbon, n, pbarug, massem)
111               IF (n>1) THEN               IF (n>1) THEN
112                  WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &                  WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &
113                       'n=', n                       'n=', n
# Line 131  contains Line 115  contains
115               DO indice = 1, n               DO indice = 1, n
116                  CALL advn(q(1, 1, iq), massem, wg, pbarug, pbarvg, dtbon, 1)                  CALL advn(q(1, 1, iq), massem, wg, pbarug, pbarvg, dtbon, 1)
117               END DO               END DO
118            ELSE IF (iadv(iq)==13) THEN            case (13)
119               ! Pas de temps adaptatif               ! Pas de temps adaptatif
120               CALL adaptdt(iadv(iq), dtbon, n, pbarug, massem)               CALL adaptdt(dtbon, n, pbarug, massem)
121               IF (n>1) THEN               IF (n>1) THEN
122                  WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &                  WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &
123                       'n=', n                       'n=', n
# Line 141  contains Line 125  contains
125               DO indice = 1, n               DO indice = 1, n
126                  CALL advn(q(1, 1, iq), massem, wg, pbarug, pbarvg, dtbon, 2)                  CALL advn(q(1, 1, iq), massem, wg, pbarug, pbarvg, dtbon, 2)
127               END DO               END DO
128               ! Schema de pente SLOPES           case (14)
129            ELSE IF (iadv(iq)==20) THEN               ! Schema "pseudo amont" + test sur humidite specifique
130               CALL pentes_ini(q(1, 1, iq), wg, massem, pbarug, pbarvg, 0)               ! pour la vapeur d'eau. F. Codron
131               ! Schema de Prather               CALL vlspltqs(q(1, 1, 1), 2., massem, wg, pbarug, pbarvg, dtvr, &
132            ELSE IF (iadv(iq)==30) THEN                    p, pk, teta)
133               ! Pas de temps adaptatif            END select
              CALL adaptdt(iadv(iq), dtbon, n, pbarug, massem)  
              IF (n>1) THEN  
                 WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &  
                      'n=', n  
              END IF  
              CALL prather(q(1, 1, iq), wg, massem, pbarug, pbarvg, n, dtbon)  
              ! Schemas PPM Lin et Rood  
           ELSE IF (iadv(iq)==11 .OR. (iadv(iq)>=16 .AND. iadv(iq)<=18)) THEN  
              ! Test sur le flux horizontal  
              ! Pas de temps adaptatif  
              CALL adaptdt(iadv(iq), dtbon, n, pbarug, massem)  
              IF (n>1) THEN  
                 WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &  
                      'n=', n  
              END IF  
              ! Test sur le flux vertical  
              cflmaxz = 0.  
              DO l = 2, llm  
                 DO ij = iip2, ip1jm  
                    aaa = wg(ij, l)*dtvr/massem(ij, l)  
                    cflmaxz = max(cflmaxz, aaa)  
                    bbb = -wg(ij, l)*dtvr/massem(ij, l-1)  
                    cflmaxz = max(cflmaxz, bbb)  
                 END DO  
              END DO  
              IF (cflmaxz>=1) THEN  
                 WRITE (*, *) 'WARNING vertical', 'CFLmaxz=', cflmaxz  
              END IF  
   
              ! Ss-prg interface LMDZ.4->PPM3d  
              CALL interpre(q(1, 1, iq), qppm(1, 1, iq), wg, fluxwppm, massem, &  
                   apppm, bpppm, massebx, masseby, pbarug, pbarvg, unatppm, &  
                   vnatppm, psppm)  
   
              DO indice = 1, n  
                 ! VL (version PPM) horiz. et PPM vert.  
                 IF (iadv(iq)==11) THEN  
                    ! Ss-prg PPM3d de Lin  
                    CALL ppm3d(1, qppm(1, 1, iq), psppm, psppm, unatppm, &  
                         vnatppm, fluxwppm, dtbon, 2, 2, 2, 1, iim, jjp1, 2, &  
                         llm, apppm, bpppm, 0.01, 6400000, fill, dum, 220.)  
                    ! Monotonic PPM  
                 ELSE IF (iadv(iq)==16) THEN  
                    ! Ss-prg PPM3d de Lin  
                    CALL ppm3d(1, qppm(1, 1, iq), psppm, psppm, unatppm, &  
                         vnatppm, fluxwppm, dtbon, 3, 3, 3, 1, iim, jjp1, 2, &  
                         llm, apppm, bpppm, 0.01, 6400000, fill, dum, 220.)  
                    ! Semi Monotonic PPM  
                 ELSE IF (iadv(iq)==17) THEN  
                    ! Ss-prg PPM3d de Lin  
                    CALL ppm3d(1, qppm(1, 1, iq), psppm, psppm, unatppm, &  
                         vnatppm, fluxwppm, dtbon, 4, 4, 4, 1, iim, jjp1, 2, &  
                         llm, apppm, bpppm, 0.01, 6400000, fill, dum, 220.)  
                    ! Positive Definite PPM  
                 ELSE IF (iadv(iq)==18) THEN  
                    ! Ss-prg PPM3d de Lin  
                    CALL ppm3d(1, qppm(1, 1, iq), psppm, psppm, unatppm, &  
                         vnatppm, fluxwppm, dtbon, 5, 5, 5, 1, iim, jjp1, 2, &  
                         llm, apppm, bpppm, 0.01, 6400000, fill, dum, 220.)  
                 END IF  
              END DO  
   
              ! Ss-prg interface PPM3d-LMDZ.4  
              CALL interpost(q(1, 1, iq), qppm(1, 1, iq))  
           END IF  
134         END DO         END DO
135    
136         ! on reinitialise a zero les flux de masse cumules         ! on reinitialise a zero les flux de masse cumules
Legend:
Removed from v.82  
changed lines
  Added in v.178
  ViewVC Help
Powered by ViewVC 1.1.21