Changeset 344 for LMDZ.3.3/trunk/libf/dyn3d/tracvl.F

Timestamp:

Mar 6, 2002, 3:58:31 PM (22 years ago)

Author:

lmdz

Message:

Inclusion des modifs de D. Hauglustaine pour la version 1 de INCA
LF

File:

• LMDZ.3.3/trunk/libf/dyn3d/tracvl.F (modified) (4 diffs)

LMDZ.3.3/trunk/libf/dyn3d/tracvl.F

@@ -1 @@
-      SUBROUTINE tracvl(numvanle,iapp_tracvl,nq,pbaru,pbarv ,
-     *                    p, masse , q, iapptrac, iadv1, teta, pk  )
+      SUBROUTINE tracvl(numvanle,
+     *                  iapp_tracvl,
+     *                  nq,
+     *                  pbaru,
+     *                  pbarv,
+     *                  p, 
+     *                  masse, 
+     *                  q, 
+     *                  iapptrac, 
+     *                  iadv1, 
+     *                  teta, 
+#ifdef INCA_CH4
+     *                  flxw,
+     *                  pk, 
+     *                  mmt_adj,
+     *                  adv_flg)
+#else
+     *                  pk) 
+#endif
 c
 c     Auteur :  F. Hourdin
@@ -20 +37 @@
 c
       INTEGER numvanle, nq, iapp_tracvl, iapptrac, iadv1
-
       REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
       REAL q(ip1jmp1,llm,nq),masse(ip1jmp1,llm)
       REAL p( ip1jmp1,llmp1 ),teta(ip1jmp1,llm)
       REAL pk(ip1jmp1,llm)
-
+#ifdef INCA_CH4
+      INTEGER, PARAMETER :: ntra   = 1
+      INTEGER, PARAMETER :: nprath = 1
+      INTEGER            :: adv_flg(nq)
+      REAL               :: mmt_adj(ip1jmp1,llm,nprath)
+      REAL, SAVE         :: qpente(ip1jmp1,llm,10,nprath)
+      REAL               :: flxw(ip1jmp1,llm)
+#endif
 c     ....  var. locales  .....
 c
@@ -82 +105 @@
         CALL groupe( massem, pbaruc,pbarvc, pbarug,pbarvg,wg )
 
+#ifdef INCA_CH4
+      ! ... Flux de masse diaganostiques traceurs
+      flxw = wg / FLOAT(iapp_tracvl) 
+#endif
 
 c  test sur l'eventuelle creation de valeurs negatives de la masse
@@ -115 +142 @@
          ENDIF
 
-         DO iq = numvan, nq
-          CALL vlsplt( q(1,1,iq), 2. ,massem,wg,pbarug,pbarvg,dtvr )
-         ENDDO
+#ifdef INCA_CH4
+      do iq = 2, 10
+        qpente(:,:,iq,1)=qpente(:,:,iq,1)*mmt_adj(:,:,1)
+      enddo
+#endif
 
-         iadvtr=0
+      DO iq = numvan, 2 
+#ifdef INCA
+      IF (adv_flg(iq) == 0) CYCLE
+#endif
+      CALL vlsplt(q(1,1,iq),2.,massem,wg,pbarug,pbarvg,dtvr)
+      ENDDO
+
+#ifdef INCA_CH4
+!     CALL prather(q(1,1,3),wg,massem,pbarug,pbarvg,ntra,qpente(1,1,1,1))
+#endif
+
+      DO  iq =3,nq
+#ifdef INCA
+      IF (adv_flg(iq) == 0) CYCLE
+#endif
+      CALL vlsplt(q(1,1,iq),2.,massem,wg,pbarug,pbarvg,dtvr)
+      ENDDO
+
+      iadvtr=0
 
 c   on reinitialise a zero les flux de masse cumules.