/[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/Sources/dyn3d/advtrac.f revision 150 by guez, Thu Jun 18 13:49:26 2015 UTC trunk/dyn3d/advtrac.f revision 265 by guez, Tue Mar 20 09:35:59 2018 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 dimensions, ONLY : jjm, llm, nqmx
15        use groupe_m, only: groupe
16      USE iniadvtrac_m, ONLY : iadv      USE iniadvtrac_m, ONLY : iadv
     use interpre_m, only: interpre  
17      use massbar_m, only: massbar      use massbar_m, only: massbar
18      USE paramet_m, ONLY : iip1, iip2, ijmllm, ijp1llm, ip1jm, ip1jmp1, jjp1, &      USE paramet_m, ONLY : iip1, iip2, ijmllm, ijp1llm, ip1jm, ip1jmp1, llmp1
19           llmp1      use vlsplt_m, only: vlsplt
20      use vlspltqs_m, only: vlspltqs      use vlspltqs_m, only: vlspltqs
21    
22      REAL, intent(in):: pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)      REAL, intent(in):: pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
# Line 40  contains Line 40  contains
40      REAL zdpmin, zdpmax      REAL zdpmin, zdpmax
41      EXTERNAL minmax      EXTERNAL minmax
42    
     ! Rajouts pour PPM  
   
43      INTEGER indice, n      INTEGER indice, n
44      ! Pas de temps adaptatif pour que CFL < 1      ! Pas de temps adaptatif pour que CFL < 1
45      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.  
46    
47      !-----------------------------------------------------------      !-----------------------------------------------------------
48    
# Line 111  contains Line 101  contains
101         ! Appel des sous programmes d'advection         ! Appel des sous programmes d'advection
102    
103         DO iq = 1, nqmx         DO iq = 1, nqmx
104            IF (iadv(iq)==0) CYCLE            select case (iadv(iq))
105              case (10)
106            ! Schema de Van Leer I MUSCL               ! Schema de Van Leer I MUSCL
   
           IF (iadv(iq)==10) THEN  
107               CALL vlsplt(q(:, :, iq), 2., massem, wg, pbarug, pbarvg, dtvr)               CALL vlsplt(q(:, :, iq), 2., massem, wg, pbarug, pbarvg, dtvr)
108               ! 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)  
109               ! Schema de Frederic Hourdin               ! Schema de Frederic Hourdin
           ELSE IF (iadv(iq)==12) THEN  
110               ! Pas de temps adaptatif               ! Pas de temps adaptatif
111               CALL adaptdt(dtbon, n, pbarug, massem)               CALL adaptdt(dtbon, n, pbarug, massem)
112               IF (n>1) THEN               IF (n>1) THEN
# Line 133  contains Line 116  contains
116               DO indice = 1, n               DO indice = 1, n
117                  CALL advn(q(1, 1, iq), massem, wg, pbarug, pbarvg, dtbon, 1)                  CALL advn(q(1, 1, iq), massem, wg, pbarug, pbarvg, dtbon, 1)
118               END DO               END DO
119            ELSE IF (iadv(iq)==13) THEN            case (13)
120               ! Pas de temps adaptatif               ! Pas de temps adaptatif
121               CALL adaptdt(dtbon, n, pbarug, massem)               CALL adaptdt(dtbon, n, pbarug, massem)
122               IF (n>1) THEN               IF (n>1) THEN
# Line 143  contains Line 126  contains
126               DO indice = 1, n               DO indice = 1, n
127                  CALL advn(q(1, 1, iq), massem, wg, pbarug, pbarvg, dtbon, 2)                  CALL advn(q(1, 1, iq), massem, wg, pbarug, pbarvg, dtbon, 2)
128               END DO               END DO
129               ! Schema de pente SLOPES           case (14)
130            ELSE IF (iadv(iq)==20) THEN               ! Schema "pseudo amont" + test sur humidite specifique
131               CALL pentes_ini(q(1, 1, iq), wg, massem, pbarug, pbarvg, 0)               ! pour la vapeur d'eau. F. Codron
132               ! Schema de Prather               CALL vlspltqs(q(1, 1, 1), 2., massem, wg, pbarug, pbarvg, dtvr, &
133            ELSE IF (iadv(iq)==30) THEN                    p, pk, teta)
134               ! Pas de temps adaptatif            END select
              CALL adaptdt(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(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  
135         END DO         END DO
136    
137         ! on reinitialise a zero les flux de masse cumules         ! on reinitialise a zero les flux de masse cumules
Legend:
Removed from v.150  
changed lines
  Added in v.265
  ViewVC Help
Powered by ViewVC 1.1.21