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

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

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

revision 168 by guez, Wed Sep 9 10:41:47 2015 UTC 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
     use interpre_m, only: interpre  
16      use massbar_m, only: massbar      use massbar_m, only: massbar
17      USE paramet_m, ONLY : iip1, iip2, ijmllm, ijp1llm, ip1jm, ip1jmp1, jjp1, &      USE paramet_m, ONLY : iip1, iip2, ijmllm, ijp1llm, ip1jm, ip1jmp1, llmp1
          llmp1  
     use ppm3d_m, only: ppm3d  
18      use vlsplt_m, only: vlsplt      use vlsplt_m, only: vlsplt
19      use vlspltqs_m, only: vlspltqs      use vlspltqs_m, only: vlspltqs
20    
# Line 42  contains Line 39  contains
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:: fill = .TRUE.  
45    
46      !-----------------------------------------------------------      !-----------------------------------------------------------
47    
# Line 117  contains Line 104  contains
104            case (10)            case (10)
105               ! Schema de Van Leer I MUSCL               ! Schema de Van Leer I MUSCL
106               CALL vlsplt(q(:, :, iq), 2., massem, wg, pbarug, pbarvg, dtvr)               CALL vlsplt(q(:, :, iq), 2., massem, wg, pbarug, pbarvg, dtvr)
107            case (14)             case (12)
              ! Schema "pseudo amont" + test sur humidite specifique  
              ! pour la vapeur d'eau. F. Codron  
              CALL vlspltqs(q(1, 1, 1), 2., massem, wg, pbarug, pbarvg, dtvr, &  
                   p, pk, teta)  
           case (12)  
108               ! Schema de Frederic Hourdin               ! Schema de Frederic Hourdin
109               ! Pas de temps adaptatif               ! Pas de temps adaptatif
110               CALL adaptdt(dtbon, n, pbarug, massem)               CALL adaptdt(dtbon, n, pbarug, massem)
# Line 143  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            case (20)           case (14)
129               ! Schema de pente SLOPES               ! 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            case (30)               CALL vlspltqs(q(1, 1, 1), 2., massem, wg, pbarug, pbarvg, dtvr, &
132               ! Schema de Prather                    p, pk, teta)
              ! 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  
              CALL prather(q(1, 1, iq), wg, massem, pbarug, pbarvg, n, dtbon)  
           case (11, 16:18)  
              ! Schemas PPM Lin et Rood  
              ! 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, 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, 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, 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, 220.)  
                 END IF  
              END DO  
   
              ! Ss-prg interface PPM3d-LMDZ.4  
              CALL interpost(q(1, 1, iq), qppm(1, 1, iq))  
133            END select            END select
134         END DO         END DO
135    
Legend:
Removed from v.168  
changed lines
  Added in v.178
  ViewVC Help
Powered by ViewVC 1.1.21