/[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 168 by guez, Wed Sep 9 10:41:47 2015 UTC
# Line 13  contains Line 13  contains
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 : iim, jjm, llm, nqmx
15      USE iniadvtrac_m, ONLY : iadv      USE iniadvtrac_m, ONLY : iadv
16        use interpre_m, only: interpre
17        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, jjp1, &
19           llmp1           llmp1
20        use ppm3d_m, only: ppm3d
21        use vlsplt_m, only: vlsplt
22        use vlspltqs_m, only: vlspltqs
23    
24      REAL, intent(in):: pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)      REAL, intent(in):: pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
25      REAL, intent(in):: p(ip1jmp1, llmp1)      REAL, intent(in):: p(ip1jmp1, llmp1)
# Line 31  contains Line 36  contains
36      REAL, save:: massem(ip1jmp1, llm)      REAL, save:: massem(ip1jmp1, llm)
37      real zdp(ip1jmp1)      real zdp(ip1jmp1)
38      REAL pbarug(ip1jmp1, llm), pbarvg(ip1jm, llm), wg(ip1jmp1, llm)      REAL pbarug(ip1jmp1, llm), pbarvg(ip1jm, llm), wg(ip1jmp1, llm)
     REAL cpuadv(nqmx)  
39    
40      INTEGER:: iadvtr = 0      INTEGER:: iadvtr = 0
41      INTEGER ij, l, iq      INTEGER ij, l, iq
# Line 50  contains Line 54  contains
54      REAL qppm(iim*jjp1, llm, nqmx)      REAL qppm(iim*jjp1, llm, nqmx)
55      REAL fluxwppm(iim, jjp1, llm)      REAL fluxwppm(iim, jjp1, llm)
56      REAL apppm(llmp1), bpppm(llmp1)      REAL apppm(llmp1), bpppm(llmp1)
57      LOGICAL:: dum = .TRUE., fill = .TRUE.      LOGICAL:: fill = .TRUE.
58    
59      !-----------------------------------------------------------      !-----------------------------------------------------------
60    
# Line 81  contains Line 85  contains
85         ! 1. calcul de w         ! 1. calcul de w
86         ! 2. groupement des mailles pres du pole.         ! 2. groupement des mailles pres du pole.
87    
88         CALL groupe(massem, pbaruc, pbarvc, pbarug, pbarvg, wg)         CALL groupe(pbaruc, pbarvc, pbarug, pbarvg, wg)
89    
90         ! test sur l'eventuelle creation de valeurs negatives de la masse         ! test sur l'eventuelle creation de valeurs negatives de la masse
91         DO l = 1, llm - 1         DO l = 1, llm - 1
# Line 103  contains Line 107  contains
107    
108         ! Advection proprement dite         ! Advection proprement dite
109    
110         ! Calcul des moyennes basées sur la masse         ! Calcul des moyennes bas\'ees sur la masse
111         CALL massbar(massem, massebx, masseby)         CALL massbar(massem, massebx, masseby)
112    
113         ! Appel des sous programmes d'advection         ! Appel des sous programmes d'advection
114    
115         DO iq = 1, nqmx         DO iq = 1, nqmx
116            IF (iadv(iq)==0) CYCLE            select case (iadv(iq))
117              case (10)
118            ! Schema de Van Leer I MUSCL               ! Schema de Van Leer I MUSCL
   
           IF (iadv(iq)==10) THEN  
119               CALL vlsplt(q(:, :, iq), 2., massem, wg, pbarug, pbarvg, dtvr)               CALL vlsplt(q(:, :, iq), 2., massem, wg, pbarug, pbarvg, dtvr)
120              case (14)
121               ! Schema "pseudo amont" + test sur humidite specifique               ! Schema "pseudo amont" + test sur humidite specifique
122               ! pour la vapeur d'eau. F. Codron               ! pour la vapeur d'eau. F. Codron
           ELSE IF (iadv(iq)==14) THEN  
123               CALL vlspltqs(q(1, 1, 1), 2., massem, wg, pbarug, pbarvg, dtvr, &               CALL vlspltqs(q(1, 1, 1), 2., massem, wg, pbarug, pbarvg, dtvr, &
124                    p, pk, teta)                    p, pk, teta)
125              case (12)
126               ! Schema de Frederic Hourdin               ! Schema de Frederic Hourdin
           ELSE IF (iadv(iq)==12) THEN  
127               ! Pas de temps adaptatif               ! Pas de temps adaptatif
128               CALL adaptdt(iadv(iq), dtbon, n, pbarug, massem)               CALL adaptdt(dtbon, n, pbarug, massem)
129               IF (n>1) THEN               IF (n>1) THEN
130                  WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &                  WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &
131                       'n=', n                       'n=', n
# Line 131  contains Line 133  contains
133               DO indice = 1, n               DO indice = 1, n
134                  CALL advn(q(1, 1, iq), massem, wg, pbarug, pbarvg, dtbon, 1)                  CALL advn(q(1, 1, iq), massem, wg, pbarug, pbarvg, dtbon, 1)
135               END DO               END DO
136            ELSE IF (iadv(iq)==13) THEN            case (13)
137               ! Pas de temps adaptatif               ! Pas de temps adaptatif
138               CALL adaptdt(iadv(iq), dtbon, n, pbarug, massem)               CALL adaptdt(dtbon, n, pbarug, massem)
139               IF (n>1) THEN               IF (n>1) THEN
140                  WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &                  WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &
141                       'n=', n                       'n=', n
# Line 141  contains Line 143  contains
143               DO indice = 1, n               DO indice = 1, n
144                  CALL advn(q(1, 1, iq), massem, wg, pbarug, pbarvg, dtbon, 2)                  CALL advn(q(1, 1, iq), massem, wg, pbarug, pbarvg, dtbon, 2)
145               END DO               END DO
146              case (20)
147               ! Schema de pente SLOPES               ! Schema de pente SLOPES
           ELSE IF (iadv(iq)==20) THEN  
148               CALL pentes_ini(q(1, 1, iq), wg, massem, pbarug, pbarvg, 0)               CALL pentes_ini(q(1, 1, iq), wg, massem, pbarug, pbarvg, 0)
149              case (30)
150               ! Schema de Prather               ! Schema de Prather
           ELSE IF (iadv(iq)==30) THEN  
151               ! Pas de temps adaptatif               ! Pas de temps adaptatif
152               CALL adaptdt(iadv(iq), dtbon, n, pbarug, massem)               CALL adaptdt(dtbon, n, pbarug, massem)
153               IF (n>1) THEN               IF (n>1) THEN
154                  WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &                  WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &
155                       'n=', n                       'n=', n
156               END IF               END IF
157               CALL prather(q(1, 1, iq), wg, massem, pbarug, pbarvg, n, dtbon)               CALL prather(q(1, 1, iq), wg, massem, pbarug, pbarvg, n, dtbon)
158              case (11, 16:18)
159               ! Schemas PPM Lin et Rood               ! Schemas PPM Lin et Rood
           ELSE IF (iadv(iq)==11 .OR. (iadv(iq)>=16 .AND. iadv(iq)<=18)) THEN  
160               ! Test sur le flux horizontal               ! Test sur le flux horizontal
161               ! Pas de temps adaptatif               ! Pas de temps adaptatif
162               CALL adaptdt(iadv(iq), dtbon, n, pbarug, massem)               CALL adaptdt(dtbon, n, pbarug, massem)
163               IF (n>1) THEN               IF (n>1) THEN
164                  WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &                  WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &
165                       'n=', n                       'n=', n
# Line 187  contains Line 189  contains
189                     ! Ss-prg PPM3d de Lin                     ! Ss-prg PPM3d de Lin
190                     CALL ppm3d(1, qppm(1, 1, iq), psppm, psppm, unatppm, &                     CALL ppm3d(1, qppm(1, 1, iq), psppm, psppm, unatppm, &
191                          vnatppm, fluxwppm, dtbon, 2, 2, 2, 1, iim, jjp1, 2, &                          vnatppm, fluxwppm, dtbon, 2, 2, 2, 1, iim, jjp1, 2, &
192                          llm, apppm, bpppm, 0.01, 6400000, fill, dum, 220.)                          llm, apppm, bpppm, 0.01, 6400000, fill, 220.)
193                     ! Monotonic PPM                     ! Monotonic PPM
194                  ELSE IF (iadv(iq)==16) THEN                  ELSE IF (iadv(iq)==16) THEN
195                     ! Ss-prg PPM3d de Lin                     ! Ss-prg PPM3d de Lin
196                     CALL ppm3d(1, qppm(1, 1, iq), psppm, psppm, unatppm, &                     CALL ppm3d(1, qppm(1, 1, iq), psppm, psppm, unatppm, &
197                          vnatppm, fluxwppm, dtbon, 3, 3, 3, 1, iim, jjp1, 2, &                          vnatppm, fluxwppm, dtbon, 3, 3, 3, 1, iim, jjp1, 2, &
198                          llm, apppm, bpppm, 0.01, 6400000, fill, dum, 220.)                          llm, apppm, bpppm, 0.01, 6400000, fill, 220.)
199                     ! Semi Monotonic PPM                     ! Semi Monotonic PPM
200                  ELSE IF (iadv(iq)==17) THEN                  ELSE IF (iadv(iq)==17) THEN
201                     ! Ss-prg PPM3d de Lin                     ! Ss-prg PPM3d de Lin
202                     CALL ppm3d(1, qppm(1, 1, iq), psppm, psppm, unatppm, &                     CALL ppm3d(1, qppm(1, 1, iq), psppm, psppm, unatppm, &
203                          vnatppm, fluxwppm, dtbon, 4, 4, 4, 1, iim, jjp1, 2, &                          vnatppm, fluxwppm, dtbon, 4, 4, 4, 1, iim, jjp1, 2, &
204                          llm, apppm, bpppm, 0.01, 6400000, fill, dum, 220.)                          llm, apppm, bpppm, 0.01, 6400000, fill, 220.)
205                     ! Positive Definite PPM                     ! Positive Definite PPM
206                  ELSE IF (iadv(iq)==18) THEN                  ELSE IF (iadv(iq)==18) THEN
207                     ! Ss-prg PPM3d de Lin                     ! Ss-prg PPM3d de Lin
208                     CALL ppm3d(1, qppm(1, 1, iq), psppm, psppm, unatppm, &                     CALL ppm3d(1, qppm(1, 1, iq), psppm, psppm, unatppm, &
209                          vnatppm, fluxwppm, dtbon, 5, 5, 5, 1, iim, jjp1, 2, &                          vnatppm, fluxwppm, dtbon, 5, 5, 5, 1, iim, jjp1, 2, &
210                          llm, apppm, bpppm, 0.01, 6400000, fill, dum, 220.)                          llm, apppm, bpppm, 0.01, 6400000, fill, 220.)
211                  END IF                  END IF
212               END DO               END DO
213    
214               ! Ss-prg interface PPM3d-LMDZ.4               ! Ss-prg interface PPM3d-LMDZ.4
215               CALL interpost(q(1, 1, iq), qppm(1, 1, iq))               CALL interpost(q(1, 1, iq), qppm(1, 1, iq))
216            END IF            END select
217         END DO         END DO
218    
219         ! 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.168
  ViewVC Help
Powered by ViewVC 1.1.21