--- trunk/dyn3d/advtrac.f	2014/03/26 17:18:58	91
+++ trunk/Sources/dyn3d/advtrac.f	2015/08/24 16:30:33	167
@@ -13,9 +13,13 @@
     USE conf_gcm_m, ONLY : iapp_tracvl
     USE dimens_m, ONLY : iim, jjm, llm, nqmx
     USE iniadvtrac_m, ONLY : iadv
+    use interpre_m, only: interpre
     use massbar_m, only: massbar
     USE paramet_m, ONLY : iip1, iip2, ijmllm, ijp1llm, ip1jm, ip1jmp1, jjp1, &
          llmp1
+    use ppm3d_m, only: ppm3d
+    use vlsplt_m, only: vlsplt
+    use vlspltqs_m, only: vlspltqs
 
     REAL, intent(in):: pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
     REAL, intent(in):: p(ip1jmp1, llmp1)
@@ -32,7 +36,6 @@
     REAL, save:: massem(ip1jmp1, llm)
     real zdp(ip1jmp1)
     REAL pbarug(ip1jmp1, llm), pbarvg(ip1jm, llm), wg(ip1jmp1, llm)
-    REAL cpuadv(nqmx)
 
     INTEGER:: iadvtr = 0
     INTEGER ij, l, iq
@@ -82,7 +85,7 @@
        ! 1. calcul de w
        ! 2. groupement des mailles pres du pole.
 
-       CALL groupe(massem, pbaruc, pbarvc, pbarug, pbarvg, wg)
+       CALL groupe(pbaruc, pbarvc, pbarug, pbarvg, wg)
 
        ! test sur l'eventuelle creation de valeurs negatives de la masse
        DO l = 1, llm - 1
@@ -104,27 +107,25 @@
 
        ! Advection proprement dite
 
-       ! Calcul des moyennes basées sur la masse
+       ! Calcul des moyennes bas\'ees sur la masse
        CALL massbar(massem, massebx, masseby)
 
        ! Appel des sous programmes d'advection
 
        DO iq = 1, nqmx
-          IF (iadv(iq)==0) CYCLE
-
-          ! Schema de Van Leer I MUSCL
-
-          IF (iadv(iq)==10) THEN
+          select case (iadv(iq))
+          case (10)
+             ! Schema de Van Leer I MUSCL
              CALL vlsplt(q(:, :, iq), 2., massem, wg, pbarug, pbarvg, dtvr)
+          case (14)
              ! Schema "pseudo amont" + test sur humidite specifique
              ! pour la vapeur d'eau. F. Codron
-          ELSE IF (iadv(iq)==14) THEN
              CALL vlspltqs(q(1, 1, 1), 2., massem, wg, pbarug, pbarvg, dtvr, &
                   p, pk, teta)
+          case (12)
              ! Schema de Frederic Hourdin
-          ELSE IF (iadv(iq)==12) THEN
              ! Pas de temps adaptatif
-             CALL adaptdt(iadv(iq), dtbon, n, pbarug, massem)
+             CALL adaptdt(dtbon, n, pbarug, massem)
              IF (n>1) THEN
                 WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &
                      'n=', n
@@ -132,9 +133,9 @@
              DO indice = 1, n
                 CALL advn(q(1, 1, iq), massem, wg, pbarug, pbarvg, dtbon, 1)
              END DO
-          ELSE IF (iadv(iq)==13) THEN
+          case (13)
              ! Pas de temps adaptatif
-             CALL adaptdt(iadv(iq), dtbon, n, pbarug, massem)
+             CALL adaptdt(dtbon, n, pbarug, massem)
              IF (n>1) THEN
                 WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &
                      'n=', n
@@ -142,23 +143,23 @@
              DO indice = 1, n
                 CALL advn(q(1, 1, iq), massem, wg, pbarug, pbarvg, dtbon, 2)
              END DO
+          case (20)
              ! Schema de pente SLOPES
-          ELSE IF (iadv(iq)==20) THEN
              CALL pentes_ini(q(1, 1, iq), wg, massem, pbarug, pbarvg, 0)
+          case (30)
              ! Schema de Prather
-          ELSE IF (iadv(iq)==30) THEN
              ! Pas de temps adaptatif
-             CALL adaptdt(iadv(iq), dtbon, n, pbarug, massem)
+             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
-          ELSE IF (iadv(iq)==11 .OR. (iadv(iq)>=16 .AND. iadv(iq)<=18)) THEN
              ! Test sur le flux horizontal
              ! Pas de temps adaptatif
-             CALL adaptdt(iadv(iq), dtbon, n, pbarug, massem)
+             CALL adaptdt(dtbon, n, pbarug, massem)
              IF (n>1) THEN
                 WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &
                      'n=', n
@@ -188,31 +189,31 @@
                    ! 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, dum, 220.)
+                        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, dum, 220.)
+                        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, dum, 220.)
+                        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, dum, 220.)
+                        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))
-          END IF
+          END select
        END DO
 
        ! on reinitialise a zero les flux de masse cumules