/[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

trunk/libf/dyn3d/advtrac.f90 revision 40 by guez, Tue Feb 22 13:49:36 2011 UTC trunk/Sources/dyn3d/advtrac.f revision 150 by guez, Thu Jun 18 13:49:26 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 vlspltqs_m, only: vlspltqs
21    
22      ! 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)  
23      REAL, intent(in):: p(ip1jmp1, llmp1)      REAL, intent(in):: p(ip1jmp1, llmp1)
24      real teta(ip1jmp1, llm)      real, intent(in):: masse(ip1jmp1, llm)
25      REAL pk(ip1jmp1, llm)      REAL, intent(inout):: q(ip1jmp1, llm, nqmx)
26        INTEGER, intent(out):: iapptrac
27        real, intent(in):: teta(ip1jmp1, llm)
28        REAL, intent(in):: pk(ip1jmp1, llm)
29    
30      ! Variables locales      ! Variables locales
31    
# Line 33  contains Line 34  contains
34      REAL, save:: massem(ip1jmp1, llm)      REAL, save:: massem(ip1jmp1, llm)
35      real zdp(ip1jmp1)      real zdp(ip1jmp1)
36      REAL pbarug(ip1jmp1, llm), pbarvg(ip1jm, llm), wg(ip1jmp1, llm)      REAL pbarug(ip1jmp1, llm), pbarvg(ip1jm, llm), wg(ip1jmp1, llm)
     REAL cpuadv(nqmx)  
37    
38      INTEGER:: iadvtr = 0      INTEGER:: iadvtr = 0
39      INTEGER ij, l, iq      INTEGER ij, l, iq
# Line 72  contains Line 72  contains
72      END DO      END DO
73    
74      ! selection de la masse instantannee des mailles avant le transport.      ! selection de la masse instantannee des mailles avant le transport.
75      IF (iadvtr==0) THEN      IF (iadvtr==0) massem = masse
        CALL scopy(ip1jmp1*llm, masse, 1, massem, 1)  
     END IF  
76    
77      iadvtr = iadvtr + 1      iadvtr = iadvtr + 1
78      iapptrac = iadvtr      iapptrac = iadvtr
79    
80      ! Test pour savoir si on advecte a ce pas de temps      ! Test pour savoir si on advecte a ce pas de temps
81      IF (iadvtr==iapp_tracvl) THEN      IF (iadvtr == iapp_tracvl) THEN
82         ! traitement des flux de masse avant advection.         ! traitement des flux de masse avant advection.
83         ! 1. calcul de w         ! 1. calcul de w
84         ! 2. groupement des mailles pres du pole.         ! 2. groupement des mailles pres du pole.
85    
86         CALL groupe(massem, pbaruc, pbarvc, pbarug, pbarvg, wg)         CALL groupe(pbaruc, pbarvc, pbarug, pbarvg, wg)
87    
88         ! test sur l'eventuelle creation de valeurs negatives de la masse         ! test sur l'eventuelle creation de valeurs negatives de la masse
89         DO l = 1, llm - 1         DO l = 1, llm - 1
# Line 107  contains Line 105  contains
105    
106         ! Advection proprement dite         ! Advection proprement dite
107    
108         ! Calcul des moyennes basées sur la masse         ! Calcul des moyennes bas\'ees sur la masse
109         CALL massbar(massem, massebx, masseby)         CALL massbar(massem, massebx, masseby)
110    
111         ! Appel des sous programmes d'advection         ! Appel des sous programmes d'advection
# Line 127  contains Line 125  contains
125               ! Schema de Frederic Hourdin               ! Schema de Frederic Hourdin
126            ELSE IF (iadv(iq)==12) THEN            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 137  contains Line 135  contains
135               END DO               END DO
136            ELSE IF (iadv(iq)==13) THEN            ELSE IF (iadv(iq)==13) THEN
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 151  contains Line 149  contains
149               ! Schema de Prather               ! Schema de Prather
150            ELSE IF (iadv(iq)==30) THEN            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
# Line 161  contains Line 159  contains
159            ELSE IF (iadv(iq)==11 .OR. (iadv(iq)>=16 .AND. iadv(iq)<=18)) THEN            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
Legend:
Removed from v.40  
changed lines
  Added in v.150
  ViewVC Help
Powered by ViewVC 1.1.21