/[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 44 by guez, Wed Apr 13 12:29:18 2011 UTC trunk/Sources/dyn3d/advtrac.f revision 157 by guez, Mon Jul 20 16:01:49 2015 UTC
# Line 9  contains Line 9  contains
9      ! From dyn3d/advtrac.F, version 1.4 2005/04/13 08:58:34      ! From dyn3d/advtrac.F, version 1.4 2005/04/13 08:58:34
10      ! Author: F. Hourdin      ! Author: F. Hourdin
11    
     USE dimens_m, ONLY : iim, jjm, llm, nqmx  
     USE paramet_m, ONLY : iip1, iip2, ijmllm, ijp1llm, ip1jm, ip1jmp1, jjp1, &  
          llmp1  
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
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, &
19             llmp1
20        use vlsplt_m, only: vlsplt
21        use vlspltqs_m, only: vlspltqs
22    
23      ! Arguments      REAL, intent(in):: pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
   
     INTEGER iapptrac  
     REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)  
     REAL, intent(inout):: q(ip1jmp1, llm, nqmx)  
     real masse(ip1jmp1, llm)  
24      REAL, intent(in):: p(ip1jmp1, llmp1)      REAL, intent(in):: p(ip1jmp1, llmp1)
25        real, intent(in):: masse(ip1jmp1, llm)
26        REAL, intent(inout):: q(ip1jmp1, llm, nqmx)
27        INTEGER, intent(out):: iapptrac
28      real, intent(in):: teta(ip1jmp1, llm)      real, intent(in):: teta(ip1jmp1, llm)
29      REAL pk(ip1jmp1, llm)      REAL, intent(in):: pk(ip1jmp1, llm)
30    
31      ! Variables locales      ! Variables locales
32    
# Line 33  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 72  contains Line 73  contains
73      END DO      END DO
74    
75      ! selection de la masse instantannee des mailles avant le transport.      ! selection de la masse instantannee des mailles avant le transport.
76      IF (iadvtr==0) THEN      IF (iadvtr==0) massem = masse
        CALL scopy(ip1jmp1*llm, masse, 1, massem, 1)  
     END IF  
77    
78      iadvtr = iadvtr + 1      iadvtr = iadvtr + 1
79      iapptrac = iadvtr      iapptrac = iadvtr
80    
81      ! Test pour savoir si on advecte a ce pas de temps      ! Test pour savoir si on advecte a ce pas de temps
82      IF (iadvtr==iapp_tracvl) THEN      IF (iadvtr == iapp_tracvl) THEN
83         ! traitement des flux de masse avant advection.         ! traitement des flux de masse avant advection.
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 107  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 135  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 145  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 215  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.44  
changed lines
  Added in v.157
  ViewVC Help
Powered by ViewVC 1.1.21