/[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/libf/dyn3d/advtrac.f90 revision 71 by guez, Mon Jul 8 18:12:18 2013 UTC trunk/Sources/dyn3d/advtrac.f revision 157 by guez, Mon Jul 20 16:01:49 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 vlsplt_m, only: vlsplt
21        use vlspltqs_m, only: vlspltqs
22    
23      REAL, intent(in):: pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)      REAL, intent(in):: pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
24      REAL, intent(in):: p(ip1jmp1, llmp1)      REAL, intent(in):: p(ip1jmp1, llmp1)
# Line 31  contains Line 35  contains
35      REAL, save:: massem(ip1jmp1, llm)      REAL, save:: massem(ip1jmp1, llm)
36      real zdp(ip1jmp1)      real zdp(ip1jmp1)
37      REAL pbarug(ip1jmp1, llm), pbarvg(ip1jm, llm), wg(ip1jmp1, llm)      REAL pbarug(ip1jmp1, llm), pbarvg(ip1jm, llm), wg(ip1jmp1, llm)
     REAL cpuadv(nqmx)  
38    
39      INTEGER:: iadvtr = 0      INTEGER:: iadvtr = 0
40      INTEGER ij, l, iq      INTEGER ij, l, iq
# Line 81  contains Line 84  contains
84         ! 1. calcul de w         ! 1. calcul de w
85         ! 2. groupement des mailles pres du pole.         ! 2. groupement des mailles pres du pole.
86    
87         CALL groupe(massem, pbaruc, pbarvc, pbarug, pbarvg, wg)         CALL groupe(pbaruc, pbarvc, pbarug, pbarvg, wg)
88    
89         ! test sur l'eventuelle creation de valeurs negatives de la masse         ! test sur l'eventuelle creation de valeurs negatives de la masse
90         DO l = 1, llm - 1         DO l = 1, llm - 1
# Line 103  contains Line 106  contains
106    
107         ! Advection proprement dite         ! Advection proprement dite
108    
109         ! Calcul des moyennes basées sur la masse         ! Calcul des moyennes bas\'ees sur la masse
110         CALL massbar(massem, massebx, masseby)         CALL massbar(massem, massebx, masseby)
111    
112         ! Appel des sous programmes d'advection         ! Appel des sous programmes d'advection
113    
114         DO iq = 1, nqmx         DO iq = 1, nqmx
115            IF (iadv(iq)==0) CYCLE            select case (iadv(iq))
116              case (10)
117            ! Schema de Van Leer I MUSCL               ! Schema de Van Leer I MUSCL
   
           IF (iadv(iq)==10) THEN  
118               CALL vlsplt(q(:, :, iq), 2., massem, wg, pbarug, pbarvg, dtvr)               CALL vlsplt(q(:, :, iq), 2., massem, wg, pbarug, pbarvg, dtvr)
119              case (14)
120               ! Schema "pseudo amont" + test sur humidite specifique               ! Schema "pseudo amont" + test sur humidite specifique
121               ! pour la vapeur d'eau. F. Codron               ! pour la vapeur d'eau. F. Codron
           ELSE IF (iadv(iq)==14) THEN  
122               CALL vlspltqs(q(1, 1, 1), 2., massem, wg, pbarug, pbarvg, dtvr, &               CALL vlspltqs(q(1, 1, 1), 2., massem, wg, pbarug, pbarvg, dtvr, &
123                    p, pk, teta)                    p, pk, teta)
124              case (12)
125               ! Schema de Frederic Hourdin               ! Schema de Frederic Hourdin
           ELSE IF (iadv(iq)==12) THEN  
126               ! Pas de temps adaptatif               ! Pas de temps adaptatif
127               CALL adaptdt(iadv(iq), dtbon, n, pbarug, massem)               CALL adaptdt(dtbon, n, pbarug, massem)
128               IF (n>1) THEN               IF (n>1) THEN
129                  WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &                  WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &
130                       'n=', n                       'n=', n
# Line 131  contains Line 132  contains
132               DO indice = 1, n               DO indice = 1, n
133                  CALL advn(q(1, 1, iq), massem, wg, pbarug, pbarvg, dtbon, 1)                  CALL advn(q(1, 1, iq), massem, wg, pbarug, pbarvg, dtbon, 1)
134               END DO               END DO
135            ELSE IF (iadv(iq)==13) THEN            case (13)
136               ! Pas de temps adaptatif               ! Pas de temps adaptatif
137               CALL adaptdt(iadv(iq), dtbon, n, pbarug, massem)               CALL adaptdt(dtbon, n, pbarug, massem)
138               IF (n>1) THEN               IF (n>1) THEN
139                  WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &                  WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &
140                       'n=', n                       'n=', n
# Line 141  contains Line 142  contains
142               DO indice = 1, n               DO indice = 1, n
143                  CALL advn(q(1, 1, iq), massem, wg, pbarug, pbarvg, dtbon, 2)                  CALL advn(q(1, 1, iq), massem, wg, pbarug, pbarvg, dtbon, 2)
144               END DO               END DO
145              case (20)
146               ! Schema de pente SLOPES               ! Schema de pente SLOPES
           ELSE IF (iadv(iq)==20) THEN  
147               CALL pentes_ini(q(1, 1, iq), wg, massem, pbarug, pbarvg, 0)               CALL pentes_ini(q(1, 1, iq), wg, massem, pbarug, pbarvg, 0)
148              case (30)
149               ! Schema de Prather               ! Schema de Prather
           ELSE IF (iadv(iq)==30) THEN  
150               ! Pas de temps adaptatif               ! Pas de temps adaptatif
151               CALL adaptdt(iadv(iq), dtbon, n, pbarug, massem)               CALL adaptdt(dtbon, n, pbarug, massem)
152               IF (n>1) THEN               IF (n>1) THEN
153                  WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &                  WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &
154                       'n=', n                       'n=', n
155               END IF               END IF
156               CALL prather(q(1, 1, iq), wg, massem, pbarug, pbarvg, n, dtbon)               CALL prather(q(1, 1, iq), wg, massem, pbarug, pbarvg, n, dtbon)
157              case (11, 16:18)
158               ! Schemas PPM Lin et Rood               ! Schemas PPM Lin et Rood
           ELSE IF (iadv(iq)==11 .OR. (iadv(iq)>=16 .AND. iadv(iq)<=18)) THEN  
159               ! Test sur le flux horizontal               ! Test sur le flux horizontal
160               ! Pas de temps adaptatif               ! Pas de temps adaptatif
161               CALL adaptdt(iadv(iq), dtbon, n, pbarug, massem)               CALL adaptdt(dtbon, n, pbarug, massem)
162               IF (n>1) THEN               IF (n>1) THEN
163                  WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &                  WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &
164                       'n=', n                       'n=', n
# Line 211  contains Line 212  contains
212    
213               ! Ss-prg interface PPM3d-LMDZ.4               ! Ss-prg interface PPM3d-LMDZ.4
214               CALL interpost(q(1, 1, iq), qppm(1, 1, iq))               CALL interpost(q(1, 1, iq), qppm(1, 1, iq))
215            END IF            END select
216         END DO         END DO
217    
218         ! on reinitialise a zero les flux de masse cumules         ! on reinitialise a zero les flux de masse cumules
Legend:
Removed from v.71  
changed lines
  Added in v.157
  ViewVC Help
Powered by ViewVC 1.1.21