Changeset 1269 for trunk/LMDZ.MARS/libf/phymars/newcondens.F

Timestamp:

May 19, 2014, 11:00:18 AM (11 years ago)

Author:

aslmd

Message:

LMDZ.MARS. replaced llm by nlayer with automatic array in newcondens (vl1d).

File:

• trunk/LMDZ.MARS/libf/phymars/newcondens.F (modified) (10 diffs)

trunk/LMDZ.MARS/libf/phymars/newcondens.F

@@ -578 +578 @@
                 w(l)=-zmflux(l)*ptimestep
             END DO
-            call vl1d(ztc,2.,masse,w,ztm) 
-            call vl1d(zu ,2.,masse,w,zum) 
-            call vl1d(zv ,2.,masse,w,zvm) 
+            call vl1d(nlayer,ztc,2.,masse,w,ztm) 
+            call vl1d(nlayer,zu ,2.,masse,w,zum) 
+            call vl1d(nlayer,zv ,2.,masse,w,zvm) 
             do iq=1,nq
              do l=1,nlayer
@@ -586 +586 @@
              enddo
              zqm1(1)=zqm(1,iq)
-             call vl1d(zq1,2.,masse,w,zqm1)
+             call vl1d(nlayer,zq1,2.,masse,w,zqm1)
              do l=2,nlayer
               zq( l,iq)=zq1(l)
@@ -799 +799 @@
 
 c *****************************************************************
-      SUBROUTINE vl1d(q,pente_max,masse,w,qm)
+      SUBROUTINE vl1d(nlayer,q,pente_max,masse,w,qm)
 c
 c    
@@ -813 +813 @@
       IMPLICIT NONE
 
-#include "dimensions.h"
-
 c
 c
@@ -820 +818 @@
 c   Arguments:
 c   ----------
-      real masse(llm),pente_max
-      REAL q(llm),qm(llm+1)
-      REAL w(llm+1)
+      real masse(nlayer),pente_max
+      REAL q(nlayer),qm(nlayer+1)
+      REAL w(nlayer+1)
 c
 c      Local 
@@ -829 +827 @@
       INTEGER l
 c
-      real dzq(llm),dzqw(llm),adzqw(llm),dzqmax
+      real dzq(nlayer),dzqw(nlayer),adzqw(nlayer),dzqmax
       real sigw, Mtot, MQtot
       integer m 
@@ -838 +836 @@
 c     W > 0 WHEN DOWN !!!!!!!!!!!!!
 
-      do l=2,llm
+      do l=2,nlayer
             dzqw(l)=q(l-1)-q(l)
             adzqw(l)=abs(dzqw(l))
       enddo
 
-      do l=2,llm-1
+      do l=2,nlayer-1
             if(dzqw(l)*dzqw(l+1).gt.0.) then
                 dzq(l)=0.5*(dzqw(l)+dzqw(l+1))
@@ -854 +852 @@
 
          dzq(1)=0.
-         dzq(llm)=0.
-
-       do l = 1,llm-1
+         dzq(nlayer)=0.
+
+       do l = 1,nlayer-1
 
 c         Regular scheme (transfered mass < layer mass)
@@ -873 +871 @@
              Mtot = masse(m)
              MQtot = masse(m)*q(m)
-             do while ((m.lt.llm).and.(w(l+1).gt.(Mtot+masse(m+1))))
+             do while ((m.lt.nlayer).and.(w(l+1).gt.(Mtot+masse(m+1))))
                 m=m+1
                 Mtot = Mtot + masse(m)
                 MQtot = MQtot + masse(m)*q(m)
              end do
-             if (m.lt.llm) then
+             if (m.lt.nlayer) then
                 sigw=(w(l+1)-Mtot)/masse(m+1)
                 qm(l+1)= (1/w(l+1))*(MQtot + (w(l+1)-Mtot)*
@@ -912 +910 @@
 
 c     boundary conditions (not used in newcondens !!)
-c         qm(llm+1)=0.
+c         qm(nlayer+1)=0.
 c         if(w(1).gt.0.) then
 c            qm(1)=q(1)