Index: LMDZ.3.3/branches/rel-/libf/phylmd/1DUTILS.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/1DUTILS.h	(revision 416)
+++ 	(revision )
@@ -1,920 +1,0 @@
-      SUBROUTINE initial0(n,x)
-      IMPLICIT NONE
-      INTEGER n,i
-      REAL x(n)
-      DO 10 i=1,n
-         x(i)=0.
-10    CONTINUE
-      RETURN
-      END
-      SUBROUTINE gr_fi_dyn(nfield,ngrid,im,jm,pfi,pdyn)
-      IMPLICIT NONE
-c=======================================================================
-c   passage d'un champ de la grille scalaire a la grille physique
-c=======================================================================
-
-c-----------------------------------------------------------------------
-c   declarations:
-c   -------------
-
-      INTEGER im,jm,ngrid,nfield
-      REAL pdyn(im,jm,nfield)
-      REAL pfi(ngrid,nfield)
-
-      INTEGER i,j,ifield,ig
-
-c-----------------------------------------------------------------------
-c   calcul:
-c   -------
-
-      DO ifield=1,nfield
-c   traitement des poles
-         DO i=1,im
-            pdyn(i,1,ifield)=pfi(1,ifield)
-            pdyn(i,jm,ifield)=pfi(ngrid,ifield)
-         ENDDO
-
-c   traitement des point normaux
-         DO j=2,jm-1
-	    ig=2+(j-2)*(im-1)
-            CALL SCOPY(im-1,pfi(ig,ifield),1,pdyn(1,j,ifield),1)
-	    pdyn(im,j,ifield)=pdyn(1,j,ifield)
-         ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-      SUBROUTINE disvert1d(llm,kappa,sig,dsig,s,ds,dsig1,sdsig)
-      IMPLICIT NONE
-c
-c=======================================================================
-c
-c
-c    s = sigma ** kappa   :  coordonnee  verticale
-c    dsig(l)            : epaisseur de la couche l ds la coord.  s
-c    sig(l)             : sigma a l'interface des couches l et l-1
-c    ds(l)              : distance entre les couches l et l-1 en coord.s
-c
-c=======================================================================
-c
-c   declarations:
-c   -------------
-c
-      integer llm
-      real kappa,pi,x
-      real sig(llm+1),dsig(llm),s(llm),ds(llm),dsig1(llm),sdsig(llm)
-c
-      integer ll,l,lllm,lllmm1,lllmp1
-      real abid,abid2,som,quoi,quand,snorm,sigbid,sbid
-      REAL alpha,beta,h,zd,dz0,dz1
-      REAL gama,delta,deltaz,np
-
-      real nhaut
-      INTEGER ierr,ierr1,ierr2
-      real puiss
-
-      real asig,bsig,csig,esig,zsig,p,zz,sig1
-      REAL z1,z2
-c
-c-----------------------------------------------------------------------
-c
-      lllm=llm
-      lllmm1=lllm-1
-      lllmp1=lllm+1
-      pi=2.*asin(1.)
-
-      OPEN(99,file='sigma.def',status='old',form='formatted',
-     s   iostat=ierr1)
-      if(ierr1.ne.0) then
-         close(99)
-         open(99,file='esasig.def',status='old',form='formatted',
-     s   iostat=ierr2)
-      endif
-
-
-c-----------------------------------------------------------------------
-c   cas 1 on lit les options dans sigma.def:
-c   ----------------------------------------
-
-
-      if (ierr1.eq.0) then
-         PRINT*,'WARNING Lecture de sigma.def'
-         READ(99,*) deltaz
-         READ(99,*) h
-         READ(99,*) beta
-         READ(99,*) gama
-         READ(99,*) delta
-         READ(99,*) np
-         CLOSE(99)
-         alpha=deltaz/(llm*h)
-          do l= 1, llm
-             dsig(l) = (alpha+(1.-alpha)*exp(-beta*(llm-l)))*
-     $          ( (tanh(gama*l)/tanh(gama*llm))**np +
-     $            (1.-l/FLOAT(llm))*delta )
-          enddo
-
-          sig(1)=1.
-          do l=1,llm-1
-             sig(l+1)=sig(l)*(1.-dsig(l))/(1.+dsig(l))
-          enddo
-          sig(llm+1)=0.
-
-          do l = 1, llm
-             dsig(l) = sig(l)-sig(l+1)
-          enddo
-
-      else if(ierr2.eq.0) then
-
-         PRINT*,'WARNING Lecture de esasig.def'
-         READ(99,*) h
-         READ(99,*) dz0
-         READ(99,*) dz1
-         READ(99,*) nhaut
-         CLOSE(99)
-
-         dz0=dz0/h
-         dz1=dz1/h
-
-         sig1=(1.-dz1)/tanh(.5*(llm-1)/nhaut)
-
-         esig=1.
-
-         PRINT*
-         do l=1,20
-            print*,'esig=',esig
-            esig=-log((1./sig1-1.)*exp(-dz0)/esig)/(llm-1.)
-         enddo
-         PRINT*
-         csig=(1./sig1-1.)/(exp(esig)-1.)
-
-         DO L = 2, llm
-           zz=csig*(exp(esig*(l-1.))-1.)
-           sig(l) =1./(1.+zz)
-     &    * tanh(.5*(llm+1-l)/nhaut)
-         ENDDO
-         sig(1)=1.
-         sig(llm+1)=0.
-
-         do  l = 1, llm
-         dsig(l) =sig(l)-sig(l+1)
-         enddo
-
-      else
-
-         print*,'WARNING!!! Ancienne discretisation verticale'
-c        stop
-         h=7.
-         snorm  = 0.
-         do l = 1, llm
-            x = 2.*asin(1.) * (float(l)-0.5) / float(llm+1)
-            dsig(l) = 1.0 + 7.0 * sin(x)**2
-            snorm = snorm + dsig(l)
-         enddo
-         snorm = 1./snorm
-         do l = 1, llm
-            dsig(l) = dsig(l)*snorm
-         enddo
-         sig(llm+1) = 0.
-         do l = llm, 1, -1
-            sig(l) = sig(l+1) + dsig(l)
-         enddo
-
-      endif
-
-c-----------------------------------------------------------------------
-c   calcul de s, ds, sdsig...
-c   -------------------------
-
-       quoi      = 1. + 2.* kappa
-       s( llm )  = 1.
-       s(lllmm1) = quoi
-       IF( llm.gt.2 )  THEN
-          DO  ll = 2, lllmm1
-             l         = lllmp1 - ll
-             quand     = sig(l+1)/ sig(l)
-             s(l-1)    = quoi * (1.-quand) * s(l)  + quand * s(l+1)
-          ENDDO
-       END IF
-c
-       snorm=(1.-.5*sig(2)+kappa*(1.-sig(2)))*s(1)+.5*sig(2)*s(2)
-       DO l = 1, llm
-          s(l)    = s(l)/ snorm
-       ENDDO
-
-       DO l = 2, llm
-          ds(l)   = s(l-1) - s(l)
-       ENDDO
-       ds(1)  = 1. - s(1)
-c
-       DO l  = 1, llm
-          sdsig(l) = s(l) * dsig(l)
-          dsig1(l)= 1./dsig(l)
-       ENDDO
-
-c-----------------------------------------------------------------------
-c
-c     Diagnostique sur la discretisation verticale:
-c     ---------------------------------------------
-c
-      print*,'Diagnostique de la discretisation verticale'
-      print*
-      print*,'comparaison de sig(l) et (s(l)+s(l+1))/2)**(1/K)'
-      do 14 l=1,llm-1
-         sigbid=(0.5*(s(l)+s(l+1)))**(1./kappa)
-         print*,'sig(',l+1,')  = ',sig(l+1),
-     S           '    valeur approchee :',sigbid,'   ',dsig(l)
-14    continue
-      print*
-      print*,'comparaison de s(l) et (sig(l)+sig(l+1))/2)**K'
-      do 15 l=1,llm
-         sbid=(0.5*(sig(l+1)+sig(l)))**kappa
-         print*,'  s(',l,')  = ',s(l),
-     S           '    valeur approchee :',sbid
-15    continue
-c
-      PRINT*,'Altitude approchee z,dz'
-      PRINT*
-      z1=0.
-      print*,'   l       Z      DZ      Ztop   dsig'
-      DO 18 l=1,llm-1
-         z2=-h*log(sig(l+1))
-         write(*,'(i5,3x,4f8.4)') l,-h*log(s(l))/kappa,z2-z1,z2
-     &    ,dsig(l)
-         write(14,'(3x,i5,1f10.4)') l,-h*log(s(l))/kappa
-         z1=z2
-18    CONTINUE
-      write(*,'(i5,3x,3f8.4)') l,-h*log(s(llm))/kappa
-      write(14,'(3x,i5,1f10.4)') l,-h*log(s(llm))/kappa
-
-
-      RETURN
-      END
-
-c---------------------------------------------------------------
-      subroutine adv_vert2(w,q,plev)
-c   Schéma amont pour l'advection verticale de l'eau
-      implicit none
-
-#include "dimensions.h"
-#include "dimphy.h"
-
-      real w(llm+1),wq(llm+1),q(llm),plev(llm+1),dsig(llm+1)
-
-      integer l
-
-      do l=1,llm
-         wq(l)=q(l)*w(l)
-         dsig(l)=(plev(l)-plev(l+1))/plev(1)
-      enddo
-
-      wq(llm+1)=0.
-      do l=1,llm
-         q(l)=(q(l)*dsig(l)+wq(l+1)-wq(l))/(dsig(l)+w(l+1)-w(l))
-      enddo
-      do l=1,llm
-         wq(l)=q(l)*w(l)
-      enddo
-      wq(llm+1)=0.
-      do l=1,llm
-         q(l)=(q(l)*dsig(l)+wq(l+1)-wq(l))/(dsig(l)+w(l+1)-w(l))
-      enddo
-
-      return
-      end
-c---------------------------------------------------------------
-      subroutine adv_vert(w,q)
-c   Schéma amont pour l'advection verticale de l'eau
-      implicit none
-
-#include "dimensions.h"
-#include "dimphy.h"
-#include "comvert1d.h"
-
-      real w(llm+1),wq(llm+1),q(llm)
-
-      integer l
-
-      do l=1,llm
-         wq(l)=q(l)*w(l)
-      enddo
-
-      wq(llm+1)=0.
-      do l=1,llm
-         q(l)=(q(l)*dsig(l)+wq(l+1)-wq(l))/(dsig(l)+w(l+1)-w(l))
-      enddo
-      do l=1,llm
-         wq(l)=q(l)*w(l)
-      enddo
-      wq(llm+1)=0.
-      do l=1,llm
-         q(l)=(q(l)*dsig(l)+wq(l+1)-wq(l))/(dsig(l)+w(l+1)-w(l))
-      enddo
-
-      return
-      end
-      subroutine ug_vg(lm,sig,ug,vg)
-      implicit none
-
-      integer lm
-
-      real u0,uinf,sigu0,alphau
-      real v0,vinf,sigv0,alphav
-
-      real sig(lm),ug(lm),vg(lm)
-      integer l
-
-      data u0,uinf,sigu0/-9.,6.,0.8/
-c     data v0,vinf,sigv0/-1.,4.,0.98/
-      data v0,vinf,sigv0/-1.,7.,0.98/
-
-
-      alphau=-log((uinf-u0)/uinf)/log(sigu0)
-      alphav=-log((vinf-v0)/vinf)/log(sigv0)
-      print*,'Alpha=',alphau,alphav
-
-      do l=1,lm
-         ug(l)=uinf+(u0-uinf)*sig(l)**alphau
-         vg(l)=vinf+(v0-vinf)*sig(l)**alphav
-      enddo
-
-      return
-      end
-      SUBROUTINE abort_gcm(modname, message, ierr)
-     
-      USE IOIPSL
-C
-C Stops the simulation cleanly, closing files and printing various
-C comments
-C
-C  Input: modname = name of calling program
-C         message = stuff to print
-C         ierr    = severity of situation ( = 0 normal )
-
-      character*20 modname
-      integer ierr
-      character*80 message
-
-      write(*,*) 'in abort_gcm'
-      call histclo
-c     call histclo(2)
-c     call histclo(3)
-c     call histclo(4)
-c     call histclo(5)
-      write(*,*) 'out of histclo'
-      write(*,*) 'Stopping in ', modname
-      write(*,*) 'Reason = ',message
-      if (ierr .eq. 0) then
-        write(*,*) 'Everything is cool'
-      else
-        write(*,*) 'Houston, we have a problem ', ierr
-      endif
-      STOP
-      END
-      FUNCTION q_sat(kelvin, millibar)
-c
-      IMPLICIT none
-c======================================================================
-c Autheur(s): Z.X. Li (LMD/CNRS)
-c Objet: calculer la vapeur d'eau saturante (formule Centre Euro.)
-c======================================================================
-c Arguments:
-c kelvin---input-R: temperature en Kelvin
-c millibar--input-R: pression en mb
-c
-c q_sat----output-R: vapeur d'eau saturante en kg/kg
-c======================================================================
-c
-      REAL q_sat, kelvin, millibar
-c
-      REAL r2es
-      PARAMETER (r2es=611.14 *18.0153/28.9644)
-c
-      REAL r3les, r3ies, r3es
-      PARAMETER (R3LES=17.269)
-      PARAMETER (R3IES=21.875)
-c
-      REAL r4les, r4ies, r4es
-      PARAMETER (R4LES=35.86)
-      PARAMETER (R4IES=7.66)
-c
-      REAL rtt
-      PARAMETER (rtt=273.16)
-c
-      REAL retv
-      PARAMETER (retv=28.9644/18.0153 - 1.0)
-c
-      REAL zqsat
-      REAL temp, pres
-C     ------------------------------------------------------------------
-c
-c
-      temp = kelvin
-      pres = millibar * 100.0
-c      write(*,*)'kelvin,millibar=',kelvin,millibar
-c      write(*,*)'temp,pres=',temp,pres
-c
-      IF (temp .LE. rtt) THEN
-         r3es = r3ies
-         r4es = r4ies
-      ELSE
-         r3es = r3les
-         r4es = r4les
-      ENDIF
-c
-      zqsat=r2es/pres * EXP ( r3es*(temp-rtt) / (temp-r4es) )
-      zqsat=MIN(0.5,ZQSAT)
-      zqsat=zqsat/(1.-retv  *zqsat)
-c
-      q_sat = zqsat
-c
-      RETURN
-      END
-      subroutine scopy(n,sx,incx,sy,incy)
-c
-      IMPLICIT NONE
-c
-      integer n,incx,incy,ix,iy,i
-      real sx((n-1)*incx+1),sy((n-1)*incy+1)
-c
-      iy=1
-      ix=1
-      do 10 i=1,n
-	 sy(iy)=sx(ix)
-         ix=ix+incx
-         iy=iy+incy
-10    continue
-c
-      return
-      end
-      subroutine wrgradsfi(if,nl,field,name,titlevar)
-      implicit none
-
-c   Declarations
-
-#include "gradsdef.h"
-
-c   arguments
-      integer if,nl
-      real field(imx*jmx*lmx)
-      character*10 name,file
-      character*10 titlevar
-
-c   local
-
-      integer im,jm,lm,i,j,l,lnblnk,iv,iii,iji,iif,ijf
-
-      logical writectl
-
-
-      writectl=.false.
-
-c     print*,if,iid(if),jid(if),ifd(if),jfd(if)
-      iii=iid(if)
-      iji=jid(if)
-      iif=ifd(if)
-      ijf=jfd(if)
-      im=iif-iii+1
-      jm=ijf-iji+1
-      lm=lmd(if)
-
-c     print*,'im,jm,lm,name,firsttime(if)'
-c     print*,im,jm,lm,name,firsttime(if)
-
-      if(firsttime(if)) then
-         if(name.eq.var(1,if)) then
-            firsttime(if)=.false.
-            ivar(if)=1
-         print*,'fin de l initialiation de l ecriture du fichier'
-         print*,file
-           print*,'fichier no: ',if
-           print*,'unit ',unit(if)
-           print*,'nvar  ',nvar(if)
-           print*,'vars ',(var(iv,if),iv=1,nvar(if))
-         else
-            ivar(if)=ivar(if)+1
-            nvar(if)=ivar(if)
-            var(ivar(if),if)=name
-            tvar(ivar(if),if)=titlevar(1:lnblnk(titlevar))
-            nld(ivar(if),if)=nl
-            print*,'initialisation ecriture de ',var(ivar(if),if)
-            print*,'if ivar(if) nld ',if,ivar(if),nld(ivar(if),if)
-         endif
-         writectl=.true.
-         itime(if)=1
-      else
-         ivar(if)=mod(ivar(if),nvar(if))+1
-         if (ivar(if).eq.nvar(if)) then
-            writectl=.true.
-            itime(if)=itime(if)+1
-         endif
-
-         if(var(ivar(if),if).ne.name) then
-           print*,'Il faut stoker la meme succession de champs a chaque'
-           print*,'pas de temps'
-           print*,'fichier no: ',if
-           print*,'unit ',unit(if)
-           print*,'nvar  ',nvar(if)
-           print*,'vars ',(var(iv,if),iv=1,nvar(if))
-
-           stop
-         endif
-      endif
-
-c     print*,'ivar(if),nvar(if),var(ivar(if),if),writectl'
-c     print*,ivar(if),nvar(if),var(ivar(if),if),writectl
-      do l=1,nl
-         irec(if)=irec(if)+1
-c        print*,'Ecrit rec=',irec(if),iii,iif,iji,ijf,
-c    s (l-1)*imd(if)*jmd(if)+(iji-1)*imd(if)+iii
-c    s ,(l-1)*imd(if)*jmd(if)+(ijf-1)*imd(if)+iif
-         write(unit(if)+1,rec=irec(if))
-     s   ((field((l-1)*imd(if)*jmd(if)+(j-1)*imd(if)+i)
-     s   ,i=iii,iif),j=iji,ijf)
-      enddo
-      if (writectl) then
-
-      file=fichier(if)
-c   WARNING! on reecrase le fichier .ctl a chaque ecriture
-      open(unit(if),file=file(1:lnblnk(file))//'.ctl',
-     &         form='formatted',status='unknown')
-      write(unit(if),'(a5,1x,a40)')
-     &       'DSET ','^'//file(1:lnblnk(file))//'.dat'
-
-      write(unit(if),'(a12)') 'UNDEF 1.0E30'
-      write(unit(if),'(a5,1x,a40)') 'TITLE ',title(if)
-      call formcoord(unit(if),im,xd(iii,if),1.,.false.,'XDEF')
-      call formcoord(unit(if),jm,yd(iji,if),1.,.true.,'YDEF')
-      call formcoord(unit(if),lm,zd(1,if),1.,.false.,'ZDEF')
-      write(unit(if),'(a4,i10,a30)')
-     &       'TDEF ',itime(if),' LINEAR 07AUG1998 30MN '
-      write(unit(if),'(a4,2x,i5)') 'VARS',nvar(if)
-      do iv=1,nvar(if)
-c        print*,'if,var(iv,if),nld(iv,if),nld(iv,if)-1/nld(iv,if)'
-c        print*,if,var(iv,if),nld(iv,if),nld(iv,if)-1/nld(iv,if)
-         write(unit(if),1000) var(iv,if),nld(iv,if)-1/nld(iv,if)
-     &     ,99,tvar(iv,if)
-      enddo
-      write(unit(if),'(a7)') 'ENDVARS'
-c
-1000  format(a5,3x,i4,i3,1x,a39)
-
-      close(unit(if))
-
-      endif ! writectl
-
-      return
-
-      END
-
-      subroutine inigrads(if,im
-     s  ,x,fx,xmin,xmax,jm,y,ymin,ymax,fy,lm,z,fz
-     s  ,dt,file,titlel)
-
-
-      implicit none
-
-      integer if,im,jm,lm,i,j,l,lnblnk
-      real x(im),y(jm),z(lm),fx,fy,fz,dt
-      real xmin,xmax,ymin,ymax
-
-      character file*10,titlel*40
-
-#include "gradsdef.h"
-
-      data unit/24,32,34,36,38,40,42,44,46,48/
-      data nf/0/
-
-      if (if.le.nf) stop'verifier les appels a inigrads'
-
-      print*,'Entree dans inigrads'
-
-      nf=if
-      title(if)=titlel
-      ivar(if)=0
-
-      fichier(if)=file(1:lnblnk(file))
-
-      firsttime(if)=.true.
-      dtime(if)=dt
-
-      iid(if)=1
-      ifd(if)=im
-      imd(if)=im
-      do i=1,im
-         xd(i,if)=x(i)*fx
-         if(xd(i,if).lt.xmin) iid(if)=i+1
-         if(xd(i,if).le.xmax) ifd(if)=i
-      enddo
-      print*,'On stoke du point ',iid(if),'  a ',ifd(if),' en x'
-
-      jid(if)=1
-      jfd(if)=jm
-      jmd(if)=jm
-      do j=1,jm
-         yd(j,if)=y(j)*fy
-         if(yd(j,if).gt.ymax) jid(if)=j+1
-         if(yd(j,if).ge.ymin) jfd(if)=j
-      enddo
-      print*,'On stoke du point ',jid(if),'  a ',jfd(if),' en y'
-
-      print*,'Open de dat'
-      print*,'file=',file
-      print*,'fichier(if)=',fichier(if)
-
-      print*,4*(ifd(if)-iid(if))*(jfd(if)-jid(if))
-      print*,file(1:lnblnk(file))//'.dat'
-
-      OPEN (unit(if)+1,FILE=file(1:lnblnk(file))//'.dat',
-     s   FORM='UNFORMATTED',
-     s   ACCESS='DIRECT'
-     s  ,RECL=4*(ifd(if)-iid(if)+1)*(jfd(if)-jid(if)+1))
-
-      print*,'Open de dat ok'
-
-      lmd(if)=lm
-      do l=1,lm
-         zd(l,if)=z(l)*fz
-      enddo
-
-      irec(if)=0
-
-      print*,if,imd(if),jmd(if),lmd(if)
-      print*,'if,imd(if),jmd(if),lmd(if)'
-
-      return
-      end
-      SUBROUTINE gr_dyn_fi(nfield,im,jm,ngrid,pdyn,pfi)
-      IMPLICIT NONE
-c=======================================================================
-c   passage d'un champ de la grille scalaire a la grille physique
-c=======================================================================
-
-c-----------------------------------------------------------------------
-c   declarations:
-c   -------------
-
-      INTEGER im,jm,ngrid,nfield
-      REAL pdyn(im,jm,nfield)
-      REAL pfi(ngrid,nfield)
-
-      INTEGER j,ifield,ig
-
-c-----------------------------------------------------------------------
-c   calcul:
-c   -------
-
-      IF(ngrid.NE.2+(jm-2)*(im-1).AND.ngrid.NE.1)
-     s    STOP 'probleme de dim'
-c   traitement des poles
-      CALL SCOPY(nfield,pdyn,im*jm,pfi,ngrid)
-      CALL SCOPY(nfield,pdyn(1,jm,1),im*jm,pfi(ngrid,1),ngrid)
-
-c   traitement des point normaux
-      DO ifield=1,nfield
-         DO j=2,jm-1
-	    ig=2+(j-2)*(im-1)
-            CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1)
-         ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-      subroutine writelim
-     s   (phy_nat,phy_alb,phy_sst,phy_bil,phy_rug,phy_ice)
-c
-#include "dimensions.h"
-#include "dimphy.h"
-#include "netcdf.inc"
-
-      REAL phy_nat(klon,360)
-      REAL phy_alb(klon,360)
-      REAL phy_sst(klon,360)
-      REAL phy_bil(klon,360)
-      REAL phy_rug(klon,360)
-      REAL phy_ice(klon,360)
-
-      INTEGER ierr
-      INTEGER dimfirst(3)
-      INTEGER dimlast(3)
-c
-      INTEGER nid, ndim, ntim
-      INTEGER dims(2), debut(2), epais(2)
-      INTEGER id_tim
-      INTEGER id_NAT, id_SST, id_BILS, id_RUG, id_ALB
-
-      PRINT*, 'Ecriture du fichier limit'
-c
-      ierr = NF_CREATE ("limit.nc", NF_CLOBBER, nid)
-c
-      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 30,
-     .                       "Fichier conditions aux limites")
-      ierr = NF_DEF_DIM (nid, "points_physiques", klon, ndim)
-      ierr = NF_DEF_DIM (nid, "time", NF_UNLIMITED, ntim)
-c
-      dims(1) = ndim
-      dims(2) = ntim
-c
-ccc      ierr = NF_DEF_VAR (nid, "TEMPS", NF_DOUBLE, 1,ntim, id_tim)
-      ierr = NF_DEF_VAR (nid, "TEMPS", NF_FLOAT, 1,ntim, id_tim)
-      ierr = NF_PUT_ATT_TEXT (nid, id_tim, "title", 17,
-     .                        "Jour dans l annee")
-ccc      ierr = NF_DEF_VAR (nid, "NAT", NF_DOUBLE, 2,dims, id_NAT)
-      ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT)
-      ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23,
-     .                        "Nature du sol (0,1,2,3)")
-ccc      ierr = NF_DEF_VAR (nid, "SST", NF_DOUBLE, 2,dims, id_SST)
-      ierr = NF_DEF_VAR (nid, "SST", NF_FLOAT, 2,dims, id_SST)
-      ierr = NF_PUT_ATT_TEXT (nid, id_SST, "title", 35,
-     .                        "Temperature superficielle de la mer")
-ccc      ierr = NF_DEF_VAR (nid, "BILS", NF_DOUBLE, 2,dims, id_BILS)
-      ierr = NF_DEF_VAR (nid, "BILS", NF_FLOAT, 2,dims, id_BILS)
-      ierr = NF_PUT_ATT_TEXT (nid, id_BILS, "title", 32,
-     .                        "Reference flux de chaleur au sol")
-ccc      ierr = NF_DEF_VAR (nid, "ALB", NF_DOUBLE, 2,dims, id_ALB)
-      ierr = NF_DEF_VAR (nid, "ALB", NF_FLOAT, 2,dims, id_ALB)
-      ierr = NF_PUT_ATT_TEXT (nid, id_ALB, "title", 19,
-     .                        "Albedo a la surface")
-ccc      ierr = NF_DEF_VAR (nid, "RUG", NF_DOUBLE, 2,dims, id_RUG)
-      ierr = NF_DEF_VAR (nid, "RUG", NF_FLOAT, 2,dims, id_RUG)
-      ierr = NF_PUT_ATT_TEXT (nid, id_RUG, "title", 8,
-     .                        "Rugosite")
-c
-      ierr = NF_ENDDEF(nid)
-c
-      DO k = 1, 360
-c
-      debut(1) = 1
-      debut(2) = k
-      epais(1) = klon
-      epais(2) = 1
-c
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR1_DOUBLE (nid,id_tim,k,DBLE(k))
-      ierr = NF_PUT_VARA_DOUBLE (nid,id_NAT,debut,epais,phy_nat(1,k))
-      ierr = NF_PUT_VARA_DOUBLE (nid,id_SST,debut,epais,phy_sst(1,k))
-      ierr = NF_PUT_VARA_DOUBLE (nid,id_BILS,debut,epais,phy_bil(1,k))
-      ierr = NF_PUT_VARA_DOUBLE (nid,id_ALB,debut,epais,phy_alb(1,k))
-      ierr = NF_PUT_VARA_DOUBLE (nid,id_RUG,debut,epais,phy_rug(1,k))
-#else
-      ierr = NF_PUT_VAR1_REAL (nid,id_tim,k,FLOAT(k))
-      ierr = NF_PUT_VARA_REAL (nid,id_NAT,debut,epais,phy_nat(1,k))
-      ierr = NF_PUT_VARA_REAL (nid,id_SST,debut,epais,phy_sst(1,k))
-      ierr = NF_PUT_VARA_REAL (nid,id_BILS,debut,epais,phy_bil(1,k))
-      ierr = NF_PUT_VARA_REAL (nid,id_ALB,debut,epais,phy_alb(1,k))
-      ierr = NF_PUT_VARA_REAL (nid,id_RUG,debut,epais,phy_rug(1,k))
-#endif
-c
-      ENDDO
-c
-      ierr = NF_CLOSE(nid)
-c
-      return
-      end
-
-      SUBROUTINE disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
-
-c    Auteur :  P. Le Van .
-c
-      IMPLICIT NONE
-
-#include "dimensions.h"
-#include "paramet.h"
-c
-c=======================================================================
-c
-c
-c    s = sigma ** kappa   :  coordonnee  verticale
-c    dsig(l)            : epaisseur de la couche l ds la coord.  s
-c    sig(l)             : sigma a l'interface des couches l et l-1
-c    ds(l)              : distance entre les couches l et l-1 en coord.s
-c
-c=======================================================================
-c
-      REAL pa,preff
-      REAL ap(llmp1),bp(llmp1),dpres(llm),nivsigs(llm),nivsig(llmp1)
-      REAL presnivs(llm)
-c
-c   declarations:
-c   -------------
-c
-      REAL sig(llm+1),dsig(llm)
-c
-      INTEGER l
-      REAL snorm
-      REAL alpha,beta,gama,delta,deltaz,h
-      INTEGER np,ierr
-      REAL pi,x
-
-c-----------------------------------------------------------------------
-c
-      pi=2.*ASIN(1.)
-
-      OPEN(99,file='sigma.def',status='old',form='formatted',
-     s   iostat=ierr)
-
-c-----------------------------------------------------------------------
-c   cas 1 on lit les options dans sigma.def:
-c   ----------------------------------------
-
-      IF (ierr.eq.0) THEN
-
-      print*,'WARNING!!! on lit les options dans sigma.def'
-      READ(99,*) deltaz
-      READ(99,*) h
-      READ(99,*) beta
-      READ(99,*) gama
-      READ(99,*) delta
-      READ(99,*) np
-      CLOSE(99)
-      alpha=deltaz/(llm*h)
-c
-
-       DO 1  l = 1, llm
-       dsig(l) = (alpha+(1.-alpha)*exp(-beta*(llm-l)))*
-     $          ( (tanh(gama*l)/tanh(gama*llm))**np +
-     $            (1.-l/FLOAT(llm))*delta )
-   1   CONTINUE
-
-       sig(1)=1.
-       DO 101 l=1,llm-1
-          sig(l+1)=sig(l)*(1.-dsig(l))/(1.+dsig(l))
-101    CONTINUE
-       sig(llm+1)=0.
-
-       DO 2  l = 1, llm
-       dsig(l) = sig(l)-sig(l+1)
-   2   CONTINUE
-c
-
-      ELSE
-c-----------------------------------------------------------------------
-c   cas 2 ancienne discretisation (LMD5...):
-c   ----------------------------------------
-
-      PRINT*,'WARNING!!! Ancienne discretisation verticale'
-
-      h=7.
-      snorm  = 0.
-      DO l = 1, llm
-         x = 2.*asin(1.) * (FLOAT(l)-0.5) / float(llm+1)
-         dsig(l) = 1.0 + 7.0 * SIN(x)**2
-         snorm = snorm + dsig(l)
-      ENDDO
-      snorm = 1./snorm
-      DO l = 1, llm
-         dsig(l) = dsig(l)*snorm
-      ENDDO
-      sig(llm+1) = 0.
-      DO l = llm, 1, -1
-         sig(l) = sig(l+1) + dsig(l)
-      ENDDO
-
-      ENDIF
-
-
-      DO l=1,llm
-        nivsigs(l) = FLOAT(l)
-      ENDDO
-
-      DO l=1,llmp1
-        nivsig(l)= FLOAT(l)
-      ENDDO
-
-c
-c    ....  Calculs  de ap(l) et de bp(l)  ....
-c    .........................................
-c
-c
-c   .....  pa et preff sont lus  sur les fichiers start par lectba  .....
-c
-
-      bp(llmp1) =   0.
-
-      DO l = 1, llm
-cc
-ccc    ap(l) = 0.
-ccc    bp(l) = sig(l)
-
-      bp(l) = EXP( 1. -1./( sig(l)*sig(l)) )
-      ap(l) = pa * ( sig(l) - bp(l) )
-c
-      ENDDO
-      ap(llmp1) = pa * ( sig(llmp1) - bp(llmp1) )
-
-      PRINT *,' BP '
-      PRINT *,  bp
-      PRINT *,' AP '
-      PRINT *,  ap
-
-      DO l = 1, llm
-       dpres(l) = bp(l) - bp(l+1)
-       presnivs(l) = 0.5 *( ap(l)+bp(l)*preff + ap(l+1)+bp(l+1)*preff )
-      ENDDO
-
-      PRINT *,' PRESNIVS '
-      PRINT *,presnivs
-
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/1Dconv.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/1Dconv.h	(revision 416)
+++ 	(revision )
@@ -1,1755 +1,0 @@
-        SUBROUTINE get_uvd(itap,dtime,tsol,qsol,file_fordat
-     s                    ,ht,hq,hw)
-
-        implicit none
- 
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-c cette routine permet d'obtenir u_convg,v_convg,ht,hq et ainsi de
-c pouvoir calculer la convergence et le cisaillement dans la physiq
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-#include "YOMCST.h"
-
-      INTEGER klev
-      REAL play(100)  !pression en Pa au milieu de chaque couche GCM
-      INTEGER JM(100) !pression en Pa au milieu de chaque couche GCM
-      REAL coef1(100) !coefficient d'interpolation
-      REAL coef2(100) !coefficient d'interpolation
-
-      INTEGER nblvlm !nombre de niveau de pression du mesoNH
-      REAL playm(100)  !pression en Pa au milieu de chaque couche Meso-NH
-      REAL hplaym(100) !pression en hPa milieux des couches Meso-NH
-
-      integer i,j,k,ii,ll,in
-      REAL tsol,qsol
-
-      CHARACTER*80 file_forctl,file_fordat,file_start
-
-      COMMON/physiq1/klev,play,JM,coef1,coef2
-      COMMON/physiq2/nblvlm,playm,hplaym
-
-c======================================================================
-c methode: on va chercher les donnees du mesoNH de meteo france, on y
-c          a acces a tout pas detemps grace a la routine rdgrads qui
-c          est une boucle lisant dans ces fichiers.
-c          Puis on interpole ces donnes sur les 11 niveaux du gcm et
-c          et sur les pas de temps de ce meme gcm
-c======================================================================
-c input:
-c       pasmax     :nombre de pas de temps maximum du mesoNH
-c       dt         :pas de temps du meso_NH (en secondes)
-c----------------------------------------------------------------------
-      integer pasmax,dt
-      save pasmax,dt
-c----------------------------------------------------------------------
-c arguments:
-c           itap   :compteur de la physique(le nombre de ces pas est
-c                   fixe dans la subroutine calcul_ini_gcm de interpo
-c                   -lation
-c           dtime  :pas detemps du gcm (en secondes)
-c           ht     :convergence horizontale de temperature(K/s)
-c           hq     :    "         "       d'humidite (kg/kg/s)
-c           hw     :vitesse verticale moyenne (m/s**2)
-c----------------------------------------------------------------------
-        integer itap
-        real dtime
-        real ht(100)
-        real hq(100)
-        real hw(100)
-c----------------------------------------------------------------------
-c Variables internes de get_uvd (note : l'interpolation temporelle
-c est faite entre les pas de temps before et after, sur les variables
-c definies sur la grille du SCM)
-c     time0     :date initiale en secondes
-c     time      :temps associe a chaque pas
-c     pas       :numero du pas du meso_NH
-c     pasprev   :numero du pas precedent
-c     htaft     :advection horizontale de temp. au pas de temps after
-c     hqaft     :    "         "      d'humidite        "
-c     hwaft     :vitesse verticalle moyenne  au pas de temps after
-c     htbef     :idem htaft, mais pour le pas de temps before
-c     hqbef     :voir hqaft
-c     hwbef     :voir hwaft
-c----------------------------------------------------------------------
-        integer time0,pas,pasprev
-        save time0,pas,pasprev
-        real time
-        real htaft(100),hqaft(100),hwaft(100)
-        save htaft,hqaft,hwaft
-        real htbef(100),hqbef(100),hwbef(100)
-        save htbef,hqbef,hwbef
-        integer timeaft,timebef
-        save timeaft,timebef
-        integer temps
-        character*4 string
-c----------------------------------------------------------------------
-c variables arguments de la subroutine rdgrads
-c---------------------------------------------------------------------
-        integer icompt      !compteur de rdgrads
-        real z(100)         ! altitude (grille Meso)
-        real ht_mes(100)    !convergence horizontale de temperature
-                            !-(grille Meso)
-        real hq_mes(100)    !convergence horizontale d'humidite
-                            !(grille Meso)
-        real hw_mes(100)    !vitesse verticale moyenne
-                            !(grille Meso)
-c
-c---------------------------------------------------------------------
-c variable argument de la subroutine copie
-c---------------------------------------------------------------------
-c SB        real pplay(100)    !pression en milieu de couche du gcm
-c SB                            !argument de la physique
-c---------------------------------------------------------------------
-c variables destinees a la lecture du pas de temps du fichier de donnees
-c---------------------------------------------------------------------
-       character*80 aaa,atemps,spaces,apasmax
-       integer nch,imn,ipa
-c---------------------------------------------------------------------
-c  procedures appelees
-        external rdgrads    !lire en iterant dans forcing.dat
-c---------------------------------------------------------------------
-               print*,'le pas itap est:',itap
-c*** on determine le pas du meso_NH correspondant au nouvel itap ***
-c*** pour aller chercher les champs dans rdgrads                 ***
-        time=time0+itap*dtime
-        temps=int(time/dt+1)
-        pas=min(temps,pasmax)
-             print*,'le pas Meso est:',pas
-c
-c
-c===================================================================
-c
-c*** on remplit les champs before avec les champs after du pas   ***
-c*** precedent en format gcm                                     ***
-        if(pas.gt.pasprev)then
-               do i=1,klev
-                  htbef(i)=htaft(i)
-                  hqbef(i)=hqaft(i)
-                  hwbef(i)=hwaft(i)
-               enddo
-               timebef=pasprev*dt
-               timeaft=timebef+dt
-               icompt=(pas-1)*(nblvlm*4)
-                       print*,'le pas pas est:',pas
-c*** on va chercher les nouveaux champs after dans toga.dat     ***
-c*** champs en format meso_NH                                   ***
-c          open(99,FILE='forcing.dat',FORM='UNFORMATTED',
-
-          write(*,'(a)') 'OPEN dans get_uvd de '//file_fordat
-          open(99,FILE=file_fordat,FORM='UNFORMATTED',
-     .             ACCESS='DIRECT',RECL=4)
-          call rdgrads(99,icompt,nblvlm,z,ht_mes,hq_mes,hw_mes)
-          do i = 1,nblvlm
-            ht_mes(i) = ht_mes(i)*(hplaym(i)/1000.)**rkappa
-          enddo
-c
-               print*,'ht_mes ',(ht_mes(i),i=1,nblvlm)
-               print*,'hq_mes ',(hq_mes(i),i=1,nblvlm)
-               print*,'hw_mes ',(hw_mes(i),i=1,nblvlm)
-c*** on interpole les champs meso_NH sur les niveaux de pression***
-c*** gcm . on obtient le nouveau champ after                    ***
-            do k=1,klev
-             if (JM(k) .eq. 0) then
-         htaft(k)=coef1(k)*tsol+coef2(k)*ht_mes(jm(k)+1)
-         hqaft(k)=coef1(k)*qsol+coef2(k)*hq_mes(jm(k)+1)
-         hwaft(k)=              coef2(k)*hw_mes(jm(k)+1)
-             else
-         htaft(k)=coef1(k)*ht_mes(jm(k))+coef2(k)*ht_mes(jm(k)+1)
-         hqaft(k)=coef1(k)*hq_mes(jm(k))+coef2(k)*hq_mes(jm(k)+1)
-         hwaft(k)=coef1(k)*hw_mes(jm(k))+coef2(k)*hw_mes(jm(k)+1)
-             endif
-            enddo
-          pasprev=pas
-         else
-                      print*,'timebef est:',timebef
-         endif      !fin du bloc relatif au passage au pas
-                    !de temps (meso) suivant
-c*** si on atteint le pas max des donnees experimentales ,on     ***
-c*** on conserve les derniers champs calcules                    ***
-      if(pas.ge.pasmax)then
-          do ll=1,klev
-               ht(ll)=htaft(ll)
-               hq(ll)=hqaft(ll)
-               hw(ll)=hwaft(ll)
-          enddo
-      else
-c*** on interpole sur les pas de temps de 10mn du gcm a partir   ***
-c** des pas de temps de 1h du meso_NH                            ***
-         do j=1,klev
-         ht(j)=((timeaft-time)*htbef(j)+(time-timebef)*htaft(j))/dt
-         hq(j)=((timeaft-time)*hqbef(j)+(time-timebef)*hqaft(j))/dt
-         hw(j)=((timeaft-time)*hwbef(j)+(time-timebef)*hwaft(j))/dt
-         enddo
-       endif
-c
-c-------------------------------------------------------------------
-c
-         return
-c
-c-----------------------------------------------------------------------
-c on sort les champs de "convergence" pour l'instant initial 'in'
-c ceci se passe au pas temps itap=0 de la physique
-c-----------------------------------------------------------------------
-        entry get_uvd2(itap,file_forctl,file_fordat,file_start
-     s                ,ht,hq,hw)
-             print*,'le pas itap est:',itap
-c
-c===================================================================
-c
-      write(*,*) '   '
-      write(*,*) 'FICHIERS A LIRE DANS GET_UVD2:   '
-      write(*,'(a)') 'fichier forcing.ctl: '//file_forctl
-      write(*,'(a)') 'fichier forcing.dat: '//file_fordat
-      write(*,'(a)') 'fichier start18.data: '//file_start
-      write(*,*) '   '
-
-c!! en attendant de pouvoir compiler les fns CERN, en prescrit
-c!! les variables imn et pasmax a la main...
-c!!
-       write(*,'(a)') 'OPEN '//file_forctl
-       open(97,FILE=file_forctl,FORM='FORMATTED')
-c
-c------------------
-      do i=1,1000
-      read(97,1000,end=999) string
- 1000 format (a4)
-      if (string .eq. 'TDEF') go to 50
-      enddo
- 50   backspace(97)
-c-------------------------------------------------------------------
-c   *** on lit le pas de temps dans le fichier de donnees ***
-c   *** "forcing.ctl" et pasmax                           ***
-c-------------------------------------------------------------------
-      read(97,2000) aaa
-2000  format (a80)
-         print*,'aaa est',aaa
-      aaa=spaces(aaa,1)
-         print*,'aaa',aaa
-      call getsch(aaa,' ',' ',5,atemps,nch)
-         print*,'atemps est',atemps
-        atemps=atemps(1:nch-2)
-         print*,'atemps',atemps
-        read(atemps,*) imn
-        dt=imn*60
-         print*,'le pas de temps dt',dt
-      call getsch(aaa,' ',' ',2,apasmax,nch)
-        apasmax=apasmax(1:nch)
-        read(apasmax,*) ipa
-        pasmax=ipa
-         print*,'pasmax est',pasmax
-      CLOSE(97)
-
-c CASE_E:
-c!!         imn = 60
-c!!         ipa = 8
-c TOGA:
-c!!         imn = 360
-c!!         ipa = 480
-
-         dt=imn*60
-         pasmax=ipa
-         print*,'le pas de temps dt',dt
-         print*,'pasmax est',pasmax
-
-
-c------------------------------------------------------------------
-c *** onlit le pas de temps initial de la simulation dans ***
-c *** "start.data"                                        ***
-c------------------------------------------------------------------
-c      open(98,file='start18.data',form='formatted')
-      write(*,'(a)') 'OPEN '//file_start
-      open(98,FILE=file_start,FORM='FORMATTED')
-          read(98,*)in
-                  pasprev=in
-                    print*,'le pas in ini est:',pasprev
-C
-Cjyg     Correction de la date du demarrage.
-CC                  time0=dt*pasprev
-                  time0=dt*(pasprev-1)
-C
-          close(98)
-c
-c      open(99,FILE='forcing.dat',FORM='UNFORMATTED',
-      write(*,'(a)') 'OPEN '//file_fordat
-      open(99,FILE=file_fordat,FORM='UNFORMATTED',
-     .          ACCESS='DIRECT',RECL=4)
-                  icompt=(in-1)*(nblvlm*4)
-        call rdgrads(99,icompt,nblvlm,z,ht_mes,hq_mes,hw_mes)
-          do i = 1,nblvlm
-            ht_mes(i) = ht_mes(i)*(hplaym(i)/1000.)**rkappa
-          enddo
-c
-               print*,'ht_mes ',(ht_mes(i),i=1,nblvlm)
-               print*,'hq_mes ',(hq_mes(i),i=1,nblvlm)
-               print*,'hw_mes ',(hw_mes(i),i=1,nblvlm)
-c----------------------------------------------------------------------
-c on a obtenu des champs initiaux sur les niveaux du meso_NH
-c on interpole sur les niveaux du gcm(niveau pression bien sur!)
-c-----------------------------------------------------------------------
-         do ii=1,klev
-         htaft(ii)=coef1(ii)*ht_mes(JM(ii))+coef2(ii)*ht_mes(JM(ii)+1)
-         hqaft(ii)=coef1(ii)*hq_mes(JM(ii))+coef2(ii)*hq_mes(JM(ii)+1)
-         hwaft(ii)=coef1(ii)*hw_mes(JM(ii))+coef2(ii)*hw_mes(JM(ii)+1)
-             enddo
-c valeurs initiales des champs de convergence
-          do k=1,klev
-             ht(k)=htaft(k)
-             hq(k)=hqaft(k)
-             hw(k)=hwaft(k)
-          enddo
-        close(99)
-        close(98)
-c
-c-------------------------------------------------------------------
-c
- 100    return
-c
-999     continue
-        stop 'erreur lecture, file forcing.ctl'
-        end
- 
- 
-      SUBROUTINE cool_pool(istep
-     e                    ,n_cooling,dt_cooling,dq_cooling
-     s                    ,dt_cool,dq_cool)
-       implicit none
-C***************************************************************
-C*                                                             *
-C* COOL_POOL                                                   *
-C*                                                             *
-C*                                                             *
-C* written by   : Gilles Foret RAMSES, 15/09/97, 22.00.2       *
-C* modified by :  Sandrine Bony 10/09/98                       *
-C***************************************************************
-c Arguments
-c =========
-c Input
-c -----
-c   istep : numero du pas de temps
-c   n_cooling: nbre de pas de temps ou la pertubation nominale
-c              est appliquee (ensuite, la pertubation decroit
-c              exponentiellement).
-c   dt_cooling : pertubation nominale en temperature
-c   dq_cooling : pertubation nominale en humidite
-c Output
-c ------
-c    dt_cool : pertubation en temperature
-c    dq_cool : pertubation en humidite
-c
-c Variables internes
-c ==================
-c    scale :  facteur applique a la pertubation nominale
-c
-#include "dimensions.h"
-#include "dimphy.h"
-c
-      integer n_cooling,k,istep
-      real dt_cooling(klev),dq_cooling(klev),scale
-      real dt_cool(klev),dq_cool(klev)
-c
-      if (istep .le. n_cooling ) then
-        scale = 1.
-      else
-        scale = 4**(min(15,istep-n_cooling))
-      endif
-c
-        do k = 1,klev
-          dt_cool(k) = dt_cooling(k)/scale
-          dq_cool(k) = dq_cooling(k)/scale
-        enddo
-c
-      return
-      end
-      SUBROUTINE advect_tvl(dtime,t,q,vu_f,vv_f,t_f,q_f
-     :                     ,d_t_adv,d_q_adv)
-      implicit none
-
-#include "dimensions.h"
-#include "dimphy.h"
-
-      integer k
-      real dtime, fact, du, dv, cx, cy, alx, aly
-      real t(klev), q(klev,3)
-     :   , vu_f(klev), vv_f(klev), t_f(klev), q_f(klev,3)
-
-      real d_t_adv(klev), d_q_adv(klev,3)
-
-c Velocity of moving cell
-      data cx,cy /12., -2./
-
-c Dimensions of moving cell
-      data alx,aly /100 000.,150 000./
-
-      do k = 1, klev
-            du = abs(vu_f(k)-cx)/alx
-            dv = abs(vv_f(k)-cy)/aly
-            fact = dtime *(du+dv-du*dv*dtime)
-            d_t_adv(k) = fact * (t_f(k)-t(k))
-            d_q_adv(k,1) = fact * (q_f(k,1)-q(k,1))
-            d_q_adv(k,2) = fact * (q_f(k,2)-q(k,2))
-            d_q_adv(k,3) = fact * (q_f(k,3)-q(k,3))
-      enddo
-
-      return
-      end
-      SUBROUTINE copie(klevgcm,playgcm,psolgcm,file_forctl)
-      implicit none
-
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-c cette routine remplit les COMMON physiq1 et physiq2.h
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-      INTEGER JM
-      INTEGER klev !nombre de niveau de pression du GCM
-      INTEGER nblvlm !nombre de niveau de pression du mesoNH
-
-      REAL playm(100) !pression en Pa au milieu de chaque couche Meso-NH
-      REAL hplaym(100)!pression en hecto-Pa des milieux de couche Meso-NH
-      REAL play(100)  !pression en Pa au milieu de chaque couche GCM
-      REAL coef1(100)   !coefficient d'interpolation
-      REAL coef2(100)   !coefficient d'interpolation
-
-      COMMON/physiq1/klev,play,JM,coef1,coef2
-      COMMON/physiq2/nblvlm,playm,hplaym
-
-      integer i,k,klevgcm
-      real playgcm(klevgcm) ! pression en milieu de couche du gcm
-      real psolgcm
-      character*80 file_forctl
-
-      klev = klevgcm
-
-c---------------------------------------------------------------------
-c pression au milieu des couches du gcm dans la physiq
-c (SB: remplace le call conv_lipress_gcm(playgcm) )
-c---------------------------------------------------------------------
-
-       do k = 1, klev
-        play(k) = playgcm(k)
-        print*,'la pression gcm est:',play(k)
-       enddo
-
-c----------------------------------------------------------------------
-c lecture du descripteur des donnees Meso-NH (forcing.ctl):
-c  -> nb niveaux du meso.NH (nblvlm) + pressions meso.NH
-c (on remplit le COMMON physiq2)
-c----------------------------------------------------------------------
-
-      call mesolupbis(file_forctl)
-
-      print*,'la valeur de nblvlm est:',nblvlm
-
-c----------------------------------------------------------------------
-c etude de la correspondance entre les niveaux meso.NH et GCM;
-c calcul des coefficients d'interpolation coef1 et coef2
-c (on remplit le COMMON physiq1)
-c----------------------------------------------------------------------
-
-      call corresbis(psolgcm)
-
-c---------------------------------------------------------
-c TEST sur le remplissage de physiq1 et physiq2:
-c---------------------------------------------------------
- 
-      write(*,*) ' '
-      write(*,*) 'TESTS physiq1 et physiq2 dans copie.F '
-      write(*,*) '--------------------------------------'
-      write(*,*) 'GCM: nb niveaux:',klev,' et pression, coeffs:'
-      do k = 1, klev
-      write(*,*) play(k), coef1(k), coef2(k)
-      enddo
-      write(*,*) 'MESO-NH: nb niveaux:',nblvlm,' et pression:'
-      do k = 1, nblvlm
-      write(*,*) playm(k), hplaym(k)
-      enddo
-      write(*,*) ' '
-
-      end
-      SUBROUTINE writeg1d(ngrid,nx,x,nom,titre)
-      IMPLICIT NONE
-c.......................................................................
-c
-c  ecriture de x pour GRADS-1D
-c
-c  in :
-c         * ngrid      ---> pour controler que l'on est bien en 1D
-c         * nx         ---> taille du vecteur a stocker
-c                             "1" pour une variable de surface
-c                             "nlayer" pour une variable de centre de couche
-c                             "nlayer+1" pour une variable d'interface
-c         * x          ---> variable a stocker
-c         * nom        ---> nom "pour grads"
-c         * titre      ---> titre "pour grads"
-c
-c.......................................................................
-c
-#include "comg1d.h"
-c
-c.......................................................................
-c  declaration des arguments 
-c
-      INTEGER ngrid,nx
-      REAL x(nx)
-      CHARACTER*(*) nom
-      CHARACTER*(*) titre
-c
-c  declaration des arguments 
-c....................................................................... 
-c  declaration des variables locales
-c
-      INTEGER ilayer,ivar
-      LOGICAL test 
-c
-c  declaration des variables locales
-c.......................................................................
-c  contole 1D
-c
-c     print*,'ngrid=',ngrid
-      IF (ngrid.NE.1) return
-c
-c  contole 1D
-c.......................................................................
-c  ouverture du fichier au premier appel
-c
-      IF (g1d_premier) THEN
-        OPEN (g1d_unitfich,FILE=g1d_nomfich
-     &       ,FORM='unformatted',ACCESS='direct',RECL=4)
-        g1d_irec=0
-        g1d_nvar=0
-        g1d_premier=.false.
-      ENDIF
-c
-c  ouverture du fichier au premier appel
-c.......................................................................
-c  pour l'ecriture du fichier ctl
-c
-      test=.true.
-      DO ivar=1,g1d_nvar
-        IF (nom.EQ.g1d_nomvar(ivar)) test=.false.
-      ENDDO
-      IF (test) THEN
-        g1d_nvar=g1d_nvar+1
-        g1d_nomvar(g1d_nvar)=nom
-        g1d_titrevar(g1d_nvar)=titre
-        IF (nx.EQ.1) THEN
-           g1d_dimvar(g1d_nvar)=0
-        ELSEIF (nx.EQ.g1d_nlayer) THEN
-           g1d_dimvar(g1d_nvar)=g1d_nlayer
-        ELSEIF (nx.EQ.g1d_nlayer+1) THEN
-           g1d_dimvar(g1d_nvar)=g1d_nlayer
-        ELSE
-           PRINT *,'._. probleme de dimension dans GRADS-1D ._.'
-        ENDIF
-      ENDIF
-c
-c  pour l'ecriture du fichier ctl
-c.......................................................................
-c  ecriture
-c
-      IF (nx.EQ.1) THEN
-        g1d_irec=g1d_irec+1
-        WRITE(g1d_unitfich,REC=g1d_irec) x(1)
-      ELSE
-        DO ilayer=1,g1d_nlayer
-          g1d_irec=g1d_irec+1
-          WRITE(g1d_unitfich,REC=g1d_irec) x(ilayer)
-        ENDDO
-      ENDIF
-c
-c  ecriture
-c.......................................................................
-c
-10001 CONTINUE
-c
-c.......................................................................
-c
-      RETURN
-      END
-
-
-
-
-
-
-c SB      SUBROUTINE endg1d(ngrid,nlayer,zlayer,ndt)
-      SUBROUTINE endg1d(ngrid,nlayer,player,ndt,dt)
-      IMPLICIT NONE
-c.......................................................................
-c
-c  ecriture du fichier de controle pour GRADS-1D
-c
-c  in :
-c         * ngrid      ---> pour controler que l'on est bien en 1D
-c         * nlayer     ---> nombre de couches
-c         * zlayer     ---> altitude au centre de chaque couche (km)
-c         * player     ---> pression au centre de chaque couche (hPa)
-c         * ndt        ---> nombre de pas de temps
-c         * dt         ---> valeur du pas de temps (s)
-c
-c.......................................................................
-c
-#include "comg1d.h"
-c
-c.......................................................................
-c  declaration des arguments 
-c
-      INTEGER ngrid,nlayer
-c SB      REAL zlayer(nlayer)
-      REAL player(nlayer)
-      INTEGER ndt
-      REAL dt,dtm
-c
-c  declaration des arguments 
-c....................................................................... 
-c  declaration des variables locales
-c
-      INTEGER ivar,ilayer
-c
-c  declaration des variables locales
-c.......................................................................
-c  contole 1D
-c
-      IF (ngrid.NE.1) GOTO 10001
-c
-c  contole 1D
-c.......................................................................
-c
-      IF (nlayer.ne.g1d_nlayer) 
-     &   PRINT *,'._. probleme de dimension dans GRADS-1D ._.'
-c
-c.......................................................................
-c
-      CLOSE (g1d_unitfich)
-c
-c.......................................................................
-c
-      dtm = dt/60.
-
-      OPEN (g1d_unitctl,FILE=g1d_nomctl,FORM='formatted'
-     s     ,status='new')
-      WRITE (g1d_unitctl,'(a4,2x,a20)') 'DSET',g1d_nomfich
-      WRITE (g1d_unitctl,'(a5,2x,a20)') 'UNDEF ','1.E+30'
-      WRITE (g1d_unitctl,'(a11)') 'FORMAT YREV'
-      WRITE (g1d_unitctl,'(a5,2x,a30)') 'TITLE ','champs 1D'
-      WRITE (g1d_unitctl,'(a5,i4,a20)') 'XDEF ',1,' LINEAR 0 1'
-      WRITE (g1d_unitctl,'(a5,i4,a20)') 'YDEF ',1,' LINEAR 0 1'
-      WRITE (g1d_unitctl,'(a5,i4,a20)') 'ZDEF ',g1d_nlayer,' LEVELS'
-      WRITE (g1d_unitctl,'(5(1x,f13.5))')
-c SB     &      (zlayer(ilayer),ilayer=1,g1d_nlayer)
-     &      (player(ilayer)/100.,ilayer=1,g1d_nlayer)
-c SB      WRITE (g1d_unitctl,'(a4,2x,i10,a25)')
-c SB     &      'TDEF ',ndt,' LINEAR 02JAN1987 1HR '
-      WRITE (g1d_unitctl,'(a4,2x,i10,a20,i3,a3)')
-     &      'TDEF ',ndt,' LINEAR 02JAN1987 ',INT(dtm),'MN '
-      WRITE (g1d_unitctl,'(a5,i5)') 'VARS ',g1d_nvar
-      DO ivar=1,g1d_nvar
-      WRITE (g1d_unitctl,'(a5,3x,i4,i3,1x,a39)') 
-     &       g1d_nomvar(ivar),g1d_dimvar(ivar),99,g1d_titrevar(ivar)
-      ENDDO
-      WRITE (g1d_unitctl,'(a7)') 'ENDVARS'
-      CLOSE (g1d_unitctl)
-c
-c.......................................................................
-c
-10001 CONTINUE
-c
-c.......................................................................
-c
-      RETURN
-      END
-      SUBROUTINE mesolupbis(file_forctl)
-      implicit none 
-c
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-c
-c Lecture descripteur des donnees MESO-NH (forcing.ctl):
-c -------------------------------------------------------
-c
-c     Cette subroutine lit dans le fichier de controle "essai.ctl"
-c     et affiche le nombre de niveaux du Meso-NH ainsi que les valeurs
-c     des pressions en milieu de couche du Meso-NH (en Pa puis en hPa).
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-c
-      INTEGER nblvlm !nombre de niveau de pression du mesoNH
-      REAL playm(100)  !pression en Pa milieu de chaque couche Meso-NH
-      REAL hplaym(100) !pression en hPa des milieux de couche Meso-NH
-      COMMON/physiq2/nblvlm,playm,hplaym
-
-      INTEGER i,lu,k,mlz,mlzh,j
- 
-      character*80 file_forctl
-
-      character*4 a
-      character*80 aaa,anblvl,spaces
-      integer nch
-
-      lu=9
-c      open (lu,file='forcing.ctl')
-      open(lu,file=file_forctl,form='formatted')
-c
-      do i=1,1000
-      read(lu,1000,end=999) a
-      if (a .eq. 'ZDEF') go to 100
-      enddo
-c
- 100  backspace(lu)
-      print*,'  DESCRIPTION DES 2 MODELES : '
-      print*,' '
-c
-      read(lu,2000) aaa
- 2000  format (a80)
-       aaa=spaces(aaa,1)
-       call getsch(aaa,' ',' ',2,anblvl,nch)
-         read(anblvl,*) nblvlm
-
-c      write(*,*) 'ATTENTION! dans mesolupbis on rentre
-c     : nblvlm a la main car pas de bibliotheque CERN..:'
-c CASE_e:
-c!          nblvlm = 43
-c TOGA:
-c!!          nblvlm = 40
-c
-      print*,'nbre de niveaux de pression Meso-NH :',nblvlm
-      print*,' '
-      print*,'pression en Pa de chaque couche du meso-NH :'
-c
-      read(lu,*) (playm(mlz),mlz=1,nblvlm)
-c      Si la pression est en HPa, la multiplier par 100
-      if (playm(1) .lt. 10000.) then
-        do mlz = 1,nblvlm
-         playm(mlz) = playm(mlz)*100.
-        enddo
-      endif
-      print*,(playm(mlz),mlz=1,nblvlm)
-c
- 1000 format (a4)
- 1001 format(5x,i2)
-c
-      print*,' '
-      do mlzh=1,nblvlm
-      hplaym(mlzh)=playm(mlzh)/100.
-      enddo
-c
-      print*,'pression en hPa de chaque couche du meso-NH: '
-      print*,(hplaym(mlzh),mlzh=1,nblvlm)
-c
-      close (lu)
-      return
-c
- 999  stop 'erreur lecture des niveaux pression des donnees'
-      end
-      SUBROUTINE GETSCH(STR,DEL,TRM,NTH,SST,NCH)
-C***************************************************************
-C*                                                             *
-C*                                                             *
-C* GETSCH                                                      *
-C*                                                             *
-C*                                                             *
-C* modified by :                                               *
-C***************************************************************
-C*   Return in SST the character string found between the NTH-1 and NTH
-C*   occurence of the delimiter 'DEL' but before the terminator 'TRM' in
-C*   the input string 'STR'. If TRM=DEL then STR is considered unlimited.
-C*   NCH=Length of the string returned in SST or =-1 if NTH is <1 or if
-C*   NTH is greater than the number of delimiters in STR.
-      IMPLICIT INTEGER (A-Z)
-      CHARACTER STR*(*),DEL*1,TRM*1,SST*(*)
-      NCH=-1
-      SST=' '
-      IF(NTH.GT.0) THEN
-        IF(TRM.EQ.DEL) THEN
-          LENGTH=LEN(STR)
-        ELSE
-          LENGTH=INDEX(STR,TRM)-1
-          IF(LENGTH.LT.0) LENGTH=LEN(STR)
-        ENDIF
-C*     Find beginning and end of the NTH DEL-limited substring in STR
-        END=-1
-        DO 1,N=1,NTH
-        IF(END.EQ.LENGTH) RETURN
-        BEG=END+2
-        END=BEG+INDEX(STR(BEG:LENGTH),DEL)-2
-        IF(END.EQ.BEG-2) END=LENGTH
-C*        PRINT *,'NTH,LENGTH,N,BEG,END=',NTH,LENGTH,N,BEG,END
-    1   CONTINUE
-        NCH=END-BEG+1
-        IF(NCH.GT.0) SST=STR(BEG:END)
-      ENDIF
-      END
-      SUBROUTINE rdgrads(itape,icount,nl,z,ht,hq,hw)
-      IMPLICIT none
-
-      INTEGER itape,icount,icomp, nl
-      real z(nl),ht(nl),hq(nl),hw(nl)
-c
-      INTEGER i, k
-c
-      icomp = icount
-c
-c
-         do k=1,nl
-            icomp=icomp+1
-            read(itape,rec=icomp)z(k)
-         enddo
-         do k=1,nl
-            icomp=icomp+1
-            read(itape,rec=icomp)hT(k)
-         enddo
-         do k=1,nl
-            icomp=icomp+1
-            read(itape,rec=icomp)hQ(k)
-         enddo
-         do k=1,nl
-            icomp=icomp+1
-            read(itape,rec=icomp)hw(k)
-         enddo
-c
-c
-      RETURN
-      END
-      SUBROUTINE corresbis(psol)
-      implicit none
-
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-c Cette subroutine calcule et affiche les valeurs des coefficients
-c d'interpolation qui serviront dans la formule d'interpolation elle-
-c meme.
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-      INTEGER klev    !nombre de niveau de pression du GCM
-      REAL play(100)  !pression en Pa au milieu de chaque couche GCM
-      INTEGER JM(100)
-      REAL coef1(100) !coefficient d'interpolation
-      REAL coef2(100) !coefficient d'interpolation
-
-      INTEGER nblvlm !nombre de niveau de pression du mesoNH
-      REAL playm(100) !pression en Pa milieu de chaque couche Meso-NH
-      REAL hplaym(100)!pression en hPa des milieux de couche Meso-NH
-
-      COMMON/physiq1/klev,play,JM,coef1,coef2
-      COMMON/physiq2/nblvlm,playm,hplaym
-
-      REAL psol
-      REAL val
-      INTEGER k, mlz, mlzh
-
-
-      do k=1,klev
-         val=play(k)
-       if (val .gt. playm(1)) then
-          mlz = 0
-          JM(1) = mlz
-          coef1(1)=(playm(mlz+1)-val)
-     *             /(playm(mlz+1)-psol)
-          coef2(1)=(val-psol)
-     *             /(playm(mlz+1)-psol)
-       else
-         do mlz=1,nblvlm
-          if (     val .le. playm(mlz)
-     *       .and. val .gt. playm(mlz+1))then
-           JM(k)=mlz
-           coef1(k)=(playm(mlz+1)-val)
-     *              /(playm(mlz+1)-playm(mlz))
-           coef2(k)=(val-playm(mlz))
-     *              /(playm(mlz+1)-playm(mlz))
-          endif
-c
-         enddo
-       endif
-      enddo
-c
-      if (play(klev) .le. playm(nblvlm)) then
-         mlz=nblvlm-1
-         JM(klev)=mlz
-         coef1(klev)=(playm(mlz+1)-val)
-     *            /(playm(mlz+1)-playm(mlz))
-         coef2(klev)=(val-playm(mlz))
-     *            /(playm(mlz+1)-playm(mlz))
-      endif
-c
-      print*,' '
-      print*,'         INTERPOLATION  : '
-      print*,' '
-      print*,'correspondance de 9 niveaux du GCM sur les 53 du meso-NH:'
-      print*,(JM(k),k=1,klev)
-      print*,'correspondance de 9 niveaux du GCM sur les 53 du meso-NH:'
-      print*,(JM(k),k=1,klev)
-      print*,' '
-      print*,'valeurs du premier coef d"interpolation pour les 9 niveaux
-     *: '
-      print*,(coef1(k),k=1,klev)
-      print*,' '
-      print*,'valeurs du deuxieme coef d"interpolation pour les 9 niveau
-     *x: '
-      print*,(coef2(k),k=1,klev)
-c
-      return
-      end
-      SUBROUTINE phyredem (fichnom,dtime,radpas,co2_ppm,solaire,
-     .           rlat,rlon,tsol,tsoil,deltat,qsol,snow,
-     .           radsol,rugmer,agesno,
-     .           zmea,zstd,zsig,zgam,zthe,zpic,zval,rugsrel,
-     .           t_ancien, q_ancien)
-      IMPLICIT none
-c======================================================================
-c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
-c Objet: Ecriture de l'etat de redemarrage pour la physique
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "netcdf.inc"
-#include "indicesol.h"
-#include "dimsoil.h"
-#include "clesphys.h"
-#include "control.h"
-#include "temps.h"
-c======================================================================
-      CHARACTER*(*) fichnom
-      REAL dtime
-      INTEGER radpas
-      REAL rlat(klon), rlon(klon)
-      REAL co2_ppm
-      REAL solaire
-      REAL tsol(klon,nbsrf)
-      REAL tsoil(klon,nsoilmx,nbsrf)
-      REAL deltat(klon)
-      REAL qsol(klon,nbsrf)
-      REAL snow(klon,nbsrf)
-      REAL radsol(klon)
-      REAL rugmer(klon)
-      REAL agesno(klon)
-      REAL zmea(klon)
-      REAL zstd(klon)
-      REAL zsig(klon)
-      REAL zgam(klon)
-      REAL zthe(klon)
-      REAL zpic(klon)
-      REAL zval(klon)
-      REAL rugsrel(klon)
-      REAL t_ancien(klon,klev), q_ancien(klon,klev)
-c
-      INTEGER nid, nvarid, idim1, idim2, idim3
-      INTEGER ierr
-      INTEGER length
-      PARAMETER (length=100)
-      REAL tab_cntrl(length)
-c
-      INTEGER isoil, nsrf
-      CHARACTER*7 str7
-      CHARACTER*2 str2
-c
-      ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
-      IF (ierr.NE.NF_NOERR) THEN
-        write(6,*)' Pb d''ouverture du fichier '//fichnom
-        write(6,*)' ierr = ', ierr
-        CALL ABORT
-      ENDIF
-c
-      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 28,
-     .                       "Fichier redemmarage physique")
-c
-      ierr = NF_DEF_DIM (nid, "index", length, idim1)
-      ierr = NF_DEF_DIM (nid, "points_physiques", klon, idim2)
-      ierr = NF_DEF_DIM (nid, "horizon_vertical", klon*klev, idim3)
-c
-      ierr = NF_ENDDEF(nid)
-c
-      DO ierr = 1, length
-         tab_cntrl(ierr) = 0.0
-      ENDDO
-      tab_cntrl(1) = dtime
-      tab_cntrl(2) = radpas
-      tab_cntrl(3) = co2_ppm
-      tab_cntrl(4) = solaire
-      tab_cntrl(5) = iflag_con
-      tab_cntrl(6) = nbapp_rad
-
-      IF( cycle_diurne ) tab_cntrl( 7 ) = 1.
-      IF(   soil_model ) tab_cntrl( 8 ) = 1.
-      IF(     new_oliq ) tab_cntrl( 9 ) = 1.
-      IF(     ok_orodr ) tab_cntrl(10 ) = 1.
-      IF(     ok_orolf ) tab_cntrl(11 ) = 1.
-
-      tab_cntrl(13) = dayref
-      tab_cntrl(14) = anneeref
-      tab_cntrl(13) = day_end
-      tab_cntrl(14) = anne_ini
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, idim1,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, idim1,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
-     .                        "Parametres de controle")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "longitude", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "longitude", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
-     .                        "Longitudes de la grille physique")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlon)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlon)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "latitude", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 31,
-     .                        "Latitudes de la grille physique")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlat)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlat)
-#endif
-c
-c
-      DO nsrf = 1, nbsrf
-        IF (nsrf.LE.99) THEN
-        WRITE(str2,'(i2.2)') nsrf
-        ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid, "TS"//str2, NF_DOUBLE, 1, idim2,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid, "TS"//str2, NF_FLOAT, 1, idim2,nvarid)
-#endif
-        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
-     .                        "Temperature de surface No."//str2)
-        ierr = NF_ENDDEF(nid)
-        ELSE
-        PRINT*, "Trop de sous-mailles"
-        CALL abort
-        ENDIF
-#ifdef NC_DOUBLE
-        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsol(1,nsrf))
-#else
-        ierr = NF_PUT_VAR_REAL (nid,nvarid,tsol(1,nsrf))
-#endif
-      ENDDO
-c
-      DO nsrf = 1, nbsrf
-      DO isoil=1, nsoilmx
-        IF (isoil.LE.99 .AND. nsrf.LE.99) THEN
-        WRITE(str7,'(i2.2,"srf",i2.2)') isoil,nsrf
-        ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid, "Tsoil"//str7,NF_DOUBLE,1,idim2,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid, "Tsoil"//str7,NF_FLOAT,1,idim2,nvarid)
-#endif
-        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 29,
-     .                        "Temperature du sol No."//str7)
-        ierr = NF_ENDDEF(nid)
-        ELSE
-        PRINT*, "Trop de couches"
-        CALL abort
-        ENDIF
-#ifdef NC_DOUBLE
-        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsoil(1,isoil,nsrf))
-#else
-        ierr = NF_PUT_VAR_REAL (nid,nvarid,tsoil(1,isoil,nsrf))
-#endif
-      ENDDO
-      ENDDO
-c
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "DELTAT", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "DELTAT", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 33,
-     .                        "Ecart de la SST (pour slab-ocean)")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,deltat)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,deltat)
-#endif
-c
-      DO nsrf = 1, nbsrf
-        IF (nsrf.LE.99) THEN
-        WRITE(str2,'(i2.2)') nsrf
-        ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid,"QS"//str2,NF_DOUBLE,1,idim2,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid,"QS"//str2,NF_FLOAT,1,idim2,nvarid)
-#endif
-        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 25,
-     .                        "Humidite de surface No."//str2)
-        ierr = NF_ENDDEF(nid)
-        ELSE
-        PRINT*, "Trop de sous-mailles"
-        CALL abort
-        ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,qsol(1,nsrf))
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,qsol(1,nsrf))
-#endif
-      ENDDO
-c
-      DO nsrf = 1, nbsrf
-        IF (nsrf.LE.99) THEN
-        WRITE(str2,'(i2.2)') nsrf
-        ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid,"SNOW"//str2,NF_DOUBLE,1,idim2,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid,"SNOW"//str2,NF_FLOAT,1,idim2,nvarid)
-#endif
-        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
-     .                        "Neige de surface No."//str2)
-        ierr = NF_ENDDEF(nid)
-        ELSE
-        PRINT*, "Trop de sous-mailles"
-        CALL abort
-        ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,snow(1,nsrf))
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,snow(1,nsrf))
-#endif
-      ENDDO
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "RADS", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "RADS", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
-     .                        "Rayonnement net a la surface")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,radsol)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,radsol)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "RUGMER", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "RUGMER", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
-     .                        "Longueur de rugosite sur mer")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rugmer)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rugmer)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "AGESNO", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "AGESNO", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 15,
-     .                        "Age de la neige")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,agesno)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,agesno)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZMEA", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZMEA", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zmea)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,zmea)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZSTD", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZSTD", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zstd)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,zstd)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZSIG", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZSIG", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zsig)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,zsig)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZGAM", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZGAM", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zgam)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,zgam)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZTHE", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZTHE", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zthe)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,zthe)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZPIC", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZPIC", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zpic)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,zpic)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZVAL", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZVAL", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zval)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,zval)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "RUGSREL", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "RUGSREL", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rugsrel)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rugsrel)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "TANCIEN", NF_DOUBLE, 1, idim3,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "TANCIEN", NF_FLOAT, 1, idim3,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,t_ancien)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,t_ancien)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "QANCIEN", NF_DOUBLE, 1, idim3,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "QANCIEN", NF_FLOAT, 1, idim3,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q_ancien)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,q_ancien)
-#endif
-c
-      ierr = NF_CLOSE(nid)
-c
-      RETURN
-      END
-      subroutine physdem(lonfi, latfi,phystep,radpas,co2_ppm,
-     .                   solaire, ts, ws, 
-     .                   sn, radsol, deltat, rugmer,
-     .                   agesno, zmea, zstd, zsig,
-     .                   zgam, zthe, zpic, zval,
-     .                   rugsrel)
-
-      IMPLICIT none
-c-------------------------------------------------------------
-C Author : L. Fairhead
-C Date   : 01/10/1999
-C Objet  : Ecriture des etats initiaux physiques
-c-------------------------------------------------------------
-c
-c
-c
-      INTEGER ivap
-      PARAMETER (ivap=1)
-c
-      REAL qsolmax
-      PARAMETER ( qsolmax = 150.0 )
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "dimphy.h"
-#include "control.h"
-#include "netcdf.inc"
-c
-      INTEGER nid
-
-c Ajout de quelques parametres orographiques (F. LOTT janvier 1995)
-
-      REAL zmea(iip1,jjp1),zstd(iip1,jjp1)
-      REAL zsig(iip1,jjp1),zgam(iip1,jjp1),zthe(iip1,jjp1)
-      REAL zpic(iip1,jjp1),zval(iip1,jjp1)
-      REAL rugsrel(iip1,jjp1)
-      INTEGER idayref,anneeref
-
-
-      integer ierr, idim1, idim2, nvarid
-
-c
-      REAL phystep
-      INTEGER radpas
-      REAL co2_ppm
-      REAL solaire
-      REAL latfi(klon), lonfi(klon)
-      REAL champhys(klon)
-      REAL ts(klon)
-      REAL deltat(klon)
-      REAL ws(klon)
-      REAL sn(klon)
-      REAL radsol(klon)
-      REAL rugmer(klon)
-      REAL agesno(klon)
-      INTEGER length
-      PARAMETER (length=100)
-      REAL tab_cntrl(length)
-      real pi
-
-c
-
-#include "serre.h"
-#include "clesphys.h"
-#include "fxyprim.h"
-c-----------------------------------------------------------------------
-c
-c  stockage sur le fichier Physique:
-c
-      pi=2.*asin(1.)
-      ierr = NF_CREATE("startphy.nc", NF_CLOBBER, nid)
-      IF (ierr.NE.NF_NOERR) THEN
-        WRITE(6,*)' Pb d''ouverture du fichier startphy.nc'
-        WRITE(6,*)' ierr = ', ierr
-        CALL ABORT
-      ENDIF
-c
-      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 28,
-     .                       "Fichier demmarage physique")
-c
-      ierr = NF_DEF_DIM (nid, "index", length, idim1)
-      ierr = NF_DEF_DIM (nid, "points_physiques", klon, idim2)
-c
-      ierr = NF_ENDDEF(nid)
-c
-      DO ierr = 1, length
-         tab_cntrl(ierr) = 0.0
-      ENDDO
-      tab_cntrl(1)  = phystep
-      tab_cntrl(2)  = radpas
-      tab_cntrl(3)  = co2_ppm
-      tab_cntrl(4)  = solaire
-      tab_cntrl(5)  = iflag_con
-      tab_cntrl(6)  = nbapp_rad
-c
-cc     Modif ( P. Le Van )
-c
-       tab_cntrl( 7 ) = 0. 
-       tab_cntrl( 8 ) = 0. 
-       tab_cntrl( 9 ) = 0. 
-       tab_cntrl(10 ) = 0. 
-       tab_cntrl(11 ) = 0. 
-       tab_cntrl(12 ) = 0. 
-
-      IF(  cycle_diurne )  tab_cntrl( 7 ) = 1. 
-      IF(   soil_model  )  tab_cntrl( 8 ) = 1. 
-      IF(    new_oliq   )  tab_cntrl( 9 ) = 1. 
-      IF(    ok_orodr   )  tab_cntrl(10 ) = 1. 
-      IF(    ok_orolf   )  tab_cntrl(11 ) = 1. 
-      IF(  ok_limitvrai )  tab_cntrl(12 ) = 1. 
-
-      tab_cntrl(13)  = dayref
-      tab_cntrl(14)  = anneeref
-
-
-cc   ***    new_oliq   (  commentaires de L. LI dans routine physique ) 
-cc   ***  ok_orodr  et ok_orolf   si on appelle l'orographie      ****
-
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, idim1,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, idim1,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
-     .                        "Parametres de controle")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "longitude", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "longitude", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
-     .                        "Longitudes de la grille physique")
-      ierr = NF_ENDDEF(nid)
-
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,lonfi)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,lonfi)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "latitude", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 31,
-     .                        "Latitudes de la grille physique")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,latfi)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,latfi)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "TS", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "TS", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 25,
-     .                        "Temperature de la surface")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ts)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,ts)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "QS", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "QS", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15,
-     .                        "Humidite du sol")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ws)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,ws)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "SNOW", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "SNOW", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 5,
-     .                        "Neige")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,sn)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,sn)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "RADS", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "RADS", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
-     .                        "Rayonnement net a la surface")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,radsol)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,radsol)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "DELTAT", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "DELTAT", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 33,
-     .                        "Ecart de la SST (pour slab-ocean)")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,deltat)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,deltat)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "RUGMER", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "RUGMER", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
-     .                        "Longueur de rugosite sur mer")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rugmer)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rugmer)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "AGESNO", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "AGESNO", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 15,
-     .                        "Age de la neige")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,agesno)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,agesno)
-#endif
-c
-      CALL gr_dyn_fi(1, iip1, jjp1, klon, zmea, champhys)
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZMEA", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZMEA", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,champhys)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,champhys)
-#endif
-c
-      CALL gr_dyn_fi(1, iip1, jjp1, klon, zstd, champhys)
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZSTD", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZSTD", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,champhys)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,champhys)
-#endif
-
-      CALL gr_dyn_fi(1, iip1, jjp1, klon, zsig, champhys)
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZSIG", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZSIG", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,champhys)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,champhys)
-#endif
-
-      CALL gr_dyn_fi(1, iip1, jjp1, klon, zgam, champhys)
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZGAM", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZGAM", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,champhys)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,champhys)
-#endif
-
-      CALL gr_dyn_fi(1, iip1, jjp1, klon, zthe, champhys)
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZTHE", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZTHE", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,champhys)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,champhys)
-#endif
-
-      CALL gr_dyn_fi(1, iip1, jjp1, klon, zpic, champhys)
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZPIC", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZPIC", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,champhys)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,champhys)
-#endif
-
-      CALL gr_dyn_fi(1, iip1, jjp1, klon, zval, champhys)
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZVAL", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZVAL", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,champhys)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,champhys)
-#endif
-
-      CALL gr_dyn_fi(1, iip1, jjp1, klon, rugsrel, champhys)
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "RUGSREL", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "RUGSREL", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,champhys)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,champhys)
-#endif
-c
-      ierr = NF_CLOSE(nid)
-
-      RETURN
-
-      END
-*CMZ :          28/02/95  17.58.56  by  Unknown
-*-- Author :
-      CHARACTER*(*) FUNCTION SPACES(STR,NSPACE)
-C
-C CERN PROGLIB# M433    SPACES          .VERSION KERNFOR  4.14  860211
-C ORIG.  6/05/86 M.GOOSSENS/DD
-C
-C-    The function value SPACES returns the character string STR with
-C-    leading blanks removed and each occurence of one or more blanks
-C-    replaced by NSPACE blanks inside the string STR
-C
-      CHARACTER*(*) STR
-C
-      LENSPA = LEN(SPACES)
-      SPACES = ' '
-      IF (NSPACE.LT.0) NSPACE = 0
-      IBLANK = 1
-      ISPACE = 1
-  100 INONBL = INDEXC(STR(IBLANK:),' ')
-      IF (INONBL.EQ.0) THEN
-          SPACES(ISPACE:) = STR(IBLANK:)
-                                                    GO TO 999
-      ENDIF
-      INONBL = INONBL + IBLANK - 1
-      IBLANK = INDEX(STR(INONBL:),' ')
-      IF (IBLANK.EQ.0) THEN
-          SPACES(ISPACE:) = STR(INONBL:)
-                                                    GO TO 999
-      ENDIF
-      IBLANK = IBLANK + INONBL - 1
-      SPACES(ISPACE:) = STR(INONBL:IBLANK-1)
-      ISPACE = ISPACE + IBLANK - INONBL + NSPACE
-      IF (ISPACE.LE.LENSPA)                         GO TO 100
-  999 END
-      FUNCTION INDEXC(STR,SSTR)
-C
-C CERN PROGLIB# M433    INDEXC          .VERSION KERNFOR  4.14  860211
-C ORIG. 26/03/86 M.GOOSSENS/DD
-C
-C-    Find the leftmost position where substring SSTR does not match
-C-    string STR scanning forward
-C
-      CHARACTER*(*) STR,SSTR
-C
-      LENS   = LEN(STR)
-      LENSS  = LEN(SSTR)
-C
-      DO 10 I=1,LENS-LENSS+1
-          IF (STR(I:I+LENSS-1).NE.SSTR) THEN
-              INDEXC = I
-                                         GO TO 999
-          ENDIF
-   10 CONTINUE
-      INDEXC = 0
-C
-  999 END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/FCTTRE.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/FCTTRE.h	(revision 416)
+++ 	(revision )
@@ -1,36 +1,0 @@
-C     ------------------------------------------------------------------
-C     This COMDECK includes the Thermodynamical functions for the cy39
-C       ECMWF Physics package.
-C       Consistent with YOMCST Basic physics constants, assuming the
-C       partial pressure of water vapour is given by a first order
-C       Taylor expansion of Qs(T) w.r.t. to Temperature, using constants
-C       in YOETHF
-C     ------------------------------------------------------------------
-      REAL PTARG, PDELARG, P5ARG, PQSARG, PCOARG
-      REAL FOEEW, FOEDE, qsats, qsatl, dqsats, dqsatl
-      LOGICAL thermcep
-      PARAMETER (thermcep=.TRUE.)
-C
-      FOEEW ( PTARG,PDELARG ) = EXP (
-     S          (R3LES*(1.-PDELARG)+R3IES*PDELARG) * (PTARG-RTT)
-     S / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG)) )
-C
-      FOEDE ( PTARG,PDELARG,P5ARG,PQSARG,PCOARG ) = PQSARG*PCOARG*P5ARG
-     S / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG))**2
-c
-      qsats(ptarg) = 100.0 * 0.622 * 10.0
-     .           ** (2.07023 - 0.00320991 * ptarg
-     .           - 2484.896 / ptarg + 3.56654 * LOG10(ptarg))
-      qsatl(ptarg) = 100.0 * 0.622 * 10.0
-     .           ** (23.8319 - 2948.964 / ptarg
-     .           - 5.028 * LOG10(ptarg)
-     .           - 29810.16 * EXP( - 0.0699382 * ptarg)
-     .           + 25.21935 * EXP( - 2999.924 / ptarg))
-c
-      dqsats(ptarg,pqsarg) = RLVTT/RCPD*pqsarg * (3.56654/ptarg
-     .                     +2484.896*LOG(10.)/ptarg**2
-     .                     -0.00320991*LOG(10.))
-      dqsatl(ptarg,pqsarg) = RLVTT/RCPD*pqsarg*LOG(10.)*
-     .                (2948.964/ptarg**2-5.028/LOG(10.)/ptarg
-     .                +25.21935*2999.924/ptarg**2*EXP(-2999.924/ptarg)
-     .                +29810.16*0.0699382*EXP(-0.0699382*ptarg))
Index: LMDZ.3.3/branches/rel-/libf/phylmd/FCTTRE.inc
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/FCTTRE.inc	(revision 416)
+++ 	(revision )
@@ -1,36 +1,0 @@
-!      ------------------------------------------------------------------
-!      This COMDECK includes the Thermodynamical functions for the cy39
-!       ECMWF Physics package.
-!       Consistent with YOMCST Basic physics constants, assuming the
-!       partial pressure of water vapour is given by a first order
-!       Taylor expansion of Qs(T) w.r.t. to Temperature, using constants
-!       in YOETHF
-!     ------------------------------------------------------------------
-      REAL PTARG, PDELARG, P5ARG, PQSARG, PCOARG
-      REAL FOEEW, FOEDE, qsats, qsatl, dqsats, dqsatl
-      LOGICAL thermcep
-      PARAMETER (thermcep=.TRUE.)
-!
-      FOEEW ( PTARG,PDELARG ) = EXP ( &
-     &          (R3LES*(1.-PDELARG)+R3IES*PDELARG) * (PTARG-RTT) &
-     & / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG)) )
-!
-      FOEDE ( PTARG,PDELARG,P5ARG,PQSARG,PCOARG ) = PQSARG*PCOARG*P5ARG &
-     & / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG))**2
-!
-      qsats(ptarg) = 100.0 * 0.622 * 10.0 &
-     &           ** (2.07023 - 0.00320991 * ptarg &
-     &           - 2484.896 / ptarg + 3.56654 * LOG10(ptarg))
-      qsatl(ptarg) = 100.0 * 0.622 * 10.0 &
-     &           ** (23.8319 - 2948.964 / ptarg &
-     &           - 5.028 * LOG10(ptarg) &
-     &           - 29810.16 * EXP( - 0.0699382 * ptarg) &
-     &           + 25.21935 * EXP( - 2999.924 / ptarg))
-!
-      dqsats(ptarg,pqsarg) = RLVTT/RCPD*pqsarg * (3.56654/ptarg &
-     &                     +2484.896*LOG(10.)/ptarg**2 &
-     &                     -0.00320991*LOG(10.))
-      dqsatl(ptarg,pqsarg) = RLVTT/RCPD*pqsarg*LOG(10.)* &
-     &                (2948.964/ptarg**2-5.028/LOG(10.)/ptarg &
-     &                +25.21935*2999.924/ptarg**2*EXP(-2999.924/ptarg) &
-     &                +29810.16*0.0699382*EXP(-0.0699382*ptarg))
Index: LMDZ.3.3/branches/rel-/libf/phylmd/LISEZMOI
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/LISEZMOI	(revision 416)
+++ 	(revision )
@@ -1,74 +1,0 @@
-Cette version de la physique est denommee "phylmd_oct98"
-Cette version a ete construite sur la base de "phylmd_juin96"
-(LMDZ.2.0). L'esprit est de rendre la structure du modele plus
-adaptee pour de futures evolutions tout en gardant, quand c'est
-possible, la version de base. Donc, theoriquement, cette version
-par defaut est tres proche de la version precedente. En resume:
--- informatique: rupture importante avec "phylmd_juin96"
--- physique: continuite avec "phylmd_juin96"
-
-De nombreuses clefs sont introduites pour controler les options:
-- check: verifier la conservation du modele en eau
-- ok_ocean: modele oceanique "slab ocean"
-- ok_oasis: couplage OASIS (ocean complet, type OPA du LODYC)
-- cycle_diurne: introduction du cycle diurne
-- soil_model: modele thermique du sol (pour le cycle diurne)
-- new_oliq: une nouvelle eau liquide pour le rayonnement
-- ok_orodr: parametrisation de l'orographie
-- ok_orolf: parametrisation de l'orographie
-- ok_journe: sortir le fichier journalier
-- ok_instan: sortir le fichier instantane
-- ok_region: sortir le fichier regional
-
-La structure du programme est la suivante:
-
-- suphec
-- phyetat0
-- sugwd
-- soil
-- o3cm
-
-- hgardfou
-- condsurf
-- ozonecm
-- clmain
-- soil
-- convection (conlmd, conflx, conccm)
-- homogene
-- flxtr
-- ajsec
-- fisrtilp
-- nuage
-- orbite
-- angle
-- alboc
-- albsno
-- radlwsw 
-- hydrol
-- drag_noro
-- lift_noro
-- transp
-
-- phyredem
-
-Quelques explications supplementaires:
-
-(1) La couche limite est appelee au debut de la physique. Elle
-fonctionne pour des sous-fractions de maille. Diffusion d'un
-traceur passif est maintenant possible
-
-(2) Le rayonnement est une version nouvelle (radlwsw), qui
-correspond a Arpege-IFS (debut 1997). L'option sur le recouvrement
-vertical des nuages est controlee dans radopt.h. Le rayonnement
-peut fonctionner maintenant region par region, ce qui reduit la
-taille en memoire du code (voir raddim.h)
-
-(3) Plusieurs schemas de convection sont au choix. Le schema
-classique du LMD (Manabe+Kuo) a subit des transformations
-importantes. Un nouveau modele est introduit pour traiter la
-condensation pendant la convection.
-
-(4) La condensation a grande echelle et la parametrisation des
-nuages sont traitees dans fisrtilp.F. La transition eau/glace
-est differente. La pluie tombante subit des eveporations si elle
-traverse des zones non-saturees.
Index: LMDZ.3.3/branches/rel-/libf/phylmd/YOECUMF.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/YOECUMF.h	(revision 416)
+++ 	(revision )
@@ -1,39 +1,0 @@
-C     ----------------------------------------------------------------
-C*    *COMMON* *YOECUMF* - PARAMETERS FOR CUMULUS MASSFLUX SCHEME
-C     ----------------------------------------------------------------
-C
-      COMMON /YOECUMF/
-     L                 LMFPEN,LMFSCV,LMFMID,LMFDD,LMFDUDV,
-     R                 ENTRPEN,ENTRSCV,ENTRMID,ENTRDD,CMFCTOP,
-     R                 CMFCMAX,CMFCMIN,CMFDEPS,RHCDD,CPRCON
-C
-      LOGICAL          LMFPEN,LMFSCV,LMFMID,LMFDD,LMFDUDV
-      REAL ENTRPEN, ENTRSCV, ENTRMID, ENTRDD
-      REAL CMFCTOP, CMFCMAX, CMFCMIN, CMFDEPS, RHCDD, CPRCON
-C
-*if (DOC,declared) <> 'UNKNOWN'
-C*    *COMMON* *YOECUMF* - PARAMETERS FOR CUMULUS MASSFLUX SCHEME
-C
-C     M.TIEDTKE       E. C. M. W. F.      18/1/89
-C
-C     NAME      TYPE      PURPOSE
-C     ----      ----      -------
-C
-C     LMFPEN    LOGICAL  TRUE IF PENETRATIVE CONVECTION IS SWITCHED ON
-C     LMFSCV    LOGICAL  TRUE IF SHALLOW     CONVECTION IS SWITCHED ON
-C     LMFMID    LOGICAL  TRUE IF MIDLEVEL    CONVECTION IS SWITCHED ON
-C     LMFDD     LOGICAL  TRUE IF CUMULUS DOWNDRAFT      IS SWITCHED ON
-C     LMFDUDV   LOGICAL  TRUE IF CUMULUS FRICTION       IS SWITCHED ON
-C     ENTRPEN   REAL     ENTRAINMENT RATE FOR PENETRATIVE CONVECTION
-C     ENTRSCV   REAL     ENTRAINMENT RATE FOR SHALLOW CONVECTION
-C     ENTRMID   REAL     ENTRAINMENT RATE FOR MIDLEVEL CONVECTION
-C     ENTRDD    REAL     ENTRAINMENT RATE FOR CUMULUS DOWNDRAFTS
-C     CMFCTOP   REAL     RELAT. CLOUD MASSFLUX AT LEVEL ABOVE NONBUOYANC
-C     CMFCMAX   REAL     MAXIMUM MASSFLUX VALUE ALLOWED FOR
-C     CMFCMIN   REAL     MINIMUM MASSFLUX VALUE (FOR SAFETY)
-C     CMFDEPS   REAL     FRACTIONAL MASSFLUX FOR DOWNDRAFTS AT LFS
-C     RHCDD     REAL     RELATIVE SATURATION IN DOWNDRAFTS
-C     CPRCON    REAL     COEFFICIENTS FOR DETERMINING CONVERSION
-C                        FROM CLOUD WATER TO RAIN
-*ifend
-C     ----------------------------------------------------------------
Index: LMDZ.3.3/branches/rel-/libf/phylmd/YOEGWD.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/YOEGWD.h	(revision 416)
+++ 	(revision )
@@ -1,9 +1,0 @@
-C     -----------------------------------------------------------------
-C*    *COMMON* *YOEGWD* - PARAMETERS FOR GRAVITY WAVE DRAG CALCULATIONS
-C     -----------------------------------------------------------------
-C
-      COMMON/YOEGWD/ GFRCRIT,GKWAKE,GRCRIT,GVCRIT,GKDRAG,GKLIFT
-     *        ,GHMAX,GRAHILO,GSIGCR,NKTOPG,NSTRA,GSSEC,GTSEC,GVSEC
-C
-
-
Index: LMDZ.3.3/branches/rel-/libf/phylmd/YOETHF.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/YOETHF.h	(revision 416)
+++ 	(revision )
@@ -1,12 +1,0 @@
-C*    COMMON *YOETHF* DERIVED CONSTANTS SPECIFIC TO ECMWF THERMODYNAMICS
-C
-C     *R__ES*   *CONSTANTS USED FOR COMPUTATION OF SATURATION
-C                MIXING RATIO OVER LIQUID WATER(*R_LES*) OR
-C                ICE(*R_IES*).
-C     *RVTMP2*  *RVTMP2=RCPV/RCPD-1.
-C     *RHOH2O*  *DENSITY OF LIQUID WATER.   (RATM/100.)
-C
-      REAL R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES
-      REAL RVTMP2, RHOH2O
-      COMMON /YOETHF/R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES,
-     .               RVTMP2, RHOH2O
Index: LMDZ.3.3/branches/rel-/libf/phylmd/YOETHF.inc
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/YOETHF.inc	(revision 416)
+++ 	(revision )
@@ -1,12 +1,0 @@
-!*    COMMON *YOETHF* DERIVED CONSTANTS SPECIFIC TO ECMWF THERMODYNAMICS
-!
-!     *R__ES*   *CONSTANTS USED FOR COMPUTATION OF SATURATION
-!                MIXING RATIO OVER LIQUID WATER(*R_LES*) OR
-!                ICE(*R_IES*).
-!     *RVTMP2*  *RVTMP2=RCPV/RCPD-1.
-!     *RHOH2O*  *DENSITY OF LIQUID WATER.   (RATM/100.)
-!
-      REAL R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES
-      REAL RVTMP2, RHOH2O
-      COMMON /YOETHF/R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES, &
-     &               RVTMP2, RHOH2O
Index: LMDZ.3.3/branches/rel-/libf/phylmd/YOMCST.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/YOMCST.h	(revision 416)
+++ 	(revision )
@@ -1,33 +1,0 @@
-C A1.0 Fundamental constants
-      REAL RPI,RCLUM,RHPLA,RKBOL,RNAVO
-C A1.1 Astronomical constants
-      REAL RDAY,REA,REPSM,RSIYEA,RSIDAY,ROMEGA
-c A1.1.bis Constantes concernant l'orbite de la Terre:
-      REAL R_ecc, R_peri, R_incl
-C A1.2 Geoide
-      REAL RA,RG,R1SA
-C A1.3 Radiation
-      REAL RSIGMA,RI0
-C A1.4 Thermodynamic gas phase
-      REAL R,RMD,RMV,RD,RV,RCPD,RCPV,RCVD,RCVV
-      REAL RKAPPA,RETV
-C A1.5,6 Thermodynamic liquid,solid phases
-      REAL RCW,RCS
-C A1.7 Thermodynamic transition of phase
-      REAL RLVTT,RLSTT,RLMLT,RTT,RATM
-C A1.8 Curve of saturation
-      REAL RESTT,RALPW,RBETW,RGAMW,RALPS,RBETS,RGAMS
-      REAL RALPD,RBETD,RGAMD
-C
-      COMMON/YOMCST/RPI   ,RCLUM ,RHPLA ,RKBOL ,RNAVO
-     S      ,RDAY  ,REA   ,REPSM ,RSIYEA,RSIDAY,ROMEGA
-     s      ,R_ecc, R_peri, R_incl
-     S      ,RA    ,RG    ,R1SA
-     S      ,RSIGMA,RI0
-     S      ,R     ,RMD   ,RMV   ,RD    ,RV    ,RCPD
-     S      ,RCPV  ,RCVD  ,RCVV  ,RKAPPA,RETV
-     S      ,RCW   ,RCS
-     S      ,RLVTT ,RLSTT ,RLMLT ,RTT   ,RATM
-     S      ,RESTT ,RALPW ,RBETW ,RGAMW ,RALPS ,RBETS ,RGAMS
-     S      ,RALPD ,RBETD ,RGAMD
-C    ------------------------------------------------------------------
Index: LMDZ.3.3/branches/rel-/libf/phylmd/YOMCST.inc
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/YOMCST.inc	(revision 416)
+++ 	(revision )
@@ -1,26 +1,0 @@
-! A1.0 Fundamental constants
-      REAL :: RPI,RCLUM,RHPLA,RKBOL,RNAVO
-! A1.1 Astronomical constants
-      REAL :: RDAY,REA,REPSM,RSIYEA,RSIDAY,ROMEGA
-! A1.1.bis Constantes concernant l'orbite de la Terre:
-      REAL :: R_ecc, R_peri, R_incl
-! A1.2 Geoide
-      REAL :: RA,RG,R1SA
-! A1.3 Radiation
-      REAL :: RSIGMA,RI0
-! A1.4 Thermodynamic gas phase
-      REAL :: R,RMD,RMV,RD,RV,RCPD,RCPV,RCVD,RCVV
-      REAL :: RKAPPA,RETV
-! A1.5,6 Thermodynamic liquid,solid phases
-      REAL :: RCW,RCS
-! A1.7 Thermodynamic transition of phase
-      REAL :: RLVTT,RLSTT,RLMLT,RTT,RATM
-! A1.8 Curve of saturation
-      REAL :: RESTT,RALPW,RBETW,RGAMW,RALPS,RBETS,RGAMS
-      REAL :: RALPD,RBETD,RGAMD
-!
-      COMMON/YOMCST/RPI ,RCLUM, RHPLA, RKBOL, RNAVO ,RDAY  ,REA &
-     & ,REPSM ,RSIYEA,RSIDAY,ROMEGA ,R_ecc, R_peri, R_incl, RA    ,RG &
-     & ,R1SA ,RSIGMA,RI0,R ,RMD   ,RMV   ,RD    ,RV    ,RCPD ,RCPV,RCVD &
-     & ,RCVV  ,RKAPPA,RETV ,RCW   ,RCS ,RLVTT ,RLSTT ,RLMLT ,RTT ,RATM &
-     & ,RESTT ,RALPW ,RBETW ,RGAMW ,RALPS ,RBETS ,RGAMS ,RALPD ,RBETD ,RGAMD
Index: LMDZ.3.3/branches/rel-/libf/phylmd/ajsec.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/ajsec.F	(revision 416)
+++ 	(revision )
@@ -1,240 +1,0 @@
-      SUBROUTINE ajsec(paprs, pplay, t,q, d_t,d_q)
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
-c Objet: ajustement sec (adaptation du GCM du LMD)
-c======================================================================
-c Arguments:
-c t-------input-R- Temperature
-c
-c d_t-----output-R-Incrementation de la temperature
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-      REAL paprs(klon,klev+1), pplay(klon,klev)
-      REAL t(klon,klev), q(klon,klev)
-      REAL d_t(klon,klev), d_q(klon,klev)
-c
-      INTEGER limbas, limhau ! les couches a ajuster
-ccc      PARAMETER (limbas=klev-3, limhau=klev)
-      PARAMETER (limbas=1, limhau=klev)
-c
-      LOGICAL mixq
-ccc      PARAMETER (mixq=.TRUE.)
-      PARAMETER (mixq=.FALSE.)
-c
-      REAL zh(klon,klev)
-      REAL zq(klon,klev)
-      REAL zpk(klon,klev)
-      REAL zpkdp(klon,klev)
-      REAL hm, sm, qm
-      LOGICAL modif(klon), down
-      INTEGER i, k, k1, k2
-c
-c Initialisation:
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         d_t(i,k) = 0.0
-         d_q(i,k) = 0.0
-      ENDDO
-      ENDDO
-c------------------------------------- detection des profils a modifier
-      DO k = limbas, limhau
-      DO i = 1, klon
-         zpk(i,k) = pplay(i,k)**RKAPPA
-         zh(i,k) = RCPD * t(i,k)/ zpk(i,k)
-         zq(i,k) = q(i,k)
-      ENDDO
-      ENDDO
-c
-      DO k = limbas, limhau
-      DO i = 1, klon
-         zpkdp(i,k) = zpk(i,k) * (paprs(i,k)-paprs(i,k+1))
-      ENDDO
-      ENDDO
-c
-      DO i = 1, klon
-         modif(i) = .FALSE.
-      ENDDO
-      DO k = limbas+1, limhau
-      DO i = 1, klon
-      IF (.NOT.modif(i)) THEN
-         IF ( zh(i,k).LT.zh(i,k-1) ) modif(i) = .TRUE.
-      ENDIF
-      ENDDO
-      ENDDO
-c------------------------------------- correction des profils instables
-      DO 1080 i = 1, klon
-      IF (modif(i)) THEN
-          k2 = limbas
- 8000     CONTINUE
-            k2 = k2 + 1
-            IF (k2 .GT. limhau) goto 8001
-            IF (zh(i,k2) .LT. zh(i,k2-1)) THEN
-              k1 = k2 - 1
-              k = k1
-              sm = zpkdp(i,k2)
-              hm = zh(i,k2)
-              qm = zq(i,k2)
- 8020         CONTINUE
-                sm = sm +zpkdp(i,k)
-                hm = hm +zpkdp(i,k) * (zh(i,k)-hm) / sm
-                qm = qm +zpkdp(i,k) * (zq(i,k)-qm) / sm
-                down = .FALSE.
-                IF (k1 .ne. limbas) THEN
-                  IF (hm .LT. zh(i,k1-1)) down = .TRUE.
-                ENDIF
-                IF (down) THEN
-                  k1 = k1 - 1
-                  k = k1
-                ELSE
-                  IF ((k2 .EQ. limhau)) GOTO 8021
-                  IF ((zh(i,k2+1).GE.hm)) GOTO 8021
-                  k2 = k2 + 1
-                  k = k2
-                ENDIF
-              GOTO 8020
- 8021         CONTINUE
-c------------ nouveau profil : constant (valeur moyenne)
-              DO k = k1, k2
-                zh(i,k) = hm
-                zq(i,k) = qm
-              ENDDO
-              k2 = k2 + 1
-            ENDIF
-          GOTO 8000
- 8001     CONTINUE
-      ENDIF
- 1080 CONTINUE
-c
-      DO k = limbas, limhau
-      DO i = 1, klon
-         d_t(i,k) = zh(i,k)*zpk(i,k)/RCPD - t(i,k)
-         d_q(i,k) = zq(i,k) - q(i,k)
-      ENDDO
-      ENDDO
-c
-      IF (limbas.GT.1) THEN
-      DO k = 1, limbas-1
-      DO i = 1, klon
-         d_t(i,k) = 0.0
-         d_q(i,k) = 0.0
-      ENDDO
-      ENDDO
-      ENDIF
-c
-      IF (limhau.LT.klev) THEN
-      DO k = limhau+1, klev
-      DO i = 1, klon
-         d_t(i,k) = 0.0
-         d_q(i,k) = 0.0
-      ENDDO
-      ENDDO
-      ENDIF
-c
-      IF (.NOT.mixq) THEN
-      DO k = 1, klev
-      DO i = 1, klon
-         d_q(i,k) = 0.0
-      ENDDO
-      ENDDO
-      ENDIF
-c
-      RETURN
-      END
-      SUBROUTINE ajsec_old(paprs, pplay, t, d_t)
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
-c Objet: ajustement sec (adaptation du GCM du LMD)
-c======================================================================
-c Arguments:
-c t-------input-R- Temperature
-c
-c d_t-----output-R-Incrementation de la temperature
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-      REAL paprs(klon,klev+1), pplay(klon,klev)
-      REAL t(klon,klev)
-      REAL d_t(klon,klev)
-c
-      REAL local_h(klon,klev)
-      REAL hm, sm
-      LOGICAL modif(klon), down
-      INTEGER i, l, l1, l2
-c------------------------------------- detection des profils a modifier
-      DO i = 1, klon
-         modif(i)   = .false.
-      ENDDO
-c
-      DO l = 1, klev
-      DO i = 1, klon
-         local_h(i,l) = RCPD * t(i,l)/ (pplay(i,l)**RKAPPA)
-      ENDDO
-      ENDDO
-c
-      DO l = 2, klev
-      DO i = 1, klon
-         IF ( local_h(i,l).lt.local_h(i,l-1) ) THEN
-            modif(i) = .true.
-         ELSE
-            modif(i) = modif(i)
-         ENDIF
-      ENDDO
-      ENDDO
-c------------------------------------- correction des profils instables
-      do 1080 i = 1, klon
-        if (modif(i)) then
-          l2 = 1
- 8000     continue
-            l2 = l2 + 1
-            if (l2 .gt. klev) goto 8001
-            if (local_h(i, l2) .lt. local_h(i, l2-1)) then
-              l1 = l2 - 1
-              l  = l1
-              sm = pplay(i,l2)**rkappa * (paprs(i,l2)-paprs(i,l2+1))
-              hm = local_h(i, l2)
- 8020         continue
-                sm = sm +pplay(i,l)**rkappa*(paprs(i,l)-paprs(i,l+1))
-                hm = hm +pplay(i,l)**rkappa*(paprs(i,l)-paprs(i,l+1))
-     .                         * (local_h(i, l) - hm) / sm
-                down = .false.
-                if (l1 .ne. 1) then
-                  if (hm .lt. local_h(i, l1-1)) then
-                    down = .true.
-                  end if
-                end if
-                if (down) then
-                  l1 = l1 - 1
-                  l  = l1
-                else
-                  if ((l2 .eq. klev)) GOTO 8021
-                  IF ((local_h(i, l2+1).ge.hm)) goto 8021
-                  l2 = l2 + 1
-                  l  = l2
-                end if
-              go to 8020
- 8021         continue
-c------------ nouveau profil : constant (valeur moyenne)
-              do 1100 l = l1, l2
-                local_h(i, l) = hm
- 1100         continue
-              l2 = l2 + 1
-            end if
-          go to 8000
- 8001     continue
-        end if
- 1080 continue
-c
-      DO l = 1, klev
-      DO i = 1, klon
-         d_t(i,l) = local_h(i,l)*(pplay(i,l)**rkappa)/RCPD - t(i,l)
-      ENDDO
-      ENDDO
-c
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/albedo.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/albedo.F	(revision 416)
+++ 	(revision )
@@ -1,131 +1,0 @@
-      SUBROUTINE alboc(rjour,rlat,albedo)
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS) (adaptation du GCM du LMD)
-c Date: le 16 mars 1995
-c Objet: Calculer l'albedo sur l'ocean
-c Methode: Integrer numeriquement l'albedo pendant une journee
-c
-c Arguments;
-c rjour (in,R)  : jour dans l'annee (a compter du 1 janvier)
-c rlat (in,R)   : latitude en degre
-c albedo (out,R): albedo obtenu (de 0 a 1)
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-c
-      REAL fmagic ! un facteur magique pour regler l'albedo
-ccc      PARAMETER (fmagic=0.7)
-      PARAMETER (fmagic=1.1)
-      INTEGER npts ! il controle la precision de l'integration
-      PARAMETER (npts=120) ! 120 correspond a l'interval 6 minutes
-c
-      REAL rlat(klon), rjour, albedo(klon)
-      REAL zdist, zlonsun, zpi, zdeclin
-      REAL rmu,alb, srmu, salb, fauxo, aa, bb
-      INTEGER i, k
-c
-      zpi = 4. * ATAN(1.)
-c
-c Calculer la longitude vraie de l'orbite terrestre:
-      CALL orbite(rjour,zlonsun,zdist)
-c
-c Calculer la declinaison du soleil (qui varie entre + et - R_incl):
-      zdeclin = ASIN(SIN(zlonsun*zpi/180.0)*SIN(R_incl*zpi/180.0))
-c
-      DO 999 i=1,klon
-      aa = SIN(rlat(i)*zpi/180.0) * SIN(zdeclin)
-      bb = COS(rlat(i)*zpi/180.0) * COS(zdeclin)
-c
-c Midi local (angle du temps = 0.0):
-      rmu = aa + bb * COS(0.0)
-      rmu = MAX(0.0, rmu)
-      fauxo = (1.47-ACOS(rmu))/.15
-      alb = 0.03+0.630/(1.+fauxo*fauxo)
-      srmu = rmu
-      salb = alb * rmu
-c
-c Faire l'integration numerique de midi a minuit (le facteur 2
-c prend en compte l'autre moitie de la journee):
-      DO k = 1, npts
-         rmu = aa + bb * COS(FLOAT(k)/FLOAT(npts)*zpi)
-         rmu = MAX(0.0, rmu)
-         fauxo = (1.47-ACOS(rmu))/.15
-         alb = 0.03+0.630/(1.+fauxo*fauxo)
-         srmu = srmu + rmu * 2.0
-         salb = salb + alb*rmu * 2.0
-      ENDDO
-      IF (srmu .NE. 0.0) THEN
-         albedo(i) = salb / srmu * fmagic
-      ELSE ! nuit polaire (on peut prendre une valeur quelconque)
-         albedo(i) = fmagic
-      ENDIF
-  999 CONTINUE
-      RETURN
-      END
-c=====================================================================
-      SUBROUTINE alboc_cd(rmu0,albedo)
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS)
-c date: 19940624
-c Calculer l'albedo sur l'ocean en fonction de l'angle zenithal moyen
-c Formule due a Larson and Barkstrom (1977) Proc. of the symposium
-C on radiation in the atmosphere, 19-28 August 1976, science Press,
-C 1977 pp 451-453, ou These de 3eme cycle de Sylvie Joussaume.
-c
-c Arguments
-c rmu0    (in): cosinus de l'angle solaire zenithal
-c albedo (out): albedo de surface de l'ocean
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-      REAL rmu0(klon), albedo(klon)
-c
-      REAL fmagic ! un facteur magique pour regler l'albedo
-ccc      PARAMETER (fmagic=0.7)
-      PARAMETER (fmagic=1.1)
-c
-      REAL fauxo
-      INTEGER i
-c
-      DO i = 1, klon
-         fauxo = ( 1.47 - ACOS( rmu0(i) ) )/0.15
-         albedo(i) = fmagic*( .03 + .630/( 1. + fauxo*fauxo))
-         albedo(i) = MAX(MIN(albedo(i),0.60),0.04)
-      ENDDO
-c
-      RETURN
-      END
-c========================================================================
-      SUBROUTINE albsno(veget, agesno, alb_neig)
-      IMPLICIT none
-c
-#include "dimensions.h"
-#include "dimphy.h"
-      INTEGER nvm
-      PARAMETER (nvm=8)
-      REAL veget(klon,nvm)
-      REAL alb_neig(klon)
-      REAL agesno(klon)
-c
-      INTEGER i, nv
-c
-      REAL init(nvm), decay(nvm), as
-      SAVE init, decay
-      DATA init /0.55, 0.14, 0.18, 0.29, 0.15, 0.15, 0.14, 0./
-      DATA decay/0.30, 0.67, 0.63, 0.45, 0.40, 0.14, 0.06, 1./
-c
-      DO i = 1, klon
-         alb_neig(i) = 0.0
-      ENDDO
-      DO nv = 1, nvm
-         DO i = 1, klon
-            as = init(nv)+decay(nv)*EXP(-agesno(i)/5.)
-            alb_neig(i) = alb_neig(i) + veget(i,nv)*as
-         ENDDO
-      ENDDO
-c
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/atm2geo.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/atm2geo.F	(revision 416)
+++ 	(revision )
@@ -1,44 +1,0 @@
-C
-      SUBROUTINE atm2geo ( im, jm, pte, ptn, plon, plat, pxx, pyy, pzz )
-cc
-cc Change wind local atmospheric coordinates to
-cc geocentric
-cc
-c$$$      INCLUDE 'param.h'
-c
-      INTEGER, INTENT (in)              :: im, jm
-      REAL, DIMENSION (im,jm), INTENT (in) :: pte, ptn
-      REAL, DIMENSION (im,jm), INTENT (in) :: plon, plat
-      REAL, DIMENSION (im,jm), INTENT(out) :: pxx, pyy, pzz
-c
-      REAL, PARAMETER :: rpi = 3.141592653E0
-      REAL, PARAMETER :: rad = rpi / 180.0E0
-c
-      REAL, DIMENSION (im,jm) :: zsinlon, zcoslon
-      REAL, DIMENSION (im,jm) :: zsinlat, zcoslat
-c
-      LOGICAL, SAVE :: linit = .FALSE.
-c
-c$$$      IF ( .NOT. linit ) THEN 
-          zsinlon = SIN (rad * plon)
-          zcoslon = COS (rad * plon)
-          zsinlat = SIN (rad * plat)
-          zcoslat = COS (rad * plat)
-          linit = .TRUE.
-c$$$      ENDIF 
-c
-      pxx = - zsinlon * pte - zsinlat * zcoslon * ptn
-      pyy =   zcoslon * pte - zsinlat * zsinlon * ptn
-      pzz =   zcoslat * ptn
-c
-c Value at North Pole
-      pxx ( :,  1) = - ptn ( 1, 1)
-      pyy ( :,  1) = - pte ( 1, 1)
-      pzz ( :,  1) = 0.0
-c Value at South Pole
-      pxx ( :, jm) = + ptn ( 1, jm)
-      pyy ( :, jm) = + pte ( 1, jm)
-      pzz ( :, jm) = 0.0
-c
-      RETURN 
-      END SUBROUTINE atm2geo
Index: LMDZ.3.3/branches/rel-/libf/phylmd/calcratqs.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/calcratqs.F	(revision 416)
+++ 	(revision )
@@ -1,159 +1,0 @@
-c $Header$
-      SUBROUTINE calcratqs (flag_ratqs,
-     I            paprs,pplay,q_seri,d_t_con,d_t_ajs
-     O           ,ratqs,zpt_conv)
-      IMPLICIT none
-c======================================================================
-c
-c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
-c
-c Objet: Moniteur general de la physique du modele
-cAA      Modifications quant aux traceurs :
-cAA                  -  uniformisation des parametrisations ds phytrac
-cAA                  -  stockage des moyennes des champs necessaires
-cAA                     en mode traceur off-line 
-c======================================================================
-c    modif   ( P. Le Van ,  12/10/98 )
-c
-c  Arguments:
-c
-c paprs---input-R-pression pour chaque inter-couche (en Pa)
-c pplay---input-R-pression pour le mileu de chaque couche (en Pa)
-c presnivs-input_R_pressions approximat. des milieux couches ( en PA)
-#include "dimensions.h"
-#include "dimphy.h"
-      REAL paprs(klon,klev+1)
-      REAL pplay(klon,klev)
-      REAL d_t_con(klon,klev)
-      REAL d_t_ajs(klon,klev)
-      REAL ratqs(klon,klev)
-      LOGICAL pt_conv(klon,klev)
-      REAL q_seri(klon,klev)
-
-      logical firstcall
-      save firstcall
-      data firstcall/.true./
-
-
-      REAL ratqsmin,ratqsmax,zx,epmax
-      REAL ratqs1,ratqs2,ratqs3,ratqs4
-      REAL ratqsc1,ratqsc2,ratqsc3,ratqsc4
-      INTEGER i,k
-      INTEGER flag_ratqs
-      save ratqsmin,ratqsmax,epmax
-      save ratqs1,ratqs2,ratqs3,ratqs4
-      save ratqsc1,ratqsc2,ratqsc3,ratqsc4
-      real zpt_conv(klon,klev)
-
-      REAL zx_min
-      PARAMETER (zx_min=1.0)
-      REAL zx_max
-      PARAMETER (zx_max=0.1)
-
-c
-c Appeler le processus de condensation a grande echelle
-c et le processus de precipitation
-c
-      if (flag_ratqs.eq.0) then
-
-         ratqsmax=0.01
-         ratqsmin=0.3
-
-         if (firstcall) print*,'RATQS ANCIEN '
-         do k=1,klev
-         do i=1,klon
-            zx = pplay(i,k)/paprs(i,1)
-            zx = (zx_max-zx)/(zx_max-zx_min)
-            zx = MIN(MAX(zx,0.0),1.0)
-            zx = zx * zx * zx
-            ratqs(i,k)= zx * (ratqsmax-ratqsmin) + ratqsmin
-         enddo
-         enddo
-
-      else
-
-c  On aplique un ratqs "interactif" a toutes les mailles affectees
-c  par la convection ou se trouvant "sous" une maille affectee.
-         do i=1,klon
-            pt_conv(i,klev)=.false.
-         enddo
-         do k=klev-1,1,-1
-            do i=1,klon
-               pt_conv(i,k)=pt_conv(i,k+1).or.
-     s               (abs(d_t_con(i,k))+abs(d_t_ajs(i,k))).gt.1.e-8
-               if(pt_conv(i,k)) then
-                  zpt_conv(i,k)=1.
-               else
-                  zpt_conv(i,k)=0.
-               endif
-            enddo
-         enddo
-
-         if (flag_ratqs.eq.1) then
-
-            ratqsmin=0.4
-            ratqsmax=0.99
-            if (firstcall) print*,'RATQS INTERACTIF '
-            do k=1,klev
-                do i=1,klon
-                   if (pt_conv(i,k)) then
-                      ratqs(i,k)=0.01
-     s                +0.25*(q_seri(i,1)-q_seri(i,k))/q_seri(i,k)
-                      ratqs(i,k)=min(ratqs(i,k),ratqsmax)
-                      ratqs(i,k)=max(ratqs(i,k),0.1)
-                   else
-                      ratqs(i,k)=0.01+(ratqsmin-0.01)*
-     s             min((paprs(i,1)-pplay(i,k))/(paprs(i,1)-30000.),1.)
-                   endif
-                enddo
-            enddo
-         else if (flag_ratqs.eq.2) then
-            do k=1,klev
-                do i=1,klon
-                   ratqs(i,k)=0.001+
-     s             (q_seri(i,1)-q_seri(i,k))/q_seri(i,k)
-                   if (pt_conv(i,k)) then
-                      ratqs(i,k)=min(ratqs(i,k),ratqsmax)
-                   else
-                      ratqs(i,k)=min(ratqs(i,k),ratqsmin)
-                   endif
-                enddo
-            enddo
-         else
-            do k=1,klev
-               do i=1,klon
-                  if (pplay(i,k).ge.95000.) then
-                     if (pt_conv(i,k)) then
-                        ratqs(i,k)=ratqsc1
-                     else
-                        ratqs(i,k)=ratqs1
-                     endif
-                  else if (pplay(i,k).ge.75000.) then
-                     if (pt_conv(i,k)) then
-                        ratqs(i,k)=ratqsc2
-                     else
-                        ratqs(i,k)=ratqs2
-                     endif
-                  else if (pplay(i,k).ge.50000.) then
-                     if (pt_conv(i,k)) then
-                        ratqs(i,k)=ratqsc3
-                     else
-                        ratqs(i,k)=ratqs3
-                     endif
-                  else
-                     if (pt_conv(i,k)) then
-                        ratqs(i,k)=ratqsc4
-                     else
-                        ratqs(i,k)=ratqs4
-                     endif
-                  endif
-               enddo
-            enddo
-         endif
-
-      endif
-
-      firstcall=.false.
-
-      return
-      end
Index: LMDZ.3.3/branches/rel-/libf/phylmd/clcdrag.F90
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/clcdrag.F90	(revision 416)
+++ 	(revision )
@@ -1,101 +1,0 @@
-      SUBROUTINE clcdrag(klon, knon, nsrf, zxli, &
-                         u, v, t, q, zgeop, &
-                         ts, qsurf, rugos, &
-                         pcfm, pcfh)
-      IMPLICIT NONE
-! ================================================================= c
-!
-! Objet : calcul des cdrags pour le moment (pcfm) et 
-!         les flux de chaleur sensible et latente (pcfh).   
-!
-! ================================================================= c
-!
-! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
-! knon----input-I- nombre de points pour un type de surface
-! nsrf----input-I- indice pour le type de surface; voir indicesol.inc
-! zxli----input-L- calcul des cdrags selon Laurent Li
-! u-------input-R- vent zonal au 1er niveau du modele
-! v-------input-R- vent meridien au 1er niveau du modele
-! t-------input-R- temperature de l'air au 1er niveau du modele
-! q-------input-R- humidite de l'air au 1er niveau du modele
-! zgeop---input-R- geopotentiel au 1er niveau du modele
-! ts------input-R- temperature de l'air a la surface
-! qsurf---input-R- humidite de l'air a la surface
-! rugos---input-R- rugosite
-!
-! pcfm---output-R- cdrag pour le moment 
-! pcfh---output-R- cdrag pour les flux de chaleur latente et sensible
-!
-      INTEGER, intent(in) :: klon, knon, nsrf
-      LOGICAL, intent(in) :: zxli
-      REAL, intent(in), dimension(klon) :: u, v, t, q, zgeop
-      REAL, intent(in), dimension(klon) :: ts, qsurf
-      REAL, intent(in), dimension(klon) :: rugos
-      REAL, intent(out), dimension(klon) :: pcfm, pcfh
-! ================================================================= c
-!
-#include "YOMCST.inc"
-#include "YOETHF.inc"
-#include "indicesol.inc"
-!
-! Quelques constantes et options:
-      REAL, PARAMETER :: ckap=0.35, cb=5.0, cc=5.0, cd=5.0, cepdu2=(0.1)**2
-!
-! Variables locales :
-      INTEGER :: i
-      REAL :: zdu2, ztsolv, ztvd, zscf
-      REAL :: zucf, zcr
-      REAL :: friv, frih
-      REAL, dimension(klon) :: zcfm1, zcfm2
-      REAL, dimension(klon) :: zcfh1, zcfh2
-      REAL, dimension(klon) :: zcdn
-      REAL, dimension(klon) :: zri
-!
-! Fonctions thermodynamiques et fonctions d'instabilite
-      REAL :: fsta, fins, x
-      fsta(x) = 1.0 / (1.0+10.0*x*(1+8.0*x))
-      fins(x) = SQRT(1.0-18.0*x)
-! ================================================================= c
-!
-! Calculer le frottement au sol (Cdrag)
-!
-      DO i = 1, knon
-        zdu2 = max(cepdu2,u(i)**2+v(i)**2)
-        ztsolv = ts(i) * (1.0+RETV*qsurf(i))
-        ztvd = (t(i)+zgeop(i)/RCPD/(1.+RVTMP2*q(i))) &
-             *(1.+RETV*q(i))
-        zri(i) = zgeop(i)*(ztvd-ztsolv)/(zdu2*ztvd)
-        zcdn(i) = (ckap/log(1.+zgeop(i)/(RG*rugos(i))))**2
-!
-        IF (zri(i) .ge. 0.) THEN      ! situation stable
-          zri(i) = min(20.,zri(i))
-          IF (.NOT.zxli) THEN
-            zscf = SQRT(1.+cd*ABS(zri(i)))
-            FRIV = AMAX1(1. / (1.+2.*CB*zri(i)/ZSCF), 0.1)
-            zcfm1(i) = zcdn(i) * FRIV
-            FRIH = AMAX1(1./ (1.+3.*CB*zri(i)*ZSCF), 0.1 )
-            zcfh1(i) = zcdn(i) * FRIH
-            pcfm(i) = zcfm1(i)
-            pcfh(i) = zcfh1(i)
-          ELSE
-            pcfm(i) = zcdn(i)* fsta(zri(i))
-            pcfh(i) = zcdn(i)* fsta(zri(i))
-          ENDIF
-        ELSE                          ! situation instable
-          IF (.NOT.zxli) THEN
-            zucf = 1./(1.+3.0*cb*cc*zcdn(i)*SQRT(ABS(zri(i)) &
-                 *(1.0+zgeop(i)/(RG*rugos(i)))))
-            zcfm2(i) = zcdn(i)*amax1((1.-2.0*cb*zri(i)*zucf),0.1)
-            zcfh2(i) = zcdn(i)*amax1((1.-3.0*cb*zri(i)*zucf),0.1)
-            pcfm(i) = zcfm2(i)
-            pcfh(i) = zcfh2(i)
-          ELSE
-            pcfm(i) = zcdn(i)* fins(zri(i))
-            pcfh(i) = zcdn(i)* fins(zri(i))
-          ENDIF
-          zcr = (0.0016/(zcdn(i)*SQRT(zdu2)))*ABS(ztvd-ztsolv)**(1./3.)
-          IF(nsrf.EQ.is_oce) pcfh(i) = zcdn(i)*(1.0+zcr**1.25)**(1./1.25)
-        ENDIF
-      END DO
-      RETURN
-      END SUBROUTINE clcdrag
Index: LMDZ.3.3/branches/rel-/libf/phylmd/clesphys.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/clesphys.h	(revision 416)
+++ 	(revision )
@@ -1,9 +1,0 @@
-c..include cles_phys.h
-c
-       LOGICAL cycle_diurne,soil_model,new_oliq,ok_orodr,ok_orolf 
-       LOGICAL ok_limitvrai
-       INTEGER nbapp_rad, iflag_con
-
-       COMMON/clesphys/cycle_diurne, soil_model, new_oliq ,
-     ,     ok_orodr, ok_orolf, ok_limitvrai, nbapp_rad, iflag_con
-c
Index: LMDZ.3.3/branches/rel-/libf/phylmd/clift.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/clift.F	(revision 416)
+++ 	(revision )
@@ -1,70 +1,0 @@
-c $Header$
-        SUBROUTINE CLIFT (P,T,RR,RS,PLCL,DPLCLDT,DPLCLDQ)
-C***************************************************************
-C*                                                             *
-C* CLIFT : COMPUTE LIFTING CONDENSATION LEVEL AND ITS          *
-C*         DERIVATIVES RELATIVE TO T AND R                     *
-C*   (WITHIN 0.2% OF FORMULA OF BOLTON, MON. WEA. REV.,1980)   *
-C*                                                             *
-C* written by   : GRANDPEIX Jean-Yves, 17/11/98, 12.39.01      *
-C* modified by :                                               *
-C***************************************************************
-C*
-C*Arguments :
-C*
-C* Input :  P = pressure of level from wich lifting is performed
-C*          T = temperature of level P
-C*          RR = vapour mixing ratio at level P
-C*          RS = vapour saturation mixing ratio at level P
-C*
-C* Output : PLCL = lifting condensation level
-C*          DPLCLDT = derivative of PLCL relative to T
-C*          DPLCLDQ = derivative of PLCL relative to R
-C*
-ccccccccccccccccccccccc
-c constantes coherentes avec le modele du Centre Europeen
-c      RD = 1000.0 * 1.380658E-23 * 6.0221367E+23 / 28.9644
-c      RV = 1000.0 * 1.380658E-23 * 6.0221367E+23 / 18.0153
-c      CPD = 3.5 * RD
-c      CPV = 4.0 * RV
-c      CL = 4218.0
-c      CI=2090.0
-c      CPVMCL=CL-CPV
-c      CLMCI=CL-CI
-c      EPS=RD/RV
-c      ALV0=2.5008E+06
-c      ALF0=3.34E+05
-c
-c on utilise les constantes thermo du Centre Europeen: (sb)
-c
-#include "YOMCST.h"
-c
-       CPD = RCPD
-       CPV = RCPV
-       CL = RCW
-       CPVMCL = CL-CPV
-       EPS = RD/RV
-       ALV0 = RLVTT
-c
-c
-c      Bolton formula coefficients :
-      A = 1669.0
-      B = 122.0
-c
-      RH=RR/RS
-      CHI=T/(A-B*RH-T)
-      PLCL=P*(RH**CHI)
-c
-      ALV = ALV0 - CPVMCL*(T-273.15)
-c
-c -- sb: correction:
-c       DPLCLDQ = PLCL*CHI*( 1./RR - B*CHI/T/RS*ALOG(RH) )
-      DPLCLDQ = PLCL*CHI*( 1./RR + B*CHI/T/RS*ALOG(RH) )
-c sb --
-c
-      DPLCLDT = PLCL*CHI*((A-B*RH*(1.+ALV/RV/T))/T**2*CHI*ALOG(RH)
-     $                    - ALV/RV/T**2 )
-c
-c
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/clim.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/clim.h	(revision 416)
+++ 	(revision )
@@ -1,109 +1,0 @@
-C
-C     - - - - - - - - - - - - - - - - - - - - - - - - -
-C
-C*    =clim.h=  CLIM 1.1 include file 
-C	        Coupling Library for Interfacing Models
-C
-C     - - - - - - - - - - - - - - - - - - - - - - - - -
-C
-      INTEGER*4 CLIM_Void
-C
-      INTEGER*4	CLIM_MaxMod,
-     *          CLIM_MaxPort,   
-     *          CLIM_MaxSegments,
-     *          CLIM_MaxTag,
-     *          CLIM_MaxLink,
-     *          CLIM_ParSize,
-     *          CLIM_Clength
-C
-      INTEGER*4 CLIM_In,        CLIM_Out,       CLIM_InOut
-C
-      INTEGER*4 CLIM_Strategy,  CLIM_Serial,
-     *          CLIM_Apple,     CLIM_Orange,    CLIM_Box,
-     *          CLIM_Segments,  CLIM_Length,    CLIM_Offset,
-     *          CLIM_SizeX,     CLIM_SizeY,     CLIM_LdX
-C
-      INTEGER*4 CLIM_Integer,   CLIM_Real,      CLIM_Double
-C
-      INTEGER*4 CLIM_StopPvm,   CLIM_ContPvm
-C
-      INTEGER*4	CLIM_MaxCodes,  CLIM_Ok,
-     *          CLIM_FastExit,  CLIM_BadName,   CLIM_BadPort,
-     *          CLIM_BadType,   CLIM_DoubleDef, CLIM_NotStep,
-     *          CLIM_IncStep,   CLIM_IncSize,   CLIM_NotClim,
-     *          CLIM_TimeOut,
-     *          CLIM_Pvm,       CLIM_FirstCall, CLIM_PbRoute,
-     *          CLIM_Group,     CLIM_BadTaskId, CLIM_NoTask,
-     *          CLIM_InitBuff,  CLIM_Pack,      CLIM_Unpack,
-     *          CLIM_Down,      CLIM_PvmExit
-C
-C-----Parameter sizes
-C
-      PARAMETER ( CLIM_Void    = 0  )
-      PARAMETER ( CLIM_MaxMod  = 8 )
-      PARAMETER ( CLIM_MaxPort = 16 )
-      PARAMETER ( CLIM_MaxSegments = 160 )
-      PARAMETER ( CLIM_MaxLink = CLIM_MaxMod * CLIM_MaxPort )
-      PARAMETER ( CLIM_ParSize = 2 * CLIM_MaxSegments + 2 )
-      PARAMETER ( CLIM_MaxTag  = 16777215 )
-      PARAMETER ( CLIM_Clength = 32 )
-C
-C-----Ports status
-C
-      PARAMETER ( CLIM_In      = 1 )
-      PARAMETER ( CLIM_Out     = 0 )
-      PARAMETER ( CLIM_InOut   = 2 )
-C
-C-----Parallel distribution
-C
-      PARAMETER ( CLIM_Strategy = 1 )
-      PARAMETER ( CLIM_Segments = 2 )
-      PARAMETER ( CLIM_Serial   = 0 )
-      PARAMETER ( CLIM_Apple    = 1 )
-      PARAMETER ( CLIM_Box      = 2 )
-      PARAMETER ( CLIM_Orange   = 3 )
-      PARAMETER ( CLIM_Offset   = 2 )
-      PARAMETER ( CLIM_Length   = 3 )
-      PARAMETER ( CLIM_SizeX    = 3 )
-      PARAMETER ( CLIM_SizeY    = 4 )
-      PARAMETER ( CLIM_LdX      = 5 )
-C
-C-----Datatypes
-C
-      PARAMETER ( CLIM_Integer = 1 )
-      PARAMETER ( CLIM_Real    = 4 ) 
-      PARAMETER ( CLIM_Double  = 8 )
-C
-C-----Quit parameters
-C
-      PARAMETER ( CLIM_ContPvm = 0 )
-      PARAMETER ( CLIM_StopPvm = 1 )
-C
-C-----Error Codes
-C
-      PARAMETER ( CLIM_MaxCodes  = -21 )
-C
-      PARAMETER ( CLIM_Ok        = 0 )
-      PARAMETER ( CLIM_FastExit  = -1 )
-      PARAMETER ( CLIM_BadName   = -2 )
-      PARAMETER ( CLIM_BadPort   = -3 )
-      PARAMETER ( CLIM_BadType   = -4 )
-      PARAMETER ( CLIM_DoubleDef = -5 )
-      PARAMETER ( CLIM_NotStep   = -6 )
-      PARAMETER ( CLIM_IncStep   = -7 )
-      PARAMETER ( CLIM_IncSize   = -8 )
-      PARAMETER ( CLIM_NotClim   = -9 )
-      PARAMETER ( CLIM_TimeOut   = -10 )
-      PARAMETER ( CLIM_Pvm       = -11 )
-      PARAMETER ( CLIM_FirstCall = -12 )
-      PARAMETER ( CLIM_PbRoute   = -13 )
-      PARAMETER ( CLIM_Group     = -14 )
-      PARAMETER ( CLIM_BadTaskId = -15 )
-      PARAMETER ( CLIM_NoTask    = -16 )
-      PARAMETER ( CLIM_InitBuff  = -17 )
-      PARAMETER ( CLIM_Pack      = -18 )
-      PARAMETER ( CLIM_Unpack    = -19 )
-      PARAMETER ( CLIM_Down      = -20 )
-      PARAMETER ( CLIM_PvmExit   = -21 )
-C
-C-----End of clim.h
Index: LMDZ.3.3/branches/rel-/libf/phylmd/clmain.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/clmain.F	(revision 416)
+++ 	(revision )
@@ -1,1728 +1,0 @@
-      SUBROUTINE clmain(dtime,pctsrf,t,q,u,v,
-     .                  soil_model,ts,soilcap,soilflux,
-     .                  paprs,pplay,radsol,snow,qsol,
-     .                  xlat, rugos,
-     .                  d_t,d_q,d_u,d_v,d_ts,
-     .                  flux_t,flux_q,flux_u,flux_v,cdragh,cdragm,
-     .                  rugmer, dflux_t,dflux_q,
-     .                  zcoefh,zu1,zv1)
-cAA .                  itr, tr, flux_surf, d_tr)
-cAA REM:
-cAA-----
-cAA Tout ce qui a trait au traceurs est dans phytrac maintenant
-cAA pour l'instant le calcul de la couche limite pour les traceurs
-cAA se fait avec cltrac et ne tient pas compte de la differentiation
-cAA des sous-fraction de sol.
-cAA REM bis :
-cAA----------
-cAA Pour pouvoir extraire les coefficient d'echanges et le vent 
-cAA dans la premiere couche, 3 champs supplementaires ont ete crees
-cAA zcoefh,zu1 et zv1. Pour l'instant nous avons moyenne les valeurs
-cAA de ces trois champs sur les 4 subsurfaces du modele. Dans l'avenir 
-cAA si les informations des subsurfaces doivent etre prises en compte
-cAA il faudra sortir ces memes champs en leur ajoutant une dimension, 
-cAA c'est a dire nbsrf (nbre de subsurface).
- 
-      IMPLICIT none
-c======================================================================
-c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
-c Objet: interface de "couche limite" (diffusion verticale)
-c Arguments:
-c dtime----input-R- interval du temps (secondes)
-c t--------input-R- temperature (K)
-c q--------input-R- vapeur d'eau (kg/kg)
-c u--------input-R- vitesse u
-c v--------input-R- vitesse v
-c ts-------input-R- temperature du sol (en Kelvin)
-c paprs----input-R- pression a intercouche (Pa)
-c pplay----input-R- pression au milieu de couche (Pa)
-c radsol---input-R- flux radiatif net (positif vers le sol) en W/m**2
-c capsol---input-R- inversion de l'effective capacite du sol (J/m2/K)
-c beta-----input-R- coefficient de l'evaporation reelle (0 a 1)
-c dif_grnd-input-R- coeff. de diffusion (chaleur) vers le sol profond
-c xlat-----input-R- latitude en degree
-c rugos----input-R- longeur de rugosite (en m)
-c
-c d_t------output-R- le changement pour "t"
-c d_q------output-R- le changement pour "q"
-c d_u------output-R- le changement pour "u"
-c d_v------output-R- le changement pour "v"
-c d_ts-----output-R- le changement pour "ts"
-c flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)
-c                    (orientation positive vers le bas)
-c flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)
-c flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
-c flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
-c rugmer---output-R- longeur de rugosite sur mer (m)
-c dflux_t derive du flux sensible
-c dflux_q derive du flux latent
-cAA on rajoute en output yu1 et yv1 qui sont les vents dans 
-cAA la premiere couche
-cAA ces 4 variables sont maintenant traites dans phytrac
-c itr--------input-I- nombre de traceurs
-c tr---------input-R- q. de traceurs
-c flux_surf--input-R- flux de traceurs a la surface
-c d_tr-------output-R tendance de traceurs
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "indicesol.h"
-c
-      LOGICAL soil_model
-c
-      REAL dtime
-      REAL t(klon,klev), q(klon,klev)
-      REAL u(klon,klev), v(klon,klev)
-      REAL paprs(klon,klev+1), pplay(klon,klev), radsol(klon)
-      REAL xlat(klon)
-      REAL d_t(klon, klev), d_q(klon, klev)
-      REAL d_u(klon, klev), d_v(klon, klev)
-      REAL flux_t(klon,klev), flux_q(klon,klev)
-      REAL dflux_t(klon), dflux_q(klon)
-      REAL flux_u(klon,klev), flux_v(klon,klev)
-      REAL rugmer(klon)
-      REAL cdragh(klon), cdragm(klon)
-cAA      INTEGER itr
-cAA      REAL tr(klon,klev,nbtr)
-cAA      REAL d_tr(klon,klev,nbtr)
-cAA      REAL flux_surf(klon,nbtr)
-c
-      REAL pctsrf(klon,nbsrf)
-      REAL ts(klon,nbsrf)
-      REAL d_ts(klon,nbsrf)
-      REAL snow(klon,nbsrf)
-      REAL qsol(klon,nbsrf)
-      REAL rugos(klon,nbsrf)
-cAA
-      REAL zcoefh(klon,klev)
-      REAL zu1(klon)
-      REAL zv1(klon)
-cAA
-c======================================================================
-      EXTERNAL clqh, clvent, coefkz, calbeta, cltrac
-c======================================================================
-      REAL yts(klon), yrugos(klon), ypct(klon)
-      REAL ycal(klon), ybeta(klon), ydif(klon)
-      REAL yu1(klon), yv1(klon)
-      REAL yrugm(klon), yrads(klon)
-      REAL y_d_ts(klon)
-      REAL y_d_t(klon, klev), y_d_q(klon, klev)
-      REAL y_d_u(klon, klev), y_d_v(klon, klev)
-      REAL y_flux_t(klon,klev), y_flux_q(klon,klev)
-      REAL y_flux_u(klon,klev), y_flux_v(klon,klev)
-      REAL y_dflux_t(klon), y_dflux_q(klon)
-      REAL ycoefh(klon,klev), ycoefm(klon,klev)
-      REAL ygamt(klon,2:klev) ! contre-gradient pour temperature
-      REAL ygamq(klon,2:klev) ! contre-gradient pour humidite
-      REAL yu(klon,klev), yv(klon,klev)
-      REAL yt(klon,klev), yq(klon,klev)
-      REAL ypaprs(klon,klev+1), ypplay(klon,klev), ydelp(klon,klev)
-cAA      REAL ytr(klon,klev,nbtr)
-cAA      REAL y_d_tr(klon,klev,nbtr)
-cAA      REAL yflxsrf(klon,nbtr)
-c
-      LOGICAL contreg
-      PARAMETER (contreg=.TRUE.)
-c
-      LOGICAL ok_nonloc
-      PARAMETER (ok_nonloc=.FALSE.)
-      REAL y_cd_h(klon), y_cd_m(klon)
-      REAL ycoefm0(klon,klev), ycoefh0(klon,klev)
-c
-#include "YOMCST.h"
-      REAL u1lay(klon), v1lay(klon)
-      REAL delp(klon,klev)
-      REAL capsol(klon), beta(klon), dif_grnd(klon)
-      REAL cal(klon)
-      REAL soilcap(klon,nbsrf), soilflux(klon,nbsrf)
-      REAL totalflu(klon)
-      INTEGER i, k, nsrf 
-cAA   INTEGER it
-      INTEGER ni(klon), knon, j
-c======================================================================
-      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.
-c======================================================================
-      DO k = 1, klev   ! epaisseur de couche
-      DO i = 1, klon
-         delp(i,k) = paprs(i,k)-paprs(i,k+1)
-      ENDDO
-      ENDDO
-      DO i = 1, klon  ! vent de la premiere couche
-ccc         zx_alf1 = (paprs(i,1)-pplay(i,2))/(pplay(i,1)-pplay(i,2))
-         zx_alf1 = 1.0
-         zx_alf2 = 1.0 - zx_alf1
-         u1lay(i) = u(i,1)*zx_alf1 + u(i,2)*zx_alf2
-         v1lay(i) = v(i,1)*zx_alf1 + v(i,2)*zx_alf2
-      ENDDO
-c
-c initialisation:
-c
-      DO i = 1, klon
-         rugmer(i) = 0.0
-         cdragh(i) = 0.0
-         cdragm(i) = 0.0
-         dflux_t(i) = 0.0
-         dflux_q(i) = 0.0
-         zu1(i) = 0.0
-         zv1(i) = 0.0
-      ENDDO
-      DO nsrf = 1, nbsrf
-      DO i = 1, klon
-         d_ts(i,nsrf) = 0.0
-      ENDDO
-      ENDDO
-      DO k = 1, klev
-      DO i = 1, klon
-         d_t(i,k) = 0.0
-         d_q(i,k) = 0.0
-         flux_t(i,k) = 0.0
-         flux_q(i,k) = 0.0
-         d_u(i,k) = 0.0
-         d_v(i,k) = 0.0
-         flux_u(i,k) = 0.0
-         flux_v(i,k) = 0.0
-         zcoefh(i,k) = 0.0
-      ENDDO
-      ENDDO
-cAA      IF (itr.GE.1) THEN
-cAA      DO it = 1, itr
-cAA      DO k = 1, klev
-cAA      DO i = 1, klon
-cAA         d_tr(i,k,it) = 0.0
-cAA      ENDDO
-cAA      ENDDO
-cAA      ENDDO
-cAA      ENDIF
-c
-c Boucler sur toutes les sous-fractions du sol:
-c
-      DO 99999 nsrf = 1, nbsrf
-c
-c prescrire les proprietes du sol:
-      CALL calbeta(dtime,nsrf,snow,qsol, beta,capsol,dif_grnd)
-      IF (.NOT.soil_model) THEN
-         DO i = 1, klon
-            cal(i) = RCPD * capsol(i)
-            totalflu(i) = radsol(i)
-         ENDDO
-      ELSE
-         DO i = 1, klon
-            totalflu(i) = soilflux(i,nsrf) + radsol(i)
-            IF (nsrf.EQ.is_oce) THEN
-               cal(i) = 0.0
-            ELSE
-               cal(i) = RCPD / soilcap(i,nsrf)
-            ENDIF
-         ENDDO
-      ENDIF
-c
-c chercher les indices:
-      DO j = 1, klon
-         ni(j) = 0
-      ENDDO
-      knon = 0
-      DO i = 1, klon
-      IF (pctsrf(i,nsrf).GT.epsfra) THEN
-         knon = knon + 1
-         ni(knon) = i
-      ENDIF
-      ENDDO
-c
-      IF (knon.EQ.0) GOTO 99999
-      DO j = 1, knon
-      i = ni(j)
-        ypct(j) = pctsrf(i,nsrf)
-        yts(j) = ts(i,nsrf)
-        yrugos(j) = rugos(i,nsrf)
-        yu1(j) = u1lay(i)
-        yv1(j) = v1lay(i)
-        yrads(j) = totalflu(i)
-        ycal(j) = cal(i)
-        ybeta(j) = beta(i)
-        ydif(j) = dif_grnd(i)
-        ypaprs(j,klev+1) = paprs(i,klev+1)
-      ENDDO
-      DO k = 1, klev
-      DO j = 1, knon
-      i = ni(j)
-        ypaprs(j,k) = paprs(i,k)
-        ypplay(j,k) = pplay(i,k)
-        ydelp(j,k) = delp(i,k)
-        yu(j,k) = u(i,k)
-        yv(j,k) = v(i,k)
-        yt(j,k) = t(i,k)
-        yq(j,k) = q(i,k)
-      ENDDO
-      ENDDO
-c
-cAA      IF (itr.GE.1) THEN
-cAA      DO it = 1, itr
-cAA        DO k = 1, klev
-cAA        DO j = 1, knon
-cAA        i = ni(j)
-cAA          ytr(j,k,it) = tr(i,k,it)
-cAA        ENDDO
-cAA        ENDDO
-cAA        DO j = 1, knon
-cAA        i = ni(j)
-cAA          yflxsrf(j,it) = flux_surf(i,it)
-cAA        ENDDO
-cAA      ENDDO
-cAA      ENDIF
-c
-c calculer Cdrag et les coefficients d'echange
-      CALL coefkz(nsrf, knon, ypaprs, ypplay,
-     .            yts, yrugos, yu, yv, yt, yq,
-     .            ycoefm, ycoefh)
-      CALL coefkz2(nsrf, knon, ypaprs, ypplay,yt,
-     .                  ycoefm0, ycoefh0)
-      DO k = 1, klev
-      DO i = 1, knon
-         ycoefm(i,k) = MAX(ycoefm(i,k),ycoefm0(i,k))
-         ycoefh(i,k) = MAX(ycoefh(i,k),ycoefh0(i,k))
-      ENDDO
-      ENDDO
-c
-c parametrisation non-locale:
-      IF (ok_nonloc) THEN
-         DO i = 1, knon
-            y_cd_h(i) = ycoefh(i,1)
-            y_cd_m(i) = ycoefm(i,1)
-         ENDDO
-         CALL nonlocal(knon, ypaprs, ypplay,
-     .        yts,ybeta,yu,yv,yt,yq,
-     .        y_cd_h, y_cd_m, ycoefm0, ycoefh0, ygamt, ygamq)
-         DO k = 1, klev
-         DO i = 1, knon
-            ycoefm(i,k) = MAX(ycoefm(i,k),ycoefm0(i,k))
-            ycoefh(i,k) = MAX(ycoefh(i,k),ycoefh0(i,k))
-         ENDDO
-         ENDDO
-      ELSE
-         IF (.NOT.contreg) THEN
-            DO k = 2, klev
-            DO i = 1, knon
-               ygamq(i,k) = 0.0
-               ygamt(i,k) = 0.0
-            ENDDO
-            ENDDO
-         ELSE
-         DO k = 3, klev
-         DO i = 1, knon
-            ygamq(i,k) = 0.0
-            ygamt(i,k) = -1.0E-03
-         ENDDO
-         ENDDO
-         DO i = 1, knon
-            ygamq(i,2) = 0.0
-            ygamt(i,2) = -2.5E-03
-         ENDDO
-         ENDIF
-      ENDIF
-c
-c calculer la diffusion de "q" et de "h"
-      CALL clqh(knon, dtime, yu1, yv1,
-     e          ycoefh,yt,yq,yts,ypaprs,ypplay,ydelp,yrads,
-     e          ycal,ybeta,ydif,ygamt,ygamq,
-     s          y_d_t, y_d_q, y_d_ts, 
-     s          y_flux_t, y_flux_q, y_dflux_t, y_dflux_q)
-c
-c calculer la diffusion des vitesses "u" et "v"
-      CALL clvent(knon,dtime,yu1,yv1,ycoefm,yt,yu,ypaprs,ypplay,ydelp,
-     s            y_d_u,y_flux_u)
-      CALL clvent(knon,dtime,yu1,yv1,ycoefm,yt,yv,ypaprs,ypplay,ydelp,
-     s            y_d_v,y_flux_v)
-c
-c calculer la longueur de rugosite sur ocean
-      IF (nsrf.EQ.is_oce) THEN
-      DO j = 1, knon
-         yrugm(j) = 0.018*ycoefm(j,1) * (yu1(j)**2+yv1(j)**2)/RG
-         yrugm(j) = MAX(1.5e-05,yrugm(j))
-      ENDDO
-      ENDIF
-c
-cAA MAINTENANT DANS PHYTRAC
-cAAc calculer la diffusion des traceurs
-cAA      IF (itr.GE.1) THEN
-cAA      DO it = 1, itr
-cAA      CALL cltrac(knon,dtime,ycoefh, yt, ytr(1,1,it), yflxsrf(1,it),
-cAA     e            ypaprs, ypplay, ydelp,
-cAA     s            y_d_tr(1,1,it))
-cAA      ENDDO
-cAA      ENDIF
-c
-      DO j = 1, knon
-         y_dflux_t(j) = y_dflux_t(j) * ypct(j)
-         y_dflux_q(j) = y_dflux_q(j) * ypct(j)
-         yu1(j) = yu1(j) *  ypct(j)
-         yv1(j) = yv1(j) *  ypct(j)
-      ENDDO
-c
-      DO k = 1, klev
-      DO j = 1, knon
-         ycoefh(j,k) = ycoefh(j,k) * ypct(j)
-         ycoefm(j,k) = ycoefm(j,k) * ypct(j)
-         y_d_t(j,k) = y_d_t(j,k) * ypct(j)
-         y_d_q(j,k) = y_d_q(j,k) * ypct(j)
-         y_flux_t(j,k) = y_flux_t(j,k) * ypct(j)
-         y_flux_q(j,k) = y_flux_q(j,k) * ypct(j)
-         y_d_u(j,k) = y_d_u(j,k) * ypct(j)
-         y_d_v(j,k) = y_d_v(j,k) * ypct(j)
-         y_flux_u(j,k) = y_flux_u(j,k) * ypct(j)
-         y_flux_v(j,k) = y_flux_v(j,k) * ypct(j)
-      ENDDO
-      ENDDO
-c
-      DO j = 1, knon
-      i = ni(j)
-         d_ts(i,nsrf) = y_d_ts(j)
-         rugmer(i) = yrugm(j)
-         cdragh(i) = cdragh(i) + ycoefh(j,1)
-         cdragm(i) = cdragm(i) + ycoefm(j,1)
-         dflux_t(i) = dflux_t(i) + y_dflux_t(j)
-         dflux_q(i) = dflux_q(i) + y_dflux_q(j)
-         zu1(i) = zu1(i) + yu1(j)
-         zv1(i) = zv1(i) + yv1(j)
-      ENDDO
-c
-#ifdef CRAY
-      DO k = 1, klev
-      DO j = 1, knon
-      i = ni(j)
-#else
-      DO j = 1, knon
-      i = ni(j)
-      DO k = 1, klev
-#endif
-         d_t(i,k) = d_t(i,k) + y_d_t(j,k)
-         d_q(i,k) = d_q(i,k) + y_d_q(j,k)
-         flux_t(i,k) = flux_t(i,k) + y_flux_t(j,k)
-         flux_q(i,k) = flux_q(i,k) + y_flux_q(j,k)
-         d_u(i,k) = d_u(i,k) + y_d_u(j,k)
-         d_v(i,k) = d_v(i,k) + y_d_v(j,k)
-         flux_u(i,k) = flux_u(i,k) + y_flux_u(j,k)
-         flux_v(i,k) = flux_v(i,k) + y_flux_v(j,k)
-         zcoefh(i,k) = zcoefh(i,k) + ycoefh(j,k)
-      ENDDO
-      ENDDO
-c
-cAA      IF (itr.GE.1) THEN
-cAA      DO it = 1, itr
-cAA      DO k = 1, klev
-cAA      DO j = 1, knon
-cAA         y_d_tr(j,k,it) = y_d_tr(j,k,it) * ypct(j)
-cAA      ENDDO
-cAA      ENDDO
-cAA      ENDDO
-cAA      DO j = 1, knon
-cAA      i = ni(j)
-cAA      DO it = 1, itr
-cAA      DO k = 1, klev
-cAA         d_tr(i,k,it) = d_tr(i,k,it) + y_d_tr(j,k,it)
-cAA      ENDDO
-cAA      ENDDO
-cAA      ENDDO
-cAA      ENDIF
-c
-99999 CONTINUE
-c
-      RETURN
-      END
-      SUBROUTINE clqh(knon,dtime,u1lay,v1lay,coef,t,q,ts,paprs,pplay,
-     e                delp,radsol,cal,beta,dif_grnd, gamt,gamq,
-     s                d_t, d_q, d_ts, flux_t, flux_q,dflux_s,dflux_l)
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
-c Objet: diffusion verticale de "q" et de "h"
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-c Arguments:
-      INTEGER knon
-      REAL dtime              ! intervalle du temps (s)
-      REAL u1lay(klon)        ! vitesse u de la 1ere couche (m/s)
-      REAL v1lay(klon)        ! vitesse v de la 1ere couche (m/s)
-      REAL coef(klon,klev)    ! le coefficient d'echange (m**2/s)
-c                               multiplie par le cisaillement du 
-c                               vent (dV/dz); la premiere valeur
-c                               indique la valeur de Cdrag (sans unite)
-      REAL cal(klon)          ! Cp/cal indique la capacite calorifique
-c                               surfacique du sol
-      REAL beta(klon)         ! evap. reelle / evapotranspiration
-      REAL dif_grnd(klon)     ! coeff. diffusion vers le sol profond
-      REAL t(klon,klev)       ! temperature (K)
-      REAL q(klon,klev)       ! humidite specifique (kg/kg)
-      REAL ts(klon)           ! temperature du sol (K)
-      REAL paprs(klon,klev+1) ! pression a inter-couche (Pa)
-      REAL pplay(klon,klev)   ! pression au milieu de couche (Pa)
-      REAL delp(klon,klev)    ! epaisseur de couche en pression (Pa)
-      REAL radsol(klon)       ! ray. net au sol (Solaire+IR) W/m2
-c
-      REAL d_t(klon,klev)     ! incrementation de "t"
-      REAL d_q(klon,klev)     ! incrementation de "q"
-      REAL d_ts(klon)         ! incrementation de "ts"
-      REAL flux_t(klon,klev)  ! (diagnostic) flux de la chaleur
-c                               sensible, flux de Cp*T, positif vers
-c                               le bas: j/(m**2 s) c.a.d.: W/m2
-      REAL flux_q(klon,klev)  ! flux de la vapeur d'eau:kg/(m**2 s)
-      REAL dflux_s(klon) ! derivee du flux sensible dF/dTs
-      REAL dflux_l(klon) ! derivee du flux latent dF/dTs
-      REAL dflux_g(klon) ! derivee du flux du sol profond dF/dTs
-c======================================================================
-      REAL t_grnd  ! temperature de rappel pour glace de mer
-      PARAMETER (t_grnd=271.35)
-      REAL t_coup
-      PARAMETER(t_coup=273.15)
-c======================================================================
-      INTEGER i, k
-      REAL zx_a
-      REAL zx_b
-      REAL zx_qs
-      REAL zx_dq_s_dh
-      REAL zx_h_grnd
-      REAL zx_cq0(klon)
-      REAL zx_dq0(klon)
-      REAL zx_cq(klon,klev)
-      REAL zx_dq(klon,klev)
-      REAL zx_ch(klon,klev)
-      REAL zx_dh(klon,klev)
-      REAL zx_buf1(klon)
-      REAL zx_buf2(klon)
-      REAL zx_coef(klon,klev)
-      REAL zx_q_0(klon)
-      REAL zx_h_ts(klon)
-      REAL zx_sl(klon)
-      REAL local_h(klon,klev) ! enthalpie potentielle
-      REAL local_q(klon,klev)
-      REAL local_ts(klon)
-      REAL psref(klon) ! pression de reference pour temperature potent.
-      REAL zx_pkh(klon,klev), zx_pkf(klon,klev)
-c======================================================================
-c contre-gradient pour la vapeur d'eau: (kg/kg)/metre
-      REAL gamq(klon,2:klev)
-c contre-gradient pour la chaleur sensible: Kelvin/metre
-      REAL gamt(klon,2:klev)
-      REAL z_gamaq(klon,2:klev), z_gamah(klon,2:klev)
-      REAL zdelz
-c======================================================================
-C Variables intermediaires pour le calcul des fluxs a la surface
-      real zx_mh(klon), zx_nh(klon), zx_oh(klon)
-      real zx_mq(klon), zx_nq(klon), zx_oq(klon)
-      real zx_k1(klon), zx_dq_s_dt(klon)
-      real zx_qsat(klon)
-c======================================================================
-      REAL zcor, zdelta, zcvm5
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-c======================================================================
-      DO i = 1, knon
-         psref(i) = paprs(i,1) !pression de reference est celle au sol
-         local_ts(i) = ts(i)
-      ENDDO
-      DO k = 1, klev
-      DO i = 1, knon
-         zx_pkh(i,k) = (psref(i)/paprs(i,k))**RKAPPA
-         zx_pkf(i,k) = (psref(i)/pplay(i,k))**RKAPPA
-         local_h(i,k) = RCPD * t(i,k) * zx_pkf(i,k)
-         local_q(i,k) = q(i,k)
-      ENDDO
-      ENDDO
-c
-c Convertir les coefficients en variables convenables au calcul:
-c
-      DO i = 1, knon
-         zx_coef(i,1) = coef(i,1)
-     .                 * (1.0+SQRT(u1lay(i)**2+v1lay(i)**2))
-     .                 * pplay(i,1)/(RD*t(i,1))
-      ENDDO
-c
-      DO k = 2, klev
-      DO i = 1, knon
-         zx_coef(i,k) = coef(i,k)*RG/(pplay(i,k-1)-pplay(i,k))
-     .                  *(paprs(i,k)*2/(t(i,k)+t(i,k-1))/RD)**2
-         zx_coef(i,k) = zx_coef(i,k) * dtime*RG
-      ENDDO
-      ENDDO
-c
-c Preparer les flux lies aux contre-gardients
-c
-      DO k = 2, klev
-      DO i = 1, knon
-         zdelz = RD * (t(i,k-1)+t(i,k))/2.0 / RG /paprs(i,k)
-     .              *(pplay(i,k-1)-pplay(i,k))
-         z_gamaq(i,k) = gamq(i,k) * zdelz
-         z_gamah(i,k) = gamt(i,k) * zdelz *RCPD * zx_pkh(i,k)
-      ENDDO
-      ENDDO
-c======================================================================
-c
-c zx_qs = qsat en kg/kg
-c
-      DO i = 1, knon
-         IF (thermcep) THEN
-           zdelta=MAX(0.,SIGN(1.,rtt-local_ts(i)))
-           zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
-           zcvm5 = zcvm5 / RCPD / (1.0+RVTMP2*q(i,1))
-           zx_qs= r2es * FOEEW(local_ts(i),zdelta)/paprs(i,1)
-           zx_qs=MIN(0.5,zx_qs)
-           zcor=1./(1.-retv*zx_qs)
-           zx_qs=zx_qs*zcor
-           zx_dq_s_dh = FOEDE(local_ts(i),zdelta,zcvm5,zx_qs,zcor)
-     .                 /RLVTT / zx_pkh(i,1)
-         ELSE
-           IF (local_ts(i).LT.t_coup) THEN
-              zx_qs = qsats(local_ts(i)) / paprs(i,1)
-              zx_dq_s_dh = dqsats(local_ts(i),zx_qs)/RLVTT
-     .                    / zx_pkh(i,1)
-           ELSE
-              zx_qs = qsatl(local_ts(i)) / paprs(i,1)
-              zx_dq_s_dh = dqsatl(local_ts(i),zx_qs)/RLVTT
-     .                    / zx_pkh(i,1)
-           ENDIF
-         ENDIF
-
-c        zx_dq_s_dh = 0.
-         zx_dq_s_dt(i) = RCPD * zx_pkh(i,1) * zx_dq_s_dh
-         zx_qsat(i) = zx_qs
-c
-      ENDDO
-      DO i = 1, knon
-         zx_buf1(i) = zx_coef(i,klev) + delp(i,klev)
-         zx_cq(i,klev) = (local_q(i,klev)*delp(i,klev)
-     .                   -zx_coef(i,klev)*z_gamaq(i,klev))/zx_buf1(i)
-         zx_dq(i,klev) = zx_coef(i,klev) / zx_buf1(i)
-c
-         zx_buf2(i) = delp(i,klev) + zx_coef(i,klev)
-         zx_ch(i,klev) = (local_h(i,klev)*delp(i,klev)
-     .                   -zx_coef(i,klev)*z_gamah(i,klev))/zx_buf2(i)
-         zx_dh(i,klev) = zx_coef(i,klev) / zx_buf2(i)
-      ENDDO
-      DO k = klev-1, 2 , -1
-      DO i = 1, knon
-         zx_buf1(i) = delp(i,k)+zx_coef(i,k)
-     .               +zx_coef(i,k+1)*(1.-zx_dq(i,k+1))
-         zx_cq(i,k) = (local_q(i,k)*delp(i,k)
-     .                 +zx_coef(i,k+1)*zx_cq(i,k+1)
-     .                 +zx_coef(i,k+1)*z_gamaq(i,k+1)
-     .                 -zx_coef(i,k)*z_gamaq(i,k))/zx_buf1(i)
-         zx_dq(i,k) = zx_coef(i,k) / zx_buf1(i)
-c
-         zx_buf2(i) = delp(i,k)+zx_coef(i,k)
-     .               +zx_coef(i,k+1)*(1.-zx_dh(i,k+1))
-         zx_ch(i,k) = (local_h(i,k)*delp(i,k)
-     .                 +zx_coef(i,k+1)*zx_ch(i,k+1)
-     .                 +zx_coef(i,k+1)*z_gamah(i,k+1)
-     .                 -zx_coef(i,k)*z_gamah(i,k))/zx_buf2(i)
-         zx_dh(i,k) = zx_coef(i,k) / zx_buf2(i)
-      ENDDO
-      ENDDO
-C
-C nouvelle formulation JL Dufresne
-C
-C q1 = zx_cq(i,1) + zx_dq(i,1) * Flux_Q(i,1) * dt
-C h1 = zx_ch(i,1) + zx_dh(i,1) * Flux_H(i,1) * dt
-C
-      DO i = 1, knon
-         zx_buf1(i) = delp(i,1) + zx_coef(i,2)*(1.-zx_dq(i,2))
-         zx_cq(i,1) = (local_q(i,1)*delp(i,1)
-     .                 +zx_coef(i,2)*(z_gamaq(i,2)+zx_cq(i,2)))
-     .                /zx_buf1(i)
-         zx_dq(i,1) = -1. * RG / zx_buf1(i)
-c
-         zx_buf2(i) = delp(i,1) + zx_coef(i,2)*(1.-zx_dh(i,2))
-         zx_ch(i,1) = (local_h(i,1)*delp(i,1)
-     .                 +zx_coef(i,2)*(z_gamah(i,2)+zx_ch(i,2)))
-     .                /zx_buf2(i)
-         zx_dh(i,1) = -1. * RG / zx_buf2(i)
-      ENDDO
-
-C === Calcul de la temperature de surface ===
-C 
-C zx_sl = chaleur latente d'evaporation ou de sublimation
-C
-      do i = 1, knon
-        zx_sl(i) = RLVTT
-        if (local_ts(i) .LT. RTT) zx_sl(i) = RLSTT
-        zx_k1(i) = zx_coef(i,1)
-      enddo
-      do i = 1, knon
-C Q
-        zx_oq(i) = 1. - (beta(i) * zx_k1(i) * zx_dq(i,1) * dtime)
-        zx_mq(i) = beta(i) * zx_k1(i) * 
-     .              (zx_cq(i,1) - zx_qsat(i) 
-     .                             + zx_dq_s_dt(i) * local_ts(i))
-     .              / zx_oq(i)
-        zx_nq(i) = beta(i) * zx_k1(i) * (-1. * zx_dq_s_dt(i))
-     .                                                / zx_oq(i)
-c H
-        zx_oh(i) = 1. - (zx_k1(i) * zx_dh(i,1) * dtime)
-        zx_mh(i) = zx_k1(i) * zx_ch(i,1) / zx_oh(i)
-        zx_nh(i) = - (zx_k1(i) * RCPD * zx_pkh(i,1))/ zx_oh(i)
-c Tsurface
-        local_ts(i) = (ts(i) + cal(i)/(RCPD * zx_pkh(i,1)) * dtime *
-     .                   (radsol(i) + zx_mh(i) + zx_sl(i) * zx_mq(i)) 
-     .                       + dif_grnd(i) * t_grnd * dtime)/
-     .                ( 1. - dtime * cal(i)/(RCPD * zx_pkh(i,1)) * (
-     .                       zx_nh(i) + zx_sl(i) * zx_nq(i))  
-     .                     + dtime * dif_grnd(i))
-        zx_h_ts(i) = local_ts(i) * RCPD * zx_pkh(i,1)
-        d_ts(i) = local_ts(i) - ts(i)
-        zx_q_0(i) = zx_qsat(i) + zx_dq_s_dt(i) * d_ts(i)
-c== flux_q est le flux de vapeur d'eau: kg/(m**2 s)  positive vers bas
-c== flux_t est le flux de cpt (energie sensible): j/(m**2 s)
-        flux_q(i,1) = zx_mq(i) + zx_nq(i) * local_ts(i) 
-        flux_t(i,1) = zx_mh(i) + zx_nh(i) * local_ts(i)
-c Derives des flux dF/dTs (W m-2 K-1):
-        dflux_s(i) = zx_nh(i)
-        dflux_l(i) = (zx_sl(i) * zx_nq(i))
-      ENDDO
-
-
-c==== une fois on a zx_h_ts, on peut faire l'iteration ========
-      DO i = 1, knon
-         local_h(i,1) = zx_ch(i,1) + zx_dh(i,1)*flux_t(i,1)*dtime
-         local_q(i,1) = zx_cq(i,1) + zx_dq(i,1)*flux_q(i,1)*dtime
-      ENDDO
-      DO k = 2, klev
-      DO i = 1, knon
-        local_q(i,k) = zx_cq(i,k) + zx_dq(i,k)*local_q(i,k-1)
-        local_h(i,k) = zx_ch(i,k) + zx_dh(i,k)*local_h(i,k-1)
-      ENDDO
-      ENDDO
-c======================================================================
-c== flux_q est le flux de vapeur d'eau: kg/(m**2 s)  positive vers bas
-c== flux_t est le flux de cpt (energie sensible): j/(m**2 s)
-      DO k = 2, klev
-      DO i = 1, knon
-        flux_q(i,k) = (zx_coef(i,k)/RG/dtime)
-     .                * (local_q(i,k)-local_q(i,k-1)+z_gamaq(i,k))
-        flux_t(i,k) = (zx_coef(i,k)/RG/dtime)
-     .                * (local_h(i,k)-local_h(i,k-1)+z_gamah(i,k))
-     .                / zx_pkh(i,k)
-      ENDDO
-      ENDDO
-c======================================================================
-C Calcul tendances
-      DO k = 1, klev
-      DO i = 1, knon
-         d_t(i,k) = local_h(i,k)/zx_pkf(i,k)/RCPD - t(i,k)
-         d_q(i,k) = local_q(i,k) - q(i,k)
-      ENDDO
-      ENDDO
-c
-      RETURN
-      END
-      SUBROUTINE clvent(knon,dtime, u1lay,v1lay,coef,t,ven,
-     e                  paprs,pplay,delp,
-     s                  d_ven,flux_v)
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
-c Objet: diffusion vertical de la vitesse "ven"
-c======================================================================
-c Arguments:
-c dtime----input-R- intervalle du temps (en second)
-c u1lay----input-R- vent u de la premiere couche (m/s)
-c v1lay----input-R- vent v de la premiere couche (m/s)
-c coef-----input-R- le coefficient d'echange (m**2/s) multiplie par
-c                   le cisaillement du vent (dV/dz); la premiere
-c                   valeur indique la valeur de Cdrag (sans unite)
-c t--------input-R- temperature (K)
-c ven------input-R- vitesse horizontale (m/s)
-c paprs----input-R- pression a inter-couche (Pa)
-c pplay----input-R- pression au milieu de couche (Pa)
-c delp-----input-R- epaisseur de couche (Pa)
-c
-c
-c d_ven----output-R- le changement de "ven"
-c flux_v---output-R- (diagnostic) flux du vent: (kg m/s)/(m**2 s)
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-      INTEGER knon
-      REAL dtime
-      REAL u1lay(klon), v1lay(klon)
-      REAL coef(klon,klev)
-      REAL t(klon,klev), ven(klon,klev)
-      REAL paprs(klon,klev+1), pplay(klon,klev), delp(klon,klev)
-      REAL d_ven(klon,klev)
-      REAL flux_v(klon,klev)
-c======================================================================
-#include "YOMCST.h"
-c======================================================================
-      INTEGER i, k
-      REAL zx_cv(klon,2:klev)
-      REAL zx_dv(klon,2:klev)
-      REAL zx_buf(klon)
-      REAL zx_coef(klon,klev)
-      REAL local_ven(klon,klev)
-      REAL zx_alf1(klon), zx_alf2(klon)
-c======================================================================
-      DO k = 1, klev
-      DO i = 1, knon
-         local_ven(i,k) = ven(i,k)
-      ENDDO
-      ENDDO
-c======================================================================
-      DO i = 1, knon
-ccc         zx_alf1(i) = (paprs(i,1)-pplay(i,2))/(pplay(i,1)-pplay(i,2))
-         zx_alf1(i) = 1.0
-         zx_alf2(i) = 1.0 - zx_alf1(i)
-         zx_coef(i,1) = coef(i,1)
-     .                 * (1.0+SQRT(u1lay(i)**2+v1lay(i)**2))
-     .                 * pplay(i,1)/(RD*t(i,1))
-         zx_coef(i,1) = zx_coef(i,1) * dtime*RG
-      ENDDO
-c======================================================================
-      DO k = 2, klev
-      DO i = 1, knon
-         zx_coef(i,k) = coef(i,k)*RG/(pplay(i,k-1)-pplay(i,k))
-     .                  *(paprs(i,k)*2/(t(i,k)+t(i,k-1))/RD)**2
-         zx_coef(i,k) = zx_coef(i,k) * dtime*RG
-      ENDDO
-      ENDDO
-c======================================================================
-      DO i = 1, knon
-         zx_buf(i) = delp(i,1) + zx_coef(i,1)*zx_alf1(i)+zx_coef(i,2)
-         zx_cv(i,2) = local_ven(i,1)*delp(i,1) / zx_buf(i)
-         zx_dv(i,2) = (zx_coef(i,2)-zx_alf2(i)*zx_coef(i,1))
-     .                /zx_buf(i)
-      ENDDO
-      DO k = 3, klev
-      DO i = 1, knon
-         zx_buf(i) = delp(i,k-1) + zx_coef(i,k)
-     .                         + zx_coef(i,k-1)*(1.-zx_dv(i,k-1))
-         zx_cv(i,k) = (local_ven(i,k-1)*delp(i,k-1)
-     .                  +zx_coef(i,k-1)*zx_cv(i,k-1) )/zx_buf(i)
-         zx_dv(i,k) = zx_coef(i,k)/zx_buf(i)
-      ENDDO
-      ENDDO
-      DO i = 1, knon
-         local_ven(i,klev) = ( local_ven(i,klev)*delp(i,klev)
-     .                        +zx_coef(i,klev)*zx_cv(i,klev) )
-     .                   / ( delp(i,klev) + zx_coef(i,klev)
-     .                       -zx_coef(i,klev)*zx_dv(i,klev) )
-      ENDDO
-      DO k = klev-1, 1, -1
-      DO i = 1, knon
-         local_ven(i,k) = zx_cv(i,k+1) + zx_dv(i,k+1)*local_ven(i,k+1)
-      ENDDO
-      ENDDO
-c======================================================================
-c== flux_v est le flux de moment angulaire (positif vers bas)
-c== dont l'unite est: (kg m/s)/(m**2 s)
-      DO i = 1, knon
-         flux_v(i,1) = zx_coef(i,1)/(RG*dtime)
-     .                 *(local_ven(i,1)*zx_alf1(i)
-     .                  +local_ven(i,2)*zx_alf2(i))
-      ENDDO
-      DO k = 2, klev
-      DO i = 1, knon
-         flux_v(i,k) = zx_coef(i,k)/(RG*dtime)
-     .               * (local_ven(i,k)-local_ven(i,k-1))
-      ENDDO
-      ENDDO
-c
-      DO k = 1, klev
-      DO i = 1, knon
-         d_ven(i,k) = local_ven(i,k) - ven(i,k)
-      ENDDO
-      ENDDO
-c
-      RETURN
-      END
-      SUBROUTINE coefkz(nsrf, knon, paprs, pplay,
-     .                  ts, rugos,
-     .                  u,v,t,q,
-     .                  pcfm, pcfh)
-      IMPLICIT none
-c======================================================================
-c Auteur(s) F. Hourdin, M. Forichon, Z.X. Li (LMD/CNRS) date: 19930922
-c           (une version strictement identique a l'ancien modele)
-c Objet: calculer le coefficient du frottement du sol (Cdrag) et les
-c        coefficients d'echange turbulent dans l'atmosphere.
-c Arguments:
-c nsrf-----input-I- indicateur de la nature du sol
-c knon-----input-I- nombre de points a traiter
-c paprs----input-R- pression a chaque intercouche (en Pa)
-c pplay----input-R- pression au milieu de chaque couche (en Pa)
-c ts-------input-R- temperature du sol (en Kelvin)
-c rugos----input-R- longeur de rugosite (en m)
-c xlat-----input-R- latitude en degree
-c u--------input-R- vitesse u
-c v--------input-R- vitesse v
-c t--------input-R- temperature (K)
-c q--------input-R- vapeur d'eau (kg/kg)
-c
-c itop-----output-I- numero de couche du sommet de la couche limite
-c pcfm-----output-R- coefficients a calculer (vitesse)
-c pcfh-----output-R- coefficients a calculer (chaleur et humidite)
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "indicesol.h"
-c
-c Arguments:
-c
-      INTEGER knon, nsrf
-      REAL ts(klon)
-      REAL paprs(klon,klev+1), pplay(klon,klev)
-      REAL u(klon,klev), v(klon,klev), t(klon,klev), q(klon,klev)
-      REAL rugos(klon)
-      REAL xlat(klon)
-c
-      REAL pcfm(klon,klev), pcfh(klon,klev)
-      INTEGER itop(klon)
-c
-c Quelques constantes et options:
-c
-      REAL cepdu2, ckap, cb, cc, cd, clam
-      PARAMETER (cepdu2 =(0.1)**2)
-      PARAMETER (ckap=0.35)
-      PARAMETER (cb=5.0)
-      PARAMETER (cc=5.0)
-      PARAMETER (cd=5.0)
-      PARAMETER (clam=160.0)
-      REAL ratqs ! largeur de distribution de vapeur d'eau
-      PARAMETER (ratqs=0.05)
-      LOGICAL richum ! utilise le nombre de Richardson humide
-      PARAMETER (richum=.TRUE.)
-      REAL ric ! nombre de Richardson critique
-      PARAMETER(ric=0.4)
-      REAL prandtl
-      PARAMETER (prandtl=0.4)
-      REAL kstable ! diffusion minimale (situation stable)
-      PARAMETER (kstable=1.0e-10)
-      REAL mixlen ! constante controlant longueur de melange
-      PARAMETER (mixlen=35.0)
-      INTEGER isommet ! le sommet de la couche limite
-      PARAMETER (isommet=klev)
-      LOGICAL tvirtu ! calculer Ri d'une maniere plus performante
-      PARAMETER (tvirtu=.TRUE.)
-      LOGICAL opt_ec ! formule du Centre Europeen dans l'atmosphere
-      PARAMETER (opt_ec=.FALSE.)
-      LOGICAL contreg ! utiliser le contre-gradient dans Ri
-      PARAMETER (contreg=.TRUE.)
-c
-c Variables locales:
-c
-      INTEGER i, k
-      REAL zgeop(klon,klev)
-      REAL zmgeom(klon)
-      REAL zri(klon)
-      REAL zl2(klon)
-      REAL zcfm1(klon), zcfm2(klon)
-      REAL zcfh1(klon), zcfh2(klon)
-      REAL zdphi, zdu2, ztvd, ztvu, ztsolv, zcdn
-      REAL zscf, zucf, zcr
-      REAL zt, zq, zdelta, zcvm5, zcor, zqs, zfr, zdqs
-      REAL z2geomf, zalh2, zalm2, zscfh, zscfm
-      REAL t_coup
-      PARAMETER (t_coup=273.15)
-c
-c contre-gradient pour la chaleur sensible: Kelvin/metre
-      REAL gamt(2:klev)
-c
-      LOGICAL appel1er
-      SAVE appel1er
-c
-c Fonctions thermodynamiques et fonctions d'instabilite
-      REAL fsta, fins, x
-      LOGICAL zxli ! utiliser un jeu de fonctions simples
-      PARAMETER (zxli=.FALSE.)
-c
-#include "YOETHF.h"
-#include "FCTTRE.h"
-      fsta(x) = 1.0 / (1.0+10.0*x*(1+8.0*x))
-      fins(x) = SQRT(1.0-18.0*x)
-c
-      DATA appel1er /.TRUE./
-c
-      IF (appel1er) THEN
-         PRINT*, 'coefkz, opt_ec:', opt_ec
-         PRINT*, 'coefkz, richum:', richum
-         IF (richum) PRINT*, 'coefkz, ratqs:', ratqs
-         PRINT*, 'coefkz, isommet:', isommet
-         PRINT*, 'coefkz, tvirtu:', tvirtu
-         appel1er = .FALSE.
-      ENDIF
-c
-c Initialiser les sorties
-c
-      DO k = 1, klev
-      DO i = 1, knon
-         pcfm(i,k) = 0.0
-         pcfh(i,k) = 0.0
-      ENDDO
-      ENDDO
-      DO i = 1, knon
-         itop(i) = 0
-      ENDDO
-c
-c Prescrire la valeur de contre-gradient
-c
-      IF (.NOT.contreg) THEN
-         DO k = 2, klev
-            gamt(k) = 0.0
-         ENDDO
-      ELSE
-         DO k = 3, klev
-            gamt(k) = -1.0E-03
-         ENDDO
-         gamt(2) = -2.5E-03
-      ENDIF
-c
-c Calculer les geopotentiels de chaque couche
-c
-      DO i = 1, knon
-         zgeop(i,1) = RD * t(i,1) / (0.5*(paprs(i,1)+pplay(i,1)))
-     .                   * (paprs(i,1)-pplay(i,1))
-      ENDDO
-      DO k = 2, klev
-      DO i = 1, knon
-         zgeop(i,k) = zgeop(i,k-1)
-     .              + RD * 0.5*(t(i,k-1)+t(i,k)) / paprs(i,k)
-     .                   * (pplay(i,k-1)-pplay(i,k))
-      ENDDO
-      ENDDO
-c
-c Calculer le frottement au sol (Cdrag)
-c
-      DO i = 1, knon
-         zdu2=max(cepdu2,u(i,1)**2+v(i,1)**2)
-         zdphi=zgeop(i,1)
-         ztsolv = ts(i) * (1.0+RETV*q(i,1)) ! qsol approx = q(i,1)
-         ztvd=(t(i,1)+zdphi/RCPD/(1.+RVTMP2*q(i,1)))
-     .       *(1.+RETV*q(i,1))
-         zri(i)=zgeop(i,1)*(ztvd-ztsolv)/(zdu2*ztvd)
-         zcdn = (ckap/log(1.+zgeop(i,1)/(RG*rugos(i))))**2
-         IF (zri(i) .ge. 0.) THEN ! situation stable
-           IF (.NOT.zxli) THEN
-           zscf=SQRT(1.+cd*ABS(zri(i)))
-           zcfm1(i) = zcdn/(1.+2.0*cb*zri(i)/zscf)
-           zcfh1(i) = zcdn/(1.+3.0*cb*zri(i)*zscf)
-           pcfm(i,1) = zcfm1(i)
-           pcfh(i,1) = zcfh1(i)
-           ELSE
-           pcfm(i,1) = zcdn* fsta(zri(i))
-           pcfh(i,1) = zcdn* fsta(zri(i))
-           ENDIF
-         ELSE ! situation instable
-           IF (.NOT.zxli) THEN
-           zucf=1./(1.+3.0*cb*cc*zcdn*SQRT(ABS(zri(i))
-     .              *(1.0+zgeop(i,1)/(RG*rugos(i)))))
-           zcfm2(i) = zcdn*(1.-2.0*cb*zri(i)*zucf)
-           zcfh2(i) = zcdn*(1.-3.0*cb*zri(i)*zucf)
-           pcfm(i,1) = zcfm2(i)
-           pcfh(i,1) = zcfh2(i)
-           ELSE
-           pcfm(i,1) = zcdn* fins(zri(i))
-           pcfh(i,1) = zcdn* fins(zri(i))
-           ENDIF
-           zcr = (0.0016/(zcdn*SQRT(zdu2)))*ABS(ztvd-ztsolv)**(1./3.)
-           IF(nsrf.EQ.is_oce)pcfh(i,1)=zcdn*(1.0+zcr**1.25)**(1./1.25)
-         ENDIF
-      ENDDO
-c
-c Calculer les coefficients turbulents dans l'atmosphere
-c
-      DO i = 1, knon
-         itop(i) = isommet
-      ENDDO
-
-      DO k = 2, isommet
-      DO i = 1, knon
-            zdu2=MAX(cepdu2,(u(i,k)-u(i,k-1))**2
-     .                     +(v(i,k)-v(i,k-1))**2)
-            zmgeom(i)=zgeop(i,k)-zgeop(i,k-1)
-            zdphi =zmgeom(i) / 2.0
-            zt = (t(i,k)+t(i,k-1)) * 0.5
-            zq = (q(i,k)+q(i,k-1)) * 0.5
-c
-c           calculer Qs et dQs/dT:
-c
-            IF (thermcep) THEN
-              zdelta = MAX(0.,SIGN(1.,RTT-zt))
-              zcvm5 = R5LES*RLVTT/RCPD/(1.0+RVTMP2*zq)*(1.-zdelta) 
-     .            + R5IES*RLSTT/RCPD/(1.0+RVTMP2*zq)*zdelta
-              zqs = R2ES * FOEEW(zt,zdelta) / pplay(i,k)
-              zqs = MIN(0.5,zqs)
-              zcor = 1./(1.-RETV*zqs)
-              zqs = zqs*zcor
-              zdqs = FOEDE(zt,zdelta,zcvm5,zqs,zcor)
-            ELSE
-              IF (zt .LT. t_coup) THEN
-                 zqs = qsats(zt) / pplay(i,k)
-                 zdqs = dqsats(zt,zqs)
-              ELSE
-                 zqs = qsatl(zt) / pplay(i,k)
-                 zdqs = dqsatl(zt,zqs)
-              ENDIF
-            ENDIF
-c
-c           calculer la fraction nuageuse (processus humide):
-c
-            zfr = (zq+ratqs*zq-zqs) / (2.0*ratqs*zq)
-            zfr = MAX(0.0,MIN(1.0,zfr))
-            IF (.NOT.richum) zfr = 0.0
-c
-c           calculer le nombre de Richardson:
-c
-            IF (tvirtu) THEN
-            ztvd =( t(i,k)
-     .             + zdphi/RCPD/(1.+RVTMP2*zq)
-     .              *( (1.-zfr) + zfr*(1.+RLVTT*zqs/RD/zt)/(1.+zdqs) )
-     .            )*(1.+RETV*q(i,k))
-            ztvu =( t(i,k-1)
-     .             - zdphi/RCPD/(1.+RVTMP2*zq)
-     .              *( (1.-zfr) + zfr*(1.+RLVTT*zqs/RD/zt)/(1.+zdqs) )
-     .            )*(1.+RETV*q(i,k-1))
-            zri(i) =zmgeom(i)*(ztvd-ztvu)/(zdu2*0.5*(ztvd+ztvu))
-            zri(i) = zri(i)
-     .             + zmgeom(i)*zmgeom(i)/RG*gamt(k)
-     .               *(paprs(i,k)/101325.0)**RKAPPA
-     .               /(zdu2*0.5*(ztvd+ztvu))
-c
-            ELSE ! calcul de Ridchardson compatible LMD5
-c
-            zri(i) =(RCPD*(t(i,k)-t(i,k-1))
-     .              -RD*0.5*(t(i,k)+t(i,k-1))/paprs(i,k)
-     .               *(pplay(i,k)-pplay(i,k-1))
-     .              )*zmgeom(i)/(zdu2*0.5*RCPD*(t(i,k-1)+t(i,k)))
-            zri(i) = zri(i) +
-     .             zmgeom(i)*zmgeom(i)*gamt(k)/RG
-cSB     .             /(paprs(i,k)/101325.0)**RKAPPA
-     .             *(paprs(i,k)/101325.0)**RKAPPA
-     .             /(zdu2*0.5*(t(i,k-1)+t(i,k)))
-            ENDIF
-c
-c           finalement, les coefficients d'echange sont obtenus:
-c
-            zcdn=SQRT(zdu2) / zmgeom(i) * RG
-c
-          IF (opt_ec) THEN
-            z2geomf=zgeop(i,k-1)+zgeop(i,k)
-            zalm2=(0.5*ckap/RG*z2geomf
-     .             /(1.+0.5*ckap/rg/clam*z2geomf))**2
-            zalh2=(0.5*ckap/rg*z2geomf
-     .             /(1.+0.5*ckap/RG/(clam*SQRT(1.5*cd))*z2geomf))**2
-            IF (zri(i).LT.0.0) THEN  ! situation instable
-               zscf = ((zgeop(i,k)/zgeop(i,k-1))**(1./3.)-1.)**3
-     .                / (zmgeom(i)/RG)**3 / (zgeop(i,k-1)/RG)
-               zscf = SQRT(-zri(i)*zscf)
-               zscfm = 1.0 / (1.0+3.0*cb*cc*zalm2*zscf)
-               zscfh = 1.0 / (1.0+3.0*cb*cc*zalh2*zscf)
-               pcfm(i,k)=zcdn*zalm2*(1.-2.0*cb*zri(i)*zscfm)
-               pcfh(i,k)=zcdn*zalh2*(1.-3.0*cb*zri(i)*zscfh)
-            ELSE ! situation stable
-               zscf=SQRT(1.+cd*zri(i))
-               pcfm(i,k)=zcdn*zalm2/(1.+2.0*cb*zri(i)/zscf)
-               pcfh(i,k)=zcdn*zalh2/(1.+3.0*cb*zri(i)*zscf)
-            ENDIF
-          ELSE
-            zl2(i)=(mixlen*MAX(0.0,(paprs(i,k)-paprs(i,itop(i)+1))
-     .                          /(paprs(i,2)-paprs(i,itop(i)+1)) ))**2
-            pcfm(i,k)=sqrt(max(zcdn*zcdn*(ric-zri(i))/ric, kstable))
-            pcfm(i,k)= zl2(i)* pcfm(i,k)
-            pcfh(i,k) = pcfm(i,k) /prandtl ! h et m different
-          ENDIF
-      ENDDO
-      ENDDO
-c
-c Au-dela du sommet, pas de diffusion turbulente:
-c
-      DO i = 1, knon
-         IF (itop(i)+1 .LE. klev) THEN
-            DO k = itop(i)+1, klev
-               pcfh(i,k) = 0.0
-               pcfm(i,k) = 0.0
-            ENDDO
-         ENDIF
-      ENDDO
-c
-      RETURN
-      END
-      SUBROUTINE coefkz2(nsrf, knon, paprs, pplay,t,
-     .                  pcfm, pcfh)
-      IMPLICIT none
-c======================================================================
-c J'introduit un peu de diffusion sauf dans les endroits
-c ou une forte inversion est presente
-c On peut dire qu'il represente la convection peu profonde
-c
-c Arguments:
-c nsrf-----input-I- indicateur de la nature du sol
-c knon-----input-I- nombre de points a traiter
-c paprs----input-R- pression a chaque intercouche (en Pa)
-c pplay----input-R- pression au milieu de chaque couche (en Pa)
-c t--------input-R- temperature (K)
-c
-c pcfm-----output-R- coefficients a calculer (vitesse)
-c pcfh-----output-R- coefficients a calculer (chaleur et humidite)
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "indicesol.h"
-c
-c Arguments:
-c
-      INTEGER knon, nsrf
-      REAL paprs(klon,klev+1), pplay(klon,klev)
-      REAL t(klon,klev)
-c
-      REAL pcfm(klon,klev), pcfh(klon,klev)
-c
-c Quelques constantes et options:
-c
-      REAL prandtl
-      PARAMETER (prandtl=0.4)
-      REAL kstable
-      PARAMETER (kstable=0.002)
-ccc      PARAMETER (kstable=0.001)
-      REAL mixlen ! constante controlant longueur de melange
-      PARAMETER (mixlen=35.0)
-      REAL seuil ! au-dela l'inversion est consideree trop faible
-      PARAMETER (seuil=-0.02)
-ccc      PARAMETER (seuil=-0.04)
-ccc      PARAMETER (seuil=-0.06)
-ccc      PARAMETER (seuil=-0.09)
-c
-c Variables locales:
-c
-      INTEGER i, k, invb(knon)
-      REAL zl2(knon)
-      REAL zdthmin(knon), zdthdp
-c
-c Initialiser les sorties
-c
-      DO k = 1, klev
-      DO i = 1, knon
-         pcfm(i,k) = 0.0
-         pcfh(i,k) = 0.0
-      ENDDO
-      ENDDO
-c
-c Chercher la zone d'inversion forte
-c
-      DO i = 1, knon
-         invb(i) = klev
-         zdthmin(i)=0.0
-      ENDDO
-      DO k = 2, klev/2-1
-      DO i = 1, knon
-         zdthdp = (t(i,k)-t(i,k+1))/(pplay(i,k)-pplay(i,k+1))
-     .          - RD * 0.5*(t(i,k)+t(i,k+1))/RCPD/paprs(i,k+1)
-         zdthdp = zdthdp * 100.0
-         IF (pplay(i,k).GT.0.8*paprs(i,1) .AND.
-     .       zdthdp.LT.zdthmin(i) ) THEN
-            zdthmin(i) = zdthdp
-            invb(i) = k
-         ENDIF
-      ENDDO
-      ENDDO
-c
-c Introduire une diffusion:
-c
-      DO k = 2, klev
-      DO i = 1, knon
-      IF ( (nsrf.NE.is_oce) .OR.  ! si ce n'est pas sur l'ocean
-     .     (invb(i).EQ.klev) .OR. ! s'il n'y a pas d'inversion
-     .     (zdthmin(i).GT.seuil) )THEN ! si l'inversion est trop faible
-         zl2(i)=(mixlen*MAX(0.0,(paprs(i,k)-paprs(i,klev+1))
-     .                       /(paprs(i,2)-paprs(i,klev+1)) ))**2
-         pcfm(i,k)= zl2(i)* kstable
-         pcfh(i,k) = pcfm(i,k) /prandtl ! h et m different
-      ENDIF
-      ENDDO
-      ENDDO
-c
-      RETURN
-      END
-      SUBROUTINE calbeta(dtime,indice,snow,qsol,
-     .                    vbeta,vcal,vdif)
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS) (adaptation du GCM du LMD)
-c date: 19940414
-c======================================================================
-c
-c Calculer quelques parametres pour appliquer la couche limite
-c ------------------------------------------------------------
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "indicesol.h"
-      REAL tau_gl ! temps de relaxation pour la glace de mer
-ccc      PARAMETER (tau_gl=86400.0*30.0)
-      PARAMETER (tau_gl=86400.0*5.0)
-      REAL mx_eau_sol
-      PARAMETER (mx_eau_sol=150.0)
-c
-      REAL calsol, calsno, calice ! epaisseur du sol: 0.15 m
-      PARAMETER (calsol=1.0/(2.5578E+06*0.15))
-      PARAMETER (calsno=1.0/(2.3867E+06*0.15))
-      PARAMETER (calice=1.0/(5.1444E+06*0.15))
-C
-      INTEGER i
-c
-      REAL dtime
-      REAL snow(klon,nbsrf), qsol(klon,nbsrf)
-      INTEGER indice
-C
-      REAL vbeta(klon)
-      REAL vcal(klon)
-      REAL vdif(klon)
-C
-      IF (indice.EQ.is_oce) THEN
-      DO i = 1, klon
-          vcal(i)   = 0.0
-          vbeta(i)  = 1.0
-          vdif(i) = 0.0
-      ENDDO
-      ENDIF
-c
-      IF (indice.EQ.is_sic) THEN
-      DO i = 1, klon
-          vcal(i) = calice
-          IF (snow(i,is_sic) .GT. 0.0) vcal(i) = calsno
-          vbeta(i)  = 1.0
-          vdif(i) = 1.0/tau_gl
-ccc          vdif(i) = calice/tau_gl ! c'etait une erreur
-      ENDDO
-      ENDIF
-c
-      IF (indice.EQ.is_ter) THEN
-      DO i = 1, klon
-          vcal(i) = calsol
-          IF (snow(i,is_ter) .GT. 0.0) vcal(i) = calsno
-          vbeta(i)  = MIN(2.0*qsol(i,is_ter)/mx_eau_sol, 1.0)
-          vdif(i) = 0.0
-      ENDDO
-      ENDIF
-c
-      IF (indice.EQ.is_lic) THEN
-      DO i = 1, klon
-          vcal(i) = calice
-          IF (snow(i,is_lic) .GT. 0.0) vcal(i) = calsno
-          vbeta(i)  = 1.0
-          vdif(i) = 0.0
-      ENDDO
-      ENDIF
-c
-      RETURN
-      END
-C======================================================================
-      SUBROUTINE nonlocal(knon, paprs, pplay,
-     .                    tsol,beta,u,v,t,q,
-     .                    cd_h, cd_m, pcfh, pcfm, cgh, cgq)
-      IMPLICIT none
-c======================================================================
-c Laurent Li (LMD/CNRS), le 30 septembre 1998
-c Couche limite non-locale. Adaptation du code du CCM3.
-c Code non teste, donc a ne pas utiliser.
-c======================================================================
-c Nonlocal scheme that determines eddy diffusivities based on a
-c diagnosed boundary layer height and a turbulent velocity scale.
-c Also countergradient effects for heat and moisture are included.
-c
-c For more information, see Holtslag, A.A.M., and B.A. Boville, 1993:
-c Local versus nonlocal boundary-layer diffusion in a global climate
-c model. J. of Climate, vol. 6, 1825-1842.
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-c
-c Arguments:
-c
-      INTEGER knon ! nombre de points a calculer
-      REAL tsol(klon) ! temperature du sol (K)
-      REAL beta(klon) ! efficacite d'evaporation (entre 0 et 1)
-      REAL paprs(klon,klev+1) ! pression a inter-couche (Pa)
-      REAL pplay(klon,klev)   ! pression au milieu de couche (Pa)
-      REAL u(klon,klev) ! vitesse U (m/s)
-      REAL v(klon,klev) ! vitesse V (m/s)
-      REAL t(klon,klev) ! temperature (K)
-      REAL q(klon,klev) ! vapeur d'eau (kg/kg)
-      REAL cd_h(klon) ! coefficient de friction au sol pour chaleur
-      REAL cd_m(klon) ! coefficient de friction au sol pour vitesse
-c
-      INTEGER isommet
-      PARAMETER (isommet=klev)
-      REAL vk
-      PARAMETER (vk=0.35)
-      REAL ricr
-      PARAMETER (ricr=0.4)
-      REAL fak
-      PARAMETER (fak=8.5)
-      REAL fakn
-      PARAMETER (fakn=7.2)
-      REAL onet
-      PARAMETER (onet=1.0/3.0)
-      REAL t_coup
-      PARAMETER(t_coup=273.15)
-      REAL zkmin
-      PARAMETER (zkmin=0.01)
-      REAL betam
-      PARAMETER (betam=15.0)
-      REAL betah
-      PARAMETER (betah=15.0)
-      REAL betas
-      PARAMETER (betas=5.0)
-      REAL sffrac
-      PARAMETER (sffrac=0.1)
-      REAL binm
-      PARAMETER (binm=betam*sffrac)
-      REAL binh
-      PARAMETER (binh=betah*sffrac)
-      REAL ccon
-      PARAMETER (ccon=fak*sffrac*vk)
-c
-      REAL z(klon,klev)
-      REAL pcfm(klon,klev), pcfh(klon,klev)
-c
-      INTEGER i, k
-      REAL zxt, zxq, zxu, zxv, zxmod, taux, tauy
-      REAL zx_alf1, zx_alf2 ! parametres pour extrapolation
-      REAL khfs(klon)       ! surface kinematic heat flux [mK/s]
-      REAL kqfs(klon)       ! sfc kinematic constituent flux [m/s]
-      REAL heatv(klon)      ! surface virtual heat flux
-      REAL ustar(klon)
-      REAL rino(klon,klev)  ! bulk Richardon no. from level to ref lev
-      LOGICAL unstbl(klon)  ! pts w/unstbl pbl (positive virtual ht flx)
-      LOGICAL stblev(klon)  ! stable pbl with levels within pbl
-      LOGICAL unslev(klon)  ! unstbl pbl with levels within pbl
-      LOGICAL unssrf(klon)  ! unstb pbl w/lvls within srf pbl lyr
-      LOGICAL unsout(klon)  ! unstb pbl w/lvls in outer pbl lyr
-      LOGICAL check(klon)   ! True=>chk if Richardson no.>critcal
-      REAL pblh(klon)
-      REAL cgh(klon,2:klev) ! counter-gradient term for heat [K/m]
-      REAL cgq(klon,2:klev) ! counter-gradient term for constituents
-      REAL cgs(klon,2:klev) ! counter-gradient star (cg/flux)
-      REAL obklen(klon)
-      REAL ztvd, ztvu, zdu2
-      REAL therm(klon)      ! thermal virtual temperature excess
-      REAL phiminv(klon)    ! inverse phi function for momentum
-      REAL phihinv(klon)    ! inverse phi function for heat
-      REAL wm(klon)         ! turbulent velocity scale for momentum
-      REAL fak1(klon)       ! k*ustar*pblh
-      REAL fak2(klon)       ! k*wm*pblh
-      REAL fak3(klon)       ! fakn*wstr/wm
-      REAL pblk(klon)       ! level eddy diffusivity for momentum
-      REAL pr(klon)         ! Prandtl number for eddy diffusivities
-      REAL zl(klon)         ! zmzp / Obukhov length
-      REAL zh(klon)         ! zmzp / pblh
-      REAL zzh(klon)        ! (1-(zmzp/pblh))**2
-      REAL wstr(klon)       ! w*, convective velocity scale
-      REAL zm(klon)         ! current level height
-      REAL zp(klon)         ! current level height + one level up
-      REAL zcor, zdelta, zcvm5, zxqs
-      REAL fac, pblmin, zmzp, term
-c
-#include "YOETHF.h"
-#include "FCTTRE.h"
-c
-c Initialisation
-c
-      DO i = 1, klon
-         pcfh(i,1) = cd_h(i)
-         pcfm(i,1) = cd_m(i)
-      ENDDO
-      DO k = 2, klev
-      DO i = 1, klon
-         pcfh(i,k) = zkmin
-         pcfm(i,k) = zkmin
-         cgs(i,k) = 0.0
-         cgh(i,k) = 0.0
-         cgq(i,k) = 0.0
-      ENDDO
-      ENDDO
-c
-c Calculer les hauteurs de chaque couche
-c
-      DO i = 1, knon
-         z(i,1) = RD * t(i,1) / (0.5*(paprs(i,1)+pplay(i,1)))
-     .               * (paprs(i,1)-pplay(i,1)) / RG
-      ENDDO
-      DO k = 2, klev
-      DO i = 1, knon
-         z(i,k) = z(i,k-1)
-     .              + RD * 0.5*(t(i,k-1)+t(i,k)) / paprs(i,k)
-     .                   * (pplay(i,k-1)-pplay(i,k)) / RG
-      ENDDO
-      ENDDO
-c
-      DO i = 1, knon
-         IF (thermcep) THEN
-           zdelta=MAX(0.,SIGN(1.,RTT-tsol(i)))
-           zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
-           zcvm5 = zcvm5 / RCPD / (1.0+RVTMP2*q(i,1))
-           zxqs= r2es * FOEEW(tsol(i),zdelta)/paprs(i,1)
-           zxqs=MIN(0.5,zxqs)
-           zcor=1./(1.-retv*zxqs)
-           zxqs=zxqs*zcor
-         ELSE
-           IF (tsol(i).LT.t_coup) THEN
-              zxqs = qsats(tsol(i)) / paprs(i,1)
-           ELSE
-              zxqs = qsatl(tsol(i)) / paprs(i,1)
-           ENDIF
-         ENDIF
-        zx_alf1 = 1.0
-        zx_alf2 = 1.0 - zx_alf1
-        zxt = (t(i,1)+z(i,1)*RG/RCPD/(1.+RVTMP2*q(i,1)))
-     .        *(1.+RETV*q(i,1))*zx_alf1
-     .      + (t(i,2)+z(i,2)*RG/RCPD/(1.+RVTMP2*q(i,2)))
-     .        *(1.+RETV*q(i,2))*zx_alf2
-        zxu = u(i,1)*zx_alf1+u(i,2)*zx_alf2
-        zxv = v(i,1)*zx_alf1+v(i,2)*zx_alf2
-        zxq = q(i,1)*zx_alf1+q(i,2)*zx_alf2
-        zxmod = 1.0+SQRT(zxu**2+zxv**2)
-        khfs(i) = (tsol(i)*(1.+RETV*q(i,1))-zxt) *zxmod*cd_h(i)
-        kqfs(i) = (zxqs-zxq) *zxmod*cd_h(i) * beta(i)
-        heatv(i) = khfs(i) + 0.61*zxt*kqfs(i)
-        taux = zxu *zxmod*cd_m(i)
-        tauy = zxv *zxmod*cd_m(i)
-        ustar(i) = SQRT(taux**2+tauy**2)
-        ustar(i) = MAX(SQRT(ustar(i)),0.01)
-      ENDDO
-c
-      DO i = 1, knon
-         rino(i,1) = 0.0
-         check(i) = .TRUE.
-         pblh(i) = z(i,1)
-         obklen(i) = -t(i,1)*ustar(i)**3/(RG*vk*heatv(i))
-      ENDDO
-
-C
-C PBL height calculation:
-C Search for level of pbl. Scan upward until the Richardson number between
-C the first level and the current level exceeds the "critical" value.
-C
-      fac = 100.0
-      DO k = 1, isommet
-      DO i = 1, knon
-      IF (check(i)) THEN
-         zdu2 = (u(i,k)-u(i,1))**2+(v(i,k)-v(i,1))**2+fac*ustar(i)**2
-         zdu2 = max(zdu2,1.0e-20)
-         ztvd =(t(i,k)+z(i,k)*0.5*RG/RCPD/(1.+RVTMP2*q(i,k)))
-     .         *(1.+RETV*q(i,k))
-         ztvu =(t(i,1)-z(i,k)*0.5*RG/RCPD/(1.+RVTMP2*q(i,1)))
-     .         *(1.+RETV*q(i,1))
-         rino(i,k) = (z(i,k)-z(i,1))*RG*(ztvd-ztvu)
-     .               /(zdu2*0.5*(ztvd+ztvu))
-         IF (rino(i,k).GE.ricr) THEN
-           pblh(i) = z(i,k-1) + (z(i,k-1)-z(i,k)) *
-     .              (ricr-rino(i,k-1))/(rino(i,k-1)-rino(i,k))
-           check(i) = .FALSE.
-         ENDIF
-      ENDIF
-      ENDDO
-      ENDDO
-
-C
-C Set pbl height to maximum value where computation exceeds number of
-C layers allowed
-C
-      DO i = 1, knon
-        if (check(i)) pblh(i) = z(i,isommet)
-      ENDDO
-C
-C Improve estimate of pbl height for the unstable points.
-C Find unstable points (sensible heat flux is upward):
-C
-      DO i = 1, knon
-      IF (heatv(i) .GT. 0.) THEN
-        unstbl(i) = .TRUE.
-        check(i) = .TRUE.
-      ELSE
-        unstbl(i) = .FALSE.
-        check(i) = .FALSE.
-      ENDIF
-      ENDDO
-C
-C For the unstable case, compute velocity scale and the
-C convective temperature excess:
-C
-      DO i = 1, knon
-      IF (check(i)) THEN
-        phiminv(i) = (1.-binm*pblh(i)/obklen(i))**onet
-        wm(i)= ustar(i)*phiminv(i)
-        therm(i) = heatv(i)*fak/wm(i)
-        rino(i,1) = 0.0
-      ENDIF
-      ENDDO
-C
-C Improve pblh estimate for unstable conditions using the
-C convective temperature excess:
-C
-      DO k = 1, isommet
-      DO i = 1, knon
-      IF (check(i)) THEN
-         zdu2 = (u(i,k)-u(i,1))**2+(v(i,k)-v(i,1))**2+fac*ustar(i)**2
-         zdu2 = max(zdu2,1.0e-20)
-         ztvd =(t(i,k)+z(i,k)*0.5*RG/RCPD/(1.+RVTMP2*q(i,k)))
-     .         *(1.+RETV*q(i,k))
-         ztvu =(t(i,1)+therm(i)-z(i,k)*0.5*RG/RCPD/(1.+RVTMP2*q(i,1)))
-     .         *(1.+RETV*q(i,1))
-         rino(i,k) = (z(i,k)-z(i,1))*RG*(ztvd-ztvu)
-     .               /(zdu2*0.5*(ztvd+ztvu))
-         IF (rino(i,k).GE.ricr) THEN
-           pblh(i) = z(i,k-1) + (z(i,k-1)-z(i,k)) *
-     .              (ricr-rino(i,k-1))/(rino(i,k-1)-rino(i,k))
-           check(i) = .FALSE.
-         ENDIF
-      ENDIF
-      ENDDO
-      ENDDO
-C
-C Set pbl height to maximum value where computation exceeds number of
-C layers allowed
-C
-      DO i = 1, knon
-        if (check(i)) pblh(i) = z(i,isommet)
-      ENDDO
-C
-C Points for which pblh exceeds number of pbl layers allowed;
-C set to maximum
-C
-      DO i = 1, knon
-        IF (check(i)) pblh(i) = z(i,isommet)
-      ENDDO
-C
-C PBL height must be greater than some minimum mechanical mixing depth
-C Several investigators have proposed minimum mechanical mixing depth
-C relationships as a function of the local friction velocity, u*.  We
-C make use of a linear relationship of the form h = c u* where c=700.
-C The scaling arguments that give rise to this relationship most often
-C represent the coefficient c as some constant over the local coriolis
-C parameter.  Here we make use of the experimental results of Koracin
-C and Berkowicz (1988) [BLM, Vol 43] for wich they recommend 0.07/f
-C where f was evaluated at 39.5 N and 52 N.  Thus we use a typical mid
-C latitude value for f so that c = 0.07/f = 700.
-C
-      DO i = 1, knon
-        pblmin  = 700.0*ustar(i)
-        pblh(i) = MAX(pblh(i),pblmin)
-      ENDDO
-C
-C pblh is now available; do preparation for diffusivity calculation:
-C
-      DO i = 1, knon
-        pblk(i) = 0.0
-        fak1(i) = ustar(i)*pblh(i)*vk
-C
-C Do additional preparation for unstable cases only, set temperature
-C and moisture perturbations depending on stability.
-C
-        IF (unstbl(i)) THEN
-          zxt=(t(i,1)-z(i,1)*0.5*RG/RCPD/(1.+RVTMP2*q(i,1)))
-     .         *(1.+RETV*q(i,1))
-          phiminv(i) = (1. - binm*pblh(i)/obklen(i))**onet
-          phihinv(i) = sqrt(1. - binh*pblh(i)/obklen(i))
-          wm(i)      = ustar(i)*phiminv(i)
-          fak2(i)    = wm(i)*pblh(i)*vk
-          wstr(i)    = (heatv(i)*RG*pblh(i)/zxt)**onet
-          fak3(i)    = fakn*wstr(i)/wm(i)
-        ENDIF
-      ENDDO
-
-C Main level loop to compute the diffusivities and
-C counter-gradient terms:
-C
-      DO 1000 k = 2, isommet
-C
-C Find levels within boundary layer:
-C
-        DO i = 1, knon
-          unslev(i) = .FALSE.
-          stblev(i) = .FALSE.
-          zm(i) = z(i,k-1)
-          zp(i) = z(i,k)
-          IF (zkmin.EQ.0.0 .AND. zp(i).GT.pblh(i)) zp(i) = pblh(i)
-          IF (zm(i) .LT. pblh(i)) THEN
-            zmzp = 0.5*(zm(i) + zp(i))
-            zh(i) = zmzp/pblh(i)
-            zl(i) = zmzp/obklen(i)
-            zzh(i) = 0.
-            IF (zh(i).LE.1.0) zzh(i) = (1. - zh(i))**2
-C
-C stblev for points zm < plbh and stable and neutral
-C unslev for points zm < plbh and unstable
-C
-            IF (unstbl(i)) THEN
-              unslev(i) = .TRUE.
-            ELSE
-              stblev(i) = .TRUE.
-            ENDIF
-          ENDIF
-        ENDDO
-C
-C Stable and neutral points; set diffusivities; counter-gradient
-C terms zero for stable case:
-C
-        DO i = 1, knon
-          IF (stblev(i)) THEN
-            IF (zl(i).LE.1.) THEN
-              pblk(i) = fak1(i)*zh(i)*zzh(i)/(1. + betas*zl(i))
-            ELSE
-              pblk(i) = fak1(i)*zh(i)*zzh(i)/(betas + zl(i))
-            ENDIF
-            pcfm(i,k) = pblk(i)
-            pcfh(i,k) = pcfm(i,k)
-          ENDIF
-        ENDDO
-C
-C unssrf, unstable within surface layer of pbl
-C unsout, unstable within outer   layer of pbl
-C
-        DO i = 1, knon
-          unssrf(i) = .FALSE.
-          unsout(i) = .FALSE.
-          IF (unslev(i)) THEN
-            IF (zh(i).lt.sffrac) THEN
-              unssrf(i) = .TRUE.
-            ELSE
-              unsout(i) = .TRUE.
-            ENDIF
-          ENDIF
-        ENDDO
-C
-C Unstable for surface layer; counter-gradient terms zero
-C
-        DO i = 1, knon
-          IF (unssrf(i)) THEN
-            term = (1. - betam*zl(i))**onet
-            pblk(i) = fak1(i)*zh(i)*zzh(i)*term
-            pr(i) = term/sqrt(1. - betah*zl(i))
-          ENDIF
-        ENDDO
-C
-C Unstable for outer layer; counter-gradient terms non-zero:
-C
-        DO i = 1, knon
-          IF (unsout(i)) THEN
-            pblk(i) = fak2(i)*zh(i)*zzh(i)
-            cgs(i,k) = fak3(i)/(pblh(i)*wm(i))
-            cgh(i,k) = khfs(i)*cgs(i,k)
-            pr(i) = phiminv(i)/phihinv(i) + ccon*fak3(i)/fak
-            cgq(i,k) = kqfs(i)*cgs(i,k)
-          ENDIF
-        ENDDO
-C
-C For all unstable layers, set diffusivities
-C
-        DO i = 1, knon
-        IF (unslev(i)) THEN
-            pcfm(i,k) = pblk(i)
-            pcfh(i,k) = pblk(i)/pr(i)
-        ENDIF
-        ENDDO
- 1000 continue           ! end of level loop
-
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/clouds_gno.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/clouds_gno.F	(revision 416)
+++ 	(revision )
@@ -1,250 +1,0 @@
-C
-C================================================================================
-C
-      SUBROUTINE CLOUDS_GNO(klon,ND,R,RS,QSUB,PTCONV,RATQSC,CLDF)
-      IMPLICIT NONE
-C     
-C--------------------------------------------------------------------------------
-C
-C Inputs:
-C
-C  ND----------: Number of vertical levels
-C  R--------ND-: Domain-averaged mixing ratio of total water 
-C  RS-------ND-: Mean saturation humidity mixing ratio within the gridbox
-C  QSUB-----ND-: Mixing ratio of condensed water within clouds associated
-C                with SUBGRID-SCALE condensation processes (here, it is
-C                predicted by the convection scheme)
-C Outputs:
-C
-C  PTCONV-----ND-: Point convectif = TRUE
-C  RATQSC-----ND-: Largeur normalisee de la distribution
-C  CLDF-----ND-: Fraction nuageuse
-C
-C--------------------------------------------------------------------------------
-
-
-      INTEGER klon,ND
-      REAL R(klon,ND),  RS(klon,ND), QSUB(klon,ND)
-      LOGICAL PTCONV(klon,ND)
-      REAL RATQSC(klon,ND)
-      REAL CLDF(klon,ND)
-
-c -- parameters controlling the iteration:
-c --    nmax    : maximum nb of iterations (hopefully never reached)
-c --    epsilon : accuracy of the numerical resolution 
-c --    vmax    : v-value above which we use an asymptotic expression for ERF(v)
-
-      INTEGER nmax
-      PARAMETER ( nmax = 10) 
-      REAL epsilon, vmax0, vmax(klon)
-      PARAMETER ( epsilon = 0.02, vmax0 = 2.0 ) 
-
-      REAL min_mu, min_Q
-      PARAMETER ( min_mu =  1.e-12, min_Q=1.e-12 )
-     
-      INTEGER i,K, n, m
-      REAL mu(klon), qsat(klon), delta(klon), beta(klon) 
-      real zu2(klon),zv2(klon)
-      REAL xx(klon), aux(klon), coeff(klon), block(klon)
-      REAL  dist(klon), fprime(klon), det(klon)
-      REAL pi, u(klon), v(klon), erfu(klon), erfv(klon)
-      REAL  xx1(klon), xx2(klon)
-      real erf,kkk
-c lconv = true si le calcul a converge (entre autre si qsub < min_q)
-       LOGICAL lconv(klon)
-
-
-      pi = ACOS(-1.)
-
-      ptconv=.false.
-      ratqsc=0.
-
-
-      DO 500 K = 1, ND
-
-                                    do i=1,klon ! vector
-      mu(i) = R(i,K)
-      mu(i) = MAX(mu(i),min_mu)
-      qsat(i) = RS(i,K) 
-      qsat(i) = MAX(qsat(i),min_mu)
-      delta(i) = log(mu(i)/qsat(i))
-                                    enddo ! vector
-
-C
-C ***          There is no subgrid-scale condensation;        ***
-C ***   the scheme becomes equivalent to an "all-or-nothing"  *** 
-C ***             large-scale condensation scheme.            ***
-C
-
-C
-C ***     Some condensation is produced at the subgrid-scale       ***
-C ***                                                              ***
-C ***       PDF = generalized log-normal distribution (GNO)        ***
-C ***   (k<0 because a lower bound is considered for the PDF)      ***
-C ***                                                              ***
-C ***  -> Determine x (the parameter k of the GNO PDF) such        ***
-C ***  that the contribution of subgrid-scale processes to         ***
-C ***  the in-cloud water content is equal to QSUB(K)              ***
-C ***  (equations (13), (14), (15) + Appendix B of the paper)      ***
-C ***                                                              ***
-C ***    Here, an iterative method is used for this purpose        ***
-C ***    (other numerical methods might be more efficient)         ***
-C ***                                                              ***
-C ***          NB: the "error function" is called ERF              ***
-C ***                 (ERF in double precision)                   ***
-C
-
-c  On commence par eliminer les cas pour lesquels on n'a pas
-c  suffisamment d'eau nuageuse.
-
-                                    do i=1,klon ! vector
-
-      IF ( QSUB(i,K) .lt. min_Q ) THEN
-        ptconv(i,k)=.false.
-        ratqsc(i,k)=0.
-        lconv(i)  = .true.
-
-c   Rien on a deja initialise
-
-      ELSE 
-
-        lconv(i)  = .FALSE. 
-        vmax(i) = vmax0
-
-        beta(i) = QSUB(i,K)/mu(i) + EXP( -MIN(0.0,delta(i)) )
-
-c --  roots of equation v > vmax:
-
-        det(i) = delta(i) + vmax(i)**2.
-        if (det(i).LE.0.0) vmax(i) = vmax0 + 1.0
-        det(i) = delta(i) + vmax(i)**2.
-
-        if (det(i).LE.0.) then
-          xx(i) = -0.0001
-        else 
-         xx1(i)=-SQRT(2.)*vmax(i)*(1.0-SQRT(1.0+delta(i)/(vmax(i)**2.)))
-         xx2(i)=-SQRT(2.)*vmax(i)*(1.0+SQRT(1.0+delta(i)/(vmax(i)**2.)))
-         xx(i) = 1.01 * xx1(i)
-         if ( xx1(i) .GE. 0.0 ) xx(i) = 0.5*xx2(i)
-        endif
-        if (delta(i).LT.0.) xx(i) = -0.5*SQRT(log(2.)) 
-
-      ENDIF
-
-                                    enddo       ! vector
-
-c----------------------------------------------------------------------
-c   Debut des nmax iterations pour trouver la solution.
-c----------------------------------------------------------------------
-
-      DO n = 1, nmax 
-
-                                    do i=1,klon ! vector
-        if (.not.lconv(i)) then
-
-          u(i) = delta(i)/(xx(i)*sqrt(2.)) + xx(i)/(2.*sqrt(2.))
-          v(i) = delta(i)/(xx(i)*sqrt(2.)) - xx(i)/(2.*sqrt(2.))
-
-          IF ( v(i) .GT. vmax(i) ) THEN 
-
-            IF (     ABS(u(i))  .GT. vmax(i) 
-     :          .AND.  delta(i) .LT. 0. ) THEN
-
-c -- use asymptotic expression of erf for u and v large:
-c ( -> analytic solution for xx )
-
-             aux(i) = 2.0*delta(i)*(1.-beta(i)*EXP(delta(i)))
-     :                       /(1.+beta(i)*EXP(delta(i)))
-             if (aux(i).lt.0.) then
-                print*,'AUX(',i,',',k,')<0',aux(i),delta(i),beta(i)
-                aux(i)=0.
-             endif
-             xx(i) = -SQRT(aux(i))
-             block(i) = EXP(-v(i)*v(i)) / v(i) / SQRT(pi)
-             dist(i) = 0.0
-             fprime(i) = 1.0
-
-            ELSE
-
-c -- erfv -> 1.0, use an asymptotic expression of erfv for v large:
-
-             erfu(i) = ERF(u(i))
-c  !!! ATTENTION : rajout d'un seuil pour l'exponentiel
-             aux(i) = SQRT(pi)*(1.0-erfu(i))*EXP(min(v(i)*v(i),100.))
-             coeff(i) = 1.0 - 1./2./(v(i)**2.) + 3./4./(v(i)**4.)
-             block(i) = coeff(i) * EXP(-v(i)*v(i)) / v(i) / SQRT(pi)
-             dist(i) = v(i) * aux(i) / coeff(i) - beta(i)
-             fprime(i) = 2.0 / xx(i) * (v(i)**2.)
-     :           * ( coeff(i)*EXP(-delta(i)) - u(i) * aux(i) )
-     :           / coeff(i) / coeff(i)
-            
-            ENDIF ! ABS(u)
-
-          ELSE
-
-c -- general case:
-
-           erfu(i) = ERF(u(i))
-           erfv(i) = ERF(v(i))
-           block(i) = 1.0-erfv(i)
-           dist(i) = (1.0 - erfu(i)) / (1.0 - erfv(i)) - beta(i)
-           zu2(i)=u(i)*u(i)
-           zv2(i)=v(i)*v(i)
-           if(zu2(i).gt.20..or. zv2(i).gt.20.) then
-              print*,'ATTENTION !!! xx(',i,') =', xx(i)
-           print*,'ATTENTION !!! klon,ND,R,RS,QSUB,PTCONV,RATQSC,CLDF',
-     .klon,ND,R(i,k),RS(i,k),QSUB(i,k),PTCONV(i,k),RATQSC(i,k),
-     .CLDF(i,k)
-              print*,'ATTENTION !!! zu2 zv2 =',zu2(i),zv2(i)
-              zu2(i)=20.
-              zv2(i)=20.
-             fprime(i) = 0.
-           else
-             fprime(i) = 2. /SQRT(pi) /xx(i) /(1.0-erfv(i))**2.
-     :           * (   (1.0-erfv(i))*v(i)*EXP(-zu2(i))
-     :               - (1.0-erfu(i))*u(i)*EXP(-zv2(i)) )
-           endif
-          ENDIF ! x
-
-c -- test numerical convergence:
-
-c         print*,'avant test ',i,k,lconv(i),u(i),v(i)
-          if ( ABS(dist(i)/beta(i)) .LT. epsilon ) then 
-c           print*,'v-u **2',(v(i)-u(i))**2
-c           print*,'exp v-u **2',exp((v(i)-u(i))**2)
-            ptconv(i,K) = .TRUE. 
-            lconv(i)=.true.
-c  borne pour l'exponentielle
-            ratqsc(i,k)=min(2.*(v(i)-u(i))**2,20.)
-            ratqsc(i,k)=sqrt(exp(ratqsc(i,k))-1.)
-            CLDF(i,K) = 0.5 * block(i)
-cccccccccccccccccccccccc
-c           kkk=-sqrt(log(1.+ratqsc(i,k)**2))
-c           u(i)=delta(i)/(kkk*sqrt(2.))-kkk/(2.*sqrt(2.))
-c           v(i)=delta(i)/(kkk*sqrt(2.))+kkk/(2.*sqrt(2.))
-c           erfu(i)=erf(u(i))
-c           erfv(i)=erf(v(i))
-c           print*,'SIG ',k,qsub(i,k)
-c    s      ,mu(i)*((1.-erfv(i))/(1.-erfu(i))-qsat(i)/mu(i))
-c    s      ,0.5*erfu(i)
-cccccccccccccccccccccccc
-          else
-            xx(i) = xx(i) - dist(i)/fprime(i)
-          endif
-c         print*,'apres test ',i,k,lconv(i)
-
-        endif ! lconv
-                                    enddo       ! vector
-
-c----------------------------------------------------------------------
-c   Fin des nmax iterations pour trouver la solution.
-        ENDDO ! n
-c----------------------------------------------------------------------
-
-500   CONTINUE  ! K
-
-       RETURN
-       END
-
-
-
Index: LMDZ.3.3/branches/rel-/libf/phylmd/cltrac.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/cltrac.F	(revision 416)
+++ 	(revision )
@@ -1,118 +1,0 @@
-      SUBROUTINE cltrac(dtime,coef,t,tr,flux,paprs,pplay,delp,
-     s                  d_tr)
-      IMPLICIT none
-c======================================================================
-c Auteur(s): O. Boucher (LOA/LMD) date: 19961127
-c            inspire de clvent
-c Objet: diffusion verticale de traceurs avec flux fixe a la surface
-c        ou/et flux du type c-drag
-c======================================================================
-c Arguments:
-c dtime----input-R- intervalle du temps (en second)
-c coef-----input-R- le coefficient d'echange (m**2/s) l>1
-c t--------input-R- temperature (K)
-c tr-------input-R- la q. de traceurs
-c flux-----input-R- le flux de traceurs a la surface
-c paprs----input-R- pression a inter-couche (Pa)
-c pplay----input-R- pression au milieu de couche (Pa)
-c delp-----input-R- epaisseur de couche (Pa)
-c cdrag----input-R- cdrag pour le flux de surface (non active)
-c tr0------input-R- traceurs a la surface ou dans l'ocean (non active)
-c d_tr-----output-R- le changement de tr
-c flux_tr--output-R- flux de tr
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-      REAL dtime
-      REAL coef(klon,klev)
-      REAL t(klon,klev), tr(klon,klev)
-      REAL paprs(klon,klev+1), pplay(klon,klev), delp(klon,klev)
-      REAL d_tr(klon,klev)
-      REAL flux(klon), cdrag(klon), tr0(klon)
-c      REAL flux_tr(klon,klev)
-c======================================================================
-#include "YOMCST.h"
-c======================================================================
-      INTEGER i, k
-      REAL zx_ctr(klon,2:klev)
-      REAL zx_dtr(klon,2:klev)
-      REAL zx_buf(klon)
-      REAL zx_coef(klon,klev)
-      REAL local_tr(klon,klev)
-      REAL zx_alf1(klon), zx_alf2(klon), zx_flux(klon)
-c======================================================================
-      DO k = 1, klev
-      DO i = 1, klon
-         local_tr(i,k) = tr(i,k)
-      ENDDO
-      ENDDO
-c
-
-c======================================================================
-      DO i = 1, klon
-         zx_alf1(i) = (paprs(i,1)-pplay(i,2))/(pplay(i,1)-pplay(i,2))
-         zx_alf2(i) = 1.0 - zx_alf1(i)
-         zx_flux(i) =  -flux(i)*dtime*RG
-c--pour le moment le flux est prescrit
-c--cdrag et zx_coef(1) vaut 0
-         cdrag(i) = 0.0 
-         tr0(i) = 0.0
-         zx_coef(i,1) = cdrag(i)*dtime*RG 
-      ENDDO
-c======================================================================
-      DO k = 2, klev
-      DO i = 1, klon
-         zx_coef(i,k) = coef(i,k)*RG/(pplay(i,k-1)-pplay(i,k))
-     .                  *(paprs(i,k)*2/(t(i,k)+t(i,k-1))/RD)**2
-         zx_coef(i,k) = zx_coef(i,k)*dtime*RG
-      ENDDO
-      ENDDO
-c======================================================================
-      DO i = 1, klon
-         zx_buf(i) = delp(i,1) + zx_coef(i,1)*zx_alf1(i) + zx_coef(i,2)
-         zx_ctr(i,2) = (local_tr(i,1)*delp(i,1)+
-     .                  zx_coef(i,1)*tr0(i)-zx_flux(i))/zx_buf(i)
-         zx_dtr(i,2) = (zx_coef(i,2)-zx_alf2(i)*zx_coef(i,1)) / 
-     .                  zx_buf(i)
-      ENDDO
-c
-      DO k = 3, klev
-      DO i = 1, klon
-         zx_buf(i) = delp(i,k-1) + zx_coef(i,k)
-     .                  + zx_coef(i,k-1)*(1.-zx_dtr(i,k-1))
-         zx_ctr(i,k) = (local_tr(i,k-1)*delp(i,k-1)
-     .                  +zx_coef(i,k-1)*zx_ctr(i,k-1) )/zx_buf(i)
-         zx_dtr(i,k) = zx_coef(i,k)/zx_buf(i)
-      ENDDO
-      ENDDO
-      DO i = 1, klon
-         local_tr(i,klev) = ( local_tr(i,klev)*delp(i,klev)
-     .                        +zx_coef(i,klev)*zx_ctr(i,klev) )
-     .                   / ( delp(i,klev) + zx_coef(i,klev)
-     .                       -zx_coef(i,klev)*zx_dtr(i,klev) )
-      ENDDO
-      DO k = klev-1, 1, -1
-      DO i = 1, klon
-         local_tr(i,k) = zx_ctr(i,k+1) + zx_dtr(i,k+1)*local_tr(i,k+1)
-      ENDDO
-      ENDDO
-c======================================================================
-c== flux_tr est le flux de traceur (positif vers bas)
-c      DO i = 1, klon
-c         flux_tr(i,1) = zx_coef(i,1)/(RG*dtime)
-c      ENDDO
-c      DO k = 2, klev
-c      DO i = 1, klon
-c         flux_tr(i,k) = zx_coef(i,k)/(RG*dtime)
-c     .               * (local_tr(i,k)-local_tr(i,k-1))
-c      ENDDO
-c      ENDDO
-c======================================================================
-      DO k = 1, klev
-      DO i = 1, klon
-         d_tr(i,k) = local_tr(i,k) - tr(i,k)
-      ENDDO
-      ENDDO
-c
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/cltracrn.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/cltracrn.F	(revision 416)
+++ 	(revision )
@@ -1,290 +1,0 @@
-      SUBROUTINE cltracrn( itr, dtime,u1lay, v1lay,
-     e              coef,t,ftsol,pctsrf,
-     e              tr,trs,paprs,pplay,delp,
-     e              masktr,fshtr,hsoltr,tautr,vdeptr,
-     e              lat,
-     s              d_tr,d_trs )
-
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Alex/LMD) date:  fev 99
-c            inspire de clqh + clvent
-c Objet: diffusion verticale de traceurs avec quantite de traceur ds 
-c        le sol ( reservoir de sol de radon ) 
-c        
-c note : pour l'instant le traceur dans le sol et le flux sont
-c        calcules mais ils ne servent que de diagnostiques
-c        seule la tendance sur le traceur est sortie (d_tr)
-c======================================================================
-c Arguments:
-c itr---  -input-R- le type de traceur 1- Rn 2 - Pb
-c dtime----input-R- intervalle du temps (en second)
-c u1lay----input-R- vent u de la premiere couche (m/s)
-c v1lay----input-R- vent v de la premiere couche (m/s)
-c coef-----input-R- le coefficient d'echange (m**2/s) l>1
-c t--------input-R- temperature (K)
-c paprs----input-R- pression a inter-couche (Pa)
-c pplay----input-R- pression au milieu de couche (Pa)
-c delp-----input-R- epaisseur de couche (Pa)
-c ftsol----input-R- temperature du sol (en Kelvin)
-c tr-------input-R- traceurs
-c trs------input-R- traceurs dans le sol
-c masktr---input-R- Masque reservoir de sol traceur (1 = reservoir)
-c fshtr----input-R- Flux surfacique de production dans le sol
-c tautr----input-R- Constante de decroissance du traceur
-c vdeptr---input-R- Vitesse de depot sec dans la couche brownienne
-c hsoltr---input-R- Epaisseur equivalente du reservoir de sol
-c lat-----input-R- latitude en degree
-c d_tr-----output-R- le changement de "tr"
-c d_trs----output-R- le changement de "trs"
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "indicesol.h"
-c======================================================================
-      REAL dtime
-      REAL u1lay(klon), v1lay(klon)
-      REAL coef(klon,klev)
-      REAL t(klon,klev), ftsol(klon,nbsrf), pctsrf(klon,nbsrf) 
-      REAL tr(klon,klev), trs(klon)
-      REAL paprs(klon,klev+1), pplay(klon,klev), delp(klon,klev)
-      REAL masktr(klon) 
-      REAL fshtr(klon) 
-      REAL hsoltr
-      REAL tautr
-      REAL vdeptr
-      REAL lat(klon)   
-      REAL d_tr(klon,klev)
-c======================================================================
-      REAL flux_tr(klon,klev)  ! (diagnostic) flux de traceur
-      REAL d_trs(klon)         ! (diagnostic) traceur ds le sol
-c======================================================================
-      INTEGER i, k, itr, n, l
-      REAL rotrhi(klon)
-      REAL zx_coef(klon,klev)
-      REAL zx_buf(klon)
-      REAL zx_ctr(klon,klev)
-      REAL zx_dtr(klon,klev)
-      REAL zx_trs(klon)
-      REAL zx_a, zx_b
-
-      REAL local_tr(klon,klev)
-      REAL local_trs(klon)
-      REAL zts(klon)
-      REAL zx_alpha1(klon), zx_alpha2(klon)
-c======================================================================
-cAA Pour l'instant les 4 types de surface ne sont pas pris en compte
-cAA On fabrique avec zts un champ de temperature de sol  
-cAA que le pondere par la fraction de nature de sol.
-c 
-      print*,'PASSAGE DANS CLTRACRN'
-
-      DO i = 1,klon
-            zts(i) = 0. 
-      ENDDO
-c
-      DO n=1,nbsrf
-         DO i = 1,klon
-            zts(i) = zts(i) + ftsol(i,n)*pctsrf(i,n)
-         ENDDO
-      ENDDO
-c
-      DO i = 1,klon
-          rotrhi(i) = RD * zts(i) / hsoltr 
-      END DO
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         local_tr(i,k) = tr(i,k)
-      ENDDO
-      ENDDO
-c
-      DO i = 1, klon
-         local_trs(i) = trs(i)
-      ENDDO
-c======================================================================
-cAA   Attention si dans clmain zx_alf1(i) = 1.0 
-cAA   Il doit y avoir coherence (dc la meme chose ici)
-
-      DO i = 1, klon
-cAA         zx_alpha1(i) = (paprs(i,1)-pplay(i,2))/(pplay(i,1)-pplay(i,2))
-         zx_alpha1(i) = 1.0
-         zx_alpha2(i) = 1.0 - zx_alpha1(i)
-      ENDDO
-c======================================================================
-      DO i = 1, klon
-         zx_coef(i,1) = coef(i,1)
-     .                 * (1.0+SQRT(u1lay(i)**2+v1lay(i)**2))
-     .                 * pplay(i,1)/(RD*t(i,1))
-         zx_coef(i,1) = zx_coef(i,1) * dtime*RG
-      ENDDO
-c
-      DO k = 2, klev
-      DO i = 1, klon
-         zx_coef(i,k) = coef(i,k)*RG/(pplay(i,k-1)-pplay(i,k))
-     .                  *(paprs(i,k)*2/(t(i,k)+t(i,k-1))/RD)**2
-         zx_coef(i,k) = zx_coef(i,k) * dtime*RG
-      ENDDO
-      ENDDO
-c======================================================================
-      DO i = 1, klon
-         zx_buf(i)      = delp(i,klev) + zx_coef(i,klev)
-         zx_ctr(i,klev) = local_tr(i,klev)*delp(i,klev)/zx_buf(i)
-         zx_dtr(i,klev) = zx_coef(i,klev) / zx_buf(i)
-      ENDDO
-c
-      DO l = klev-1, 2 , -1
-      DO i = 1, klon
-         zx_buf(i) = delp(i,l)+zx_coef(i,l)
-     .              +zx_coef(i,l+1)*(1.-zx_dtr(i,l+1))
-         zx_ctr(i,l) = ( local_tr(i,l)*delp(i,l)
-     .                   + zx_coef(i,l+1)*zx_ctr(i,l+1) )/zx_buf(i)
-         zx_dtr(i,l) = zx_coef(i,l) / zx_buf(i)
-      ENDDO
-      ENDDO
-c
-      DO i = 1, klon
-         zx_buf(i) = delp(i,1) + zx_coef(i,2)*(1.-zx_dtr(i,2))
-     .               + masktr(i) * zx_coef(i,1)
-     .               *( zx_alpha1(i)+zx_alpha2(i)*zx_dtr(i,2) )
-         zx_ctr(i,1) = ( local_tr(i,1)*delp(i,1)
-     .                  + zx_ctr(i,2)
-     .                  *(zx_coef(i,2)
-     .                    - masktr(i) * zx_coef(i,1)
-     .                    *zx_alpha2(i) ) ) / zx_buf(i)
-         zx_dtr(i,1) = masktr(i) * zx_coef(i,1) / zx_buf(i)
-      ENDDO
-c======================================================================
-c Calculer d'abord local_trs nouvelle quantite dans le reservoir
-c de sol
-c
-c-------------------------
-c Au dessus des continents
-c-------------------------
-c Le pb peut se deposer partout : vdeptr = 10-3 m/s
-c Le Rn est traiter commme une couche Brownienne puisque vdeptr = 0.
-c
-      DO i = 1, klon
-c
-        IF ( NINT(masktr(i)) .EQ. 1 ) THEN
-         zx_trs(i) = local_trs(i)
-         zx_a = zx_trs(i)
-     .         +fshtr(i)*dtime*rotrhi(i)
-     .         +rotrhi(i)*masktr(i)*zx_coef(i,1)/RG
-     .         *(zx_ctr(i,1)*(zx_alpha1(i)+zx_alpha2(i)*zx_dtr(i,2))
-     .         +zx_alpha2(i)*zx_ctr(i,2))
-         zx_b = 1. + rotrhi(i)*masktr(i)*zx_coef(i,1)/RG
-     .              * (1.-zx_dtr(i,1)
-     .              *(zx_alpha1(i)+zx_alpha2(i)*zx_dtr(i,2)))
-     .              + dtime / tautr
-cAA: Pour l'instant, pour aller vite, le depot sec est traite
-C comme une decroissance
-     .              + dtime * vdeptr / hsoltr
-         zx_trs(i) = zx_a / zx_b
-         local_trs(i) = zx_trs(i)
-        ENDIF
-c
-c Si on est entre 60N et 70N on divise par 2 l'emanation
-c--------------------------------------------------------
-c
-        IF
-     .  ( (itr.eq.1.AND.NINT(masktr(i)).EQ.1.AND.lat(i).GE.60.
-     .     .AND.lat(i).LE.70.)
-     .                      .OR.
-     .     (itr.eq.2.AND.NINT(masktr(i)).EQ.1.AND.lat(i).GE.60.
-     .     .AND.lat(i).LE.70.) )
-     .  THEN
-         zx_trs(i) = local_trs(i)
-         zx_a = zx_trs(i)
-     .         +(fshtr(i)/2.)*dtime*rotrhi(i)
-     .         +rotrhi(i)*masktr(i)*zx_coef(i,1)/RG
-     .         *(zx_ctr(i,1)*(zx_alpha1(i)+zx_alpha2(i)*zx_dtr(i,2))
-     .         +zx_alpha2(i)*zx_ctr(i,2))
-         zx_b = 1. + rotrhi(i)*masktr(i)*zx_coef(i,1)/RG
-     .              * (1.-zx_dtr(i,1)
-     .              *(zx_alpha1(i)+zx_alpha2(i)*zx_dtr(i,2)))
-     .              + dtime / tautr
-     .              + dtime * vdeptr / hsoltr
-         zx_trs(i) = zx_a / zx_b
-         local_trs(i) = zx_trs(i)
-        ENDIF
-c
-c----------------------------------------------
-c Au dessus des oceans et aux hautes latitudes
-c----------------------------------------------
-c
-c au dessous de -60S  pas d'emission de radon au dessus 
-c des oceans et des continents
-c---------------------------------------------------------------
-
-       IF ( (itr.EQ.1.AND.NINT(masktr(i)).EQ.0)
-     .                 .OR.
-     . (itr.EQ.1.AND.NINT(masktr(i)).EQ.1.AND.lat(i).LT.-60.))
-     . THEN
-         zx_trs(i) = 0.
-         local_trs(i) = 0.
-        END IF
-
-c au dessus de 70 N pas d'emission de radon au dessus 
-c des oceans et des continents
-c--------------------------------------------------------------
-       IF ( (itr.EQ.1.AND.NINT(masktr(i)).EQ.0)
-     .                 .OR.
-     . (itr.EQ.1.AND.NINT(masktr(i)).EQ.1.AND.lat(i).GT.70.))
-     . THEN
-         zx_trs(i) = 0.
-         local_trs(i) = 0.
-        END IF
-
-c Au dessus des oceans la source est nulle
-c-----------------------------------------
-c
-        IF (itr.eq.1.AND.NINT(masktr(i)).EQ.0) THEN
-         zx_trs(i) = 0.
-         local_trs(i) = 0.
-        END IF
-c
-      ENDDO    ! sur le i=1,klon
-c
-c======================================================================
-c==== une fois on a zx_trs, on peut faire l'iteration ========
-c
-      DO i = 1, klon
-         local_tr(i,1) = zx_ctr(i,1)+zx_dtr(i,1)*zx_trs(i)
-      ENDDO
-      DO l = 2, klev
-      DO i = 1, klon
-        local_tr(i,l)
-     .    = zx_ctr(i,l) + zx_dtr(i,l)*local_tr(i,l-1)
-      ENDDO
-      ENDDO
-c======================================================================
-c== Calcul du flux de traceur (flux_tr): UA/(m**2 s)
-c
-      DO i = 1, klon
-        flux_tr(i,1) = masktr(i)*zx_coef(i,1)/RG
-     .      * (zx_alpha1(i)*local_tr(i,1)+zx_alpha2(i)*local_tr(i,2)
-     .                   -zx_trs(i)) / dtime
-      ENDDO
-      DO l = 2, klev
-      DO i = 1, klon
-        flux_tr(i,l) = zx_coef(i,l)/RG
-     .       * (local_tr(i,l)-local_tr(i,l-1)) / dtime
-      ENDDO
-      ENDDO
-c======================================================================
-c== Calcul des tendances du traceur ds le sol et dans l'atmosphere
-c
-      DO l = 1, klev
-      DO i = 1, klon
-         d_tr(i,l) = local_tr(i,l) - tr(i,l)
-      ENDDO
-      ENDDO
-      DO i = 1, klon
-         d_trs(i) = local_trs(i) - trs(i)
-      ENDDO
-c======================================================================
-c
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/coefcdrag.F90
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/coefcdrag.F90	(revision 416)
+++ 	(revision )
@@ -1,137 +1,0 @@
-      SUBROUTINE coefcdrag (klon, knon, nsrf, zxli, &
-                            speed, t, q, zgeop, psol, &
-                            ts, qsurf, rugos, okri, ri1, &
-                            cdram, cdrah, cdran, zri1, pref)
-      IMPLICIT none
-!-------------------------------------------------------------------------
-! Objet : calcul des cdrags pour le moment (cdram) et les flux de chaleur 
-!         sensible et latente (cdrah), du cdrag neutre (cdran), 
-!         du nombre de Richardson entre la surface et le niveau de reference 
-!         (zri1) et de la pression au niveau de reference (pref).    
-!
-! I. Musat, 01.07.2002
-!-------------------------------------------------------------------------
-!
-! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
-! knon----input-I- nombre de points pour un type de surface
-! nsrf----input-I- indice pour le type de surface; voir indicesol.inc
-! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
-! speed---input-R- module du vent au 1er niveau du modele
-! t-------input-R- temperature de l'air au 1er niveau du modele
-! q-------input-R- humidite de l'air au 1er niveau du modele
-! zgeop---input-R- geopotentiel au 1er niveau du modele
-! psol----input-R- pression au sol 
-! ts------input-R- temperature de l'air a la surface
-! qsurf---input-R- humidite de l'air a la surface
-! rugos---input-R- rugosite
-! okri----input-L- TRUE si on veut tester le nb. Richardson entre la sfce 
-!                  et zref par rapport au Ri entre la sfce et la 1ere couche
-! ri1-----input-R- nb. Richardson entre la surface et la 1ere couche
-!
-! cdram--output-R- cdrag pour le moment
-! cdrah--output-R- cdrag pour les flux de chaleur latente et sensible
-! cdran--output-R- cdrag neutre
-! zri1---output-R- nb. Richardson entre la surface et la couche zgeop/RG
-! pref---output-R- pression au niveau zgeop/RG
-!
-      INTEGER, intent(in) :: klon, knon, nsrf
-      LOGICAL, intent(in) :: zxli 
-      REAL, dimension(klon), intent(in) :: speed, t, q, zgeop, psol
-      REAL, dimension(klon), intent(in) :: ts, qsurf, rugos, ri1 
-      LOGICAL, intent(in) :: okri    
-!
-      REAL, dimension(klon), intent(out) :: cdram, cdrah, cdran, zri1, pref
-!-------------------------------------------------------------------------
-!
-#include "YOMCST.inc"
-#include "YOETHF.inc"
-#include "indicesol.inc"
-! Quelques constantes :
-      REAL, parameter :: RKAR=0.40, CB=5.0, CC=5.0, CD=5.0
-!
-! Variables locales :
-      INTEGER :: i
-      REAL, dimension(klon) :: zdu2, zdphi, ztsolv, ztvd
-      REAL, dimension(klon) :: zscf, friv, frih, zucf, zcr
-      REAL, dimension(klon) :: zcfm1, zcfh1
-      REAL, dimension(klon) :: zcfm2, zcfh2
-      REAL, dimension(klon) :: trm0, trm1
-!-------------------------------------------------------------------------
-      REAL :: fsta, fins, x
-      fsta(x) = 1.0 / (1.0+10.0*x*(1+8.0*x))
-      fins(x) = SQRT(1.0-18.0*x)
-!-------------------------------------------------------------------------
-!
-      DO i = 1, knon
-!
-       zdphi(i) = zgeop(i)
-       zdu2(i) = speed(i)**2
-       pref(i) = exp(log(psol(i)) - zdphi(i)/(RD*t(i)* &
-                 (1.+ RETV * max(q(i),0.0))))
-       ztsolv(i) = ts(i)
-       ztvd(i) = t(i) * (psol(i)/pref(i))**RKAPPA
-       trm0(i) = 1. + RETV * max(qsurf(i),0.0)
-       trm1(i) = 1. + RETV * max(q(i),0.0)
-       ztsolv(i) = ztsolv(i) * trm0(i)
-       ztvd(i) = ztvd(i) * trm1(i)
-       zri1(i) = zdphi(i)*(ztvd(i)-ztsolv(i))/(zdu2(i)*ztvd(i))
-!
-! on teste zri1 par rapport au Richardson de la 1ere couche ri1 
-!
-       IF (okri) THEN
-         IF (ri1(i).GE.0.0.AND.zri1(i).LT.0.0) THEN
-           zri1(i) = ri1(i)
-         ELSE IF(ri1(i).LT.0.0.AND.zri1(i).GE.0.0) THEN
-           zri1(i) = ri1(i)
-         ENDIF 
-       ENDIF
-! 
-       cdran(i) = (RKAR/log(1.+zdphi(i)/(RG*rugos(i))))**2
-
-       IF (zri1(i) .ge. 0.) THEN 
-!
-! situation stable : pour eviter les inconsistances dans les cas 
-! tres stables on limite zri1 a 20. cf Hess et al. (1995)
-!
-         zri1(i) = min(20.,zri1(i))
-!
-         IF (.NOT.zxli) THEN
-           zscf(i) = SQRT(1.+CD*ABS(zri1(i)))
-           friv(i) = max(1. / (1.+2.*CB*zri1(i)/ zscf(i)), 0.1)
-           zcfm1(i) = cdran(i) * friv(i)
-           frih(i) = max(1./ (1.+3.*CB*zri1(i)*zscf(i)), 0.1 )
-           zcfh1(i) = cdran(i) * frih(i)
-           cdram(i) = zcfm1(i)
-           cdrah(i) = zcfh1(i)
-         ELSE
-           cdram(i) = cdran(i)* fsta(zri1(i))
-           cdrah(i) = cdran(i)* fsta(zri1(i))
-         ENDIF
-!
-       ELSE
-! 
-! situation instable
-!
-         IF (.NOT.zxli) THEN
-           zucf(i) = 1./(1.+3.0*CB*CC*cdran(i)*SQRT(ABS(zri1(i)) &
-                 *(1.0+zdphi(i)/(RG*rugos(i)))))
-           zcfm2(i) = cdran(i)*max((1.-2.0*CB*zri1(i)*zucf(i)),0.1)
-           zcfh2(i) = cdran(i)*max((1.-3.0*CB*zri1(i)*zucf(i)),0.1)
-           cdram(i) = zcfm2(i)
-           cdrah(i) = zcfh2(i)
-         ELSE
-           cdram(i) = cdran(i)* fins(zri1(i))
-           cdrah(i) = cdran(i)* fins(zri1(i))
-         ENDIF
-!
-! cdrah sur l'ocean cf. Miller et al. (1992)
-!
-         zcr(i) = (0.0016/(cdran(i)*SQRT(zdu2(i))))*ABS(ztvd(i)-ztsolv(i)) &
-               **(1./3.)
-         IF (nsrf.EQ.is_oce) cdrah(i) = cdran(i)*(1.0+zcr(i)**1.25) &
-                  **(1./1.25)
-       ENDIF
-!
-      END DO
-      RETURN 
-      END SUBROUTINE coefcdrag
Index: LMDZ.3.3/branches/rel-/libf/phylmd/coefcdrag_int.F90
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/coefcdrag_int.F90	(revision 416)
+++ 	(revision )
@@ -1,22 +1,0 @@
-MODULE coefcdrag_int
-
-  IMPLICIT NONE 
-
-  INTERFACE
- 
-    SUBROUTINE coefcdrag (klon, knon, nsrf, zxli, &
-                          speed, t, q, zgeop, psol, &
-                          ts, qsurf, rugos, okri, ri1, &
-                          cdram, cdrah, cdran, zri1, pref)
-      INTEGER, intent(in) :: klon, knon, nsrf
-      LOGICAL, intent(in) :: zxli
-      REAL, dimension(klon), intent(in) :: speed, t, q, zgeop, psol
-      REAL, dimension(klon), intent(in) :: ts, qsurf, rugos, ri1
-      LOGICAL, intent(in) :: okri
-      REAL, dimension(klon), intent(out) :: cdram, cdrah, cdran, zri1, pref
-
-    END SUBROUTINE coefcdrag
-
-  END INTERFACE
-
-END MODULE coefcdrag_int
Index: LMDZ.3.3/branches/rel-/libf/phylmd/comg1d.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/comg1d.h	(revision 416)
+++ 	(revision )
@@ -1,52 +1,0 @@
-c.......................................................................
-c  le COMMON pour GRADS-1D
-c
-c  on peut se dire : "on ne sauvera pas plus de 1000 variables ... hein ?"
-c
-      INTEGER g1d_nvarmx
-      PARAMETER(g1d_nvarmx=1000)
-c
-c         * g1d_nlayer     ---> nombre de couches verticales
-c         * g1d_nomfich    ---> nom du fichier grads
-c         * g1d_unitfich   ---> code du fichier grads
-c         * g1d_nomctl     ---> nom du fichier ctl
-c         * g1d_unitctl    ---> code du fichier ctl
-c         * g1d_premier    ---> variable logique pour dire si le fichier
-c                               est deja ouvert
-c         * g1d_irec       ---> indice de derniere ecriture
-c         * g1d_nvar       ---> nombre de variables deja definies a la
-c                               derniere ecriture
-c         * g1d_nomvar     ---> noms des vecteurs existants
-c         * g1d_dimvar     ---> taille des vecteurs
-c         * g1d_titrevar   ---> titres des vecteurs
-c         * g1d_tmp1       ---> caractere 
-c         * g1d_tmp2       ---> caractere 
-c
-      INTEGER g1d_nlayer
-      CHARACTER*100 g1d_nomfich
-      INTEGER g1d_unitfich
-      CHARACTER*100 g1d_nomctl
-      INTEGER g1d_unitctl
-      LOGICAL g1d_premier
-      INTEGER g1d_irec
-      INTEGER g1d_nvar
-      CHARACTER*100 g1d_nomvar
-      INTEGER g1d_dimvar
-      CHARACTER*100 g1d_titrevar
-      CHARACTER*100 g1d_tmp1,g1d_tmp2
-c
-      COMMON/COMG1DI/g1d_nlayer
-     &             ,g1d_unitfich
-     &             ,g1d_unitctl
-     &             ,g1d_irec
-     &             ,g1d_nvar
-      COMMON/COMG1DC/g1d_dimvar(0:g1d_nvarmx)
-     &             ,g1d_nomfich
-     &             ,g1d_nomctl
-     &             ,g1d_nomvar(0:g1d_nvarmx)
-     &             ,g1d_titrevar(0:g1d_nvarmx)
-     &             ,g1d_tmp1
-     &             ,g1d_tmp2
-      COMMON/COMG1DL/g1d_premier
-c
-c.......................................................................
Index: LMDZ.3.3/branches/rel-/libf/phylmd/comvert1d.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/comvert1d.h	(revision 416)
+++ 	(revision )
@@ -1,10 +1,0 @@
-c-----------------------------------------------------------------------
-c   INCLUDE 'comvert.h'
-
-      COMMON/comvert/
-     . s(klev),sig(klev+1),ds(klev),dsig(klev),dsig1(klev),sdsig(klev)
-     . ,sig_s(klev)
-
-      REAL s,sig,ds,dsig,dsig1,sdsig,sig_s
-
-c-----------------------------------------------------------------------
Index: LMDZ.3.3/branches/rel-/libf/phylmd/conccm.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/conccm.F	(revision 416)
+++ 	(revision )
@@ -1,830 +1,0 @@
-      SUBROUTINE conccm (dtime,paprs,pplay,t,q,conv_q,
-     s                   d_t, d_q, rain, snow, kbascm, ktopcm)
-c
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS) date: le 14 mars 1996
-c Objet: Schema simple (avec flux de masse) pour la convection 
-c        (schema standard du modele NCAR CCM2)
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "YOETHF.h"
-c
-c Entree:
-      REAL dtime              ! pas d'integration
-      REAL paprs(klon,klev+1) ! pression inter-couche (Pa)
-      REAL pplay(klon,klev)   ! pression au milieu de couche (Pa)
-      REAL t(klon,klev)       ! temperature (K)
-      REAL q(klon,klev)       ! humidite specifique (g/g)
-      REAL conv_q(klon,klev)  ! taux de convergence humidite (g/g/s)
-c Sortie:
-      REAL d_t(klon,klev)     ! incrementation temperature
-      REAL d_q(klon,klev)     ! incrementation vapeur
-      REAL rain(klon)         ! pluie (mm/s)
-      REAL snow(klon)         ! neige (mm/s)
-      INTEGER kbascm(klon)    ! niveau du bas de convection
-      INTEGER ktopcm(klon)    ! niveau du haut de convection
-c
-      REAL pt(klon,klev)
-      REAL pq(klon,klev)
-      REAL pres(klon,klev)
-      REAL dp(klon,klev)
-      REAL zgeom(klon,klev)
-      REAL cmfprs(klon)
-      REAL cmfprt(klon)
-      INTEGER ntop(klon)
-      INTEGER nbas(klon)
-      INTEGER i, k
-      REAL zlvdcp, zlsdcp, zdelta, zz, za, zb
-c
-      LOGICAL usekuo ! utiliser convection profonde (schema Kuo)
-      PARAMETER (usekuo=.TRUE.)
-c
-      REAL d_t_bis(klon,klev)
-      REAL d_q_bis(klon,klev)
-      REAL rain_bis(klon)
-      REAL snow_bis(klon)
-      INTEGER ibas_bis(klon)
-      INTEGER itop_bis(klon)
-      REAL d_ql_bis(klon,klev)
-      REAL rneb_bis(klon,klev)
-c
-c initialiser les variables de sortie (pour securite)
-      DO i = 1, klon
-         rain(i) = 0.0
-         snow(i) = 0.0
-         kbascm(i) = 0
-         ktopcm(i) = 0
-      ENDDO
-      DO k = 1, klev
-      DO i = 1, klon
-         d_t(i,k) = 0.0
-         d_q(i,k) = 0.0
-      ENDDO
-      ENDDO
-c
-c preparer les variables d'entree (attention: l'ordre des niveaux 
-c verticaux augmente du haut vers le bas)
-      DO k = 1, klev
-      DO i = 1, klon
-         pt(i,k) = t(i,klev-k+1)
-         pq(i,k) = q(i,klev-k+1)
-         pres(i,k) = pplay(i,klev-k+1)
-         dp(i,k) = paprs(i,klev+1-k)-paprs(i,klev+1-k+1)
-      ENDDO
-      ENDDO
-      DO i = 1, klon
-         zgeom(i,klev) = RD * t(i,1) / (0.5*(paprs(i,1)+pplay(i,1)))
-     .                      * (paprs(i,1)-pplay(i,1))
-      ENDDO
-      DO k = 2, klev
-      DO i = 1, klon
-         zgeom(i,klev+1-k) = zgeom(i,klev+1-k+1)
-     .              + RD * 0.5*(t(i,k-1)+t(i,k)) / paprs(i,k)
-     .                   * (pplay(i,k-1)-pplay(i,k))
-      ENDDO
-      ENDDO
-c
-      CALL cmfmca(dtime, pres, dp, zgeom, pt, pq,
-     $                  cmfprt, cmfprs, ntop, nbas)
-C
-      DO k = 1, klev
-      DO i = 1, klon
-         d_q(i,klev+1-k) = pq(i,k) - q(i,klev+1-k) 
-         d_t(i,klev+1-k) = pt(i,k) - t(i,klev+1-k)
-      ENDDO
-      ENDDO
-c
-      DO i = 1, klon
-         rain(i) = cmfprt(i) * rhoh2o
-         snow(i) = cmfprs(i) * rhoh2o
-         kbascm(i) = klev+1 - nbas(i)
-         ktopcm(i) = klev+1 - ntop(i)
-      ENDDO
-c
-      IF (usekuo) THEN
-      CALL conkuo(dtime, paprs, pplay, t, q, conv_q,
-     s            d_t_bis, d_q_bis, d_ql_bis, rneb_bis,
-     s            rain_bis, snow_bis, ibas_bis, itop_bis)
-      DO k = 1, klev
-      DO i = 1, klon
-         d_t(i,k) = d_t(i,k) + d_t_bis(i,k)
-         d_q(i,k) = d_q(i,k) + d_q_bis(i,k)
-      ENDDO
-      ENDDO
-      DO i = 1, klon
-         rain(i) = rain(i) + rain_bis(i)
-         snow(i) = snow(i) + snow_bis(i)
-         kbascm(i) = MIN(kbascm(i),ibas_bis(i))
-         ktopcm(i) = MAX(ktopcm(i),itop_bis(i))
-      ENDDO
-      DO k = 1, klev ! eau liquide convective est
-      DO i = 1, klon ! dispersee dans l'air
-         zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q(i,k))
-         zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*q(i,k))
-         zdelta = MAX(0.,SIGN(1.,RTT-t(i,k)))
-         zz = d_ql_bis(i,k) ! re-evap. de l'eau liquide
-         zb = MAX(0.0,zz)
-         za = - MAX(0.0,zz) * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
-         d_t(i,k) = d_t(i,k) + za
-         d_q(i,k) = d_q(i,k) + zb
-      ENDDO
-      ENDDO
-      ENDIF
-c
-      RETURN
-      END
-      SUBROUTINE cmfmca(deltat, p, dp, gz,
-     $                  tb, shb,
-     $                  cmfprt, cmfprs, cnt, cnb)
-      IMPLICIT none
-C-----------------------------------------------------------------------
-C Moist convective mass flux procedure:
-C If stratification is unstable to nonentraining parcel ascent,
-C complete an adjustment making use of a simple cloud model
-C 
-C Code generalized to allow specification of parcel ("updraft")
-C properties, as well as convective transport of an arbitrary
-C number of passive constituents (see cmrb array).
-C----------------------------Code History-------------------------------
-C Original version:  J. J. Hack, March 22, 1990
-C Standardized:      J. Rosinski, June 1992
-C Reviewed:          J. Hack, G. Taylor, August 1992
-c Adaptation au LMD: Z.X. Li, mars 1996 (reference: Hack 1994,
-c                    J. Geophys. Res. vol 99, D3, 5551-5568). J'ai
-c                    introduit les constantes et les fonctions thermo-
-c                    dynamiques du Centre Europeen. J'ai elimine le
-c                    re-indicage du code en esperant que cela pourra
-c                    simplifier la lecture et la comprehension.
-C-----------------------------------------------------------------------
-#include "dimensions.h"
-#include "dimphy.h"
-      INTEGER pcnst ! nombre de traceurs passifs
-      PARAMETER (pcnst=1)
-C------------------------------Arguments--------------------------------
-C Input arguments
-C
-      REAL deltat                 ! time step (seconds)
-      REAL p(klon,klev)           ! pressure
-      REAL dp(klon,klev)          ! delta-p
-      REAL gz(klon,klev)          ! geopotential (a partir du sol)
-c
-      REAL thtap(klon)            ! PBL perturbation theta
-      REAL shp(klon)              ! PBL perturbation specific humidity 
-      REAL pblh(klon)             ! PBL height (provided by PBL routine)
-      REAL cmrp(klon,pcnst)       ! constituent perturbations in PBL
-c
-c Updated arguments:
-c
-      REAL tb(klon,klev)         ! temperature (t bar)
-      REAL shb(klon,klev)        ! specific humidity (sh bar)
-      REAL cmrb(klon,klev,pcnst) ! constituent mixing ratios (cmr bar)
-C
-C Output arguments
-C
-      REAL cmfdt(klon,klev)    ! dT/dt due to moist convection
-      REAL cmfdq(klon,klev)    ! dq/dt due to moist convection
-      REAL cmfmc(klon,klev )   ! moist convection cloud mass flux
-      REAL cmfdqr(klon,klev)   ! dq/dt due to convective rainout 
-      REAL cmfsl(klon,klev )   ! convective lw static energy flux
-      REAL cmflq(klon,klev )   ! convective total water flux
-      REAL cmfprt(klon)        ! convective precipitation rate
-      REAL cmfprs(klon)        ! convective snowfall rate
-      REAL qc(klon,klev)       ! dq/dt due to rainout terms
-      INTEGER cnt(klon)        ! top level of convective activity   
-      INTEGER cnb(klon)        ! bottom level of convective activity
-C------------------------------Parameters-------------------------------
-      REAL c0         ! rain water autoconversion coefficient
-      PARAMETER (c0=1.0e-4)
-      REAL dzmin       ! minimum convective depth for precipitation
-      PARAMETER (dzmin=0.0)
-      REAL betamn      ! minimum overshoot parameter
-      PARAMETER (betamn=0.10)
-      REAL cmftau      ! characteristic adjustment time scale
-      PARAMETER (cmftau=3600.)
-      INTEGER limcnv   ! top interface level limit for convection
-      PARAMETER (limcnv=1)
-      REAL tpmax       ! maximum acceptable t perturbation (degrees C)
-      PARAMETER (tpmax=1.50)
-      REAL shpmax      ! maximum acceptable q perturbation (g/g)
-      PARAMETER (shpmax=1.50e-3)
-      REAL tiny        ! arbitrary small num used in transport estimates
-      PARAMETER (tiny=1.0e-36)
-      REAL eps         ! convergence criteria (machine dependent)
-      PARAMETER (eps=1.0e-13)
-      REAL tmelt       ! freezing point of water(req'd for rain vs snow)
-      PARAMETER (tmelt=273.15)
-      REAL ssfac ! supersaturation bound (detrained air)
-      PARAMETER (ssfac=1.001)
-C
-C---------------------------Local workspace-----------------------------
-      REAL gam(klon,klev)     ! L/cp (d(qsat)/dT)
-      REAL sb(klon,klev)      ! dry static energy (s bar)
-      REAL hb(klon,klev)      ! moist static energy (h bar)
-      REAL shbs(klon,klev)    ! sat. specific humidity (sh bar star)
-      REAL hbs(klon,klev)     ! sat. moist static energy (h bar star)
-      REAL shbh(klon,klev+1)  ! specific humidity on interfaces
-      REAL sbh(klon,klev+1)   ! s bar on interfaces
-      REAL hbh(klon,klev+1)   ! h bar on interfaces
-      REAL cmrh(klon,klev+1)  ! interface constituent mixing ratio 
-      REAL prec(klon)         ! instantaneous total precipitation
-      REAL dzcld(klon)        ! depth of convective layer (m)
-      REAL beta(klon)         ! overshoot parameter (fraction)
-      REAL betamx             ! local maximum on overshoot
-      REAL eta(klon)          ! convective mass flux (kg/m^2 s)
-      REAL etagdt             ! eta*grav*deltat
-      REAL cldwtr(klon)       ! cloud water (mass)
-      REAL rnwtr(klon)        ! rain water  (mass)
-      REAL sc  (klon)         ! dry static energy   ("in-cloud")
-      REAL shc (klon)         ! specific humidity   ("in-cloud")
-      REAL hc  (klon)         ! moist static energy ("in-cloud")
-      REAL cmrc(klon)         ! constituent mix rat ("in-cloud")
-      REAL dq1(klon)          ! shb  convective change (lower lvl)
-      REAL dq2(klon)          ! shb  convective change (mid level)
-      REAL dq3(klon)          ! shb  convective change (upper lvl)
-      REAL ds1(klon)          ! sb   convective change (lower lvl)
-      REAL ds2(klon)          ! sb   convective change (mid level)
-      REAL ds3(klon)          ! sb   convective change (upper lvl)
-      REAL dcmr1(klon)        ! cmrb convective change (lower lvl)
-      REAL dcmr2(klon)        ! cmrb convective change (mid level)
-      REAL dcmr3(klon)        ! cmrb convective change (upper lvl)
-      REAL flotab(klon)       ! hc - hbs (mesure d'instabilite)
-      LOGICAL ldcum(klon)     ! .true. si la convection existe
-      LOGICAL etagt0          ! true if eta > 0.0
-      REAL dt                 ! current 2 delta-t (model time step)
-      REAL cats     ! modified characteristic adj. time
-      REAL rdt      ! 1./dt
-      REAL qprime   ! modified specific humidity pert.
-      REAL tprime   ! modified thermal perturbation
-      REAL pblhgt   ! bounded pbl height (max[pblh,1m])
-      REAL fac1     ! intermediate scratch variable
-      REAL shprme   ! intermediate specific humidity pert.
-      REAL qsattp   ! saturation mixing ratio for 
-C                   !  thermally perturbed PBL parcels 
-      REAL dz       ! local layer depth
-      REAL b1       ! bouyancy measure in detrainment lvl
-      REAL b2       ! bouyancy measure in condensation lvl
-      REAL g     ! bounded vertical gradient of hb
-      REAL tmass ! total mass available for convective exchange
-      REAL denom ! intermediate scratch variable
-      REAL qtest1! used in negative q test (middle lvl) 
-      REAL qtest2! used in negative q test (lower lvl) 
-      REAL fslkp ! flux lw static energy (bot interface)
-      REAL fslkm ! flux lw static energy (top interface)
-      REAL fqlkp ! flux total water (bottom interface)
-      REAL fqlkm ! flux total water (top interface)
-      REAL botflx! bottom constituent mixing ratio flux
-      REAL topflx! top constituent mixing ratio flux
-      REAL efac1 ! ratio cmrb to convectively induced change (bot lvl)
-      REAL efac2 ! ratio cmrb to convectively induced change (mid lvl)
-      REAL efac3 ! ratio cmrb to convectively induced change (top lvl)
-c
-      INTEGER i,k  ! indices horizontal et vertical
-      INTEGER km1  ! k-1 (index offset)
-      INTEGER kp1  ! k+1 (index offset)
-      INTEGER m    ! constituent index
-      INTEGER ktp  ! temporary index used to track top 
-      INTEGER is   ! nombre de points a ajuster
-C
-      REAL tmp1, tmp2, tmp3, tmp4
-      REAL zx_t, zx_p, zx_q, zx_qs, zx_gam
-      REAL zcor, zdelta, zcvm5
-C
-      REAL qhalf, sh1, sh2, shbs1, shbs2
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-      qhalf(sh1,sh2,shbs1,shbs2) = MIN(MAX(sh1,sh2),
-     $                            (shbs2*sh1 + shbs1*sh2)/(shbs1+shbs2))
-C
-C-----------------------------------------------------------------------
-c pas de traceur pour l'instant
-      DO m = 1, pcnst
-      DO k = 1, klev
-      DO i = 1, klon
-         cmrb(i,k,m) = 0.0
-      ENDDO
-      ENDDO
-      ENDDO
-c
-c Les perturbations de la couche limite sont zero pour l'instant
-c
-      DO m = 1, pcnst
-      DO i = 1, klon
-         cmrp(i,m) = 0.0
-      ENDDO
-      ENDDO
-      DO i = 1, klon
-         thtap(i) = 0.0
-         shp(i) = 0.0
-         pblh(i) = 1.0
-      ENDDO
-C
-C Ensure that characteristic adjustment time scale (cmftau) assumed
-C in estimate of eta isn't smaller than model time scale (deltat)
-C
-      dt   = deltat
-      cats = MAX(dt,cmftau)
-      rdt  = 1.0/dt
-C
-C Compute sb,hb,shbs,hbs
-C
-      DO k = 1, klev
-      DO i = 1, klon
-         zx_t = tb(i,k)
-         zx_p = p(i,k)
-         zx_q = shb(i,k)
-           zdelta=MAX(0.,SIGN(1.,RTT-zx_t))
-           zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
-           zcvm5 = zcvm5 / RCPD / (1.0+RVTMP2*zx_q)
-           zx_qs= r2es * FOEEW(zx_t,zdelta)/zx_p
-           zx_qs=MIN(0.5,zx_qs)
-           zcor=1./(1.-retv*zx_qs)
-           zx_qs=zx_qs*zcor
-           zx_gam = FOEDE(zx_t,zdelta,zcvm5,zx_qs,zcor)
-         shbs(i,k) = zx_qs
-         gam(i,k) = zx_gam
-      ENDDO
-      ENDDO
-C
-      DO k=limcnv,klev
-         DO i=1,klon
-            sb (i,k) = RCPD*tb(i,k) + gz(i,k)
-            hb (i,k) = sb(i,k) + RLVTT*shb(i,k)
-            hbs(i,k) = sb(i,k) + RLVTT*shbs(i,k)
-         ENDDO
-      ENDDO
-C
-C Compute sbh, shbh
-C
-      DO k=limcnv+1,klev
-         km1 = k - 1
-         DO i=1,klon
-            sbh (i,k) =0.5*(sb(i,km1) + sb(i,k))
-            shbh(i,k) =qhalf(shb(i,km1),shb(i,k),shbs(i,km1),shbs(i,k))
-            hbh (i,k) =sbh(i,k) + RLVTT*shbh(i,k)
-         ENDDO
-      ENDDO
-C
-C Specify properties at top of model (not used, but filling anyway)
-C
-      DO i=1,klon
-         sbh (i,limcnv) = sb(i,limcnv)
-         shbh(i,limcnv) = shb(i,limcnv)
-         hbh (i,limcnv) = hb(i,limcnv)
-      ENDDO
-C
-C Zero vertically independent control, tendency & diagnostic arrays
-C
-      DO i=1,klon
-         prec(i)  = 0.0
-         dzcld(i) = 0.0
-         cnb(i)   = 0
-         cnt(i)   = klev+1
-      ENDDO
-
-      DO k = 1, klev
-        DO i = 1,klon
-         cmfdt(i,k)  = 0.
-         cmfdq(i,k)  = 0.
-         cmfdqr(i,k) = 0.
-         cmfmc(i,k)  = 0.
-         cmfsl(i,k)  = 0.
-         cmflq(i,k)  = 0.
-        ENDDO
-      ENDDO
-C
-C Begin moist convective mass flux adjustment procedure.
-C Formalism ensures that negative cloud liquid water can never occur
-C
-      DO 70 k=klev-1,limcnv+1,-1
-         km1 = k - 1
-         kp1 = k + 1
-         DO 10 i=1,klon
-            eta   (i) = 0.0
-            beta  (i) = 0.0
-            ds1   (i) = 0.0
-            ds2   (i) = 0.0
-            ds3   (i) = 0.0
-            dq1   (i) = 0.0
-            dq2   (i) = 0.0
-            dq3   (i) = 0.0
-C
-C Specification of "cloud base" conditions
-C
-            qprime    = 0.0
-            tprime    = 0.0
-C
-C Assign tprime within the PBL to be proportional to the quantity
-C thtap (which will be bounded by tpmax), passed to this routine by 
-C the PBL routine.  Don't allow perturbation to produce a dry 
-C adiabatically unstable parcel.  Assign qprime within the PBL to be 
-C an appropriately modified value of the quantity shp (which will be 
-C bounded by shpmax) passed to this routine by the PBL routine.  The 
-C quantity qprime should be less than the local saturation value 
-C (qsattp=qsat[t+tprime,p]).  In both cases, thtap and shp are
-C linearly reduced toward zero as the PBL top is approached.
-C
-            pblhgt = MAX(pblh(i),1.0)
-            IF (gz(i,kp1)/RG.LE.pblhgt .AND. dzcld(i).EQ.0.0) THEN
-               fac1   = MAX(0.0,1.0-gz(i,kp1)/RG/pblhgt)
-               tprime = MIN(thtap(i),tpmax)*fac1
-               qsattp = shbs(i,kp1) + RCPD/RLVTT*gam(i,kp1)*tprime
-               shprme = MIN(MIN(shp(i),shpmax)*fac1,
-     $                        MAX(qsattp-shb(i,kp1),0.0))
-               qprime = MAX(qprime,shprme)
-            ELSE
-               tprime = 0.0
-               qprime = 0.0
-            ENDIF
-C
-C Specify "updraft" (in-cloud) thermodynamic properties
-C
-            sc (i)    = sb (i,kp1) + RCPD*tprime
-            shc(i)    = shb(i,kp1) + qprime
-            hc (i)    = sc (i    ) + RLVTT*shc(i)
-            flotab(i) = hc(i) - hbs(i,k)
-            dz        = dp(i,k)*RD*tb(i,k)/RG/p(i,k)
-            IF (flotab(i).gt.0.0) THEN
-               dzcld(i) = dzcld(i) + dz
-            ELSE
-               dzcld(i) = 0.0
-            ENDIF
-   10    CONTINUE
-C
-C Check on moist convective instability
-C
-         is = 0
-         DO i = 1, klon
-            IF (flotab(i).GT.0.0) THEN
-               ldcum(i) = .TRUE.
-               is = is + 1
-            ELSE
-               ldcum(i) = .FALSE.
-            ENDIF
-         ENDDO
-C
-         IF (is.EQ.0) THEN
-            DO i=1,klon
-               dzcld(i) = 0.0
-            ENDDO
-            GOTO 70
-         ENDIF
-C
-C Current level just below top level => no overshoot
-C
-         IF (k.le.limcnv+1) THEN
-            DO i=1,klon
-            IF (ldcum(i)) THEN
-               cldwtr(i) = sb(i,k)-sc(i)+flotab(i)/(1.0+gam(i,k))
-               cldwtr(i) = MAX(0.0,cldwtr(i))
-               beta(i)   = 0.0
-            ENDIF
-            ENDDO
-            GOTO 20
-         ENDIF
-C
-C First guess at overshoot parameter using crude buoyancy closure
-C 10% overshoot assumed as a minimum and 1-c0*dz maximum to start
-C If pre-existing supersaturation in detrainment layer, beta=0
-C cldwtr is temporarily equal to RLVTT*l (l=> liquid water)
-C
-         DO i=1,klon
-         IF (ldcum(i)) THEN
-            cldwtr(i) = sb(i,k)-sc(i)+flotab(i)/(1.0+gam(i,k))
-            cldwtr(i) = MAX(0.0,cldwtr(i))
-            betamx = 1.0 - c0*MAX(0.0,(dzcld(i)-dzmin))
-            b1        = (hc(i) - hbs(i,km1))*dp(i,km1)
-            b2        = (hc(i) - hbs(i,k  ))*dp(i,k  )
-            beta(i)   = MAX(betamn,MIN(betamx, 1.0+b1/b2))
-            IF (hbs(i,km1).le.hb(i,km1)) beta(i) = 0.0
-         ENDIF
-         ENDDO
-C
-C Bound maximum beta to ensure physically realistic solutions
-C
-C First check constrains beta so that eta remains positive
-C (assuming that eta is already positive for beta equal zero)
-c La premiere contrainte de beta est que le flux eta doit etre positif.
-C
-         DO i=1,klon
-         IF (ldcum(i)) THEN
-            tmp1 = (1.0+gam(i,k))*(sc(i)-sbh(i,kp1) + cldwtr(i))
-     $            - (hbh(i,kp1)-hc(i))*dp(i,k)/dp(i,kp1)
-            tmp2 = (1.0+gam(i,k))*(sc(i)-sbh(i,k))
-            IF ((beta(i)*tmp2-tmp1).GT.0.0) THEN
-               betamx = 0.99*(tmp1/tmp2)
-               beta(i) = MAX(0.0,MIN(betamx,beta(i)))
-            ENDIF
-C
-C Second check involves supersaturation of "detrainment layer"
-C small amount of supersaturation acceptable (by ssfac factor)
-c La 2e contrainte est que la convection ne doit pas sursaturer
-c la "detrainment layer", Neanmoins, une petite sursaturation
-c est acceptee (facteur ssfac).
-C
-            IF (hb(i,km1).lt.hbs(i,km1)) THEN
-               tmp1 = (1.0+gam(i,k))*(sc(i)-sbh(i,kp1) + cldwtr(i))
-     $               - (hbh(i,kp1)-hc(i))*dp(i,k)/dp(i,kp1)
-               tmp1 = tmp1/dp(i,k)
-               tmp2 = gam(i,km1)*(sbh(i,k)-sc(i) + cldwtr(i)) -
-     $                 hbh(i,k) + hc(i) - sc(i) + sbh(i,k)
-               tmp3 = (1.0+gam(i,k))*(sc(i)-sbh(i,k))/dp(i,k)
-               tmp4 = (dt/cats)*(hc(i)-hbs(i,k))*tmp2
-     $               / (dp(i,km1)*(hbs(i,km1)-hb(i,km1))) + tmp3
-               IF ((beta(i)*tmp4-tmp1).GT.0.0) THEN
-                  betamx = ssfac*(tmp1/tmp4)
-                  beta(i)   = MAX(0.0,MIN(betamx,beta(i)))
-               ENDIF
-            ELSE 
-               beta(i) = 0.0
-            ENDIF
-C
-C Third check to avoid introducing 2 delta x thermodynamic
-C noise in the vertical ... constrain adjusted h (or theta e)
-C so that the adjustment doesn't contribute to "kinks" in h
-C
-            g = MIN(0.0,hb(i,k)-hb(i,km1))
-            tmp3 = (hb(i,k)-hb(i,km1)-g)*(cats/dt) / (hc(i)-hbs(i,k))
-            tmp1 = (1.0+gam(i,k))*(sc(i)-sbh(i,kp1) + cldwtr(i))
-     $            - (hbh(i,kp1)-hc(i))*dp(i,k)/dp(i,kp1)
-            tmp1 = tmp1/dp(i,k)
-            tmp1 = tmp3*tmp1 + (hc(i) - hbh(i,kp1))/dp(i,k)
-            tmp2 = tmp3*(1.0+gam(i,k))*(sc(i)-sbh(i,k))/dp(i,k)
-     $            + (hc(i)-hbh(i,k)-cldwtr(i))
-     $             *(1.0/dp(i,k)+1.0/dp(i,kp1))
-            IF ((beta(i)*tmp2-tmp1).GT.0.0) THEN
-               betamx = 0.0
-               IF (tmp2.NE.0.0) betamx = tmp1/tmp2
-               beta(i) = MAX(0.0,MIN(betamx,beta(i)))
-            ENDIF
-         ENDIF
-         ENDDO
-C
-C Calculate mass flux required for stabilization.
-C
-C Ensure that the convective mass flux, eta, is positive by
-C setting negative values of eta to zero..
-C Ensure that estimated mass flux cannot move more than the
-C minimum of total mass contained in either layer k or layer k+1.
-C Also test for other pathological cases that result in non-
-C physical states and adjust eta accordingly.
-C
-   20    CONTINUE
-         DO i=1,klon
-         IF (ldcum(i)) THEN
-            beta(i) = MAX(0.0,beta(i))
-            tmp1 = hc(i) - hbs(i,k)
-            tmp2 = ((1.0+gam(i,k))*(sc(i)-sbh(i,kp1)+cldwtr(i)) -
-     $               beta(i)*(1.0+gam(i,k))*(sc(i)-sbh(i,k)))/dp(i,k) -
-     $              (hbh(i,kp1)-hc(i))/dp(i,kp1)
-            eta(i) = tmp1/(tmp2*RG*cats)
-            tmass = MIN(dp(i,k),dp(i,kp1))/RG
-            IF (eta(i).GT.tmass*rdt .OR. eta(i).LE.0.0) eta(i) = 0.0
-C
-C Check on negative q in top layer (bound beta)
-C
-            IF(shc(i)-shbh(i,k).LT.0.0 .AND. beta(i)*eta(i).NE.0.0)THEN
-               denom = eta(i)*RG*dt*(shc(i) - shbh(i,k))/dp(i,km1)
-               beta(i) = MAX(0.0,MIN(-0.999*shb(i,km1)/denom,beta(i)))
-            ENDIF
-C
-C Check on negative q in middle layer (zero eta)
-C
-            qtest1 = shb(i,k) + eta(i)*RG*dt*((shc(i) - shbh(i,kp1)) -
-     $               (1.0 - beta(i))*cldwtr(i)/RLVTT -
-     $               beta(i)*(shc(i) - shbh(i,k)))/dp(i,k)
-            IF (qtest1.le.0.0) eta(i) = 0.0
-C
-C Check on negative q in lower layer (bound eta)
-C
-            fac1 = -(shbh(i,kp1) - shc(i))/dp(i,kp1)
-            qtest2 = shb(i,kp1) - eta(i)*RG*dt*fac1
-            IF (qtest2 .lt. 0.0) THEN
-               eta(i) = 0.99*shb(i,kp1)/(RG*dt*fac1)
-            ENDIF
-         ENDIF
-         ENDDO
-C
-C
-C Calculate cloud water, rain water, and thermodynamic changes
-C
-         DO 30 i=1,klon
-         IF (ldcum(i)) THEN
-            etagdt = eta(i)*RG*dt
-            cldwtr(i) = etagdt*cldwtr(i)/RLVTT/RG
-            rnwtr(i) = (1.0 - beta(i))*cldwtr(i)
-            ds1(i) = etagdt*(sbh(i,kp1) - sc(i))/dp(i,kp1)
-            dq1(i) = etagdt*(shbh(i,kp1) - shc(i))/dp(i,kp1)
-            ds2(i) = (etagdt*(sc(i) - sbh(i,kp1)) +
-     $                RLVTT*RG*cldwtr(i) - beta(i)*etagdt*
-     $                (sc(i) - sbh(i,k)))/dp(i,k)
-            dq2(i) = (etagdt*(shc(i) - shbh(i,kp1)) -
-     $                RG*rnwtr(i) - beta(i)*etagdt*
-     $                (shc(i) - shbh(i,k)))/dp(i,k)
-            ds3(i) = beta(i)*(etagdt*(sc(i) - sbh(i,k)) -
-     $               RLVTT*RG*cldwtr(i))/dp(i,km1)
-            dq3(i) = beta(i)*etagdt*(shc(i) - shbh(i,k))/dp(i,km1)
-C
-C Isolate convective fluxes for later diagnostics
-C
-            fslkp = eta(i)*(sc(i) - sbh(i,kp1))
-            fslkm = beta(i)*(eta(i)*(sc(i) - sbh(i,k)) -
-     $                       RLVTT*cldwtr(i)*rdt)
-            fqlkp = eta(i)*(shc(i) - shbh(i,kp1))
-            fqlkm = beta(i)*eta(i)*(shc(i) - shbh(i,k))
-C
-C
-C Update thermodynamic profile (update sb, hb, & hbs later)
-C
-            tb (i,kp1) = tb(i,kp1)  + ds1(i) / RCPD
-            tb (i,k  ) = tb(i,k  )  + ds2(i) / RCPD
-            tb (i,km1) = tb(i,km1)  + ds3(i) / RCPD
-            shb(i,kp1) = shb(i,kp1) + dq1(i)
-            shb(i,k  ) = shb(i,k  ) + dq2(i)
-            shb(i,km1) = shb(i,km1) + dq3(i)
-            prec(i)    = prec(i)    + rnwtr(i)/rhoh2o
-C
-C Update diagnostic information for final budget
-C Tracking temperature & specific humidity tendencies,
-C rainout term, convective mass flux, convective liquid
-C water static energy flux, and convective total water flux
-C
-            cmfdt (i,kp1) = cmfdt (i,kp1) + ds1(i)/RCPD*rdt
-            cmfdt (i,k  ) = cmfdt (i,k  ) + ds2(i)/RCPD*rdt
-            cmfdt (i,km1) = cmfdt (i,km1) + ds3(i)/RCPD*rdt
-            cmfdq (i,kp1) = cmfdq (i,kp1) + dq1(i)*rdt
-            cmfdq (i,k  ) = cmfdq (i,k  ) + dq2(i)*rdt
-            cmfdq (i,km1) = cmfdq (i,km1) + dq3(i)*rdt
-            cmfdqr(i,k  ) = cmfdqr(i,k  ) + (RG*rnwtr(i)/dp(i,k))*rdt
-            cmfmc (i,kp1) = cmfmc (i,kp1) + eta(i)
-            cmfmc (i,k  ) = cmfmc (i,k  ) + beta(i)*eta(i)
-            cmfsl (i,kp1) = cmfsl (i,kp1) + fslkp
-            cmfsl (i,k  ) = cmfsl (i,k  ) + fslkm
-            cmflq (i,kp1) = cmflq (i,kp1) + RLVTT*fqlkp
-            cmflq (i,k  ) = cmflq (i,k  ) + RLVTT*fqlkm
-            qc    (i,k  ) =                (RG*rnwtr(i)/dp(i,k))*rdt
-         ENDIF
-   30    CONTINUE
-C
-C Next, convectively modify passive constituents
-C
-         DO 50 m=1,pcnst
-         DO 40 i=1,klon
-         IF (ldcum(i)) THEN
-C
-C If any of the reported values of the constituent is negative in
-C the three adjacent levels, nothing will be done to the profile
-C
-            IF ((cmrb(i,kp1,m).LT.0.0) .OR.
-     $          (cmrb(i,k,m).LT.0.0) .OR.
-     $          (cmrb(i,km1,m).LT.0.0)) GOTO 40
-C
-C Specify constituent interface values (linear interpolation)
-C
-            cmrh(i,k  ) = 0.5*(cmrb(i,km1,m) + cmrb(i,k  ,m))
-            cmrh(i,kp1) = 0.5*(cmrb(i,k  ,m) + cmrb(i,kp1,m))
-C
-C Specify perturbation properties of constituents in PBL
-C
-            pblhgt = MAX(pblh(i),1.0)
-            IF (gz(i,kp1)/RG.LE.pblhgt .AND. dzcld(i).EQ.0.) THEN
-               fac1 = MAX(0.0,1.0-gz(i,kp1)/RG/pblhgt)
-               cmrc(i) = cmrb(i,kp1,m) + cmrp(i,m)*fac1
-            ELSE
-               cmrc(i) = cmrb(i,kp1,m)
-            ENDIF
-C
-C Determine fluxes, flux divergence => changes due to convection
-C Logic must be included to avoid producing negative values. A bit
-C messy since there are no a priori assumptions about profiles.
-C Tendency is modified (reduced) when pending disaster detected.
-C
-            etagdt = eta(i)*RG*dt
-            botflx   = etagdt*(cmrc(i) - cmrh(i,kp1))
-            topflx   = beta(i)*etagdt*(cmrc(i)-cmrh(i,k))
-            dcmr1(i) = -botflx/dp(i,kp1)
-            efac1    = 1.0
-            efac2    = 1.0
-            efac3    = 1.0
-C
-            IF (cmrb(i,kp1,m)+dcmr1(i) .LT. 0.0) THEN
-               efac1 = MAX(tiny,ABS(cmrb(i,kp1,m)/dcmr1(i)) - eps)
-            ENDIF
-C
-            IF (efac1.EQ.tiny .OR. efac1.GT.1.0) efac1 = 0.0
-            dcmr1(i) = -efac1*botflx/dp(i,kp1)
-            dcmr2(i) = (efac1*botflx - topflx)/dp(i,k)
-C  
-            IF (cmrb(i,k,m)+dcmr2(i) .LT. 0.0) THEN
-               efac2 = MAX(tiny,ABS(cmrb(i,k  ,m)/dcmr2(i)) - eps)
-            ENDIF
-C
-            IF (efac2.EQ.tiny .OR. efac2.GT.1.0) efac2 = 0.0
-            dcmr2(i) = (efac1*botflx - efac2*topflx)/dp(i,k)
-            dcmr3(i) = efac2*topflx/dp(i,km1)
-C
-            IF (cmrb(i,km1,m)+dcmr3(i) .LT. 0.0) THEN
-               efac3 = MAX(tiny,ABS(cmrb(i,km1,m)/dcmr3(i)) - eps)
-            ENDIF
-C
-            IF (efac3.EQ.tiny .OR. efac3.GT.1.0) efac3 = 0.0
-            efac3    = MIN(efac2,efac3)
-            dcmr2(i) = (efac1*botflx - efac3*topflx)/dp(i,k)
-            dcmr3(i) = efac3*topflx/dp(i,km1)
-C
-            cmrb(i,kp1,m) = cmrb(i,kp1,m) + dcmr1(i)
-            cmrb(i,k  ,m) = cmrb(i,k  ,m) + dcmr2(i)
-            cmrb(i,km1,m) = cmrb(i,km1,m) + dcmr3(i)
-         ENDIF
-   40    CONTINUE
-   50    CONTINUE              ! end of m=1,pcnst loop
-C
-         IF (k.EQ.limcnv+1) GOTO 60 ! on ne pourra plus glisser
-c
-c Dans la procedure de glissage ascendant, les variables thermo-
-c dynamiques des couches k et km1 servent au calcul des couches
-c superieures. Elles ont donc besoin d'une mise-a-jour.
-C
-         DO i = 1, klon
-         IF (ldcum(i)) THEN
-            zx_t = tb(i,k)
-            zx_p = p(i,k)
-            zx_q = shb(i,k)
-              zdelta=MAX(0.,SIGN(1.,RTT-zx_t))
-              zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
-              zcvm5 = zcvm5 / RCPD / (1.0+RVTMP2*zx_q)
-              zx_qs= r2es * FOEEW(zx_t,zdelta)/zx_p
-              zx_qs=MIN(0.5,zx_qs)
-              zcor=1./(1.-retv*zx_qs)
-              zx_qs=zx_qs*zcor
-              zx_gam = FOEDE(zx_t,zdelta,zcvm5,zx_qs,zcor)
-            shbs(i,k) = zx_qs
-            gam(i,k) = zx_gam
-c
-            zx_t = tb(i,km1)
-            zx_p = p(i,km1)
-            zx_q = shb(i,km1)
-              zdelta=MAX(0.,SIGN(1.,RTT-zx_t))
-              zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
-              zcvm5 = zcvm5 / RCPD / (1.0+RVTMP2*zx_q)
-              zx_qs= r2es * FOEEW(zx_t,zdelta)/zx_p
-              zx_qs=MIN(0.5,zx_qs)
-              zcor=1./(1.-retv*zx_qs)
-              zx_qs=zx_qs*zcor
-              zx_gam = FOEDE(zx_t,zdelta,zcvm5,zx_qs,zcor)
-            shbs(i,km1) = zx_qs
-            gam(i,km1) = zx_gam
-C
-            sb (i,k  ) = sb(i,k  ) + ds2(i)
-            sb (i,km1) = sb(i,km1) + ds3(i)
-            hb (i,k  ) = sb(i,k  ) + RLVTT*shb(i,k)
-            hb (i,km1) = sb(i,km1) + RLVTT*shb(i,km1)
-            hbs(i,k  ) = sb(i,k  ) + RLVTT*shbs(i,k  )
-            hbs(i,km1) = sb(i,km1) + RLVTT*shbs(i,km1)
-C
-            sbh (i,k) = 0.5*(sb(i,k) + sb(i,km1))
-            shbh(i,k) = qhalf(shb(i,km1),shb(i,k)
-     $                       ,shbs(i,km1),shbs(i,k))
-            hbh (i,k) = sbh(i,k) + RLVTT*shbh(i,k)
-            sbh (i,km1) = 0.5*(sb(i,km1) + sb(i,k-2))
-            shbh(i,km1) = qhalf(shb(i,k-2),shb(i,km1),
-     $                    shbs(i,k-2),shbs(i,km1))
-            hbh (i,km1) = sbh(i,km1) + RLVTT*shbh(i,km1)
-         ENDIF
-         ENDDO
-C
-C Ensure that dzcld is reset if convective mass flux zero
-C specify the current vertical extent of the convective activity
-C top of convective layer determined by size of overshoot param.
-C
-   60    CONTINUE
-         DO i=1,klon
-            etagt0 = eta(i).gt.0.0
-            IF (.not.etagt0) dzcld(i) = 0.0
-            IF (etagt0 .and. beta(i).gt.betamn) THEN
-               ktp = km1
-            ELSE
-               ktp = k
-            ENDIF
-            IF (etagt0) THEN
-               cnt(i) = MIN(cnt(i),ktp)
-               cnb(i) = MAX(cnb(i),k)
-            ENDIF
-         ENDDO
-   70 CONTINUE        ! end of k loop
-C
-C determine whether precipitation, prec, is frozen (snow) or not
-C
-      DO i=1,klon
-         IF (tb(i,klev).LT.tmelt .AND. tb(i,klev-1).lt.tmelt) THEN
-             cmfprs(i) = prec(i)*rdt
-         ELSE
-             cmfprt(i) = prec(i)*rdt
-         ENDIF
-      ENDDO
-C
-      RETURN  ! we're all done ... return to calling procedure
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/concvl.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/concvl.F	(revision 416)
+++ 	(revision )
@@ -1,173 +1,0 @@
-      SUBROUTINE concvl (iflag_con,dtime,paprs,pplay,t,q,u,v,tra,ntra,
-     .             work1,work2,d_t,d_q,d_u,d_v,d_tra,
-     .             rain, snow, kbas, ktop,
-     .             upwd,dnwd,dnwdbis,Ma,cape,tvp,iflag,
-     .             pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,
-     .             qcondc,wd)
- 
-c
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
-c Objet: schema de convection de Emanuel (1991) interface
-c======================================================================
-c Arguments:
-c dtime--input-R-pas d'integration (s)
-c s-------input-R-la valeur "s" pour chaque couche
-c sigs----input-R-la valeur "sigma" de chaque couche
-c sig-----input-R-la valeur de "sigma" pour chaque niveau
-c psolpa--input-R-la pression au sol (en Pa)
-C pskapa--input-R-exponentiel kappa de psolpa
-c h-------input-R-enthalpie potentielle (Cp*T/P**kappa)
-c q-------input-R-vapeur d'eau (en kg/kg)
-c
-c work*: input et output: deux variables de travail,
-c                            on peut les mettre a 0 au debut
-c ALE-----input-R-energie disponible pour soulevement
-c
-C d_h-----output-R-increment de l'enthalpie potentielle (h)
-c d_q-----output-R-increment de la vapeur d'eau
-c rain----output-R-la pluie (mm/s)
-c snow----output-R-la neige (mm/s)
-c upwd----output-R-saturated updraft mass flux (kg/m**2/s)
-c dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)
-c dnwd0---output-R-unsaturated downdraft mass flux (kg/m**2/s)
-c Cape----output-R-CAPE (J/kg)
-c Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee
-c                  adiabatiquement a partir du niveau 1 (K)
-c deltapb-output-R-distance entre LCL et base de la colonne (<0 ; Pa)
-c Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de la glace
-c======================================================================
-c
-#include "dimensions.h"
-#include "dimphy.h"
-c
-      integer NTRAC
-      PARAMETER (NTRAC=nqmx-2)
-c
-       INTEGER iflag_con
-c
-       REAL dtime, paprs(klon,klev+1),pplay(klon,klev)
-       REAL t(klon,klev),q(klon,klev),u(klon,klev),v(klon,klev)
-       REAL tra(klon,klev,ntrac)
-       INTEGER ntra
-       REAL work1(klon,klev),work2(klon,klev)
-c
-       REAL d_t(klon,klev),d_q(klon,klev),d_u(klon,klev),d_v(klon,klev)
-       REAL d_tra(klon,klev,ntrac)
-       REAL rain(klon),snow(klon)
-c
-       INTEGER kbas(klon),ktop(klon)
-       REAL em_ph(klon,klev+1),em_p(klon,klev)
-       REAL upwd(klon,klev),dnwd(klon,klev),dnwdbis(klon,klev)
-       REAL Ma(klon,klev),cape(klon),tvp(klon,klev)
-       INTEGER iflag(klon)
-       REAL rflag(klon)
-       REAL pbase(klon),bbase(klon)
-       REAL dtvpdt1(klon,klev),dtvpdq1(klon,klev)
-       REAL dplcldt(klon),dplcldr(klon)
-       REAL qcondc(klon,klev)
-       REAL wd(klon)
-c
-       REAL zx_t,zdelta,zx_qs,zcor
-c
-       INTEGER noff, minorig
-       INTEGER i,k,itra
-       REAL qs(klon,klev)
-       REAL cbmf(klon)
-       SAVE cbmf
-       INTEGER ifrst
-       SAVE ifrst
-       DATA ifrst /0/
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-c
-c
-      IF (ifrst .EQ. 0) THEN
-         ifrst = 1
-         DO i = 1, klon
-          cbmf(i) = 0.
-         ENDDO
-      ENDIF
-
-      DO k = 1, klev+1
-         DO i=1,klon
-         em_ph(i,k) = paprs(i,k) / 100.0
-      ENDDO
-      ENDDO
-c
-      DO k = 1, klev
-         DO i=1,klon
-         em_p(i,k) = pplay(i,k) / 100.0
-      ENDDO
-      ENDDO
-
-c
-      if (iflag_con .eq. 4) then
-      DO k = 1, klev
-        DO i = 1, klon
-         zx_t = t(i,k)
-         zdelta=MAX(0.,SIGN(1.,rtt-zx_t))
-         zx_qs= MIN(0.5 , r2es * FOEEW(zx_t,zdelta)/em_p(i,k)/100.0)
-         zcor=1./(1.-retv*zx_qs)
-         qs(i,k)=zx_qs*zcor
-        ENDDO
-      ENDDO
-      else ! iflag_con=3 (modif de puristes qui fait la diffce pour la convergence numerique)
-      DO k = 1, klev
-        DO i = 1, klon
-         zx_t = t(i,k)
-         zdelta=MAX(0.,SIGN(1.,rtt-zx_t))
-         zx_qs= r2es * FOEEW(zx_t,zdelta)/em_p(i,k)/100.0
-         zx_qs= MIN(0.5,zx_qs)
-         zcor=1./(1.-retv*zx_qs)
-         zx_qs=zx_qs*zcor
-         qs(i,k)=zx_qs
-        ENDDO
-      ENDDO
-      endif ! iflag_con
-c
-C------------------------------------------------------------------
-
-C Main driver for convection:
-C		iflag_con = 3  -> equivalent to convect3
-C		iflag_con = 4  -> equivalent to convect1/2
-
-      CALL cv_driver(klon,klev,klev+1,ntra,iflag_con,
-     :              t,q,qs,u,v,tra,
-     $              em_p,em_ph,iflag,
-     $              d_t,d_q,d_u,d_v,d_tra,rain,
-     $              cbmf,work1,work2,
-     $              dtime,Ma,upwd,dnwd,dnwdbis,qcondc,wd,cape)
-
-C------------------------------------------------------------------
-
-      DO i = 1,klon
-        rain(i) = rain(i)/86400.
-        rflag(i)=iflag(i)
-      ENDDO
-
-      DO k = 1, klev
-        DO i = 1, klon
-           d_t(i,k) = dtime*d_t(i,k)
-           d_q(i,k) = dtime*d_q(i,k)
-           d_u(i,k) = dtime*d_u(i,k)
-           d_v(i,k) = dtime*d_v(i,k)
-        ENDDO
-      ENDDO
- 
-c les traceurs ne sont pas mis dans cette version de convect4:
-      if (iflag_con.eq.4) then
-       DO itra = 1,ntra
-        DO k = 1, klev
-         DO i = 1, klon
-            d_tra(i,k,itra) = 0.
-         ENDDO
-        ENDDO
-       ENDDO
-      endif
- 
-      RETURN
-      END
- 
Index: LMDZ.3.3/branches/rel-/libf/phylmd/condsurf.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/condsurf.F	(revision 416)
+++ 	(revision )
@@ -1,299 +1,0 @@
-c $Header$
-c
-      SUBROUTINE condsurf( jour, jourvrai, pctsrf,
-     s                    lmt_sst,lmt_alb,lmt_rug,lmt_bils )
-      IMPLICIT none
-c
-c Lire les conditions aux limites du modele.
-c -----------------------------------------
-c jour     : input  , numero du jour a lire
-c jourvrai : input  , vrai jour de la simulation  
-c
-c pctsrf:  sous-maille fractionnelle, la somme doit = 1
-c lmt_sst: temperature de la surface oceanique
-c lmt_alb: albedo du sol
-c lmt_rug: longeur de rugosite du sol
-c lmt_bils: bilan chaleur au sol (a utiliser pour "slab-ocean")
-c
-#include "netcdf.inc"
-      INTEGER nid, nvarid
-      INTEGER debut(2)
-      INTEGER epais(2)
-      INTEGER lnblnk
-      EXTERNAL lnblnk
-c
-#include "dimensions.h"
-#include "dimphy.h"
-#include "indicesol.h"
-#include "temps.h"
-#include "clesphys.h"
-c
-c newlmt indique l'utilisation de la sous-maille fractionnelle,
-c tandis que l'ancien regime utilisait l'indicateur du sol (0,1,2,3).
-
-      LOGICAL newlmt
-      PARAMETER (newlmt=.FALSE.)
-
-      INTEGER     nannemax
-      PARAMETER ( nannemax = 60 )
-c
-      INTEGER jour,jourvrai
-      REAL lmt_nat(klon) ! indicateur de la nature du sol
-      REAL pctsrf(klon,nbsrf) ! sous-maille fractionnelle
-      REAL lmt_sst(klon) ! temperature de la surface oceanique
-      REAL lmt_alb(klon) ! albedo du sol
-      REAL lmt_rug(klon) ! longeur de rugosite du sol
-      REAL lmt_bils(klon)
-c
-c Variables locales:
-      INTEGER ig, i, j, kt, ierr
-      LOGICAL ok
-      INTEGER anneelim,anneemax
-      CHARACTER*20 fich
-cc
-cc   .....................................................................
-cc
-cc    Pour lire le fichier limit correspondant vraiment  a l'annee de la
-cc     simulation en cours , il suffit de mettre  ok_limitvrai = .TRUE.
-cc
-cc   ......................................................................
-c
-c
-      IF (jour.LT.0 .OR. jour.GT.(360-1)) THEN
-         PRINT*,'Le jour demande n est pas correct: ', jour
-         CALL ABORT
-      ENDIF
-c
-c  .............   modif  (  P. Le Van )  ...........
-
-       anneelim  = anne_ini
-       anneemax  = anne_ini + nannemax
-c
-c
-       IF( ok_limitvrai )       THEN
-          DO  kt = 1, nannemax
-            IF(jourvrai.LE. (kt-1)*360 + 359  )  THEN
-              WRITE(fich,'("limit",i4,".nc")') anneelim
-              PRINT *,' Fichier  Limite ',fich
-              GO TO 100
-             ENDIF
-           anneelim = anneelim + 1
-          ENDDO
-
-         PRINT *,' PBS ! Le jour a lire sur le fichier limit ne se '
-         PRINT *,' trouve pas sur les ',nannemax,' annees a partir de '
-         PRINT *,' l annee de debut', anne_ini
-           CALL EXIT(1)
-c
-100     CONTINUE
-c
-       ELSE
-     
-            WRITE(fich,'("limit.nc")') 
-            PRINT *,' Fichier  Limite ',fich
-       ENDIF
-c
-c  ........... ( fin   modif   P. Le Van  ) ............
-c
-c Ouvrir le fichier en format NetCDF:
-c
-      ierr = NF_OPEN (fich, NF_NOWRITE,nid)
-      IF (ierr.NE.NF_NOERR) THEN
-        WRITE(6,*)' Pb d''ouverture du fichier ', fich
-        WRITE(6,*)' Le fichier limit ',fich,' (avec 4 chiffres , pour' 
-        WRITE(6,*)'       l an 2000 )  ,  n existe  pas !  ' 
-        WRITE(6,*)' ierr = ', ierr
-        CALL EXIT(1)
-      ENDIF
-c
-c La tranche de donnees a lire:
-c
-      debut(1) = 1
-      debut(2) = jour + 1
-      epais(1) = klon
-      epais(2) = 1
-c
-      IF (newlmt) THEN
-c
-c Fraction "ocean":
-      ierr = NF_INQ_VARID (nid, "FOCE", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "condsurf: Le champ <FOCE> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid,nvarid,debut,epais,pctsrf(1,is_oce))
-#else
-      ierr = NF_GET_VARA_REAL(nid,nvarid,debut,epais,pctsrf(1,is_oce))
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "condsurf: Lecture echouee pour <FOCE>"
-         CALL abort
-      ENDIF
-c
-c Fraction "glace de mer":
-      ierr = NF_INQ_VARID (nid, "FSIC", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "condsurf: Le champ <FSIC> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid,nvarid,debut,epais,pctsrf(1,is_sic))
-#else
-      ierr = NF_GET_VARA_REAL(nid,nvarid,debut,epais,pctsrf(1,is_sic))
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "condsurf: Lecture echouee pour <FSIC>"
-         CALL abort
-      ENDIF
-c
-c Fraction "terre":
-      ierr = NF_INQ_VARID (nid, "FTER", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "condsurf: Le champ <FTER> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid,nvarid,debut,epais,pctsrf(1,is_ter))
-#else
-      ierr = NF_GET_VARA_REAL(nid,nvarid,debut,epais,pctsrf(1,is_ter))
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "condsurf: Lecture echouee pour <FTER>"
-         CALL abort
-      ENDIF
-c
-c Fraction "glacier terre":
-      ierr = NF_INQ_VARID (nid, "FLIC", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "condsurf: Le champ <FLIC> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid,nvarid,debut,epais,pctsrf(1,is_lic))
-#else
-      ierr = NF_GET_VARA_REAL(nid,nvarid,debut,epais,pctsrf(1,is_lic))
-#endif
-      IF (ierr .NE. 0) THEN
-         PRINT*, "condsurf: Lecture echouee pour <FLIC>"
-         CALL abort
-      ENDIF
-c
-      ELSE ! test sur newlmt
-c
-c Indicateur de la nature du sol (0,1,2,3):
-      ierr = NF_INQ_VARID (nid, "NAT", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "condsurf: Le champ <NAT> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,debut,epais,lmt_nat)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,debut,epais,lmt_nat)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "condsurf: Lecture echouee pour <NAT>"
-         CALL abort
-      ENDIF
-c
-      DO ig = 1, klon
-         pctsrf(ig,is_oce) = 0.0
-         pctsrf(ig,is_ter) = 0.0
-         pctsrf(ig,is_lic) = 0.0
-         pctsrf(ig,is_sic) = 0.0
-      ENDDO
-      ok = .TRUE.
-      DO ig = 1, klon
-      IF (NINT(lmt_nat(ig)).EQ.0) THEN
-         pctsrf(ig,is_oce) = 1.0
-      ELSE IF (NINT(lmt_nat(ig)).EQ.1) THEN
-         pctsrf(ig,is_ter) = 1.0
-      ELSE IF (NINT(lmt_nat(ig)).EQ.2) THEN
-         pctsrf(ig,is_lic) = 1.0
-      ELSE IF (NINT(lmt_nat(ig)).EQ.3) THEN
-         pctsrf(ig,is_sic) = 1.0
-      ELSE
-         ok = .FALSE.
-      ENDIF
-      ENDDO
-      IF (.NOT.ok) THEN
-         PRINT*, "valeur fausse pour lmt_nat:", lmt_nat
-         CALL abort
-      ENDIF
-c
-      ENDIF ! fin de test sur newlmt
-c
-c Sea surface temperature:
-      ierr = NF_INQ_VARID (nid, "SST", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "condsurf: Le champ <SST> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,debut,epais,lmt_sst)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,debut,epais,lmt_sst)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "condsurf: Lecture echouee pour <SST>"
-         CALL abort
-      ENDIF
-c
-c Albedo de surface:
-      ierr = NF_INQ_VARID (nid, "ALB", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "condsurf: Le champ <ALB> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,debut,epais,lmt_alb)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,debut,epais,lmt_alb)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "condsurf: Lecture echouee pour <ALB>"
-         CALL abort
-      ENDIF
-c
-c Longueur de rugosite au sol:
-      ierr = NF_INQ_VARID (nid, "RUG", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "condsurf: Le champ <RUG> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,debut,epais,lmt_rug)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,debut,epais,lmt_rug)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "condsurf: Lecture echouee pour <RUG>"
-         CALL abort
-      ENDIF
-c
-c Bilan flux de chaleur au sol:
-      ierr = NF_INQ_VARID (nid, "BILS", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "condsurf: Le champ <BILS> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,debut,epais,lmt_bils)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,debut,epais,lmt_bils)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "condsurf: Lecture echouee pour <BILS>"
-         CALL abort
-      ENDIF
-c
-c Fermer le fichier:
-c
-      ierr = NF_CLOSE(nid)
-c
-c
-      PRINT*, 'SST, ALB, RUG, etc. sont lus pour jour: ', jour
-c
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/conema3.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/conema3.F	(revision 416)
+++ 	(revision )
@@ -1,281 +1,0 @@
-c $Header$
-      SUBROUTINE conema (dtime,paprs,pplay,t,q,u,v,tra,ntra,
-     .             work1,work2,d_t,d_q,d_u,d_v,d_tra,
-     .             rain, snow, kbas, ktop,
-     .             upwd,dnwd,dnwdbis,bas,top,Ma,cape,tvp,rflag,
-     .             pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr)
-
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
-c Objet: schema de convection de Emanuel (1991) interface
-c Mai 1998: Interface modifiee pour implementation dans LMDZ
-c======================================================================
-c Arguments:
-c dtime---input-R-pas d'integration (s)
-c paprs---input-R-pression inter-couches (Pa)
-c pplay---input-R-pression au milieu des couches (Pa)
-c t-------input-R-temperature (K)
-c q-------input-R-humidite specifique (kg/kg)
-c u-------input-R-vitesse du vent zonal (m/s)
-c v-------input-R-vitesse duvent meridien (m/s)
-c tra-----input-R-tableau de rapport de melange des traceurs
-c work*: input et output: deux variables de travail,
-c                            on peut les mettre a 0 au debut
-c
-C d_t-----output-R-increment de la temperature
-c d_q-----output-R-increment de la vapeur d'eau
-c d_u-----output-R-increment de la vitesse zonale
-c d_v-----output-R-increment de la vitesse meridienne
-c d_tra---output-R-increment du contenu en traceurs
-c rain----output-R-la pluie (mm/s)
-c snow----output-R-la neige (mm/s)
-c kbas----output-R-bas du nuage (integer)
-c ktop----output-R-haut du nuage (integer)
-c upwd----output-R-saturated updraft mass flux (kg/m**2/s)
-c dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)
-c dnwdbis-output-R-unsaturated downdraft mass flux (kg/m**2/s)
-c bas-----output-R-bas du nuage (real)
-c top-----output-R-haut du nuage (real)
-c Ma------output-R-flux ascendant non dilue (kg/m**2/s)
-c cape----output-R-CAPE
-c tvp-----output-R-virtual temperature of the lifted parcel
-c rflag---output-R-flag sur le fonctionnement de convect
-c pbase---output-R-pression a la base du nuage (Pa)
-c bbase---output-R-buoyancy a la base du nuage (K)
-c dtvpdt1-output-R-derivative of parcel virtual temp wrt T1 
-c dtvpdq1-output-R-derivative of parcel virtual temp wrt Q1 
-c dplcldt-output-R-derivative of the PCP pressure wrt T1
-c dplcldr-output-R-derivative of the PCP pressure wrt Q1
-c======================================================================
-c
-#include "dimensions.h"
-#include "dimphy.h"
-      INTEGER i, l,m,itra
-      INTEGER ntra,ntrac !number of tracers; if no tracer transport
-                         ! is needed, set ntra = 1 (or 0)
-      PARAMETER (ntrac=nqmx-2)
-      REAL dtime
-c
-
-c 
-      REAL paprs(klon,klev+1), pplay(klon,klev)
-      REAL t(klon,klev), q(klon,klev), d_t(klon,klev), d_q(klon,klev)
-      REAL u(klon,klev), v(klon,klev), tra(klon,klev,ntra)
-      REAL d_u(klon,klev), d_v(klon,klev), d_tra(klon,klev,ntra)
-      REAL work1(klon,klev), work2(klon,klev)
-      REAL upwd(klon,klev), dnwd(klon,klev), dnwdbis(klon,klev)
-      REAL rain(klon)
-      REAL snow(klon)
-      REAL cape(klon), tvp(klon,klev), rflag(klon)
-      REAL pbase(klon), bbase(klon)
-      REAL dtvpdt1(klon,klev), dtvpdq1(klon,klev)
-      REAL dplcldt(klon), dplcldr(klon)
-      INTEGER kbas(klon), ktop(klon)
-c
-      REAL em_t(klev)
-      REAL em_q(klev)
-      REAL em_qs(klev)
-      REAL em_u(klev), em_v(klev), em_tra(klev,ntrac)
-      REAL em_ph(klev+1), em_p(klev)
-      REAL em_work1(klev), em_work2(klev)
-      REAL em_precip, em_d_t(klev), em_d_q(klev)
-      REAL em_d_u(klev), em_d_v(klev), em_d_tra(klev,ntrac)
-      REAL em_upwd(klev), em_dnwd(klev), em_dnwdbis(klev)
-      REAL em_dtvpdt1(klev), em_dtvpdq1(klev)
-      REAL em_dplcldt, em_dplcldr
-      SAVE em_t,em_q, em_qs, em_ph, em_p, em_work1, em_work2
-      SAVE em_u,em_v, em_tra
-      SAVE em_d_u,em_d_v, em_d_tra
-      SAVE em_precip, em_d_t, em_d_q, em_upwd, em_dnwd, em_dnwdbis
-      INTEGER em_bas, em_top
-      SAVE em_bas, em_top
-c
-      REAL zx_t, zx_qs, zdelta, zcor
-      INTEGER iflag
-      REAL sigsum
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-c     VARIABLES A SORTIR
-cccccccccccccccccccccccccccccccccccccccccccccccccc
- 
-      REAL emmip(klev) !variation de flux ascnon dilue i et i+1
-      SAVE emmip
-      real emMke(klev)
-      save emMke
-      real top
-      real bas
-      real emMa(klev)
-      save emMa
-      real Ma(klon,klev)
-      real Ment(klev,klev)
-      real Qent(klev,klev)
-      real TPS(klev),TLS(klev)
-      real SIJ(klev,klev)
-      real em_CAPE, em_TVP(klev)
-      real em_pbase, em_bbase
-      integer iw,j,k,ix,iy
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-c
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
- 
-c
-c$$$      print*,'debut conema'
-
-      DO 999 i = 1, klon
-      DO l = 1, klev+1
-         em_ph(l) = paprs(i,l) / 100.0
-      ENDDO
-c
-      DO l = 1, klev
-         em_p(l) = pplay(i,l) / 100.0
-         em_t(l) = t(i,l)
-         em_q(l) = q(i,l)
-         em_u(l) = u(i,l)
-         em_v(l) = v(i,l)
-         do itra = 1, ntra
-          em_tra(l,itra) = tra(i,l,itra)
-         enddo
-c$$$      print*,'em_t',em_t
-c$$$      print*,'em_q',em_q
-c$$$      print*,'em_qs',em_qs
-c$$$      print*,'em_u',em_u
-c$$$      print*,'em_v',em_v
-c$$$      print*,'em_tra',em_tra
-c$$$      print*,'em_p',em_p
-
- 
-c
-         zx_t = em_t(l)
-         zdelta=MAX(0.,SIGN(1.,rtt-zx_t))
-         zx_qs= r2es * FOEEW(zx_t,zdelta)/em_p(l)/100.0
-         zx_qs=MIN(0.5,zx_qs)
-c$$$       print*,'zx_qs',zx_qs
-         zcor=1./(1.-retv*zx_qs) 
-         zx_qs=zx_qs*zcor
-         em_qs(l) = zx_qs
-c$$$      print*,'em_qs',em_qs
-c
-         em_work1(l) = work1(i,l)
-         em_work2(l) = work2(i,l)
-         emMke(l)=0
-c        emMa(l)=0
-c        Ma(i,l)=0
-     
-         em_dtvpdt1(l) = 0.
-         em_dtvpdq1(l) = 0.
-         dtvpdt1(i,l) = 0.
-         dtvpdq1(i,l) = 0.
-      ENDDO
-c
-      em_dplcldt = 0.
-      em_dplcldr = 0.
-      rain(i) = 0.0
-      snow(i) = 0.0
-      kbas(i) = 1
-      ktop(i) = 1
-c ajout SB:
-      bas = 1
-      top = 1
- 
- 
-c sb3d      write(*,1792) (em_work1(m),m=1,klev)
-1792  format('sig avant convect ',/,10(1X,E13.5))
-c
-c sb d      write(*,1793) (em_work2(m),m=1,klev)
-1793  format('w avant convect ',/,10(1X,E13.5))
- 
-c$$$      print*,'avant convect' 
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-c 
-      CALL convect(dtime, em_t, em_q, em_qs,em_u ,em_v ,
-     .              em_tra, em_p, em_ph,
-     .              klev, klev+1, klev-1,ntra, dtime, iflag,
-     .              em_d_t, em_d_q,em_d_u,em_d_v,
-     .              em_d_tra, em_precip,
-     .              em_bas, em_top,em_upwd, em_dnwd, em_dnwdbis,
-     .              em_work1, em_work2,emmip,emMke,emMa,Ment,
-c SB 11sept98     .              Qent,TPS,TLS,SIJ)
-c 19oct98     .              Qent,TPS,TLS,SIJ,em_CAPE,em_TVP)
-     .  Qent,TPS,TLS,SIJ,em_CAPE,em_TVP,em_pbase,em_bbase,
-     .  em_dtvpdt1,em_dtvpdq1,em_dplcldt,em_dplcldr)
-c
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-c
-c SB:
-      if (iflag.ne.1 .and. iflag.ne.4) then
-         em_CAPE = 0.
-      do l = 1, klev
-         em_upwd(l) = 0.
-         em_dnwd(l) = 0.
-         em_dnwdbis(l) = 0.
-         emMa(l) = 0.
-         em_TVP(l) = 0.
-      enddo
-      endif
-c fin SB
-c
-c  If sig has been set to zero, then set Ma to zero
-c
-      sigsum = 0.
-      do k = 1,klev
-        sigsum = sigsum + em_work1(k)
-      enddo
-      if (sigsum .eq. 0.0) then
-        do k = 1,klev
-          emMa(k) = 0.
-        enddo
-      endif
-c
-c sb3d       print*,'i, iflag=',i,iflag
-c 
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-c
-c       SORTIE DES ICB ET INB
-c       en fait inb et icb correspondent au niveau ou se trouve
-c       le nuage,le numero d'interface
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- 
-c modif SB:
-      if (iflag.EQ.1 .or. iflag.EQ.4) then
-       top=em_top
-       bas=em_bas
-       kbas(i) = em_bas
-       ktop(i) = em_top
-      endif
- 
-      pbase(i) = em_pbase
-      bbase(i) = em_bbase
-      rain(i) = em_precip/ 86400.0
-      snow(i) = 0.0
-      cape(i) = em_CAPE
-      rflag(i) = float(iflag)
-c SB      kbas(i) = em_bas
-c SB      ktop(i) = em_top
-      dplcldt(i) = em_dplcldt
-      dplcldr(i) = em_dplcldr
-      DO l = 1, klev
-         d_t(i,l) = dtime * em_d_t(l) 
-         d_q(i,l) = dtime * em_d_q(l)
-         d_u(i,l) = dtime * em_d_u(l)
-         d_v(i,l) = dtime * em_d_v(l)
-         do itra = 1, ntra
-         d_tra(i,l,itra) = dtime * em_d_tra(l,itra)
-         enddo
-         upwd(i,l) = em_upwd(l)
-         dnwd(i,l) = em_dnwd(l)
-         dnwdbis(i,l) = em_dnwdbis(l)
-         work1(i,l) = em_work1(l)
-         work2(i,l) = em_work2(l)
-         Ma(i,l)=emMa(l)
-         tvp(i,l)=em_TVP(l)
-         dtvpdt1(i,l) = em_dtvpdt1(l)
-         dtvpdq1(i,l) = em_dtvpdq1(l)
-      ENDDO
-  999 CONTINUE
- 
-
-      RETURN
-      END
-
Index: LMDZ.3.3/branches/rel-/libf/phylmd/conema3.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/conema3.h	(revision 416)
+++ 	(revision )
@@ -1,5 +1,0 @@
-      real epmax             ! 0.993
-      logical ok_adj_ema      ! F
-      integer iflag_clw      ! 0
-
-      common/comconema/epmax,ok_adj_ema,iflag_clw
Index: LMDZ.3.3/branches/rel-/libf/phylmd/conemav.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/conemav.F	(revision 416)
+++ 	(revision )
@@ -1,147 +1,0 @@
-      SUBROUTINE conemav (dtime,paprs,pplay,t,q,u,v,tra,ntra,
-     .             work1,work2,d_t,d_q,d_u,d_v,d_tra,
-     .             rain, snow, kbas, ktop,
-     .             upwd,dnwd,dnwdbis,Ma,cape,tvp,iflag,
-     .             pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr)
- 
-c
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
-c Objet: schema de convection de Emanuel (1991) interface
-c======================================================================
-c Arguments:
-c dtime--input-R-pas d'integration (s)
-c s-------input-R-la valeur "s" pour chaque couche
-c sigs----input-R-la valeur "sigma" de chaque couche
-c sig-----input-R-la valeur de "sigma" pour chaque niveau
-c psolpa--input-R-la pression au sol (en Pa)
-C pskapa--input-R-exponentiel kappa de psolpa
-c h-------input-R-enthalpie potentielle (Cp*T/P**kappa)
-c q-------input-R-vapeur d'eau (en kg/kg)
-c
-c work*: input et output: deux variables de travail,
-c                            on peut les mettre a 0 au debut
-c ALE-----input-R-energie disponible pour soulevement
-c
-C d_h-----output-R-increment de l'enthalpie potentielle (h)
-c d_q-----output-R-increment de la vapeur d'eau
-c rain----output-R-la pluie (mm/s)
-c snow----output-R-la neige (mm/s)
-c upwd----output-R-saturated updraft mass flux (kg/m**2/s)
-c dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)
-c dnwd0---output-R-unsaturated downdraft mass flux (kg/m**2/s)
-c Cape----output-R-CAPE (J/kg)
-c Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee
-c                  adiabatiquement a partir du niveau 1 (K)
-c deltapb-output-R-distance entre LCL et base de la colonne (<0 ; Pa)
-c Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de la glace
-c======================================================================
-c
-#include "dimensions.h"
-#include "dimphy.h"
-c
-      integer NTRAC
-      PARAMETER (NTRAC=nqmx-2)
-c
-       REAL dtime, paprs(klon,klev+1),pplay(klon,klev)
-       REAL t(klon,klev),q(klon,klev),u(klon,klev),v(klon,klev)
-       REAL tra(klon,klev,ntrac)
-       INTEGER ntra
-       REAL work1(klon,klev),work2(klon,klev)
-c
-       REAL d_t(klon,klev),d_q(klon,klev),d_u(klon,klev),d_v(klon,klev)
-       REAL d_tra(klon,klev,ntrac)
-       REAL rain(klon),snow(klon)
-c
-       INTEGER kbas(klon),ktop(klon)
-       REAL em_ph(klon,klev+1),em_p(klon,klev)
-       REAL upwd(klon,klev),dnwd(klon,klev),dnwdbis(klon,klev)
-       REAL Ma(klon,klev),cape(klon),tvp(klon,klev)
-       INTEGER iflag(klon)
-       REAL rflag(klon)
-       REAL pbase(klon),bbase(klon)
-       REAL dtvpdt1(klon,klev),dtvpdq1(klon,klev)
-       REAL dplcldt(klon),dplcldr(klon)
-c
-       REAL zx_t,zdelta,zx_qs,zcor
-c
-       INTEGER noff, minorig
-       INTEGER i,k,itra
-       REAL qs(klon,klev)
-       REAL cbmf(klon)
-       SAVE cbmf
-       INTEGER ifrst
-       SAVE ifrst
-       DATA ifrst /0/
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-c
-c
-      IF (ifrst .EQ. 0) THEN
-         ifrst = 1
-         DO i = 1, klon
-          cbmf(i) = 0.
-         ENDDO
-      ENDIF
-
-      DO k = 1, klev+1
-         DO i=1,klon
-         em_ph(i,k) = paprs(i,k) / 100.0
-      ENDDO
-      ENDDO
-c
-      DO k = 1, klev
-         DO i=1,klon
-         em_p(i,k) = pplay(i,k) / 100.0
-      ENDDO
-      ENDDO
-
-c
-      DO k = 1, klev
-        DO i = 1, klon
-         zx_t = t(i,k)
-         zdelta=MAX(0.,SIGN(1.,rtt-zx_t))
-         zx_qs= MIN(0.5 , r2es * FOEEW(zx_t,zdelta)/em_p(i,k)/100.0)
-         zcor=1./(1.-retv*zx_qs)
-         qs(i,k)=zx_qs*zcor
-        ENDDO
-      ENDDO
-c
-      noff = 2
-      minorig = 2
-      CALL convect1(klon,klev,klev+1,noff,minorig,t,q,qs,u,v,
-     $              em_p,em_ph,iflag,
-     $              d_t,d_q,d_u,d_v,rain,cbmf,dtime,Ma)
-c
-      DO i = 1,klon
-        rain(i) = rain(i)/86400.
-        rflag(i)=iflag(i)
-      ENDDO
-c      call dump2d(iim,jjm-1,rflag(2:klon-1),'FLAG CONVECTION   ')
-c     if (klon.eq.1) then
-c        print*,'IFLAG ',iflag
-c     else
-c        write(*,'(96i1)') (iflag(i),i=2,klon-1)
-c     endif
-      DO k = 1, klev
-        DO i = 1, klon
-           d_t(i,k) = dtime*d_t(i,k)
-           d_q(i,k) = dtime*d_q(i,k)
-           d_u(i,k) = dtime*d_u(i,k)
-           d_v(i,k) = dtime*d_v(i,k)
-        ENDDO
-        DO itra = 1,ntra
-          DO i = 1, klon
-            d_tra(i,k,itra) = 0.
-          ENDDO
-        ENDDO
-      ENDDO
- 
-c
-c
-c
-      RETURN
-      END
- 
Index: LMDZ.3.3/branches/rel-/libf/phylmd/conf_phys.F90
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/conf_phys.F90	(revision 416)
+++ 	(revision )
@@ -1,97 +1,0 @@
-!
-! $Header$
-!
-
-  subroutine conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, ok_instan)
-
-   use IOIPSL
-   implicit none
-
-!
-! Configuration de la "physique" de LMDZ a l'aide de la fonction
-! GETIN de IOIPSL
-!
-! LF 05/2001
-!
-
-!
-! ocean:      type d'ocean (force, slab, couple)
-! ok_veget:   type de modele de vegetation
-! ok_journe:  sorties journalieres
-! ok_mensuel: sorties mensuelles
-! ok_instan:  sorties instantanees
-
-
-
-! Sortie:
-  character (len = 6)  :: ocean
-  logical              :: ok_veget
-  logical              :: ok_journe, ok_mensuel, ok_instan
-! Local
-  integer              :: numout = 6
-
-!
-!
-!
-
-
-!Config Key  = OCEAN 
-!Config Desc = Type d'ocean
-!Config Def  = force
-!Config Help = Type d'ocean utilise: force, slab,couple
-!
-  ocean = 'force '
-  call getin('OCEAN', ocean)
-!
-!Config Key  = VEGET 
-!Config Desc = Type de modele de vegetation
-!Config Def  = .false.
-!Config Help = Type de modele de vegetation utilise
-!
-  ok_veget = .false.
-  call getin('VEGET', ok_veget)
-!
-!Config Key  = OK_journe
-!Config Desc = Pour des sorties journalieres 
-!Config Def  = .false.
-!Config Help = Pour creer le fichier histday contenant les sorties
-!              journalieres 
-!
-  ok_journe = .false.
-  call getin('OK_journe', ok_journe)
-!
-!Config Key  = OK_mensuel
-!Config Desc = Pour des sorties mensuelles 
-!Config Def  = .true.
-!Config Help = Pour creer le fichier histmth contenant les sorties
-!              mensuelles 
-!
-  ok_mensuel = .true.
-  call getin('OK_mensuel', ok_mensuel)
-!
-!Config Key  = OK_instan
-!Config Desc = Pour des sorties instantanees 
-!Config Def  = .false.
-!Config Help = Pour creer le fichier histins contenant les sorties
-!              instantanees 
-!
-  ok_instan = .false.
-  call getin('OK_instan', ok_instan)
-
-!
-!
-!
-
-  write(numout,*)' ##############################################'
-  write(numout,*)' Configuration des parametres de la physique: '
-  write(numout,*)' Config ocean = ', ocean
-  write(numout,*)' Config veget = ', ok_veget
-  write(numout,*)' Sortie journaliere = ', ok_journe
-  write(numout,*)' Sortie mensuelle = ', ok_mensuel
-  write(numout,*)' Sortie instantanee = ', ok_instan
-
-
-  return
-
-  end subroutine conf_phys
-
Index: LMDZ.3.3/branches/rel-/libf/phylmd/conflx.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/conflx.F	(revision 416)
+++ 	(revision )
@@ -1,1660 +1,0 @@
-      SUBROUTINE conflx (dtime,pres_h,pres_f,
-     e                   t, q, con_t, con_q, pqhfl, w,
-     s                   d_t, d_q, rain, snow,
-     s                   pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
-     s                   kcbot, kctop, kdtop, pmflxr, pmflxs)
-c
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS) date: 19941014
-c Objet: Schema flux de masse pour la convection 
-c        (schema de Tiedtke avec qqs modifications mineures)
-c Dec.97: Prise en compte des modifications introduites par
-c         Olivier Boucher et Alexandre Armengaud pour melange
-c         et lessivage des traceurs passifs.
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "YOETHF.h"
-c Entree:
-      REAL dtime            ! pas d'integration (s)
-      REAL pres_h(klon,klev+1) ! pression half-level (Pa)
-      REAL pres_f(klon,klev)! pression full-level (Pa)
-      REAL t(klon,klev)     ! temperature (K)
-      REAL q(klon,klev)     ! humidite specifique (g/g)
-      REAL w(klon,klev)     ! vitesse verticale (Pa/s)
-      REAL con_t(klon,klev) ! convergence de temperature (K/s)
-      REAL con_q(klon,klev) ! convergence de l'eau vapeur (g/g/s)
-      REAL pqhfl(klon)      ! evaporation (negative vers haut) mm/s
-c Sortie:
-      REAL d_t(klon,klev)   ! incrementation de temperature
-      REAL d_q(klon,klev)   ! incrementation d'humidite
-      REAL pmfu(klon,klev)  ! flux masse (kg/m2/s) panache ascendant
-      REAL pmfd(klon,klev)  ! flux masse (kg/m2/s) panache descendant
-      REAL pen_u(klon,klev)
-      REAL pen_d(klon,klev)
-      REAL pde_u(klon,klev)
-      REAL pde_d(klon,klev)
-      REAL rain(klon)       ! pluie (mm/s)
-      REAL snow(klon)       ! neige (mm/s)
-      REAL pmflxr(klon,klev+1)
-      REAL pmflxs(klon,klev+1)
-      INTEGER kcbot(klon)  ! niveau du bas de la convection
-      INTEGER kctop(klon)  ! niveau du haut de la convection
-      INTEGER kdtop(klon)  ! niveau du haut des downdrafts
-c Local:
-      REAL pt(klon,klev)
-      REAL pq(klon,klev)
-      REAL pqs(klon,klev)
-      REAL pvervel(klon,klev)
-      LOGICAL land(klon)
-c
-      REAL d_t_bis(klon,klev)
-      REAL d_q_bis(klon,klev)
-      REAL paprs(klon,klev+1)
-      REAL paprsf(klon,klev)
-      REAL zgeom(klon,klev)
-      REAL zcvgq(klon,klev)
-      REAL zcvgt(klon,klev)
-cAA
-      REAL zmfu(klon,klev) 
-      REAL zmfd(klon,klev)
-      REAL zen_u(klon,klev)
-      REAL zen_d(klon,klev)
-      REAL zde_u(klon,klev)
-      REAL zde_d(klon,klev)
-      REAL zmflxr(klon,klev+1)
-      REAL zmflxs(klon,klev+1)
-cAA
-
-c
-      INTEGER i, k
-      REAL zdelta, zqsat
-c
-#include "FCTTRE.h"
-c
-c initialiser les variables de sortie (pour securite)
-      DO i = 1, klon
-         rain(i) = 0.0
-         snow(i) = 0.0
-         kcbot(i) = 0
-         kctop(i) = 0
-         kdtop(i) = 0
-      ENDDO
-      DO k = 1, klev
-      DO i = 1, klon
-         d_t(i,k) = 0.0
-         d_q(i,k) = 0.0
-         pmfu(i,k) = 0.0
-         pmfd(i,k) = 0.0
-         pen_u(i,k) = 0.0
-         pde_u(i,k) = 0.0
-         pen_d(i,k) = 0.0
-         pde_d(i,k) = 0.0
-         zmfu(i,k) = 0.0
-         zmfd(i,k) = 0.0
-         zen_u(i,k) = 0.0
-         zde_u(i,k) = 0.0
-         zen_d(i,k) = 0.0
-         zde_d(i,k) = 0.0
-      ENDDO
-      ENDDO
-      DO k = 1, klev+1
-      DO i = 1, klon
-         zmflxr(i,k) = 0.0
-         zmflxs(i,k) = 0.0
-      ENDDO
-      ENDDO
-c
-c calculer la nature du sol (pour l'instant, ocean partout)
-      DO i = 1, klon
-         land(i) = .FALSE.
-      ENDDO
-c
-c preparer les variables d'entree (attention: l'ordre des niveaux 
-c verticaux augmente du haut vers le bas)
-      DO k = 1, klev
-      DO i = 1, klon
-         pt(i,k) = t(i,klev-k+1)
-         pq(i,k) = q(i,klev-k+1)
-         paprsf(i,k) = pres_f(i,klev-k+1)
-         paprs(i,k) = pres_h(i,klev+1-k+1)
-         pvervel(i,k) = w(i,klev+1-k)
-         zcvgt(i,k) = con_t(i,klev-k+1)
-         zcvgq(i,k) = con_q(i,klev-k+1)
-c
-         zdelta=MAX(0.,SIGN(1.,RTT-pt(i,k)))
-         zqsat=R2ES*FOEEW ( pt(i,k), zdelta ) / paprsf(i,k)
-         zqsat=MIN(0.5,zqsat)
-         zqsat=zqsat/(1.-RETV  *zqsat)
-         pqs(i,k) = zqsat
-      ENDDO
-      ENDDO
-      DO i = 1, klon
-         paprs(i,klev+1) = pres_h(i,1)
-         zgeom(i,klev) = RD * pt(i,klev)
-     .                   / (0.5*(paprs(i,klev+1)+paprsf(i,klev)))
-     .                   * (paprs(i,klev+1)-paprsf(i,klev))
-      ENDDO
-      DO k = klev-1, 1, -1
-      DO i = 1, klon
-         zgeom(i,k) = zgeom(i,k+1)
-     .              + RD * 0.5*(pt(i,k+1)+pt(i,k)) / paprs(i,k+1)
-     .                   * (paprsf(i,k+1)-paprsf(i,k))
-      ENDDO
-      ENDDO
-c
-c appeler la routine principale
-c
-      CALL flxmain(dtime, pt, pq, pqs, pqhfl,
-     .             paprsf, paprs, zgeom, land, zcvgt, zcvgq, pvervel,
-     .             rain, snow, kcbot, kctop, kdtop,
-     .             zmfu, zmfd, zen_u, zde_u, zen_d, zde_d,
-     .             d_t_bis, d_q_bis, zmflxr, zmflxs)
-C
-cAA--------------------------------------------------------
-cAA rem : De la meme facon que l'on effectue le reindicage 
-cAA       pour la temperature t et le champ q 
-cAA       on reindice les flux necessaires a la convection 
-cAA       des traceurs
-cAA--------------------------------------------------------
-      DO k = 1, klev
-      DO i = 1, klon
-         d_q(i,klev+1-k) = dtime*d_q_bis(i,k)
-         d_t(i,klev+1-k) = dtime*d_t_bis(i,k)
-      ENDDO
-      ENDDO
-c
-      DO i = 1, klon
-         pmfu(i,1)= 0.
-         pmfd(i,1)= 0.
-         pen_d(i,1)= 0.
-         pde_d(i,1)= 0.
-      ENDDO
-     
-      DO k = 2, klev
-      DO i = 1, klon
-         pmfu(i,klev+2-k)= zmfu(i,k)
-         pmfd(i,klev+2-k)= zmfd(i,k)
-      ENDDO
-      ENDDO
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         pen_u(i,klev+1-k)=  zen_u(i,k)
-         pde_u(i,klev+1-k)=  zde_u(i,k)
-      ENDDO
-      ENDDO
-c
-      DO k = 1, klev-1
-      DO i = 1, klon
-         pen_d(i,klev+1-k)= -zen_d(i,k+1)
-         pde_d(i,klev+1-k)= -zde_d(i,k+1)
-      ENDDO
-      ENDDO
-
-      DO k = 1, klev+1
-      DO i = 1, klon
-         pmflxr(i,klev+2-k)= zmflxr(i,k)
-         pmflxs(i,klev+2-k)= zmflxs(i,k)
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-c--------------------------------------------------------------------
-      SUBROUTINE flxmain(pdtime, pten, pqen, pqsen, pqhfl, pap, paph,
-     .                   pgeo, ldland, ptte, pqte, pvervel,
-     .                   prsfc, pssfc, kcbot, kctop, kdtop,
-c     *                   ldcum, ktype,
-     .                   pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
-     .                   dt_con, dq_con, pmflxr, pmflxs)
-      IMPLICIT none
-C     ------------------------------------------------------------------
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "YOECUMF.h"
-C     ----------------------------------------------------------------
-      REAL pten(klon,klev), pqen(klon,klev), pqsen(klon,klev)
-      REAL ptte(klon,klev)
-      REAL pqte(klon,klev)
-      REAL pvervel(klon,klev)
-      REAL pgeo(klon,klev), pap(klon,klev), paph(klon,klev+1)
-      REAL pqhfl(klon)
-c
-      REAL ptu(klon,klev), pqu(klon,klev), plu(klon,klev)
-      REAL plude(klon,klev)
-      REAL pmfu(klon,klev)
-      REAL prsfc(klon), pssfc(klon)
-      INTEGER  kcbot(klon), kctop(klon), ktype(klon)
-      LOGICAL  ldland(klon), ldcum(klon)
-c
-      REAL ztenh(klon,klev), zqenh(klon,klev), zqsenh(klon,klev)
-      REAL zgeoh(klon,klev)
-      REAL zmfub(klon), zmfub1(klon)
-      REAL zmfus(klon,klev), zmfuq(klon,klev), zmful(klon,klev)
-      REAL zdmfup(klon,klev), zdpmel(klon,klev)
-      REAL zentr(klon), zhcbase(klon)
-      REAL zdqpbl(klon), zdqcv(klon), zdhpbl(klon)
-      REAL zrfl(klon)
-      REAL pmflxr(klon,klev+1)
-      REAL pmflxs(klon,klev+1)
-      INTEGER  ilab(klon,klev), ictop0(klon)
-      LOGICAL  llo1
-      REAL dt_con(klon,klev), dq_con(klon,klev)
-      REAL zmfmax, zdh
-      REAL pdtime, zqumqe, zdqmin, zalvdcp, zhsat, zzz
-      REAL zhhat, zpbmpt, zgam, zeps, zfac
-      INTEGER i, k, ikb, itopm2, kcum
-c
-      REAL pen_u(klon,klev), pde_u(klon,klev)
-      REAL pen_d(klon,klev), pde_d(klon,klev)
-c
-      REAL ptd(klon,klev), pqd(klon,klev), pmfd(klon,klev)
-      REAL zmfds(klon,klev), zmfdq(klon,klev), zdmfdp(klon,klev)
-      INTEGER kdtop(klon)
-      LOGICAL lddraf(klon)
-C---------------------------------------------------------------------
-      LOGICAL firstcal
-      SAVE firstcal
-      DATA firstcal / .TRUE. /
-C---------------------------------------------------------------------
-      IF (firstcal) THEN
-         CALL flxsetup
-         firstcal = .FALSE.
-      ENDIF
-C---------------------------------------------------------------------
-      DO i = 1, klon
-         ldcum(i) = .FALSE.
-      ENDDO
-      DO k = 1, klev
-      DO i = 1, klon
-         dt_con(i,k) = 0.0
-         dq_con(i,k) = 0.0
-      ENDDO
-      ENDDO
-c----------------------------------------------------------------------
-c initialiser les variables et faire l'interpolation verticale
-c----------------------------------------------------------------------
-      CALL flxini(pten, pqen, pqsen, pgeo,
-     .     paph, zgeoh, ztenh, zqenh, zqsenh,
-     .     ptu, pqu, ptd, pqd, pmfd, zmfds, zmfdq, zdmfdp,
-     .     pmfu, zmfus, zmfuq, zdmfup,
-     .     zdpmel, plu, plude, ilab, pen_u, pde_u, pen_d, pde_d)
-c---------------------------------------------------------------------
-c determiner les valeurs au niveau de base de la tour convective
-c---------------------------------------------------------------------
-      CALL flxbase(ztenh, zqenh, zgeoh, paph,
-     *            ptu, pqu, plu, ldcum, kcbot, ilab)
-c---------------------------------------------------------------------
-c calculer la convergence totale de l'humidite et celle en provenance
-c de la couche limite, plus precisement, la convergence integree entre
-c le sol et la base de la convection. Cette derniere convergence est
-c comparee avec l'evaporation obtenue dans la couche limite pour
-c determiner le type de la convection
-c---------------------------------------------------------------------
-      k=1
-      DO i = 1, klon
-         zdqcv(i) = pqte(i,k)*(paph(i,k+1)-paph(i,k))
-         zdhpbl(i) = 0.0
-         zdqpbl(i) = 0.0
-      ENDDO
-c
-      DO k=2,klev
-      DO i = 1, klon
-          zdqcv(i)=zdqcv(i)+pqte(i,k)*(paph(i,k+1)-paph(i,k))
-          IF (k.GE.kcbot(i)) THEN
-             zdqpbl(i)=zdqpbl(i)+pqte(i,k)*(paph(i,k+1)-paph(i,k))
-             zdhpbl(i)=zdhpbl(i)+(RCPD*ptte(i,k)+RLVTT*pqte(i,k))
-     .                          *(paph(i,k+1)-paph(i,k))
-          ENDIF
-      ENDDO
-      ENDDO
-c
-      DO i = 1, klon
-         ktype(i) = 2
-         if (zdqcv(i).GT.MAX(0.,-1.5*pqhfl(i)*RG)) ktype(i) = 1
-ccc         if (zdqcv(i).GT.MAX(0.,-1.1*pqhfl(i)*RG)) ktype(i) = 1
-      ENDDO
-c
-c---------------------------------------------------------------------
-c determiner le flux de masse entrant a travers la base.
-c on ignore, pour l'instant, l'effet du panache descendant
-c---------------------------------------------------------------------
-      DO i = 1, klon
-         ikb=kcbot(i)
-         zqumqe=pqu(i,ikb)+plu(i,ikb)-zqenh(i,ikb)
-         zdqmin=MAX(0.01*zqenh(i,ikb),1.E-10)
-         IF (zdqpbl(i).GT.0..AND.zqumqe.GT.zdqmin.AND.ldcum(i)) THEN
-            zmfub(i) = zdqpbl(i)/(RG*MAX(zqumqe,zdqmin))
-         ELSE
-            zmfub(i) = 0.01
-            ldcum(i)=.FALSE.
-         ENDIF
-         IF (ktype(i).EQ.2) THEN
-            zdh = RCPD*(ptu(i,ikb)-ztenh(i,ikb)) + RLVTT*zqumqe
-            zdh = RG * MAX(zdh,1.0E5*zdqmin)
-            IF (zdhpbl(i).GT.0..AND.ldcum(i))zmfub(i)=zdhpbl(i)/zdh
-         ENDIF
-         zmfmax = (paph(i,ikb)-paph(i,ikb-1)) / (RG*pdtime)
-         zmfub(i) = MIN(zmfub(i),zmfmax)
-         zentr(i) = ENTRSCV
-         IF (ktype(i).EQ.1) zentr(i) = ENTRPEN
-      ENDDO
-C-----------------------------------------------------------------------
-C DETERMINE CLOUD ASCENT FOR ENTRAINING PLUME
-C-----------------------------------------------------------------------
-c (A) calculer d'abord la hauteur "theorique" de la tour convective sans
-c     considerer l'entrainement ni le detrainement du panache, sachant
-c     ces derniers peuvent abaisser la hauteur theorique.
-c
-      DO i = 1, klon
-         ikb=kcbot(i)
-         zhcbase(i)=RCPD*ptu(i,ikb)+zgeoh(i,ikb)+RLVTT*pqu(i,ikb)
-         ictop0(i)=kcbot(i)-1
-      ENDDO
-c
-      zalvdcp=RLVTT/RCPD
-      DO k=klev-1,3,-1
-      DO i = 1, klon
-         zhsat=RCPD*ztenh(i,k)+zgeoh(i,k)+RLVTT*zqsenh(i,k)
-         zgam=R5LES*zalvdcp*zqsenh(i,k)/
-     .        ((1.-RETV  *zqsenh(i,k))*(ztenh(i,k)-R4LES)**2)
-         zzz=RCPD*ztenh(i,k)*0.608
-         zhhat=zhsat-(zzz+zgam*zzz)/(1.+zgam*zzz/RLVTT)*
-     .               MAX(zqsenh(i,k)-zqenh(i,k),0.)
-         IF(k.LT.ictop0(i).AND.zhcbase(i).GT.zhhat) ictop0(i)=k
-      ENDDO
-      ENDDO
-c
-c (B) calculer le panache ascendant
-c
-      CALL flxasc(pdtime,ztenh, zqenh, pten, pqen, pqsen,
-     .     pgeo, zgeoh, pap, paph, pqte, pvervel,
-     .     ldland, ldcum, ktype, ilab,
-     .     ptu, pqu, plu, pmfu, zmfub, zentr,
-     .     zmfus, zmfuq, zmful, plude, zdmfup,
-     .     kcbot, kctop, ictop0, kcum, pen_u, pde_u)
-      IF (kcum.EQ.0) GO TO 1000
-C
-C verifier l'epaisseur de la convection et changer eventuellement
-c le taux d'entrainement/detrainement
-C
-      DO i = 1, klon
-         zpbmpt=paph(i,kcbot(i))-paph(i,kctop(i))
-         IF(ldcum(i).AND.ktype(i).EQ.1.AND.zpbmpt.LT.2.E4)ktype(i)=2
-         IF(ldcum(i)) ictop0(i)=kctop(i)
-         IF(ktype(i).EQ.2) zentr(i)=ENTRSCV
-      ENDDO
-c
-      IF (lmfdd) THEN  ! si l'on considere le panache descendant
-c
-c calculer la precipitation issue du panache ascendant pour 
-c determiner l'existence du panache descendant dans la convection
-      DO i = 1, klon
-         zrfl(i)=zdmfup(i,1)
-      ENDDO
-      DO k=2,klev
-      DO i = 1, klon
-         zrfl(i)=zrfl(i)+zdmfup(i,k)
-      ENDDO
-      ENDDO
-c
-c determiner le LFS (level of free sinking: niveau de plonge libre)
-      CALL flxdlfs(ztenh, zqenh, zgeoh, paph, ptu, pqu,
-     *     ldcum,    kcbot,    kctop,    zmfub,    zrfl,
-     *     ptd,      pqd,
-     *     pmfd,     zmfds,    zmfdq,    zdmfdp,
-     *     kdtop,    lddraf)
-c
-c calculer le panache descendant
-      CALL flxddraf(ztenh,    zqenh,
-     *     zgeoh,    paph,     zrfl,
-     *     ptd,      pqd,
-     *     pmfd,     zmfds,    zmfdq,    zdmfdp,
-     *     lddraf, pen_d, pde_d)
-c
-c calculer de nouveau le flux de masse entrant a travers la base
-c de la convection, sachant qu'il a ete modifie par le panache
-c descendant
-      DO i = 1, klon
-      IF (lddraf(i)) THEN
-         ikb = kcbot(i)
-         llo1 = PMFD(i,ikb).LT.0.
-         zeps = 0.
-         IF ( llo1 ) zeps = CMFDEPS
-         zqumqe = pqu(i,ikb)+plu(i,ikb)-
-     .            zeps*pqd(i,ikb)-(1.-zeps)*zqenh(i,ikb)
-         zdqmin = MAX(0.01*zqenh(i,ikb),1.E-10)
-         zmfmax = (paph(i,ikb)-paph(i,ikb-1)) / (RG*pdtime)
-         IF (zdqpbl(i).GT.0..AND.zqumqe.GT.zdqmin.AND.ldcum(i)
-     .       .AND.zmfub(i).LT.zmfmax) THEN
-            zmfub1(i) = zdqpbl(i) / (RG*MAX(zqumqe,zdqmin))
-         ELSE
-            zmfub1(i) = zmfub(i)
-         ENDIF
-         IF (ktype(i).EQ.2) THEN
-            zdh = RCPD*(ptu(i,ikb)-zeps*ptd(i,ikb)-
-     .            (1.-zeps)*ztenh(i,ikb))+RLVTT*zqumqe
-            zdh = RG * MAX(zdh,1.0E5*zdqmin)
-            IF (zdhpbl(i).GT.0..AND.ldcum(i))zmfub1(i)=zdhpbl(i)/zdh
-         ENDIF
-         IF ( .NOT.((ktype(i).EQ.1.OR.ktype(i).EQ.2).AND.
-     .              ABS(zmfub1(i)-zmfub(i)).LT.0.2*zmfub(i)) )
-     .      zmfub1(i) = zmfub(i)
-      ENDIF
-      ENDDO
-      DO k = 1, klev
-      DO i = 1, klon
-      IF (lddraf(i)) THEN
-         zfac = zmfub1(i)/MAX(zmfub(i),1.E-10)
-         pmfd(i,k) = pmfd(i,k)*zfac
-         zmfds(i,k) = zmfds(i,k)*zfac
-         zmfdq(i,k) = zmfdq(i,k)*zfac
-         zdmfdp(i,k) = zdmfdp(i,k)*zfac
-         pen_d(i,k) = pen_d(i,k)*zfac
-         pde_d(i,k) = pde_d(i,k)*zfac
-      ENDIF
-      ENDDO
-      ENDDO
-      DO i = 1, klon
-         IF (lddraf(i)) zmfub(i)=zmfub1(i)
-      ENDDO
-c
-      ENDIF   ! fin de test sur lmfdd
-c
-c-----------------------------------------------------------------------
-c calculer de nouveau le panache ascendant
-c-----------------------------------------------------------------------
-      CALL flxasc(pdtime,ztenh, zqenh, pten, pqen, pqsen,
-     .     pgeo, zgeoh, pap, paph, pqte, pvervel,
-     .     ldland, ldcum, ktype, ilab,
-     .     ptu, pqu, plu, pmfu, zmfub, zentr,
-     .     zmfus, zmfuq, zmful, plude, zdmfup,
-     .     kcbot, kctop, ictop0, kcum, pen_u, pde_u)
-c
-c-----------------------------------------------------------------------
-c determiner les flux convectifs en forme finale, ainsi que
-c la quantite des precipitations
-c-----------------------------------------------------------------------
-      CALL flxflux(pdtime, pqen, pqsen, ztenh, zqenh, pap, paph, 
-     .     ldland, zgeoh, kcbot, kctop, lddraf, kdtop, ktype, ldcum,
-     .     pmfu, pmfd, zmfus, zmfds, zmfuq, zmfdq, zmful, plude,
-     .     zdmfup, zdmfdp, pten, prsfc, pssfc, zdpmel, itopm2,
-     .     pmflxr, pmflxs)
-c
-c----------------------------------------------------------------------
-c calculer les tendances pour T et Q
-c----------------------------------------------------------------------
-      CALL flxdtdq(pdtime, itopm2, paph, ldcum, pten,
-     e     zmfus, zmfds, zmfuq, zmfdq, zmful, zdmfup, zdmfdp, zdpmel,
-     s     dt_con,dq_con)
-c
- 1000 CONTINUE
-      RETURN
-      END
-      SUBROUTINE flxini(pten, pqen, pqsen, pgeo, paph, pgeoh, ptenh,
-     .           pqenh, pqsenh, ptu, pqu, ptd, pqd, pmfd, pmfds, pmfdq,
-     .           pdmfdp, pmfu, pmfus, pmfuq, pdmfup, pdpmel, plu, plude,
-     .           klab,pen_u, pde_u, pen_d, pde_d)
-      IMPLICIT none
-C----------------------------------------------------------------------
-C THIS ROUTINE INTERPOLATES LARGE-SCALE FIELDS OF T,Q ETC.
-C TO HALF LEVELS (I.E. GRID FOR MASSFLUX SCHEME),
-C AND INITIALIZES VALUES FOR UPDRAFTS
-C----------------------------------------------------------------------
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "YOETHF.h"
-C
-      REAL pten(klon,klev)   ! temperature (environnement)
-      REAL pqen(klon,klev)   ! humidite (environnement)
-      REAL pqsen(klon,klev)  ! humidite saturante (environnement)
-      REAL pgeo(klon,klev)   ! geopotentiel (g * metre)
-      REAL pgeoh(klon,klev)  ! geopotentiel aux demi-niveaux
-      REAL paph(klon,klev+1) ! pression aux demi-niveaux
-      REAL ptenh(klon,klev)  ! temperature aux demi-niveaux
-      REAL pqenh(klon,klev)  ! humidite aux demi-niveaux
-      REAL pqsenh(klon,klev) ! humidite saturante aux demi-niveaux
-C
-      REAL ptu(klon,klev)    ! temperature du panache ascendant (p-a)
-      REAL pqu(klon,klev)    ! humidite du p-a
-      REAL plu(klon,klev)    ! eau liquide du p-a
-      REAL pmfu(klon,klev)   ! flux de masse du p-a
-      REAL pmfus(klon,klev)  ! flux de l'energie seche dans le p-a
-      REAL pmfuq(klon,klev)  ! flux de l'humidite dans le p-a
-      REAL pdmfup(klon,klev) ! quantite de l'eau precipitee dans p-a
-      REAL plude(klon,klev)  ! quantite de l'eau liquide jetee du
-c                              p-a a l'environnement
-      REAL pdpmel(klon,klev) ! quantite de neige fondue
-c
-      REAL ptd(klon,klev)    ! temperature du panache descendant (p-d)
-      REAL pqd(klon,klev)    ! humidite du p-d
-      REAL pmfd(klon,klev)   ! flux de masse du p-d
-      REAL pmfds(klon,klev)  ! flux de l'energie seche dans le p-d
-      REAL pmfdq(klon,klev)  ! flux de l'humidite dans le p-d
-      REAL pdmfdp(klon,klev) ! quantite de precipitation dans p-d
-c
-      REAL pen_u(klon,klev) ! quantite de masse entrainee pour p-a
-      REAL pde_u(klon,klev) ! quantite de masse detrainee pour p-a
-      REAL pen_d(klon,klev) ! quantite de masse entrainee pour p-d
-      REAL pde_d(klon,klev) ! quantite de masse detrainee pour p-d
-C
-      INTEGER  klab(klon,klev)
-      LOGICAL  llflag(klon)
-      INTEGER k, i, icall
-      REAL zzs
-C----------------------------------------------------------------------
-C SPECIFY LARGE SCALE PARAMETERS AT HALF LEVELS
-C ADJUST TEMPERATURE FIELDS IF STATICLY UNSTABLE
-C----------------------------------------------------------------------
-      DO 130 k = 2, klev
-c
-      DO i = 1, klon
-         pgeoh(i,k)=pgeo(i,k)+(pgeo(i,k-1)-pgeo(i,k))*0.5
-         ptenh(i,k)=(MAX(RCPD*pten(i,k-1)+pgeo(i,k-1),
-     .             RCPD*pten(i,k)+pgeo(i,k))-pgeoh(i,k))/RCPD
-         pqsenh(i,k)=pqsen(i,k-1)
-         llflag(i)=.TRUE.
-      ENDDO
-c
-      icall=0
-      CALL flxadjtq(paph(1,k),ptenh(1,k),pqsenh(1,k),llflag,icall)
-c
-      DO i = 1, klon
-         pqenh(i,k)=MIN(pqen(i,k-1),pqsen(i,k-1))
-     .               +(pqsenh(i,k)-pqsen(i,k-1))
-         pqenh(i,k)=MAX(pqenh(i,k),0.)
-      ENDDO
-c
-  130 CONTINUE
-C
-      DO 140 i = 1, klon
-         ptenh(i,klev)=(RCPD*pten(i,klev)+pgeo(i,klev)-
-     1                   pgeoh(i,klev))/RCPD
-         pqenh(i,klev)=pqen(i,klev)
-         ptenh(i,1)=pten(i,1)
-         pqenh(i,1)=pqen(i,1)
-         pgeoh(i,1)=pgeo(i,1)
-  140 CONTINUE
-c
-      DO 160 k = klev-1, 2, -1
-      DO 150 i = 1, klon
-         zzs = MAX(RCPD*ptenh(i,k)+pgeoh(i,k),
-     .             RCPD*ptenh(i,k+1)+pgeoh(i,k+1))
-         ptenh(i,k) = (zzs-pgeoh(i,k))/RCPD
-  150 CONTINUE
-  160 CONTINUE
-C
-C-----------------------------------------------------------------------
-C INITIALIZE VALUES FOR UPDRAFTS AND DOWNDRAFTS
-C-----------------------------------------------------------------------
-      DO k = 1, klev
-      DO i = 1, klon
-         ptu(i,k) = ptenh(i,k)
-         pqu(i,k) = pqenh(i,k)
-         plu(i,k) = 0.
-         pmfu(i,k) = 0.
-         pmfus(i,k) = 0.
-         pmfuq(i,k) = 0.
-         pdmfup(i,k) = 0.
-         pdpmel(i,k) = 0.
-         plude(i,k) = 0.
-c
-         klab(i,k) = 0
-c
-         ptd(i,k) = ptenh(i,k)
-         pqd(i,k) = pqenh(i,k)
-         pmfd(i,k) = 0.0
-         pmfds(i,k) = 0.0
-         pmfdq(i,k) = 0.0
-         pdmfdp(i,k) = 0.0
-c
-         pen_u(i,k) = 0.0
-         pde_u(i,k) = 0.0
-         pen_d(i,k) = 0.0
-         pde_d(i,k) = 0.0
-      ENDDO
-      ENDDO
-C
-      RETURN
-      END
-      SUBROUTINE flxbase(ptenh, pqenh, pgeoh, paph,
-     *     ptu, pqu, plu, ldcum, kcbot, klab)
-      IMPLICIT none
-C----------------------------------------------------------------------
-C THIS ROUTINE CALCULATES CLOUD BASE VALUES (T AND Q)
-C
-C INPUT ARE ENVIRONM. VALUES OF T,Q,P,PHI AT HALF LEVELS.
-C IT RETURNS CLOUD BASE VALUES AND FLAGS AS FOLLOWS;
-C   klab=1 FOR SUBCLOUD LEVELS
-C   klab=2 FOR CONDENSATION LEVEL
-C
-C LIFT SURFACE AIR DRY-ADIABATICALLY TO CLOUD BASE
-C (NON ENTRAINING PLUME,I.E.CONSTANT MASSFLUX)
-C----------------------------------------------------------------------
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "YOETHF.h"
-C       ----------------------------------------------------------------
-      REAL ptenh(klon,klev), pqenh(klon,klev)
-      REAL pgeoh(klon,klev), paph(klon,klev+1)
-C
-      REAL ptu(klon,klev), pqu(klon,klev), plu(klon,klev)
-      INTEGER  klab(klon,klev), kcbot(klon)
-C
-      LOGICAL llflag(klon), ldcum(klon)
-      INTEGER i, k, icall, is
-      REAL zbuo, zqold(klon)
-C----------------------------------------------------------------------
-C INITIALIZE VALUES AT LIFTING LEVEL
-C----------------------------------------------------------------------
-      DO i = 1, klon
-         klab(i,klev)=1
-         kcbot(i)=klev-1
-         ldcum(i)=.FALSE.
-      ENDDO
-C----------------------------------------------------------------------
-C DO ASCENT IN SUBCLOUD LAYER,
-C CHECK FOR EXISTENCE OF CONDENSATION LEVEL,
-C ADJUST T,Q AND L ACCORDINGLY
-C CHECK FOR BUOYANCY AND SET FLAGS
-C----------------------------------------------------------------------
-      DO 290 k = klev-1, 2, -1
-c
-      is = 0
-      DO i = 1, klon
-         IF (klab(i,k+1).EQ.1) is = is + 1
-         llflag(i) = .FALSE.
-         IF (klab(i,k+1).EQ.1) llflag(i) = .TRUE.
-      ENDDO
-      IF (is.EQ.0) GOTO 290
-c
-      DO i = 1, klon
-      IF(llflag(i)) THEN
-         pqu(i,k) = pqu(i,k+1)
-         ptu(i,k) = ptu(i,k+1)+(pgeoh(i,k+1)-pgeoh(i,k))/RCPD
-         zbuo = ptu(i,k)*(1.+RETV*pqu(i,k))-
-     .          ptenh(i,k)*(1.+RETV*pqenh(i,k))+0.5
-         IF (zbuo.GT.0.) klab(i,k) = 1
-         zqold(i) = pqu(i,k)
-      ENDIF
-      ENDDO
-c
-      icall=1
-      CALL flxadjtq(paph(1,k), ptu(1,k), pqu(1,k), llflag, icall)
-c
-      DO i = 1, klon
-      IF (llflag(i).AND.pqu(i,k).NE.zqold(i)) THEN
-         klab(i,k) = 2
-         plu(i,k) = plu(i,k) + zqold(i)-pqu(i,k)
-         zbuo = ptu(i,k)*(1.+RETV*pqu(i,k))-
-     .          ptenh(i,k)*(1.+RETV*pqenh(i,k))+0.5
-         IF (zbuo.GT.0.) kcbot(i) = k
-         IF (zbuo.GT.0.) ldcum(i) = .TRUE.
-      ENDIF
-      ENDDO
-c
-  290 CONTINUE
-c
-      RETURN
-      END
-      SUBROUTINE flxasc(pdtime, ptenh, pqenh, pten, pqen, pqsen,
-     .     pgeo, pgeoh, pap, paph, pqte, pvervel,
-     .     ldland, ldcum, ktype, klab, ptu, pqu, plu,
-     .     pmfu, pmfub, pentr, pmfus, pmfuq,
-     .     pmful, plude, pdmfup, kcbot, kctop, kctop0, kcum,
-     .     pen_u, pde_u)
-      IMPLICIT none
-C----------------------------------------------------------------------
-C THIS ROUTINE DOES THE CALCULATIONS FOR CLOUD ASCENTS
-C FOR CUMULUS PARAMETERIZATION
-C----------------------------------------------------------------------
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "YOECUMF.h"
-C
-      REAL pdtime
-      REAL pten(klon,klev), ptenh(klon,klev)
-      REAL pqen(klon,klev), pqenh(klon,klev), pqsen(klon,klev)
-      REAL pgeo(klon,klev), pgeoh(klon,klev)
-      REAL pap(klon,klev), paph(klon,klev+1)
-      REAL pqte(klon,klev)
-      REAL pvervel(klon,klev) ! vitesse verticale en Pa/s
-C
-      REAL pmfub(klon), pentr(klon)
-      REAL ptu(klon,klev), pqu(klon,klev), plu(klon,klev)
-      REAL plude(klon,klev)
-      REAL pmfu(klon,klev), pmfus(klon,klev)
-      REAL pmfuq(klon,klev), pmful(klon,klev)
-      REAL pdmfup(klon,klev)
-      INTEGER ktype(klon), klab(klon,klev), kcbot(klon), kctop(klon)
-      INTEGER kctop0(klon)
-      LOGICAL ldland(klon), ldcum(klon)
-C
-      REAL pen_u(klon,klev), pde_u(klon,klev)
-      REAL zqold(klon)
-      REAL zdland(klon)
-      LOGICAL llflag(klon)
-      INTEGER k, i, is, icall, kcum
-      REAL ztglace, zdphi, zqeen, zseen, zscde, zqude
-      REAL zmfusk, zmfuqk, zmfulk, zbuo, zdnoprc, zprcon, zlnew
-c
-      REAL zpbot(klon), zptop(klon), zrho(klon)
-      REAL zdprho, zentr, zpmid, zmftest, zmfmax
-      LOGICAL llo1, llo2
-c
-      REAL zwmax(klon), zzzmb
-      INTEGER klwmin(klon) ! level of maximum vertical velocity
-C----------------------------------------------------------------------
-      ztglace = RTT - 13.
-c
-c Chercher le niveau ou la vitesse verticale est maximale:
-      DO i = 1, klon
-         klwmin(i) = klev
-         zwmax(i) = 0.0
-      ENDDO
-      DO k = klev, 3, -1
-      DO i = 1, klon
-      IF (pvervel(i,k).LT.zwmax(i)) THEN
-         zwmax(i) = pvervel(i,k)
-         klwmin(i) = k
-      ENDIF
-      ENDDO
-      ENDDO
-C----------------------------------------------------------------------
-C SET DEFAULT VALUES
-C----------------------------------------------------------------------
-      DO i = 1, klon
-         IF (.NOT.ldcum(i)) ktype(i)=0
-      ENDDO
-c
-      DO k=1,klev
-      DO i = 1, klon
-         plu(i,k)=0.
-         pmfu(i,k)=0.
-         pmfus(i,k)=0.
-         pmfuq(i,k)=0.
-         pmful(i,k)=0.
-         plude(i,k)=0.
-         pdmfup(i,k)=0.
-         IF(.NOT.ldcum(i).OR.ktype(i).EQ.3) klab(i,k)=0
-         IF(.NOT.ldcum(i).AND.paph(i,k).LT.4.E4) kctop0(i)=k
-      ENDDO
-      ENDDO
-c
-      DO i = 1, klon
-      IF (ldland(i)) THEN
-         zdland(i)=3.0E4
-         zdphi=pgeoh(i,kctop0(i))-pgeoh(i,kcbot(i))
-         IF (ptu(i,kctop0(i)).GE.ztglace) zdland(i)=zdphi
-         zdland(i)=MAX(3.0E4,zdland(i))
-         zdland(i)=MIN(5.0E4,zdland(i))
-      ENDIF
-      ENDDO
-C
-C Initialiser les valeurs au niveau d'ascendance
-C
-      DO i = 1, klon
-         kctop(i) = klev-1
-         IF (.NOT.ldcum(i)) THEN
-            kcbot(i) = klev-1
-            pmfub(i) = 0.
-            pqu(i,klev) = 0.
-         ENDIF
-         pmfu(i,klev) = pmfub(i)
-         pmfus(i,klev) = pmfub(i)*(RCPD*ptu(i,klev)+pgeoh(i,klev))
-         pmfuq(i,klev) = pmfub(i)*pqu(i,klev)
-      ENDDO
-c
-      DO i = 1, klon
-         ldcum(i) = .FALSE.
-      ENDDO
-C----------------------------------------------------------------------
-C  DO ASCENT: SUBCLOUD LAYER (klab=1) ,CLOUDS (klab=2)
-C  BY DOING FIRST DRY-ADIABATIC ASCENT AND THEN
-C  BY ADJUSTING T,Q AND L ACCORDINGLY IN *flxadjtq*,
-C  THEN CHECK FOR BUOYANCY AND SET FLAGS ACCORDINGLY
-C----------------------------------------------------------------------
-      DO 480 k = klev-1,3,-1
-c
-      IF (LMFMID .AND. k.LT.klev-1 .AND. k.GT.klev/2) THEN
-         DO i = 1, klon
-         IF (.NOT.ldcum(i) .AND. klab(i,k+1).EQ.0 .AND.
-     .       pqen(i,k).GT.0.9*pqsen(i,k)) THEN
-            ptu(i,k+1) = pten(i,k) +(pgeo(i,k)-pgeoh(i,k+1))/RCPD
-            pqu(i,k+1) = pqen(i,k)
-            plu(i,k+1) = 0.0
-            zzzmb = MAX(CMFCMIN, -pvervel(i,k))
-            zmfmax = (paph(i,k)-paph(i,k-1))/(RG*pdtime)
-            pmfub(i) = MIN(zzzmb,zmfmax)
-            pmfu(i,k+1) = pmfub(i)
-            pmfus(i,k+1) = pmfub(i)*(RCPD*ptu(i,k+1)+pgeoh(i,k+1))
-            pmfuq(i,k+1) = pmfub(i)*pqu(i,k+1)
-            pmful(i,k+1) = 0.0
-            pdmfup(i,k+1) = 0.0
-            kcbot(i) = k
-            klab(i,k+1) = 1
-            ktype(i) = 3
-            pentr(i) = ENTRMID
-         ENDIF
-         ENDDO
-      ENDIF
-c
-      is = 0
-      DO i = 1, klon
-         is = is + klab(i,k+1)
-         IF (klab(i,k+1) .EQ. 0) klab(i,k) = 0
-         llflag(i) = .FALSE.
-         IF (klab(i,k+1) .GT. 0) llflag(i) = .TRUE.
-      ENDDO
-      IF (is .EQ. 0) GOTO 480
-c
-c calculer le taux d'entrainement et de detrainement
-c
-      DO i = 1, klon
-         pen_u(i,k) = 0.0
-         pde_u(i,k) = 0.0
-         zrho(i)=paph(i,k+1)/(RD*ptenh(i,k+1))
-         zpbot(i)=paph(i,kcbot(i))
-         zptop(i)=paph(i,kctop0(i))
-      ENDDO
-c
-      DO 125 i = 1, klon
-      IF(ldcum(i)) THEN
-         zdprho=(paph(i,k+1)-paph(i,k))/(RG*zrho(i))
-         zentr=pentr(i)*pmfu(i,k+1)*zdprho
-         llo1=k.LT.kcbot(i)
-         IF(llo1) pde_u(i,k)=zentr
-         zpmid=0.5*(zpbot(i)+zptop(i))
-         llo2=llo1.AND.ktype(i).EQ.2.AND.
-     .        (zpbot(i)-paph(i,k).LT.0.2E5.OR.
-     .         paph(i,k).GT.zpmid)
-         IF(llo2) pen_u(i,k)=zentr
-         llo2=llo1.AND.(ktype(i).EQ.1.OR.ktype(i).EQ.3).AND.
-     .        (k.GE.MAX(klwmin(i),kctop0(i)+2).OR.pap(i,k).GT.zpmid)
-         IF(llo2) pen_u(i,k)=zentr
-         llo1=pen_u(i,k).GT.0..AND.(ktype(i).EQ.1.OR.ktype(i).EQ.2)
-         IF(llo1) THEN
-            zentr=zentr*(1.+3.*(1.-MIN(1.,(zpbot(i)-pap(i,k))/1.5E4)))
-            pen_u(i,k)=pen_u(i,k)*(1.+3.*(1.-MIN(1.,
-     .                 (zpbot(i)-pap(i,k))/1.5E4)))
-            pde_u(i,k)=pde_u(i,k)*(1.+3.*(1.-MIN(1.,
-     .                 (zpbot(i)-pap(i,k))/1.5E4)))
-         ENDIF
-         IF(llo2.AND.pqenh(i,k+1).GT.1.E-5)
-     .   pen_u(i,k)=zentr+MAX(pqte(i,k),0.)/pqenh(i,k+1)*
-     .              zrho(i)*zdprho
-      ENDIF
-  125 CONTINUE
-c
-C----------------------------------------------------------------------
-c DO ADIABATIC ASCENT FOR ENTRAINING/DETRAINING PLUME
-C----------------------------------------------------------------------
-c
-      DO 420 i = 1, klon
-      IF (llflag(i)) THEN
-         IF (k.LT.kcbot(i)) THEN
-            zmftest = pmfu(i,k+1)+pen_u(i,k)-pde_u(i,k)
-            zmfmax = MIN(zmftest,(paph(i,k)-paph(i,k-1))/(RG*pdtime))
-            pen_u(i,k)=MAX(pen_u(i,k)-MAX(0.0,zmftest-zmfmax),0.0)
-         ENDIF
-         pde_u(i,k)=MIN(pde_u(i,k),0.75*pmfu(i,k+1))
-c calculer le flux de masse du niveau k a partir de celui du k+1
-         pmfu(i,k)=pmfu(i,k+1)+pen_u(i,k)-pde_u(i,k)
-c calculer les valeurs Su, Qu et l du niveau k dans le panache montant
-         zqeen=pqenh(i,k+1)*pen_u(i,k)
-         zseen=(RCPD*ptenh(i,k+1)+pgeoh(i,k+1))*pen_u(i,k)
-         zscde=(RCPD*ptu(i,k+1)+pgeoh(i,k+1))*pde_u(i,k)
-         zqude=pqu(i,k+1)*pde_u(i,k)
-         plude(i,k)=plu(i,k+1)*pde_u(i,k)
-         zmfusk=pmfus(i,k+1)+zseen-zscde
-         zmfuqk=pmfuq(i,k+1)+zqeen-zqude
-         zmfulk=pmful(i,k+1)    -plude(i,k)
-         plu(i,k)=zmfulk*(1./MAX(CMFCMIN,pmfu(i,k)))
-         pqu(i,k)=zmfuqk*(1./MAX(CMFCMIN,pmfu(i,k)))
-         ptu(i,k)=(zmfusk*(1./MAX(CMFCMIN,pmfu(i,k)))-
-     1               pgeoh(i,k))/RCPD
-         ptu(i,k)=MAX(100.,ptu(i,k))
-         ptu(i,k)=MIN(400.,ptu(i,k))
-         zqold(i)=pqu(i,k)
-      ELSE
-         zqold(i)=0.0
-      ENDIF
-  420 CONTINUE
-c
-C----------------------------------------------------------------------
-c DO CORRECTIONS FOR MOIST ASCENT BY ADJUSTING T,Q AND L
-C----------------------------------------------------------------------
-c
-      icall = 1
-      CALL flxadjtq(paph(1,k), ptu(1,k), pqu(1,k), llflag, icall)
-C
-      DO 440 i = 1, klon
-      IF(llflag(i).AND.pqu(i,k).NE.zqold(i)) THEN
-         klab(i,k) = 2
-         plu(i,k) = plu(i,k)+zqold(i)-pqu(i,k)
-         zbuo = ptu(i,k)*(1.+RETV*pqu(i,k))-
-     .          ptenh(i,k)*(1.+RETV*pqenh(i,k))
-         IF (klab(i,k+1).EQ.1) zbuo=zbuo+0.5
-         IF (zbuo.GT.0..AND.pmfu(i,k).GE.0.1*pmfub(i)) THEN
-            kctop(i) = k
-            ldcum(i) = .TRUE.
-            zdnoprc = 1.5E4
-            IF (ldland(i)) zdnoprc = zdland(i)
-            zprcon = CPRCON
-            IF ((zpbot(i)-paph(i,k)).LT.zdnoprc) zprcon = 0.0
-            zlnew=plu(i,k)/(1.+zprcon*(pgeoh(i,k)-pgeoh(i,k+1)))
-            pdmfup(i,k)=MAX(0.,(plu(i,k)-zlnew)*pmfu(i,k))
-            plu(i,k)=zlnew
-         ELSE
-            klab(i,k)=0
-            pmfu(i,k)=0.
-         ENDIF
-      ENDIF
-  440 CONTINUE
-      DO 455 i = 1, klon
-      IF (llflag(i)) THEN
-         pmful(i,k)=plu(i,k)*pmfu(i,k)
-         pmfus(i,k)=(RCPD*ptu(i,k)+pgeoh(i,k))*pmfu(i,k)
-         pmfuq(i,k)=pqu(i,k)*pmfu(i,k)
-      ENDIF
-  455 CONTINUE
-C
-  480 CONTINUE
-C----------------------------------------------------------------------
-C DETERMINE CONVECTIVE FLUXES ABOVE NON-BUOYANCY LEVEL
-C    (NOTE: CLOUD VARIABLES LIKE T,Q AND L ARE NOT
-C           AFFECTED BY DETRAINMENT AND ARE ALREADY KNOWN
-C           FROM PREVIOUS CALCULATIONS ABOVE)
-C----------------------------------------------------------------------
-      DO i = 1, klon
-         IF (kctop(i).EQ.klev-1) ldcum(i) = .FALSE.
-         kcbot(i) = MAX(kcbot(i),kctop(i))
-      ENDDO
-c
-      ldcum(1)=ldcum(1)
-c
-      is = 0
-      DO i = 1, klon
-         if (ldcum(i)) is = is + 1
-      ENDDO
-      kcum = is
-      IF (is.EQ.0) GOTO 800
-c
-      DO 530 i = 1, klon
-      IF (ldcum(i)) THEN
-         k=kctop(i)-1
-         pde_u(i,k)=(1.-CMFCTOP)*pmfu(i,k+1)
-         plude(i,k)=pde_u(i,k)*plu(i,k+1)
-         pmfu(i,k)=pmfu(i,k+1)-pde_u(i,k)
-         zlnew=plu(i,k)
-         pdmfup(i,k)=MAX(0.,(plu(i,k)-zlnew)*pmfu(i,k))
-         plu(i,k)=zlnew
-         pmfus(i,k)=(RCPD*ptu(i,k)+pgeoh(i,k))*pmfu(i,k)
-         pmfuq(i,k)=pqu(i,k)*pmfu(i,k)
-         pmful(i,k)=plu(i,k)*pmfu(i,k)
-         plude(i,k-1)=pmful(i,k)
-      ENDIF
-  530 CONTINUE
-C
-  800 CONTINUE
-      RETURN
-      END
-      SUBROUTINE flxflux(pdtime, pqen, pqsen, ptenh, pqenh, pap
-     .  ,  paph, ldland, pgeoh, kcbot, kctop, lddraf, kdtop
-     .  ,  ktype, ldcum, pmfu, pmfd, pmfus, pmfds
-     .  ,  pmfuq, pmfdq, pmful, plude, pdmfup, pdmfdp
-     .  ,  pten, prfl, psfl, pdpmel, ktopm2
-     .  ,  pmflxr, pmflxs)
-      IMPLICIT none
-C----------------------------------------------------------------------
-C THIS ROUTINE DOES THE FINAL CALCULATION OF CONVECTIVE
-C FLUXES IN THE CLOUD LAYER AND IN THE SUBCLOUD LAYER
-C----------------------------------------------------------------------
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "YOECUMF.h"
-C
-      REAL cevapcu(klev)
-C     -----------------------------------------------------------------
-      REAL pqen(klon,klev), pqenh(klon,klev), pqsen(klon,klev)
-      REAL pten(klon,klev), ptenh(klon,klev)
-      REAL paph(klon,klev+1), pgeoh(klon,klev)
-c
-      REAL pap(klon,klev)
-      REAL ztmsmlt, zdelta, zqsat
-C
-      REAL pmfu(klon,klev), pmfus(klon,klev)
-      REAL pmfd(klon,klev), pmfds(klon,klev)
-      REAL pmfuq(klon,klev), pmful(klon,klev)
-      REAL pmfdq(klon,klev)
-      REAL plude(klon,klev)
-      REAL pdmfup(klon,klev), pdpmel(klon,klev)
-cjq The variable maxpdmfdp(klon) has been introduced by Olivier Boucher
-cjq 14/11/00 to fix the problem with the negative precipitation.      
-      REAL pdmfdp(klon,klev), maxpdmfdp(klon,klev) 
-      REAL prfl(klon), psfl(klon)
-      REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1)
-      INTEGER  kcbot(klon), kctop(klon), ktype(klon)
-      LOGICAL  ldland(klon), ldcum(klon)
-      INTEGER k, kp, i
-      REAL zcons1, zcons2, zcucov, ztmelp2
-      REAL pdtime, zdp, zzp, zfac, zsnmlt, zrfl, zrnew
-      REAL zrmin, zrfln, zdrfl
-      REAL zpds, zpdr, zdenom
-      INTEGER ktopm2, itop, ikb
-c
-      LOGICAL lddraf(klon)
-      INTEGER kdtop(klon)
-c
-#include "FCTTRE.h"
-c
-      DO 101 k=1,klev
-      CEVAPCU(k)=1.93E-6*261.*SQRT(1.E3/(38.3*0.293)
-     1 *SQRT(0.5*(paph(1,k)+paph(1,k+1))/paph(1,klev+1)) ) * 0.5/RG
- 101  CONTINUE
-c
-c SPECIFY CONSTANTS
-c
-      zcons1 = RCPD/(RLMLT*RG*pdtime)
-      zcons2 = 1./(RG*pdtime)
-      zcucov = 0.05
-      ztmelp2 = RTT + 2.
-c
-c DETERMINE FINAL CONVECTIVE FLUXES
-c
-      itop=klev
-      DO 110 i = 1, klon
-         itop=MIN(itop,kctop(i))
-         IF (.NOT.ldcum(i) .OR. kdtop(i).LT.kctop(i)) lddraf(i)=.FALSE.
-         IF(.NOT.ldcum(i)) ktype(i)=0
-  110 CONTINUE
-c
-      ktopm2=itop-2
-      DO 120 k=ktopm2,klev
-      DO 115 i = 1, klon
-      IF(ldcum(i).AND.k.GE.kctop(i)-1) THEN
-         pmfus(i,k)=pmfus(i,k)-pmfu(i,k)*
-     .                (RCPD*ptenh(i,k)+pgeoh(i,k))
-         pmfuq(i,k)=pmfuq(i,k)-pmfu(i,k)*pqenh(i,k)
-         zdp = 1.5E4
-         IF ( ldland(i) ) zdp = 3.E4
-c
-c        l'eau liquide detrainee est precipitee quand certaines
-c        conditions sont reunies (sinon, elle est consideree
-c        evaporee dans l'environnement)
-c
-         IF(paph(i,kcbot(i))-paph(i,kctop(i)).GE.zdp.AND.
-     .      pqen(i,k-1).GT.0.8*pqsen(i,k-1))
-     .      pdmfup(i,k-1)=pdmfup(i,k-1)+plude(i,k-1)
-c
-         IF(lddraf(i).AND.k.GE.kdtop(i)) THEN
-            pmfds(i,k)=pmfds(i,k)-pmfd(i,k)*
-     .                   (RCPD*ptenh(i,k)+pgeoh(i,k))
-            pmfdq(i,k)=pmfdq(i,k)-pmfd(i,k)*pqenh(i,k)
-         ELSE
-            pmfd(i,k)=0.
-            pmfds(i,k)=0.
-            pmfdq(i,k)=0.
-            pdmfdp(i,k-1)=0.
-         END IF
-      ELSE
-         pmfu(i,k)=0.
-         pmfus(i,k)=0.
-         pmfuq(i,k)=0.
-         pmful(i,k)=0.
-         pdmfup(i,k-1)=0.
-         plude(i,k-1)=0.
-         pmfd(i,k)=0.
-         pmfds(i,k)=0.
-         pmfdq(i,k)=0.
-         pdmfdp(i,k-1)=0.
-      ENDIF
-  115 CONTINUE
-  120 CONTINUE
-c
-      DO 130 k=ktopm2,klev
-      DO 125 i = 1, klon
-      IF(ldcum(i).AND.k.GT.kcbot(i)) THEN
-         ikb=kcbot(i)
-         zzp=((paph(i,klev+1)-paph(i,k))/
-     .        (paph(i,klev+1)-paph(i,ikb)))
-         IF (ktype(i).EQ.3) zzp = zzp**2
-         pmfu(i,k)=pmfu(i,ikb)*zzp
-         pmfus(i,k)=pmfus(i,ikb)*zzp
-         pmfuq(i,k)=pmfuq(i,ikb)*zzp
-         pmful(i,k)=pmful(i,ikb)*zzp
-      ENDIF
-  125 CONTINUE
-  130 CONTINUE
-c
-c CALCULATE RAIN/SNOW FALL RATES
-c CALCULATE MELTING OF SNOW
-c CALCULATE EVAPORATION OF PRECIP
-c
-      DO k = 1, klev+1
-      DO i = 1, klon
-         pmflxr(i,k) = 0.0
-         pmflxs(i,k) = 0.0
-      ENDDO
-      ENDDO
-      DO k = ktopm2, klev
-      DO i = 1, klon
-      IF (ldcum(i)) THEN
-         IF (pmflxs(i,k).GT.0.0 .AND. pten(i,k).GT.ztmelp2) THEN
-            zfac=zcons1*(paph(i,k+1)-paph(i,k))
-            zsnmlt=MIN(pmflxs(i,k),zfac*(pten(i,k)-ztmelp2))
-            pdpmel(i,k)=zsnmlt
-            ztmsmlt=pten(i,k)-zsnmlt/zfac
-            zdelta=MAX(0.,SIGN(1.,RTT-ztmsmlt))
-            zqsat=R2ES*FOEEW(ztmsmlt, zdelta) / pap(i,k)
-            zqsat=MIN(0.5,zqsat)
-            zqsat=zqsat/(1.-RETV  *zqsat)
-            pqsen(i,k) = zqsat
-         ENDIF
-         IF (pten(i,k).GT.RTT) THEN
-         pmflxr(i,k+1)=pmflxr(i,k)+pdmfup(i,k)+pdmfdp(i,k)+pdpmel(i,k)
-         pmflxs(i,k+1)=pmflxs(i,k)-pdpmel(i,k)
-         ELSE
-           pmflxs(i,k+1)=pmflxs(i,k)+pdmfup(i,k)+pdmfdp(i,k)
-           pmflxr(i,k+1)=pmflxr(i,k)
-         ENDIF
-c        si la precipitation est negative, on ajuste le plux du
-c        panache descendant pour eliminer la negativite
-         IF ((pmflxr(i,k+1)+pmflxs(i,k+1)).LT.0.0) THEN
-            pdmfdp(i,k) = -pmflxr(i,k)-pmflxs(i,k)-pdmfup(i,k)
-            pmflxr(i,k+1) = 0.0
-            pmflxs(i,k+1) = 0.0
-            pdpmel(i,k) = 0.0
-         ENDIF
-      ENDIF
-      ENDDO
-      ENDDO
-c
-cjq The new variable is initialized here.
-cjq It contains the humidity which is fed to the downdraft
-cjq by evaporation of precipitation in the column below the base
-cjq of convection.
-cjq 
-cjq In the former version, this term has been subtracted from precip
-cjq as well as the evaporation.
-cjq      
-      DO k = 1, klev
-      DO i = 1, klon 
-         maxpdmfdp(i,k)=0.0
-      ENDDO
-      ENDDO
-      DO k = 1, klev
-       DO kp = k, klev
-        DO i = 1, klon
-         maxpdmfdp(i,k)=maxpdmfdp(i,k)+pdmfdp(i,kp)
-        ENDDO
-       ENDDO
-      ENDDO
-cjq End of initialization
-c      
-      DO k = ktopm2, klev
-      DO i = 1, klon
-      IF (ldcum(i) .AND. k.GE.kcbot(i)) THEN
-         zrfl = pmflxr(i,k) + pmflxs(i,k)
-         IF (zrfl.GT.1.0E-20) THEN
-            zrnew=(MAX(0.,SQRT(zrfl/zcucov)-
-     .            CEVAPCU(k)*(paph(i,k+1)-paph(i,k))*
-     .            MAX(0.,pqsen(i,k)-pqen(i,k))))**2*zcucov
-            zrmin=zrfl-zcucov*MAX(0.,0.8*pqsen(i,k)-pqen(i,k))
-     .            *zcons2*(paph(i,k+1)-paph(i,k))
-            zrnew=MAX(zrnew,zrmin)
-            zrfln=MAX(zrnew,0.)
-            zdrfl=MIN(0.,zrfln-zrfl)
-cjq At least the amount of precipiation needed to feed the downdraft
-cjq with humidity below the base of convection has to be left and can't
-cjq be evaporated (surely the evaporation can't be positive):            
-            zdrfl=MAX(zdrfl,
-     .            MIN(-pmflxr(i,k)-pmflxs(i,k)-maxpdmfdp(i,k),0.0))
-cjq End of insertion
-c            
-            zdenom=1.0/MAX(1.0E-20,pmflxr(i,k)+pmflxs(i,k))
-            IF (pten(i,k).GT.RTT) THEN
-               zpdr = pdmfdp(i,k)
-               zpds = 0.0
-            ELSE
-               zpdr = 0.0
-               zpds = pdmfdp(i,k)
-            ENDIF
-            pmflxr(i,k+1) = pmflxr(i,k) + zpdr + pdpmel(i,k)
-     .                    + zdrfl*pmflxr(i,k)*zdenom
-            pmflxs(i,k+1) = pmflxs(i,k) + zpds - pdpmel(i,k)
-     .                    + zdrfl*pmflxs(i,k)*zdenom
-            pdmfup(i,k) = pdmfup(i,k) + zdrfl
-         ELSE
-            pmflxr(i,k+1) = 0.0
-            pmflxs(i,k+1) = 0.0
-            pdmfdp(i,k) = 0.0
-            pdpmel(i,k) = 0.0
-         ENDIF         
-         if (pmflxr(i,k) + pmflxs(i,k).lt.-1.e-26) 
-     .    write(*,*) 'precip. < 1e-16 ',pmflxr(i,k) + pmflxs(i,k)
-      ENDIF
-      ENDDO
-      ENDDO
-c
-      DO 210 i = 1, klon
-         prfl(i) = pmflxr(i,klev+1)
-         psfl(i) = pmflxs(i,klev+1)
-  210 CONTINUE
-c
-      RETURN
-      END
-      SUBROUTINE flxdtdq(pdtime, ktopm2, paph, ldcum, pten
-     .  ,  pmfus, pmfds, pmfuq, pmfdq, pmful, pdmfup, pdmfdp
-     .  ,  pdpmel, dt_con, dq_con)
-      IMPLICIT none
-c----------------------------------------------------------------------
-c calculer les tendances T et Q
-c----------------------------------------------------------------------
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "YOECUMF.h"
-C     -----------------------------------------------------------------
-      LOGICAL  llo1
-C
-      REAL pten(klon,klev), paph(klon,klev+1)
-      REAL pmfus(klon,klev), pmfuq(klon,klev), pmful(klon,klev)
-      REAL pmfds(klon,klev), pmfdq(klon,klev)
-      REAL pdmfup(klon,klev)
-      REAL pdmfdp(klon,klev)
-      REAL pdpmel(klon,klev)
-      LOGICAL ldcum(klon)
-      REAL dt_con(klon,klev), dq_con(klon,klev)
-c
-      INTEGER ktopm2
-      REAL pdtime
-c
-      INTEGER i, k
-      REAL zalv, zdtdt, zdqdt
-c
-      DO 210 k=ktopm2,klev-1
-      DO 220 i = 1, klon
-      IF (ldcum(i)) THEN
-         llo1 = (pten(i,k)-RTT).GT.0.
-         zalv = RLSTT
-         IF (llo1) zalv = RLVTT
-         zdtdt=RG/(paph(i,k+1)-paph(i,k))/RCPD
-     .        *(pmfus(i,k+1)-pmfus(i,k)
-     .         +pmfds(i,k+1)-pmfds(i,k)
-     .          -RLMLT*pdpmel(i,k)
-     .          -zalv*(pmful(i,k+1)-pmful(i,k)-pdmfup(i,k)-pdmfdp(i,k))
-     .         )
-         dt_con(i,k)=zdtdt
-         zdqdt=RG/(paph(i,k+1)-paph(i,k))
-     .        *(pmfuq(i,k+1)-pmfuq(i,k)
-     .         +pmfdq(i,k+1)-pmfdq(i,k)
-     .          +pmful(i,k+1)-pmful(i,k)-pdmfup(i,k)-pdmfdp(i,k))
-         dq_con(i,k)=zdqdt
-      ENDIF
-  220 CONTINUE
-  210 CONTINUE
-C
-      k = klev
-      DO 230 i = 1, klon
-      IF (ldcum(i)) THEN
-         llo1 = (pten(i,k)-RTT).GT.0.
-         zalv = RLSTT
-         IF (llo1) zalv = RLVTT
-         zdtdt=-RG/(paph(i,k+1)-paph(i,k))/RCPD
-     .         *(pmfus(i,k)+pmfds(i,k)+RLMLT*pdpmel(i,k)
-     .           -zalv*(pmful(i,k)+pdmfup(i,k)+pdmfdp(i,k)))
-         dt_con(i,k)=zdtdt
-         zdqdt=-RG/(paph(i,k+1)-paph(i,k))
-     .            *(pmfuq(i,k)+pmfdq(i,k)+pmful(i,k)
-     .             +pdmfup(i,k)+pdmfdp(i,k))
-         dq_con(i,k)=zdqdt
-      ENDIF
-  230 CONTINUE
-C
-      RETURN
-      END
-      SUBROUTINE flxdlfs(ptenh, pqenh, pgeoh, paph, ptu, pqu,
-     .     ldcum, kcbot, kctop, pmfub, prfl, ptd, pqd,
-     .     pmfd, pmfds, pmfdq, pdmfdp, kdtop, lddraf)
-      IMPLICIT none
-C
-C----------------------------------------------------------------------
-C THIS ROUTINE CALCULATES LEVEL OF FREE SINKING FOR
-C CUMULUS DOWNDRAFTS AND SPECIFIES T,Q,U AND V VALUES
-C
-C TO PRODUCE LFS-VALUES FOR CUMULUS DOWNDRAFTS
-C FOR MASSFLUX CUMULUS PARAMETERIZATION
-C
-C INPUT ARE ENVIRONMENTAL VALUES OF T,Q,U,V,P,PHI
-C AND UPDRAFT VALUES T,Q,U AND V AND ALSO
-C CLOUD BASE MASSFLUX AND CU-PRECIPITATION RATE.
-C IT RETURNS T,Q,U AND V VALUES AND MASSFLUX AT LFS.
-C
-C CHECK FOR NEGATIVE BUOYANCY OF AIR OF EQUAL PARTS OF
-C MOIST ENVIRONMENTAL AIR AND CLOUD AIR.
-C----------------------------------------------------------------------
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "YOECUMF.h"
-C
-      REAL ptenh(klon,klev)
-      REAL pqenh(klon,klev)
-      REAL pgeoh(klon,klev), paph(klon,klev+1)
-      REAL ptu(klon,klev), pqu(klon,klev)
-      REAL pmfub(klon)
-      REAL prfl(klon)
-C
-      REAL ptd(klon,klev), pqd(klon,klev)
-      REAL pmfd(klon,klev), pmfds(klon,klev), pmfdq(klon,klev)
-      REAL pdmfdp(klon,klev)
-      INTEGER  kcbot(klon), kctop(klon), kdtop(klon)
-      LOGICAL  ldcum(klon), lddraf(klon)
-C
-      REAL ztenwb(klon,klev), zqenwb(klon,klev), zcond(klon)
-      REAL zttest, zqtest, zbuo, zmftop
-      LOGICAL  llo2(klon)
-      INTEGER i, k, is, icall
-C----------------------------------------------------------------------
-      DO i= 1, klon
-         lddraf(i)=.FALSE.
-         kdtop(i)=klev+1
-      ENDDO
-C
-C----------------------------------------------------------------------
-C DETERMINE LEVEL OF FREE SINKING BY
-C DOING A SCAN FROM TOP TO BASE OF CUMULUS CLOUDS
-C
-C FOR EVERY POINT AND PROCEED AS FOLLOWS:
-C     (1) DETEMINE WET BULB ENVIRONMENTAL T AND Q
-C     (2) DO MIXING WITH CUMULUS CLOUD AIR
-C     (3) CHECK FOR NEGATIVE BUOYANCY
-C
-C THE ASSUMPTION IS THAT AIR OF DOWNDRAFTS IS MIXTURE
-C OF 50% CLOUD AIR + 50% ENVIRONMENTAL AIR AT WET BULB
-C TEMPERATURE (I.E. WHICH BECAME SATURATED DUE TO
-C EVAPORATION OF RAIN AND CLOUD WATER)
-C----------------------------------------------------------------------
-C
-      DO 290 k = 3, klev-3
-C
-      is=0
-      DO 212 i= 1, klon
-         ztenwb(i,k)=ptenh(i,k)
-         zqenwb(i,k)=pqenh(i,k)
-         llo2(i) = ldcum(i).AND.prfl(i).GT.0.
-     .             .AND..NOT.lddraf(i)
-     .             .AND.(k.LT.kcbot(i).AND.k.GT.kctop(i))
-         IF ( llo2(i) ) is = is + 1
-  212 CONTINUE
-      IF(is.EQ.0) GO TO 290
-C
-      icall=2
-      CALL flxadjtq(paph(1,k), ztenwb(1,k), zqenwb(1,k), llo2, icall)
-C
-C----------------------------------------------------------------------
-C DO MIXING OF CUMULUS AND ENVIRONMENTAL AIR
-C AND CHECK FOR NEGATIVE BUOYANCY.
-C THEN SET VALUES FOR DOWNDRAFT AT LFS.
-C----------------------------------------------------------------------
-      DO 222 i= 1, klon
-      IF (llo2(i)) THEN
-         zttest=0.5*(ptu(i,k)+ztenwb(i,k))
-         zqtest=0.5*(pqu(i,k)+zqenwb(i,k))
-         zbuo=zttest*(1.+RETV*zqtest)-
-     .        ptenh(i,k)*(1.+RETV  *pqenh(i,k))
-         zcond(i)=pqenh(i,k)-zqenwb(i,k)
-         zmftop=-CMFDEPS*pmfub(i)
-         IF (zbuo.LT.0..AND.prfl(i).GT.10.*zmftop*zcond(i)) THEN
-            kdtop(i)=k
-            lddraf(i)=.TRUE.
-            ptd(i,k)=zttest
-            pqd(i,k)=zqtest
-            pmfd(i,k)=zmftop
-            pmfds(i,k)=pmfd(i,k)*(RCPD*ptd(i,k)+pgeoh(i,k))
-            pmfdq(i,k)=pmfd(i,k)*pqd(i,k)
-            pdmfdp(i,k-1)=-0.5*pmfd(i,k)*zcond(i)
-            prfl(i)=prfl(i)+pdmfdp(i,k-1)
-         ENDIF
-      ENDIF
-  222 CONTINUE
-c
-  290 CONTINUE
-C
-      RETURN
-      END
-      SUBROUTINE flxddraf(ptenh, pqenh, pgeoh, paph, prfl,
-     .           ptd, pqd, pmfd, pmfds, pmfdq, pdmfdp,
-     .           lddraf, pen_d, pde_d)
-      IMPLICIT none
-C
-C----------------------------------------------------------------------
-C          THIS ROUTINE CALCULATES CUMULUS DOWNDRAFT DESCENT
-C
-C          TO PRODUCE THE VERTICAL PROFILES FOR CUMULUS DOWNDRAFTS
-C          (I.E. T,Q,U AND V AND FLUXES)
-C
-C          INPUT IS T,Q,P,PHI,U,V AT HALF LEVELS.
-C          IT RETURNS FLUXES OF S,Q AND EVAPORATION RATE
-C          AND U,V AT LEVELS WHERE DOWNDRAFT OCCURS
-C
-C          CALCULATE MOIST DESCENT FOR ENTRAINING/DETRAINING PLUME BY
-C          A) MOVING AIR DRY-ADIABATICALLY TO NEXT LEVEL BELOW AND
-C          B) CORRECTING FOR EVAPORATION TO OBTAIN SATURATED STATE.
-C
-C----------------------------------------------------------------------
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "YOECUMF.h"
-C
-      REAL ptenh(klon,klev), pqenh(klon,klev)
-      REAL pgeoh(klon,klev), paph(klon,klev+1)
-C
-      REAL ptd(klon,klev), pqd(klon,klev)
-      REAL pmfd(klon,klev), pmfds(klon,klev), pmfdq(klon,klev)
-      REAL pdmfdp(klon,klev)
-      REAL prfl(klon)
-      LOGICAL lddraf(klon)
-C
-      REAL pen_d(klon,klev), pde_d(klon,klev), zcond(klon)
-      LOGICAL llo2(klon), llo1
-      INTEGER i, k, is, icall, itopde
-      REAL zentr, zseen, zqeen, zsdde, zqdde, zmfdsk, zmfdqk, zdmfdp
-      REAL zbuo
-C----------------------------------------------------------------------
-C CALCULATE MOIST DESCENT FOR CUMULUS DOWNDRAFT BY
-C       (A) CALCULATING ENTRAINMENT RATES, ASSUMING
-C           LINEAR DECREASE OF MASSFLUX IN PBL
-C       (B) DOING MOIST DESCENT - EVAPORATIVE COOLING
-C           AND MOISTENING IS CALCULATED IN *flxadjtq*
-C       (C) CHECKING FOR NEGATIVE BUOYANCY AND
-C           SPECIFYING FINAL T,Q,U,V AND DOWNWARD FLUXES
-C
-      DO 180 k = 3, klev
-c
-      is = 0
-      DO i = 1, klon
-         llo2(i)=lddraf(i).AND.pmfd(i,k-1).LT.0.
-         IF (llo2(i)) is = is + 1
-      ENDDO
-      IF (is.EQ.0) GOTO 180
-c
-      DO i = 1, klon
-      IF (llo2(i)) THEN
-         zentr = ENTRDD*pmfd(i,k-1)*RD*ptenh(i,k-1)/
-     .           (RG*paph(i,k-1))*(paph(i,k)-paph(i,k-1))
-         pen_d(i,k) = zentr
-         pde_d(i,k) = zentr
-      ENDIF
-      ENDDO
-c
-      itopde = klev-2
-      IF (k.GT.itopde) THEN
-         DO i = 1, klon
-         IF (llo2(i)) THEN
-            pen_d(i,k)=0.
-            pde_d(i,k)=pmfd(i,itopde)*
-     .      (paph(i,k)-paph(i,k-1))/(paph(i,klev+1)-paph(i,itopde))
-         ENDIF
-         ENDDO
-      ENDIF
-C
-      DO i = 1, klon
-      IF (llo2(i)) THEN
-         pmfd(i,k) = pmfd(i,k-1)+pen_d(i,k)-pde_d(i,k)
-         zseen = (RCPD*ptenh(i,k-1)+pgeoh(i,k-1))*pen_d(i,k)
-         zqeen = pqenh(i,k-1)*pen_d(i,k)
-         zsdde = (RCPD*ptd(i,k-1)+pgeoh(i,k-1))*pde_d(i,k)
-         zqdde = pqd(i,k-1)*pde_d(i,k)
-         zmfdsk = pmfds(i,k-1)+zseen-zsdde
-         zmfdqk = pmfdq(i,k-1)+zqeen-zqdde
-         pqd(i,k) = zmfdqk*(1./MIN(-CMFCMIN,pmfd(i,k)))
-         ptd(i,k) = (zmfdsk*(1./MIN(-CMFCMIN,pmfd(i,k)))-
-     .               pgeoh(i,k))/RCPD
-         ptd(i,k) = MIN(400.,ptd(i,k))
-         ptd(i,k) = MAX(100.,ptd(i,k))
-         zcond(i) = pqd(i,k)
-      ENDIF
-      ENDDO
-C
-      icall = 2
-      CALL flxadjtq(paph(1,k), ptd(1,k), pqd(1,k), llo2, icall)
-C
-      DO i = 1, klon
-      IF (llo2(i)) THEN
-         zcond(i) = zcond(i)-pqd(i,k)
-         zbuo = ptd(i,k)*(1.+RETV  *pqd(i,k))-
-     .          ptenh(i,k)*(1.+RETV  *pqenh(i,k))
-         llo1 = zbuo.LT.0..AND.(prfl(i)-pmfd(i,k)*zcond(i).GT.0.)
-         IF (.not.llo1) pmfd(i,k) = 0.0
-         pmfds(i,k) = (RCPD*ptd(i,k)+pgeoh(i,k))*pmfd(i,k)
-         pmfdq(i,k) = pqd(i,k)*pmfd(i,k)
-         zdmfdp = -pmfd(i,k)*zcond(i)
-         pdmfdp(i,k-1) = zdmfdp
-         prfl(i) = prfl(i)+zdmfdp
-      ENDIF
-      ENDDO
-c
-  180 CONTINUE
-      RETURN
-      END
-      SUBROUTINE flxadjtq(pp, pt, pq, ldflag, kcall)
-      IMPLICIT none
-c======================================================================
-c Objet: ajustement entre T et Q
-c======================================================================
-C NOTE: INPUT PARAMETER kcall DEFINES CALCULATION AS
-C        kcall=0    ENV. T AND QS IN*CUINI*
-C        kcall=1  CONDENSATION IN UPDRAFTS  (E.G. CUBASE, CUASC)
-C        kcall=2  EVAPORATION IN DOWNDRAFTS (E.G. CUDLFS,CUDDRAF)
-C
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-C
-      REAL pt(klon), pq(klon), pp(klon)
-      LOGICAL ldflag(klon)
-      INTEGER kcall
-c
-      REAL zcond(klon), zcond1
-      REAL Z5alvcp, z5alscp, zalvdcp, zalsdcp
-      REAL zdelta, zcvm5, zldcp, zqsat, zcor
-      INTEGER is, i
-#include "YOETHF.h"
-#include "FCTTRE.h"
-C
-      z5alvcp = r5les*RLVTT/RCPD
-      z5alscp = r5ies*RLSTT/RCPD
-      zalvdcp = rlvtt/RCPD
-      zalsdcp = rlstt/RCPD
-C
-
-      DO i = 1, klon
-         zcond(i) = 0.0
-      ENDDO
-
-      DO 210 i =1, klon
-      IF (ldflag(i)) THEN
-         zdelta = MAX(0.,SIGN(1.,RTT-pt(i)))
-         zcvm5 = z5alvcp*(1.-zdelta) + zdelta*z5alscp
-         zldcp = zalvdcp*(1.-zdelta) + zdelta*zalsdcp
-         zqsat = R2ES*FOEEW(pt(i),zdelta) / pp(i)
-         zqsat = MIN(0.5,zqsat)
-         zcor = 1./(1.-RETV*zqsat)
-         zqsat = zqsat*zcor
-         zcond(i) = (pq(i)-zqsat)
-     .     / (1. + FOEDE(pt(i), zdelta, zcvm5, zqsat, zcor))
-         IF (kcall.EQ.1) zcond(i) = MAX(zcond(i),0.)
-         IF (kcall.EQ.2) zcond(i) = MIN(zcond(i),0.)
-         pt(i) = pt(i) + zldcp*zcond(i)
-         pq(i) = pq(i) - zcond(i)
-      ENDIF
-  210 CONTINUE
-C
-      is = 0
-      DO i =1, klon
-         IF (zcond(i).NE.0.) is = is + 1
-      ENDDO
-      IF (is.EQ.0) GOTO 230
-C
-      DO 220 i = 1, klon
-      IF(ldflag(i).AND.zcond(i).NE.0.) THEN
-         zdelta = MAX(0.,SIGN(1.,RTT-pt(i)))
-         zcvm5 = z5alvcp*(1.-zdelta) + zdelta*z5alscp
-         zldcp = zalvdcp*(1.-zdelta) + zdelta*zalsdcp
-         zqsat = R2ES* FOEEW(pt(i),zdelta) / pp(i)
-         zqsat = MIN(0.5,zqsat)
-         zcor = 1./(1.-RETV*zqsat)
-         zqsat = zqsat*zcor
-         zcond1 = (pq(i)-zqsat)
-     .     / (1. + FOEDE(pt(i),zdelta,zcvm5,zqsat,zcor))
-         pt(i) = pt(i) + zldcp*zcond1
-         pq(i) = pq(i) - zcond1
-      ENDIF
-  220 CONTINUE
-C
-  230 CONTINUE
-      RETURN
-      END
-      SUBROUTINE flxsetup
-      IMPLICIT none
-C
-C     THIS ROUTINE DEFINES DISPOSABLE PARAMETERS FOR MASSFLUX SCHEME
-C
-#include "YOECUMF.h"
-C
-      ENTRPEN=1.0E-4  ! ENTRAINMENT RATE FOR PENETRATIVE CONVECTION
-      ENTRSCV=3.0E-4  ! ENTRAINMENT RATE FOR SHALLOW CONVECTION
-      ENTRMID=1.0E-4  ! ENTRAINMENT RATE FOR MIDLEVEL CONVECTION
-      ENTRDD =2.0E-4  ! ENTRAINMENT RATE FOR DOWNDRAFTS
-      CMFCTOP=0.33  ! RELATIVE CLOUD MASSFLUX AT LEVEL ABOVE NONBUO LEVEL
-      CMFCMAX=1.0  ! MAXIMUM MASSFLUX VALUE ALLOWED FOR UPDRAFTS ETC
-      CMFCMIN=1.E-10  ! MINIMUM MASSFLUX VALUE (FOR SAFETY)
-      CMFDEPS=0.3  ! FRACTIONAL MASSFLUX FOR DOWNDRAFTS AT LFS
-      CPRCON =2.0E-4  ! CONVERSION FROM CLOUD WATER TO RAIN
-      RHCDD=1.  ! RELATIVE SATURATION IN DOWNDRAFRS (NO LONGER USED)
-c                 (FORMULATION IMPLIES SATURATION)
-      LMFPEN = .TRUE.
-      LMFSCV = .TRUE.
-      LMFMID = .TRUE.
-      LMFDD = .TRUE.
-      LMFDUDV = .TRUE.
-c
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/conlmd.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/conlmd.F	(revision 416)
+++ 	(revision )
@@ -1,2305 +1,0 @@
-      SUBROUTINE conlmd (dtime, paprs, pplay, t, q, conv_q,
-     s                   d_t, d_q, rain, snow, ibas, itop)
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
-c Objet: Schema de convection utilis'e dans le modele du LMD
-c        Ajustement humide (Manabe) + Ajustement convectif (Kuo)
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "YOETHF.h"
-c
-c Arguments:
-c
-      REAL dtime              ! pas d'integration (s)
-      REAL paprs(klon,klev+1) ! pression inter-couche (Pa)
-      REAL pplay(klon,klev)   ! pression au milieu de couche (Pa)
-      REAL t(klon,klev)       ! temperature (K)
-      REAL q(klon,klev)       ! humidite specifique (kg/kg)
-      REAL conv_q(klon,klev)  ! taux de convergence humidite (g/g/s)
-c
-      REAL d_t(klon,klev)     ! incrementation temperature
-      REAL d_q(klon,klev)     ! incrementation humidite
-      REAL rain(klon)         ! pluies (mm/s)
-      REAL snow(klon)         ! neige (mm/s)
-      INTEGER ibas(klon)      ! niveau du bas
-      INTEGER itop(klon)      ! niveau du haut
-c
-      LOGICAL usekuo ! utiliser convection profonde (schema Kuo)
-      PARAMETER (usekuo=.TRUE.)
-c
-      REAL d_t_bis(klon,klev)
-      REAL d_q_bis(klon,klev)
-      REAL rain_bis(klon)
-      REAL snow_bis(klon)
-      INTEGER ibas_bis(klon)
-      INTEGER itop_bis(klon)
-      REAL d_ql(klon,klev), d_ql_bis(klon,klev)
-      REAL rneb(klon,klev), rneb_bis(klon,klev)
-c
-      INTEGER i, k
-      REAL zlvdcp, zlsdcp, zdelta, zz, za, zb
-c
-ccc      CALL fiajh ! ancienne version de Convection Manabe
-      CALL conman ! nouvelle version de Convection Manabe
-     e     (dtime, paprs, pplay, t, q,
-     s      d_t, d_q, d_ql, rneb,
-     s      rain, snow, ibas, itop)
-c
-      IF (usekuo) THEN
-ccc      CALL fiajc ! ancienne version de Convection Kuo
-      CALL conkuo ! nouvelle version de Convection Kuo
-     e     (dtime, paprs, pplay, t, q, conv_q,
-     s      d_t_bis, d_q_bis, d_ql_bis, rneb_bis, 
-     s      rain_bis, snow_bis, ibas_bis, itop_bis)
-      DO k = 1, klev
-      DO i = 1, klon
-         d_t(i,k) = d_t(i,k) + d_t_bis(i,k)
-         d_q(i,k) = d_q(i,k) + d_q_bis(i,k)
-         d_ql(i,k) = d_ql(i,k) + d_ql_bis(i,k)
-      ENDDO
-      ENDDO
-      DO i = 1, klon
-         rain(i) = rain(i) + rain_bis(i)
-         snow(i) = snow(i) + snow_bis(i)
-         ibas(i) = MIN(ibas(i),ibas_bis(i))
-         itop(i) = MAX(itop(i),itop_bis(i))
-      ENDDO
-      ENDIF
-c
-c L'eau liquide convective est dispersee dans l'air:
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q(i,k))
-         zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*q(i,k))
-         zdelta = MAX(0.,SIGN(1.,RTT-t(i,k)))
-         zz = d_ql(i,k) ! re-evap. de l'eau liquide
-         zb = MAX(0.0,zz)
-         za = - MAX(0.0,zz) * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
-         d_t(i,k) = d_t(i,k) + za
-         d_q(i,k) = d_q(i,k) + zb
-      ENDDO
-      ENDDO
-c
-      RETURN
-      END
-      SUBROUTINE conman (dtime, paprs, pplay, t, q,
-     s                   d_t, d_q, d_ql, rneb,
-     s                   rain, snow, ibas, itop)
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS) date: 19970324
-c Objet: ajustement humide convectif avec la possibilite de faire
-c        l'ajustement sur une fraction de la maille.
-c Methode: On impose une distribution uniforme pour la vapeur d'eau
-c au sein d'une maille. On applique la procedure d'ajustement
-c successivement a la totalite, 75%, 50%, 25% et 5% de la maille
-c jusqu'a ce que l'ajustement a lieu. J'espere que ceci augmente
-c les activites convectives et corrige le biais "trop froid et sec"
-c du modele.
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-c
-      REAL dtime              ! pas d'integration (s)
-      REAL t(klon,klev)       ! temperature (K)
-      REAL q(klon,klev)       ! humidite specifique (kg/kg)
-      REAL paprs(klon,klev+1) ! pression inter-couche (Pa)
-      REAL pplay(klon,klev)   ! pression au milieu de couche (Pa)
-c
-      REAL d_t(klon,klev)     ! incrementation temperature
-      REAL d_q(klon,klev)     ! incrementation humidite
-      REAL d_ql(klon,klev)    ! incrementation eau liquide
-      REAL rneb(klon,klev)    ! nebulosite
-      REAL rain(klon)         ! pluies (mm/s)
-      REAL snow(klon)         ! neige (mm/s)
-      INTEGER ibas(klon)      ! niveau du bas
-      INTEGER itop(klon)      ! niveau du haut
-c
-      LOGICAL afaire(klon)   ! .TRUE. implique l'ajustement
-      LOGICAL accompli(klon) ! .TRUE. si l'ajustement est effectif
-c
-      INTEGER nb ! nombre de sous-fractions a considere
-      PARAMETER (nb=1)
-ccc      PARAMETER (nb=3)
-c
-      REAL ratqs ! largeur de la distribution pour vapeur d'eau
-      PARAMETER (ratqs=0.05)
-c
-      REAL w_q(klon,klev)
-      REAL w_d_t(klon,klev), w_d_q(klon,klev), w_d_ql(klon,klev)
-      REAL w_rneb(klon,klev)
-      REAL w_rain(klon), w_snow(klon)
-      INTEGER w_ibas(klon), w_itop(klon)
-      REAL zq1, zq2
-      INTEGER i, k, n
-c
-      REAL t_coup
-      PARAMETER (t_coup=234.0)
-      REAL zdp1, zdp2
-      REAL zqs1, zqs2, zdqs1, zdqs2
-      REAL zgamdz
-      REAL zflo ! flotabilite
-      REAL zsat ! sur-saturation
-      REAL zdelta, zcor, zcvm5
-      LOGICAL imprim
-c
-      INTEGER ncpt
-      SAVE ncpt
-      REAL frac(nb) ! valeur de la maille fractionnelle
-      SAVE frac
-      INTEGER opt_cld(nb) ! option pour le modele nuageux
-      SAVE opt_cld
-      LOGICAL appel1er
-      SAVE appel1er
-c
-c Fonctions thermodynamiques:
-c
-#include "YOETHF.h"
-#include "FCTTRE.h"
-c
-      DATA frac / 1.0 /
-      DATA opt_cld / 4 /
-ccc      DATA frac    / 1.0, 0.50, 0.25/
-ccc      DATA opt_cld / 4,   4,    4/
-c
-      DATA appel1er /.TRUE./
-      DATA ncpt /0/
-c
-      IF (appel1er) THEN
-         PRINT*, 'conman, nb:', nb
-         PRINT*, 'conman, frac:', frac
-         PRINT*, 'conman, opt_cld:', opt_cld
-         appel1er = .FALSE.
-      ENDIF
-c
-c Initialiser les sorties a zero:
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         d_t(i,k) = 0.0
-         d_q(i,k) = 0.0
-         d_ql(i,k) = 0.0
-         rneb(i,k) = 0.0
-      ENDDO
-      ENDDO
-      DO i = 1, klon
-         ibas(i) = klev
-         itop(i) = 1
-         rain(i) = 0.0
-         snow(i) = 0.0
-      ENDDO
-c
-c S'il n'y a pas d'instabilite conditionnelle,
-c pas la penne de se fatiguer:
-c
-      DO i = 1, klon
-         afaire(i) = .FALSE.
-      ENDDO
-      DO k = 1, klev-1
-      DO i = 1, klon
-         IF (thermcep) THEN
-            zdelta=MAX(0.,SIGN(1.,RTT-t(i,k)))
-            zcvm5=R5LES*RLVTT*(1.-zdelta) + zdelta*R5IES*RLSTT
-            zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*q(i,k))
-            zqs1= R2ES*FOEEW(t(i,k),zdelta)/pplay(i,k)
-            zqs1=MIN(0.5,zqs1)
-            zcor=1./(1.-RETV*zqs1)
-            zqs1=zqs1*zcor
-            zdqs1 =FOEDE(t(i,k),zdelta,zcvm5,zqs1,zcor)
-c
-            zdelta=MAX(0.,SIGN(1.,RTT-t(i,k+1)))
-            zcvm5=R5LES*RLVTT*(1.-zdelta) + zdelta*R5IES*RLSTT
-            zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*q(i,k+1))
-            zqs2= R2ES*FOEEW(t(i,k+1),zdelta)/pplay(i,k+1)
-            zqs2=MIN(0.5,zqs2)
-            zcor=1./(1.-RETV*zqs2)
-            zqs2=zqs2*zcor
-            zdqs2 =FOEDE(t(i,k+1),zdelta,zcvm5,zqs2,zcor)
-         ELSE
-           IF (t(i,k) .LT. t_coup) THEN
-              zqs1= qsats(t(i,k)) / pplay(i,k)
-              zdqs1= dqsats(t(i,k),zqs1)
-c
-              zqs2= qsats(t(i,k+1)) / pplay(i,k+1)
-              zdqs2= dqsats(t(i,k+1),zqs2)
-           ELSE
-              zqs1= qsatl(t(i,k)) / pplay(i,k)
-              zdqs1= dqsatl(t(i,k),zqs1)
-c
-              zqs2= qsatl(t(i,k+1)) / pplay(i,k+1)
-              zdqs2= dqsatl(t(i,k+1),zqs2)
-           ENDIF
-         ENDIF
-         zdp1 = paprs(i,k) - paprs(i,k+1)
-         zdp2 = paprs(i,k+1) - paprs(i,k+2)
-         zgamdz = - (pplay(i,k)-pplay(i,k+1))/paprs(i,k+1)/RCPD
-     .          *( RD*(t(i,k)*zdp1+t(i,k+1)*zdp2)/(zdp1+zdp2)
-     .            +RLVTT*(zqs1*zdp1+zqs2*zdp2)/(zdp1+zdp2)
-     .           ) / (1.0+(zdqs1*zdp1+zdqs2*zdp2)/(zdp1+zdp2) )
-         zflo = t(i,k) + zgamdz - t(i,k+1)
-         zsat = (q(i,k)-zqs1)*zdp1 + (q(i,k+1)-zqs2)*zdp2
-         IF (zflo.GT.0.0) afaire(i) = .TRUE.
-c erreur         IF (zflo.GT.0.0 .AND. zsat.GT.0.0) afaire(i) = .TRUE.
-      ENDDO
-      ENDDO
-c
-      imprim = MOD(ncpt,48).EQ.0
-      DO 99999 n = 1, nb
-c
-      DO k = 1, klev
-      DO i = 1, klon
-      IF (afaire(i)) THEN
-         zq1 = q(i,k) * (1.0-ratqs)
-         zq2 = q(i,k) * (1.0+ratqs)
-         w_q(i,k) = zq2 - frac(n)/2.0 * (zq2-zq1)
-      ENDIF
-      ENDDO
-      ENDDO
-c
-      CALL conmanv (dtime, paprs, pplay, t, w_q,
-     e              afaire, opt_cld(n),
-     s              w_d_t, w_d_q, w_d_ql, w_rneb,
-     s              w_rain, w_snow, w_ibas, w_itop,accompli,imprim)
-      DO k = 1, klev
-      DO i = 1, klon
-      IF (afaire(i) .AND. accompli(i)) THEN
-         d_t(i,k) = w_d_t(i,k) * frac(n)
-         d_q(i,k) = w_d_q(i,k) * frac(n)
-         d_ql(i,k) = w_d_ql(i,k) * frac(n)
-         IF (NINT(w_rneb(i,k)).EQ.1) rneb(i,k) = frac(n)
-      ENDIF
-      ENDDO
-      ENDDO
-      DO i = 1, klon
-      IF (afaire(i) .AND. accompli(i)) THEN
-         rain(i) = w_rain(i) * frac(n)
-         snow(i) = w_snow(i) * frac(n)
-         ibas(i) = MIN(ibas(i),w_ibas(i))
-         itop(i) = MAX(itop(i),w_itop(i))
-      ENDIF
-      ENDDO
-      DO i = 1, klon
-         IF(afaire(i) .AND. accompli(i)) afaire(i) = .FALSE.
-      ENDDO
-c
-99999 CONTINUE
-c
-      ncpt = ncpt + 1
-c
-      RETURN
-      END
-      SUBROUTINE conmanv (dtime, paprs, pplay, t, q,
-     e                    afaire, opt_cld,
-     s                    d_t, d_q, d_ql, rneb,
-     s                    rain, snow, ibas, itop,accompli,imprim)
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
-c Objet: ajustement humide (convection proposee par Manabe).
-c        Pour une colonne verticale, il peut avoir plusieurs blocs
-c        necessitant l'ajustement. ibas est le bas du plus bas bloc
-c        et itop est le haut du plus haut bloc
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-c
-c Arguments:
-c
-      REAL dtime              ! pas d'integration (s)
-      REAL t(klon,klev)       ! temperature (K)
-      REAL q(klon,klev)       ! humidite specifique (kg/kg)
-      REAL paprs(klon,klev+1) ! pression inter-couche (Pa)
-      REAL pplay(klon,klev)   ! pression au milieu de couche (Pa)
-      INTEGER opt_cld ! comment traiter l'eau liquide
-      LOGICAL afaire(klon) ! .TRUE. si le point est a faire (Input)
-      LOGICAL imprim ! .T. pour imprimer quelques diagnostiques
-c
-      REAL d_t(klon,klev)     ! incrementation temperature
-      REAL d_q(klon,klev)     ! incrementation humidite
-      REAL d_ql(klon,klev)    ! incrementation eau liquide
-      REAL rneb(klon,klev)    ! nebulosite
-      REAL rain(klon)         ! pluies (mm/s)
-      REAL snow(klon)         ! neige (mm/s)
-      INTEGER ibas(klon)      ! niveau du bas
-      INTEGER itop(klon)      ! niveau du haut
-      LOGICAL accompli(klon) ! .TRUE. si l'ajustement a eu lieu (Output)
-c
-c Quelques options:
-c
-      LOGICAL new_top ! re-calculer sommet quand re-ajustement est fait
-      PARAMETER (new_top=.FALSE.)
-      LOGICAL evap_prec ! evaporation de pluie au-dessous de convection
-      PARAMETER (evap_prec=.TRUE.)
-      REAL coef_eva
-      PARAMETER (coef_eva=1.0E-05)
-      REAL t_coup
-      PARAMETER (t_coup=234.0)
-      REAL seuil_vap
-      PARAMETER (seuil_vap=1.0E-10)
-      LOGICAL old_tau ! implique precip nulle, si vrai.
-      PARAMETER (old_tau=.FALSE.)
-      REAL toliq(klon) ! rapport entre l'eau nuageuse et l'eau precipitante
-      REAL dpmin, tomax !Epaisseur faible, rapport eau liquide plus grande
-      PARAMETER (dpmin=0.15, tomax=0.97)
-      REAL dpmax, tomin !Epaisseur grande, rapport eau liquide plus faible
-      PARAMETER (dpmax=0.30, tomin=0.05)
-      REAL deep_sig, deep_to ! au dela de deep_sig, utiliser deep_to
-      PARAMETER (deep_sig=0.50, deep_to=0.05)
-      LOGICAL exigent ! implique un calcul supplementaire pour Qs
-      PARAMETER (exigent=.FALSE.)
-c
-      INTEGER kbase
-      PARAMETER (kbase=0)
-c
-c Variables locales:
-c
-      INTEGER nexpo
-      INTEGER i, k, k1min, k1max, k2min, k2max, is
-      REAL zgamdz(klon,klev-1)
-      REAL zt(klon,klev), zq(klon,klev)
-      REAL zqs(klon,klev), zdqs(klon,klev)
-      REAL zqmqsdp(klon,klev)
-      REAL ztnew(klon,klev), zqnew(klon,klev)
-      REAL zcond(klon), zvapo(klon), zrapp(klon)
-      REAL zrfl(klon), zrfln, zqev, zqevt
-      REAL zsat(klon) ! sur-saturation
-      REAL zflo(klon) ! flotabilite
-      REAL za(klon), zb(klon), zc(klon)
-      INTEGER k1(klon), k2(klon)
-      REAL zdelta, zcor, zcvm5
-      REAL delp(klon,klev)
-      LOGICAL possible(klon), todo(klon), etendre(klon)
-      LOGICAL aller(klon), todobis(klon)
-      REAL zalfa
-      INTEGER nbtodo, nbdone
-c
-c Fonctions thermodynamiques:
-c
-#include "YOETHF.h"
-#include "FCTTRE.h"
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         delp(i,k) = paprs(i,k) - paprs(i,k+1)
-      ENDDO
-      ENDDO
-c
-c Initialiser les sorties a zero
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         d_t(i,k) = 0.0
-         d_q(i,k) = 0.0
-         d_ql(i,k) = 0.0
-         rneb(i,k) = 0.0
-      ENDDO
-      ENDDO
-      DO i = 1, klon
-         ibas(i) = klev
-         itop(i) = 1
-         rain(i) = 0.0
-         snow(i) = 0.0
-         accompli(i) = .FALSE.
-      ENDDO
-c
-c Preparations
-c
-      DO k = 1, klev
-      DO i = 1, klon
-      IF (afaire(i)) THEN
-         zt(i,k) = t(i,k)
-         zq(i,k) = q(i,k) 
-c
-c        Calculer Qs et L/Cp*dQs/dT
-c
-         IF (thermcep) THEN
-            zdelta=MAX(0.,SIGN(1.,RTT-zt(i,k)))
-            zcvm5=R5LES*RLVTT*(1.-zdelta) + zdelta*R5IES*RLSTT
-            zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*zq(i,k))
-            zqs(i,k)= R2ES*FOEEW(zt(i,k),zdelta)/pplay(i,k)
-            zqs(i,k)=MIN(0.5,zqs(i,k))
-            zcor=1./(1.-RETV*zqs(i,k))
-            zqs(i,k)=zqs(i,k)*zcor
-            zdqs(i,k) =FOEDE(zt(i,k),zdelta,zcvm5,zqs(i,k),zcor)
-         ELSE
-           IF (zt(i,k) .LT. t_coup) THEN
-              zqs(i,k)= qsats(zt(i,k)) / pplay(i,k)
-              zdqs(i,k)= dqsats(zt(i,k),zqs(i,k))
-           ELSE
-              zqs(i,k)= qsatl(zt(i,k)) / pplay(i,k)
-              zdqs(i,k)= dqsatl(zt(i,k),zqs(i,k))
-           ENDIF
-         ENDIF
-c
-c        Calculer (q-qs)*dp
-         zqmqsdp(i,k) = (zq(i,k)-zqs(i,k)) * delp(i,k)
-      ENDIF
-      ENDDO
-      ENDDO
-c
-c-----zgama is the moist convective lapse rate (-dT/dz).
-c-----zgamdz(*,k) est la difference minimale autorisee des temperatures
-c-----entre deux couches (k et k+1), c.a.d. si T(k+1)-T(k) est inferieur
-c-----a zgamdz(*,k), alors ces 2 couches sont instables conditionnellement
-c
-      DO k = 1, klev-1
-      DO i = 1, klon
-      IF (afaire(i)) THEN
-         zgamdz(i,k) = - (pplay(i,k)-pplay(i,k+1))/paprs(i,k+1)/RCPD
-     .          *( RD*(zt(i,k)*delp(i,k)+zt(i,k+1)*delp(i,k+1))
-     .               /(delp(i,k)+delp(i,k+1))
-     .            +RLVTT*(zqs(i,k)*delp(i,k)+zqs(i,k+1)*delp(i,k+1))
-     .                  /(delp(i,k)+delp(i,k+1))
-     .           ) / (1.0+(zdqs(i,k)*delp(i,k)+zdqs(i,k+1)*delp(i,k+1))
-     .                   /(delp(i,k)+delp(i,k+1)) )
-      ENDIF
-      ENDDO
-      ENDDO
-c
-c On cherche la presence simultanee d'instabilite conditionnelle
-c et de sur-saturation. Sinon, pas la penne de se fatiguer:
-c
-      DO i = 1, klon
-         possible(i) = .FALSE.
-      ENDDO
-      DO k = 2, klev
-      DO i = 1, klon
-      IF (afaire(i)) THEN
-         zflo(i) = zt(i,k-1) + zgamdz(i,k-1) - zt(i,k)
-         zsat(i) = zqmqsdp(i,k) + zqmqsdp(i,k-1)
-         IF (zflo(i).GT.0.0 .AND. zsat(i).GT.0.0) possible(i) = .TRUE.
-      ENDIF
-      ENDDO
-      ENDDO
-c
-      DO i = 1, klon
-      IF (possible(i)) THEN
-         k1(i) = kbase
-         k2(i) = k1(i) + 1
-      ENDIF
-      ENDDO
-c
-  810 CONTINUE ! chercher le bas de la colonne a ajuster
-c
-      k2min = klev
-      DO i = 1, klon
-         todo(i) = .FALSE.
-         aller(i) = .TRUE.
-         IF (possible(i)) k2min = MIN(k2min,k2(i))
-      ENDDO
-      IF (k2min.EQ.klev) GOTO 860
-      DO k = k2min, klev-1
-      DO i = 1, klon
-      IF (possible(i) .AND. k.GE.k2(i) .AND. aller(i)) THEN
-         zflo(i) = zt(i,k) + zgamdz(i,k) - zt(i,k+1)
-         zsat(i) = zqmqsdp(i,k) + zqmqsdp(i,k+1)
-         IF (zflo(i).GT.0.0 .AND. zsat(i).GT.0.0) THEN
-            k1(i) = k
-            k2(i) = k+1
-            todo(i) = .TRUE.
-            aller(i) = .FALSE.
-         ENDIF
-      ENDIF
-      ENDDO
-      ENDDO
-      DO i = 1, klon
-      IF (possible(i).AND.aller(i)) THEN
-         todo(i) = .FALSE.
-         k1(i) = klev
-         k2(i) = klev
-      ENDIF
-      ENDDO
-c
-CCC      DO i = 1, klon
-CCC      IF (possible(i)) THEN
-CCC  811    k2(i) = k2(i) + 1
-CCC         IF (k2(i) .GT. klev) THEN
-CCC            todo(i) = .FALSE.
-CCC            GOTO 812
-CCC         ENDIF
-CCC         k = k2(i)
-CCC         zflo(i) = zt(i,k-1) + zgamdz(i,k-1) - zt(i,k)
-CCC         zsat(i) = zqmqsdp(i,k) + zqmqsdp(i,k-1)
-CCC         IF (zflo(i).LE.0.0 .OR. zsat(i).LE.0.0) GOTO 811
-CCC         k1(i) = k2(i) - 1
-CCC         todo(i) = .TRUE.
-CCC      ENDIF
-CCC  812 CONTINUE
-CCC      ENDDO
-c
-  820 CONTINUE ! chercher le haut de la colonne
-c
-      k2min = klev
-      DO i = 1, klon
-         aller(i) = .TRUE.
-         IF (todo(i)) k2min = MIN(k2min,k2(i))
-      ENDDO
-      IF (k2min.LT.klev) THEN
-      DO k = k2min, klev
-      DO i = 1, klon
-      IF (todo(i) .AND. k.GT.k2(i) .AND. aller(i)) THEN
-            zsat(i) = zsat(i) + zqmqsdp(i,k)
-            zflo(i) = zt(i,k-1) + zgamdz(i,k-1) - zt(i,k)
-            IF (zflo(i).LE.0.0 .OR. zsat(i).LE.0.0) THEN
-               aller(i) = .FALSE.
-            ELSE
-               k2(i) = k
-            ENDIF
-      ENDIF
-      ENDDO
-      ENDDO
-c error      is = 0
-c error      DO i = 1, klon
-c error      IF(todo(i).AND.aller(i)) THEN
-c error         is = is + 1
-c error         todo(i) = .FALSE.
-c error         k2(i) = klev
-c error      ENDIF
-c error      ENDDO
-c error      IF (is.GT.0) THEN
-c error         PRINT*, "Bizard. je pourrais continuer mais j arrete"
-c error         CALL abort
-c error      ENDIF
-      ENDIF
-c
-CCC      DO i = 1, klon
-CCC      IF (todo(i)) THEN
-CCC  821    CONTINUE
-CCC         IF (k2(i) .EQ. klev) GOTO 822
-CCC         k = k2(i) + 1
-CCC         zsat(i) = zsat(i) + zqmqsdp(i,k)
-CCC         zflo(i) = zt(i,k-1) + zgamdz(i,k-1) - zt(i,k)
-CCC         IF (zflo(i).LE.0.0 .OR. zsat(i).LE.0.0) GOTO 822
-CCC         k2(i) = k
-CCC         GOTO 821
-CCC      ENDIF
-CCC  822 CONTINUE
-CCC      ENDDO
-c
-  830 CONTINUE ! faire l'ajustement en sachant k1 et k2
-c
-      is = 0
-      DO i = 1, klon
-      IF (todo(i)) THEN
-         IF (k2(i).LE.k1(i)) is = is + 1
-      ENDIF
-      ENDDO
-      IF (is.GT.0) THEN
-         PRINT*, "Impossible: k1 trop grand ou k2 trop petit"
-         PRINT*, "is=", is
-         CALL abort
-      ENDIF
-c
-      k1min = klev
-      k1max = 1
-      k2max = 1
-      DO i = 1, klon
-      IF (todo(i)) THEN
-         k1min = MIN(k1min,k1(i))
-         k1max = MAX(k1max,k1(i))
-         k2max = MAX(k2max,k2(i))
-      ENDIF
-      ENDDO
-c
-      DO i = 1, klon
-      IF (todo(i)) THEN
-      k = k1(i)
-      za(i) = 0.
-      zb(i) = ( RCPD*(1.+zdqs(i,k))*(zt(i,k)-za(i))
-     .      -RLVTT*(zqs(i,k)-zq(i,k)) )*delp(i,k)
-      zc(i) = delp(i,k) * RCPD*(1.+zdqs(i,k))
-      ENDIF
-      ENDDO
-c
-      DO k = k1min, k2max
-      DO i = 1, klon
-      IF (todo(i) .AND. k.GE.(k1(i)+1) .AND. k.LE.k2(i)) THEN
-         za(i) = za(i) + zgamdz(i,k-1)
-         zb(i) = zb(i)+(RCPD*(1.+zdqs(i,k))*(zt(i,k)-za(i))
-     .           -RLVTT*(zqs(i,k)-zq(i,k)) ) * delp(i,k)
-         zc(i) = zc(i) + delp(i,k)*RCPD*(1.+zdqs(i,k))
-      ENDIF
-      ENDDO
-      ENDDO
-c
-      DO i = 1, klon
-      IF (todo(i)) THEN
-         k = k1(i)
-         ztnew(i,k) = zb(i)/zc(i)
-         zqnew(i,k) = zqs(i,k) + (ztnew(i,k)-zt(i,k))
-     .                          *RCPD/RLVTT*zdqs(i,k)
-      ENDIF
-      ENDDO
-c
-      DO k = k1min, k2max
-      DO i = 1, klon
-      IF (todo(i) .AND. k.GE.(k1(i)+1) .AND. k.LE.k2(i)) THEN
-         ztnew(i,k) = ztnew(i,k-1) + zgamdz(i,k-1)
-         zqnew(i,k) = zqs(i,k) + (ztnew(i,k)-zt(i,k))
-     .                        *RCPD/RLVTT*zdqs(i,k)
-      ENDIF
-      ENDDO
-      ENDDO
-c
-c Quantite de condensation produite pendant l'ajustement:
-c
-      DO i = 1, klon
-         zcond(i) = 0.0
-      ENDDO
-      DO k = k1min, k2max
-      DO i = 1, klon
-      IF (todo(i) .AND. k.GE.k1(i) .AND. k.LE.k2(i)) THEN
-         rneb(i,k) = 1.0
-         zcond(i) = zcond(i) + (zq(i,k)-zqnew(i,k)) *delp(i,k)/RG
-      ENDIF
-      ENDDO
-      ENDDO
-c
-c Si condensation negative, effort completement perdu:
-c
-      DO i = 1, klon
-         IF (todo(i).AND.zcond(i).LE.0.) todo(i) = .FALSE.
-      ENDDO
-c
-c L'ajustement a ete accompli, meme les calculs accessoires
-c ne sont pas encore faits:
-c
-      DO i = 1, klon
-         IF (todo(i)) accompli(i) = .TRUE.
-      ENDDO
-c
-c=====
-c Une fois que la condensation a lieu, on doit construire un
-c "modele nuageux" pour partager la condensation entre l'eau
-c liquide nuageuse et la precipitation (leur rapport toliq
-c est calcule selon l'epaisseur nuageuse). Je suppose que
-c toliq=tomax quand l'epaisseur nuageuse est inferieure a dpmin,
-c et que toliq=tomin quand l'epaisseur depasse dpmax (interpolation
-c lineaire entre dpmin et dpmax).
-c=====
-      DO i = 1, klon
-      IF (todo(i)) THEN
-      toliq(i) = tomax-((paprs(i,k1(i))-paprs(i,k2(i)+1))
-     .                 /paprs(i,1)-dpmin)
-     .                 *(tomax-tomin)/(dpmax-dpmin)
-      toliq(i) = MAX(tomin,MIN(tomax,toliq(i)))
-      IF (pplay(i,k2(i))/paprs(i,1) .LE. deep_sig) toliq(i) = deep_to
-      IF (old_tau) toliq(i) = 1.0
-      ENDIF
-      ENDDO
-c=====
-c On doit aussi determiner la distribution verticale de 
-c l'eau nuageuse. Plusieurs options sont proposees:
-c
-c (0) La condensation precipite integralement (toliq ne sera
-c     pas utilise).
-c (1) L'eau liquide est distribuee entre k1 et k2 et proportionnelle
-c     a la vapeur d'eau locale.
-c (2) Elle est distribuee entre k1 et k2 avec une valeur constante.
-c (3) Elle est seulement distribuee aux couches ou la vapeur d'eau
-c     est effectivement diminuee pendant le processus d'ajustement.
-c (4) Elle est en fonction (lineaire ou exponentielle) de la
-c     distance (epaisseur en pression) avec le niveau k1 (la couche
-c     k1 n'aura donc pas d'eau liquide).
-c=====
-c
-      IF (opt_cld.EQ.0) THEN
-c
-         DO i = 1, klon
-            IF (todo(i)) zrfl(i) = zcond(i) / dtime
-         ENDDO
-c
-      ELSE IF (opt_cld.EQ.1) THEN
-c
-         DO i = 1, klon
-         IF (todo(i)) zvapo(i) = 0.0 ! quantite integrale de vapeur d'eau
-         ENDDO
-         DO k = k1min, k2max
-         DO i = 1, klon
-            IF (todo(i) .AND. k.GE.k1(i) .AND. k.LE.k2(i))
-     .         zvapo(i) = zvapo(i) + zqnew(i,k)*delp(i,k)/RG
-         ENDDO
-         ENDDO
-         DO i = 1, klon
-         IF (todo(i)) THEN
-            zrapp(i) = toliq(i) * zcond(i) / zvapo(i)
-            zrapp(i) = MAX(0.,MIN(1.,zrapp(i)))
-            zrfl(i) = (1.0-toliq(i)) * zcond(i) / dtime
-         ENDIF
-         ENDDO
-         DO k = k1min, k2max
-         DO i = 1, klon
-         IF (todo(i) .AND. k.GE.k1(i) .AND. k.LE.k2(i)) THEN
-            d_ql(i,k) = d_ql(i,k) + zrapp(i) * zqnew(i,k)
-         ENDIF
-         ENDDO
-         ENDDO
-c
-      ELSE IF (opt_cld.EQ.2) THEN
-c
-         DO i = 1, klon
-         IF (todo(i)) zvapo(i) = 0.0 ! quantite integrale de masse
-         ENDDO
-         DO k = k1min, k2max
-         DO i = 1, klon
-            IF (todo(i) .AND. k.GE.k1(i) .AND. k.LE.k2(i))
-     .         zvapo(i) = zvapo(i) + delp(i,k)/RG
-         ENDDO
-         ENDDO
-         DO k = k1min, k2max
-         DO i = 1, klon
-         IF (todo(i) .AND. k.GE.k1(i) .AND. k.LE.k2(i)) THEN
-            d_ql(i,k) = d_ql(i,k) + toliq(i) * zcond(i) / zvapo(i)
-         ENDIF
-         ENDDO
-         ENDDO
-         DO i = 1, klon
-            IF (todo(i)) zrfl(i) = (1.0-toliq(i)) * zcond(i) / dtime
-         ENDDO
-c
-      ELSE IF (opt_cld.EQ.3) THEN
-c
-         DO i = 1, klon
-         IF (todo(i)) zvapo(i) = 0.0 ! quantite de l'eau strictement condensee
-         ENDDO
-         DO k = k1min, k2max
-         DO i = 1, klon
-            IF (todo(i) .AND. k.GE.k1(i) .AND. k.LE.k2(i))
-     .      zvapo(i) = zvapo(i) + MAX(0.0,zq(i,k)-zqnew(i,k)) 
-     .                          * delp(i,k)/RG
-         ENDDO
-         ENDDO
-         DO k = k1min, k2max
-         DO i = 1, klon
-         IF (todo(i) .AND. k.GE.k1(i) .AND. k.LE.k2(i) .AND.
-     .       zvapo(i).GT.0.0)
-     .      d_ql(i,k) = d_ql(i,k) + toliq(i) * zcond(i) / zvapo(i)
-     .                            * MAX(0.0,zq(i,k)-zqnew(i,k))
-         ENDDO
-         ENDDO
-         DO i = 1, klon
-            IF (todo(i)) zrfl(i) = (1.0-toliq(i)) * zcond(i) / dtime
-         ENDDO
-c
-      ELSE IF (opt_cld.EQ.4) THEN
-c
-         nexpo = 3
-ccc         nexpo = 1 ! distribution lineaire
-c
-         DO i = 1, klon
-         IF (todo(i)) zvapo(i) = 0.0 ! quantite integrale de masse 
-         ENDDO                       ! (avec ponderation)
-         DO k = k1min, k2max
-         DO i = 1, klon
-            IF (todo(i) .AND. k.GE.(k1(i)+1) .AND. k.LE.k2(i))
-     .         zvapo(i) = zvapo(i) + delp(i,k) / RG
-     .                    * (pplay(i,k1(i))-pplay(i,k))**nexpo
-         ENDDO
-         ENDDO
-         DO k = k1min, k2max
-         DO i = 1, klon
-         IF (todo(i) .AND. k.GE.(k1(i)+1) .AND. k.LE.k2(i))
-     .      d_ql(i,k) = d_ql(i,k) + toliq(i) * zcond(i) / zvapo(i)
-     .                            * (pplay(i,k1(i))-pplay(i,k))**nexpo
-         ENDDO
-         ENDDO
-         DO i = 1, klon
-            IF (todo(i)) zrfl(i) = (1.0-toliq(i)) * zcond(i) / dtime
-         ENDDO
-c
-      ELSE ! valeur non-prevue pour opt_cld
-c
-         PRINT*, "opt_cld est faux:", opt_cld
-         CALL abort
-c
-      ENDIF ! fin de opt_cld
-c
-c L'eau precipitante peut etre evaporee:
-c
-      zalfa = 0.05
-      IF (evap_prec .AND. (k1max.GE.2)) THEN
-      DO k = k1max-1, 1, -1
-      DO i = 1, klon
-      IF (todo(i) .AND. k.LT.k1(i) .AND. zrfl(i).GT.0.0) THEN
-         zqev = MAX (0.0, (zqs(i,k)-zq(i,k))*zalfa )
-         zqevt = coef_eva * (1.0-zq(i,k)/zqs(i,k))*SQRT(zrfl(i))
-     .         * delp(i,k)/pplay(i,k)*zt(i,k)*RD/RG
-         zqevt = MAX(0.0,MIN(zqevt,zrfl(i))) * RG*dtime/delp(i,k)
-         zqev = MIN (zqev, zqevt)
-         zrfln = zrfl(i) - zqev*(delp(i,k))/RG/dtime
-         zq(i,k) = zq(i,k) - (zrfln-zrfl(i)) 
-     .                     * (RG/(delp(i,k)))*dtime
-         zt(i,k) = zt(i,k) + (zrfln-zrfl(i))
-     .                     * (RG/(delp(i,k)))*dtime
-     .                     * RLVTT/RCPD/(1.0+RVTMP2*zq(i,k))
-         zrfl(i) = zrfln
-      ENDIF
-      ENDDO
-      ENDDO
-      ENDIF
-c
-c La temperature de la premiere couche determine la pluie ou la neige:
-c
-      DO i = 1, klon
-      IF (todo(i)) THEN
-      IF (zt(i,1) .GT. RTT) THEN
-         rain(i) = rain(i) + zrfl(i)
-      ELSE
-         snow(i) = snow(i) + zrfl(i)
-      ENDIF
-      ENDIF
-      ENDDO
-c
-c Mise a jour de la temperature et de l'humidite
-c
-      DO k = k1min, k2max
-      DO i = 1, klon
-      IF (todo(i) .AND. k.GE.k1(i) .AND. k.LE.k2(i)) THEN
-         zt(i,k) = ztnew(i,k)
-         zq(i,k) = zqnew(i,k)
-      ENDIF
-      ENDDO
-      ENDDO
-c
-c Re-calculer certaines variables pour etendre et re-ajuster la colonne
-c
-      IF (exigent) THEN
-      DO k = 1, klev
-      DO i = 1, klon
-      IF (todo(i)) THEN
-         IF (thermcep) THEN
-            zdelta=MAX(0.,SIGN(1.,RTT-zt(i,k)))
-            zcvm5=R5LES*RLVTT*(1.-zdelta) + zdelta*R5IES*RLSTT
-            zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*zq(i,k))
-            zqs(i,k)= R2ES*FOEEW(zt(i,k),zdelta)/pplay(i,k)
-            zqs(i,k)=MIN(0.5,zqs(i,k))
-            zcor=1./(1.-RETV*zqs(i,k))
-            zqs(i,k)=zqs(i,k)*zcor
-            zdqs(i,k) =FOEDE(zt(i,k),zdelta,zcvm5,zqs(i,k),zcor)
-         ELSE
-           IF (zt(i,k) .LT. t_coup) THEN
-              zqs(i,k)= qsats(zt(i,k)) / pplay(i,k)
-              zdqs(i,k)= dqsats(zt(i,k),zqs(i,k))
-           ELSE
-              zqs(i,k)= qsatl(zt(i,k)) / pplay(i,k)
-              zdqs(i,k)= dqsatl(zt(i,k),zqs(i,k))
-           ENDIF
-         ENDIF
-      ENDIF
-      ENDDO
-      ENDDO
-      ENDIF
-c
-      IF (exigent) THEN
-      DO k = 1, klev-1
-      DO i = 1, klon
-      IF (todo(i)) THEN
-         zgamdz(i,k) = - (pplay(i,k)-pplay(i,k+1))/paprs(i,k+1)/RCPD
-     .          *( RD*(zt(i,k)*delp(i,k)+zt(i,k+1)*delp(i,k+1))
-     .               /(delp(i,k)+delp(i,k+1))
-     .            +RLVTT*(zqs(i,k)*delp(i,k)+zqs(i,k+1)*delp(i,k+1))
-     .                  /(delp(i,k)+delp(i,k+1))
-     .           ) / (1.0+(zdqs(i,k)*delp(i,k)+zdqs(i,k+1)*delp(i,k+1))
-     .                   /(delp(i,k)+delp(i,k+1)) )
-      ENDIF
-      ENDDO
-      ENDDO
-      ENDIF
-c
-c Puisque l'humidite a ete modifiee, on re-fait (q-qs)*dp
-c
-      DO k = 1, klev
-      DO i = 1, klon
-      IF (todo(i)) THEN
-         zqmqsdp(i,k) = (zq(i,k)-zqs(i,k))*delp(i,k)
-      ENDIF
-      ENDDO
-      ENDDO
-c
-c Verifier si l'on peut etendre le bas de la colonne
-c
-      DO i = 1, klon
-         etendre(i) = .FALSE.
-      ENDDO
-c
-      k1max = 1
-      DO i = 1, klon
-      IF (todo(i) .AND. k1(i).GT.(kbase+1)) THEN
-         k = k1(i)
-         zflo(i) = zt(i,k-1) + zgamdz(i,k-1) - zt(i,k)
-         zsat(i) = zqmqsdp(i,k) + zqmqsdp(i,k-1)
-csc voici l'ancienne ligne:
-csc         IF (zflo(i).LE.0.0 .OR. zsat(i).LE.0.0) THEN
-csc sylvain: il faut RESPECTER les 2 criteres:
-         IF (zflo(i).GT.0.0 .AND. zsat(i).GT.0.0) THEN
-            etendre(i) = .TRUE.
-            k1(i) = k1(i) - 1
-            k1max = MAX(k1max,k1(i))
-            aller(i) = .TRUE.
-         ENDIF
-      ENDIF
-      ENDDO
-c
-      IF (k1max.GT.(kbase+1)) THEN
-      DO k = k1max, kbase+1, -1
-      DO i = 1, klon
-      IF (etendre(i) .AND. k.LT.k1(i) .AND. aller(i)) THEN
-         zsat(i) = zsat(i) + zqmqsdp(i,k)
-         zflo(i) = zt(i,k) + zgamdz(i,k) - zt(i,k+1)
-         IF (zsat(i).LE.0.0 .OR. zflo(i).LE.0.0) THEN
-            aller(i) = .FALSE.
-         ELSE
-            k1(i) = k
-         ENDIF
-      ENDIF
-      ENDDO
-      ENDDO
-      DO i = 1, klon
-         IF (etendre(i).AND.aller(i)) THEN
-            k1(i) = 1
-         ENDIF
-      ENDDO
-      ENDIF
-c
-CCC      DO i = 1, klon
-CCC      IF (etendre(i)) THEN
-CCC  840    k = k1(i)
-CCC         IF (k.GT.1) THEN
-CCC            zsat(i) = zsat(i) + zqmqsdp(i,k-1)
-CCC            zflo(i) = zt(i,k-1) + zgamdz(i,k-1) - zt(i,k)
-CCC            IF (zflo(i).GT.0.0 .AND. zsat(i).GT.0.0) THEN
-CCC               k1(i) = k - 1
-CCC               GOTO 840
-CCC            ENDIF
-CCC         ENDIF
-CCC      ENDIF
-CCC      ENDDO
-c
-      DO i = 1, klon
-         todobis(i) = todo(i)
-         todo(i) = .FALSE.
-      ENDDO
-      is = 0
-      DO i = 1, klon
-      IF (etendre(i)) THEN
-         todo(i) = .TRUE.
-         is = is + 1
-      ENDIF
-      ENDDO
-      IF (is.GT.0) THEN
-         IF (new_top) THEN
-            GOTO 820 ! chercher de nouveau le sommet k2
-         ELSE
-            GOTO 830 ! supposer que le sommet est celui deja trouve
-         ENDIF
-      ENDIF
-c
-      DO i = 1, klon
-         possible(i) = .FALSE.
-      ENDDO
-      is = 0
-      DO i = 1, klon
-      IF (todobis(i) .AND. k2(i).LT.klev) THEN
-         is = is + 1
-         possible(i) = .TRUE.
-      ENDIF
-      ENDDO
-      IF (is.GT.0) GOTO 810 !on cherche en haut d'autres blocks 
-c     a ajuster a partir du sommet de la colonne precedente
-c
-  860 CONTINUE ! Calculer les tendances et diagnostiques
-ccc      print*, "Apres 860"
-c
-      DO k = 1, klev
-      DO i = 1, klon
-      IF (accompli(i)) THEN
-         d_t(i,k) = zt(i,k) - t(i,k)
-         zq(i,k) = MAX(zq(i,k),seuil_vap)
-         d_q(i,k) = zq(i,k) - q(i,k)
-      ENDIF
-      ENDDO
-      ENDDO
-c
-      DO 888 i = 1, klon
-      IF (accompli(i)) THEN
-         DO k = 1, klev
-         IF (rneb(i,k).GT.0.0) THEN
-            ibas(i) = k
-            GOTO 807
-         ENDIF
-         ENDDO
-  807    CONTINUE
-         DO k = klev, 1, -1
-         IF (rneb(i,k).GT.0.0) THEN
-            itop(i) = k
-            GOTO 808
-         ENDIF
-         ENDDO
-  808    CONTINUE
-      ENDIF
-  888 CONTINUE
-c
-      IF (imprim) THEN
-         nbtodo = 0
-         nbdone = 0
-         DO i = 1, klon
-            IF (afaire(i)) nbtodo = nbtodo + 1
-            IF (accompli(i)) nbdone = nbdone + 1
-         ENDDO
-         PRINT*, "nbTodo, nbDone=", nbtodo, nbdone
-      ENDIF
-c
-      RETURN
-      END
-      SUBROUTINE conkuo(dtime, paprs, pplay, t, q, conv_q,
-     s                  d_t, d_q, d_ql, rneb, 
-     s                  rain, snow, ibas, itop)
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
-c Objet: Schema de convection de type Kuo (1965).
-c        Cette version du code peut calculer le niveau de depart
-c N.B. version vectorielle (le 6 oct. 1997)
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-c
-c Arguments:
-c
-      REAL dtime               ! intervalle du temps (s)
-      REAL paprs(klon,klev+1)  ! pression a inter-couche (Pa)
-      REAL pplay(klon,klev)    ! pression au milieu de couche (Pa)
-      REAL t(klon,klev)        ! temperature (K)
-      REAL q(klon,klev)        ! humidite specifique
-      REAL conv_q(klon,klev)   ! taux de convergence humidite (g/g/s)
-c
-      REAL d_t(klon,klev)      ! incrementation temperature
-      REAL d_q(klon,klev)      ! incrementation humidite
-      REAL d_ql(klon,klev)     ! incrementation eau liquide
-      REAL rneb(klon,klev)     ! nebulosite
-      REAL rain(klon)          ! pluies (mm/s)
-      REAL snow(klon)          ! neige (mm/s)
-      INTEGER itop(klon)       ! niveau du sommet
-      INTEGER ibas(klon)       ! niveau du bas
-c
-      LOGICAL ldcum(klon)      ! convection existe
-      LOGICAL todo(klon)
-c
-c Quelsques options:
-c
-      LOGICAL calcfcl ! calculer le niveau de convection libre
-      PARAMETER (calcfcl=.TRUE.)
-      INTEGER ldepar ! niveau fixe de convection libre
-      PARAMETER (ldepar=4)
-      INTEGER opt_cld ! comment traiter l'eau liquide
-      PARAMETER (opt_cld=4) ! valeur possible: 0, 1, 2, 3 ou 4
-      LOGICAL evap_prec ! evaporation de pluie au-dessous de convection
-      PARAMETER (evap_prec=.TRUE.)
-      REAL coef_eva
-      PARAMETER (coef_eva=1.0E-05)
-      LOGICAL new_deh ! nouvelle facon de calculer dH
-      PARAMETER (new_deh=.FALSE.)
-      REAL t_coup
-      PARAMETER (t_coup=234.0)
-      LOGICAL old_tau ! implique precipitation nulle
-      PARAMETER (old_tau=.FALSE.)
-      REAL toliq(klon) ! rapport entre l'eau nuageuse et l'eau precipitante
-      REAL dpmin, tomax !Epaisseur faible, rapport eau liquide plus grande
-      PARAMETER (dpmin=0.15, tomax=0.97)
-      REAL dpmax, tomin !Epaisseur grande, rapport eau liquide plus faible
-      PARAMETER (dpmax=0.30, tomin=0.05)
-      REAL deep_sig, deep_to ! au dela de deep_sig, utiliser deep_to
-      PARAMETER (deep_sig=0.50, deep_to=0.05)
-c
-c Variables locales:
-c
-      INTEGER nexpo
-      LOGICAL nuage(klon)
-      INTEGER i, k, kbmin, kbmax, khmax
-      REAL ztotal(klon,klev), zdeh(klon,klev)
-      REAL zgz(klon,klev)
-      REAL zqs(klon,klev)
-      REAL zdqs(klon,klev)
-      REAL ztemp(klon,klev)
-      REAL zpres(klon,klev)
-      REAL zconv(klon) ! convergence d'humidite
-      REAL zvirt(klon) ! convergence virtuelle d'humidite
-      REAL zfrac(klon) ! fraction convective
-      INTEGER kb(klon), kh(klon)
-c
-      REAL zcond(klon), zvapo(klon), zrapp(klon)
-      REAL zrfl(klon), zrfln, zqev, zqevt
-      REAL zdelta, zcvm5, zcor
-      REAL zvar
-c
-      LOGICAL appel1er
-      SAVE appel1er
-c
-c Fonctions thermodynamiques
-c
-#include "YOETHF.h"
-#include "FCTTRE.h"
-c
-      DATA appel1er /.TRUE./
-c
-      IF (appel1er) THEN
-         PRINT*, 'conkuo, calcfcl:', calcfcl
-         IF (.NOT.calcfcl) PRINT*, 'conkuo, ldepar:', ldepar
-         PRINT*, 'conkuo, opt_cld:', opt_cld
-         PRINT*, 'conkuo, evap_prec:', evap_prec
-         PRINT*, 'conkuo, new_deh:', new_deh
-         appel1er = .FALSE.
-      ENDIF
-c
-c Initialiser les sorties a zero
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         d_q(i,k) = 0.0
-         d_t(i,k) = 0.0
-         d_ql(i,k) = 0.0
-         rneb(i,k) = 0.0
-      ENDDO
-      ENDDO
-      DO i = 1, klon
-         rain(i) = 0.0
-         snow(i) = 0.0
-         ibas(i) = 0
-         itop(i) = 0
-      ENDDO
-c
-c Calculer la vapeur d'eau saturante Qs et sa derive L/Cp * dQs/dT
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         IF (thermcep) THEN
-           zdelta=MAX(0.,SIGN(1.,RTT-t(i,k)))
-           zcvm5=R5LES*RLVTT*(1.-zdelta) + zdelta*R5IES*RLSTT
-           zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*q(i,k))
-           zqs(i,k)=R2ES*FOEEW(t(i,k),zdelta)/pplay(i,k)
-           zqs(i,k)=MIN(0.5,zqs(i,k))
-           zcor=1./(1.-RETV*zqs(i,k))
-           zqs(i,k)=zqs(i,k)*zcor
-           zdqs(i,k) =FOEDE(t(i,k),zdelta,zcvm5,zqs(i,k),zcor)
-         ELSE
-           IF (t(i,k).LT.t_coup) THEN
-              zqs(i,k) = qsats(t(i,k))/pplay(i,k)
-              zdqs(i,k) = dqsats(t(i,k),zqs(i,k))
-           ELSE
-              zqs(i,k) = qsatl(t(i,k))/pplay(i,k)
-              zdqs(i,k) = dqsatl(t(i,k),zqs(i,k))
-           ENDIF
-         ENDIF
-      ENDDO
-      ENDDO
-c
-c Calculer gz (energie potentielle)
-c
-      DO i = 1, klon
-         zgz(i,1) = RD * t(i,1) / (0.5*(paprs(i,1)+pplay(i,1)))
-     .                   * (paprs(i,1)-pplay(i,1))
-      ENDDO
-      DO k = 2, klev
-      DO i = 1, klon
-         zgz(i,k) = zgz(i,k-1)
-     .            + RD * 0.5*(t(i,k-1)+t(i,k)) / paprs(i,k)
-     .                 * (pplay(i,k-1)-pplay(i,k))
-      ENDDO
-      ENDDO
-c
-c Calculer l'energie statique humide saturee (Cp*T + gz + L*Qs)
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         ztotal(i,k) = RCPD*t(i,k) + RLVTT*zqs(i,k) + zgz(i,k)
-      ENDDO
-      ENDDO
-c
-c Determiner le niveau de depart et calculer la difference de
-c l'energie statique humide saturee (ztotal) entre la couche
-c de depart et chaque couche au-dessus.
-c
-      IF (calcfcl) THEN
-         DO k = 1, klev
-         DO i = 1, klon
-            zpres(i,k) = pplay(i,k)
-            ztemp(i,k) = t(i,k)
-         ENDDO
-         ENDDO
-         CALL kuofcl(ztemp, q, zgz, zpres, ldcum, kb)
-         DO i = 1, klon
-         IF (ldcum(i)) THEN
-            k = kb(i)
-            IF (new_deh) THEN
-            zdeh(i,k) = ztotal(i,k-1) - ztotal(i,k)
-            ELSE
-            zdeh(i,k) = RCPD * (t(i,k-1)-t(i,k))
-     .                - RD *0.5*(t(i,k-1)+t(i,k))/paprs(i,k)
-     .                  *(pplay(i,k-1)-pplay(i,k))
-     .                + RLVTT*(zqs(i,k-1)-zqs(i,k))
-            ENDIF
-            zdeh(i,k) = zdeh(i,k) * 0.5
-         ENDIF
-         ENDDO
-         DO k = 1, klev
-         DO i = 1, klon
-         IF (ldcum(i) .AND. k.GE.(kb(i)+1)) THEN
-            IF (new_deh) THEN
-               zdeh(i,k) = zdeh(i,k-1) + (ztotal(i,k-1)-ztotal(i,k))
-            ELSE
-               zdeh(i,k) = zdeh(i,k-1)
-     .                   + RCPD * (t(i,k-1)-t(i,k))
-     .                   - RD *0.5*(t(i,k-1)+t(i,k))/paprs(i,k)
-     .                        *(pplay(i,k-1)-pplay(i,k))
-     .                   + RLVTT*(zqs(i,k-1)-zqs(i,k))
-            ENDIF
-         ENDIF
-         ENDDO
-         ENDDO
-      ELSE
-         DO i = 1, klon
-            k = ldepar
-            kb(i) = ldepar
-            ldcum(i) = .TRUE.
-            IF (new_deh) THEN
-            zdeh(i,k) = ztotal(i,k-1) - ztotal(i,k)
-            ELSE
-            zdeh(i,k) = RCPD * (t(i,k-1)-t(i,k))
-     .                - RD *0.5*(t(i,k-1)+t(i,k))/paprs(i,k)
-     .                  *(pplay(i,k-1)-pplay(i,k))
-     .                + RLVTT*(zqs(i,k-1)-zqs(i,k))
-            ENDIF
-            zdeh(i,k) = zdeh(i,k) * 0.5
-         ENDDO
-         DO k = ldepar+1, klev
-         DO i = 1, klon
-         IF (new_deh) THEN
-             zdeh(i,k)  = zdeh(i,k-1) + (ztotal(i,k-1)-ztotal(i,k))
-         ELSE
-             zdeh(i,k) = zdeh(i,k-1)
-     .                 + RCPD * (t(i,k-1)-t(i,k))
-     .                 - RD *0.5*(t(i,k-1)+t(i,k))/paprs(i,k)
-     .                      *(pplay(i,k-1)-pplay(i,k))
-     .                 + RLVTT*(zqs(i,k-1)-zqs(i,k))
-         ENDIF
-         ENDDO
-         ENDDO
-      ENDIF
-c
-c-----Chercher le sommet du nuage
-c-----Calculer la convergence de l'humidite (en kg/m**2 a un facteur
-c-----psolpa/RG pres) du bas jusqu'au sommet du nuage.
-c-----Calculer la convergence virtuelle pour que toute la maille 
-c-----deviennt nuageuse (du bas jusqu'au sommet du nuage)
-c
-      DO i = 1, klon
-         nuage(i) = .TRUE.
-         zconv(i) = 0.0
-         zvirt(i) = 0.0
-         kh(i) = -999
-      ENDDO
-      DO k = 1, klev
-      DO i = 1, klon
-      IF (k.GE.kb(i) .AND. ldcum(i)) THEN
-         nuage(i) = nuage(i) .AND. zdeh(i,k).GT.0.0
-         IF (nuage(i)) THEN
-            kh(i) = k
-            zconv(i)=zconv(i)+conv_q(i,k)*dtime
-     .                       *(paprs(i,k)-paprs(i,k+1))
-            zvirt(i)=zvirt(i)+(zdeh(i,k)/RLVTT+zqs(i,k)-q(i,k))
-     .                       *(paprs(i,k)-paprs(i,k+1))
-         ENDIF
-      ENDIF
-      ENDDO
-      ENDDO
-c
-      DO i = 1, klon
-         todo(i) = ldcum(i) .AND. kh(i).GT.kb(i) .AND. zconv(i).GT.0.0
-      ENDDO
-c
-      kbmin = klev
-      kbmax = 0
-      khmax = 0
-      DO i = 1, klon
-      IF (todo(i)) THEN
-         kbmin = MIN(kbmin,kb(i))
-         kbmax = MAX(kbmax,kb(i))
-         khmax = MAX(khmax,kh(i))
-      ENDIF
-      ENDDO
-c
-c-----Calculer la surface couverte par le nuage
-c
-      DO i = 1, klon
-      IF (todo(i)) THEN
-      zfrac(i) = MAX(0.0,MIN(zconv(i)/zvirt(i), 1.0))
-      ENDIF
-      ENDDO
-c
-c-----Calculs essentiels:
-c
-      DO i = 1, klon
-      IF (todo(i)) THEN
-      zcond(i) = 0.0
-      ENDIF
-      ENDDO
-      DO k = kbmin, khmax
-      DO i = 1, klon
-      IF (todo(i) .AND. k.GE.kb(i) .AND. k.LE.kh(i)) THEN
-         zvar = zdeh(i,k)/(1.+zdqs(i,k))
-         d_t(i,k) = zvar * zfrac(i) / RCPD
-         d_q(i,k) = (zvar*zdqs(i,k)/RLVTT+zqs(i,k)-q(i,k))*zfrac(i)
-     .            - conv_q(i,k)*dtime
-         zcond(i) = zcond(i) - d_q(i,k) *(paprs(i,k)-paprs(i,k+1))/RG
-         rneb(i,k) = zfrac(i)
-      ENDIF
-      ENDDO
-      ENDDO
-c
-      DO i = 1, klon
-      IF (todo(i) .AND. zcond(i).LT.0.0) THEN
-         PRINT*, 'WARNING: cond. negative (Kuo) ',
-     .            i,kb(i),kh(i), zcond(i)
-         zcond(i) = 0.0
-         DO k = kb(i), kh(i)
-            d_t(i,k) = 0.0
-            d_q(i,k) = 0.0
-         ENDDO
-         todo(i) = .FALSE. ! effort totalement perdu
-      ENDIF
-      ENDDO
-c
-c=====
-c Une fois que la condensation a lieu, on doit construire un
-c "modele nuageux" pour partager la condensation entre l'eau
-c liquide nuageuse et la precipitation (leur rapport toliq
-c est calcule selon l'epaisseur nuageuse). Je suppose que
-c toliq=tomax quand l'epaisseur nuageuse est inferieure a dpmin,
-c et que toliq=tomin quand l'epaisseur depasse dpmax (interpolation
-c lineaire entre dpmin et dpmax).
-c=====
-      DO i = 1, klon
-      IF (todo(i)) THEN
-      toliq(i) = tomax-((paprs(i,kb(i))-paprs(i,kh(i)+1))
-     .               /paprs(i,1)-dpmin)
-     .             *(tomax-tomin)/(dpmax-dpmin)
-      toliq(i) = MAX(tomin,MIN(tomax,toliq(i)))
-      IF (pplay(i,kh(i))/paprs(i,1) .LE. deep_sig) toliq(i) = deep_to
-      IF (old_tau) toliq(i) = 1.0
-      ENDIF
-      ENDDO
-c=====
-c On doit aussi determiner la distribution verticale de
-c l'eau nuageuse. Plusieurs options sont proposees:
-c
-c (0) La condensation precipite integralement (toliq ne sera
-c     pas utilise).
-c (1) L'eau liquide est distribuee entre k1 et k2 et proportionnelle
-c     a la vapeur d'eau locale.
-c (2) Elle est distribuee entre k1 et k2 avec une valeur constante.
-c (3) Elle est seulement distribuee aux couches ou la vapeur d'eau
-c     est effectivement diminuee pendant le processus d'ajustement.
-c (4) Elle est en fonction (lineaire ou exponentielle) de la
-c     distance (epaisseur en pression) avec le niveau k1 (la couche
-c     k1 n'aura donc pas d'eau liquide).
-c=====
-c
-      IF (opt_cld.EQ.0) THEN
-c
-         DO i = 1, klon
-         IF (todo(i)) zrfl(i) = zcond(i) / dtime
-         ENDDO
-c
-      ELSE IF (opt_cld.EQ.1) THEN
-c
-         DO i = 1, klon
-         IF (todo(i)) zvapo(i) = 0.0 ! quantite integrale de vapeur d'eau
-         ENDDO
-         DO k = kbmin, khmax
-         DO i = 1, klon
-         IF (todo(i) .AND. k.GE.kb(i) .AND. k.LE.kh(i)) THEN
-            zvapo(i) = zvapo(i) + (q(i,k)+d_q(i,k))
-     .                     *(paprs(i,k)-paprs(i,k+1))/RG
-         ENDIF
-         ENDDO
-         ENDDO
-         DO i = 1, klon
-         IF (todo(i)) THEN
-            zrapp(i) = toliq(i) * zcond(i) / zvapo(i)
-            zrapp(i) = MAX(0.,MIN(1.,zrapp(i)))
-         ENDIF
-         ENDDO
-         DO k = kbmin, khmax
-         DO i = 1, klon
-         IF (todo(i) .AND. k.GE.kb(i) .AND. k.LE.kh(i)) THEN
-            d_ql(i,k) = zrapp(i) * (q(i,k)+d_q(i,k))
-         ENDIF
-         ENDDO
-         ENDDO
-         DO i = 1, klon
-         IF (todo(i)) THEN
-         zrfl(i) = (1.0-toliq(i)) * zcond(i) / dtime
-         ENDIF
-         ENDDO
-c
-      ELSE IF (opt_cld.EQ.2) THEN
-c
-         DO i = 1, klon
-         IF (todo(i)) zvapo(i) = 0.0 ! quantite integrale de masse
-         ENDDO
-         DO k = kbmin, khmax
-         DO i = 1, klon
-         IF (todo(i) .AND. k.GE.kb(i) .AND. k.LE.kh(i)) THEN
-            zvapo(i) = zvapo(i) + (paprs(i,k)-paprs(i,k+1))/RG
-         ENDIF
-         ENDDO
-         ENDDO
-         DO k = kbmin, khmax
-         DO i = 1, klon
-         IF (todo(i) .AND. k.GE.kb(i) .AND. k.LE.kh(i)) THEN
-            d_ql(i,k) = toliq(i) * zcond(i) / zvapo(i)
-         ENDIF
-         ENDDO
-         ENDDO
-         DO i = 1, klon
-         IF (todo(i)) THEN
-         zrfl(i) = (1.0-toliq(i)) * zcond(i) / dtime
-         ENDIF
-         ENDDO
-c
-      ELSE IF (opt_cld.EQ.3) THEN
-c
-         DO i = 1, klon
-         IF (todo(i)) THEN
-         zvapo(i) = 0.0 ! quantite de l'eau strictement condensee
-         ENDIF
-         ENDDO
-         DO k = kbmin, khmax
-         DO i = 1, klon
-         IF (todo(i) .AND. k.GE.kb(i) .AND. k.LE.kh(i)) THEN
-            zvapo(i) = zvapo(i) + MAX(0.0,-d_q(i,k))
-     .                    * (paprs(i,k)-paprs(i,k+1))/RG
-         ENDIF
-         ENDDO
-         ENDDO
-         DO k = kbmin, khmax
-         DO i = 1, klon
-         IF (todo(i) .AND. k.GE.kb(i) .AND. k.LE.kh(i) .AND.
-     .                     zvapo(i).GT.0.0) THEN
-            d_ql(i,k) = d_ql(i,k) + toliq(i) * zcond(i) / zvapo(i)
-     .                            * MAX(0.0,-d_q(i,k))
-         ENDIF
-         ENDDO
-         ENDDO
-         DO i = 1, klon
-         IF (todo(i)) THEN
-         zrfl(i) = (1.0-toliq(i)) * zcond(i) / dtime
-         ENDIF
-         ENDDO
-c
-      ELSE IF (opt_cld.EQ.4) THEN
-c
-         nexpo = 3
-ccc         nexpo = 1 ! distribution lineaire
-c
-         DO i = 1, klon
-         IF (todo(i)) THEN
-         zvapo(i) = 0.0 ! quantite integrale de masse (avec ponderation)
-         ENDIF
-         ENDDO
-         DO k = kbmin, khmax
-         DO i = 1, klon
-         IF (todo(i) .AND. k.GE.(kb(i)+1) .AND. k.LE.kh(i)) THEN
-            zvapo(i) = zvapo(i) + (paprs(i,k)-paprs(i,k+1)) / RG
-     .                    * (pplay(i,kb(i))-pplay(i,k))**nexpo
-         ENDIF
-         ENDDO
-         ENDDO
-         DO k = kbmin, khmax
-         DO i = 1, klon
-         IF (todo(i) .AND. k.GE.(kb(i)+1) .AND. k.LE.kh(i)) THEN
-            d_ql(i,k) = d_ql(i,k) + toliq(i) * zcond(i) / zvapo(i)
-     .                            * (pplay(i,kb(i))-pplay(i,k))**nexpo
-         ENDIF
-         ENDDO
-         ENDDO
-         DO i = 1, klon
-         IF (todo(i)) THEN
-         zrfl(i) = (1.0-toliq(i)) * zcond(i) / dtime
-         ENDIF
-         ENDDO
-c
-      ELSE ! valeur non-prevue pour opt_cld
-c
-         PRINT*, "opt_cld est faux:", opt_cld
-         CALL abort
-c
-      ENDIF ! fin de opt_cld
-c
-c L'eau precipitante peut etre re-evaporee:
-c
-      IF (evap_prec .AND. kbmax.GE.2) THEN
-      DO k = kbmax, 1, -1
-      DO i = 1, klon
-      IF (todo(i) .AND. k.LE.(kb(i)-1) .AND. zrfl(i).GT.0.0) THEN
-         zqev = MAX (0.0, (zqs(i,k)-q(i,k))*zfrac(i) )
-         zqevt = coef_eva * (1.0-q(i,k)/zqs(i,k))*SQRT(zrfl(i))
-     .       * (paprs(i,k)-paprs(i,k+1))/pplay(i,k)*t(i,k)*RD/RG
-         zqevt = MAX(0.0,MIN(zqevt,zrfl(i)))
-     .         * RG*dtime/(paprs(i,k)-paprs(i,k+1))
-         zqev = MIN (zqev, zqevt)
-         zrfln = zrfl(i) - zqev*(paprs(i,k)-paprs(i,k+1))
-     .                 /RG/dtime
-         d_q(i,k) = - (zrfln-zrfl(i))
-     .          * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
-         d_t(i,k) = (zrfln-zrfl(i))
-     .          * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
-     .          * RLVTT/RCPD
-         zrfl(i) = zrfln
-      ENDIF
-      ENDDO
-      ENDDO
-      ENDIF
-c
-c La temperature de la premiere couche determine la pluie ou la neige:
-c
-      DO i = 1, klon
-      IF (todo(i)) THEN
-      IF (t(i,1) .GT. RTT) THEN
-         rain(i) = rain(i) + zrfl(i)
-      ELSE
-         snow(i) = snow(i) + zrfl(i)
-      ENDIF
-      ENDIF
-      ENDDO
-c
-      RETURN
-      END
-      SUBROUTINE kuofcl(pt, pq, pg, pp, LDCUM, kcbot)
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS) date: 19940927
-c            adaptation du code de Tiedtke du ECMWF
-c Objet: calculer le niveau de convection libre
-c        (FCL: Free Convection Level)
-c======================================================================
-c Arguments:
-c pt---input-R- temperature (K)
-c pq---input-R- vapeur d'eau (kg/kg)
-c pg---input-R- geopotentiel (g*z ou z est en metre)
-c pp---input-R- pression (Pa)
-c
-c LDCUM---output-L- Y-t-il la convection
-c kcbot---output-I- Niveau du bas de la convection
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "YOETHF.h"
-C
-      REAL pt(klon,klev), pq(klon,klev), pg(klon,klev), pp(klon,klev)
-      INTEGER  kcbot(klon)
-      LOGICAL  LDCUM(klon)
-C
-      REAL ztu(klon,klev), zqu(klon,klev), zlu(klon,klev)
-      REAL zqold(klon), zbuo
-      INTEGER is, i, k
-c
-c klab=1: on est sous le nuage convectif
-c klab=2: le bas du nuage convectif
-c klab=0: autres couches
-      INTEGER klab(klon,klev)
-c
-c quand lflag=.true., on est sous le nuage, il faut donc appliquer
-c le processus d'elevation.
-      LOGICAL lflag(klon)
-C
-      DO k = 1, klev
-      DO i = 1, klon
-         ztu(i,k) = pt(i,k)
-         zqu(i,k) = pq(i,k)
-         zlu(i,k) = 0.0
-         klab(i,k) = 0
-      ENDDO
-      ENDDO
-C----------------------------------------------------------------------
-      DO i = 1, klon
-         klab(i,1)=1
-         kcbot(i)=2
-         LDCUM(i)=.FALSE.
-      ENDDO
-C
-      DO 290 k = 2, klev-1
-c
-      is=0
-      DO i = 1, klon
-         if (klab(i,k-1).EQ.1) is = is + 1
-         lflag(i) = .FALSE.
-         if (klab(i,k-1).EQ.1) lflag(i) = .TRUE.
-      ENDDO
-      IF (is.EQ.0) GOTO 290
-c
-c on eleve le parcel d'air selon l'adiabatique sec
-c
-      DO i = 1, klon
-      IF (lflag(i)) THEN
-         zqu(i,k) = zqu(i,k-1)
-         ztu(i,k) = ztu(i,k-1) + (pg(i,k-1)-pg(i,k))/RCPD
-         zbuo = ztu(i,k)*(1.+RETV*zqu(i,k))-
-     .          pt(i,k)*(1.+RETV*pq(i,k))+0.5
-         IF (zbuo.GT.0.) klab(i,k)=1
-         zqold(i) = zqu(i,k)
-      ENDIF
-      ENDDO
-c
-c on calcule la condensation eventuelle
-c
-      CALL adjtq(pp(1,k), ztu(1,k), zqu(1,k), lflag, 1)
-c
-c s'il y a la condensation et la "buoyancy" force est positive
-c c'est bien le bas de la tour de convection
-c
-      DO i=1, klon
-      IF(lflag(i).AND.zqu(i,k).NE.zqold(i)) THEN
-         klab(i,k) = 2
-         zlu(i,k) = zlu(i,k)+zqold(i)-zqu(i,k)
-         zbuo = ztu(i,k)*(1.+RETV*zqu(i,k))-
-     .          pt(i,k)*(1.+RETV*pq(i,k))+0.5
-         IF (zbuo.GT.0.) THEN
-            kcbot(i) = k
-            LDCUM(i) = .TRUE.
-         ENDIF
-      ENDIF
-      ENDDO
-C
-  290 CONTINUE
-C
-      RETURN
-      END
-      SUBROUTINE adjtq(pp, pt, pq, LDFLAG, KCALL)
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS) date: 19940927
-c            adaptation du code de Tiedtke du ECMWF
-c Objet: ajustement entre T et Q
-c======================================================================
-c Arguments:
-c pp---input-R- pression (Pa)
-c pt---input/output-R- temperature (K)
-c pq---input/output-R- vapeur d'eau (kg/kg)
-c======================================================================
-C TO PRODUCE T,Q AND L VALUES FOR CLOUD ASCENT
-C
-C NOTE: INPUT PARAMETER KCALL DEFINES CALCULATION AS
-C        KCALL=0    ENV. T AND QS IN*CUINI*
-C        KCALL=1  CONDENSATION IN UPDRAFTS  (E.G. CUBASE, CUASC)
-C        KCALL=2  EVAPORATION IN DOWNDRAFTS (E.G. CUDLFS,CUDDRAF)
-C
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-C
-      REAL pt(klon), pq(klon), pp(klon)
-      LOGICAL  ldflag(klon)
-      INTEGER KCALL
-c
-      REAL t_coup
-      PARAMETER (t_coup=234.0)
-c
-      REAL zcond(klon), zcond1
-      REAL zdelta, zcvm5, zldcp, zqsat, zcor, zdqsat
-      INTEGER is, i
-#include "YOETHF.h"
-#include "FCTTRE.h"
-c
-      DO i = 1, klon
-         zcond(i) = 0.0
-      ENDDO
-C
-      DO 210 i=1, klon
-      IF (LDFLAG(i)) THEN
-         zdelta=MAX(0.,SIGN(1.,RTT-pt(i)))
-         zldcp = RLVTT*(1.-zdelta) + zdelta*RLSTT
-         zldcp = zldcp / RCPD/(1.0+RVTMP2*pq(i))
-         IF (thermcep) THEN
-           zcvm5=R5LES*RLVTT*(1.-zdelta) + zdelta*R5IES*RLSTT
-           zcvm5 = zcvm5 / RCPD/(1.0+RVTMP2*pq(i))
-           zqsat=R2ES*FOEEW (pt(i), zdelta) / pp(i)
-           zqsat=MIN(0.5,zqsat)
-           zcor=1./(1.-RETV  *zqsat)
-           zqsat=zqsat*zcor
-           zdqsat = FOEDE(pt(i), zdelta, zcvm5, zqsat, zcor)
-         ELSE
-           IF (pt(i).LT.t_coup) THEN
-              zqsat = qsats(pt(i))/pp(i)
-              zdqsat = dqsats(pt(i),zqsat)
-           ELSE
-              zqsat = qsatl(pt(i))/pp(i)
-              zdqsat = dqsatl(pt(i),zqsat)
-           ENDIF
-         ENDIF
-         zcond(i)=(pq(i)-zqsat) / (1. + zdqsat)
-         IF(KCALL.EQ.1) zcond(i)=MAX(zcond(i),0.)
-         IF(KCALL.EQ.2) zcond(i)=MIN(zcond(i),0.)
-         pt(i)=pt(i)+zldcp*zcond(i)
-         pq(i)=pq(i)-zcond(i)
-      ENDIF
-  210 CONTINUE
-C
-      is = 0
-      DO i=1, klon
-         if (zcond(i).NE.0.) is = is + 1
-      ENDDO
-      IF(is.EQ.0) GOTO 230
-C
-      DO 220 i = 1, klon
-      IF(LDFLAG(i).AND.zcond(i).NE.0.) THEN
-         zdelta=MAX(0.,SIGN(1.,RTT-pt(i)))
-         zldcp = RLVTT*(1.-zdelta) + zdelta*RLSTT
-         zldcp = zldcp / RCPD/(1.0+RVTMP2*pq(i))
-         IF (thermcep) THEN
-           zcvm5=R5LES*RLVTT*(1.-zdelta) + zdelta*R5IES*RLSTT
-           zcvm5 = zcvm5 / RCPD/(1.0+RVTMP2*pq(i))
-           zqsat=R2ES*FOEEW (pt(i), zdelta) / pp(i)
-           zqsat=MIN(0.5,zqsat)
-           zcor=1./(1.-RETV  *zqsat)
-           zqsat=zqsat*zcor
-           zdqsat = FOEDE(pt(i), zdelta, zcvm5, zqsat, zcor)
-         ELSE
-           IF (pt(i).LT.t_coup) THEN
-              zqsat = qsats(pt(i))/pp(i)
-              zdqsat = dqsats(pt(i),zqsat)
-           ELSE
-              zqsat = qsatl(pt(i))/pp(i)
-              zdqsat = dqsatl(pt(i),zqsat)
-           ENDIF
-         ENDIF
-         zcond1=(pq(i)-zqsat) / (1.+zdqsat)
-         pt(i)=pt(i)+zldcp*zcond1
-         pq(i)=pq(i)-zcond1
-      END IF
-  220 CONTINUE
-C
-  230 CONTINUE
-      RETURN
-      END
-      SUBROUTINE fiajh(dtime, paprs, pplay, t, q,
-     .                 d_t, d_q, d_ql, rneb,
-     .                 rain, snow, ibas, itop)
-      IMPLICIT NONE
-c
-c Ajustement humide (Schema de convection de Manabe)
-C.
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-c
-c Arguments:
-c
-      REAL dtime        ! intervalle du temps (s)
-      REAL t(klon,klev) ! temperature (K)
-      REAL q(klon,klev) ! humidite specifique (kg/kg)
-      REAL paprs(klon,klev+1) ! pression a inter-couche (Pa)
-      REAL pplay(klon,klev) ! pression au milieu de couche (Pa)
-c
-      REAL d_t(klon,klev) ! incrementation pour la temperature
-      REAL d_q(klon,klev) ! incrementation pour vapeur d'eau
-      REAL d_ql(klon,klev) ! incrementation pour l'eau liquide
-      REAL rneb(klon,klev) ! fraction nuageuse
-c
-      REAL rain(klon)    ! variable non utilisee
-      REAL snow(klon)    ! variable non utilisee
-      INTEGER ibas(klon) ! variable non utilisee
-      INTEGER itop(klon) ! variable non utilisee
-
-      REAL t_coup
-      PARAMETER (t_coup=234.0)
-      REAL seuil_vap
-      PARAMETER (seuil_vap=1.0E-10)
-c
-c Variables locales:
-c 
-      INTEGER i, k
-      INTEGER k1, k1p, k2, k2p
-      LOGICAL itest(klon)
-      REAL delta_q(klon, klev)
-      REAL cp_new_t(klev)
-      REAL cp_delta_t(klev)
-      REAL new_qb(klev)
-      REAL v_cptj(klev), v_cptjk1, v_ssig
-      REAL v_cptt(klon,klev), v_p, v_t
-      REAL v_qs(klon,klev), v_qsd(klon,klev)
-      REAL zq1(klon), zq2(klon)
-      REAL gamcpdz(klon,2:klev)
-      REAL zdp, zdpm
-c
-      REAL zsat ! sur-saturation
-      REAL zflo ! flotabilite
-c
-      REAL local_q(klon,klev),local_t(klon,klev)
-c
-      REAL zdelta, zcor, zcvm5
-C
-#include "YOETHF.h"
-#include "FCTTRE.h"
-C
-      DO k = 1, klev
-      DO i = 1, klon
-         local_q(i,k) = q(i,k)
-         local_t(i,k) = t(i,k)
-         rneb(i,k) = 0.0
-         d_ql(i,k) = 0.0
-         d_t(i,k) = 0.0
-         d_q(i,k) = 0.0
-      ENDDO
-      ENDDO
-      DO i = 1, klon
-         rain(i) = 0.0
-         snow(i) = 0.0
-         ibas(i) = 0
-         itop(i) = 0
-      ENDDO
-c
-c Calculer v_qs et v_qsd:
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         v_cptt(i,k) = RCPD * local_t(i,k)
-         v_t = local_t(i,k)
-         v_p = pplay(i,k)
-c
-         IF (thermcep) THEN
-            zdelta=MAX(0.,SIGN(1.,RTT-v_t))
-            zcvm5=R5LES*RLVTT*(1.-zdelta) + zdelta*R5IES*RLSTT
-            zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*local_q(i,k))
-            v_qs(i,k)= R2ES * FOEEW(v_t,zdelta)/v_p
-            v_qs(i,k)=MIN(0.5,v_qs(i,k))
-            zcor=1./(1.-RETV*v_qs(i,k))
-            v_qs(i,k)=v_qs(i,k)*zcor
-            v_qsd(i,k) =FOEDE(v_t,zdelta,zcvm5,v_qs(i,k),zcor)
-         ELSE
-           IF (v_t.LT.t_coup) THEN
-              v_qs(i,k) = qsats(v_t) / v_p
-              v_qsd(i,k) = dqsats(v_t,v_qs(i,k))
-           ELSE
-              v_qs(i,k) = qsatl(v_t) / v_p
-              v_qsd(i,k) = dqsatl(v_t,v_qs(i,k))
-           ENDIF
-         ENDIF
-      ENDDO
-      ENDDO
-c
-c Calculer Gamma * Cp * dz: (gamm est le gradient critique)
-c
-      DO k = 2, klev
-      DO i = 1, klon
-         zdp = paprs(i,k)-paprs(i,k+1)
-         zdpm = paprs(i,k-1)-paprs(i,k)
-         gamcpdz(i,k) = ( ( RD/RCPD /(zdpm+zdp) * 
-     .                      (v_cptt(i,k-1)*zdpm + v_cptt(i,k)*zdp)
-     .                     +RLVTT /(zdpm+zdp) * 
-     .                      (v_qs(i,k-1)*zdpm + v_qs(i,k)*zdp)
-     .                    )* (pplay(i,k-1)-pplay(i,k)) / paprs(i,k) )
-     .                / (1.0+(v_qsd(i,k-1)*zdpm+
-     .                        v_qsd(i,k)*zdp)/(zdpm+zdp) )
-      ENDDO
-      ENDDO
-C
-C------------------------------------ modification des profils instables
-      DO 9999 i = 1, klon
-      itest(i) = .FALSE.
-C
-      k1 = 0
-      k2 = 1
-C
-  810 CONTINUE ! chercher k1, le bas de la colonne
-      k2 = k2 + 1
-      IF (k2 .GT. klev) GOTO 9999
-      zflo = v_cptt(i,k2-1) - v_cptt(i,k2) - gamcpdz(i,k2)
-      zsat=(local_q(i,k2-1)-v_qs(i,k2-1))*(paprs(i,k2-1)-paprs(i,k2))
-     .    +(local_q(i,k2)-v_qs(i,k2))*(paprs(i,k2)-paprs(i,k2+1))
-      IF ( zflo.LE.0.0 .OR. zsat.LE.0.0 ) GOTO 810
-      k1 = k2 - 1
-      itest(i) = .TRUE.
-C
-  820 CONTINUE ! chercher k2, le haut de la colonne
-      IF (k2 .EQ. klev) GOTO 821
-      k2p = k2 + 1
-      zsat=zsat +(paprs(i,k2p)-paprs(i,k2p+1))
-     .          *(local_q(i,k2p)-v_qs(i,k2p))
-      zflo = v_cptt(i,k2p-1) - v_cptt(i,k2p) - gamcpdz(i,k2p)
-      IF (zflo.LE.0.0 .OR. zsat.LE.0.0) GOTO 821
-      k2 = k2p
-      GOTO 820
-  821 CONTINUE
-C
-C------------------------------------------------------ ajustement local
-  830 CONTINUE ! ajustement proprement dit
-      v_cptj(k1) = 0.0
-      zdp = paprs(i,k1)-paprs(i,k1+1)
-      v_cptjk1 = ( (1.0+v_qsd(i,k1))*(v_cptt(i,k1)+v_cptj(k1))
-     .               + RLVTT*(local_q(i,k1)-v_qs(i,k1)) ) * zdp
-      v_ssig = zdp * (1.0+v_qsd(i,k1))
-C
-      k1p = k1 + 1
-      DO k = k1p, k2
-         zdp = paprs(i,k)-paprs(i,k+1)
-         v_cptj(k) = v_cptj(k-1) + gamcpdz(i,k)
-         v_cptjk1 = v_cptjk1 + zdp
-     .             * ( (1.0+v_qsd(i, k))*(v_cptt(i,k)+v_cptj(k))
-     .               + RLVTT*(local_q(i,k)-v_qs(i,k)) )
-         v_ssig = v_ssig + zdp *(1.0+v_qsd(i,k))
-      ENDDO
-C
-      DO k = k1, k2
-         cp_new_t(k) = v_cptjk1/v_ssig - v_cptj(k)
-         cp_delta_t(k) = cp_new_t(k) - v_cptt(i,k)
-         new_qb(k) = v_qs(i,k) + v_qsd(i,k)*cp_delta_t(k)/RLVTT
-         local_q(i,k) = new_qb(k)
-         local_t(i,k) = cp_new_t(k) / RCPD
-      ENDDO
-C
-C--------------------------------------------------- sondage vers le bas
-C              -- on redefinit les variables prognostiques dans
-C              -- la colonne qui vient d'etre ajustee
-C
-      DO k = k1, k2
-         v_cptt(i,k) = RCPD * local_t(i,k)
-         v_t = local_t(i,k)
-         v_p = pplay(i,k)
-C
-         IF (thermcep) THEN
-            zdelta=MAX(0.,SIGN(1.,RTT-v_t))
-            zcvm5=R5LES*RLVTT*(1.-zdelta) + zdelta*R5IES*RLSTT
-            zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*local_q(i,k))
-            v_qs(i,k)= R2ES * FOEEW(v_t,zdelta)/v_p
-            v_qs(i,k)=MIN(0.5,v_qs(i,k))
-            zcor=1./(1.-RETV*v_qs(i,k))
-            v_qs(i,k)=v_qs(i,k)*zcor
-            v_qsd(i,k) =FOEDE(v_t,zdelta,zcvm5,v_qs(i,k),zcor)
-         ELSE
-           IF (v_t.LT.t_coup) THEN
-              v_qs(i,k) = qsats(v_t) / v_p
-              v_qsd(i,k) = dqsats(v_t,v_qs(i,k))
-           ELSE
-              v_qs(i,k) = qsatl(v_t) / v_p
-              v_qsd(i,k) = dqsatl(v_t,v_qs(i,k))
-           ENDIF
-         ENDIF
-      ENDDO
-      DO k = 2, klev
-         zdpm = paprs(i,k-1) - paprs(i,k)
-         zdp = paprs(i,k) - paprs(i,k+1)
-         gamcpdz(i,k) = ( ( RD/RCPD /(zdpm+zdp) *
-     .                      (v_cptt(i,k-1)*zdpm+v_cptt(i,k)*zdp)
-     .                     +RLVTT /(zdpm+zdp) *
-     .                      (v_qs(i,k-1)*zdpm+v_qs(i,k)*zdp)
-     .                    )* (pplay(i,k-1)-pplay(i,k)) / paprs(i,k) )
-     .                / (1.0+(v_qsd(i,k-1)*zdpm+v_qsd(i,k)*zdp)
-     .                      /(zdpm+zdp) )
-      ENDDO
-C
-C Verifier si l'on peut etendre la colonne vers le bas
-C
-      IF (k1 .EQ. 1) GOTO 841 ! extension echouee
-      zflo = v_cptt(i,k1-1) - v_cptt(i,k1) - gamcpdz(i,k1)
-      zsat=(local_q(i,k1-1)-v_qs(i,k1-1))*(paprs(i,k1-1)-paprs(i,k1))
-     .   + (local_q(i,k1)-v_qs(i,k1))*(paprs(i,k1)-paprs(i,k1+1))
-      IF (zflo.LE.0.0 .OR. zsat.LE.0.0) GOTO 841 ! extension echouee
-C
-  840 CONTINUE
-      k1 = k1 - 1
-      IF (k1 .EQ. 1) GOTO 830 ! GOTO 820 (a tester, Z.X.Li, mars 1995)
-      zsat = zsat + (local_q(i,k1-1)-v_qs(i,k1-1))
-     .             *(paprs(i,k1-1)-paprs(i,k1))
-      zflo = v_cptt(i,k1-1) - v_cptt(i,k1) - gamcpdz(i,k1)
-      IF (zflo.GT.0.0 .AND. zsat.GT.0.0) THEN
-         GOTO 840
-      ELSE
-         GOTO 830 ! GOTO 820 (a tester, Z.X.Li, mars 1995)
-      ENDIF
-  841 CONTINUE
-C
-      GOTO 810 ! chercher d'autres blocks en haut
-C
- 9999 CONTINUE ! boucle sur tous les points
-C-----------------------------------------------------------------------
-c
-c Determiner la fraction nuageuse (hypothese: la nebulosite a lieu
-c a l'endroit ou la vapeur d'eau est diminuee par l'ajustement):
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         IF (itest(i)) THEN
-         delta_q(i,k) = local_q(i,k) - q(i,k)
-         IF (delta_q(i,k).LT.0.) rneb(i,k)  = 1.0
-         ENDIF
-      ENDDO
-      ENDDO
-c
-c Distribuer l'eau condensee en eau liquide nuageuse (hypothese:
-c l'eau liquide est distribuee aux endroits ou la vapeur d'eau
-c diminue et d'une maniere proportionnelle a cet diminution):
-c
-      DO i = 1, klon
-         IF (itest(i)) THEN
-         zq1(i) = 0.0
-         zq2(i) = 0.0
-         ENDIF
-      ENDDO
-      DO k = 1, klev
-      DO i = 1, klon
-         IF (itest(i)) THEN
-         zdp = paprs(i,k)-paprs(i,k+1)
-         zq1(i) = zq1(i) - delta_q(i,k) * zdp
-         zq2(i) = zq2(i) - MIN(0.0, delta_q(i,k)) * zdp
-         ENDIF
-      ENDDO
-      ENDDO
-      DO k = 1, klev
-      DO i = 1, klon
-         IF (itest(i)) THEN
-         IF (zq2(i).NE.0.0)
-     .      d_ql(i,k) = - MIN(0.0,delta_q(i,k))*zq1(i)/zq2(i)
-         ENDIF
-      ENDDO
-      ENDDO
-C
-      DO k = 1, klev
-      DO i = 1, klon
-          local_q(i, k) = MAX(local_q(i, k), seuil_vap)
-      ENDDO
-      ENDDO
-C
-      DO k = 1, klev
-      DO i = 1, klon
-         d_t(i,k) = local_t(i,k) - t(i,k)
-         d_q(i,k) = local_q(i,k) - q(i,k)
-      ENDDO
-      ENDDO
-c
-      RETURN
-      END
-      SUBROUTINE fiajc(dtime,paprs,pplay,
-     .                 t, q,conv_q,
-     .                 d_t, d_q, d_ql,rneb,
-     .                 rain, snow, ibas, itop)
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-c
-c Options:
-c
-      INTEGER plb ! niveau de depart pour la convection
-      PARAMETER (plb=4)
-c
-c Mystere: cette option n'est pas innocente pour les resultats !
-c Qui peut resoudre ce mystere ? (Z.X.Li mars 1995)
-      LOGICAL vector ! calcul vectorise
-      PARAMETER (vector=.FALSE.)
-c
-      REAL t_coup
-      PARAMETER (t_coup=234.0)
-c
-c Arguments:
-c
-      REAL q(klon,klev) ! humidite specifique (kg/kg)
-      REAL t(klon,klev) ! temperature (K)
-      REAL paprs(klon,klev+1) ! pression a inter-couche (Pa)
-      REAL pplay(klon,klev) ! pression au milieu de couche (Pa)
-      REAL dtime ! intervalle du temps (s)
-      REAL conv_q(klon,klev) ! taux de convergence de l'humidite
-      REAL rneb(klon,klev) ! fraction nuageuse
-      REAL d_q(klon,klev) ! incrementaion pour la vapeur d'eau
-      REAL d_ql(klon,klev) ! incrementation pour l'eau liquide
-      REAL d_t(klon,klev) ! incrementation pour la temperature
-      REAL rain(klon) ! variable non-utilisee
-      REAL snow(klon) ! variable non-utilisee
-      INTEGER itop(klon) ! variable non-utilisee
-      INTEGER ibas(klon) ! variable non-utilisee
-c
-      INTEGER kh(klon), i, k
-      LOGICAL nuage(klon), test(klon,klev)
-      REAL zconv(klon), zdeh(klon,klev), zvirt(klon)
-      REAL zdqs(klon,klev), zqs(klon,klev)
-      REAL ztt, zvar, zfrac(klon)
-      REAL zq1(klon), zq2(klon)
-      REAL zdelta, zcor, zcvm5
-C
-#include "YOETHF.h"
-#include "FCTTRE.h"
-c
-c Initialiser les sorties:
-c
-      DO k = 1, klev
-      DO i = 1, klon
-          rneb(i,k) = 0.0
-          d_ql(i,k) = 0.0
-          d_t(i,k) = 0.0
-          d_q(i,k) = 0.0
-      ENDDO
-      ENDDO
-      DO i = 1, klon
-         itop(i) = 0
-         ibas(i) = 0
-         rain(i) = 0.0
-         snow(i) = 0.0
-      ENDDO
-c
-c Calculer Qs et L/Cp * dQs/dT:
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         ztt = t(i,k)
-         IF (thermcep) THEN
-           zdelta=MAX(0.,SIGN(1.,RTT-ztt))
-           zcvm5=R5LES*RLVTT*(1.-zdelta) + zdelta*R5IES*RLSTT
-           zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*q(i,k))
-           zqs(i,k)= R2ES*FOEEW(ztt,zdelta)/pplay(i,k)
-           zqs(i,k)=MIN(0.5,zqs(i,k))
-           zcor=1./(1.-RETV*zqs(i,k))
-           zqs(i,k)=zqs(i,k)*zcor
-           zdqs(i,k) =FOEDE(ztt,zdelta,zcvm5,zqs(i,k),zcor)
-         ELSE
-           IF (ztt .LT. t_coup) THEN
-              zqs(i,k) = qsats(ztt) / pplay(i,k)
-              zdqs(i,k) = dqsats(ztt,zqs(i,k))
-           ELSE
-              zqs(i,k) = qsatl(ztt) / pplay(i,k)
-              zdqs(i,k) = dqsatl(ztt,zqs(i,k))
-           ENDIF
-         ENDIF
-      ENDDO
-      ENDDO
-c
-c Determiner la difference de l'energie totale saturee:
-c
-      DO i = 1, klon
-         k = plb
-         zdeh(i,k) = RCPD * (t(i,k-1)-t(i,k))
-     .             - RD *0.5*(t(i,k-1)+t(i,k))/paprs(i,k)
-     .                  *(pplay(i,k-1)-pplay(i,k))
-     .             + RLVTT*(zqs(i,k-1)-zqs(i,k))
-         zdeh(i,k) = zdeh(i,k) * 0.5 ! on prend la moitie
-      ENDDO
-      DO k = plb+1, klev
-      DO i = 1, klon
-      zdeh(i,k) = zdeh(i,k-1)
-     .             + RCPD * (t(i,k-1)-t(i,k))
-     .             - RD *0.5*(t(i,k-1)+t(i,k))/paprs(i,k)
-     .                  *(pplay(i,k-1)-pplay(i,k))
-     .             + RLVTT*(zqs(i,k-1)-zqs(i,k))
-      ENDDO
-      ENDDO
-c
-c Determiner le sommet du nuage selon l'instabilite
-c Calculer les convergences d'humidite (reelle et virtuelle)
-c
-      DO i = 1, klon
-         nuage(i) = .TRUE.
-         zconv(i) = 0.0
-         zvirt(i) = 0.0
-         kh(i) = -999
-      ENDDO
-      DO k = plb, klev
-      DO i = 1, klon
-         nuage(i) = nuage(i) .AND. zdeh(i,k).GT.0.0
-         IF (nuage(i)) THEN
-            kh(i)  = k
-            zconv(i) = zconv(i)+conv_q(i,k)*dtime
-     .                         *(paprs(i,k)-paprs(i,k+1))
-            zvirt(i)=zvirt(i)+(zdeh(i,k)/RLVTT+zqs(i,k)-q(i,k))
-     .                       *(paprs(i,k)-paprs(i,k+1))
-         ENDIF
-      ENDDO
-      ENDDO
-c
-      IF (vector) THEN
-c
-c
-      DO k = plb, klev
-      DO i = 1, klon
-      IF (k.LE.kh(i) .AND. kh(i).GT.plb .AND. zconv(i).GT.0.0) THEN
-         test(i,k) = .TRUE.
-         zfrac(i) = MAX(0.0,MIN(zconv(i)/zvirt(i),1.0))
-      ELSE
-         test(i,k) = .FALSE.
-      ENDIF
-      ENDDO
-      ENDDO
-c
-      DO k = plb, klev
-      DO i = 1, klon
-      IF (test(i,k)) THEN
-         zvar = zdeh(i,k)/(1.0+zdqs(i,k))
-         d_q(i,k) = (zvar*zdqs(i,k)/RLVTT+zqs(i,k)-q(i,k))*zfrac(i)
-     .            - conv_q(i,k)*dtime
-         d_t(i,k) = zvar * zfrac(i) / RCPD
-      ENDIF
-      ENDDO
-      ENDDO
-c
-      DO i = 1, klon
-         zq1(i) = 0.0
-         zq2(i) = 0.0
-      ENDDO
-      DO k = plb, klev
-      DO i = 1, klon
-      IF (test(i,k)) THEN
-         IF (d_q(i,k).LT.0.0) rneb(i,k) = zfrac(i)
-         zq1(i) = zq1(i) - d_q(i,k) * (paprs(i,k)-paprs(i,k+1))
-         zq2(i) = zq2(i) - MIN(0.0, d_q(i,k))
-     .                   * (paprs(i,k)-paprs(i,k+1))
-      ENDIF
-      ENDDO
-      ENDDO
-c
-      DO k = plb, klev
-      DO i = 1, klon
-      IF (test(i,k)) THEN
-         IF(zq2(i).NE.0.)d_ql(i,k)=-MIN(0.0,d_q(i,k))*zq1(i)/zq2(i)
-      ENDIF
-      ENDDO
-      ENDDO
-c
-      ELSE ! (.NOT. vector)
-c
-      DO 999 i = 1, klon
-      IF (kh(i).GT.plb .AND. zconv(i).GT.0.0) THEN
-ccc         IF (kh(i).LE.plb) GOTO 999 ! il n'y a pas d'instabilite
-ccc         IF (zconv(i).LE.0.0) GOTO 999 ! convergence insuffisante
-         zfrac(i)  = MAX(0.0,MIN(zconv(i)/zvirt(i),1.0))
-         DO k = plb, kh(i)
-            zvar = zdeh(i,k)/(1.0+zdqs(i,k))
-            d_q(i,k) = (zvar*zdqs(i,k)/RLVTT+zqs(i,k)-q(i,k))*zfrac(i)
-     .               - conv_q(i,k)*dtime
-            d_t(i,k) = zvar * zfrac(i) / RCPD
-         ENDDO
-c
-         zq1(i) = 0.0
-         zq2(i) = 0.0
-         DO k = plb, kh(i)
-            IF (d_q(i,k).LT.0.0) rneb(i,k) = zfrac(i)
-            zq1(i) = zq1(i) - d_q(i,k) * (paprs(i,k)-paprs(i,k+1))
-            zq2(i) = zq2(i) - MIN(0.0, d_q(i,k))
-     .                      * (paprs(i,k)-paprs(i,k+1))
-         ENDDO
-         DO k = plb, kh(i)
-            IF(zq2(i).NE.0.)d_ql(i,k)=-MIN(0.0,d_q(i,k))*zq1(i)/zq2(i)
-         ENDDO
-      ENDIF
-  999 CONTINUE
-c
-      ENDIF ! fin de teste sur vector
-c
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/convect1.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/convect1.F	(revision 416)
+++ 	(revision )
@@ -1,645 +1,0 @@
-      subroutine convect1(len,nd,ndp1,noff,minorig,
-     &                   t,q,qs,u,v,
-     &                   p,ph,iflag,ft,
-     &                   fq,fu,fv,precip,cbmf,delt,Ma)
-C.............................START PROLOGUE............................
-C
-C SCCS IDENTIFICATION:  @(#)convect1.f	1.1 04/21/00
-C                       19:40:52 /h/cm/library/nogaps4/src/sub/fcst/convect1.f_v
-C
-C CONFIGURATION IDENTIFICATION:  None
-C
-C MODULE NAME:  convect1
-C
-C DESCRIPTION:
-C
-C convect1     The Emanuel Cumulus Convection Scheme
-C
-C CONTRACT NUMBER AND TITLE:  None
-C
-C REFERENCES: Programmers  K. Emanuel (MIT), Timothy F. Hogan, M. Peng (NRL)
-C
-C CLASSIFICATION:  Unclassified
-C
-C RESTRICTIONS: None
-C
-C COMPILER DEPENDENCIES: FORTRAN 77, FORTRAN 90
-C
-C COMPILE OPTIONS: Fortran 77: -Zu -Wf"-ei -o aggress"
-C                  Fortran 90: -O vector3,scalar3,task1,aggress,overindex  -ei -r 2
-C
-C LIBRARIES OF RESIDENCE: /a/ops/lib/libfcst159.a
-C
-C USAGE: call convect1(len,nd,noff,minorig,
-C    &                   t,q,qs,u,v,
-C    &                   p,ph,iflag,ft,
-C    &                   fq,fu,fv,precip,cbmf,delt)
-C
-C PARAMETERS:
-C      Name            Type         Usage            Description
-C   ----------      ----------     -------  ----------------------------
-C
-C      len           Integer        Input        first (i) dimension
-C      nd            Integer        Input        vertical (k) dimension
-C      ndp1          Integer        Input        nd + 1
-C      noff          Integer        Input        integer limit for convection (nd-noff)
-C      minorig       Integer        Input        First level of convection
-C      t             Real           Input        temperature
-C      q             Real           Input        specific hum
-C      qs            Real           Input        sat specific hum
-C      u             Real           Input        u-wind
-C      v             Real           Input        v-wind
-C      p             Real           Input        full level pressure
-C      ph            Real           Input        half level pressure
-C      iflag         Integer        Output       iflag on latitude strip
-C      ft            Real           Output       temp tend
-C      fq            Real           Output       spec hum tend
-C      fu            Real           Output       u-wind tend
-C      fv            Real           Output       v-wind tend
-C      cbmf          Real           In/Out       cumulus mass flux
-C      delt          Real           Input        time step
-C      iflag         Integer        Output       integer flag for Emanuel conditions
-C
-C COMMON BLOCKS:
-C      Block      Name     Type    Usage              Notes
-C     --------  --------   ----    ------   ------------------------
-C
-C FILES: None
-C
-C DATA BASES: None
-C
-C NON-FILE INPUT/OUTPUT: None
-C
-C ERROR CONDITIONS: None
-C
-C ADDITIONAL COMMENTS: None
-C
-C.................MAINTENANCE SECTION................................
-C
-C MODULES CALLED:
-C         Name           Description
-C         convect2        Emanuel cumulus convection tendency calculations
-C        -------     ----------------------
-C LOCAL VARIABLES AND
-C          STRUCTURES:
-C Name     Type    Description
-C -------  ------  -----------
-C See Comments Below
-C
-C i        Integer loop index
-C k        Integer loop index
-c
-C METHOD:
-C
-C See Emanuel, K. and M. Zivkovic-Rothman, 2000: Development and evaluation of a
-C       convective scheme for use in climate models.
-C
-C FILES: None
-C
-C INCLUDE FILES: None
-C
-C MAKEFILE: /a/ops/met/nogaps/src/sub/fcst/fcst159lib.mak
-C
-C..............................END PROLOGUE.............................
-c
-c
-      implicit none
-c
-#include "dimensions.h"
-#include "dimphy.h"
-c
-      integer len
-      integer nd
-      integer ndp1
-      integer noff
-      real t(len,nd)
-      real q(len,nd)
-      real qs(len,nd)
-      real u(len,nd)
-      real v(len,nd)
-      real p(len,nd)
-      real ph(len,ndp1)
-      integer iflag(len)
-      real ft(len,nd)
-      real fq(len,nd)
-      real fu(len,nd)
-      real fv(len,nd)
-      real precip(len)
-      real cbmf(len)
-      real Ma(len,nd)
-      integer minorig
-      real delt,cpd,cpv,cl,rv,rd,lv0,g
-      real sigs,sigd,elcrit,tlcrit,omtsnow,dtmax,damp
-      real alpha,entp,coeffs,coeffr,omtrain,cu
-c
-!-------------------------------------------------------------------
-! --- ARGUMENTS
-!-------------------------------------------------------------------
-! --- On input:
-!
-!  t:   Array of absolute temperature (K) of dimension ND, with first
-!       index corresponding to lowest model level. Note that this array
-!       will be altered by the subroutine if dry convective adjustment
-!       occurs and if IPBL is not equal to 0.
-!
-!  q:   Array of specific humidity (gm/gm) of dimension ND, with first
-!       index corresponding to lowest model level. Must be defined
-!       at same grid levels as T. Note that this array will be altered
-!       if dry convective adjustment occurs and if IPBL is not equal to 0.
-!
-!  qs:  Array of saturation specific humidity of dimension ND, with first
-!       index corresponding to lowest model level. Must be defined
-!       at same grid levels as T. Note that this array will be altered
-!       if dry convective adjustment occurs and if IPBL is not equal to 0.
-!
-!  u:   Array of zonal wind velocity (m/s) of dimension ND, witth first
-!       index corresponding with the lowest model level. Defined at
-!       same levels as T. Note that this array will be altered if
-!       dry convective adjustment occurs and if IPBL is not equal to 0.
-!
-!  v:   Same as u but for meridional velocity.
-!
-!  tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
-!       where NTRA is the number of different tracers. If no
-!       convective tracer transport is needed, define a dummy
-!       input array of dimension (ND,1). Tracers are defined at
-!       same vertical levels as T. Note that this array will be altered
-!       if dry convective adjustment occurs and if IPBL is not equal to 0.
-!
-!  p:   Array of pressure (mb) of dimension ND, with first
-!       index corresponding to lowest model level. Must be defined
-!       at same grid levels as T.
-!
-!  ph:  Array of pressure (mb) of dimension ND+1, with first index
-!       corresponding to lowest level. These pressures are defined at
-!       levels intermediate between those of P, T, Q and QS. The first
-!       value of PH should be greater than (i.e. at a lower level than)
-!       the first value of the array P.
-!
-!  nl:  The maximum number of levels to which convection can penetrate, plus 1.
-!       NL MUST be less than or equal to ND-1.
-!
-!  delt: The model time step (sec) between calls to CONVECT
-!
-!----------------------------------------------------------------------------
-! ---   On Output:
-!
-!  iflag: An output integer whose value denotes the following:
-!       VALUE   INTERPRETATION
-!       -----   --------------
-!         0     Moist convection occurs.
-!         1     Moist convection occurs, but a CFL condition
-!               on the subsidence warming is violated. This
-!               does not cause the scheme to terminate.
-!         2     Moist convection, but no precip because ep(inb) lt 0.0001
-!         3     No moist convection because new cbmf is 0 and old cbmf is 0.
-!         4     No moist convection; atmosphere is not
-!               unstable
-!         6     No moist convection because ihmin le minorig.
-!         7     No moist convection because unreasonable
-!               parcel level temperature or specific humidity.
-!         8     No moist convection: lifted condensation
-!               level is above the 200 mb level.
-!         9     No moist convection: cloud base is higher
-!               then the level NL-1.
-!
-!  ft:   Array of temperature tendency (K/s) of dimension ND, defined at same
-!        grid levels as T, Q, QS and P.
-!
-!  fq:   Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
-!        defined at same grid levels as T, Q, QS and P.
-!
-!  fu:   Array of forcing of zonal velocity (m/s^2) of dimension ND,
-!        defined at same grid levels as T.
-!
-!  fv:   Same as FU, but for forcing of meridional velocity.
-!
-!  ftra: Array of forcing of tracer content, in tracer mixing ratio per
-!        second, defined at same levels as T. Dimensioned (ND,NTRA).
-!
-!  precip: Scalar convective precipitation rate (mm/day).
-!
-!  wd:   A convective downdraft velocity scale. For use in surface
-!        flux parameterizations. See convect.ps file for details.
-!
-!  tprime: A convective downdraft temperature perturbation scale (K).
-!          For use in surface flux parameterizations. See convect.ps
-!          file for details.
-!
-!  qprime: A convective downdraft specific humidity
-!          perturbation scale (gm/gm).
-!          For use in surface flux parameterizations. See convect.ps
-!          file for details.
-!
-!  cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
-!        BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
-!        ITS NEXT CALL. That is, the value of CBMF must be "remembered"
-!        by the calling program between calls to CONVECT.
-!
-!  det:   Array of detrainment mass flux of dimension ND.
-!
-!-------------------------------------------------------------------
-c
-c  Local arrays
-c
-      integer nl
-      integer nlp
-      integer nlm
-      integer i,k,n
-      real delti
-      real rowl
-      real clmcpv
-      real clmcpd
-      real cpdmcp
-      real cpvmcpd
-      real eps
-      real epsi
-      real epsim1
-      real ginv
-      real hrd
-      real prccon1
-      integer icbmax
-      real lv(klon,klev)
-      real cpn(klon,klev)
-      real cpx(klon,klev)
-      real tv(klon,klev)
-      real gz(klon,klev)
-      real hm(klon,klev)
-      real h(klon,klev)
-      real work(klon)
-      integer ihmin(klon)
-      integer nk(klon)
-      real rh(klon)
-      real chi(klon)
-      real plcl(klon)
-      integer icb(klon)
-      real tnk(klon)
-      real qnk(klon)
-      real gznk(klon)
-      real pnk(klon)
-      real qsnk(klon)
-      real ticb(klon)
-      real gzicb(klon)
-      real tp(klon,klev)
-      real tvp(klon,klev)
-      real clw(klon,klev)
-c
-      real ah0(klon),cpp(klon)
-      real tg,qg,s,alv,tc,ahg,denom,es,rg
-c
-      integer ncum
-      integer idcum(klon)
-c
-      cpd=1005.7
-      cpv=1870.0
-      cl=4190.0
-      rv=461.5
-      rd=287.04
-      lv0=2.501E6
-      g=9.8
-C
-C   *** ELCRIT IS THE AUTOCONVERSION THERSHOLD WATER CONTENT (gm/gm) ***
-C   ***  TLCRIT IS CRITICAL TEMPERATURE BELOW WHICH THE AUTO-        ***
-C   ***       CONVERSION THRESHOLD IS ASSUMED TO BE ZERO             ***
-C   ***     (THE AUTOCONVERSION THRESHOLD VARIES LINEARLY            ***
-C   ***               BETWEEN 0 C AND TLCRIT)                        ***
-C   ***   ENTP IS THE COEFFICIENT OF MIXING IN THE ENTRAINMENT       ***
-C   ***                       FORMULATION                            ***
-C   ***  SIGD IS THE FRACTIONAL AREA COVERED BY UNSATURATED DNDRAFT  ***
-C   ***  SIGS IS THE FRACTION OF PRECIPITATION FALLING OUTSIDE       ***
-C   ***                        OF CLOUD                              ***
-C   ***        OMTRAIN IS THE ASSUMED FALL SPEED (P/s) OF RAIN       ***
-C   ***     OMTSNOW IS THE ASSUMED FALL SPEED (P/s) OF SNOW          ***
-C   ***  COEFFR IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION   ***
-C   ***                          OF RAIN                             ***
-C   ***  COEFFS IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION   ***
-C   ***                          OF SNOW                             ***
-C   ***     CU IS THE COEFFICIENT GOVERNING CONVECTIVE MOMENTUM      ***
-C   ***                         TRANSPORT                            ***
-C   ***    DTMAX IS THE MAXIMUM NEGATIVE TEMPERATURE PERTURBATION    ***
-C   ***        A LIFTED PARCEL IS ALLOWED TO HAVE BELOW ITS LFC      ***
-C   ***    ALPHA AND DAMP ARE PARAMETERS THAT CONTROL THE RATE OF    ***
-C   ***                 APPROACH TO QUASI-EQUILIBRIUM                ***
-C   ***   (THEIR STANDARD VALUES ARE  0.20 AND 0.1, RESPECTIVELY)    ***
-C   ***                   (DAMP MUST BE LESS THAN 1)                 ***
-c
-      sigs=0.12
-      sigd=0.05
-      elcrit=0.0011
-      tlcrit=-55.0
-      omtsnow=5.5
-      dtmax=0.9
-      damp=0.1
-      alpha=0.2
-      entp=1.5
-      coeffs=0.8
-      coeffr=1.0
-      omtrain=50.0
-c
-      cu=0.70
-      damp=0.1
-c
-c
-c Define nl, nlp, nlm, and delti
-c
-      nl=nd-noff
-      nlp=nl+1
-      nlm=nl-1
-      delti=1.0/delt
-!
-!-------------------------------------------------------------------
-! --- SET CONSTANTS
-!-------------------------------------------------------------------
-!
-      rowl=1000.0
-      clmcpv=cl-cpv
-      clmcpd=cl-cpd
-      cpdmcp=cpd-cpv
-      cpvmcpd=cpv-cpd
-      eps=rd/rv
-      epsi=1.0/eps
-      epsim1=epsi-1.0
-      ginv=1.0/g
-      hrd=0.5*rd
-      prccon1=86400.0*1000.0/(rowl*g)
-!
-! dtmax is the maximum negative temperature perturbation.
-!
-!=====================================================================
-! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
-!=====================================================================
-!
-      do 20 k=1,nd
-        do 10 i=1,len
-         ft(i,k)=0.0
-         fq(i,k)=0.0
-         fu(i,k)=0.0
-         fv(i,k)=0.0
-         tvp(i,k)=0.0
-         tp(i,k)=0.0
-         clw(i,k)=0.0
-         gz(i,k) = 0.
- 10     continue
- 20   continue
-      do 60 i=1,len
-        precip(i)=0.0
-        iflag(i)=0
- 60   continue
-c
-!=====================================================================
-! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
-!=====================================================================
-      do 110 k=1,nl+1
-        do 100 i=1,len
-          lv(i,k)= lv0-clmcpv*(t(i,k)-273.15)
-          cpn(i,k)=cpd*(1.0-q(i,k))+cpv*q(i,k)
-          cpx(i,k)=cpd*(1.0-q(i,k))+cl*q(i,k)
-          tv(i,k)=t(i,k)*(1.0+q(i,k)*epsim1)
- 100    continue
- 110  continue
-c
-c gz = phi at the full levels (same as p).
-c
-      do 120 i=1,len
-        gz(i,1)=0.0
- 120  continue
-      do 140 k=2,nlp
-        do 130 i=1,len
-          gz(i,k)=gz(i,k-1)+hrd*(tv(i,k-1)+tv(i,k))
-     &         *(p(i,k-1)-p(i,k))/ph(i,k)
- 130    continue
- 140  continue
-c
-c h  = phi + cpT (dry static energy).
-c hm = phi + cp(T-Tbase)+Lq
-c
-      do 170 k=1,nlp
-        do 160 i=1,len
-          h(i,k)=gz(i,k)+cpn(i,k)*t(i,k)
-          hm(i,k)=gz(i,k)+cpx(i,k)*(t(i,k)-t(i,1))+lv(i,k)*q(i,k)
- 160    continue
- 170  continue
-c
-!-------------------------------------------------------------------
-! --- Find level of minimum moist static energy
-! --- If level of minimum moist static energy coincides with
-! --- or is lower than minimum allowable parcel origin level,
-! --- set iflag to 6.
-!-------------------------------------------------------------------
-      do 180 i=1,len
-       work(i)=1.0e12
-       ihmin(i)=nl
- 180  continue
-      do 200 k=2,nlp
-        do 190 i=1,len
-         if((hm(i,k).lt.work(i)).and.
-     &      (hm(i,k).lt.hm(i,k-1)))then
-           work(i)=hm(i,k)
-           ihmin(i)=k
-         endif
- 190    continue
- 200  continue
-      do 210 i=1,len
-        ihmin(i)=min(ihmin(i),nlm)
-        if(ihmin(i).le.minorig)then
-          iflag(i)=6
-        endif
- 210  continue
-c
-!-------------------------------------------------------------------
-! --- Find that model level below the level of minimum moist static
-! --- energy that has the maximum value of moist static energy
-!-------------------------------------------------------------------
- 
-      do 220 i=1,len
-       work(i)=hm(i,minorig)
-       nk(i)=minorig
- 220  continue
-      do 240 k=minorig+1,nl
-        do 230 i=1,len
-         if((hm(i,k).gt.work(i)).and.(k.le.ihmin(i)))then
-           work(i)=hm(i,k)
-           nk(i)=k
-         endif
- 230     continue
- 240  continue
-!-------------------------------------------------------------------
-! --- Check whether parcel level temperature and specific humidity
-! --- are reasonable
-!-------------------------------------------------------------------
-       do 250 i=1,len
-       if(((t(i,nk(i)).lt.250.0).or.
-     &      (q(i,nk(i)).le.0.0).or.
-     &      (p(i,ihmin(i)).lt.400.0)).and.
-     &      (iflag(i).eq.0))iflag(i)=7
- 250   continue
-!-------------------------------------------------------------------
-! --- Calculate lifted condensation level of air at parcel origin level
-! --- (Within 0.2% of formula of Bolton, MON. WEA. REV.,1980)
-!-------------------------------------------------------------------
-       do 260 i=1,len
-        tnk(i)=t(i,nk(i))
-        qnk(i)=q(i,nk(i))
-        gznk(i)=gz(i,nk(i))
-        pnk(i)=p(i,nk(i))
-        qsnk(i)=qs(i,nk(i))
-c
-        rh(i)=qnk(i)/qsnk(i)
-        rh(i)=min(1.0,rh(i))
-        chi(i)=tnk(i)/(1669.0-122.0*rh(i)-tnk(i))
-        plcl(i)=pnk(i)*(rh(i)**chi(i))
-        if(((plcl(i).lt.200.0).or.(plcl(i).ge.2000.0))
-     &   .and.(iflag(i).eq.0))iflag(i)=8
- 260   continue
-!-------------------------------------------------------------------
-! --- Calculate first level above lcl (=icb)
-!-------------------------------------------------------------------
-      do 270 i=1,len
-       icb(i)=nlm
- 270  continue
-c
-      do 290 k=minorig,nl
-        do 280 i=1,len
-          if((k.ge.(nk(i)+1)).and.(p(i,k).lt.plcl(i)))
-     &    icb(i)=min(icb(i),k)
- 280    continue
- 290  continue
-c
-      do 300 i=1,len
-        if((icb(i).ge.nlm).and.(iflag(i).eq.0))iflag(i)=9
- 300  continue
-c
-c Compute icbmax.
-c
-      icbmax=2
-      do 310 i=1,len
-        icbmax=max(icbmax,icb(i))
- 310  continue
-!
-!-------------------------------------------------------------------
-! --- Calculates the lifted parcel virtual temperature at nk,
-! --- the actual temperature, and the adiabatic
-! --- liquid water content. The procedure is to solve the equation.
-!     cp*tp+L*qp+phi=cp*tnk+L*qnk+gznk.
-!-------------------------------------------------------------------
-!
-      do 320 i=1,len
-        tnk(i)=t(i,nk(i))
-        qnk(i)=q(i,nk(i))
-        gznk(i)=gz(i,nk(i))
-        ticb(i)=t(i,icb(i))
-        gzicb(i)=gz(i,icb(i))
- 320  continue
-c
-c   ***  Calculate certain parcel quantities, including static energy   ***
-c
-      do 330 i=1,len
-        ah0(i)=(cpd*(1.-qnk(i))+cl*qnk(i))*tnk(i)
-     &         +qnk(i)*(lv0-clmcpv*(tnk(i)-273.15))+gznk(i)
-        cpp(i)=cpd*(1.-qnk(i))+qnk(i)*cpv
- 330  continue
-c
-c   ***   Calculate lifted parcel quantities below cloud base   ***
-c
-        do 350 k=minorig,icbmax-1
-          do 340 i=1,len
-           tp(i,k)=tnk(i)-(gz(i,k)-gznk(i))/cpp(i)
-           tvp(i,k)=tp(i,k)*(1.+qnk(i)*epsi)
-  340     continue
-  350   continue
-c
-c    ***  Find lifted parcel quantities above cloud base    ***
-c
-        do 360 i=1,len
-         tg=ticb(i)
-         qg=qs(i,icb(i))
-         alv=lv0-clmcpv*(ticb(i)-273.15)
-c
-c First iteration.
-c
-          s=cpd+alv*alv*qg/(rv*ticb(i)*ticb(i))
-          s=1./s
-          ahg=cpd*tg+(cl-cpd)*qnk(i)*ticb(i)+alv*qg+gzicb(i)
-          tg=tg+s*(ah0(i)-ahg)
-          tg=max(tg,35.0)
-          tc=tg-273.15
-          denom=243.5+tc
-          if(tc.ge.0.0)then
-           es=6.112*exp(17.67*tc/denom)
-          else
-           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-          endif
-          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
-c
-c Second iteration.
-c
-          s=cpd+alv*alv*qg/(rv*ticb(i)*ticb(i))
-          s=1./s
-          ahg=cpd*tg+(cl-cpd)*qnk(i)*ticb(i)+alv*qg+gzicb(i)
-          tg=tg+s*(ah0(i)-ahg)
-          tg=max(tg,35.0)
-          tc=tg-273.15
-          denom=243.5+tc
-          if(tc.ge.0.0)then
-           es=6.112*exp(17.67*tc/denom)
-          else
-           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-          end if
-          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
-c
-         alv=lv0-clmcpv*(ticb(i)-273.15)
-         tp(i,icb(i))=(ah0(i)-(cl-cpd)*qnk(i)*ticb(i)
-     &   -gz(i,icb(i))-alv*qg)/cpd
-         clw(i,icb(i))=qnk(i)-qg
-         clw(i,icb(i))=max(0.0,clw(i,icb(i)))
-         rg=qg/(1.-qnk(i))
-         tvp(i,icb(i))=tp(i,icb(i))*(1.+rg*epsi)
-  360   continue
-c
-      do 380 k=minorig,icbmax
-       do 370 i=1,len
-         tvp(i,k)=tvp(i,k)-tp(i,k)*qnk(i)
- 370   continue
- 380  continue
-c
-!-------------------------------------------------------------------
-! --- Test for instability.
-! --- If there was no convection at last time step and parcel
-! --- is stable at icb, then set iflag to 4.
-!-------------------------------------------------------------------
- 
-      do 390 i=1,len
-        if((cbmf(i).eq.0.0) .and.(iflag(i).eq.0).and.
-     &  (tvp(i,icb(i)).le.(tv(i,icb(i))-dtmax)))iflag(i)=4
- 390  continue
- 
-!=====================================================================
-! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
-!=====================================================================
-c
-      ncum=0
-      do 400 i=1,len
-        if(iflag(i).eq.0)then
-           ncum=ncum+1
-           idcum(ncum)=i
-        endif
- 400  continue
-c
-c Call convect2, which compresses the points and computes the heating,
-c moistening, velocity mixing, and precipiation.
-c
-c     print*,'cpd avant convect2 ',cpd
-      if(ncum.gt.0)then
-      call convect2(ncum,idcum,len,nd,ndp1,nl,minorig,
-     &              nk,icb,
-     &              t,q,qs,u,v,gz,tv,tp,tvp,clw,h,
-     &              lv,cpn,p,ph,ft,fq,fu,fv,
-     &              tnk,qnk,gznk,plcl,
-     &              precip,cbmf,iflag,
-     &              delt,cpd,cpv,cl,rv,rd,lv0,g,
-     &              sigs,sigd,elcrit,tlcrit,omtsnow,dtmax,damp,
-     &              alpha,entp,coeffs,coeffr,omtrain,cu,Ma)
-      endif
-c
-      return
-      end
Index: LMDZ.3.3/branches/rel-/libf/phylmd/convect2.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/convect2.F	(revision 416)
+++ 	(revision )
@@ -1,1394 +1,0 @@
-c
-c $Header$
-c
-      subroutine convect2(ncum,idcum,len,nd,ndp1,nl,minorig,
-     &                 nk1,icb1,
-     &                 t1,q1,qs1,u1,v1,gz1,tv1,tp1,tvp1,clw1,h1,
-     &                 lv1,cpn1,p1,ph1,ft1,fq1,fu1,fv1,
-     &                 tnk1,qnk1,gznk1,plcl1,
-     &                 precip1,cbmf1,iflag1,
-     &                 delt,cpd,cpv,cl,rv,rd,lv0,g,
-     &                 sigs,sigd,elcrit,tlcrit,omtsnow,dtmax,damp,
-     &                 alpha,entp,coeffs,coeffr,omtrain,cu,Ma)
-C.............................START PROLOGUE............................
-C
-C SCCS IDENTIFICATION:  @(#)convect2.f	1.2 05/18/00
-C                       22:06:22 /h/cm/library/nogaps4/src/sub/fcst/convect2.f_v
-C
-C CONFIGURATION IDENTIFICATION:  None
-C
-C MODULE NAME:  convect2
-C
-C DESCRIPTION:
-C
-C convect1     The Emanuel Cumulus Convection Scheme - compute tendencies
-C
-C CONTRACT NUMBER AND TITLE:  None
-C
-C REFERENCES: Programmers  K. Emanuel (MIT), Timothy F. Hogan, M. Peng (NRL)
-C
-C CLASSIFICATION:  Unclassified
-C
-C RESTRICTIONS: None
-C
-C COMPILER DEPENDENCIES: FORTRAN 77, FORTRAN 90
-C
-C COMPILE OPTIONS: Fortran 77: -Zu -Wf"-ei -o aggress"
-C                  Fortran 90: -O vector3,scalar3,task1,aggress,overindex  -ei -r 2
-C
-C LIBRARIES OF RESIDENCE: /a/ops/lib/libfcst159.a
-C
-C USAGE: call convect2(ncum,idcum,len,nd,nl,minorig,
-C    &                 nk1,icb1,
-C    &                 t1,q1,qs1,u1,v1,gz1,tv1,tp1,tvp1,clw1,h1,
-C    &                 lv1,cpn1,p1,ph1,ft1,fq1,fu1,fv1,
-C    &                 tnk1,qnk1,gznk1,plcl1,
-C    &                 precip1,cbmf1,iflag1,
-C    &                 delt,cpd,cpv,cl,rv,rd,lv0,g,
-C    &                 sigs,sigd,elcrit,tlcrit,omtsnow,dtmax,damp,
-C    &                 alpha,entp,coeffs,coeffr,omtrain,cu)
-C
-C PARAMETERS:
-C      Name            Type         Usage            Description
-C   ----------      ----------     -------  ----------------------------
-C
-C      ncum          Integer        Input        number of cumulus points
-C      idcum         Integer        Input        index of cumulus point
-C      len           Integer        Input        first dimension
-C      nd            Integer        Input        total vertical dimension
-C      ndp1          Integer        Input        nd + 1
-C      nl            Integer        Input        vertical dimension for convection
-C      minorig       Integer        Input        First level where convection is allow to begin
-C      nk1           Integer        Input        First level of convection
-C      ncb1          Integer        Input        Level of free convection
-C      t1            Real           Input        temperature
-C      q1            Real           Input        specific hum
-C      qs1           Real           Input        sat specific hum
-C      u1            Real           Input        u-wind
-C      v1            Real           Input        v-wind
-C      gz1           Real           Inout        geop
-C      tv1           Real           Input        virtual temp
-C      tp1           Real           Input
-C      clw1          Real           Inout        cloud liquid water
-C      h1            Real           Inout
-C      lv1           Real           Inout
-C      cpn1          Real           Inout
-C      p1            Real           Input        full level pressure
-C      ph1           Real           Input        half level pressure
-C      ft1           Real           Output       temp tend
-C      fq1           Real           Output       spec hum tend
-C      fu1           Real           Output       u-wind tend
-C      fv1           Real           Output       v-wind tend
-C      precip1       Real           Output       prec
-C      cbmf1         Real           In/Out       cumulus mass flux
-C      iflag1        Integer        Output       iflag on latitude strip
-C      delt          Real           Input        time step
-C      cpd           Integer        Input        See description below
-C      cpv           Integer        Input        See description below
-C      cl            Integer        Input        See description below
-C      rv            Integer        Input        See description below
-C      rd            Integer        Input        See description below
-C      lv0           Integer        Input        See description below
-C      g             Integer        Input        See description below
-C      sigs          Integer        Input        See description below
-C      sigd          Integer        Input        See description below
-C      elcrit        Integer        Input        See description below
-C      tlcrit        Integer        Input        See description below
-C      omtsnow       Integer        Input        See description below
-C      dtmax         Integer        Input        See description below
-C      damp          Integer        Input        See description below
-C      alpha         Integer        Input        See description below
-C      ent           Integer        Input        See description below
-C      coeffs        Integer        Input        See description below
-C      coeffr        Integer        Input        See description below
-C      omtrain       Integer        Input        See description below
-C      cu            Integer        Input        See description below
-C
-C COMMON BLOCKS:
-C      Block      Name     Type    Usage              Notes
-C     --------  --------   ----    ------   ------------------------
-C
-C FILES: None
-C
-C DATA BASES: None
-C
-C NON-FILE INPUT/OUTPUT: None
-C
-C ERROR CONDITIONS: None
-C
-C ADDITIONAL COMMENTS: None
-C
-C.................MAINTENANCE SECTION................................
-C
-C MODULES CALLED:
-C         Name           Description
-C         zilch        Zero out an array
-C        -------     ----------------------
-C LOCAL VARIABLES AND
-C          STRUCTURES:
-C Name     Type    Description
-C -------  ------  -----------
-C See Comments Below
-C
-C i        Integer loop index
-C k        Integer loop index
-c
-C METHOD:
-C
-C See Emanuel, K. and M. Zivkovic-Rothman, 2000: Development and evaluation of a
-C       convective scheme for use in climate models.
-C
-C FILES: None
-C
-C INCLUDE FILES: None
-C
-C MAKEFILE: /a/ops/met/nogaps/src/sub/fcst/fcst159lib.mak
-C
-C..............................END PROLOGUE.............................
-c
-c
-      implicit none
-c
-#include "dimensions.h"
-#include "dimphy.h"
-c
-      integer kmax2,imax2,kmin2,imin2
-      real ftmax2,ftmin2
-      integer kmax,imax,kmin,imin
-      real ftmax,ftmin
-c
-      integer ncum
-      integer idcum(len)
-      integer len
-      integer nd
-      integer ndp1
-      integer nl
-      integer minorig
-      integer nk1(len)
-      integer icb1(len)
-      real t1(len,nd)
-      real q1(len,nd)
-      real qs1(len,nd)
-      real u1(len,nd)
-      real v1(len,nd)
-      real gz1(len,nd)
-      real tv1(len,nd)
-      real tp1(len,nd)
-      real tvp1(len,nd)
-      real clw1(len,nd)
-      real h1(len,nd)
-      real lv1(len,nd)
-      real cpn1(len,nd)
-      real p1(len,nd)
-      real ph1(len,ndp1)
-      real ft1(len,nd)
-      real fq1(len,nd)
-      real fu1(len,nd)
-      real fv1(len,nd)
-      real tnk1(len)
-      real qnk1(len)
-      real gznk1(len)
-      real precip1(len)
-      real cbmf1(len)
-      real plcl1(len)
-      integer iflag1(len)
-      real delt
-      real cpd
-      real cpv
-      real cl
-      real rv
-      real rd
-      real lv0
-      real g
-      real sigs    ! SIGS IS THE FRACTION OF PRECIPITATION FALLING OUTSIDE
-      real sigd    ! SIGD IS THE FRACTIONAL AREA COVERED BY UNSATURATED DNDRAFT
-      real elcrit  ! ELCRIT IS THE AUTOCONVERSION THERSHOLD WATER CONTENT (gm/gm)
-      real tlcrit  ! TLCRIT IS CRITICAL TEMPERATURE BELOW WHICH THE AUTO-
-c                     CONVERSION THRESHOLD IS ASSUMED TO BE ZERO
-      real omtsnow ! OMTSNOW IS THE ASSUMED FALL SPEED (P/s) OF SNOW
-      real dtmax   ! DTMAX IS THE MAXIMUM NEGATIVE TEMPERATURE PERTURBATION
-c                    A LIFTED PARCEL IS ALLOWED TO HAVE BELOW ITS LFC.
-      real damp
-      real alpha
-      real entp    ! ENTP IS THE COEFFICIENT OF MIXING IN THE ENTRAINMENT FORMULATION
-      real coeffs  ! COEFFS IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION OF SNOW
-      real coeffr  ! COEFFR IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION OF RAIN
-      real omtrain ! OMTRAIN IS THE ASSUMED FALL SPEED (P/s) OF RAIN
-      real cu      ! CU IS THE COEFFICIENT GOVERNING CONVECTIVE MOMENTUM TRANSPORT
-c
-      real Ma(len,nd)
-c
-C
-C   *** ELCRIT IS THE AUTOCONVERSION THERSHOLD WATER CONTENT (gm/gm) ***
-C   ***  TLCRIT IS CRITICAL TEMPERATURE BELOW WHICH THE AUTO-        ***
-C   ***       CONVERSION THRESHOLD IS ASSUMED TO BE ZERO             ***
-C   ***     (THE AUTOCONVERSION THRESHOLD VARIES LINEARLY            ***
-C   ***               BETWEEN 0 C AND TLCRIT)                        ***
-C   ***   ENTP IS THE COEFFICIENT OF MIXING IN THE ENTRAINMENT       ***
-C   ***                       FORMULATION                            ***
-C   ***  SIGD IS THE FRACTIONAL AREA COVERED BY UNSATURATED DNDRAFT  ***
-C   ***  SIGS IS THE FRACTION OF PRECIPITATION FALLING OUTSIDE       ***
-C   ***                        OF CLOUD                              ***
-C   ***        OMTRAIN IS THE ASSUMED FALL SPEED (P/s) OF RAIN       ***
-C   ***     OMTSNOW IS THE ASSUMED FALL SPEED (P/s) OF SNOW          ***
-C   ***  COEFFR IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION   ***
-C   ***                          OF RAIN                             ***
-C   ***  COEFFS IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION   ***
-C   ***                          OF SNOW                             ***
-C   ***     CU IS THE COEFFICIENT GOVERNING CONVECTIVE MOMENTUM      ***
-C   ***                         TRANSPORT                            ***
-C   ***    DTMAX IS THE MAXIMUM NEGATIVE TEMPERATURE PERTURBATION    ***
-C   ***        A LIFTED PARCEL IS ALLOWED TO HAVE BELOW ITS LFC      ***
-C   ***    ALPHA AND DAMP ARE PARAMETERS THAT CONTROL THE RATE OF    ***
-C   ***                 APPROACH TO QUASI-EQUILIBRIUM                ***
-C   ***   (THEIR STANDARD VALUES ARE  0.20 AND 0.1, RESPECTIVELY)    ***
-C   ***                   (DAMP MUST BE LESS THAN 1)                 ***
-c
-c Local arrays.
-c
-      real work(ncum)
-      real t(ncum,klev)
-      real q(ncum,klev)
-      real qs(ncum,klev)
-      real u(ncum,klev)
-      real v(ncum,klev)
-      real gz(ncum,klev)
-      real h(ncum,klev)
-      real lv(ncum,klev)
-      real cpn(ncum,klev)
-      real p(ncum,klev)
-      real ph(ncum,klev)
-      real ft(ncum,klev)
-      real fq(ncum,klev)
-      real fu(ncum,klev)
-      real fv(ncum,klev)
-      real precip(ncum)
-      real cbmf(ncum)
-      real plcl(ncum)
-      real tnk(ncum)
-      real qnk(ncum)
-      real gznk(ncum)
-      real tv(ncum,klev)
-      real tp(ncum,klev)
-      real tvp(ncum,klev)
-      real clw(ncum,klev)
-c     real det(ncum,klev)
-      real dph(ncum,klev)
-c     real wd(ncum)
-c     real tprime(ncum)
-c     real qprime(ncum)
-      real ah0(ncum)
-      real ep(ncum,klev)
-      real sigp(ncum,klev)
-      integer nent(ncum,klev)
-      real water(ncum,klev)
-      real evap(ncum,klev)
-      real mp(ncum,klev)
-      real m(ncum,klev)
-      real qti
-      real wt(ncum,klev)
-      real hp(ncum,klev)
-      real lvcp(ncum,klev)
-      real elij(ncum,klev,klev)
-      real ment(ncum,klev,klev)
-      real sij(ncum,klev,klev)
-      real qent(ncum,klev,klev)
-      real uent(ncum,klev,klev)
-      real vent(ncum,klev,klev)
-      real qp(ncum,klev)
-      real up(ncum,klev)
-      real vp(ncum,klev)
-      real cape(ncum)
-      real capem(ncum)
-      real frac(ncum)
-      real dtpbl(ncum)
-      real tvpplcl(ncum)
-      real tvaplcl(ncum)
-      real dtmin(ncum)
-      real w3d(ncum,klev)
-      real am(ncum)
-      real ents(ncum)
-      real uav(ncum)
-      real vav(ncum)
-c
-      integer iflag(ncum)
-      integer nk(ncum)
-      integer icb(ncum)
-      integer inb(ncum)
-      integer inb1(ncum)
-      integer jtt(ncum)
-c
-      integer nn,i,k,n,icbmax,nlp,j
-      integer ij
-      integer nn2,nn3
-      real clmcpv
-      real clmcpd
-      real cpdmcp
-      real cpvmcpd
-      real eps
-      real epsi
-      real epsim1
-      real tg,qg,s,alv,tc,ahg,denom,es,rg,ginv,rowl
-      real delti
-      real tca,elacrit
-      real by,defrac
-c     real byp
-      real byp(ncum)
-      logical lcape(ncum)
-      real dbo
-      real bf2,anum,dei,altem,cwat,stemp
-      real alt,qp1,smid,sjmax,sjmin
-      real delp,delm
-      real awat,coeff,afac,revap,dhdp,fac,qstm,rat
-      real qsm,sigt,b6,c6
-      real dpinv,cpinv
-      real fqold,ftold,fuold,fvold
-      real wdtrain(ncum),xxx
-      real bsum(ncum,klev)
-      real asij(ncum)
-      real smin(ncum)
-      real scrit(ncum)
-c     real amp1,ad
-      real amp1(ncum),ad(ncum)
-      logical lwork(ncum)
-      integer num1,num2
-c
-c     print*,'cpd en entree de convect2 ',cpd
-      nlp=nl+1
-c
-      rowl=1000.0
-      ginv=1.0/g
-      delti=1.0/delt
-c
-c Define some thermodynamic variables.
-c
-      clmcpv=cl-cpv
-      clmcpd=cl-cpd
-      cpdmcp=cpd-cpv
-      cpvmcpd=cpv-cpd
-      eps=rd/rv
-      epsi=1.0/eps
-      epsim1=epsi-1.0
-c
-c Compress the fields.
-c
-      do 110 k=1,nl+1
-       nn=0
-	do 100 i=1,len
-	  if(iflag1(i).eq.0)then
-	    nn=nn+1
-	    t(nn,k)=t1(i,k)
-	    q(nn,k)=q1(i,k)
-	    qs(nn,k)=qs1(i,k)
-	    u(nn,k)=u1(i,k)
-	    v(nn,k)=v1(i,k)
-	    gz(nn,k)=gz1(i,k)
-	    h(nn,k)=h1(i,k)
-	    lv(nn,k)=lv1(i,k)
-	    cpn(nn,k)=cpn1(i,k)
-	    p(nn,k)=p1(i,k)
-	    ph(nn,k)=ph1(i,k)
-	    tv(nn,k)=tv1(i,k)
-	    tp(nn,k)=tp1(i,k)
-	    tvp(nn,k)=tvp1(i,k)
-	    clw(nn,k)=clw1(i,k)
-	  endif
- 100    continue
-c       print*,'100 ncum,nn',ncum,nn
- 110  continue
-      nn=0
-      do 150 i=1,len
-	if(iflag1(i).eq.0)then
-	  nn=nn+1
-	  cbmf(nn)=cbmf1(i)
-	  plcl(nn)=plcl1(i)
-	  tnk(nn)=tnk1(i)
-	  qnk(nn)=qnk1(i)
-	  gznk(nn)=gznk1(i)
-	  nk(nn)=nk1(i)
-	  icb(nn)=icb1(i)
-	  iflag(nn)=iflag1(i)
-	endif
- 150  continue
-c       print*,'150 ncum,nn',ncum,nn
-c
-c Initialize the tendencies, det, wd, tprime, qprime.
-c
-      do 170 k=1,nl
-	do 160 i=1,ncum
-c         det(i,k)=0.0
-	  ft(i,k)=0.0
-	  fu(i,k)=0.0
-	  fv(i,k)=0.0
-	  fq(i,k)=0.0
-	  dph(i,k)=ph(i,k)-ph(i,k+1)
-	  ep(i,k)=0.0
-	  sigp(i,k)=sigs
- 160    continue
- 170  continue
-      do 180 i=1,ncum
-c      wd(i)=0.0
-c      tprime(i)=0.0
-c      qprime(i)=0.0
-       precip(i)=0.0
-       ft(i,nl+1)=0.0
-       fu(i,nl+1)=0.0
-       fv(i,nl+1)=0.0
-       fq(i,nl+1)=0.0
- 180  continue
-c
-c Compute icbmax.
-c
-      icbmax=2
-      do 230 i=1,ncum
-	icbmax=max(icbmax,icb(i))
- 230  continue
-c
-c
-!=====================================================================
-! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
-!=====================================================================
-c
-c ---       The procedure is to solve the equation.
-c              cp*tp+L*qp+phi=cp*tnk+L*qnk+gznk.
-c
-c   ***  Calculate certain parcel quantities, including static energy   ***
-c
-c
-      do 240 i=1,ncum
-	ah0(i)=(cpd*(1.-qnk(i))+cl*qnk(i))*tnk(i)
-     &         +qnk(i)*(lv0-clmcpv*(tnk(i)-273.15))+gznk(i)
- 240  continue
-c
-c
-c    ***  Find lifted parcel quantities above cloud base    ***
-c
-c
-	do 300 k=minorig+1,nl
-	  do 290 i=1,ncum
-	    if(k.ge.(icb(i)+1))then
-	      tg=t(i,k)
-	      qg=qs(i,k)
-	      alv=lv0-clmcpv*(t(i,k)-273.15)
-c
-c First iteration.
-c
-	       s=cpd+alv*alv*qg/(rv*t(i,k)*t(i,k))
-	       s=1./s
-	       ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
-	       tg=tg+s*(ah0(i)-ahg)
-	       tg=max(tg,35.0)
-	       tc=tg-273.15
-	       denom=243.5+tc
-	       if(tc.ge.0.0)then
-		es=6.112*exp(17.67*tc/denom)
-	       else
-		es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-	       endif
-		qg=eps*es/(p(i,k)-es*(1.-eps))
-c
-c Second iteration.
-c
-	       s=cpd+alv*alv*qg/(rv*t(i,k)*t(i,k))
-	       s=1./s
-	       ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
-	       tg=tg+s*(ah0(i)-ahg)
-	       tg=max(tg,35.0)
-	       tc=tg-273.15
-	       denom=243.5+tc
-	       if(tc.ge.0.0)then
-		es=6.112*exp(17.67*tc/denom)
-	       else
-		es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-	       endif
-		qg=eps*es/(p(i,k)-es*(1.-eps))
-c
-	       alv=lv0-clmcpv*(t(i,k)-273.15)
-c      print*,'cpd dans convect2 ',cpd
-c      print*,'tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd'
-c      print*,tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd
-	       tp(i,k)=(ah0(i)-(cl-cpd)*qnk(i)*t(i,k)-gz(i,k)-alv*qg)
-     &                  /cpd
-c              if (.not.cpd.gt.1000.) then
-c                  print*,'CPD=',cpd
-c                  stop
-c              endif
-               clw(i,k)=qnk(i)-qg
-               clw(i,k)=max(0.0,clw(i,k))
-               rg=qg/(1.-qnk(i))
-               tvp(i,k)=tp(i,k)*(1.+rg*epsi)
-            endif
-  290     continue
-  300   continue
-c
-!=====================================================================
-! --- SET THE PRECIPITATION EFFICIENCIES AND THE FRACTION OF
-! --- PRECIPITATION FALLING OUTSIDE OF CLOUD
-! --- THESE MAY BE FUNCTIONS OF TP(I), P(I) AND CLW(I)
-!=====================================================================
-c
-      do 320 k=minorig+1,nl
-        do 310 i=1,ncum
-          if(k.ge.(nk(i)+1))then
-            tca=tp(i,k)-273.15
-            if(tca.ge.0.0)then
-              elacrit=elcrit
-            else
-              elacrit=elcrit*(1.0-tca/tlcrit)
-            endif
-            elacrit=max(elacrit,0.0)
-            ep(i,k)=1.0-elacrit/max(clw(i,k),1.0e-8)
-            ep(i,k)=max(ep(i,k),0.0 )
-            ep(i,k)=min(ep(i,k),1.0 )
-            sigp(i,k)=sigs
-          endif
- 310    continue
- 320  continue
-c
-!=====================================================================
-! --- CALCULATE VIRTUAL TEMPERATURE AND LIFTED PARCEL
-! --- VIRTUAL TEMPERATURE
-!=====================================================================
-c
-      do 340 k=minorig+1,nl
-        do 330 i=1,ncum
-        if(k.ge.(icb(i)+1))then
-          tvp(i,k)=tvp(i,k)*(1.0-qnk(i)+ep(i,k)*clw(i,k))
-c         print*,'i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)'
-c         print*, i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)
-        endif
- 330    continue
- 340  continue
-      do 350 i=1,ncum
-       tvp(i,nlp)=tvp(i,nl)-(gz(i,nlp)-gz(i,nl))/cpd
- 350  continue
-c
-c
-c=====================================================================
-c --- NOW INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS
-c=====================================================================
-c
-        do 360 i=1,ncum*nlp
-          nent(i,1)=0
-          water(i,1)=0.0
-          evap(i,1)=0.0
-          mp(i,1)=0.0
-          m(i,1)=0.0
-          wt(i,1)=omtsnow
-          hp(i,1)=h(i,1)
-c         if(.not.cpn(i,1).gt.900.) then
-c         print*,'i,lv(i,1),cpn(i,1)'
-c         print*, i,lv(i,1),cpn(i,1)
-c         k=(i-1)/ncum+1
-c         print*,'i,k',mod(i,ncum),k,'  cpn',cpn(mod(i,ncum),k)
-c         stop
-c         endif
-          lvcp(i,1)=lv(i,1)/cpn(i,1)
- 360    continue
-c
-      do 380 i=1,ncum*nlp*nlp
- 380  continue
-c
-      do 400 k=1,nlp
-       do 390 j=1,nlp
-          do 385 i=1,ncum
-            qent(i,k,j)=q(i,j)
-            uent(i,k,j)=u(i,j)
-            vent(i,k,j)=v(i,j)
-            elij(i,k,j)=0.0
-            ment(i,k,j)=0.0
-            sij(i,k,j)=0.0
- 385      continue
- 390    continue
- 400  continue
-c
-      do 420 i=1,ncum
-        qp(i,1)=q(i,1)
-        up(i,1)=u(i,1)
-        vp(i,1)=v(i,1)
- 420  continue
-      do 440 k=2,nlp
-        do 430 i=1,ncum
-          qp(i,k)=q(i,k-1)
-          up(i,k)=u(i,k-1)
-          vp(i,k)=v(i,k-1)
- 430    continue
- 440  continue
-c
-c=====================================================================
-c  --- FIND THE FIRST MODEL LEVEL (INB1) ABOVE THE PARCEL'S
-c  --- HIGHEST LEVEL OF NEUTRAL BUOYANCY
-c  --- AND THE HIGHEST LEVEL OF POSITIVE CAPE (INB)
-c=====================================================================
-c
-      do 510 i=1,ncum
-        cape(i)=0.0
-        capem(i)=0.0
-        inb(i)=icb(i)+1
-        inb1(i)=inb(i)
- 510  continue
-c
-c Originial Code
-c
-c     do 530 k=minorig+1,nl-1
-c       do 520 i=1,ncum
-c         if(k.ge.(icb(i)+1))then
-c           by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
-c           byp=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
-c           cape(i)=cape(i)+by
-c           if(by.ge.0.0)inb1(i)=k+1
-c           if(cape(i).gt.0.0)then
-c             inb(i)=k+1
-c             capem(i)=cape(i)
-c           endif
-c         endif
-c520    continue
-c530  continue
-c     do 540 i=1,ncum
-c         byp=(tvp(i,nl)-tv(i,nl))*dph(i,nl)/p(i,nl)
-c         cape(i)=capem(i)+byp
-c         defrac=capem(i)-cape(i)
-c         defrac=max(defrac,0.001)
-c         frac(i)=-cape(i)/defrac
-c         frac(i)=min(frac(i),1.0)
-c         frac(i)=max(frac(i),0.0)
-c540   continue
-c
-c K Emanuel fix
-c
-c     call zilch(byp,ncum)
-c     do 530 k=minorig+1,nl-1
-c       do 520 i=1,ncum
-c         if(k.ge.(icb(i)+1))then
-c           by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
-c           cape(i)=cape(i)+by
-c           if(by.ge.0.0)inb1(i)=k+1
-c           if(cape(i).gt.0.0)then
-c             inb(i)=k+1
-c             capem(i)=cape(i)
-c             byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
-c           endif
-c         endif
-c520    continue
-c530  continue
-c     do 540 i=1,ncum
-c         inb(i)=max(inb(i),inb1(i))
-c         cape(i)=capem(i)+byp(i)
-c         defrac=capem(i)-cape(i)
-c         defrac=max(defrac,0.001)
-c         frac(i)=-cape(i)/defrac
-c         frac(i)=min(frac(i),1.0)
-c         frac(i)=max(frac(i),0.0)
-c540   continue
-c
-c J Teixeira fix
-c
-      call zilch(byp,ncum)
-      do 515 i=1,ncum
-        lcape(i)=.true.
- 515  continue
-      do 530 k=minorig+1,nl-1
-        do 520 i=1,ncum
-          if(cape(i).lt.0.0)lcape(i)=.false.
-          if((k.ge.(icb(i)+1)).and.lcape(i))then
-            by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
-            byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
-            cape(i)=cape(i)+by
-            if(by.ge.0.0)inb1(i)=k+1
-            if(cape(i).gt.0.0)then
-              inb(i)=k+1
-              capem(i)=cape(i)
-            endif
-          endif
- 520    continue
- 530  continue
-      do 540 i=1,ncum
-          cape(i)=capem(i)+byp(i)
-          defrac=capem(i)-cape(i)
-          defrac=max(defrac,0.001)
-          frac(i)=-cape(i)/defrac
-          frac(i)=min(frac(i),1.0)
-          frac(i)=max(frac(i),0.0)
- 540  continue
-c
-c=====================================================================
-c ---   CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL
-c=====================================================================
-c
-      do 600 k=minorig+1,nl
-        do 590 i=1,ncum
-        if((k.ge.icb(i)).and.(k.le.inb(i)))then
-          hp(i,k)=h(i,nk(i))+(lv(i,k)+(cpd-cpv)*t(i,k))*ep(i,k)*clw(i,k)
-        endif
- 590    continue
- 600  continue
-c
-c=====================================================================
-c ---  CALCULATE CLOUD BASE MASS FLUX AND RATES OF MIXING, M(I),
-c --- AT EACH MODEL LEVEL
-c=====================================================================
-c
-c tvpplcl = parcel temperature lifted adiabatically from level
-c           icb-1 to the LCL.
-c tvaplcl = virtual temperature at the LCL.
-c
-      do 610 i=1,ncum
-        dtpbl(i)=0.0
-        tvpplcl(i)=tvp(i,icb(i)-1)
-     &  -rd*tvp(i,icb(i)-1)*(p(i,icb(i)-1)-plcl(i))
-     &  /(cpn(i,icb(i)-1)*p(i,icb(i)-1))
-        tvaplcl(i)=tv(i,icb(i))
-     &  +(tvp(i,icb(i))-tvp(i,icb(i)+1))*(plcl(i)-p(i,icb(i)))
-     &  /(p(i,icb(i))-p(i,icb(i)+1))
- 610  continue
-c
-c-------------------------------------------------------------------
-c --- Interpolate difference between lifted parcel and
-c --- environmental temperatures to lifted condensation level
-c-------------------------------------------------------------------
-c
-c dtpbl = average of tvp-tv in the PBL (k=nk to icb-1).
-c
-      do 630 k=minorig,icbmax
-        do 620 i=1,ncum
-        if((k.ge.nk(i)).and.(k.le.(icb(i)-1)))then
-          dtpbl(i)=dtpbl(i)+(tvp(i,k)-tv(i,k))*dph(i,k)
-        endif
- 620    continue
- 630  continue
-      do 640 i=1,ncum
-        dtpbl(i)=dtpbl(i)/(ph(i,nk(i))-ph(i,icb(i)))
-        dtmin(i)=tvpplcl(i)-tvaplcl(i)+dtmax+dtpbl(i)
- 640  continue
-c
-c-------------------------------------------------------------------
-c --- Adjust cloud base mass flux
-c-------------------------------------------------------------------
-c
-      do 650 i=1,ncum
-       work(i)=cbmf(i)
-       cbmf(i)=max(0.0,(1.0-damp)*cbmf(i)+0.1*alpha*dtmin(i))
-       if((work(i).eq.0.0).and.(cbmf(i).eq.0.0))then
-         iflag(i)=3
-       endif
- 650  continue
-c
-c-------------------------------------------------------------------
-c --- Calculate rates of mixing,  m(i)
-c-------------------------------------------------------------------
-c
-      call zilch(work,ncum)
-c
-      do 670 j=minorig+1,nl
-        do 660 i=1,ncum
-          if((j.ge.(icb(i)+1)).and.(j.le.inb(i)))then
-             k=min(j,inb1(i))
-             dbo=abs(tv(i,k+1)-tvp(i,k+1)-tv(i,k-1)+tvp(i,k-1))
-     &       +entp*0.04*(ph(i,k)-ph(i,k+1))
-             work(i)=work(i)+dbo
-             m(i,j)=cbmf(i)*dbo
-          endif
- 660    continue
- 670  continue
-      do 690 k=minorig+1,nl
-        do 680 i=1,ncum
-          if((k.ge.(icb(i)+1)).and.(k.le.inb(i)))then
-            m(i,k)=m(i,k)/work(i)
-          endif
- 680    continue
- 690  continue
-c
-c
-c=====================================================================
-c --- CALCULATE ENTRAINED AIR MASS FLUX (ment), TOTAL WATER MIXING
-c --- RATIO (QENT), TOTAL CONDENSED WATER (elij), AND MIXING
-c --- FRACTION (sij)
-c=====================================================================
-c
-c
-       do 750 i=minorig+1,nl
-         do 710 j=minorig+1,nl
-           do 700 ij=1,ncum
-             if((i.ge.(icb(ij)+1)).and.(j.ge.icb(ij))
-     &         .and.(i.le.inb(ij)).and.(j.le.inb(ij)))then
-               qti=qnk(ij)-ep(ij,i)*clw(ij,i)
-               bf2=1.+lv(ij,j)*lv(ij,j)*qs(ij,j)
-     &         /(rv*t(ij,j)*t(ij,j)*cpd)
-               anum=h(ij,j)-hp(ij,i)+(cpv-cpd)*t(ij,j)*(qti-q(ij,j))
-               denom=h(ij,i)-hp(ij,i)+(cpd-cpv)*(q(ij,i)-qti)*t(ij,j)
-               dei=denom
-               if(abs(dei).lt.0.01)dei=0.01
-               sij(ij,i,j)=anum/dei
-               sij(ij,i,i)=1.0
-               altem=sij(ij,i,j)*q(ij,i)+(1.-sij(ij,i,j))*qti-qs(ij,j)
-               altem=altem/bf2
-               cwat=clw(ij,j)*(1.-ep(ij,j))
-               stemp=sij(ij,i,j)
-               if((stemp.lt.0.0.or.stemp.gt.1.0.or.
-     1           altem.gt.cwat).and.j.gt.i)then
-                 anum=anum-lv(ij,j)*(qti-qs(ij,j)-cwat*bf2)
-                 denom=denom+lv(ij,j)*(q(ij,i)-qti)
-                 if(abs(denom).lt.0.01)denom=0.01
-                 sij(ij,i,j)=anum/denom
-                 altem=sij(ij,i,j)*q(ij,i)+(1.-sij(ij,i,j))*qti-qs(ij,j)
-                 altem=altem-(bf2-1.)*cwat
-               endif
-               if(sij(ij,i,j).gt.0.0.and.sij(ij,i,j).lt.0.9)then
-                 qent(ij,i,j)=sij(ij,i,j)*q(ij,i)
-     &                        +(1.-sij(ij,i,j))*qti
-                 uent(ij,i,j)=sij(ij,i,j)*u(ij,i)
-     &                        +(1.-sij(ij,i,j))*u(ij,nk(ij))
-                 vent(ij,i,j)=sij(ij,i,j)*v(ij,i)
-     &                        +(1.-sij(ij,i,j))*v(ij,nk(ij))
-                 elij(ij,i,j)=altem
-                 elij(ij,i,j)=max(0.0,elij(ij,i,j))
-                 ment(ij,i,j)=m(ij,i)/(1.-sij(ij,i,j))
-                 nent(ij,i)=nent(ij,i)+1
-               endif
-             sij(ij,i,j)=max(0.0,sij(ij,i,j))
-             sij(ij,i,j)=min(1.0,sij(ij,i,j))
-             endif
-  700      continue
-  710    continue
-c
-c   ***   If no air can entrain at level i assume that updraft detrains  ***
-c   ***   at that level and calculate detrained air flux and properties  ***
-c
-           do 740 ij=1,ncum
-             if((i.ge.(icb(ij)+1)).and.(i.le.inb(ij))
-     &       .and.(nent(ij,i).eq.0))then
-               ment(ij,i,i)=m(ij,i)
-               qent(ij,i,i)=q(ij,nk(ij))-ep(ij,i)*clw(ij,i)
-               uent(ij,i,i)=u(ij,nk(ij))
-               vent(ij,i,i)=v(ij,nk(ij))
-               elij(ij,i,i)=clw(ij,i)
-               sij(ij,i,i)=1.0
-             endif
- 740       continue
- 750   continue
-c
-      do 770 i=1,ncum
-        sij(i,inb(i),inb(i))=1.0
- 770  continue
-c
-c=====================================================================
-c   ---  NORMALIZE ENTRAINED AIR MASS FLUXES
-c   ---  TO REPRESENT EQUAL PROBABILITIES OF MIXING
-c=====================================================================
-c
-c
-       call zilch(bsum,ncum*nlp)
-       do 780 ij=1,ncum
-         lwork(ij)=.false.
- 780   continue
-       do 789 i=minorig+1,nl
-c
-         num1=0
-         do 779 ij=1,ncum
-           if((i.ge.icb(ij)+1).and.(i.le.inb(ij)))num1=num1+1
- 779     continue
-         if(num1.le.0)go to 789
-c
-           do 781 ij=1,ncum
-             if((i.ge.icb(ij)+1).and.(i.le.inb(ij)))then
-                lwork(ij)=(nent(ij,i).ne.0)
-                qp1=q(ij,nk(ij))-ep(ij,i)*clw(ij,i)
-                anum=h(ij,i)-hp(ij,i)-lv(ij,i)*(qp1-qs(ij,i))
-                denom=h(ij,i)-hp(ij,i)+lv(ij,i)*(q(ij,i)-qp1)
-                if(abs(denom).lt.0.01)denom=0.01
-                scrit(ij)=anum/denom
-                alt=qp1-qs(ij,i)+scrit(ij)*(q(ij,i)-qp1)
-                if(scrit(ij).lt.0.0.or.alt.lt.0.0)scrit(ij)=1.0
-                asij(ij)=0.0
-                smin(ij)=1.0
-             endif
- 781       continue
-         do 783 j=minorig,nl
-c
-         num2=0
-         do 778 ij=1,ncum
-             if((i.ge.icb(ij)+1).and.(i.le.inb(ij))
-     &       .and.(j.ge.icb(ij)).and.(j.le.inb(ij))
-     &       .and.lwork(ij))num2=num2+1
- 778     continue
-         if(num2.le.0)go to 783
-c
-           do 782 ij=1,ncum
-             if((i.ge.icb(ij)+1).and.(i.le.inb(ij))
-     &       .and.(j.ge.icb(ij)).and.(j.le.inb(ij)).and.lwork(ij))then
-                  if(sij(ij,i,j).gt.0.0.and.sij(ij,i,j).lt.0.9)then
-                    if(j.gt.i)then
-                      smid=min(sij(ij,i,j),scrit(ij))
-                      sjmax=smid
-                      sjmin=smid
-                        if(smid.lt.smin(ij)
-     &                  .and.sij(ij,i,j+1).lt.smid)then
-                          smin(ij)=smid
-                          sjmax=min(sij(ij,i,j+1),sij(ij,i,j),scrit(ij))
-                          sjmin=max(sij(ij,i,j-1),sij(ij,i,j))
-                          sjmin=min(sjmin,scrit(ij))
-                        endif
-                    else
-                      sjmax=max(sij(ij,i,j+1),scrit(ij))
-                      smid=max(sij(ij,i,j),scrit(ij))
-                      sjmin=0.0
-                      if(j.gt.1)sjmin=sij(ij,i,j-1)
-                      sjmin=max(sjmin,scrit(ij))
-                    endif
-                    delp=abs(sjmax-smid)
-                    delm=abs(sjmin-smid)
-                    asij(ij)=asij(ij)+(delp+delm)
-     &                           *(ph(ij,j)-ph(ij,j+1))
-                    ment(ij,i,j)=ment(ij,i,j)*(delp+delm)
-     &                           *(ph(ij,j)-ph(ij,j+1))
-                  endif
-              endif
-  782    continue
-  783    continue
-            do 784 ij=1,ncum
-            if((i.ge.icb(ij)+1).and.(i.le.inb(ij)).and.lwork(ij))then
-               asij(ij)=max(1.0e-21,asij(ij))
-               asij(ij)=1.0/asij(ij)
-               bsum(ij,i)=0.0
-            endif
- 784        continue
-            do 786 j=minorig,nl+1
-              do 785 ij=1,ncum
-                if((i.ge.icb(ij)+1).and.(i.le.inb(ij))
-     &          .and.(j.ge.icb(ij)).and.(j.le.inb(ij))
-     &          .and.lwork(ij))then
-                   ment(ij,i,j)=ment(ij,i,j)*asij(ij)
-                   bsum(ij,i)=bsum(ij,i)+ment(ij,i,j)
-                endif
- 785     continue
- 786     continue
-             do 787 ij=1,ncum
-               if((i.ge.icb(ij)+1).and.(i.le.inb(ij))
-     &         .and.(bsum(ij,i).lt.1.0e-18).and.lwork(ij))then
-                 nent(ij,i)=0
-                 ment(ij,i,i)=m(ij,i)
-                 qent(ij,i,i)=q(ij,nk(ij))-ep(ij,i)*clw(ij,i)
-                 uent(ij,i,i)=u(ij,nk(ij))
-                 vent(ij,i,i)=v(ij,nk(ij))
-                 elij(ij,i,i)=clw(ij,i)
-                 sij(ij,i,i)=1.0
-               endif
-  787        continue
-  789  continue
-c
-c=====================================================================
-c --- PRECIPITATING DOWNDRAFT CALCULATION
-c=====================================================================
-c
-c   ***  Check whether ep(inb)=0, if so, skip precipitating    ***
-c   ***             downdraft calculation                      ***
-c
-c
-c   ***  Integrate liquid water equation to find condensed water   ***
-c   ***                and condensed water flux                    ***
-c
-c
-      do 890 i=1,ncum
-        jtt(i)=2
-        if(ep(i,inb(i)).le.0.0001)iflag(i)=2
-        if(iflag(i).eq.0)then
-          lwork(i)=.true.
-        else
-          lwork(i)=.false.
-        endif
- 890  continue
-c
-c    ***                    Begin downdraft loop                    ***
-c
-c
-        call zilch(wdtrain,ncum)
-        do 899 i=nl+1,1,-1
-c
-          num1=0
-          do 879 ij=1,ncum
-            if((i.le.inb(ij)).and.lwork(ij))num1=num1+1
- 879      continue
-          if(num1.le.0)go to 899
-c
-c
-c    ***        Calculate detrained precipitation             ***
-c
-          do 891 ij=1,ncum
-            if((i.le.inb(ij)).and.(lwork(ij)))then
-            wdtrain(ij)=g*ep(ij,i)*m(ij,i)*clw(ij,i)
-            endif
- 891      continue
-c
-          if(i.gt.1)then
-            do 893 j=1,i-1
-              do 892 ij=1,ncum
-                if((i.le.inb(ij)).and.(lwork(ij)))then
-                  awat=elij(ij,j,i)-(1.-ep(ij,i))*clw(ij,i)
-                  awat=max(0.0,awat)
-                  wdtrain(ij)=wdtrain(ij)+g*awat*ment(ij,j,i)
-                endif
- 892          continue
- 893      continue
-          endif
-c
-c    ***    Find rain water and evaporation using provisional   ***
-c    ***              estimates of qp(i)and qp(i-1)             ***
-c
-c
-c  ***  Value of terminal velocity and coeffecient of evaporation for snow   ***
-c
-          do 894 ij=1,ncum
-            if((i.le.inb(ij)).and.(lwork(ij)))then
-            coeff=coeffs
-            wt(ij,i)=omtsnow
-c
-c  ***  Value of terminal velocity and coeffecient of evaporation for rain   ***
-c
-            if(t(ij,i).gt.273.0)then
-              coeff=coeffr
-              wt(ij,i)=omtrain
-            endif
-            qsm=0.5*(q(ij,i)+qp(ij,i+1))
-            afac=coeff*ph(ij,i)*(qs(ij,i)-qsm)
-     &       /(1.0e4+2.0e3*ph(ij,i)*qs(ij,i))
-            afac=max(afac,0.0)
-            sigt=sigp(ij,i)
-            sigt=max(0.0,sigt)
-            sigt=min(1.0,sigt)
-            b6=100.*(ph(ij,i)-ph(ij,i+1))*sigt*afac/wt(ij,i)
-            c6=(water(ij,i+1)*wt(ij,i+1)+wdtrain(ij)/sigd)/wt(ij,i)
-            revap=0.5*(-b6+sqrt(b6*b6+4.*c6))
-            evap(ij,i)=sigt*afac*revap
-            water(ij,i)=revap*revap
-c
-c    ***  Calculate precipitating downdraft mass flux under     ***
-c    ***              hydrostatic approximation                 ***
-c
-            if(i.gt.1)then
-              dhdp=(h(ij,i)-h(ij,i-1))/(p(ij,i-1)-p(ij,i))
-              dhdp=max(dhdp,10.0)
-              mp(ij,i)=100.*ginv*lv(ij,i)*sigd*evap(ij,i)/dhdp
-              mp(ij,i)=max(mp(ij,i),0.0)
-c
-c   ***   Add small amount of inertia to downdraft              ***
-c
-              fac=20.0/(ph(ij,i-1)-ph(ij,i))
-              mp(ij,i)=(fac*mp(ij,i+1)+mp(ij,i))/(1.+fac)
-c
-c    ***      Force mp to decrease linearly to zero                 ***
-c    ***      between about 950 mb and the surface                  ***
-c
-              if(p(ij,i).gt.(0.949*p(ij,1)))then
-                 jtt(ij)=max(jtt(ij),i)
-                 mp(ij,i)=mp(ij,jtt(ij))*(p(ij,1)-p(ij,i))
-     &           /(p(ij,1)-p(ij,jtt(ij)))
-              endif
-            endif
-c
-c    ***       Find mixing ratio of precipitating downdraft     ***
-c
-            if(i.ne.inb(ij))then
-              if(i.eq.1)then
-                qstm=qs(ij,1)
-              else
-                qstm=qs(ij,i-1)
-              endif
-              if(mp(ij,i).gt.mp(ij,i+1))then
-                 rat=mp(ij,i+1)/mp(ij,i)
-                 qp(ij,i)=qp(ij,i+1)*rat+q(ij,i)*(1.0-rat)+100.*ginv*
-     &             sigd*(ph(ij,i)-ph(ij,i+1))*(evap(ij,i)/mp(ij,i))
-                 up(ij,i)=up(ij,i+1)*rat+u(ij,i)*(1.-rat)
-                 vp(ij,i)=vp(ij,i+1)*rat+v(ij,i)*(1.-rat)
-               else
-                 if(mp(ij,i+1).gt.0.0)then
-                   qp(ij,i)=(gz(ij,i+1)-gz(ij,i)
-     &               +qp(ij,i+1)*(lv(ij,i+1)+t(ij,i+1)
-     &               *(cl-cpd))+cpd*(t(ij,i+1)-t(ij,i)))
-     &               /(lv(ij,i)+t(ij,i)*(cl-cpd))
-                   up(ij,i)=up(ij,i+1)
-                   vp(ij,i)=vp(ij,i+1)
-                 endif
-              endif
-              qp(ij,i)=min(qp(ij,i),qstm)
-              qp(ij,i)=max(qp(ij,i),0.0)
-            endif
-            endif
- 894      continue
- 899    continue
-c
-c   ***  Calculate surface precipitation in mm/day     ***
-c
-        do 1190 i=1,ncum
-          if(iflag(i).le.1)then
-cc            precip(i)=precip(i)+wt(i,1)*sigd*water(i,1)*3600.*24000.
-cc     &                /(rowl*g)
-cc            precip(i)=precip(i)*delt/86400.
-            precip(i) = wt(i,1)*sigd*water(i,1)*86400/g
-          endif
- 1190   continue
-c
-c
-c   ***  Calculate downdraft velocity scale and surface temperature and  ***
-c   ***                    water vapor fluctuations                      ***
-c
-c     wd=beta*abs(mp(icb))*0.01*rd*t(icb)/(sigd*p(icb))
-c     qprime=0.5*(qp(1)-q(1))
-c     tprime=lv0*qprime/cpd
-c
-c   ***  Calculate tendencies of lowest level potential temperature  ***
-c   ***                      and mixing ratio                        ***
-c
-        do 1200 i=1,ncum
-          work(i)=0.01/(ph(i,1)-ph(i,2))
-          am(i)=0.0
- 1200   continue
-        do 1220 k=2,nl
-          do 1210 i=1,ncum
-            if((nk(i).eq.1).and.(k.le.inb(i)).and.(nk(i).eq.1))then
-              am(i)=am(i)+m(i,k)
-            endif
- 1210     continue
- 1220   continue
-        do 1240 i=1,ncum
-          if((g*work(i)*am(i)).ge.delti)iflag(i)=1
-          ft(i,1)=ft(i,1)+g*work(i)*am(i)*(t(i,2)-t(i,1)
-     &    +(gz(i,2)-gz(i,1))/cpn(i,1))
-          ft(i,1)=ft(i,1)-lvcp(i,1)*sigd*evap(i,1)
-          ft(i,1)=ft(i,1)+sigd*wt(i,2)*(cl-cpd)*water(i,2)*(t(i,2)
-     &     -t(i,1))*work(i)/cpn(i,1)
-          fq(i,1)=fq(i,1)+g*mp(i,2)*(qp(i,2)-q(i,1))*
-     &    work(i)+sigd*evap(i,1)
-          fq(i,1)=fq(i,1)+g*am(i)*(q(i,2)-q(i,1))*work(i)
-          fu(i,1)=fu(i,1)+g*work(i)*(mp(i,2)*(up(i,2)-u(i,1))
-     &    +am(i)*(u(i,2)-u(i,1)))
-          fv(i,1)=fv(i,1)+g*work(i)*(mp(i,2)*(vp(i,2)-v(i,1))
-     &    +am(i)*(v(i,2)-v(i,1)))
- 1240   continue
-        do 1260 j=2,nl
-           do 1250 i=1,ncum
-             if(j.le.inb(i))then
-               fq(i,1)=fq(i,1)
-     &                 +g*work(i)*ment(i,j,1)*(qent(i,j,1)-q(i,1))
-               fu(i,1)=fu(i,1)
-     &                 +g*work(i)*ment(i,j,1)*(uent(i,j,1)-u(i,1))
-               fv(i,1)=fv(i,1)
-     &                 +g*work(i)*ment(i,j,1)*(vent(i,j,1)-v(i,1))
-             endif
- 1250      continue
- 1260   continue
-c
-c   ***  Calculate tendencies of potential temperature and mixing ratio  ***
-c   ***               at levels above the lowest level                   ***
-c
-c   ***  First find the net saturated updraft and downdraft mass fluxes  ***
-c   ***                      through each level                          ***
-c
-        do 1500 i=2,nl+1
-c
-          num1=0
-          do 1265 ij=1,ncum
-            if(i.le.inb(ij))num1=num1+1
- 1265     continue
-          if(num1.le.0)go to 1500
-c
-          call zilch(amp1,ncum)
-          call zilch(ad,ncum)
-c
-          do 1280 k=i+1,nl+1
-            do 1270 ij=1,ncum
-              if((i.ge.nk(ij)).and.(i.le.inb(ij))
-     &            .and.(k.le.(inb(ij)+1)))then
-                amp1(ij)=amp1(ij)+m(ij,k)
-              endif
- 1270         continue
- 1280     continue
-c
-          do 1310 k=1,i
-            do 1300 j=i+1,nl+1
-               do 1290 ij=1,ncum
-                 if((j.le.(inb(ij)+1)).and.(i.le.inb(ij)))then
-                   amp1(ij)=amp1(ij)+ment(ij,k,j)
-                 endif
- 1290          continue
- 1300       continue
- 1310     continue
-          do 1340 k=1,i-1
-            do 1330 j=i,nl+1
-              do 1320 ij=1,ncum
-                if((i.le.inb(ij)).and.(j.le.inb(ij)))then
-                   ad(ij)=ad(ij)+ment(ij,j,k)
-                endif
- 1320         continue
- 1330       continue
- 1340     continue
-c
-          do 1350 ij=1,ncum
-          if(i.le.inb(ij))then
-            dpinv=0.01/(ph(ij,i)-ph(ij,i+1))
-            cpinv=1.0/cpn(ij,i)
-c
-            ft(ij,i)=ft(ij,i)
-     &       +g*dpinv*(amp1(ij)*(t(ij,i+1)-t(ij,i)
-     &       +(gz(ij,i+1)-gz(ij,i))*cpinv)
-     &       -ad(ij)*(t(ij,i)-t(ij,i-1)+(gz(ij,i)-gz(ij,i-1))*cpinv))
-     &       -sigd*lvcp(ij,i)*evap(ij,i)
-            ft(ij,i)=ft(ij,i)+g*dpinv*ment(ij,i,i)*(hp(ij,i)-h(ij,i)+
-     &        t(ij,i)*(cpv-cpd)*(q(ij,i)-qent(ij,i,i)))*cpinv
-            ft(ij,i)=ft(ij,i)+sigd*wt(ij,i+1)*(cl-cpd)*water(ij,i+1)*
-     &        (t(ij,i+1)-t(ij,i))*dpinv*cpinv
-            fq(ij,i)=fq(ij,i)+g*dpinv*(amp1(ij)*(q(ij,i+1)-q(ij,i))-
-     &        ad(ij)*(q(ij,i)-q(ij,i-1)))
-            fu(ij,i)=fu(ij,i)+g*dpinv*(amp1(ij)*(u(ij,i+1)-u(ij,i))-
-     &        ad(ij)*(u(ij,i)-u(ij,i-1)))
-            fv(ij,i)=fv(ij,i)+g*dpinv*(amp1(ij)*(v(ij,i+1)-v(ij,i))-
-     &        ad(ij)*(v(ij,i)-v(ij,i-1)))
-         endif
- 1350    continue
-         do 1370 k=1,i-1
-           do 1360 ij=1,ncum
-             if(i.le.inb(ij))then
-               awat=elij(ij,k,i)-(1.-ep(ij,i))*clw(ij,i)
-               awat=max(awat,0.0)
-               fq(ij,i)=fq(ij,i)
-     &         +g*dpinv*ment(ij,k,i)*(qent(ij,k,i)-awat-q(ij,i))
-               fu(ij,i)=fu(ij,i)
-     &         +g*dpinv*ment(ij,k,i)*(uent(ij,k,i)-u(ij,i))
-               fv(ij,i)=fv(ij,i)
-     &         +g*dpinv*ment(ij,k,i)*(vent(ij,k,i)-v(ij,i))
-             endif
- 1360      continue
- 1370    continue
-         do 1390 k=i,nl+1
-           do 1380 ij=1,ncum
-             if((i.le.inb(ij)).and.(k.le.inb(ij)))then
-               fq(ij,i)=fq(ij,i)
-     &                  +g*dpinv*ment(ij,k,i)*(qent(ij,k,i)-q(ij,i))
-               fu(ij,i)=fu(ij,i)
-     &                  +g*dpinv*ment(ij,k,i)*(uent(ij,k,i)-u(ij,i))
-               fv(ij,i)=fv(ij,i)
-     &                  +g*dpinv*ment(ij,k,i)*(vent(ij,k,i)-v(ij,i))
-             endif
- 1380      continue
- 1390    continue
-          do 1400 ij=1,ncum
-           if(i.le.inb(ij))then
-             fq(ij,i)=fq(ij,i)
-     &                +sigd*evap(ij,i)+g*(mp(ij,i+1)*
-     &                (qp(ij,i+1)-q(ij,i))
-     &                -mp(ij,i)*(qp(ij,i)-q(ij,i-1)))*dpinv
-             fu(ij,i)=fu(ij,i)
-     &                +g*(mp(ij,i+1)*(up(ij,i+1)-u(ij,i))-mp(ij,i)*
-     &                (up(ij,i)-u(ij,i-1)))*dpinv
-             fv(ij,i)=fv(ij,i)
-     &               +g*(mp(ij,i+1)*(vp(ij,i+1)-v(ij,i))-mp(ij,i)*
-     &               (vp(ij,i)-v(ij,i-1)))*dpinv
-           endif
- 1400     continue
- 1500   continue
-c
-c   *** Adjust tendencies at top of convection layer to reflect  ***
-c   ***       actual position of the level zero cape             ***
-c
-        do 503 ij=1,ncum
-        fqold=fq(ij,inb(ij))
-        fq(ij,inb(ij))=fq(ij,inb(ij))*(1.-frac(ij))
-        fq(ij,inb(ij)-1)=fq(ij,inb(ij)-1)
-     &   +frac(ij)*fqold*((ph(ij,inb(ij))-ph(ij,inb(ij)+1))/
-     1   (ph(ij,inb(ij)-1)-ph(ij,inb(ij))))*lv(ij,inb(ij))
-     &   /lv(ij,inb(ij)-1)
-        ftold=ft(ij,inb(ij))
-        ft(ij,inb(ij))=ft(ij,inb(ij))*(1.-frac(ij))
-        ft(ij,inb(ij)-1)=ft(ij,inb(ij)-1)
-     &   +frac(ij)*ftold*((ph(ij,inb(ij))-ph(ij,inb(ij)+1))/
-     1   (ph(ij,inb(ij)-1)-ph(ij,inb(ij))))*cpn(ij,inb(ij))
-     &   /cpn(ij,inb(ij)-1)
-        fuold=fu(ij,inb(ij))
-        fu(ij,inb(ij))=fu(ij,inb(ij))*(1.-frac(ij))
-        fu(ij,inb(ij)-1)=fu(ij,inb(ij)-1)
-     &   +frac(ij)*fuold*((ph(ij,inb(ij))-ph(ij,inb(ij)+1))/
-     1   (ph(ij,inb(ij)-1)-ph(ij,inb(ij))))
-        fvold=fv(ij,inb(ij))
-        fv(ij,inb(ij))=fv(ij,inb(ij))*(1.-frac(ij))
-        fv(ij,inb(ij)-1)=fv(ij,inb(ij)-1)
-     &  +frac(ij)*fvold*((ph(ij,inb(ij))-ph(ij,inb(ij)+1))/
-     1   (ph(ij,inb(ij)-1)-ph(ij,inb(ij))))
- 503    continue
-c
-c   ***   Very slightly adjust tendencies to force exact   ***
-c   ***     enthalpy, momentum and tracer conservation     ***
-c
-        do 682 ij=1,ncum
-        ents(ij)=0.0
-        uav(ij)=0.0
-        vav(ij)=0.0
-        do 681 i=1,inb(ij)
-         ents(ij)=ents(ij)
-     &  +(cpn(ij,i)*ft(ij,i)+lv(ij,i)*fq(ij,i))*(ph(ij,i)-ph(ij,i+1))	
-         uav(ij)=uav(ij)+fu(ij,i)*(ph(ij,i)-ph(ij,i+1))
-         vav(ij)=vav(ij)+fv(ij,i)*(ph(ij,i)-ph(ij,i+1))
-  681	continue
-  682   continue
-        do 683 ij=1,ncum
-        ents(ij)=ents(ij)/(ph(ij,1)-ph(ij,inb(ij)+1))
-        uav(ij)=uav(ij)/(ph(ij,1)-ph(ij,inb(ij)+1))
-        vav(ij)=vav(ij)/(ph(ij,1)-ph(ij,inb(ij)+1))
- 683    continue
-        do 642 ij=1,ncum
-        do 641 i=1,inb(ij)
-         ft(ij,i)=ft(ij,i)-ents(ij)/cpn(ij,i)
-         fu(ij,i)=(1.-cu)*(fu(ij,i)-uav(ij))
-         fv(ij,i)=(1.-cu)*(fv(ij,i)-vav(ij))
-  641	continue
- 642    continue
-c
-        do 1810 k=1,nl+1
-          do 1800 i=1,ncum
-            if((q(i,k)+delt*fq(i,k)).lt.0.0)iflag(i)=10
- 1800     continue
- 1810   continue
-c
-c
-        do 1900 i=1,ncum
-          if(iflag(i).gt.2)then
-          precip(i)=0.0
-          cbmf(i)=0.0
-          endif
- 1900   continue
-        do 1920 k=1,nl
-         do 1910 i=1,ncum
-           if(iflag(i).gt.2)then
-             ft(i,k)=0.0
-             fq(i,k)=0.0
-             fu(i,k)=0.0
-             fv(i,k)=0.0
-           endif
- 1910    continue
- 1920   continue
-        do 2000 i=1,ncum
-         precip1(idcum(i))=precip(i)
-         cbmf1(idcum(i))=cbmf(i)
-         iflag1(idcum(i))=iflag(i)
- 2000   continue
-        do 2020 k=1,nl
-          do 2010 i=1,ncum
-            ft1(idcum(i),k)=ft(i,k)
-            fq1(idcum(i),k)=fq(i,k)
-            fu1(idcum(i),k)=fu(i,k)
-            fv1(idcum(i),k)=fv(i,k)
- 2010     continue
- 2020   continue
-c
-      DO k=1,nd
-        DO i=1,len
-         Ma(i,k) = 0.
-        ENDDO
-      ENDDO
-      DO k=nl,1,-1
-        DO i=1,ncum
-          Ma(i,k) = Ma(i,k+1)+m(i,k)
-        ENDDO
-      ENDDO
-c
-        return
-        end
-
Index: LMDZ.3.3/branches/rel-/libf/phylmd/convect3.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/convect3.F	(revision 416)
+++ 	(revision )
@@ -1,1252 +1,0 @@
-c $Header$
-      SUBROUTINE CONVECT
-     *    (DTIME,  T1,   R1,   RS,    U,  V,  TRA,   P,     PH,
-     *     ND,       NDP1,     NL, NTRA,  DELT,  IFLAG,
-     *     FT, FR, FU,  FV,  FTRA,  PRECIP,
-     *     icb,inb,   upwd,dnwd,dnwd0,SIG, W0,Mike,Mke,
-     *     Ma,MENTS,QENTS,TPS,TLS,SIGIJ,CAPE,TVP,PBASE,BUOYBASE,
-     *     DTVPDT1,DTVPDQ1,DPLCLDT,DPLCLDR)
-C
-C    ***  THE PARAMETER NA SHOULD IN GENERAL EQUAL ND   ***
-C
-c#################################################################
-cFleur       Introduction des traceurs dans convect3 le 6 juin 200
-c#################################################################
-#include "dimensions.h"
-#include "dimphy.h"
-      PARAMETER (NA=60)
-
-      integer NTRAC
-      PARAMETER (NTRAC=nqmx-2)
-
-      INTEGER NENT(NA)
-      REAL T1(ND),R1(ND),RS(ND),U(ND),V(ND),TRA(ND,NTRA)
-      REAL P(ND),PH(NDP1)
-      REAL FT(ND),FR(ND),FU(ND),FV(ND),FTRA(ND,NTRA)
-      REAL SIG(ND),W0(ND)
-      REAL UENT(NA,NA),VENT(NA,NA),TRAENT(NA,NA,NTRAC),TRATM(NA)
-      REAL UP(NA),VP(NA),TRAP(NA,NTRAC)
-      REAL M(NA),MP(NA),MENT(NA,NA),QENT(NA,NA),ELIJ(NA,NA)
-      REAL SIJ(NA,NA),TVP(NA),TV(NA),WATER(NA)
-      REAL RP(NA),EP(NA),TH(NA),WT(NA),EVAP(NA),CLW(NA)
-      REAL SIGP(NA),B(NA),TP(NA),CPN(NA)
-      REAL LV(NA),LVCP(NA),H(NA),HP(NA),GZ(NA)
-      REAL T(NA),RR(NA)
-C
-      REAL BUOY(NA)     !  Lifted parcel buoyancy
-      REAL DTVPDT1(ND),DTVPDQ1(ND)   ! Derivatives of parcel virtual
-C                                      temperature wrt T1 and Q1
-      REAL CLW_NEW(NA),QI(NA)
-C
-      LOGICAL ICE_CONV
-      PARAMETER (ICE_CONV=.TRUE.)
- 
-cccccccccccccccccccccccccccccccccccccccccccccc
-c     declaration des variables a sortir
-ccccccccccccccccccccccccccccccccccccccccccccc
-      real Mke(nd)
-      real Mike(nd)
-      real Ma(nd)
-      real TPS(ND) !temperature dans les ascendances non diluees
-      real TLS(ND) !temperature potentielle
-      real MENTS(nd,nd)
-      real QENTS(nd,nd)
-      REAL SIGIJ(KLEV,KLEV)
-      REAL PBASE ! pressure at the cloud base level
-      REAL BUOYBASE ! buoyancy at the cloud base level
-cccccccccccccccccccccccccccccccccccccccccccccc
- 
- 
- 
-c
-      real dnwd0(nd)  !  precipitation driven unsaturated downdraft flux
-      real dnwd(nd), dn1  ! in-cloud saturated downdraft mass flux
-      real upwd(nd), up1  ! in-cloud saturated updraft mass flux
-C
-C   ***         ASSIGN VALUES OF THERMODYNAMIC CONSTANTS        ***
-C   ***             THESE SHOULD BE CONSISTENT WITH             ***
-C   ***              THOSE USED IN CALLING PROGRAM              ***
-C   ***     NOTE: THESE ARE ALSO SPECIFIED IN SUBROUTINE TLIFT  ***
-C
-c sb      CPD=1005.7
-c sb      CPV=1870.0
-c sb      CL=4190.0
-c sb      CPVMCL=CL-CPV
-c sb      RV=461.5
-c sb      RD=287.04
-c sb      EPS=RD/RV
-c sb      ALV0=2.501E6
-ccccccccccccccccccccccc
-c constantes coherentes avec le modele du Centre Europeen
-c sb      RD = 1000.0 * 1.380658E-23 * 6.0221367E+23 / 28.9644
-c sb      RV = 1000.0 * 1.380658E-23 * 6.0221367E+23 / 18.0153
-c sb      CPD = 3.5 * RD
-c sb      CPV = 4.0 * RV
-c sb      CL = 4218.0
-c sb      CPVMCL=CL-CPV
-c sb      EPS=RD/RV
-c sb      ALV0=2.5008E+06
-cccccccccccccccccccccc
-c on utilise les constantes thermo du Centre Europeen: (SB)
-c
-#include "YOMCST.h"
-c
-       CPD = RCPD
-       CPV = RCPV
-       CL = RCW
-       CPVMCL = CL-CPV
-       EPS = RD/RV
-       ALV0 = RLVTT
-c
-       NK = 1 ! origin level of the lifted parcel
-c
-cccccccccccccccccccccc
-C
-C           ***  INITIALIZE OUTPUT ARRAYS AND PARAMETERS  ***
-C
-      DO 5 I=1,ND
-         FT(I)=0.0
-         FR(I)=0.0
-         FU(I)=0.0
-         FV(I)=0.0
-         DO 4 J=1,NTRA
-          FTRA(I,J)=0.0
-    4    CONTINUE
-         T(I)=T1(I)
-         RR(I)=R1(I)
-    5 CONTINUE
-      DO 7 I=1,NL
-         RDCP=(RD*(1.-RR(I))+RR(I)*RV)/ (CPD*(1.-RR(I))+RR(I)*CPV)
-         TH(I)=T(I)*(1000.0/P(I))**RDCP
-    7 CONTINUE
-C
-*************************************************************
-**    CALCUL DES TEMPERATURES POTENTIELLES A SORTIR
-*************************************************************
-      do i=1,ND
-      RDCP=(RD*(1.-RR(I))+RR(I)*RV)/ (CPD*(1.-RR(I))+RR(I)*CPV)
- 
-      TLS(i)=T(I)*(1000.0/P(I))**RDCP
-      enddo
- 
- 
- 
- 
-************************************************************
- 
- 
-      PRECIP=0.0
-      IFLAG=1
-C
-C   ***                    SPECIFY PARAMETERS                        ***
-C   ***  PBCRIT IS THE CRITICAL CLOUD DEPTH (MB) BENEATH WHICH THE   ***
-C   ***       PRECIPITATION EFFICIENCY IS ASSUMED TO BE ZERO         ***
-C   ***  PTCRIT IS THE CLOUD DEPTH (MB) ABOVE WHICH THE PRECIP.      ***
-C   ***            EFFICIENCY IS ASSUMED TO BE UNITY                 ***
-C   ***  SIGD IS THE FRACTIONAL AREA COVERED BY UNSATURATED DNDRAFT  ***
-C   ***  SPFAC IS THE FRACTION OF PRECIPITATION FALLING OUTSIDE      ***
-C   ***                        OF CLOUD                              ***
-C   ***    ALPHA AND BETA ARE PARAMETERS THAT CONTROL THE RATE OF    ***
-C   ***                 APPROACH TO QUASI-EQUILIBRIUM                ***
-C   ***    (THEIR STANDARD VALUES ARE 1.0 AND 0.96, RESPECTIVELY)    ***
-C   ***           (BETA MUST BE LESS THAN OR EQUAL TO 1)             ***
-C   ***    DTCRIT IS THE CRITICAL BUOYANCY (K) USED TO ADJUST THE    ***
-C   ***                 APPROACH TO QUASI-EQUILIBRIUM                ***
-C   ***                     IT MUST BE LESS THAN 0                   ***
-C
-      PBCRIT=150.0
-      PTCRIT=500.0
-      SIGD=0.01
-      SPFAC=0.15
-c sb:
-      EPMAX=0.993 ! precip efficiency less than unity
-c      EPMAX=1. ! precip efficiency less than unity
-C
-Cjyg
-CCC      BETA=0.96
-C  Beta is now expressed as a function of the characteristic time
-C  of the convective process.
-CCC        Old value : TAU = 15000.   !(for dtime = 600.s)
-CCC        Other value (inducing little change) :TAU = 8000.
-      TAU = 8000.
-      BETA = 1.-DTIME/TAU
-Cjyg
-CCC      ALPHA=1.0
-      ALPHA=1.5E-3*DTIME/TAU
-C        Increase alpha in order to compensate W decrease
-      ALPHA = ALPHA*1.5
-C
-Cjyg (voir CONVECT 3)
-CCC      DTCRIT=-0.2
-      DTCRIT=-2.
-Cgf&jyg
-CCC     DT pour l'overshoot.
-      DTOVSH = -0.2
- 
-C
-C           ***        INCREMENT THE COUNTER       ***
-C
-      SIG(ND)=SIG(ND)+1.0
-      SIG(ND)=AMIN1(SIG(ND),12.1)
-C
-C           ***    IF NOPT IS AN INTEGER OTHER THAN 0, CONVECT     ***
-C           ***     RETURNS ARRAYS T AND R THAT MAY HAVE BEEN      ***
-C           ***  ALTERED BY DRY ADIABATIC ADJUSTMENT; OTHERWISE    ***
-C           ***        THE RETURNED ARRAYS ARE UNALTERED.          ***
-C
-      NOPT=0
-C
-C     ***            PERFORM DRY ADIABATIC ADJUSTMENT            ***
-C
-C     ***  DO NOT BYPASS THIS EVEN IF THE CALLING PROGRAM HAS A  ***
-C     ***                BOUNDARY LAYER SCHEME !!!               ***
-C
-c test sb      DO 30 I=NL-1,1,-1
-c test sb         JN=0
-c test sb         DO 10 J=I+1,NL
-c test sb   10    IF(TH(J).LT.TH(I))JN=J
-c test sb         IF(JN.EQ.0)GOTO 30
-c test sb         AHM=0.0
-c test sb         RM=0.0
-c test sb         UM=0.0
-c test sb         VM=0.0
-c test sb         DO K=1,NTRA
-c test sb          TRATM(K)=0.0
-c test sb         END DO
-c test sb         DO 15 J=I,JN
-c test sb          AHM=AHM+(CPD*(1.-RR(J))+RR(J)*CPV)*T(J)*(PH(J)-PH(J+1))
-c test sb          RM=RM+RR(J)*(PH(J)-PH(J+1))
-c test sb          UM=UM+U(J)*(PH(J)-PH(J+1))
-c test sb          VM=VM+V(J)*(PH(J)-PH(J+1))
-c test sb          DO K=1,NTRA
-c test sb           TRATM(K)=TRATM(K)+TRA(J,K)*(PH(J)-PH(J+1))
-c test sb          END DO
-c test sb   15    CONTINUE
-c test sb         DPHINV=1./(PH(I)-PH(JN+1))
-c test sb         RM=RM*DPHINV
-c test sb         UM=UM*DPHINV
-c test sb         VM=VM*DPHINV
-c test sb         DO K=1,NTRA
-c test sb          TRATM(K)=TRATM(K)*DPHINV
-c test sb         END DO
-c test sb         A2=0.0
-c test sb         DO 20 J=I,JN
-c test sb            RR(J)=RM
-c test sb          U(J)=UM
-c test sb          V(J)=VM
-c test sb          DO K=1,NTRA
-c test sb           TRA(J,K)=TRATM(K)
-c test sb          END DO
-c test sb            RDCP=(RD*(1.-RR(J))+RR(J)*RV)/ (CPD*(1.-RR(J))+RR(J)*CPV)
-c test sb            X=(0.001*P(J))**RDCP
-c test sb            T(J)=X
-c test sb            A2=A2+(CPD*(1.-RR(J))+RR(J)*CPV)*X*(PH(J)-PH(J+1))
-c test sb   20    CONTINUE
-c test sb         DO 25 J=I,JN
-c test sb            TH(J)=AHM/A2
-c test sb            T(J)=T(J)*TH(J)
-c test sb   25    CONTINUE
-c test sb   30 CONTINUE
-C
-C   ***   RESET INPUT ARRAYS IF NOPT .NE. 0   ***
-C
-      IF (NOPT.NE.0)THEN
-         DO 35 I=1,ND
-            T1(I)=T(I)
-            R1(I)=RR(I)
-   35    CONTINUE
-      END IF
-C
-C  *** CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY AND STATIC ENERGY
-C
-      GZ(1)=0.0
-      CPN(1)=CPD*(1.-RR(1))+RR(1)*CPV
-      H(1)=T(1)*CPN(1)
-      DO 40 I=2,NL
-        TVX=T(I)*(1.+RR(I)/EPS-RR(I))
-        TVY=T(I-1)*(1.+RR(I-1)/EPS-RR(I-1))
-        GZ(I)=GZ(I-1)+0.5*RD*(TVX+TVY)*(P(I-1)-P(I))/PH(I)
-        CPN(I)=CPD*(1.-RR(I))+CPV*RR(I)
-        H(I)=T(I)*CPN(I)+GZ(I)
-   40 CONTINUE
-C
-C   ***  CALCULATE LIFTED CONDENSATION LEVEL OF AIR AT LOWEST MODEL LEVEL ***
-C   ***       (WITHIN 0.2% OF FORMULA OF BOLTON, MON. WEA. REV.,1980)     ***
-C
-      IF (T(1).LT.250.0.OR.RR(1).LE.0.0)THEN
-         IFLAG=0
-c sb3d         print*,'je suis passe par 366'
-         RETURN
-      END IF
-
-cjyg1 Utilisation de la subroutine CLIFT
-CC      RH=RR(1)/RS(1)
-CC      CHI=T(1)/(1669.0-122.0*RH-T(1))
-CC      PLCL=P(1)*(RH**CHI)
-      CALL CLIFT(P(1),T(1),RR(1),RS(1),PLCL,DPLCLDT,DPLCLDR)
-cjyg2
-c sb3d      PRINT *,' em_plcl,p1,t1,r1,rs1,rh '
-c sb3d     $        ,PLCL,P(1),T(1),RR(1),RS(1),RH
-c
-      IF (PLCL.LT.200.0.OR.PLCL.GE.2000.0)THEN
-         IFLAG=2
-         RETURN
-      END IF
-Cjyg1
-C     Essais de modification de ICB
-C
-C   ***  CALCULATE FIRST LEVEL ABOVE LCL (=ICB)  ***
-C
-CC      ICB=NL-1
-CC      DO 50 I=2,NL-1
-CC         IF(P(I).LT.PLCL)THEN
-CC            ICB=MIN(ICB,I)   ! ICB sup ou egal a 2
-CC         END IF
-CC   50 CONTINUE
-CC      IF(ICB.EQ.(NL-1))THEN
-CC         IFLAG=3
-CC         RETURN
-CC      END IF
-C
-C   *** CALCULATE LAYER CONTAINING LCL (=ICB)   ***
-C
-      ICB=NL-1
-c sb      DO 50 I=2,NL-1
-      DO 50 I=3,NL-1 ! modif sb pour que ICB soit sup/egal a 2
-C   la modification consiste a comparer PLCL a PH et non a P:
-C   ICB est defini par :  PH(ICB)<PLCL<PH(ICB-!)
-         IF(PH(I).LT.PLCL)THEN
-            ICB=MIN(ICB,I)
-         END IF
-   50 CONTINUE
-      IF(ICB.EQ.(NL-1))THEN
-         IFLAG=3
-         RETURN
-      END IF
-      ICB = ICB-1 ! ICB sup ou egal a 2 
-Cjyg2
-C
-C
- 
-C   *** SUBROUTINE TLIFT CALCULATES PART OF THE LIFTED PARCEL VIRTUAL      ***
-C   ***  TEMPERATURE, THE ACTUAL TEMPERATURE AND THE ADIABATIC             ***
-C   ***                   LIQUID WATER CONTENT                             ***
-C
- 
-cjyg1
-c make sure that "Cloud base" seen by TLIFT is actually the 
-c fisrt level where adiabatic ascent is saturated 
-       IF (PLCL .GT. P(ICB)) THEN
-c sb        CALL TLIFT(P,T,RR,RS,GZ,PLCL,ICB,TVP,TP,CLW,ND,NL)
-        CALL TLIFT(P,T,RR,RS,GZ,PLCL,ICB,NK,TVP,TP,CLW,ND,NL
-     :            ,DTVPDT1,DTVPDQ1)
-       ELSE
-c sb        CALL TLIFT(P,T,RR,RS,GZ,PLCL,ICB+1,TVP,TP,CLW,ND,NL)
-        CALL TLIFT(P,T,RR,RS,GZ,PLCL,ICB+1,NK,TVP,TP,CLW,ND,NL
-     :            ,DTVPDT1,DTVPDQ1)
-       ENDIF
-cjyg2
- 
-******************************************************************************
-****     SORTIE DE LA TEMPERATURE DE L ASCENDANCE NON DILUE
-******************************************************************************
-        do i=1,ND
-        TPS(i)=TP(i)
-        enddo
- 
- 
-******************************************************************************
- 
-C
-C   ***  SET THE PRECIPITATION EFFICIENCIES AND THE FRACTION OF   ***
-C   ***          PRECIPITATION FALLING OUTSIDE OF CLOUD           ***
-C   ***      THESE MAY BE FUNCTIONS OF TP(I), P(I) AND CLW(I)     ***
-C
-      DO 55 I=1,NL
-         PDEN=PTCRIT-PBCRIT
-c
-cjyg
-ccc         EP(I)=(P(ICB)-P(I)-PBCRIT)/PDEN
-c sb         EP(I)=(PLCL-P(I)-PBCRIT)/PDEN
-         EP(I)=(PLCL-P(I)-PBCRIT)/PDEN * EPMAX ! sb
-c
-         EP(I)=AMAX1(EP(I),0.0)
-c sb         EP(I)=AMIN1(EP(I),1.0)
-         EP(I)=AMIN1(EP(I),EPMAX) ! sb
-         SIGP(I)=SPFAC
-C
-C   ***       CALCULATE VIRTUAL TEMPERATURE AND LIFTED PARCEL     ***
-C   ***                    VIRTUAL TEMPERATURE                    ***
-C
-         TV(I)=T(I)*(1.+RR(I)/EPS-RR(I))
-Ccd1
-C    . Keep all liquid water in lifted parcel (-> adiabatic CAPE)
-C
-ccc    TVP(I)=TVP(I)-TP(I)*(RR(1)-EP(I)*CLW(I))
-c!!! sb         TVP(I)=TVP(I)-TP(I)*RR(1) ! calcule dans tlift
-Ccd2
-C
-C   ***       Calculate first estimate of buoyancy
-C
-         BUOY(I) = TVP(I) - TV(I)
-   55 CONTINUE
-C
-C   ***   Set Cloud Base Buoyancy at (Plcl+DPbase) level buoyancy
-C
-      DPBASE = -40.   !That is 400m above LCL
-      PBASE = PLCL + DPBASE
-      TVPBASE = TVP(ICB  )*(PBASE -P(ICB+1))/(P(ICB)-P(ICB+1))
-     $         +TVP(ICB+1)*(P(ICB)-PBASE   )/(P(ICB)-P(ICB+1))
-      TVBASE = TV(ICB  )*(PBASE -P(ICB+1))/(P(ICB)-P(ICB+1))
-     $        +TV(ICB+1)*(P(ICB)-PBASE   )/(P(ICB)-P(ICB+1))
-C
-      BUOYBASE = TVPBASE - TVBASE
-C
-CC       Set buoyancy = BUOYBASE for all levels below BASE.
-CC       For safety, set : BUOY(ICB) = BUOYBASE
-      DO I = ICB,NL
-        IF (P(I) .GE. PBASE) THEN
-          BUOY(I) = BUOYBASE
-        ENDIF
-      ENDDO
-      BUOY(ICB) = BUOYBASE
-C
-c sb3d      print *,'buoybase,tvp_tv,tvpbase,tvbase,pbase,plcl'
-c sb3d     $,        buoybase,tvp(icb)-tv(icb),tvpbase,tvbase,pbase,plcl
-c sb3d      print *,'TVP ',(tvp(i),i=1,nl)
-c sb3d      print *,'TV ',(tv(i),i=1,nl)
-c sb3d      print *, 'P ',(p(i),i=1,nl)
-c sb3d      print *,'ICB ',icb
-C
-C   ***   MAKE SURE THAT COLUMN IS DRY ADIABATIC BETWEEN THE SURFACE  ***
-C   ***    AND CLOUD BASE, AND THAT LIFTED AIR IS POSITIVELY BUOYANT  ***
-C   ***                         AT CLOUD BASE                         ***
-C   ***       IF NOT, RETURN TO CALLING PROGRAM AFTER RESETTING       ***
-C   ***                        SIG(I) AND W0(I)                       ***
-C
-Cjyg
-CCC      TDIF=TVP(ICB)-TV(ICB)
-      TDIF = BUOY(ICB)
-      ATH1=TH(1)
-Cjyg
-CCC      ATH=TH(ICB-1)-1.0
-      ATH=TH(ICB-1)-5.0
-c      ATH=0.                          ! ajout sb
-c      IF (ICB.GT.1) ATH=TH(ICB-1)-5.0 ! modif sb
-      IF(TDIF.LT.DTCRIT.OR.ATH.GT.ATH1)THEN
-         DO 60 I=1,NL
-            SIG(I)=BETA*SIG(I)-2.*ALPHA*TDIF*TDIF
-            SIG(I)=AMAX1(SIG(I),0.0)
-            W0(I)=BETA*W0(I)
-   60    CONTINUE
-         IFLAG=0
-         RETURN
-      END IF
-C
- 
- 
-C   ***  IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY ***
-C   ***        NOW INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS       ***
-C
-      DO 70 I=1,NL
-         HP(I)=H(I)
-         WT(I)=0.001
-         RP(I)=RR(I)
-         UP(I)=U(I)
-         VP(I)=V(I)
-         DO 71 J=1,NTRA
-          TRAP(I,J)=TRA(I,J)
-   71    CONTINUE
-         NENT(I)=0
-         WATER(I)=0.0
-         EVAP(I)=0.0
-         B(I)=0.0
-         MP(I)=0.0
-         M(I)=0.0
-         LV(I)=ALV0-CPVMCL*(T(I)-273.15)
-         LVCP(I)=LV(I)/CPN(I)
-         DO 70 J=1,NL
-            QENT(I,J)=RR(J)
-            ELIJ(I,J)=0.0
-            MENT(I,J)=0.0
-            SIJ(I,J)=0.0
-          UENT(I,J)=U(J)
-          VENT(I,J)=V(J)
-          DO 70 K=1,NTRA
-           TRAENT(I,J,K)=TRA(J,K)
-   70 CONTINUE
- 
-      DELTI=1.0/DELT
-C
-C  ***  FIND THE FIRST MODEL LEVEL (INB) ABOVE THE PARCEL'S       ***
-C  ***                LEVEL OF NEUTRAL BUOYANCY                   ***
-C
-      INB=NL-1
-      DO 80 I=ICB,NL-1
-Cjyg
-CCC         IF((TVP(I)-TV(I)).LT.DTCRIT)THEN
-         IF(BUOY(I).LT.DTOVSH)THEN
-            INB=MIN(INB,I)
-         END IF
-   80 CONTINUE
- 
- 
- 
- 
-C
-C   ***          RESET SIG(I) AND W0(I) FOR I>INB AND I<ICB       ***
-C
-      IF(INB.LT.(NL-1))THEN
-         DO 85 I=INB+1,NL-1
-Cjyg
-CCC            SIG(I)=BETA*SIG(I)-2.0E-4*ALPHA*(TV(INB)-TVP(INB))*
-CCC     1              ABS(TV(INB)-TVP(INB))
-            SIG(I)=BETA*SIG(I)+2.*ALPHA*BUOY(INB)*
-     1              ABS(BUOY(INB))
-            SIG(I)=AMAX1(SIG(I),0.0)
-            W0(I)=BETA*W0(I)
-   85    CONTINUE
-      END IF
-      DO 87 I=1,ICB
-Cjyg
-CCC         SIG(I)=BETA*SIG(I)-2.0E-4*ALPHA*(TV(ICB)-TVP(ICB))*
-CCC     1           (TV(ICB)-TVP(ICB))
-         SIG(I)=BETA*SIG(I)-2.*ALPHA*BUOY(ICB)*BUOY(ICB)
-         SIG(I)=AMAX1(SIG(I),0.0)
-         W0(I)=BETA*W0(I)
-   87 CONTINUE
-C
-C   ***    RESET FRACTIONAL AREAS OF UPDRAFTS AND W0 AT INITIAL TIME    ***
-C   ***           AND AFTER 10 TIME STEPS OF NO CONVECTION              ***
-C
- 
-      IF(SIG(ND).LT.1.5.OR.SIG(ND).GT.12.0)THEN
-         DO 90 I=1,NL-1
-            SIG(I)=0.0
-            W0(I)=0.0
-   90    CONTINUE
-      END IF
-C
-C   ***   CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL   ***
-C
-      DO 95 I=ICB,INB
-         HP(I)=H(1)+(LV(I)+(CPD-CPV)*T(I))*EP(I)*CLW(I)
-   95 CONTINUE
-C
-C   ***  CALCULATE CONVECTIVE AVAILABLE POTENTIAL ENERGY (CAPE),  ***
-C   ***     VERTICAL VELOCITY (W), FRACTIONAL AREA COVERED BY     ***
-C   ***     UNDILUTE UPDRAFT (SIG),  AND UPDRAFT MASS FLUX (M)    ***
-C
-      CAPE=0.0
-C
-      DO 98 I=ICB+1,INB
-Cjyg1
-CCC         CAPE=CAPE+RD*(TVP(I-1)-TV(I-1))*(PH(I-1)-PH(I))/P(I-1)
-CCC         DCAPE=RD*BUOY(I-1)*(PH(I-1)-PH(I))/P(I-1)
-CCC         DLNP=(PH(I-1)-PH(I))/P(I-1)
-C          The interval on which CAPE is computed starts at PBASE :
-         DELTAP = MIN(PBASE,PH(I-1))-MIN(PBASE,PH(I))
-         CAPE=CAPE+RD*BUOY(I-1)*DELTAP/P(I-1)
-         DCAPE=RD*BUOY(I-1)*DELTAP/P(I-1)
-         DLNP=DELTAP/P(I-1)
-Cjyg2
-c sb3d         print *,'buoy,dlnp,dcape,cape',buoy(i-1),dlnp,dcape,cape
-         CAPE=AMAX1(0.0,CAPE)
-C
-         SIGOLD=SIG(I)
-         DTMIN=100.0
-         DO 97 J=ICB,I-1
-Cjyg
-CCC            DTMIN=AMIN1(DTMIN,(TVP(J)-TV(J)))
-            DTMIN=AMIN1(DTMIN,BUOY(J))
-   97    CONTINUE
-c sb3d     print *, 'DTMIN, BETA, ALPHA, SIG = ',DTMIN,BETA,ALPHA,SIG(I)
-         SIG(I)=BETA*SIG(I)+ALPHA*DTMIN*ABS(DTMIN)
-         SIG(I)=AMAX1(SIG(I),0.0)
-         SIG(I)=AMIN1(SIG(I),0.01)
-         FAC=AMIN1(((DTCRIT-DTMIN)/DTCRIT),1.0)
-Cjyg
-CC    Essais de reduction de la vitesse
-CC         FAC = FAC*.5
-C
-         W=(1.-BETA)*FAC*SQRT(CAPE)+BETA*W0(I)
-         AMU=0.5*(SIG(I)+SIGOLD)*W
-         M(I)=AMU*0.007*P(I)*(PH(I)-PH(I+1))/TV(I)
-         W0(I)=W
-   98 CONTINUE
-      W0(ICB)=0.5*W0(ICB+1)
-      M(ICB)=0.5*M(ICB+1)*(PH(ICB)-PH(ICB+1))/(PH(ICB+1)-PH(ICB+2))
-      SIG(ICB)=SIG(ICB+1)
-      SIG(ICB-1)=SIG(ICB)
-cjyg1
-c sb3d      print *, 'Cloud base, c. top, CAPE',ICB,INB,cape
-c sb3d      print *, 'SIG ',(sig(i),i=1,inb)
-c sb3d      print *, 'W ',(w0(i),i=1,inb)
-c sb3d      print *, 'M ',(m(i), i=1,inb)
-c sb3d      print *, 'Dt1 ',(tvp(i)-tv(i),i=1,inb)
-c sb3d      print *, 'Dt_vrai ',(buoy(i),i=1,inb)
-Cjyg2
-C
-C   ***  CALCULATE ENTRAINED AIR MASS FLUX (MENT), TOTAL WATER MIXING  ***
-C   ***     RATIO (QENT), TOTAL CONDENSED WATER (ELIJ), AND MIXING     ***
-C   ***                        FRACTION (SIJ)                          ***
-C
- 
- 
-      DO 170 I=ICB,INB
-         RTI=RR(1)-EP(I)*CLW(I)
-         DO 160 J=ICB-1,INB
-            BF2=1.+LV(J)*LV(J)*RS(J)/(RV*T(J)*T(J)*CPD)
-            ANUM=H(J)-HP(I)+(CPV-CPD)*T(J)*(RTI-RR(J))
-            DENOM=H(I)-HP(I)+(CPD-CPV)*(RR(I)-RTI)*T(J)
-            DEI=DENOM
-            IF(ABS(DEI).LT.0.01)DEI=0.01
-            SIJ(I,J)=ANUM/DEI
-            SIJ(I,I)=1.0
-            ALTEM=SIJ(I,J)*RR(I)+(1.-SIJ(I,J))*RTI-RS(J)
-            ALTEM=ALTEM/BF2
-            CWAT=CLW(J)*(1.-EP(J))
-            STEMP=SIJ(I,J)
-            IF((STEMP.LT.0.0.OR.STEMP.GT.1.0.OR.
-     1      ALTEM.GT.CWAT).AND.J.GT.I)THEN
-            ANUM=ANUM-LV(J)*(RTI-RS(J)-CWAT*BF2)
-            DENOM=DENOM+LV(J)*(RR(I)-RTI)
-            IF(ABS(DENOM).LT.0.01)DENOM=0.01
-            SIJ(I,J)=ANUM/DENOM
-            ALTEM=SIJ(I,J)*RR(I)+(1.-SIJ(I,J))*RTI-RS(J)
-            ALTEM=ALTEM-(BF2-1.)*CWAT
-            END IF
- 
- 
-            IF(SIJ(I,J).GT.0.0.AND.SIJ(I,J).LT.0.95)THEN
-               QENT(I,J)=SIJ(I,J)*RR(I)+(1.-SIJ(I,J))*RTI
-               UENT(I,J)=SIJ(I,J)*U(I)+(1.-SIJ(I,J))*U(NK)
-               VENT(I,J)=SIJ(I,J)*V(I)+(1.-SIJ(I,J))*V(NK)
-               DO K=1,NTRA
-               TRAENT(I,J,K)=SIJ(I,J)*TRA(I,K)+(1.-SIJ(I,J))*
-     1         TRA(NK,K)
-               END DO
-               ELIJ(I,J)=ALTEM
-               ELIJ(I,J)=AMAX1(0.0,ELIJ(I,J))
-               MENT(I,J)=M(I)/(1.-SIJ(I,J))
-               NENT(I)=NENT(I)+1
-            END IF
-            SIJ(I,J)=AMAX1(0.0,SIJ(I,J))
-            SIJ(I,J)=AMIN1(1.0,SIJ(I,J))
-  160    CONTINUE
-C
-C   ***   IF NO AIR CAN ENTRAIN AT LEVEL I ASSUME THAT UPDRAFT DETRAINS  ***
-C   ***   AT THAT LEVEL AND CALCULATE DETRAINED AIR FLUX AND PROPERTIES  ***
-C
-         IF(NENT(I).EQ.0)THEN
-            MENT(I,I)=M(I)
-            QENT(I,I)=RR(NK)-EP(I)*CLW(I)
-           UENT(I,I)=U(NK)
-           VENT(I,I)=V(NK)
-           DO J=1,NTRA
-            TRAENT(I,I,J)=TRA(NK,J)
-           END DO
-            ELIJ(I,I)=CLW(I)
-            SIJ(I,I)=1.0
-         END IF
-C
-         DO J = ICB-1,INB
-           SIGIJ(I,J) = SIJ(I,J)
-         ENDDO
-C	
-  170 CONTINUE
-C
-C   ***  NORMALIZE ENTRAINED AIR MASS FLUXES TO REPRESENT EQUAL  ***
-C   ***              PROBABILITIES OF MIXING                     ***
-C
- 
-      DO 200 I=ICB,INB
-      IF(NENT(I).NE.0)THEN
-       QP=RR(1)-EP(I)*CLW(I)
-       ANUM=H(I)-HP(I)-LV(I)*(QP-RS(I))+(CPV-CPD)*T(I)*
-     1    (QP-RR(I))
-       DENOM=H(I)-HP(I)+LV(I)*(RR(I)-QP)+
-     1    (CPD-CPV)*T(I)*(RR(I)-QP)
-       IF(ABS(DENOM).LT.0.01)DENOM=0.01
-       SCRIT=ANUM/DENOM
-       ALT=QP-RS(I)+SCRIT*(RR(I)-QP)
-       IF(SCRIT.LE.0.0.OR.ALT.LE.0.0)SCRIT=1.0
-       SMAX=0.0
-       ASIJ=0.0
-        DO 175 J=INB,ICB-1,-1
-        IF(SIJ(I,J).GT.1.0E-16.AND.SIJ(I,J).LT.0.95)THEN
-         WGH=1.0
-         IF(J.GT.I)THEN
-          SJMAX=AMAX1(SIJ(I,J+1),SMAX)
-          SJMAX=AMIN1(SJMAX,SCRIT)
-          SMAX=AMAX1(SIJ(I,J),SMAX)
-          SJMIN=AMAX1(SIJ(I,J-1),SMAX)
-          SJMIN=AMIN1(SJMIN,SCRIT)
-          IF(SIJ(I,J).LT.(SMAX-1.0E-16))WGH=0.0
-          SMID=AMIN1(SIJ(I,J),SCRIT)
-         ELSE
-          SJMAX=AMAX1(SIJ(I,J+1),SCRIT)
-          SMID=AMAX1(SIJ(I,J),SCRIT)
-          SJMIN=0.0
-          IF(J.GT.1)SJMIN=SIJ(I,J-1)
-          SJMIN=AMAX1(SJMIN,SCRIT)
-         END IF
-         DELP=ABS(SJMAX-SMID)
-         DELM=ABS(SJMIN-SMID)
-         ASIJ=ASIJ+WGH*(DELP+DELM)
-         MENT(I,J)=MENT(I,J)*(DELP+DELM)*WGH
-        END IF
-  175       CONTINUE
-       ASIJ=AMAX1(1.0E-16,ASIJ)
-       ASIJ=1.0/ASIJ
-       DO 180 J=ICB-1,INB
-        MENT(I,J)=MENT(I,J)*ASIJ
-  180    CONTINUE
-       ASUM=0.0
-       BSUM=0.0
-       DO 190 J=ICB-1,INB
-        ASUM=ASUM+MENT(I,J)
-        MENT(I,J)=MENT(I,J)*SIG(J)
-        BSUM=BSUM+MENT(I,J)
-  190       CONTINUE
-       BSUM=AMAX1(BSUM,1.0E-16)
-       BSUM=1.0/BSUM
-       DO 195 J=ICB-1,INB
-        MENT(I,J)=MENT(I,J)*ASUM*BSUM	
-  195       CONTINUE
-       CSUM=0.0
-       DO 197 J=ICB-1,INB
-        CSUM=CSUM+MENT(I,J)
-  197       CONTINUE
- 
-       IF(CSUM.LT.M(I))THEN
-        NENT(I)=0
-        MENT(I,I)=M(I)
-        QENT(I,I)=RR(1)-EP(I)*CLW(I)
-          UENT(I,I)=U(NK)
-          VENT(I,I)=V(NK)
-          DO J=1,NTRA
-           TRAENT(I,I,J)=TRA(NK,J)
-          END DO
-        ELIJ(I,I)=CLW(I)
-        SIJ(I,I)=1.0
-       END IF
-      END IF
-  200      CONTINUE
- 
- 
- 
-***************************************************************
-**       CALCUL DES MENTS(I,J) ET DES QENTS(I,J)
-**************************************************************
- 
-         DO im=1,nd
-         do jm=1,nd
- 
-         QENTS(im,jm)=QENT(im,jm)
-         MENTS(im,jm)=MENT(im,jm)
-         enddo
-         enddo
- 
-***********************************************************
- 
- 
- 
-C
-C   ***  CHECK WHETHER EP(INB)=0, IF SO, SKIP PRECIPITATING    ***
-C   ***             DOWNDRAFT CALCULATION                      ***
-C
-        IF(EP(INB).LT.0.0001)GOTO 405
-C
-C   ***  INTEGRATE LIQUID WATER EQUATION TO FIND CONDENSED WATER   ***
-C   ***                AND CONDENSED WATER FLUX                    ***
-C
-        WFLUX=0.0
-        TINV=1./3.
-C
-C    ***                    BEGIN DOWNDRAFT LOOP                    ***
-C
-        DO 400 I=INB,1,-1
-C
-C    ***              CALCULATE DETRAINED PRECIPITATION             ***
-C
- 
- 
-        WDTRAIN=10.0*EP(I)*M(I)*CLW(I)
-        IF(I.GT.1)THEN
-         DO 320 J=1,I-1
-       AWAT=ELIJ(J,I)-(1.-EP(I))*CLW(I)
-       AWAT=AMAX1(AWAT,0.0)
-  320    WDTRAIN=WDTRAIN+10.0*AWAT*MENT(J,I)
-        END IF
-C
-C    ***    FIND RAIN WATER AND EVAPORATION USING PROVISIONAL   ***
-C    ***              ESTIMATES OF RP(I)AND RP(I-1)             ***
-C
- 
- 
-        WT(I)=45.0
-      IF(I.LT.INB)THEN
-       RP(I)=RP(I+1)+(CPD*(T(I+1)-T(I))+GZ(I+1)-GZ(I))/LV(I)
-       RP(I)=0.5*(RP(I)+RR(I))
-      END IF
-      RP(I)=AMAX1(RP(I),0.0)
-      RP(I)=AMIN1(RP(I),RS(I))
-      RP(INB)=RR(INB)
-      IF(I.EQ.1)THEN
-       AFAC=P(1)*(RS(1)-RP(1))/(1.0E4+2000.0*P(1)*RS(1))
-      ELSE
-       RP(I-1)=RP(I)+(CPD*(T(I)-T(I-1))+GZ(I)-GZ(I-1))/LV(I)
-       RP(I-1)=0.5*(RP(I-1)+RR(I-1))
-       RP(I-1)=AMIN1(RP(I-1),RS(I-1))
-       RP(I-1)=AMAX1(RP(I-1),0.0)
-       AFAC1=P(I)*(RS(I)-RP(I))/(1.0E4+2000.0*P(I)*RS(I))
-       AFAC2=P(I-1)*(RS(I-1)-RP(I-1))/(1.0E4+
-     1    2000.0*P(I-1)*RS(I-1))
-       AFAC=0.5*(AFAC1+AFAC2)
-      END IF
-      IF(I.EQ.INB)AFAC=0.0
-        AFAC=AMAX1(AFAC,0.0)
-        BFAC=1./(SIGD*WT(I))
-C
-Cjyg1
-CCC        SIGT=1.0
-CCC        IF(I.GE.ICB)SIGT=SIGP(I)
-C Prise en compte de la variation progressive de SIGT dans
-C les couches ICB et ICB-1:
-C 	Pour PLCL<PH(I+1), PR1=0 & PR2=1
-C 	Pour PLCL>PH(I),   PR1=1 & PR2=0
-C 	Pour PH(I+1)<PLCL<PH(I), PR1 est la proportion a cheval
-C    sur le nuage, et PR2 est la proportion sous la base du
-C    nuage.
-         PR1 =(PLCL-PH(I+1))/(PH(I)-PH(I+1))
-         PR1 = MAX(0.,MIN(1.,PR1))
-         PR2 = (PH(I)-PLCL)/(PH(I)-PH(I+1))
-         PR2 = MAX(0.,MIN(1.,PR2))
-         SIGT = SIGP(I)*PR1 + PR2
-c sb3d         print *,'i,sigt,pr1,pr2', i,sigt,pr1,pr2
-Cjyg2
-C
-        B6=BFAC*50.*SIGD*(PH(I)-PH(I+1))*SIGT*AFAC
-        C6=WATER(I+1)+BFAC*WDTRAIN-50.*SIGD*BFAC*
-     1   (PH(I)-PH(I+1))*EVAP(I+1)
-      IF(C6.GT.0.0)THEN
-         REVAP=0.5*(-B6+SQRT(B6*B6+4.*C6))
-         EVAP(I)=SIGT*AFAC*REVAP
-         WATER(I)=REVAP*REVAP
-      ELSE
-       EVAP(I)=-EVAP(I+1)+0.02*(WDTRAIN+SIGD*WT(I)*
-     1    WATER(I+1))/(SIGD*(PH(I)-PH(I+1)))
-      END IF
- 
- 
-C
-C    ***  CALCULATE PRECIPITATING DOWNDRAFT MASS FLUX UNDER     ***
-C    ***              HYDROSTATIC APPROXIMATION                 ***
-C
-        IF(I.EQ.1)GOTO 360
-      TEVAP=AMAX1(0.0,EVAP(I))
-      DELTH=AMAX1(0.001,(TH(I)-TH(I-1)))
-      MP(I)=10.*LVCP(I)*SIGD*TEVAP*(P(I-1)-P(I))/DELTH
-C
-C    ***           IF HYDROSTATIC ASSUMPTION FAILS,             ***
-C    ***   SOLVE CUBIC DIFFERENCE EQUATION FOR DOWNDRAFT THETA  ***
-C    ***  AND MASS FLUX FROM TWO SIMULTANEOUS DIFFERENTIAL EQNS ***
-C
-      AMFAC=SIGD*SIGD*70.0*PH(I)*(P(I-1)-P(I))*
-     1   (TH(I)-TH(I-1))/(TV(I)*TH(I))
-      AMP2=ABS(MP(I+1)*MP(I+1)-MP(I)*MP(I))
-      IF(AMP2.GT.(0.1*AMFAC))THEN
-         XF=100.0*SIGD*SIGD*SIGD*(PH(I)-PH(I+1))
-         TF=B(I)-5.0*(TH(I)-TH(I-1))*T(I)/(LVCP(I)*SIGD*TH(I))
-         AF=XF*TF+MP(I+1)*MP(I+1)*TINV
-         BF=2.*(TINV*MP(I+1))**3+TINV*MP(I+1)*XF*TF+50.*
-     1    (P(I-1)-P(I))*XF*TEVAP
-         FAC2=1.0
-         IF(BF.LT.0.0)FAC2=-1.0
-         BF=ABS(BF)
-         UR=0.25*BF*BF-AF*AF*AF*TINV*TINV*TINV
-         IF(UR.GE.0.0)THEN
-          SRU=SQRT(UR)
-          FAC=1.0
-          IF((0.5*BF-SRU).LT.0.0)FAC=-1.0
-          MP(I)=MP(I+1)*TINV+(0.5*BF+SRU)**TINV+
-     1     FAC*(ABS(0.5*BF-SRU))**TINV
-         ELSE
-          D=ATAN(2.*SQRT(-UR)/(BF+1.0E-28))
-          IF(FAC2.LT.0.0)D=3.14159-D
-          MP(I)=MP(I+1)*TINV+2.*SQRT(AF*TINV)*COS(D*TINV)
-         END IF
-         MP(I)=AMAX1(0.0,MP(I))
-         B(I-1)=B(I)+100.0*(P(I-1)-P(I))*TEVAP/(MP(I)+SIGD*0.1)-
-     1    10.0*(TH(I)-TH(I-1))*T(I)/(LVCP(I)*SIGD*TH(I))
-         B(I-1)=AMAX1(B(I-1),0.0)
-      END IF
- 
- 
-C
-C   ***         LIMIT MAGNITUDE OF MP(I) TO MEET CFL CONDITION      ***
-C
-      AMPMAX=2.0*(PH(I)-PH(I+1))*DELTI
-      AMP2=2.0*(PH(I-1)-PH(I))*DELTI
-      AMPMAX=AMIN1(AMPMAX,AMP2)
-      MP(I)=AMIN1(MP(I),AMPMAX)
-C
-C    ***      FORCE MP TO DECREASE LINEARLY TO ZERO                 ***
-C    ***       BETWEEN CLOUD BASE AND THE SURFACE                   ***
-C
-          IF(P(I).GT.P(ICB))THEN
-           MP(I)=MP(ICB)*(P(1)-P(I))/(P(1)-P(ICB))
-          END IF
-  360   CONTINUE
-C
-C    ***       FIND MIXING RATIO OF PRECIPITATING DOWNDRAFT     ***
-C
-        IF(I.EQ.INB)GOTO 400
-      RP(I)=RR(I)
-        IF(MP(I).GT.MP(I+1))THEN
-        RP(I)=RP(I+1)*MP(I+1)+RR(I)*(MP(I)-MP(I+1))+
-     1       5.*SIGD*(PH(I)-PH(I+1))*(EVAP(I+1)+EVAP(I))
-        RP(I)=RP(I)/MP(I)
-          UP(I)=UP(I+1)*MP(I+1)+U(I)*(MP(I)-MP(I+1))
-         UP(I)=UP(I)/MP(I)
-          VP(I)=VP(I+1)*MP(I+1)+V(I)*(MP(I)-MP(I+1))
-         VP(I)=VP(I)/MP(I)
-          DO J=1,NTRA
-           TRAP(I,J)=TRAP(I+1,J)*MP(I+1)+
-     s     TRAP(I,J)*(MP(I)-MP(I+1))
-           TRAP(I,J)=TRAP(I,J)/MP(I)
-          END DO
-        ELSE
-        IF(MP(I+1).GT.1.0E-16)THEN
-           RP(I)=RP(I+1)+5.0*SIGD*(PH(I)-PH(I+1))*(EVAP(I+1)+
-     1      EVAP(I))/MP(I+1)
-            UP(I)=UP(I+1)
-            VP(I)=VP(I+1)
-            DO J=1,NTRA
-             TRAP(I,J)=TRAP(I+1,J)
-            END DO
-        END IF
-        END IF
-      RP(I)=AMIN1(RP(I),RS(I))
-      RP(I)=AMAX1(RP(I),0.0)
-  400   CONTINUE
-C
-C   ***  CALCULATE SURFACE PRECIPITATION IN MM/DAY     ***
-C
-        PRECIP=WT(1)*SIGD*WATER(1)*8640.0
-  405   CONTINUE
-C
-C   ***  CALCULATE TENDENCIES OF LOWEST LEVEL POTENTIAL TEMPERATURE  ***
-C   ***                      AND MIXING RATIO                        ***
-C
-      DPINV=1.0/(PH(1)-PH(2))
-        AM=0.0
-        DO 410 K=2,INB
-  410   AM=AM+M(K)
-      IF((0.1*DPINV*AM).GE.DELTI)IFLAG=4
-      FT(1)=0.1*DPINV*AM*(T(2)-T(1)+(GZ(2)-GZ(1))/CPN(1))
-        FT(1)=FT(1)-0.5*LVCP(1)*SIGD*(EVAP(1)+EVAP(2))
-        FT(1)=FT(1)-0.09*SIGD*MP(2)*T(1)*B(1)*DPINV
-      FT(1)=FT(1)+0.01*SIGD*WT(1)*(CL-CPD)*WATER(2)*(T(2)-
-     1   T(1))*DPINV/CPN(1)
-        FR(1)=0.1*MP(2)*(RP(2)-RR(1))*
-     1    DPINV+SIGD*0.5*(EVAP(1)+EVAP(2))
-        FR(1)=FR(1)+0.1*AM*(RR(2)-RR(1))*DPINV
-        FU(1)=FU(1)+0.1*DPINV*(MP(2)*(UP(2)-U(1))+AM*(U(2)-U(1)))
-        FV(1)=FV(1)+0.1*DPINV*(MP(2)*(VP(2)-V(1))+AM*(V(2)-V(1)))
-        DO J=1,NTRA
-         FTRA(1,J)=FTRA(1,J)+0.1*DPINV*(MP(2)*(TRAP(2,J)-TRA(1,J))+
-     1    AM*(TRA(2,J)-TRA(1,J)))
-        END DO
-        AMDE=0.0
-        DO 415 J=2,INB
-         FR(1)=FR(1)+0.1*DPINV*MENT(J,1)*(QENT(J,1)-RR(1))
-         FU(1)=FU(1)+0.1*DPINV*MENT(J,1)*(UENT(J,1)-U(1))
-         FV(1)=FV(1)+0.1*DPINV*MENT(J,1)*(VENT(J,1)-V(1))
-         DO K=1,NTRA
-          FTRA(1,K)=FTRA(1,K)+0.1*DPINV*MENT(J,1)*(TRAENT(J,1,K)-
-     1     TRA(1,K))
-         END DO
-  415      CONTINUE
-C
-C   ***  CALCULATE TENDENCIES OF POTENTIAL TEMPERATURE AND MIXING RATIO  ***
-C   ***               AT LEVELS ABOVE THE LOWEST LEVEL                   ***
-C
-C   ***  FIRST FIND THE NET SATURATED UPDRAFT AND DOWNDRAFT MASS FLUXES  ***
-C   ***                      THROUGH EACH LEVEL                          ***
-C
- 
- 
-        DO 500 I=2,INB
-        DPINV=1.0/(PH(I)-PH(I+1))
-      CPINV=1.0/CPN(I)
-        AMP1=0.0
-        DO 440 K=I+1,INB+1
-  440   AMP1=AMP1+M(K)
-        DO 450 K=1,I
-        DO 450 J=I+1,INB+1
-         AMP1=AMP1+MENT(K,J)
-  450   CONTINUE
-      IF((0.1*DPINV*AMP1).GE.DELTI)IFLAG=4
-        AD=0.0
-        DO 470 K=1,I-1
-        DO 470 J=I,INB
-  470   AD=AD+MENT(J,K)
-      FT(I)=0.1*DPINV*(AMP1*(T(I+1)-T(I)+(GZ(I+1)-GZ(I))*
-     1   CPINV)-AD*(T(I)-T(I-1)+(GZ(I)-GZ(I-1))*CPINV))
-     2   -0.5*SIGD*LVCP(I)*(EVAP(I)+EVAP(I+1))
-      RAT=CPN(I-1)*CPINV
-        FT(I)=FT(I)-0.09*SIGD*(MP(I+1)*T(I)*
-     1    B(I)-MP(I)*T(I-1)*RAT*B(I-1))*DPINV
-      FT(I)=FT(I)+0.1*DPINV*MENT(I,I)*(HP(I)-H(I)+
-     1    T(I)*(CPV-CPD)*(RR(I)-QENT(I,I)))*CPINV
-      FT(I)=FT(I)+0.01*SIGD*WT(I)*(CL-CPD)*WATER(I+1)*
-     1    (T(I+1)-T(I))*DPINV*CPINV
-        FR(I)=0.1*DPINV*(AMP1*(RR(I+1)-RR(I))-
-     1    AD*(RR(I)-RR(I-1)))
-        FU(I)=FU(I)+0.1*DPINV*(AMP1*(U(I+1)-U(I))-
-     1    AD*(U(I)-U(I-1)))
-        FV(I)=FV(I)+0.1*DPINV*(AMP1*(V(I+1)-V(I))-
-     1    AD*(V(I)-V(I-1)))
-        DO K=1,NTRA
-         FTRA(I,K)=FTRA(I,K)+0.1*DPINV*(AMP1*(TRA(I+1,K)-
-     1    TRA(I,K))-AD*(TRA(I,K)-TRA(I-1,K)))
-        END DO
-        DO 480 K=1,I-1
-       AWAT=ELIJ(K,I)-(1.-EP(I))*CLW(I)
-       AWAT=AMAX1(AWAT,0.0)
-         FR(I)=FR(I)+0.1*DPINV*MENT(K,I)*(QENT(K,I)-AWAT
-     1    -RR(I))
-         FU(I)=FU(I)+0.1*DPINV*MENT(K,I)*(UENT(K,I)-U(I))
-         FV(I)=FV(I)+0.1*DPINV*MENT(K,I)*(VENT(K,I)-V(I))
-         DO J=1,NTRA
-          FTRA(I,J)=FTRA(I,J)+0.1*DPINV*MENT(K,I)*(TRAENT(K,I,J)-
-     1     TRA(I,J))
-         END DO
-  480   CONTINUE
-      DO 490 K=I,INB
-       FR(I)=FR(I)+0.1*DPINV*MENT(K,I)*(QENT(K,I)-RR(I))
-         FU(I)=FU(I)+0.1*DPINV*MENT(K,I)*(UENT(K,I)-U(I))
-         FV(I)=FV(I)+0.1*DPINV*MENT(K,I)*(VENT(K,I)-V(I))
-         DO J=1,NTRA
-          FTRA(I,J)=FTRA(I,J)+0.1*DPINV*MENT(K,I)*(TRAENT(K,I,J)-
-     1     TRA(I,J))
-         END DO
-  490      CONTINUE
-        FR(I)=FR(I)+0.5*SIGD*(EVAP(I)+EVAP(I+1))+0.1*(MP(I+1)*
-     1    (RP(I+1)-RR(I))-MP(I)*(RP(I)-RR(I-1)))*DPINV
-        FU(I)=FU(I)+0.1*(MP(I+1)*(UP(I+1)-U(I))-MP(I)*
-     1    (UP(I)-U(I-1)))*DPINV
-        FV(I)=FV(I)+0.1*(MP(I+1)*(VP(I+1)-V(I))-MP(I)*
-     1    (VP(I)-V(I-1)))*DPINV
-        DO J=1,NTRA
-         FTRA(I,J)=FTRA(I,J)+0.1*DPINV*(MP(I+1)*(TRAP(I+1,J)-TRA(I,J))-
-     1    MP(I)*(TRAP(I,J)-TRAP(I-1,J)))
-        END DO
-  500   CONTINUE
- 
- 
- 
-C
-C   ***   MOVE THE DETRAINMENT AT LEVEL INB DOWN TO LEVEL INB-1   ***
-C   ***        IN SUCH A WAY AS TO PRESERVE THE VERTICALLY        ***
-C   ***          INTEGRATED ENTHALPY AND WATER TENDENCIES         ***
-C
-      AX=0.1*MENT(INB,INB)*(HP(INB)-H(INB)+T(INB)*
-     1    (CPV-CPD)*(RR(INB)-QENT(INB,INB)))/(CPN(INB)*
-     2    (PH(INB)-PH(INB+1)))
-      FT(INB)=FT(INB)-AX
-      FT(INB-1)=FT(INB-1)+AX*CPN(INB)*(PH(INB)-PH(INB+1))/
-     1    (CPN(INB-1)*(PH(INB-1)-PH(INB)))
-      BX=0.1*MENT(INB,INB)*(QENT(INB,INB)-RR(INB))/
-     1    (PH(INB)-PH(INB+1))
-      FR(INB)=FR(INB)-BX
-      FR(INB-1)=FR(INB-1)+BX*(PH(INB)-PH(INB+1))/
-     1    (PH(INB-1)-PH(INB))
-      CX=0.1*MENT(INB,INB)*(UENT(INB,INB)-U(INB))/
-     1    (PH(INB)-PH(INB+1))
-      FU(INB)=FU(INB)-CX
-      FU(INB-1)=FU(INB-1)+CX*(PH(INB)-PH(INB+1))/
-     1    (PH(INB-1)-PH(INB))
-      DX=0.1*MENT(INB,INB)*(VENT(INB,INB)-V(INB))/
-     1    (PH(INB)-PH(INB+1))
-      FV(INB)=FV(INB)-DX
-      FV(INB-1)=FV(INB-1)+DX*(PH(INB)-PH(INB+1))/
-     1    (PH(INB-1)-PH(INB))
-      DO J=1,NTRA
-      EX=0.1*MENT(INB,INB)*(TRAENT(INB,INB,J)
-     1    -TRA(INB,J))/(PH(INB)-PH(INB+1))
-      FTRA(INB,J)=FTRA(INB,J)-EX
-      FTRA(INB-1,J)=FTRA(INB-1,J)+EX*
-     1     (PH(INB)-PH(INB+1))/(PH(INB-1)-PH(INB))
-      ENDDO   
-C
-C   ***    HOMOGINIZE TENDENCIES BELOW CLOUD BASE    ***
-C
-      ASUM=0.0
-      BSUM=0.0
-      CSUM=0.0
-        DSUM=0.0
-      DO 650 I=1,ICB-1
-       ASUM=ASUM+FT(I)*(PH(I)-PH(I+1))
-         BSUM=BSUM+FR(I)*(LV(I)+(CL-CPD)*(T(I)-T(1)))*
-     1    (PH(I)-PH(I+1))
-       CSUM=CSUM+(LV(I)+(CL-CPD)*(T(I)-T(1)))*(PH(I)-PH(I+1))
-       DSUM=DSUM+T(I)*(PH(I)-PH(I+1))/TH(I)
-  650      CONTINUE
-      DO 700 I=1,ICB-1
-       FT(I)=ASUM*T(I)/(TH(I)*DSUM)
-       FR(I)=BSUM/CSUM
-  700      CONTINUE
-C
-C   ***           RESET COUNTER AND RETURN           ***
-C
-      SIG(ND)=2.0
-c
-c
-      do i = 1, nd
-         upwd(i) = 0.0
-         dnwd(i) = 0.0
-c sb       dnwd0(i) = - mp(i)
-      enddo
-c
-      do i = 1, nl
-       dnwd0(i) = - mp(i)
-      enddo
-      do i = nl+1, nd
-       dnwd0(i) = 0.
-      enddo
-c
-      do i = icb, inb
-         upwd(i) = 0.0
-         dnwd(i) = 0.0
-
-         do k =i, inb
-            up1=0.0
-            dn1=0.0
-            do n = 1, i-1
-               up1 = up1 + ment(n,k)
-               dn1 = dn1 - ment(k,n)
-            enddo
-            upwd(i) = upwd(i)+ m(k) + up1
-            dnwd(i) = dnwd(i) + dn1
-         enddo
-        enddo
- 
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-c        DETERMINATION DE LA VARIATION DE FLUX ASCENDANT ENTRE
-C        DEUX NIVEAU NON DILUE Mike
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- 
- 
-c sb      do i=1,ND
-c sb      Mike(i)=M(i)
-c sb      enddo
- 
-      do i = 1, NL
-       Mike(i) = M(i)
-      enddo
-      do i = NL+1, ND
-       Mike(i) = 0.
-      enddo
- 
-      do i=1,nd
-      Ma(i)=0
-      enddo
- 
-c sb      do i=1,nd
-c sb      do j=i,nd
-c sb      Ma(i)=Ma(i)+M(j)
-c sb      enddo
-c sb      enddo
-
-      do i = 1, NL
-      do j = i, NL
-       Ma(i) = Ma(i) + M(j)
-      enddo
-      enddo
-c
-      do i = NL+1, ND
-       Ma(i) = 0.
-      enddo
-c 
-      do i=1,ICB-1
-      Ma(i)=0
-      enddo
- 
- 
- 
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-C        ICB REPRESENTE DE NIVEAU OU SE TROUVE LA
-c        BASE DU NUAGE , ET INB LE TOP DU NUAGE
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- 
- 
-       do i=1,ND
-       Mke(i)=upwd(i)+dnwd(i)
-       enddo
-c$$$cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-c$$$         call writeg1d(1,klev,ma,'ma  ','ma  ')
-c$$$          call writeg1d(1,klev,upwd,'upwd  ','upwd  ')
-c$$$          call writeg1d(1,klev,dnwd,'dnwd  ','dnwd  ')
-c$$$          call writeg1d(1,klev,dnwd0,'dnwd0  ','dnwd0  ')
-c$$$          call writeg1d(1,klev,tvp,'tvp  ','tvp  ')
-c$$$          call writeg1d(1,klev,tra(1:klev,3),'tra3  ','tra3  ')
-c$$$          call writeg1d(1,klev,tra(1:klev,4),'tra4  ','tra4  ')
-c$$$          call writeg1d(1,klev,tra(1:klev,5),'tra5  ','tra5  ')
-c$$$          call writeg1d(1,klev,tra(1:klev,6),'tra6  ','tra6  ')
-c$$$          call writeg1d(1,klev,tra(1:klev,7),'tra7  ','tra7  ')
-c$$$          call writeg1d(1,klev,tra(1:klev,8),'tra8  ','tra8  ')
-c$$$          call writeg1d(1,klev,tra(1:klev,9),'tra9  ','tra9  ')
-c$$$          call writeg1d(1,klev,tra(1:klev,10),'tra10','tra10')
-c$$$          call writeg1d(1,klev,tra(1:klev,11),'tra11','tra11')
-c$$$          call writeg1d(1,klev,tra(1:klev,12),'tra12','tra12')
-c$$$          call writeg1d(1,klev,tra(1:klev,13),'tra13','tra13')
-c$$$          call writeg1d(1,klev,tra(1:klev,14),'tra14','tra14')
-c$$$          call writeg1d(1,klev,tra(1:klev,15),'tra15','tra15')
-c$$$          call writeg1d(1,klev,tra(1:klev,16),'tra16','tra16')
-c$$$          call writeg1d(1,klev,tra(1:klev,17),'tra17','tra17')
-c$$$          call writeg1d(1,klev,tra(1:klev,18),'tra18','tra18')
-c$$$          call writeg1d(1,klev,tra(1:klev,19),'tra19','tra19')
-c$$$          call writeg1d(1,klev,tra(1:klev,20),'tra20','tra20 ')
-c$$$          call writeg1d(1,klev,trap(1:klev,1),'trp1','trp1')
-c$$$          call writeg1d(1,klev,trap(1:klev,2),'trp2','trp2')
-c$$$          call writeg1d(1,klev,trap(1:klev,3),'trp3','trp3')
-c$$$          call writeg1d(1,klev,trap(1:klev,4),'trp4','trp4')
-c$$$          call writeg1d(1,klev,trap(1:klev,5),'trp5','trp5')
-c$$$          call writeg1d(1,klev,trap(1:klev,10),'trp10','trp10')
-c$$$          call writeg1d(1,klev,trap(1:klev,12),'trp12','trp12')
-c$$$          call writeg1d(1,klev,trap(1:klev,15),'trp15','trp15')
-c$$$          call writeg1d(1,klev,trap(1:klev,20),'trp20','trp20')
-c$$$          call writeg1d(1,klev,ftra(1:klev,1),'ftr1  ','ftr1  ')
-c$$$          call writeg1d(1,klev,ftra(1:klev,2),'ftr2  ','ftr2  ')
-c$$$          call writeg1d(1,klev,ftra(1:klev,3),'ftr3  ','ftr3  ')
-c$$$          call writeg1d(1,klev,ftra(1:klev,4),'ftr4  ','ftr4  ')
-c$$$          call writeg1d(1,klev,ftra(1:klev,5),'ftr5  ','ftr5  ')
-c$$$          call writeg1d(1,klev,ftra(1:klev,6),'ftr6  ','ftr6  ')
-c$$$          call writeg1d(1,klev,ftra(1:klev,7),'ftr7  ','ftr7  ')
-c$$$          call writeg1d(1,klev,ftra(1:klev,8),'ftr8  ','ftr8  ')
-c$$$          call writeg1d(1,klev,ftra(1:klev,9),'ftr9  ','ftr9  ')
-c$$$          call writeg1d(1,klev,ftra(1:klev,10),'ftr10','ftr10')
-c$$$          call writeg1d(1,klev,ftra(1:klev,11),'ftr11','ftr11')
-c$$$          call writeg1d(1,klev,ftra(1:klev,12),'ftr12','ftr12')
-c$$$          call writeg1d(1,klev,ftra(1:klev,13),'ftr13','ftr13')
-c$$$          call writeg1d(1,klev,ftra(1:klev,14),'ftr14','ftr14')
-c$$$          call writeg1d(1,klev,ftra(1:klev,15),'ftr15','ftr15')
-c$$$          call writeg1d(1,klev,ftra(1:klev,16),'ftr16','ftr16')
-c$$$          call writeg1d(1,klev,ftra(1:klev,17),'ftr17','ftr17')
-c$$$          call writeg1d(1,klev,ftra(1:klev,18),'ftr18','ftr18')
-c$$$          call writeg1d(1,klev,ftra(1:klev,19),'ftr19','ftr19')
-c$$$          call writeg1d(1,klev,ftra(1:klev,20),'ftr20','ftr20 ')
-c$$$          call writeg1d(1,klev,mp,'mp  ','mp ')
-c$$$          call writeg1d(1,klev,Mke,'Mke  ','Mke ')
-
- 
- 
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-c
-c
-        RETURN
-        END
-C ---------------------------------------------------------------------------
Index: LMDZ.3.3/branches/rel-/libf/phylmd/cv3_routines.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/cv3_routines.F	(revision 416)
+++ 	(revision )
@@ -1,3027 +1,0 @@
-      SUBROUTINE cv3_param(nd,delt)
-      implicit none
-
-c------------------------------------------------------------
-c Set parameters for convectL for iflag_con = 3 
-c------------------------------------------------------------
-
-C
-C   ***  PBCRIT IS THE CRITICAL CLOUD DEPTH (MB) BENEATH WHICH THE ***
-C   ***      PRECIPITATION EFFICIENCY IS ASSUMED TO BE ZERO     ***
-C   ***  PTCRIT IS THE CLOUD DEPTH (MB) ABOVE WHICH THE PRECIP. ***     
-C   ***            EFFICIENCY IS ASSUMED TO BE UNITY            ***
-C   ***  SIGD IS THE FRACTIONAL AREA COVERED BY UNSATURATED DNDRAFT  ***
-C   ***  SPFAC IS THE FRACTION OF PRECIPITATION FALLING OUTSIDE ***     
-C   ***                        OF CLOUD                         ***
-C
-C [TAU: CHARACTERISTIC TIMESCALE USED TO COMPUTE ALPHA & BETA]
-C   ***    ALPHA AND BETA ARE PARAMETERS THAT CONTROL THE RATE OF ***
-C   ***                 APPROACH TO QUASI-EQUILIBRIUM           ***
-C   ***    (THEIR STANDARD VALUES ARE 1.0 AND 0.96, RESPECTIVELY) ***
-C   ***           (BETA MUST BE LESS THAN OR EQUAL TO 1)        ***
-C
-C   ***    DTCRIT IS THE CRITICAL BUOYANCY (K) USED TO ADJUST THE ***
-C   ***                 APPROACH TO QUASI-EQUILIBRIUM           ***
-C   ***                     IT MUST BE LESS THAN 0              ***
-
-#include "cvparam3.h"
-
-      integer nd
-      real delt ! timestep (seconds)
-
-c noff: integer limit for convection (nd-noff)
-c minorig: First level of convection
-
-c -- limit levels for convection:
-
-      noff    = 1
-      minorig = 1
-      nl=nd-noff
-      nlp=nl+1
-      nlm=nl-1
-
-c -- "microphysical" parameters:
-
-      sigd   = 0.01
-      spfac  = 0.15
-      pbcrit = 150.0
-      ptcrit = 500.0
-      epmax  = 0.993
-
-      omtrain = 45.0 ! used also for snow (no disctinction rain/snow)
-
-c -- misc:
-
-      dtovsh = -0.2 ! dT for overshoot
-      dpbase = -40. ! definition cloud base (400m above LCL)
-      dttrig = 5.   ! (loose) condition for triggering 
-
-c -- rate of approach to quasi-equilibrium:
-
-      dtcrit = -2.0
-      tau    = 8000.
-      beta   = 1.0 - delt/tau
-      alpha  = 1.5E-3 * delt/tau
-c increase alpha to compensate W decrease:
-      alpha  = alpha*1.5
-
-c -- interface cloud parameterization:
-
-      delta=0.01  ! cld
-
-c -- interface with boundary-layer (gust factor): (sb)
-
-      betad=10.0   ! original value (from convect 4.3)
-
-      return
-      end
-
-      SUBROUTINE cv3_prelim(len,nd,ndp1,t,q,p,ph
-     :                    ,lv,cpn,tv,gz,h,hm,th)
-      implicit none
-
-!=====================================================================
-! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
-! "ori": from convect4.3 (vectorized)
-! "convect3": to be exactly consistent with convect3
-!=====================================================================
-
-c inputs:
-      integer len, nd, ndp1
-      real t(len,nd), q(len,nd), p(len,nd), ph(len,ndp1)
-
-c outputs:
-      real lv(len,nd), cpn(len,nd), tv(len,nd)
-      real gz(len,nd), h(len,nd), hm(len,nd)
-      real th(len,nd)
-
-c local variables:
-      integer k, i
-      real rdcp
-      real tvx,tvy ! convect3
-      real cpx(len,nd)
-
-#include "cvthermo.h"
-#include "cvparam3.h"
-
-
-c ori      do 110 k=1,nlp
-      do 110 k=1,nl ! convect3
-        do 100 i=1,len
-cdebug          lv(i,k)= lv0-clmcpv*(t(i,k)-t0)
-          lv(i,k)= lv0-clmcpv*(t(i,k)-273.15)
-          cpn(i,k)=cpd*(1.0-q(i,k))+cpv*q(i,k)
-          cpx(i,k)=cpd*(1.0-q(i,k))+cl*q(i,k)
-c ori          tv(i,k)=t(i,k)*(1.0+q(i,k)*epsim1)
-          tv(i,k)=t(i,k)*(1.0+q(i,k)/eps-q(i,k))
-          rdcp=(rrd*(1.-q(i,k))+q(i,k)*rrv)/cpn(i,k)
-          th(i,k)=t(i,k)*(1000.0/p(i,k))**rdcp
- 100    continue
- 110  continue
-c
-c gz = phi at the full levels (same as p).
-c
-      do 120 i=1,len
-        gz(i,1)=0.0
- 120  continue
-c ori      do 140 k=2,nlp
-      do 140 k=2,nl ! convect3
-        do 130 i=1,len
-        tvx=t(i,k)*(1.+q(i,k)/eps-q(i,k))       !convect3
-        tvy=t(i,k-1)*(1.+q(i,k-1)/eps-q(i,k-1)) !convect3
-        gz(i,k)=gz(i,k-1)+0.5*rrd*(tvx+tvy)     !convect3
-     &          *(p(i,k-1)-p(i,k))/ph(i,k)      !convect3
-
-c ori         gz(i,k)=gz(i,k-1)+hrd*(tv(i,k-1)+tv(i,k))
-c ori    &         *(p(i,k-1)-p(i,k))/ph(i,k)
- 130    continue
- 140  continue
-c
-c h  = phi + cpT (dry static energy).
-c hm = phi + cp(T-Tbase)+Lq
-c
-c ori      do 170 k=1,nlp
-      do 170 k=1,nl ! convect3
-        do 160 i=1,len
-          h(i,k)=gz(i,k)+cpn(i,k)*t(i,k)
-          hm(i,k)=gz(i,k)+cpx(i,k)*(t(i,k)-t(i,1))+lv(i,k)*q(i,k)
- 160    continue
- 170  continue
-
-      return
-      end
-
-      SUBROUTINE cv3_feed(len,nd,t,q,qs,p,ph,hm,gz
-     :                  ,nk,icb,icbmax,iflag,tnk,qnk,gznk,plcl)
-      implicit none
-
-C================================================================
-C Purpose: CONVECTIVE FEED
-C
-C Main differences with cv_feed:
-C   - ph added in input
-C	- here, nk(i)=minorig
-C	- icb defined differently (plcl compared with ph instead of p)
-C
-C Main differences with convect3:
-C 	- we do not compute dplcldt and dplcldr of CLIFT anymore 
-C	- values iflag different (but tests identical)
-C   - A,B explicitely defined (!...)
-C================================================================
-
-#include "cvparam3.h"
-
-c inputs:
-	  integer len, nd
-      real t(len,nd), q(len,nd), qs(len,nd), p(len,nd)
-      real hm(len,nd), gz(len,nd)
-      real ph(len,nd+1)
-
-c outputs:
-	  integer iflag(len), nk(len), icb(len), icbmax
-      real tnk(len), qnk(len), gznk(len), plcl(len)
-
-c local variables:
-      integer i, k
-      integer ihmin(len)
-      real work(len)
-      real pnk(len), qsnk(len), rh(len), chi(len)
-      real A, B ! convect3
-
-c@ !-------------------------------------------------------------------
-c@ ! --- Find level of minimum moist static energy
-c@ ! --- If level of minimum moist static energy coincides with
-c@ ! --- or is lower than minimum allowable parcel origin level,
-c@ ! --- set iflag to 6.
-c@ !-------------------------------------------------------------------
-c@ 
-c@       do 180 i=1,len
-c@        work(i)=1.0e12
-c@        ihmin(i)=nl
-c@  180  continue
-c@       do 200 k=2,nlp
-c@         do 190 i=1,len
-c@          if((hm(i,k).lt.work(i)).and.
-c@      &      (hm(i,k).lt.hm(i,k-1)))then
-c@            work(i)=hm(i,k)
-c@            ihmin(i)=k
-c@          endif
-c@  190    continue
-c@  200  continue
-c@       do 210 i=1,len
-c@         ihmin(i)=min(ihmin(i),nlm)
-c@         if(ihmin(i).le.minorig)then
-c@           iflag(i)=6
-c@         endif
-c@  210  continue
-c@ c
-c@ !-------------------------------------------------------------------
-c@ ! --- Find that model level below the level of minimum moist static
-c@ ! --- energy that has the maximum value of moist static energy
-c@ !-------------------------------------------------------------------
-c@  
-c@       do 220 i=1,len
-c@        work(i)=hm(i,minorig)
-c@        nk(i)=minorig
-c@  220  continue
-c@       do 240 k=minorig+1,nl
-c@         do 230 i=1,len
-c@          if((hm(i,k).gt.work(i)).and.(k.le.ihmin(i)))then
-c@            work(i)=hm(i,k)
-c@            nk(i)=k
-c@          endif
-c@  230     continue
-c@  240  continue
-
-!-------------------------------------------------------------------
-! --- Origin level of ascending parcels for convect3:
-!-------------------------------------------------------------------
-
-         do 220 i=1,len
-          nk(i)=minorig
-  220    continue
-
-!-------------------------------------------------------------------
-! --- Check whether parcel level temperature and specific humidity
-! --- are reasonable
-!-------------------------------------------------------------------
-       do 250 i=1,len
-       if( (     ( t(i,nk(i)).lt.250.0    )
-     &       .or.( q(i,nk(i)).le.0.0      )     )
-c@      &       .or.( p(i,ihmin(i)).lt.400.0 )  )
-     &   .and.
-     &       ( iflag(i).eq.0) ) iflag(i)=7
- 250   continue
-!-------------------------------------------------------------------
-! --- Calculate lifted condensation level of air at parcel origin level
-! --- (Within 0.2% of formula of Bolton, MON. WEA. REV.,1980)
-!-------------------------------------------------------------------
-
-       A = 1669.0 ! convect3
-       B = 122.0  ! convect3
-
-       do 260 i=1,len
-
-        if (iflag(i).ne.7) then ! modif sb Jun7th 2002
-
-        tnk(i)=t(i,nk(i))
-        qnk(i)=q(i,nk(i))
-        gznk(i)=gz(i,nk(i))
-        pnk(i)=p(i,nk(i))
-        qsnk(i)=qs(i,nk(i))
-c
-        rh(i)=qnk(i)/qsnk(i)
-c ori        rh(i)=min(1.0,rh(i)) ! removed for convect3
-c ori        chi(i)=tnk(i)/(1669.0-122.0*rh(i)-tnk(i))
-        chi(i)=tnk(i)/(A-B*rh(i)-tnk(i)) ! convect3
-        plcl(i)=pnk(i)*(rh(i)**chi(i))
-        if(((plcl(i).lt.200.0).or.(plcl(i).ge.2000.0))
-     &   .and.(iflag(i).eq.0))iflag(i)=8
- 
-        endif ! iflag=7  
-
- 260   continue
-
-!-------------------------------------------------------------------
-! --- Calculate first level above lcl (=icb)
-!-------------------------------------------------------------------
-
-c@      do 270 i=1,len
-c@       icb(i)=nlm
-c@ 270  continue
-c@c
-c@      do 290 k=minorig,nl
-c@        do 280 i=1,len
-c@          if((k.ge.(nk(i)+1)).and.(p(i,k).lt.plcl(i)))
-c@     &    icb(i)=min(icb(i),k)
-c@ 280    continue
-c@ 290  continue
-c@c
-c@      do 300 i=1,len
-c@        if((icb(i).ge.nlm).and.(iflag(i).eq.0))iflag(i)=9
-c@ 300  continue
-
-      do 270 i=1,len
-       icb(i)=nlm
- 270  continue
-c
-c la modification consiste a comparer plcl a ph et non a p:
-c icb est defini par :  ph(icb)<plcl<ph(icb-1)
-c@      do 290 k=minorig,nl
-      do 290 k=3,nl-1 ! modif pour que icb soit sup/egal a 2
-        do 280 i=1,len
-          if( ph(i,k).lt.plcl(i) ) icb(i)=min(icb(i),k)
- 280    continue
- 290  continue
-c
-      do 300 i=1,len
-c@        if((icb(i).ge.nlm).and.(iflag(i).eq.0))iflag(i)=9
-        if((icb(i).eq.nlm).and.(iflag(i).eq.0))iflag(i)=9
- 300  continue
-
-      do 400 i=1,len
-        icb(i) = icb(i)-1 ! icb sup ou egal a 2
- 400  continue
-c
-c Compute icbmax.
-c
-      icbmax=2
-      do 310 i=1,len
-c!        icbmax=max(icbmax,icb(i))
-       if (iflag(i).lt.7) icbmax=max(icbmax,icb(i)) ! sb Jun7th02
- 310  continue
-
-      return
-      end
-
-      SUBROUTINE cv3_undilute1(len,nd,t,q,qs,gz,plcl,p,nk,icb
-     :                       ,tp,tvp,clw,icbs)
-      implicit none
-
-!----------------------------------------------------------------
-! Equivalent de TLIFT entre NK et ICB+1 inclus
-!
-! Differences with convect4:
-!		- specify plcl in input
-!       - icbs is the first level above LCL (may differ from icb)
-!       - in the iterations, used x(icbs) instead x(icb)
-!       - many minor differences in the iterations
-!		- tvp is computed in only one time
-!		- icbs: first level above Plcl (IMIN de TLIFT) in output
-!       - if icbs=icb, compute also tp(icb+1),tvp(icb+1) & clw(icb+1)
-!----------------------------------------------------------------
-
-#include "cvthermo.h"
-#include "cvparam3.h"
-
-c inputs:
-      integer len, nd
-      integer nk(len), icb(len)
-      real t(len,nd), q(len,nd), qs(len,nd), gz(len,nd)
-      real p(len,nd) 
-      real plcl(len) ! convect3
-
-c outputs:
-      real tp(len,nd), tvp(len,nd), clw(len,nd)
-
-c local variables:
-      integer i, k
-      integer icb1(len), icbs(len), icbsmax2 ! convect3
-      real tg, qg, alv, s, ahg, tc, denom, es, rg
-      real ah0(len), cpp(len)
-      real tnk(len), qnk(len), gznk(len), ticb(len), gzicb(len)
-      real qsicb(len) ! convect3
-      real cpinv(len) ! convect3
-
-!-------------------------------------------------------------------
-! --- Calculates the lifted parcel virtual temperature at nk,
-! --- the actual temperature, and the adiabatic
-! --- liquid water content. The procedure is to solve the equation.
-!     cp*tp+L*qp+phi=cp*tnk+L*qnk+gznk.
-!-------------------------------------------------------------------
-
-      do 320 i=1,len
-        tnk(i)=t(i,nk(i))
-        qnk(i)=q(i,nk(i))
-        gznk(i)=gz(i,nk(i))
-c ori        ticb(i)=t(i,icb(i))
-c ori        gzicb(i)=gz(i,icb(i))
- 320  continue
-c
-c   ***  Calculate certain parcel quantities, including static energy   ***
-c
-      do 330 i=1,len
-        ah0(i)=(cpd*(1.-qnk(i))+cl*qnk(i))*tnk(i)
-     &         +qnk(i)*(lv0-clmcpv*(tnk(i)-273.15))+gznk(i)
-        cpp(i)=cpd*(1.-qnk(i))+qnk(i)*cpv
-        cpinv(i)=1./cpp(i)
- 330  continue
-c
-c   ***   Calculate lifted parcel quantities below cloud base   ***
-c
-        do i=1,len                      !convect3
-         icb1(i)=MAX(icb(i),2)          !convect3
-         icb1(i)=MIN(icb(i),nl)         !convect3
-c if icb is below LCL, start loop at ICB+1:
-c (icbs est le premier niveau au-dessus du LCL)
-         icbs(i)=icb1(i)                !convect3
-         if (plcl(i).lt.p(i,icb1(i))) then
-             icbs(i)=MIN(icbs(i)+1,nl)  !convect3
-         endif
-        enddo                           !convect3
-
-        do i=1,len                      !convect3
-         ticb(i)=t(i,icbs(i))           !convect3
-         gzicb(i)=gz(i,icbs(i))         !convect3
-         qsicb(i)=qs(i,icbs(i))         !convect3
-        enddo                           !convect3
-
-c
-c Re-compute icbsmax (icbsmax2):        !convect3
-c                                       !convect3
-      icbsmax2=2                        !convect3
-      do 310 i=1,len                    !convect3
-        icbsmax2=max(icbsmax2,icbs(i))  !convect3
- 310  continue                          !convect3
-
-c initialization outputs:
-
-      do k=1,icbsmax2     ! convect3
-       do i=1,len         ! convect3
-        tp(i,k)  = 0.0    ! convect3
-        tvp(i,k) = 0.0    ! convect3
-        clw(i,k) = 0.0    ! convect3
-       enddo              ! convect3
-      enddo               ! convect3
-
-c tp and tvp below cloud base:
-
-        do 350 k=minorig,icbsmax2-1
-          do 340 i=1,len
-           tp(i,k)=tnk(i)-(gz(i,k)-gznk(i))*cpinv(i)
-           tvp(i,k)=tp(i,k)*(1.+qnk(i)/eps-qnk(i)) !whole thing (convect3)
-  340     continue
-  350   continue
-c
-c    ***  Find lifted parcel quantities above cloud base    ***
-c
-        do 360 i=1,len
-         tg=ticb(i)
-c ori         qg=qs(i,icb(i))
-         qg=qsicb(i) ! convect3
-cdebug         alv=lv0-clmcpv*(ticb(i)-t0)
-         alv=lv0-clmcpv*(ticb(i)-273.15)
-c
-c First iteration.
-c
-c ori          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
-          s=cpd*(1.-qnk(i))+cl*qnk(i)         ! convect3
-     :      +alv*alv*qg/(rrv*ticb(i)*ticb(i)) ! convect3
-          s=1./s
-c ori          ahg=cpd*tg+(cl-cpd)*qnk(i)*ticb(i)+alv*qg+gzicb(i)
-          ahg=cpd*tg+(cl-cpd)*qnk(i)*tg+alv*qg+gzicb(i) ! convect3
-          tg=tg+s*(ah0(i)-ahg)
-c ori          tg=max(tg,35.0)
-cdebug          tc=tg-t0
-          tc=tg-273.15
-          denom=243.5+tc
-          denom=MAX(denom,1.0) ! convect3
-c ori          if(tc.ge.0.0)then
-           es=6.112*exp(17.67*tc/denom)
-c ori          else
-c ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-c ori          endif
-c ori          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
-          qg=eps*es/(p(i,icbs(i))-es*(1.-eps))
-c
-c Second iteration.
-c
-
-c ori          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
-c ori          s=1./s
-c ori          ahg=cpd*tg+(cl-cpd)*qnk(i)*ticb(i)+alv*qg+gzicb(i)
-          ahg=cpd*tg+(cl-cpd)*qnk(i)*tg+alv*qg+gzicb(i) ! convect3
-          tg=tg+s*(ah0(i)-ahg)
-c ori          tg=max(tg,35.0)
-cdebug          tc=tg-t0
-          tc=tg-273.15
-          denom=243.5+tc
-          denom=MAX(denom,1.0) ! convect3
-c ori          if(tc.ge.0.0)then
-           es=6.112*exp(17.67*tc/denom)
-c ori          else
-c ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-c ori          end if
-c ori          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
-          qg=eps*es/(p(i,icbs(i))-es*(1.-eps))
-
-         alv=lv0-clmcpv*(ticb(i)-273.15)
-
-c ori c approximation here:
-c ori         tp(i,icb(i))=(ah0(i)-(cl-cpd)*qnk(i)*ticb(i)
-c ori     &   -gz(i,icb(i))-alv*qg)/cpd
-
-c convect3: no approximation:
-         tp(i,icbs(i))=(ah0(i)-gz(i,icbs(i))-alv*qg)
-     :                /(cpd+(cl-cpd)*qnk(i))
-
-c ori         clw(i,icb(i))=qnk(i)-qg
-c ori         clw(i,icb(i))=max(0.0,clw(i,icb(i)))
-         clw(i,icbs(i))=qnk(i)-qg
-         clw(i,icbs(i))=max(0.0,clw(i,icbs(i)))
-
-         rg=qg/(1.-qnk(i))
-c ori         tvp(i,icb(i))=tp(i,icb(i))*(1.+rg*epsi)
-c convect3: (qg utilise au lieu du vrai mixing ratio rg)
-         tvp(i,icbs(i))=tp(i,icbs(i))*(1.+qg/eps-qnk(i)) !whole thing
-
-  360   continue
-c
-c ori      do 380 k=minorig,icbsmax2
-c ori       do 370 i=1,len
-c ori         tvp(i,k)=tvp(i,k)-tp(i,k)*qnk(i)
-c ori 370   continue
-c ori 380  continue
-c
-
-c -- The following is only for convect3:
-c
-c * icbs is the first level above the LCL:
-c    if plcl<p(icb), then icbs=icb+1
-c    if plcl>p(icb), then icbs=icb
-c
-c * the routine above computes tvp from minorig to icbs (included).
-c
-c * to compute buoybase (in cv3_trigger.F), both tvp(icb) and tvp(icb+1)
-c    must be known. This is the case if icbs=icb+1, but not if icbs=icb.
-c
-c * therefore, in the case icbs=icb, we compute tvp at level icb+1
-c   (tvp at other levels will be computed in cv3_undilute2.F)
-c
-
-        do i=1,len              
-         ticb(i)=t(i,icb(i)+1)   
-         gzicb(i)=gz(i,icb(i)+1) 
-         qsicb(i)=qs(i,icb(i)+1) 
-        enddo                   
-
-        do 460 i=1,len
-         tg=ticb(i)
-         qg=qsicb(i) ! convect3
-cdebug         alv=lv0-clmcpv*(ticb(i)-t0)
-         alv=lv0-clmcpv*(ticb(i)-273.15)
-c
-c First iteration.
-c
-c ori          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
-          s=cpd*(1.-qnk(i))+cl*qnk(i)         ! convect3
-     :      +alv*alv*qg/(rrv*ticb(i)*ticb(i)) ! convect3
-          s=1./s
-c ori          ahg=cpd*tg+(cl-cpd)*qnk(i)*ticb(i)+alv*qg+gzicb(i)
-          ahg=cpd*tg+(cl-cpd)*qnk(i)*tg+alv*qg+gzicb(i) ! convect3
-          tg=tg+s*(ah0(i)-ahg)
-c ori          tg=max(tg,35.0)
-cdebug          tc=tg-t0
-          tc=tg-273.15
-          denom=243.5+tc
-          denom=MAX(denom,1.0) ! convect3
-c ori          if(tc.ge.0.0)then
-           es=6.112*exp(17.67*tc/denom)
-c ori          else
-c ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-c ori          endif
-c ori          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
-          qg=eps*es/(p(i,icb(i)+1)-es*(1.-eps))
-c
-c Second iteration.
-c
-
-c ori          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
-c ori          s=1./s
-c ori          ahg=cpd*tg+(cl-cpd)*qnk(i)*ticb(i)+alv*qg+gzicb(i)
-          ahg=cpd*tg+(cl-cpd)*qnk(i)*tg+alv*qg+gzicb(i) ! convect3
-          tg=tg+s*(ah0(i)-ahg)
-c ori          tg=max(tg,35.0)
-cdebug          tc=tg-t0
-          tc=tg-273.15
-          denom=243.5+tc
-          denom=MAX(denom,1.0) ! convect3
-c ori          if(tc.ge.0.0)then
-           es=6.112*exp(17.67*tc/denom)
-c ori          else
-c ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-c ori          end if
-c ori          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
-          qg=eps*es/(p(i,icb(i)+1)-es*(1.-eps))
-
-         alv=lv0-clmcpv*(ticb(i)-273.15)
-
-c ori c approximation here:
-c ori         tp(i,icb(i))=(ah0(i)-(cl-cpd)*qnk(i)*ticb(i)
-c ori     &   -gz(i,icb(i))-alv*qg)/cpd
-
-c convect3: no approximation:
-         tp(i,icb(i)+1)=(ah0(i)-gz(i,icb(i)+1)-alv*qg)
-     :                /(cpd+(cl-cpd)*qnk(i))
-
-c ori         clw(i,icb(i))=qnk(i)-qg
-c ori         clw(i,icb(i))=max(0.0,clw(i,icb(i)))
-         clw(i,icb(i)+1)=qnk(i)-qg
-         clw(i,icb(i)+1)=max(0.0,clw(i,icb(i)+1))
-
-         rg=qg/(1.-qnk(i))
-c ori         tvp(i,icb(i))=tp(i,icb(i))*(1.+rg*epsi)
-c convect3: (qg utilise au lieu du vrai mixing ratio rg)
-         tvp(i,icb(i)+1)=tp(i,icb(i)+1)*(1.+qg/eps-qnk(i)) !whole thing
-
-  460   continue
-
-      return
-      end
-
-      SUBROUTINE cv3_trigger(len,nd,icb,plcl,p,th,tv,tvp
-     o                ,pbase,buoybase,iflag,sig,w0)
-      implicit none
-
-!-------------------------------------------------------------------
-! --- TRIGGERING
-!
-!	- computes the cloud base
-!   - triggering (crude in this version)
-!	- relaxation of sig and w0 when no convection
-!
-!	Caution1: if no convection, we set iflag=4 
-!              (it used to be 0 in convect3)
-!
-!	Caution2: at this stage, tvp (and thus buoy) are know up 
-!             through icb only!
-! -> the buoyancy below cloud base not (yet) set to the cloud base buoyancy
-!-------------------------------------------------------------------
-
-#include "cvparam3.h"
-
-c input:
-      integer len, nd
-      integer icb(len)
-      real plcl(len), p(len,nd)
-      real th(len,nd), tv(len,nd), tvp(len,nd)
-
-c output:
-      real pbase(len), buoybase(len)
-
-c input AND output:
-      integer iflag(len)
-      real sig(len,nd), w0(len,nd)
-
-c local variables:
-      integer i,k
-      real tvpbase, tvbase, tdif, ath, ath1
-
-c
-c ***   set cloud base buoyancy at (plcl+dpbase) level buoyancy
-c
-      do 100 i=1,len
-       pbase(i) = plcl(i) + dpbase
-       tvpbase = tvp(i,icb(i))*(pbase(i)-p(i,icb(i)+1))
-     :                        /(p(i,icb(i))-p(i,icb(i)+1))
-     :         + tvp(i,icb(i)+1)*(p(i,icb(i))-pbase(i))
-     :                          /(p(i,icb(i))-p(i,icb(i)+1))
-       tvbase = tv(i,icb(i))*(pbase(i)-p(i,icb(i)+1))
-     :                      /(p(i,icb(i))-p(i,icb(i)+1))
-     :        + tv(i,icb(i)+1)*(p(i,icb(i))-pbase(i))
-     :                        /(p(i,icb(i))-p(i,icb(i)+1))
-       buoybase(i) = tvpbase - tvbase
-100   continue 
-
-c
-c   ***   make sure that column is dry adiabatic between the surface  ***
-c   ***    and cloud base, and that lifted air is positively buoyant  ***
-c   ***                         at cloud base                         ***
-c   ***       if not, return to calling program after resetting       ***
-c   ***                        sig(i) and w0(i)                       ***
-c
-
-c oct3      do 200 i=1,len
-c oct3
-c oct3       tdif = buoybase(i)
-c oct3       ath1 = th(i,1)
-c oct3       ath  = th(i,icb(i)-1) - dttrig
-c oct3 
-c oct3       if (tdif.lt.dtcrit .or. ath.gt.ath1) then
-c oct3         do 60 k=1,nl
-c oct3            sig(i,k) = beta*sig(i,k) - 2.*alpha*tdif*tdif
-c oct3            sig(i,k) = AMAX1(sig(i,k),0.0)
-c oct3            w0(i,k)  = beta*w0(i,k)
-c oct3   60    continue
-c oct3         iflag(i)=4 ! pour version vectorisee
-c oct3c convect3         iflag(i)=0
-c oct3cccc         return
-c oct3       endif
-c oct3
-c oct3200   continue
- 
-c -- oct3: on reecrit la boucle 200 (pour la vectorisation)
-
-      do  60 k=1,nl
-      do 200 i=1,len
-
-       tdif = buoybase(i)
-       ath1 = th(i,1)
-       ath  = th(i,icb(i)-1) - dttrig
-
-       if (tdif.lt.dtcrit .or. ath.gt.ath1) then
-            sig(i,k) = beta*sig(i,k) - 2.*alpha*tdif*tdif
-            sig(i,k) = AMAX1(sig(i,k),0.0)
-            w0(i,k)  = beta*w0(i,k)
-        iflag(i)=4 ! pour version vectorisee
-c convect3         iflag(i)=0
-       endif
-
-200   continue
- 60   continue
-
-c fin oct3 --
-
-      return
-      end
-
-      SUBROUTINE cv3_compress( len,nloc,ncum,nd,ntra
-     :    ,iflag1,nk1,icb1,icbs1
-     :    ,plcl1,tnk1,qnk1,gznk1,pbase1,buoybase1
-     :    ,t1,q1,qs1,u1,v1,gz1,th1
-     :    ,tra1
-     :    ,h1,lv1,cpn1,p1,ph1,tv1,tp1,tvp1,clw1 
-     :    ,sig1,w01
-     o    ,iflag,nk,icb,icbs
-     o    ,plcl,tnk,qnk,gznk,pbase,buoybase
-     o    ,t,q,qs,u,v,gz,th
-     o    ,tra
-     o    ,h,lv,cpn,p,ph,tv,tp,tvp,clw 
-     o    ,sig,w0  )
-      implicit none
-
-#include "cvparam3.h"
-
-c inputs:
-      integer len,ncum,nd,ntra,nloc
-      integer iflag1(len),nk1(len),icb1(len),icbs1(len)
-      real plcl1(len),tnk1(len),qnk1(len),gznk1(len)
-      real pbase1(len),buoybase1(len)
-      real t1(len,nd),q1(len,nd),qs1(len,nd),u1(len,nd),v1(len,nd)
-      real gz1(len,nd),h1(len,nd),lv1(len,nd),cpn1(len,nd)
-      real p1(len,nd),ph1(len,nd+1),tv1(len,nd),tp1(len,nd)
-      real tvp1(len,nd),clw1(len,nd)
-      real th1(len,nd)
-      real sig1(len,nd), w01(len,nd)
-      real tra1(len,nd,ntra)
-
-c outputs:
-c en fait, on a nloc=len pour l'instant (cf cv_driver)
-      integer iflag(nloc),nk(nloc),icb(nloc),icbs(nloc)
-      real plcl(nloc),tnk(nloc),qnk(nloc),gznk(nloc)
-      real pbase(nloc),buoybase(nloc)
-      real t(nloc,nd),q(nloc,nd),qs(nloc,nd),u(nloc,nd),v(nloc,nd)
-      real gz(nloc,nd),h(nloc,nd),lv(nloc,nd),cpn(nloc,nd)
-      real p(nloc,nd),ph(nloc,nd+1),tv(nloc,nd),tp(nloc,nd)
-      real tvp(nloc,nd),clw(nloc,nd)
-      real th(nloc,nd)
-      real sig(nloc,nd), w0(nloc,nd) 
-      real tra(nloc,nd,ntra)
-
-c local variables:
-      integer i,k,nn,j
-
-
-      do 110 k=1,nl+1
-       nn=0
-      do 100 i=1,len
-      if(iflag1(i).eq.0)then
-        nn=nn+1
-        sig(nn,k)=sig1(i,k)
-        w0(nn,k)=w01(i,k)
-        t(nn,k)=t1(i,k)
-        q(nn,k)=q1(i,k)
-        qs(nn,k)=qs1(i,k)
-        u(nn,k)=u1(i,k)
-        v(nn,k)=v1(i,k)
-        gz(nn,k)=gz1(i,k)
-        h(nn,k)=h1(i,k)
-        lv(nn,k)=lv1(i,k)
-        cpn(nn,k)=cpn1(i,k)
-        p(nn,k)=p1(i,k)
-        ph(nn,k)=ph1(i,k)
-        tv(nn,k)=tv1(i,k)
-        tp(nn,k)=tp1(i,k)
-        tvp(nn,k)=tvp1(i,k)
-        clw(nn,k)=clw1(i,k)
-        th(nn,k)=th1(i,k)
-      endif
- 100    continue
- 110  continue
-
-      do 121 j=1,ntra
-ccccc      do 111 k=1,nl+1
-      do 111 k=1,nd
-       nn=0
-      do 101 i=1,len
-      if(iflag1(i).eq.0)then
-       nn=nn+1
-       tra(nn,k,j)=tra1(i,k,j)
-      endif
- 101  continue
- 111  continue
- 121  continue
-
-      if (nn.ne.ncum) then
-         print*,'strange! nn not equal to ncum: ',nn,ncum
-         stop
-      endif
-
-      nn=0
-      do 150 i=1,len
-      if(iflag1(i).eq.0)then
-      nn=nn+1
-      pbase(nn)=pbase1(i)
-      buoybase(nn)=buoybase1(i)
-      plcl(nn)=plcl1(i)
-      tnk(nn)=tnk1(i)
-      qnk(nn)=qnk1(i)
-      gznk(nn)=gznk1(i)
-      nk(nn)=nk1(i)
-      icb(nn)=icb1(i)
-      icbs(nn)=icbs1(i)
-      iflag(nn)=iflag1(i)
-      endif
- 150  continue
-
-      return
-      end
-
-      SUBROUTINE cv3_undilute2(nloc,ncum,nd,icb,icbs,nk
-     :                       ,tnk,qnk,gznk,t,q,qs,gz
-     :                       ,p,h,tv,lv,pbase,buoybase,plcl
-     o                       ,inb,tp,tvp,clw,hp,ep,sigp,buoy)
-      implicit none
-
-C---------------------------------------------------------------------
-C Purpose:
-C     FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
-C     &
-C     COMPUTE THE PRECIPITATION EFFICIENCIES AND THE 
-C     FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
-C     &
-C     FIND THE LEVEL OF NEUTRAL BUOYANCY
-C
-C Main differences convect3/convect4:
-C	- icbs (input) is the first level above LCL (may differ from icb)
-C	- many minor differences in the iterations
-C	- condensed water not removed from tvp in convect3
-C   - vertical profile of buoyancy computed here (use of buoybase)
-C   - the determination of inb is different
-C   - no inb1, only inb in output
-C---------------------------------------------------------------------
-
-#include "cvthermo.h"
-#include "cvparam3.h"
-
-c inputs:
-      integer ncum, nd, nloc
-      integer icb(nloc), icbs(nloc), nk(nloc)
-      real t(nloc,nd), q(nloc,nd), qs(nloc,nd), gz(nloc,nd)
-      real p(nloc,nd)
-      real tnk(nloc), qnk(nloc), gznk(nloc)
-      real lv(nloc,nd), tv(nloc,nd), h(nloc,nd)
-      real pbase(nloc), buoybase(nloc), plcl(nloc)
-
-c outputs:
-      integer inb(nloc)
-      real tp(nloc,nd), tvp(nloc,nd), clw(nloc,nd)
-      real ep(nloc,nd), sigp(nloc,nd), hp(nloc,nd)
-      real buoy(nloc,nd)
-
-c local variables:
-      integer i, k
-      real tg,qg,ahg,alv,s,tc,es,denom,rg,tca,elacrit
-      real by, defrac, pden
-      real ah0(nloc), cape(nloc), capem(nloc), byp(nloc)
-      logical lcape(nloc)
-
-!=====================================================================
-! --- SOME INITIALIZATIONS
-!=====================================================================
-
-      do 170 k=1,nl
-      do 160 i=1,ncum
-       ep(i,k)=0.0
-       sigp(i,k)=spfac
- 160  continue
- 170  continue
-
-!=====================================================================
-! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
-!=====================================================================
-c
-c ---       The procedure is to solve the equation.
-c              cp*tp+L*qp+phi=cp*tnk+L*qnk+gznk.
-c
-c   ***  Calculate certain parcel quantities, including static energy   ***
-c
-c
-      do 240 i=1,ncum
-         ah0(i)=(cpd*(1.-qnk(i))+cl*qnk(i))*tnk(i)
-cdebug     &         +qnk(i)*(lv0-clmcpv*(tnk(i)-t0))+gznk(i)
-     &         +qnk(i)*(lv0-clmcpv*(tnk(i)-273.15))+gznk(i)
- 240  continue
-c
-c
-c    ***  Find lifted parcel quantities above cloud base    ***
-c
-c
-	do 300 k=minorig+1,nl
-	  do 290 i=1,ncum
-c ori	    if(k.ge.(icb(i)+1))then
-	    if(k.ge.(icbs(i)+1))then ! convect3
-	      tg=t(i,k)
-	      qg=qs(i,k)
-cdebug	      alv=lv0-clmcpv*(t(i,k)-t0)
-	      alv=lv0-clmcpv*(t(i,k)-273.15)
-c
-c First iteration.
-c
-c ori	       s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
-           s=cpd*(1.-qnk(i))+cl*qnk(i)      ! convect3
-     :      +alv*alv*qg/(rrv*t(i,k)*t(i,k)) ! convect3
-	       s=1./s
-c ori	       ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
-           ahg=cpd*tg+(cl-cpd)*qnk(i)*tg+alv*qg+gz(i,k) ! convect3
-	       tg=tg+s*(ah0(i)-ahg)
-c ori	       tg=max(tg,35.0)
-cdebug	       tc=tg-t0
-	       tc=tg-273.15
-	       denom=243.5+tc
-           denom=MAX(denom,1.0) ! convect3
-c ori	       if(tc.ge.0.0)then
-			es=6.112*exp(17.67*tc/denom)
-c ori	       else
-c ori			es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-c ori	       endif
-			qg=eps*es/(p(i,k)-es*(1.-eps))
-c
-c Second iteration.
-c
-c ori	       s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
-c ori	       s=1./s
-c ori	       ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
-           ahg=cpd*tg+(cl-cpd)*qnk(i)*tg+alv*qg+gz(i,k) ! convect3
-	       tg=tg+s*(ah0(i)-ahg)
-c ori	       tg=max(tg,35.0)
-cdebug	       tc=tg-t0
-	       tc=tg-273.15
-	       denom=243.5+tc
-           denom=MAX(denom,1.0) ! convect3
-c ori	       if(tc.ge.0.0)then
-			es=6.112*exp(17.67*tc/denom)
-c ori	       else
-c ori			es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-c ori	       endif
-			qg=eps*es/(p(i,k)-es*(1.-eps))
-c
-cdebug	       alv=lv0-clmcpv*(t(i,k)-t0)
-	       alv=lv0-clmcpv*(t(i,k)-273.15)
-c      print*,'cpd dans convect2 ',cpd
-c      print*,'tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd'
-c      print*,tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd
-
-c ori c approximation here:
-c ori        tp(i,k)=(ah0(i)-(cl-cpd)*qnk(i)*t(i,k)-gz(i,k)-alv*qg)/cpd
-
-c convect3: no approximation:
-           tp(i,k)=(ah0(i)-gz(i,k)-alv*qg)/(cpd+(cl-cpd)*qnk(i))
-
-               clw(i,k)=qnk(i)-qg
-               clw(i,k)=max(0.0,clw(i,k))
-               rg=qg/(1.-qnk(i))
-c ori               tvp(i,k)=tp(i,k)*(1.+rg*epsi)
-c convect3: (qg utilise au lieu du vrai mixing ratio rg):
-               tvp(i,k)=tp(i,k)*(1.+qg/eps-qnk(i)) ! whole thing
-            endif
-  290     continue
-  300   continue
-c
-!=====================================================================
-! --- SET THE PRECIPITATION EFFICIENCIES AND THE FRACTION OF
-! --- PRECIPITATION FALLING OUTSIDE OF CLOUD
-! --- THESE MAY BE FUNCTIONS OF TP(I), P(I) AND CLW(I)
-!=====================================================================
-c
-c ori      do 320 k=minorig+1,nl
-      do 320 k=1,nl ! convect3
-        do 310 i=1,ncum
-           pden=ptcrit-pbcrit
-           ep(i,k)=(plcl(i)-p(i,k)-pbcrit)/pden*epmax
-           ep(i,k)=amax1(ep(i,k),0.0)
-           ep(i,k)=amin1(ep(i,k),epmax)
-           sigp(i,k)=spfac
-c ori          if(k.ge.(nk(i)+1))then
-c ori            tca=tp(i,k)-t0
-c ori            if(tca.ge.0.0)then
-c ori              elacrit=elcrit
-c ori            else
-c ori              elacrit=elcrit*(1.0-tca/tlcrit)
-c ori            endif
-c ori            elacrit=max(elacrit,0.0)
-c ori            ep(i,k)=1.0-elacrit/max(clw(i,k),1.0e-8)
-c ori            ep(i,k)=max(ep(i,k),0.0 )
-c ori            ep(i,k)=min(ep(i,k),1.0 )
-c ori            sigp(i,k)=sigs
-c ori          endif
- 310    continue
- 320  continue
-c
-!=====================================================================
-! --- CALCULATE VIRTUAL TEMPERATURE AND LIFTED PARCEL
-! --- VIRTUAL TEMPERATURE
-!=====================================================================
-c
-c dans convect3, tvp est calcule en une seule fois, et sans retirer
-c l'eau condensee (~> reversible CAPE)
-c
-c ori      do 340 k=minorig+1,nl
-c ori        do 330 i=1,ncum
-c ori        if(k.ge.(icb(i)+1))then
-c ori          tvp(i,k)=tvp(i,k)*(1.0-qnk(i)+ep(i,k)*clw(i,k))
-c oric         print*,'i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)'
-c oric         print*, i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)
-c ori        endif
-c ori 330    continue
-c ori 340  continue
-
-c ori      do 350 i=1,ncum
-c ori       tvp(i,nlp)=tvp(i,nl)-(gz(i,nlp)-gz(i,nl))/cpd
-c ori 350  continue
-
-      do 350 i=1,ncum       ! convect3
-       tp(i,nlp)=tp(i,nl)   ! convect3
- 350  continue              ! convect3
-c
-c=====================================================================
-c  --- EFFECTIVE VERTICAL PROFILE OF BUOYANCY (convect3 only):
-c===================================================================== 
-
-c-- this is for convect3 only:
-
-c first estimate of buoyancy:
-
-      do 500 i=1,ncum
-       do 501 k=1,nl
-        buoy(i,k)=tvp(i,k)-tv(i,k) 
- 501   continue
- 500  continue
-
-c set buoyancy=buoybase for all levels below base
-c for safety, set buoy(icb)=buoybase
-
-      do 505 i=1,ncum
-       do 506 k=1,nl
-        if((k.ge.icb(i)).and.(k.le.nl).and.(p(i,k).ge.pbase(i)))then
-         buoy(i,k)=buoybase(i)
-        endif
- 506   continue
-       buoy(icb(i),k)=buoybase(i)
- 505  continue
-
-c-- end convect3
-
-c=====================================================================
-c  --- FIND THE FIRST MODEL LEVEL (INB) ABOVE THE PARCEL'S
-c  --- LEVEL OF NEUTRAL BUOYANCY
-c=====================================================================
-c
-c-- this is for convect3 only:
-
-      do 510 i=1,ncum
-       inb(i)=nl-1
- 510  continue
-
-      do 530 i=1,ncum
-       do 535 k=1,nl-1
-        if ((k.ge.icb(i)).and.(buoy(i,k).lt.dtovsh)) then
-         inb(i)=MIN(inb(i),k)
-        endif
- 535   continue
- 530  continue
-
-c-- end convect3
-
-c ori      do 510 i=1,ncum
-c ori        cape(i)=0.0
-c ori        capem(i)=0.0
-c ori        inb(i)=icb(i)+1
-c ori        inb1(i)=inb(i)
-c ori 510  continue
-c
-c Originial Code
-c
-c     do 530 k=minorig+1,nl-1
-c       do 520 i=1,ncum
-c         if(k.ge.(icb(i)+1))then
-c           by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
-c           byp=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
-c           cape(i)=cape(i)+by
-c           if(by.ge.0.0)inb1(i)=k+1
-c           if(cape(i).gt.0.0)then
-c             inb(i)=k+1
-c             capem(i)=cape(i)
-c           endif
-c         endif
-c520    continue
-c530  continue
-c     do 540 i=1,ncum
-c         byp=(tvp(i,nl)-tv(i,nl))*dph(i,nl)/p(i,nl)
-c         cape(i)=capem(i)+byp
-c         defrac=capem(i)-cape(i)
-c         defrac=max(defrac,0.001)
-c         frac(i)=-cape(i)/defrac
-c         frac(i)=min(frac(i),1.0)
-c         frac(i)=max(frac(i),0.0)
-c540   continue
-c
-c K Emanuel fix
-c
-c     call zilch(byp,ncum)
-c     do 530 k=minorig+1,nl-1
-c       do 520 i=1,ncum
-c         if(k.ge.(icb(i)+1))then
-c           by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
-c           cape(i)=cape(i)+by
-c           if(by.ge.0.0)inb1(i)=k+1
-c           if(cape(i).gt.0.0)then
-c             inb(i)=k+1
-c             capem(i)=cape(i)
-c             byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
-c           endif
-c         endif
-c520    continue
-c530  continue
-c     do 540 i=1,ncum
-c         inb(i)=max(inb(i),inb1(i))
-c         cape(i)=capem(i)+byp(i)
-c         defrac=capem(i)-cape(i)
-c         defrac=max(defrac,0.001)
-c         frac(i)=-cape(i)/defrac
-c         frac(i)=min(frac(i),1.0)
-c         frac(i)=max(frac(i),0.0)
-c540   continue
-c
-c J Teixeira fix
-c
-c ori      call zilch(byp,ncum)
-c ori      do 515 i=1,ncum
-c ori        lcape(i)=.true.
-c ori 515  continue
-c ori      do 530 k=minorig+1,nl-1
-c ori        do 520 i=1,ncum
-c ori          if(cape(i).lt.0.0)lcape(i)=.false.
-c ori          if((k.ge.(icb(i)+1)).and.lcape(i))then
-c ori            by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
-c ori            byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
-c ori            cape(i)=cape(i)+by
-c ori            if(by.ge.0.0)inb1(i)=k+1
-c ori            if(cape(i).gt.0.0)then
-c ori              inb(i)=k+1
-c ori              capem(i)=cape(i)
-c ori            endif
-c ori          endif
-c ori 520    continue
-c ori 530  continue
-c ori      do 540 i=1,ncum
-c ori          cape(i)=capem(i)+byp(i)
-c ori          defrac=capem(i)-cape(i)
-c ori          defrac=max(defrac,0.001)
-c ori          frac(i)=-cape(i)/defrac
-c ori          frac(i)=min(frac(i),1.0)
-c ori          frac(i)=max(frac(i),0.0)
-c ori 540  continue
-c
-c=====================================================================
-c ---   CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL
-c=====================================================================
-c
-      do i=1,ncum*nlp
-       hp(i,1)=h(i,1)
-      enddo
-
-      do 600 k=minorig+1,nl
-        do 590 i=1,ncum
-        if((k.ge.icb(i)).and.(k.le.inb(i)))then
-          hp(i,k)=h(i,nk(i))+(lv(i,k)+(cpd-cpv)*t(i,k))*ep(i,k)*clw(i,k)
-        endif
- 590    continue
- 600  continue
-
-        return
-        end
-
-      SUBROUTINE cv3_closure(nloc,ncum,nd,icb,inb
-     :                      ,pbase,p,ph,tv,buoy
-     o                      ,sig,w0,cape,m)
-      implicit none
-
-!===================================================================
-! ---  CLOSURE OF CONVECT3
-!
-! vectorization: S. Bony
-!===================================================================
-
-#include "cvthermo.h"
-#include "cvparam3.h"
-
-c input:
-      integer ncum, nd, nloc
-      integer icb(nloc), inb(nloc)
-      real pbase(nloc)
-      real p(nloc,nd), ph(nloc,nd+1)
-      real tv(nloc,nd), buoy(nloc,nd)
-
-c input/output:
-      real sig(nloc,nd), w0(nloc,nd)
-
-c output:
-      real cape(nloc)
-      real m(nloc,nd)
-
-c local variables:
-      integer i, j, k, icbmax
-      real deltap, fac, w, amu
-      real dtmin(nloc,nd), sigold(nloc,nd)
-
-
-c -------------------------------------------------------
-c -- Initialization
-c -------------------------------------------------------
-
-      do k=1,nl
-       do i=1,ncum
-        m(i,k)=0.0
-       enddo
-      enddo
-
-c -------------------------------------------------------
-c -- Reset sig(i) and w0(i) for i>inb and i<icb   
-c -------------------------------------------------------
-      
-c update sig and w0 above LNB:
-
-      do 100 k=1,nl-1
-       do 110 i=1,ncum
-        if ((inb(i).lt.(nl-1)).and.(k.ge.(inb(i)+1)))then
-         sig(i,k)=beta*sig(i,k)
-     :            +2.*alpha*buoy(i,inb(i))*ABS(buoy(i,inb(i)))
-         sig(i,k)=AMAX1(sig(i,k),0.0)
-         w0(i,k)=beta*w0(i,k)
-        endif
- 110   continue
- 100  continue
-
-c compute icbmax:
-
-      icbmax=2
-      do 200 i=1,ncum
-        icbmax=MAX(icbmax,icb(i))
- 200  continue
-
-c update sig and w0 below cloud base:
-
-      do 300 k=1,icbmax
-       do 310 i=1,ncum
-        if (k.le.icb(i))then
-         sig(i,k)=beta*sig(i,k)-2.*alpha*buoy(i,icb(i))*buoy(i,icb(i))
-         sig(i,k)=amax1(sig(i,k),0.0)
-         w0(i,k)=beta*w0(i,k)
-        endif
-310    continue
-300    continue
-
-c!      if(inb.lt.(nl-1))then
-c!         do 85 i=inb+1,nl-1
-c!            sig(i)=beta*sig(i)+2.*alpha*buoy(inb)*
-c!     1              abs(buoy(inb))
-c!            sig(i)=amax1(sig(i),0.0)
-c!            w0(i)=beta*w0(i)
-c!   85    continue
-c!      end if
-
-c!      do 87 i=1,icb
-c!         sig(i)=beta*sig(i)-2.*alpha*buoy(icb)*buoy(icb)
-c!         sig(i)=amax1(sig(i),0.0)
-c!         w0(i)=beta*w0(i)
-c!   87 continue
-
-c -------------------------------------------------------------
-c -- Reset fractional areas of updrafts and w0 at initial time
-c -- and after 10 time steps of no convection
-c -------------------------------------------------------------
-      
-      do 400 k=1,nl-1
-       do 410 i=1,ncum
-        if (sig(i,nd).lt.1.5.or.sig(i,nd).gt.12.0)then
-         sig(i,k)=0.0
-         w0(i,k)=0.0
-        endif
- 410   continue
- 400  continue
-
-c -------------------------------------------------------------
-c -- Calculate convective available potential energy (cape),  
-c -- vertical velocity (w), fractional area covered by    
-c -- undilute updraft (sig), and updraft mass flux (m)  
-c -------------------------------------------------------------
-
-      do 500 i=1,ncum
-       cape(i)=0.0
- 500  continue
-
-c compute dtmin (minimum buoyancy between ICB and given level k):
-
-      do i=1,ncum
-       do k=1,nl
-         dtmin(i,k)=100.0 
-       enddo
-      enddo
-
-      do 550 i=1,ncum
-       do 560 k=1,nl
-         do 570 j=minorig,nl
-          if ( (k.ge.(icb(i)+1)).and.(k.le.inb(i)).and.
-     :         (j.ge.icb(i)).and.(j.le.(k-1)) )then
-           dtmin(i,k)=AMIN1(dtmin(i,k),buoy(i,j))
-          endif
- 570     continue
- 560   continue
- 550  continue
-
-c the interval on which cape is computed starts at pbase :
-
-      do 600 k=1,nl
-       do 610 i=1,ncum
-
-        if ((k.ge.(icb(i)+1)).and.(k.le.inb(i))) then
-
-         deltap = MIN(pbase(i),ph(i,k-1))-MIN(pbase(i),ph(i,k))
-         cape(i)=cape(i)+rrd*buoy(i,k-1)*deltap/p(i,k-1)
-         cape(i)=AMAX1(0.0,cape(i))
-         sigold(i,k)=sig(i,k)
-
-c         dtmin(i,k)=100.0
-c         do 97 j=icb(i),k-1 ! mauvaise vectorisation
-c          dtmin(i,k)=AMIN1(dtmin(i,k),buoy(i,j))
-c  97     continue
-
-         sig(i,k)=beta*sig(i,k)+alpha*dtmin(i,k)*ABS(dtmin(i,k))
-         sig(i,k)=amax1(sig(i,k),0.0)
-         sig(i,k)=amin1(sig(i,k),0.01)
-         fac=AMIN1(((dtcrit-dtmin(i,k))/dtcrit),1.0)
-         w=(1.-beta)*fac*SQRT(cape(i))+beta*w0(i,k)
-         amu=0.5*(sig(i,k)+sigold(i,k))*w
-         m(i,k)=amu*0.007*p(i,k)*(ph(i,k)-ph(i,k+1))/tv(i,k)
-         w0(i,k)=w
-        endif
-
- 610   continue
- 600  continue
-
-      do 700 i=1,ncum
-       w0(i,icb(i))=0.5*w0(i,icb(i)+1)
-       m(i,icb(i))=0.5*m(i,icb(i)+1)
-     :             *(ph(i,icb(i))-ph(i,icb(i)+1))
-     :             /(ph(i,icb(i)+1)-ph(i,icb(i)+2))
-       sig(i,icb(i))=sig(i,icb(i)+1)
-       sig(i,icb(i)-1)=sig(i,icb(i))
- 700  continue
-
-
-c!      cape=0.0
-c!      do 98 i=icb+1,inb
-c!         deltap = min(pbase,ph(i-1))-min(pbase,ph(i))
-c!         cape=cape+rrd*buoy(i-1)*deltap/p(i-1)
-c!         dcape=rrd*buoy(i-1)*deltap/p(i-1)
-c!         dlnp=deltap/p(i-1)
-c!         cape=amax1(0.0,cape)
-c!         sigold=sig(i)
-
-c!         dtmin=100.0
-c!         do 97 j=icb,i-1
-c!            dtmin=amin1(dtmin,buoy(j))
-c!   97    continue
-
-c!         sig(i)=beta*sig(i)+alpha*dtmin*abs(dtmin)
-c!         sig(i)=amax1(sig(i),0.0)
-c!         sig(i)=amin1(sig(i),0.01)
-c!         fac=amin1(((dtcrit-dtmin)/dtcrit),1.0)
-c!         w=(1.-beta)*fac*sqrt(cape)+beta*w0(i)
-c!         amu=0.5*(sig(i)+sigold)*w
-c!         m(i)=amu*0.007*p(i)*(ph(i)-ph(i+1))/tv(i)
-c!         w0(i)=w
-c!   98 continue
-c!      w0(icb)=0.5*w0(icb+1)
-c!      m(icb)=0.5*m(icb+1)*(ph(icb)-ph(icb+1))/(ph(icb+1)-ph(icb+2))
-c!      sig(icb)=sig(icb+1)
-c!      sig(icb-1)=sig(icb)
-
-       return
-       end
-
-      SUBROUTINE cv3_mixing(nloc,ncum,nd,na,ntra,icb,nk,inb
-     :                    ,ph,t,rr,rs,u,v,tra,h,lv,qnk
-     :                    ,hp,tv,tvp,ep,clw,m,sig
-     :   ,ment,qent,uent,vent,sij,elij,ments,qents,traent)
-      implicit none
-
-!---------------------------------------------------------------------
-! a faire:
-! 	- changer rr(il,1) -> qnk(il)
-!   - vectorisation de la partie normalisation des flux (do 789...)
-!---------------------------------------------------------------------
-
-#include "cvthermo.h"
-#include "cvparam3.h"
-
-c inputs:
-      integer ncum, nd, na, ntra, nloc
-      integer icb(nloc), inb(nloc), nk(nloc)
-      real sig(nloc,nd)
-      real qnk(nloc)
-      real ph(nloc,nd+1)
-      real t(nloc,nd), rr(nloc,nd), rs(nloc,nd)
-      real u(nloc,nd), v(nloc,nd)
-      real tra(nloc,nd,ntra) ! input of convect3
-      real lv(nloc,na), h(nloc,na), hp(nloc,na)
-      real tv(nloc,na), tvp(nloc,na), ep(nloc,na), clw(nloc,na)
-      real m(nloc,na)        ! input of convect3
-
-c outputs:
-      real ment(nloc,na,na), qent(nloc,na,na)
-      real uent(nloc,na,na), vent(nloc,na,na)
-      real sij(nloc,na,na), elij(nloc,na,na)
-      real traent(nloc,nd,nd,ntra) 
-      real ments(nloc,nd,nd), qents(nloc,nd,nd)
-      real sigij(nloc,nd,nd)
-
-c local variables:
-      integer i, j, k, il, im, jm
-      integer num1, num2
-      integer nent(nloc,na)
-      real rti, bf2, anum, denom, dei, altem, cwat, stemp, qp
-      real alt, smid, sjmin, sjmax, delp, delm
-      real asij(nloc), smax(nloc), scrit(nloc)
-      real asum(nloc,nd),bsum(nloc,nd),csum(nloc,nd)
-      real wgh
-      logical lwork(nloc)
-
-c=====================================================================
-c --- INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS
-c=====================================================================
-
-c ori        do 360 i=1,ncum*nlp
-        do 361 j=1,nl
-        do 360 i=1,ncum
-          nent(i,j)=0
-c in convect3, m is computed in cv3_closure
-c ori          m(i,1)=0.0
- 360    continue
- 361    continue
-
-c ori      do 400 k=1,nlp
-c ori       do 390 j=1,nlp
-      do 400 j=1,nl
-       do 390 k=1,nl
-          do 385 i=1,ncum
-            qent(i,k,j)=rr(i,j)
-            uent(i,k,j)=u(i,j)
-            vent(i,k,j)=v(i,j)
-            elij(i,k,j)=0.0
-            ment(i,k,j)=0.0
-            sij(i,k,j)=0.0
- 385      continue
- 390    continue
- 400  continue
-
-      do k=1,ntra
-       do j=1,nd  ! instead nlp
-        do i=1,nd ! instead nlp
-         do il=1,ncum
-            traent(il,i,j,k)=tra(il,j,k)
-         enddo
-        enddo
-       enddo
-      enddo
-
-c=====================================================================
-c --- CALCULATE ENTRAINED AIR MASS FLUX (ment), TOTAL WATER MIXING
-c --- RATIO (QENT), TOTAL CONDENSED WATER (elij), AND MIXING
-c --- FRACTION (sij)
-c=====================================================================
-
-      do 750 i=minorig+1, nl
-
-       do 710 j=minorig,nl
-        do 700 il=1,ncum
-         if( (i.ge.icb(il)).and.(i.le.inb(il)).and.
-     :      (j.ge.(icb(il)-1)).and.(j.le.inb(il)))then
-
-          rti=rr(il,1)-ep(il,i)*clw(il,i)
-          bf2=1.+lv(il,j)*lv(il,j)*rs(il,j)/(rrv*t(il,j)*t(il,j)*cpd)
-          anum=h(il,j)-hp(il,i)+(cpv-cpd)*t(il,j)*(rti-rr(il,j))
-          denom=h(il,i)-hp(il,i)+(cpd-cpv)*(rr(il,i)-rti)*t(il,j)
-          dei=denom
-          if(abs(dei).lt.0.01)dei=0.01
-          sij(il,i,j)=anum/dei
-          sij(il,i,i)=1.0
-          altem=sij(il,i,j)*rr(il,i)+(1.-sij(il,i,j))*rti-rs(il,j)
-          altem=altem/bf2
-          cwat=clw(il,j)*(1.-ep(il,j))
-          stemp=sij(il,i,j)
-          if((stemp.lt.0.0.or.stemp.gt.1.0.or.altem.gt.cwat)
-     :                 .and.j.gt.i)then
-           anum=anum-lv(il,j)*(rti-rs(il,j)-cwat*bf2)
-           denom=denom+lv(il,j)*(rr(il,i)-rti)
-           if(abs(denom).lt.0.01)denom=0.01
-           sij(il,i,j)=anum/denom
-           altem=sij(il,i,j)*rr(il,i)+(1.-sij(il,i,j))*rti-rs(il,j)
-           altem=altem-(bf2-1.)*cwat
-          end if
-         if(sij(il,i,j).gt.0.0.and.sij(il,i,j).lt.0.95)then
-          qent(il,i,j)=sij(il,i,j)*rr(il,i)+(1.-sij(il,i,j))*rti
-          uent(il,i,j)=sij(il,i,j)*u(il,i)+(1.-sij(il,i,j))*u(il,nk(il))
-          vent(il,i,j)=sij(il,i,j)*v(il,i)+(1.-sij(il,i,j))*v(il,nk(il))
-c!!!      do k=1,ntra
-c!!!      traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
-c!!!     :      +(1.-sij(il,i,j))*tra(il,nk(il),k)
-c!!!      end do
-          elij(il,i,j)=altem
-          elij(il,i,j)=amax1(0.0,elij(il,i,j))
-          ment(il,i,j)=m(il,i)/(1.-sij(il,i,j))
-          nent(il,i)=nent(il,i)+1
-         end if
-         sij(il,i,j)=amax1(0.0,sij(il,i,j))
-         sij(il,i,j)=amin1(1.0,sij(il,i,j))
-         endif ! new
- 700   continue
- 710  continue
-
-       do k=1,ntra
-        do j=minorig,nl
-         do il=1,ncum
-          if( (i.ge.icb(il)).and.(i.le.inb(il)).and.
-     :       (j.ge.(icb(il)-1)).and.(j.le.inb(il)))then
-            traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
-     :            +(1.-sij(il,i,j))*tra(il,nk(il),k)
-          endif
-         enddo
-        enddo
-       enddo
-
-c
-c   ***   if no air can entrain at level i assume that updraft detrains  ***
-c   ***   at that level and calculate detrained air flux and properties  ***
-c
-
-c@      do 170 i=icb(il),inb(il)
-
-      do 740 il=1,ncum
-      if ((i.ge.icb(il)).and.(i.le.inb(il)).and.(nent(il,i).eq.0)) then 
-c@      if(nent(il,i).eq.0)then
-      ment(il,i,i)=m(il,i)
-      qent(il,i,i)=rr(il,nk(il))-ep(il,i)*clw(il,i)
-      uent(il,i,i)=u(il,nk(il))
-      vent(il,i,i)=v(il,nk(il))
-      elij(il,i,i)=clw(il,i)
-      sij(il,i,i)=1.0
-      end if
- 740  continue
- 750  continue
- 
-      do j=1,ntra
-       do i=minorig+1,nl
-        do il=1,ncum
-         if (i.ge.icb(il) .and. i.le.inb(il) .and. nent(il,i).eq.0) then
-          traent(il,i,i,j)=tra(il,nk(il),j)
-         endif
-        enddo
-       enddo
-      enddo
-
-      do 100 j=minorig,nl
-      do 101 i=minorig,nl
-      do 102 il=1,ncum
-      if ((j.ge.(icb(il)-1)).and.(j.le.inb(il))
-     :    .and.(i.ge.icb(il)).and.(i.le.inb(il)))then
-       sigij(il,i,j)=sij(il,i,j)
-      endif
- 102  continue
- 101  continue
- 100  continue
-c@      enddo
-
-c@170   continue
-
-c=====================================================================
-c   ---  NORMALIZE ENTRAINED AIR MASS FLUXES
-c   ---  TO REPRESENT EQUAL PROBABILITIES OF MIXING
-c=====================================================================
-
-      call zilch(asum,ncum*nd)
-      call zilch(bsum,ncum*nd)
-      call zilch(csum,ncum*nd)
-
-      do il=1,ncum
-       lwork(il) = .FALSE.
-      enddo
-
-      DO 789 i=minorig+1,nl 
-
-      num1=0
-      do il=1,ncum
-       if ( i.ge.icb(il) .and. i.le.inb(il) ) num1=num1+1
-      enddo
-      if (num1.le.0) goto 789
-
-
-      do 781 il=1,ncum
-       if ( i.ge.icb(il) .and. i.le.inb(il) ) then
-        lwork(il)=(nent(il,i).ne.0)
-        qp=rr(il,1)-ep(il,i)*clw(il,i)
-        anum=h(il,i)-hp(il,i)-lv(il,i)*(qp-rs(il,i))
-     :           +(cpv-cpd)*t(il,i)*(qp-rr(il,i))
-        denom=h(il,i)-hp(il,i)+lv(il,i)*(rr(il,i)-qp)
-     :           +(cpd-cpv)*t(il,i)*(rr(il,i)-qp)
-        if(abs(denom).lt.0.01)denom=0.01
-        scrit(il)=anum/denom
-        alt=qp-rs(il,i)+scrit(il)*(rr(il,i)-qp)
-        if(scrit(il).le.0.0.or.alt.le.0.0)scrit(il)=1.0
-        smax(il)=0.0
-        asij(il)=0.0
-       endif
-781   continue
-
-      do 175 j=nl,minorig,-1
-
-      num2=0
-      do il=1,ncum
-       if ( i.ge.icb(il) .and. i.le.inb(il) .and.
-     :      j.ge.(icb(il)-1) .and. j.le.inb(il) 
-     :      .and. lwork(il) ) num2=num2+1
-      enddo
-      if (num2.le.0) goto 175
-
-      do 782 il=1,ncum
-      if ( i.ge.icb(il) .and. i.le.inb(il) .and.
-     :      j.ge.(icb(il)-1) .and. j.le.inb(il) 
-     :      .and. lwork(il) ) then
-
-       if(sij(il,i,j).gt.1.0e-16.and.sij(il,i,j).lt.0.95)then
-        wgh=1.0
-        if(j.gt.i)then
-         sjmax=amax1(sij(il,i,j+1),smax(il))
-         sjmax=amin1(sjmax,scrit(il))
-         smax(il)=amax1(sij(il,i,j),smax(il))
-         sjmin=amax1(sij(il,i,j-1),smax(il))
-         sjmin=amin1(sjmin,scrit(il))
-         if(sij(il,i,j).lt.(smax(il)-1.0e-16))wgh=0.0
-         smid=amin1(sij(il,i,j),scrit(il))
-        else
-         sjmax=amax1(sij(il,i,j+1),scrit(il))
-         smid=amax1(sij(il,i,j),scrit(il))
-         sjmin=0.0
-         if(j.gt.1)sjmin=sij(il,i,j-1)
-         sjmin=amax1(sjmin,scrit(il))
-        endif
-        delp=abs(sjmax-smid)
-        delm=abs(sjmin-smid)
-        asij(il)=asij(il)+wgh*(delp+delm)
-        ment(il,i,j)=ment(il,i,j)*(delp+delm)*wgh
-       endif
-      endif
-782   continue
-
-175   continue
-
-      do il=1,ncum
-       if (i.ge.icb(il).and.i.le.inb(il).and.lwork(il)) then
-        asij(il)=amax1(1.0e-16,asij(il))
-        asij(il)=1.0/asij(il)
-        asum(il,i)=0.0
-        bsum(il,i)=0.0
-        csum(il,i)=0.0
-       endif
-      enddo
-
-      do 180 j=minorig,nl
-       do il=1,ncum
-        if ( i.ge.icb(il) .and. i.le.inb(il) .and. lwork(il)
-     :   .and. j.ge.(icb(il)-1) .and. j.le.inb(il) ) then
-         ment(il,i,j)=ment(il,i,j)*asij(il)
-        endif
-       enddo
-180   continue
-
-      do 190 j=minorig,nl
-       do il=1,ncum
-        if ( i.ge.icb(il) .and. i.le.inb(il) .and. lwork(il)
-     :   .and. j.ge.(icb(il)-1) .and. j.le.inb(il) ) then
-         asum(il,i)=asum(il,i)+ment(il,i,j)
-         ment(il,i,j)=ment(il,i,j)*sig(il,j)
-         bsum(il,i)=bsum(il,i)+ment(il,i,j)
-        endif
-       enddo
-190   continue
-
-      do il=1,ncum
-       if (i.ge.icb(il).and.i.le.inb(il).and.lwork(il)) then
-        bsum(il,i)=amax1(bsum(il,i),1.0e-16)
-        bsum(il,i)=1.0/bsum(il,i)
-       endif
-      enddo
-
-      do 195 j=minorig,nl
-       do il=1,ncum
-        if ( i.ge.icb(il) .and. i.le.inb(il) .and. lwork(il)
-     :   .and. j.ge.(icb(il)-1) .and. j.le.inb(il) ) then
-         ment(il,i,j)=ment(il,i,j)*asum(il,i)*bsum(il,i)
-        endif
-       enddo
-195   continue
-
-      do 197 j=minorig,nl
-       do il=1,ncum
-        if ( i.ge.icb(il) .and. i.le.inb(il) .and. lwork(il)
-     :   .and. j.ge.(icb(il)-1) .and. j.le.inb(il) ) then
-         csum(il,i)=csum(il,i)+ment(il,i,j)
-        endif
-       enddo
-197   continue
-
-      do il=1,ncum
-       if ( i.ge.icb(il) .and. i.le.inb(il) .and. lwork(il)
-     :     .and. csum(il,i).lt.m(il,i) ) then
-        nent(il,i)=0
-        ment(il,i,i)=m(il,i)
-        qent(il,i,i)=rr(il,1)-ep(il,i)*clw(il,i)
-        uent(il,i,i)=u(il,nk(il))
-        vent(il,i,i)=v(il,nk(il))
-        elij(il,i,i)=clw(il,i)
-        sij(il,i,i)=1.0
-       endif
-      enddo ! il
-
-      do j=1,ntra
-       do il=1,ncum
-        if ( i.ge.icb(il) .and. i.le.inb(il) .and. lwork(il)
-     :     .and. csum(il,i).lt.m(il,i) ) then
-         traent(il,i,i,j)=tra(il,nk(il),j)
-        endif
-       enddo
-      enddo
-
-789   continue
-      
-      do jm=1,nd
-       do im=1,nd
-        do 999 il=1,ncum
-         qents(il,im,jm)=qent(il,im,jm)
-         ments(il,im,jm)=ment(il,im,jm)
-999     continue
-       enddo
-      enddo
-
-      return
-      end
-
-
-      SUBROUTINE cv3_unsat(nloc,ncum,nd,na,ntra,icb,inb
-     :              ,t,rr,rs,gz,u,v,tra,p,ph
-     :              ,th,tv,lv,cpn,ep,sigp,clw
-     :              ,m,ment,elij,delt,plcl
-     :              ,mp,rp,up,vp,trap,wt,water,evap,b)
-      implicit none
-
-
-#include "cvthermo.h"
-#include "cvparam3.h"
-#include "cvflag.h"
-
-c inputs:
-      integer ncum, nd, na, ntra, nloc
-      integer icb(nloc), inb(nloc)
-      real delt, plcl(nloc)
-      real t(nloc,nd), rr(nloc,nd), rs(nloc,nd)
-      real u(nloc,nd), v(nloc,nd)
-      real tra(nloc,nd,ntra)
-      real p(nloc,nd), ph(nloc,nd+1)
-      real th(nloc,na), gz(nloc,na)
-      real lv(nloc,na), ep(nloc,na), sigp(nloc,na), clw(nloc,na)
-      real cpn(nloc,na), tv(nloc,na)
-      real m(nloc,na), ment(nloc,na,na), elij(nloc,na,na)
-
-c outputs:
-      real mp(nloc,na), rp(nloc,na), up(nloc,na), vp(nloc,na)
-      real water(nloc,na), evap(nloc,na), wt(nloc,na)
-      real trap(nloc,na,ntra)
-      real b(nloc,na)
-
-c local variables
-      integer i,j,k,il,num1
-      real tinv, delti
-      real awat, afac, afac1, afac2, bfac
-      real pr1, pr2, sigt, b6, c6, revap, tevap, delth
-      real amfac, amp2, xf, tf, fac2, ur, sru, fac, d, af, bf
-      real ampmax
-      real lvcp(nloc,na)
-      real wdtrain(nloc)
-      logical lwork(nloc)
-
-
-c------------------------------------------------------
-
-        delti = 1./delt
-        tinv=1./3.
-
-        do i=1,nl
-         do il=1,ncum
-          mp(il,i)=0.0
-          rp(il,i)=rr(il,i)
-          up(il,i)=u(il,i)
-          vp(il,i)=v(il,i)
-          wt(il,i)=0.001
-          water(il,i)=0.0
-          evap(il,i)=0.0
-          b(il,i)=0.0
-          lvcp(il,i)=lv(il,i)/cpn(il,i)
-         enddo
-        enddo
-
-        do k=1,ntra
-         do i=1,nd
-          do il=1,ncum
-           trap(il,i,k)=tra(il,i,k)
-          enddo
-         enddo
-        enddo
-
-c
-c   ***  check whether ep(inb)=0, if so, skip precipitating    ***
-c   ***             downdraft calculation                      ***
-c
-
-        do il=1,ncum
-          lwork(il)=.TRUE.
-          if(ep(il,inb(il)).lt.0.0001)lwork(il)=.FALSE.
-        enddo
-
-        call zilch(wdtrain,ncum)
- 
-        DO 400 i=nl+1,1,-1
-
-        num1=0
-        do il=1,ncum
-         if ( i.le.inb(il) .and. lwork(il) ) num1=num1+1
-        enddo
-        if (num1.le.0) goto 400
-
-c
-c   ***  integrate liquid water equation to find condensed water   ***
-c   ***                and condensed water flux                    ***
-c
-
-c
-c    ***                    begin downdraft loop                    ***
-c
-
-c
-c    ***              calculate detrained precipitation             ***
-c
-       do il=1,ncum
-        if (i.le.inb(il) .and. lwork(il)) then
-         if (cvflag_grav) then
-          wdtrain(il)=grav*ep(il,i)*m(il,i)*clw(il,i)
-         else
-          wdtrain(il)=10.0*ep(il,i)*m(il,i)*clw(il,i)
-         endif
-        endif
-       enddo
-
-       if(i.gt.1)then
-        do 320 j=1,i-1
-         do il=1,ncum
-          if (i.le.inb(il) .and. lwork(il)) then
-           awat=elij(il,j,i)-(1.-ep(il,i))*clw(il,i)
-           awat=amax1(awat,0.0)
-           if (cvflag_grav) then
-            wdtrain(il)=wdtrain(il)+grav*awat*ment(il,j,i)
-           else
-            wdtrain(il)=wdtrain(il)+10.0*awat*ment(il,j,i)
-           endif
-          endif
-         enddo
-320     continue
-       endif
-
-c
-c    ***    find rain water and evaporation using provisional   ***
-c    ***              estimates of rp(i)and rp(i-1)             ***
-c
-
-      do 999 il=1,ncum
-
-       if (i.le.inb(il) .and. lwork(il)) then
-
-      wt(il,i)=45.0
-
-      if(i.lt.inb(il))then
-       rp(il,i)=rp(il,i+1)
-     :       +(cpd*(t(il,i+1)-t(il,i))+gz(il,i+1)-gz(il,i))/lv(il,i)
-       rp(il,i)=0.5*(rp(il,i)+rr(il,i))
-      endif
-      rp(il,i)=amax1(rp(il,i),0.0)
-      rp(il,i)=amin1(rp(il,i),rs(il,i))
-      rp(il,inb(il))=rr(il,inb(il))
-
-      if(i.eq.1)then
-       afac=p(il,1)*(rs(il,1)-rp(il,1))/(1.0e4+2000.0*p(il,1)*rs(il,1))
-      else
-       rp(il,i-1)=rp(il,i)
-     :          +(cpd*(t(il,i)-t(il,i-1))+gz(il,i)-gz(il,i-1))/lv(il,i)
-       rp(il,i-1)=0.5*(rp(il,i-1)+rr(il,i-1))
-       rp(il,i-1)=amin1(rp(il,i-1),rs(il,i-1))
-       rp(il,i-1)=amax1(rp(il,i-1),0.0)
-       afac1=p(il,i)*(rs(il,i)-rp(il,i))/(1.0e4+2000.0*p(il,i)*rs(il,i))
-       afac2=p(il,i-1)*(rs(il,i-1)-rp(il,i-1))
-     :                /(1.0e4+2000.0*p(il,i-1)*rs(il,i-1))
-       afac=0.5*(afac1+afac2)
-      endif
-      if(i.eq.inb(il))afac=0.0
-      afac=amax1(afac,0.0)
-      bfac=1./(sigd*wt(il,i))
-c
-cjyg1
-ccc        sigt=1.0
-ccc        if(i.ge.icb)sigt=sigp(i)
-c prise en compte de la variation progressive de sigt dans
-c les couches icb et icb-1:
-c 	pour plcl<ph(i+1), pr1=0 & pr2=1
-c 	pour plcl>ph(i),   pr1=1 & pr2=0
-c 	pour ph(i+1)<plcl<ph(i), pr1 est la proportion a cheval
-c    sur le nuage, et pr2 est la proportion sous la base du
-c    nuage.
-      pr1=(plcl(il)-ph(il,i+1))/(ph(il,i)-ph(il,i+1))
-      pr1=max(0.,min(1.,pr1))
-      pr2=(ph(il,i)-plcl(il))/(ph(il,i)-ph(il,i+1))
-      pr2=max(0.,min(1.,pr2))
-      sigt=sigp(il,i)*pr1+pr2
-cjyg2
-c
-      b6=bfac*50.*sigd*(ph(il,i)-ph(il,i+1))*sigt*afac
-      c6=water(il,i+1)+bfac*wdtrain(il)
-     :                -50.*sigd*bfac*(ph(il,i)-ph(il,i+1))*evap(il,i+1)
-      if(c6.gt.0.0)then
-       revap=0.5*(-b6+sqrt(b6*b6+4.*c6))
-       evap(il,i)=sigt*afac*revap
-       water(il,i)=revap*revap
-      else
-       evap(il,i)=-evap(il,i+1)
-     :            +0.02*(wdtrain(il)+sigd*wt(il,i)*water(il,i+1))
-     :                 /(sigd*(ph(il,i)-ph(il,i+1)))
-      end if
-c
-c    ***  calculate precipitating downdraft mass flux under     ***
-c    ***              hydrostatic approximation                 ***
-c
-      if (i.ne.1) then
-
-      tevap=amax1(0.0,evap(il,i))
-      delth=amax1(0.001,(th(il,i)-th(il,i-1)))
-      if (cvflag_grav) then
-       mp(il,i)=100.*ginv*lvcp(il,i)*sigd*tevap
-     :              *(p(il,i-1)-p(il,i))/delth
-      else
-       mp(il,i)=10.*lvcp(il,i)*sigd*tevap*(p(il,i-1)-p(il,i))/delth
-      endif
-c
-c    ***           if hydrostatic assumption fails,             ***
-c    ***   solve cubic difference equation for downdraft theta  ***
-c    ***  and mass flux from two simultaneous differential eqns ***
-c
-      amfac=sigd*sigd*70.0*ph(il,i)*(p(il,i-1)-p(il,i))
-     :          *(th(il,i)-th(il,i-1))/(tv(il,i)*th(il,i))
-      amp2=abs(mp(il,i+1)*mp(il,i+1)-mp(il,i)*mp(il,i))
-      if(amp2.gt.(0.1*amfac))then
-       xf=100.0*sigd*sigd*sigd*(ph(il,i)-ph(il,i+1))
-       tf=b(il,i)-5.0*(th(il,i)-th(il,i-1))*t(il,i)
-     :               /(lvcp(il,i)*sigd*th(il,i))
-       af=xf*tf+mp(il,i+1)*mp(il,i+1)*tinv
-       bf=2.*(tinv*mp(il,i+1))**3+tinv*mp(il,i+1)*xf*tf
-     :            +50.*(p(il,i-1)-p(il,i))*xf*tevap
-       fac2=1.0
-       if(bf.lt.0.0)fac2=-1.0
-       bf=abs(bf)
-       ur=0.25*bf*bf-af*af*af*tinv*tinv*tinv
-       if(ur.ge.0.0)then
-        sru=sqrt(ur)
-        fac=1.0
-        if((0.5*bf-sru).lt.0.0)fac=-1.0
-        mp(il,i)=mp(il,i+1)*tinv+(0.5*bf+sru)**tinv
-     :                  +fac*(abs(0.5*bf-sru))**tinv
-       else
-        d=atan(2.*sqrt(-ur)/(bf+1.0e-28))
-        if(fac2.lt.0.0)d=3.14159-d
-        mp(il,i)=mp(il,i+1)*tinv+2.*sqrt(af*tinv)*cos(d*tinv)
-       endif
-       mp(il,i)=amax1(0.0,mp(il,i))
-
-       if (cvflag_grav) then
-Cjyg : il y a vraisemblablement une erreur dans la ligne 2 suivante: 
-C il faut diviser par (mp(il,i)*sigd*grav) et non par (mp(il,i)+sigd*0.1). 
-C Et il faut bien revoir les facteurs 100.
-        b(il,i-1)=b(il,i)+100.0*(p(il,i-1)-p(il,i))*tevap
-     2   /(mp(il,i)+sigd*0.1)
-     3   -10.0*(th(il,i)-th(il,i-1))*t(il,i)/(lvcp(il,i)*sigd*th(il,i))
-       else
-        b(il,i-1)=b(il,i)+100.0*(p(il,i-1)-p(il,i))*tevap
-     2   /(mp(il,i)+sigd*0.1)
-     3   -10.0*(th(il,i)-th(il,i-1))*t(il,i)/(lvcp(il,i)*sigd*th(il,i))
-       endif
-       b(il,i-1)=amax1(b(il,i-1),0.0)
-      endif
-c
-c   ***         limit magnitude of mp(i) to meet cfl condition      ***
-c
-      ampmax=2.0*(ph(il,i)-ph(il,i+1))*delti
-      amp2=2.0*(ph(il,i-1)-ph(il,i))*delti
-      ampmax=amin1(ampmax,amp2)
-      mp(il,i)=amin1(mp(il,i),ampmax)
-c
-c    ***      force mp to decrease linearly to zero                 ***
-c    ***       between cloud base and the surface                   ***
-c
-      if(p(il,i).gt.p(il,icb(il)))then
-       mp(il,i)=mp(il,icb(il))*(p(il,1)-p(il,i))/(p(il,1)-p(il,icb(il)))
-      endif
-
-360   continue
-      endif ! i.eq.1
-c
-c    ***       find mixing ratio of precipitating downdraft     ***
-c
-
-      if (i.ne.inb(il)) then
-
-      rp(il,i)=rr(il,i)
-
-      if(mp(il,i).gt.mp(il,i+1))then
-
-       if (cvflag_grav) then
-        rp(il,i)=rp(il,i+1)*mp(il,i+1)+rr(il,i)*(mp(il,i)-mp(il,i+1))
-     :   +100.*ginv*0.5*sigd*(ph(il,i)-ph(il,i+1))
-     :                     *(evap(il,i+1)+evap(il,i))
-       else
-        rp(il,i)=rp(il,i+1)*mp(il,i+1)+rr(il,i)*(mp(il,i)-mp(il,i+1))
-     :   +5.*sigd*(ph(il,i)-ph(il,i+1))
-     :                      *(evap(il,i+1)+evap(il,i))
-       endif
-      rp(il,i)=rp(il,i)/mp(il,i)
-      up(il,i)=up(il,i+1)*mp(il,i+1)+u(il,i)*(mp(il,i)-mp(il,i+1))
-      up(il,i)=up(il,i)/mp(il,i)
-      vp(il,i)=vp(il,i+1)*mp(il,i+1)+v(il,i)*(mp(il,i)-mp(il,i+1))
-      vp(il,i)=vp(il,i)/mp(il,i)
-
-      do j=1,ntra
-      trap(il,i,j)=trap(il,i+1,j)*mp(il,i+1)
-     :            +trap(il,i,j)*(mp(il,i)-mp(il,i+1))
-      trap(il,i,j)=trap(il,i,j)/mp(il,i)
-      end do
-
-      else
-
-       if(mp(il,i+1).gt.1.0e-16)then
-        if (cvflag_grav) then
-         rp(il,i)=rp(il,i+1)
-     :            +100.*ginv*0.5*sigd*(ph(il,i)-ph(il,i+1))
-     :            *(evap(il,i+1)+evap(il,i))/mp(il,i+1)
-        else
-         rp(il,i)=rp(il,i+1)
-     :           +5.*sigd*(ph(il,i)-ph(il,i+1))
-     :           *(evap(il,i+1)+evap(il,i))/mp(il,i+1)
-        endif
-       up(il,i)=up(il,i+1)
-       vp(il,i)=vp(il,i+1)
-
-       do j=1,ntra
-       trap(il,i,j)=trap(il,i+1,j)
-       end do
-
-       endif
-      endif
-      rp(il,i)=amin1(rp(il,i),rs(il,i))
-      rp(il,i)=amax1(rp(il,i),0.0)
-
-      endif
-      endif
-999   continue
-
-400   continue
-
-       return
-       end
-
-      SUBROUTINE cv3_yield(nloc,ncum,nd,na,ntra 
-     :                    ,icb,inb,delt
-     :                    ,t,rr,u,v,tra,gz,p,ph,h,hp,lv,cpn,th
-     :                    ,ep,clw,m,tp,mp,rp,up,vp,trap
-     :                    ,wt,water,evap,b
-     :                    ,ment,qent,uent,vent,nent,elij,traent,sig
-     :                    ,tv,tvp
-     :                    ,iflag,precip,ft,fr,fu,fv,ftra
-     :                    ,upwd,dnwd,dnwd0,ma,mike,tls,tps,qcondc,wd)
-      implicit none
-
-#include "cvthermo.h"
-#include "cvparam3.h"
-#include "cvflag.h"
-
-c inputs:
-      integer ncum,nd,na,ntra,nloc
-      integer icb(nloc), inb(nloc)
-      real delt
-      real t(nloc,nd), rr(nloc,nd), u(nloc,nd), v(nloc,nd)
-      real tra(nloc,nd,ntra), sig(nloc,nd)
-      real gz(nloc,na), ph(nloc,nd+1), h(nloc,na), hp(nloc,na)
-      real th(nloc,na), p(nloc,nd), tp(nloc,na)
-      real lv(nloc,na), cpn(nloc,na), ep(nloc,na), clw(nloc,na)
-      real m(nloc,na), mp(nloc,na), rp(nloc,na), up(nloc,na)
-      real vp(nloc,na), wt(nloc,nd), trap(nloc,nd,ntra)
-      real water(nloc,na), evap(nloc,na), b(nloc,na)
-      real ment(nloc,na,na), qent(nloc,na,na), uent(nloc,na,na)
-      real vent(nloc,na,na), nent(nloc,na), elij(nloc,na,na)
-      real traent(nloc,na,na,ntra)
-      real tv(nloc,nd), tvp(nloc,nd)
-
-c input/output:
-      integer iflag(nloc)
-
-c outputs:
-      real precip(nloc)
-      real ft(nloc,nd), fr(nloc,nd), fu(nloc,nd), fv(nloc,nd)
-      real ftra(nloc,nd,ntra)
-      real upwd(nloc,nd), dnwd(nloc,nd), ma(nloc,nd)
-      real dnwd0(nloc,nd), mike(nloc,nd)
-      real tls(nloc,nd), tps(nloc,nd)
-      real qcondc(nloc,nd)                               ! cld
-      real wd(nloc)                                      ! gust
-
-c local variables:
-      integer i,k,il,n,j,num1
-      real rat, awat, delti
-      real ax, bx, cx, dx, ex
-      real cpinv, rdcp, dpinv
-      real lvcp(nloc,na), mke(nloc,na)
-      real am(nloc), work(nloc), ad(nloc), amp1(nloc)
-c!!      real up1(nloc), dn1(nloc)
-      real up1(nloc,nd,nd), dn1(nloc,nd,nd)
-      real asum(nloc), bsum(nloc), csum(nloc), dsum(nloc)
-      real qcond(nloc,nd), nqcond(nloc,nd), wa(nloc,nd)  ! cld
-      real siga(nloc,nd), sax(nloc,nd), mac(nloc,nd)      ! cld
-
-
-c-------------------------------------------------------------
-
-c initialization:
-
-      delti = 1.0/delt
-
-      do il=1,ncum
-       precip(il)=0.0
-       wd(il)=0.0     ! gust
-      enddo
-
-      do i=1,nd
-       do il=1,ncum
-         ft(il,i)=0.0
-         fr(il,i)=0.0
-         fu(il,i)=0.0
-         fv(il,i)=0.0
-         qcondc(il,i)=0.0                                ! cld
-         qcond(il,i)=0.0                                 ! cld
-         nqcond(il,i)=0.0                                ! cld
-       enddo 
-      enddo
-
-      do j=1,ntra
-       do i=1,nd
-        do il=1,ncum
-          ftra(il,i,j)=0.0
-        enddo
-       enddo 
-      enddo
-
-      do i=1,nl
-       do il=1,ncum
-         lvcp(il,i)=lv(il,i)/cpn(il,i)
-       enddo
-      enddo
-
-
-c
-c   ***  calculate surface precipitation in mm/day     ***
-c
-      do il=1,ncum 
-       if(ep(il,inb(il)).ge.0.0001)then 
-        if (cvflag_grav) then
-         precip(il)=wt(il,1)*sigd*water(il,1)*86400.*1000./(rowl*grav)
-        else
-         precip(il)=wt(il,1)*sigd*water(il,1)*8640.
-        endif
-       endif 
-      enddo 
-
-c
-c   ***  Calculate downdraft velocity scale    ***
-c   ***  NE PAS UTILISER POUR L'INSTANT ***
-c
-c!      do il=1,ncum
-c!        wd(il)=betad*abs(mp(il,icb(il)))*0.01*rrd*t(il,icb(il))
-c!     :                                  /(sigd*p(il,icb(il)))
-c!      enddo
-
-c
-c   ***  calculate tendencies of lowest level potential temperature  ***
-c   ***                      and mixing ratio                        ***
-c
-      do il=1,ncum
-       work(il)=1.0/(ph(il,1)-ph(il,2))
-       am(il)=0.0
-      enddo
-
-      do k=2,nl
-       do il=1,ncum
-        if (k.le.inb(il)) then
-         am(il)=am(il)+m(il,k)
-        endif
-       enddo
-      enddo
-
-      do il=1,ncum
-
-c convect3      if((0.1*dpinv*am).ge.delti)iflag(il)=4
-      if (cvflag_grav) then
-      if((0.01*grav*work(il)*am(il)).ge.delti)iflag(il)=1!consist vect
-       ft(il,1)=0.01*grav*work(il)*am(il)*(t(il,2)-t(il,1)
-     :            +(gz(il,2)-gz(il,1))/cpn(il,1))
-      else
-       if((0.1*work(il)*am(il)).ge.delti)iflag(il)=1 !consistency vect
-       ft(il,1)=0.1*work(il)*am(il)*(t(il,2)-t(il,1)
-     :            +(gz(il,2)-gz(il,1))/cpn(il,1))
-      endif
-
-      ft(il,1)=ft(il,1)-0.5*lvcp(il,1)*sigd*(evap(il,1)+evap(il,2))
-
-      if (cvflag_grav) then
-       ft(il,1)=ft(il,1)-0.009*grav*sigd*mp(il,2)
-     :                             *t(il,1)*b(il,1)*work(il)
-      else
-       ft(il,1)=ft(il,1)-0.09*sigd*mp(il,2)*t(il,1)*b(il,1)*work(il)
-      endif
-
-      ft(il,1)=ft(il,1)+0.01*sigd*wt(il,1)*(cl-cpd)*water(il,2)*(t(il,2)
-     :-t(il,1))*work(il)/cpn(il,1)
-
-      if (cvflag_grav) then
-Cjyg1  Correction pour mieux conserver l'eau (conformite avec CONVECT4.3)
-c (sb: pour l'instant, on ne fait que le chgt concernant grav, pas evap) 
-       fr(il,1)=0.01*grav*mp(il,2)*(rp(il,2)-rr(il,1))*work(il)
-     :          +sigd*0.5*(evap(il,1)+evap(il,2))
-c+tard     :          +sigd*evap(il,1)
-
-       fr(il,1)=fr(il,1)+0.01*grav*am(il)*(rr(il,2)-rr(il,1))*work(il)
-
-       fu(il,1)=fu(il,1)+0.01*grav*work(il)*(mp(il,2)*(up(il,2)-u(il,1))
-     :         +am(il)*(u(il,2)-u(il,1)))
-       fv(il,1)=fv(il,1)+0.01*grav*work(il)*(mp(il,2)*(vp(il,2)-v(il,1))
-     :         +am(il)*(v(il,2)-v(il,1)))
-      else  ! cvflag_grav
-       fr(il,1)=0.1*mp(il,2)*(rp(il,2)-rr(il,1))*work(il)
-     :          +sigd*0.5*(evap(il,1)+evap(il,2))
-       fr(il,1)=fr(il,1)+0.1*am(il)*(rr(il,2)-rr(il,1))*work(il)
-       fu(il,1)=fu(il,1)+0.1*work(il)*(mp(il,2)*(up(il,2)-u(il,1))
-     :         +am(il)*(u(il,2)-u(il,1)))
-       fv(il,1)=fv(il,1)+0.1*work(il)*(mp(il,2)*(vp(il,2)-v(il,1))
-     :         +am(il)*(v(il,2)-v(il,1)))
-      endif ! cvflag_grav
-
-      enddo ! il
-
-      do j=1,ntra
-       do il=1,ncum
-        if (cvflag_grav) then
-         ftra(il,1,j)=ftra(il,1,j)+0.01*grav*work(il)
-     :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
-     :             +am(il)*(tra(il,2,j)-tra(il,1,j)))
-        else
-         ftra(il,1,j)=ftra(il,1,j)+0.1*work(il)
-     :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
-     :             +am(il)*(tra(il,2,j)-tra(il,1,j)))
-        endif
-       enddo
-      enddo
-
-      do j=2,nl
-       do il=1,ncum
-        if (j.le.inb(il)) then
-         if (cvflag_grav) then
-          fr(il,1)=fr(il,1)
-     :       +0.01*grav*work(il)*ment(il,j,1)*(qent(il,j,1)-rr(il,1))
-          fu(il,1)=fu(il,1)
-     :       +0.01*grav*work(il)*ment(il,j,1)*(uent(il,j,1)-u(il,1))
-          fv(il,1)=fv(il,1)
-     :       +0.01*grav*work(il)*ment(il,j,1)*(vent(il,j,1)-v(il,1))
-         else   ! cvflag_grav
-          fr(il,1)=fr(il,1)
-     :         +0.1*work(il)*ment(il,j,1)*(qent(il,j,1)-rr(il,1))
-          fu(il,1)=fu(il,1)
-     :         +0.1*work(il)*ment(il,j,1)*(uent(il,j,1)-u(il,1))
-          fv(il,1)=fv(il,1)
-     :         +0.1*work(il)*ment(il,j,1)*(vent(il,j,1)-v(il,1))
-         endif  ! cvflag_grav
-        endif ! j
-       enddo
-      enddo
-
-      do k=1,ntra
-       do j=2,nl
-        do il=1,ncum
-         if (j.le.inb(il)) then
-
-          if (cvflag_grav) then
-           ftra(il,1,k)=ftra(il,1,k)+0.01*grav*work(il)*ment(il,j,1)
-     :                *(traent(il,j,1,k)-tra(il,1,k))
-          else
-           ftra(il,1,k)=ftra(il,1,k)+0.1*work(il)*ment(il,j,1)
-     :                *(traent(il,j,1,k)-tra(il,1,k))
-          endif
-
-         endif
-        enddo
-       enddo
-      enddo
-
-c
-c   ***  calculate tendencies of potential temperature and mixing ratio  ***
-c   ***               at levels above the lowest level                   ***
-c
-c   ***  first find the net saturated updraft and downdraft mass fluxes  ***
-c   ***                      through each level                          ***
-c
-
-      do 500 i=2,nl+1 ! newvecto: mettre nl au lieu nl+1?
-
-       num1=0
-       do il=1,ncum
-        if(i.le.inb(il))num1=num1+1
-       enddo
-       if(num1.le.0)go to 500
-
-       call zilch(amp1,ncum)
-       call zilch(ad,ncum)
-
-      do 440 k=i+1,nl+1
-       do 441 il=1,ncum
-        if (i.le.inb(il) .and. k.le.(inb(il)+1)) then
-         amp1(il)=amp1(il)+m(il,k)
-        endif
- 441   continue
- 440  continue
-
-      do 450 k=1,i
-       do 451 j=i+1,nl+1
-        do 452 il=1,ncum
-         if (i.le.inb(il) .and. j.le.(inb(il)+1)) then
-          amp1(il)=amp1(il)+ment(il,k,j)
-         endif
-452     continue
-451    continue
-450   continue
-
-      do 470 k=1,i-1
-       do 471 j=i,nl+1 ! newvecto: nl au lieu nl+1?
-        do 472 il=1,ncum
-        if (i.le.inb(il) .and. j.le.inb(il)) then
-         ad(il)=ad(il)+ment(il,j,k)
-        endif
-472     continue
-471    continue
-470   continue
-  
-      do 1350 il=1,ncum
-      if (i.le.inb(il)) then
-       dpinv=1.0/(ph(il,i)-ph(il,i+1))
-       cpinv=1.0/cpn(il,i)
-
-c convect3      if((0.1*dpinv*amp1).ge.delti)iflag(il)=4
-      if (cvflag_grav) then
-       if((0.01*grav*dpinv*amp1(il)).ge.delti)iflag(il)=1 ! vecto
-      else
-       if((0.1*dpinv*amp1(il)).ge.delti)iflag(il)=1 ! vecto
-      endif
-
-      if (cvflag_grav) then
-       ft(il,i)=0.01*grav*dpinv*(amp1(il)*(t(il,i+1)-t(il,i)
-     :    +(gz(il,i+1)-gz(il,i))*cpinv)
-     :    -ad(il)*(t(il,i)-t(il,i-1)+(gz(il,i)-gz(il,i-1))*cpinv))
-     :    -0.5*sigd*lvcp(il,i)*(evap(il,i)+evap(il,i+1))
-       rat=cpn(il,i-1)*cpinv
-       ft(il,i)=ft(il,i)-0.009*grav*sigd*(mp(il,i+1)*t(il,i)*b(il,i)
-     :   -mp(il,i)*t(il,i-1)*rat*b(il,i-1))*dpinv
-       ft(il,i)=ft(il,i)+0.01*grav*dpinv*ment(il,i,i)*(hp(il,i)-h(il,i)
-     :    +t(il,i)*(cpv-cpd)*(rr(il,i)-qent(il,i,i)))*cpinv
-      else  ! cvflag_grav
-       ft(il,i)=0.1*dpinv*(amp1(il)*(t(il,i+1)-t(il,i)
-     :    +(gz(il,i+1)-gz(il,i))*cpinv)
-     :    -ad(il)*(t(il,i)-t(il,i-1)+(gz(il,i)-gz(il,i-1))*cpinv))
-     :    -0.5*sigd*lvcp(il,i)*(evap(il,i)+evap(il,i+1))
-       rat=cpn(il,i-1)*cpinv
-       ft(il,i)=ft(il,i)-0.09*sigd*(mp(il,i+1)*t(il,i)*b(il,i)
-     :   -mp(il,i)*t(il,i-1)*rat*b(il,i-1))*dpinv
-       ft(il,i)=ft(il,i)+0.1*dpinv*ment(il,i,i)*(hp(il,i)-h(il,i)
-     :    +t(il,i)*(cpv-cpd)*(rr(il,i)-qent(il,i,i)))*cpinv
-      endif ! cvflag_grav
-
-
-      ft(il,i)=ft(il,i)+0.01*sigd*wt(il,i)*(cl-cpd)*water(il,i+1)
-     :           *(t(il,i+1)-t(il,i))*dpinv*cpinv
-
-      if (cvflag_grav) then
-       fr(il,i)=0.01*grav*dpinv*(amp1(il)*(rr(il,i+1)-rr(il,i))
-     :           -ad(il)*(rr(il,i)-rr(il,i-1)))
-       fu(il,i)=fu(il,i)+0.01*grav*dpinv*(amp1(il)*(u(il,i+1)-u(il,i))
-     :             -ad(il)*(u(il,i)-u(il,i-1)))
-       fv(il,i)=fv(il,i)+0.01*grav*dpinv*(amp1(il)*(v(il,i+1)-v(il,i))
-     :             -ad(il)*(v(il,i)-v(il,i-1)))
-      else  ! cvflag_grav
-       fr(il,i)=0.1*dpinv*(amp1(il)*(rr(il,i+1)-rr(il,i))
-     :           -ad(il)*(rr(il,i)-rr(il,i-1)))
-       fu(il,i)=fu(il,i)+0.1*dpinv*(amp1(il)*(u(il,i+1)-u(il,i))
-     :             -ad(il)*(u(il,i)-u(il,i-1)))
-       fv(il,i)=fv(il,i)+0.1*dpinv*(amp1(il)*(v(il,i+1)-v(il,i))
-     :             -ad(il)*(v(il,i)-v(il,i-1)))
-      endif ! cvflag_grav
-
-      endif ! i
-1350  continue
-
-      do k=1,ntra
-       do il=1,ncum
-        if (i.le.inb(il)) then
-         dpinv=1.0/(ph(il,i)-ph(il,i+1))
-         cpinv=1.0/cpn(il,i)
-         if (cvflag_grav) then
-           ftra(il,i,k)=ftra(il,i,k)+0.01*grav*dpinv
-     :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
-     :           -ad(il)*(tra(il,i,k)-tra(il,i-1,k)))
-         else
-           ftra(il,i,k)=ftra(il,i,k)+0.1*dpinv
-     :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
-     :           -ad(il)*(tra(il,i,k)-tra(il,i-1,k)))
-         endif
-        endif
-       enddo
-      enddo
-
-      do 480 k=1,i-1
-       do 1370 il=1,ncum
-        if (i.le.inb(il)) then
-         dpinv=1.0/(ph(il,i)-ph(il,i+1))
-         cpinv=1.0/cpn(il,i)
-
-      awat=elij(il,k,i)-(1.-ep(il,i))*clw(il,i)
-      awat=amax1(awat,0.0)
-
-      if (cvflag_grav) then
-      fr(il,i)=fr(il,i)
-     :   +0.01*grav*dpinv*ment(il,k,i)*(qent(il,k,i)-awat-rr(il,i))
-      fu(il,i)=fu(il,i)
-     :         +0.01*grav*dpinv*ment(il,k,i)*(uent(il,k,i)-u(il,i))
-      fv(il,i)=fv(il,i)
-     :         +0.01*grav*dpinv*ment(il,k,i)*(vent(il,k,i)-v(il,i))
-      else  ! cvflag_grav
-      fr(il,i)=fr(il,i)
-     :   +0.1*dpinv*ment(il,k,i)*(qent(il,k,i)-awat-rr(il,i))
-      fu(il,i)=fu(il,i)
-     :   +0.01*grav*dpinv*ment(il,k,i)*(uent(il,k,i)-u(il,i))
-      fv(il,i)=fv(il,i)
-     :   +0.1*dpinv*ment(il,k,i)*(vent(il,k,i)-v(il,i))
-      endif ! cvflag_grav
-
-c (saturated updrafts resulting from mixing)        ! cld
-        qcond(il,i)=qcond(il,i)+(elij(il,k,i)-awat) ! cld
-        nqcond(il,i)=nqcond(il,i)+1.                ! cld
-      endif ! i
-1370  continue
-480   continue
-
-      do j=1,ntra
-       do k=1,i-1
-        do il=1,ncum
-         if (i.le.inb(il)) then
-          dpinv=1.0/(ph(il,i)-ph(il,i+1))
-          cpinv=1.0/cpn(il,i)
-          if (cvflag_grav) then
-           ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
-     :        *(traent(il,k,i,j)-tra(il,i,j))
-          else
-           ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i)
-     :        *(traent(il,k,i,j)-tra(il,i,j))
-          endif
-         endif
-        enddo
-       enddo
-      enddo
-
-      do 490 k=i,nl+1
-       do 1380 il=1,ncum
-        if (i.le.inb(il) .and. k.le.inb(il)) then
-         dpinv=1.0/(ph(il,i)-ph(il,i+1))
-         cpinv=1.0/cpn(il,i)
-
-         if (cvflag_grav) then
-         fr(il,i)=fr(il,i)
-     :         +0.01*grav*dpinv*ment(il,k,i)*(qent(il,k,i)-rr(il,i))
-         fu(il,i)=fu(il,i)
-     :         +0.01*grav*dpinv*ment(il,k,i)*(uent(il,k,i)-u(il,i))
-         fv(il,i)=fv(il,i)
-     :         +0.01*grav*dpinv*ment(il,k,i)*(vent(il,k,i)-v(il,i))
-         else  ! cvflag_grav 
-         fr(il,i)=fr(il,i)
-     :         +0.1*dpinv*ment(il,k,i)*(qent(il,k,i)-rr(il,i))
-         fu(il,i)=fu(il,i)
-     :         +0.1*dpinv*ment(il,k,i)*(uent(il,k,i)-u(il,i))
-         fv(il,i)=fv(il,i)
-     :         +0.1*dpinv*ment(il,k,i)*(vent(il,k,i)-v(il,i))
-         endif ! cvflag_grav 
-        endif ! i and k
-1380   continue
-490   continue
-
-      do j=1,ntra
-       do k=i,nl+1
-        do il=1,ncum
-         if (i.le.inb(il) .and. k.le.inb(il)) then
-          dpinv=1.0/(ph(il,i)-ph(il,i+1))
-          cpinv=1.0/cpn(il,i)
-          if (cvflag_grav) then
-           ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
-     :         *(traent(il,k,i,j)-tra(il,i,j))
-          else
-           ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i)
-     :             *(traent(il,k,i,j)-tra(il,i,j))
-          endif
-         endif ! i and k
-        enddo
-       enddo
-      enddo
-
-      do 1400 il=1,ncum
-       if (i.le.inb(il)) then
-        dpinv=1.0/(ph(il,i)-ph(il,i+1))
-        cpinv=1.0/cpn(il,i)
-
-        if (cvflag_grav) then
-c sb: on ne fait pas encore la correction permettant de mieux
-c conserver l'eau:
-         fr(il,i)=fr(il,i)+0.5*sigd*(evap(il,i)+evap(il,i+1))
-     :        +0.01*grav*(mp(il,i+1)*(rp(il,i+1)-rr(il,i))-mp(il,i)
-     :               *(rp(il,i)-rr(il,i-1)))*dpinv
-
-         fu(il,i)=fu(il,i)+0.01*grav*(mp(il,i+1)*(up(il,i+1)-u(il,i))
-     :             -mp(il,i)*(up(il,i)-u(il,i-1)))*dpinv
-         fv(il,i)=fv(il,i)+0.01*grav*(mp(il,i+1)*(vp(il,i+1)-v(il,i))
-     :             -mp(il,i)*(vp(il,i)-v(il,i-1)))*dpinv
-        else  ! cvflag_grav
-         fr(il,i)=fr(il,i)+0.5*sigd*(evap(il,i)+evap(il,i+1))
-     :        +0.1*(mp(il,i+1)*(rp(il,i+1)-rr(il,i))-mp(il,i)
-     :               *(rp(il,i)-rr(il,i-1)))*dpinv
-         fu(il,i)=fu(il,i)+0.1*(mp(il,i+1)*(up(il,i+1)-u(il,i))
-     :             -mp(il,i)*(up(il,i)-u(il,i-1)))*dpinv
-         fv(il,i)=fv(il,i)+0.1*(mp(il,i+1)*(vp(il,i+1)-v(il,i))
-     :             -mp(il,i)*(vp(il,i)-v(il,i-1)))*dpinv
-        endif ! cvflag_grav
-
-      endif ! i
-1400  continue
-
-c sb: interface with the cloud parameterization:          ! cld
-
-      do k=i+1,nl
-       do il=1,ncum 
-        if (k.le.inb(il) .and. i.le.inb(il)) then         ! cld
-C (saturated downdrafts resulting from mixing)            ! cld
-          qcond(il,i)=qcond(il,i)+elij(il,k,i)            ! cld
-          nqcond(il,i)=nqcond(il,i)+1.                    ! cld
-        endif                                             ! cld
-       enddo                                              ! cld
-      enddo                                               ! cld
-
-C (particular case: no detraining level is found)         ! cld
-      do il=1,ncum                                        ! cld
-       if (i.le.inb(il) .and. nent(il,i).eq.0) then       ! cld
-          qcond(il,i)=qcond(il,i)+(1.-ep(il,i))*clw(il,i) ! cld
-          nqcond(il,i)=nqcond(il,i)+1.                    ! cld
-       endif                                              ! cld
-      enddo                                               ! cld
-
-      do il=1,ncum                                        ! cld
-       if (i.le.inb(il) .and. nqcond(il,i).ne.0.) then    ! cld
-          qcond(il,i)=qcond(il,i)/nqcond(il,i)            ! cld
-       endif                                              ! cld
-      enddo
-
-      do j=1,ntra
-       do il=1,ncum
-        if (i.le.inb(il)) then
-         dpinv=1.0/(ph(il,i)-ph(il,i+1))
-         cpinv=1.0/cpn(il,i)
-
-         if (cvflag_grav) then
-          ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv
-     :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
-     :     -mp(il,i)*(trap(il,i,j)-trap(il,i-1,j)))
-         else
-          ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv
-     :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
-     :     -mp(il,i)*(trap(il,i,j)-trap(il,i-1,j)))
-         endif
-        endif ! i
-       enddo
-      enddo 
-
-
-500   continue
-
-
-c   ***   move the detrainment at level inb down to level inb-1   ***
-c   ***        in such a way as to preserve the vertically        ***
-c   ***          integrated enthalpy and water tendencies         ***
-c
-      do 503 il=1,ncum
-
-      ax=0.1*ment(il,inb(il),inb(il))*(hp(il,inb(il))-h(il,inb(il))
-     : +t(il,inb(il))*(cpv-cpd)
-     : *(rr(il,inb(il))-qent(il,inb(il),inb(il))))
-     :  /(cpn(il,inb(il))*(ph(il,inb(il))-ph(il,inb(il)+1)))
-      ft(il,inb(il))=ft(il,inb(il))-ax
-      ft(il,inb(il)-1)=ft(il,inb(il)-1)+ax*cpn(il,inb(il))
-     :    *(ph(il,inb(il))-ph(il,inb(il)+1))/(cpn(il,inb(il)-1)
-     :    *(ph(il,inb(il)-1)-ph(il,inb(il))))
-
-      bx=0.1*ment(il,inb(il),inb(il))*(qent(il,inb(il),inb(il))
-     :    -rr(il,inb(il)))/(ph(il,inb(il))-ph(il,inb(il)+1))
-      fr(il,inb(il))=fr(il,inb(il))-bx
-      fr(il,inb(il)-1)=fr(il,inb(il)-1)
-     :   +bx*(ph(il,inb(il))-ph(il,inb(il)+1))
-     :      /(ph(il,inb(il)-1)-ph(il,inb(il)))
-
-      cx=0.1*ment(il,inb(il),inb(il))*(uent(il,inb(il),inb(il))
-     :       -u(il,inb(il)))/(ph(il,inb(il))-ph(il,inb(il)+1))
-      fu(il,inb(il))=fu(il,inb(il))-cx
-      fu(il,inb(il)-1)=fu(il,inb(il)-1)
-     :     +cx*(ph(il,inb(il))-ph(il,inb(il)+1))
-     :        /(ph(il,inb(il)-1)-ph(il,inb(il)))
-
-      dx=0.1*ment(il,inb(il),inb(il))*(vent(il,inb(il),inb(il))
-     :      -v(il,inb(il)))/(ph(il,inb(il))-ph(il,inb(il)+1))
-      fv(il,inb(il))=fv(il,inb(il))-dx
-      fv(il,inb(il)-1)=fv(il,inb(il)-1)
-     :    +dx*(ph(il,inb(il))-ph(il,inb(il)+1))
-     :       /(ph(il,inb(il)-1)-ph(il,inb(il)))
-
-503   continue
-
-      do j=1,ntra
-       do il=1,ncum
-        ex=0.1*ment(il,inb(il),inb(il)) 
-     :      *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
-     :      /(ph(i l,inb(il))-ph(il,inb(il)+1))
-        ftra(il,inb(il),j)=ftra(il,inb(il),j)-ex
-        ftra(il,inb(il)-1,j)=ftra(il,inb(il)-1,j)
-     :       +ex*(ph(il,inb(il))-ph(il,inb(il)+1))
-     :          /(ph(il,inb(il)-1)-ph(il,inb(il)))
-       enddo
-      enddo
-
-c
-c   ***    homoginize tendencies below cloud base    ***
-c
-c
-      do il=1,ncum
-       asum(il)=0.0
-       bsum(il)=0.0
-       csum(il)=0.0
-       dsum(il)=0.0
-      enddo
-
-      do i=1,nl
-       do il=1,ncum
-        if (i.le.(icb(il)-1)) then
-      asum(il)=asum(il)+ft(il,i)*(ph(il,i)-ph(il,i+1))
-      bsum(il)=bsum(il)+fr(il,i)*(lv(il,i)+(cl-cpd)*(t(il,i)-t(il,1)))
-     :                  *(ph(il,i)-ph(il,i+1))
-      csum(il)=csum(il)+(lv(il,i)+(cl-cpd)*(t(il,i)-t(il,1)))
-     :                      *(ph(il,i)-ph(il,i+1))
-      dsum(il)=dsum(il)+t(il,i)*(ph(il,i)-ph(il,i+1))/th(il,i)
-        endif 
-       enddo
-      enddo
-
-c!!!      do 700 i=1,icb(il)-1
-      do i=1,nl
-       do il=1,ncum
-        if (i.le.(icb(il)-1)) then
-         ft(il,i)=asum(il)*t(il,i)/(th(il,i)*dsum(il))
-         fr(il,i)=bsum(il)/csum(il)
-        endif
-       enddo
-      enddo
-
-c
-c   ***           reset counter and return           ***
-c
-      do il=1,ncum
-       sig(il,nd)=2.0
-      enddo
-
-
-      do i=1,nd
-       do il=1,ncum
-        upwd(il,i)=0.0
-        dnwd(il,i)=0.0
-       enddo
-      enddo
-      
-      do i=1,nl
-       do il=1,ncum
-        dnwd0(il,i)=-mp(il,i)
-       enddo
-      enddo
-      do i=nl+1,nd
-       do il=1,ncum
-        dnwd0(il,i)=0.
-       enddo
-      enddo
-
-
-      do i=1,nl
-       do il=1,ncum
-        if (i.ge.icb(il) .and. i.le.inb(il)) then
-          upwd(il,i)=0.0
-          dnwd(il,i)=0.0
-        endif
-       enddo
-      enddo
-
-      do i=1,nl
-       do k=1,nl
-        do il=1,ncum
-          up1(il,k,i)=0.0
-          dn1(il,k,i)=0.0
-        enddo
-       enddo
-      enddo
-
-      do i=1,nl
-       do k=i,nl
-        do n=1,i-1
-         do il=1,ncum
-          if (i.ge.icb(il).and.i.le.inb(il).and.k.le.inb(il)) then
-             up1(il,k,i)=up1(il,k,i)+ment(il,n,k)
-             dn1(il,k,i)=dn1(il,k,i)-ment(il,k,n)
-          endif
-         enddo
-        enddo
-       enddo
-      enddo
-
-      do i=1,nl
-       do k=i,nl
-        do il=1,ncum
-         if (i.ge.icb(il).and.i.le.inb(il).and.k.le.inb(il)) then
-            upwd(il,i)=upwd(il,i)+m(il,k)+up1(il,k,i)
-            dnwd(il,i)=dnwd(il,i)+dn1(il,k,i)
-         endif
-        enddo
-       enddo
-      enddo
-
-
-c!!!      DO il=1,ncum
-c!!!      do i=icb(il),inb(il)
-c!!!     
-c!!!      upwd(il,i)=0.0
-c!!!      dnwd(il,i)=0.0
-c!!!      do k=i,inb(il)
-c!!!      up1=0.0
-c!!!      dn1=0.0
-c!!!      do n=1,i-1
-c!!!      up1=up1+ment(il,n,k)
-c!!!      dn1=dn1-ment(il,k,n)
-c!!!      enddo
-c!!!      upwd(il,i)=upwd(il,i)+m(il,k)+up1
-c!!!      dnwd(il,i)=dnwd(il,i)+dn1
-c!!!      enddo
-c!!!      enddo
-c!!!
-c!!!      ENDDO
-
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-c        determination de la variation de flux ascendant entre
-c        deux niveau non dilue mike
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-      do i=1,nl
-       do il=1,ncum
-        mike(il,i)=m(il,i)
-       enddo
-      enddo
-
-      do i=nl+1,nd
-       do il=1,ncum
-        mike(il,i)=0.
-       enddo
-      enddo
-
-      do i=1,nd
-       do il=1,ncum
-        ma(il,i)=0
-       enddo
-      enddo
-
-      do i=1,nl
-       do j=i,nl
-        do il=1,ncum
-         ma(il,i)=ma(il,i)+m(il,j)
-        enddo
-       enddo
-      enddo
-
-      do i=nl+1,nd
-       do il=1,ncum
-        ma(il,i)=0.
-       enddo
-      enddo
-
-      do i=1,nl
-       do il=1,ncum
-        if (i.le.(icb(il)-1)) then
-         ma(il,i)=0
-        endif
-       enddo
-      enddo
-
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-c        icb represente de niveau ou se trouve la
-c        base du nuage , et inb le top du nuage
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-      do i=1,nd
-       do il=1,ncum
-        mke(il,i)=upwd(il,i)+dnwd(il,i)
-       enddo
-      enddo
-
-      do i=1,nd
-       DO 999 il=1,ncum
-        rdcp=(rrd*(1.-rr(il,i))-rr(il,i)*rrv)
-     :        /(cpd*(1.-rr(il,i))+rr(il,i)*cpv)
-        tls(il,i)=t(il,i)*(1000.0/p(il,i))**rdcp
-        tps(il,i)=tp(il,i)
-999    CONTINUE
-      enddo
-
-c
-c   *** diagnose the in-cloud mixing ratio   ***            ! cld
-c   ***           of condensed water         ***            ! cld
-c                                                           ! cld
-
-       do i=1,nd                                            ! cld
-        do il=1,ncum                                        ! cld
-         mac(il,i)=0.0                                      ! cld
-         wa(il,i)=0.0                                       ! cld
-         siga(il,i)=0.0                                     ! cld
-         sax(il,i)=0.0                                      ! cld
-        enddo                                               ! cld
-       enddo                                                ! cld
-
-       do i=minorig, nl                                     ! cld
-        do k=i+1,nl+1                                       ! cld
-         do il=1,ncum                                       ! cld
-          if (i.le.inb(il) .and. k.le.(inb(il)+1)) then     ! cld
-            mac(il,i)=mac(il,i)+m(il,k)                     ! cld
-          endif                                             ! cld
-         enddo                                              ! cld
-        enddo                                               ! cld
-       enddo                                                ! cld
-
-       do i=1,nl                                            ! cld
-        do j=1,i                                            ! cld
-         do il=1,ncum                                       ! cld
-          if (i.ge.icb(il) .and. i.le.(inb(il)-1)           ! cld
-     :      .and. j.ge.icb(il) ) then                       ! cld
-           sax(il,i)=sax(il,i)+rrd*(tvp(il,j)-tv(il,j))     ! cld
-     :        *(ph(il,j)-ph(il,j+1))/p(il,j)                ! cld
-          endif                                             ! cld
-         enddo                                              ! cld
-        enddo                                               ! cld
-       enddo                                                ! cld
-
-       do i=1,nl                                            ! cld
-        do il=1,ncum                                        ! cld
-         if (i.ge.icb(il) .and. i.le.(inb(il)-1)            ! cld
-     :       .and. sax(il,i).gt.0.0 ) then                  ! cld
-           wa(il,i)=sqrt(2.*sax(il,i))                      ! cld
-         endif                                              ! cld
-        enddo                                               ! cld
-       enddo                                                ! cld
-            
-       do i=1,nl                                            ! cld
-        do il=1,ncum                                        ! cld
-         if (wa(il,i).gt.0.0)                               ! cld
-     :     siga(il,i)=mac(il,i)/wa(il,i)                    ! cld
-     :         *rrd*tvp(il,i)/p(il,i)/100./delta            ! cld
-          siga(il,i) = min(siga(il,i),1.0)                  ! cld
-          qcondc(il,i)=siga(il,i)*clw(il,i)*(1.-ep(il,i))   ! cld
-     :           + (1.-siga(il,i))*qcond(il,i)              ! cld
-        enddo                                               ! cld
-       enddo                                                ! cld
-
-        return
-        end
-
-
-      SUBROUTINE cv3_uncompress(nloc,len,ncum,nd,ntra,idcum
-     :         ,iflag
-     :         ,precip,sig,w0
-     :         ,ft,fq,fu,fv,ftra
-     :         ,Ma,upwd,dnwd,dnwd0,qcondc,wd,cape
-     :         ,iflag1
-     :         ,precip1,sig1,w01
-     :         ,ft1,fq1,fu1,fv1,ftra1
-     :         ,Ma1,upwd1,dnwd1,dnwd01,qcondc1,wd1,cape1
-     :                               )
-      implicit none
-
-#include "cvparam3.h"
-
-c inputs:
-      integer len, ncum, nd, ntra, nloc
-      integer idcum(nloc)
-      integer iflag(nloc)
-      real precip(nloc)
-      real sig(nloc,nd), w0(nloc,nd)
-      real ft(nloc,nd), fq(nloc,nd), fu(nloc,nd), fv(nloc,nd)
-      real ftra(nloc,nd,ntra)
-      real Ma(nloc,nd)
-      real upwd(nloc,nd),dnwd(nloc,nd),dnwd0(nloc,nd)
-      real qcondc(nloc,nd)
-      real wd(nloc),cape(nloc)
-
-c outputs:
-      integer iflag1(len)
-      real precip1(len)
-      real sig1(len,nd), w01(len,nd)
-      real ft1(len,nd), fq1(len,nd), fu1(len,nd), fv1(len,nd)
-      real ftra1(len,nd,ntra)
-      real Ma1(len,nd)
-      real upwd1(len,nd),dnwd1(len,nd),dnwd01(len,nd)
-      real qcondc1(nloc,nd)
-      real wd1(nloc),cape1(nloc)
-
-c local variables:
-      integer i,k,j
-
-        do 2000 i=1,ncum
-         precip1(idcum(i))=precip(i)
-         iflag1(idcum(i))=iflag(i)
-         wd1(idcum(i))=wd(i)
-         cape1(idcum(i))=cape(i)
- 2000   continue
-
-        do 2020 k=1,nl
-          do 2010 i=1,ncum
-            sig1(idcum(i),k)=sig(i,k)
-            w01(idcum(i),k)=w0(i,k)
-            ft1(idcum(i),k)=ft(i,k)
-            fq1(idcum(i),k)=fq(i,k)
-            fu1(idcum(i),k)=fu(i,k)
-            fv1(idcum(i),k)=fv(i,k)
-            Ma1(idcum(i),k)=Ma(i,k)
-            upwd1(idcum(i),k)=upwd(i,k)
-            dnwd1(idcum(i),k)=dnwd(i,k)
-            dnwd01(idcum(i),k)=dnwd0(i,k)
-            qcondc1(idcum(i),k)=qcondc(i,k)
- 2010     continue
- 2020   continue
-
-        do 2200 i=1,ncum
-          sig1(idcum(i),nd)=sig(i,nd)
-2200    continue
-
-
-        do 2100 j=1,ntra
-c oct3         do 2110 k=1,nl
-         do 2110 k=1,nd ! oct3
-          do 2120 i=1,ncum
-            ftra1(idcum(i),k,j)=ftra(i,k,j)
- 2120     continue
- 2110    continue
- 2100   continue
-
-        return
-        end
-
Index: LMDZ.3.3/branches/rel-/libf/phylmd/cv_driver.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/cv_driver.F	(revision 416)
+++ 	(revision )
@@ -1,670 +1,0 @@
-      SUBROUTINE cv_driver(len,nd,ndp1,ntra,iflag_con,
-     &                   t1,q1,qs1,u1,v1,tra1,
-     &                   p1,ph1,iflag1,ft1,fq1,fu1,fv1,ftra1,
-     &                   precip1,
-     &                   cbmf1,sig1,w01,
-     &                   delt,Ma1,upwd1,dnwd1,dnwd01,qcondc1,wd1,cape1)
-C
-      implicit none
-C
-C.............................START PROLOGUE............................
-C
-C PARAMETERS:
-C      Name            Type         Usage            Description
-C   ----------      ----------     -------  ----------------------------
-C
-C      len           Integer        Input        first (i) dimension
-C      nd            Integer        Input        vertical (k) dimension
-C      ndp1          Integer        Input        nd + 1
-C      ntra          Integer        Input        number of tracors
-C      iflag_con     Integer        Input        version of convect (3/4)
-C      t1            Real           Input        temperature
-C      q1            Real           Input        specific hum
-C      qs1           Real           Input        sat specific hum
-C      u1            Real           Input        u-wind
-C      v1            Real           Input        v-wind
-C      tra1          Real           Input        tracors
-C      p1            Real           Input        full level pressure
-C      ph1           Real           Input        half level pressure
-C      iflag1        Integer        Output       flag for Emanuel conditions
-C      ft1           Real           Output       temp tend
-C      fq1           Real           Output       spec hum tend
-C      fu1           Real           Output       u-wind tend
-C      fv1           Real           Output       v-wind tend
-C      ftra1         Real           Output       tracor tend
-C      precip1       Real           Output       precipitation
-C      cbmf1         Real           Output       cloud base mass flux
-C      sig1          Real           In/Out       section adiabatic updraft
-C      w01           Real           In/Out       vertical velocity within adiab updraft
-C      delt          Real           Input        time step
-C      Ma1           Real           Output       mass flux adiabatic updraft
-C      upwd1         Real           Output       total upward mass flux (adiab+mixed)
-C      dnwd1         Real           Output       saturated downward mass flux (mixed)
-C      dnwd01        Real           Output       unsaturated downward mass flux 
-C      qcondc1       Real           Output       in-cld mixing ratio of condensed water
-C      wd1           Real           Output       downdraft velocity scale for sfc fluxes
-C      cape1         Real           Output       CAPE
-C
-C S. Bony, Mar 2002:
-C 	* Several modules corresponding to different physical processes
-C 	* Several versions of convect may be used:
-C  		- iflag_con=3: version lmd  (previously named convect3) 
-C  		- iflag_con=4: version 4.3b (vect. version, previously convect1/2) 
-C   + tard: 	- iflag_con=5: version lmd with ice (previously named convectg) 
-C S. Bony, Oct 2002:
-C	* Vectorization of convect3 (ie version lmd)
-C
-C..............................END PROLOGUE.............................
-c
-c
-#include "dimensions.h"
-#include "dimphy.h"
-
-      integer len
-      integer nd
-      integer ndp1
-      integer noff
-      integer iflag_con
-      integer ntra
-      real t1(len,nd)
-      real q1(len,nd)
-      real qs1(len,nd)
-      real u1(len,nd)
-      real v1(len,nd)
-      real p1(len,nd)
-      real ph1(len,ndp1)
-      integer iflag1(len)
-      real ft1(len,nd)
-      real fq1(len,nd)
-      real fu1(len,nd)
-      real fv1(len,nd)
-      real precip1(len)
-      real cbmf1(len)
-      real Ma1(len,nd)
-      real upwd1(len,nd)
-      real dnwd1(len,nd)
-      real dnwd01(len,nd)
-
-      real qcondc1(len,nd)     ! cld
-      real wd1(len)            ! gust
-      real cape1(len)     
-
-      real tra1(len,nd,ntra)
-      real ftra1(len,nd,ntra)
-
-      real delt
-
-!-------------------------------------------------------------------
-! --- ARGUMENTS
-!-------------------------------------------------------------------
-! --- On input:
-!
-!  t:   Array of absolute temperature (K) of dimension ND, with first
-!       index corresponding to lowest model level. Note that this array
-!       will be altered by the subroutine if dry convective adjustment
-!       occurs and if IPBL is not equal to 0.
-!
-!  q:   Array of specific humidity (gm/gm) of dimension ND, with first
-!       index corresponding to lowest model level. Must be defined
-!       at same grid levels as T. Note that this array will be altered
-!       if dry convective adjustment occurs and if IPBL is not equal to 0.
-!
-!  qs:  Array of saturation specific humidity of dimension ND, with first
-!       index corresponding to lowest model level. Must be defined
-!       at same grid levels as T. Note that this array will be altered
-!       if dry convective adjustment occurs and if IPBL is not equal to 0.
-!
-!  u:   Array of zonal wind velocity (m/s) of dimension ND, witth first
-!       index corresponding with the lowest model level. Defined at
-!       same levels as T. Note that this array will be altered if
-!       dry convective adjustment occurs and if IPBL is not equal to 0.
-!
-!  v:   Same as u but for meridional velocity.
-!
-!  tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
-!       where NTRA is the number of different tracers. If no
-!       convective tracer transport is needed, define a dummy
-!       input array of dimension (ND,1). Tracers are defined at
-!       same vertical levels as T. Note that this array will be altered
-!       if dry convective adjustment occurs and if IPBL is not equal to 0.
-!
-!  p:   Array of pressure (mb) of dimension ND, with first
-!       index corresponding to lowest model level. Must be defined
-!       at same grid levels as T.
-!
-!  ph:  Array of pressure (mb) of dimension ND+1, with first index
-!       corresponding to lowest level. These pressures are defined at
-!       levels intermediate between those of P, T, Q and QS. The first
-!       value of PH should be greater than (i.e. at a lower level than)
-!       the first value of the array P.
-!
-!  nl:  The maximum number of levels to which convection can penetrate, plus 1.
-!       NL MUST be less than or equal to ND-1.
-!
-!  delt: The model time step (sec) between calls to CONVECT
-!
-!----------------------------------------------------------------------------
-! ---   On Output:
-!
-!  iflag: An output integer whose value denotes the following:
-!       VALUE   INTERPRETATION
-!       -----   --------------
-!         0     Moist convection occurs.
-!         1     Moist convection occurs, but a CFL condition
-!               on the subsidence warming is violated. This
-!               does not cause the scheme to terminate.
-!         2     Moist convection, but no precip because ep(inb) lt 0.0001
-!         3     No moist convection because new cbmf is 0 and old cbmf is 0.
-!         4     No moist convection; atmosphere is not
-!               unstable
-!         6     No moist convection because ihmin le minorig.
-!         7     No moist convection because unreasonable
-!               parcel level temperature or specific humidity.
-!         8     No moist convection: lifted condensation
-!               level is above the 200 mb level.
-!         9     No moist convection: cloud base is higher
-!               then the level NL-1.
-!
-!  ft:   Array of temperature tendency (K/s) of dimension ND, defined at same
-!        grid levels as T, Q, QS and P.
-!
-!  fq:   Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
-!        defined at same grid levels as T, Q, QS and P.
-!
-!  fu:   Array of forcing of zonal velocity (m/s^2) of dimension ND,
-!        defined at same grid levels as T.
-!
-!  fv:   Same as FU, but for forcing of meridional velocity.
-!
-!  ftra: Array of forcing of tracer content, in tracer mixing ratio per
-!        second, defined at same levels as T. Dimensioned (ND,NTRA).
-!
-!  precip: Scalar convective precipitation rate (mm/day).
-!
-!  wd:   A convective downdraft velocity scale. For use in surface
-!        flux parameterizations. See convect.ps file for details.
-!
-!  tprime: A convective downdraft temperature perturbation scale (K).
-!          For use in surface flux parameterizations. See convect.ps
-!          file for details.
-!
-!  qprime: A convective downdraft specific humidity
-!          perturbation scale (gm/gm).
-!          For use in surface flux parameterizations. See convect.ps
-!          file for details.
-!
-!  cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
-!        BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
-!        ITS NEXT CALL. That is, the value of CBMF must be "remembered"
-!        by the calling program between calls to CONVECT.
-!
-!  det:   Array of detrainment mass flux of dimension ND.
-!
-!-------------------------------------------------------------------
-c
-c  Local arrays
-c
-
-      integer i,k,n,il,j
-      integer icbmax
-      integer nk1(klon)
-      integer icb1(klon)
-      integer icbs1(klon)
-
-      real plcl1(klon)
-      real tnk1(klon)
-      real qnk1(klon)
-      real gznk1(klon)
-      real pnk1(klon)
-      real qsnk1(klon)
-      real pbase1(klon)
-      real buoybase1(klon)
-
-      real lv1(klon,klev)
-      real cpn1(klon,klev)
-      real tv1(klon,klev)
-      real gz1(klon,klev)
-      real hm1(klon,klev)
-      real h1(klon,klev)
-      real tp1(klon,klev)
-      real tvp1(klon,klev)
-      real clw1(klon,klev)
-      real sig1(klon,klev)
-      real w01(klon,klev)
-      real th1(klon,klev)
-c
-      integer ncum
-c
-c (local) compressed fields:
-c
-      integer nloc
-      parameter (nloc=klon) ! pour l'instant
-
-      integer idcum(nloc)
-      integer iflag(nloc),nk(nloc),icb(nloc)
-      integer nent(nloc,klev)
-      integer icbs(nloc)
-      integer inb(nloc), inbis(nloc)
-
-      real cbmf(nloc),plcl(nloc),tnk(nloc),qnk(nloc),gznk(nloc)
-      real t(nloc,klev),q(nloc,klev),qs(nloc,klev)
-      real u(nloc,klev),v(nloc,klev)
-      real gz(nloc,klev),h(nloc,klev),lv(nloc,klev),cpn(nloc,klev)
-      real p(nloc,klev),ph(nloc,klev+1),tv(nloc,klev),tp(nloc,klev)
-      real clw(nloc,klev)
-      real dph(nloc,klev)
-      real pbase(nloc), buoybase(nloc), th(nloc,klev)
-      real tvp(nloc,klev)
-      real sig(nloc,klev), w0(nloc,klev)
-      real hp(nloc,klev), ep(nloc,klev), sigp(nloc,klev)
-      real frac(nloc), buoy(nloc,klev)
-      real cape(nloc)
-      real m(nloc,klev), ment(nloc,klev,klev), qent(nloc,klev,klev)
-      real uent(nloc,klev,klev), vent(nloc,klev,klev)
-      real ments(nloc,klev,klev), qents(nloc,klev,klev)
-      real sij(nloc,klev,klev), elij(nloc,klev,klev)
-      real mp(nloc,klev), qp(nloc,klev), up(nloc,klev), vp(nloc,klev)
-      real wt(nloc,klev), water(nloc,klev), evap(nloc,klev)
-      real b(nloc,klev), ft(nloc,klev), fq(nloc,klev)
-      real fu(nloc,klev), fv(nloc,klev)
-      real upwd(nloc,klev), dnwd(nloc,klev), dnwd0(nloc,klev)
-      real Ma(nloc,klev), mike(nloc,klev), tls(nloc,klev)
-      real tps(nloc,klev), qprime(nloc), tprime(nloc)
-      real precip(nloc)
-      real tra(nloc,klev,ntra), trap(nloc,klev,ntra)
-      real ftra(nloc,klev,ntra), traent(nloc,klev,klev,ntra)
-      real qcondc(nloc,klev)  ! cld
-      real wd(nloc)           ! gust
-
-!-------------------------------------------------------------------
-! --- SET CONSTANTS AND PARAMETERS
-!-------------------------------------------------------------------
-
-c -- set simulation flags:
-c   (common cvflag)
-
-       CALL cv_flag
-
-c -- set thermodynamical constants:
-c 	(common cvthermo)
-
-       CALL cv_thermo(iflag_con)
-
-c -- set convect parameters 
-c
-c 	includes microphysical parameters and parameters that 
-c  	control the rate of approach to quasi-equilibrium) 
-c 	(common cvparam)
-
-      if (iflag_con.eq.3) then
-       CALL cv3_param(nd,delt)
-      endif
-
-      if (iflag_con.eq.4) then
-       CALL cv_param(nd)
-      endif
-
-!---------------------------------------------------------------------
-! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
-!---------------------------------------------------------------------
-
-      do 20 k=1,nd
-        do 10 i=1,len
-         ft1(i,k)=0.0
-         fq1(i,k)=0.0
-         fu1(i,k)=0.0
-         fv1(i,k)=0.0
-         tvp1(i,k)=0.0
-         tp1(i,k)=0.0
-         clw1(i,k)=0.0
-         gz1(i,k) = 0.
-
-         Ma1(i,k)=0.0
-         upwd1(i,k)=0.0
-         dnwd1(i,k)=0.0
-         dnwd01(i,k)=0.0
-         qcondc1(i,k)=0.0
- 10     continue
- 20   continue
-
-      do 30 j=1,ntra
-       do 31 k=1,nd
-        do 32 i=1,len
-         ftra1(i,k,j)=0.0
- 32     continue    
- 31    continue    
- 30   continue    
-
-      do 60 i=1,len
-        precip1(i)=0.0
-        iflag1(i)=0
-        wd1(i)=0.0
-        cape1(i)=0.0
- 60   continue
-
-      if (iflag_con.eq.3) then
-        do il=1,len
-         sig1(il,nd)=sig1(il,nd)+1.
-         sig1(il,nd)=amin1(sig1(il,nd),12.1)
-        enddo
-      endif
-
-!--------------------------------------------------------------------
-! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
-!--------------------------------------------------------------------
-
-      if (iflag_con.eq.3) then
-       CALL cv3_prelim(len,nd,ndp1,t1,q1,p1,ph1            ! nd->na
-     o               ,lv1,cpn1,tv1,gz1,h1,hm1,th1)
-      endif
-
-      if (iflag_con.eq.4) then
-       CALL cv_prelim(len,nd,ndp1,t1,q1,p1,ph1
-     o               ,lv1,cpn1,tv1,gz1,h1,hm1)
-      endif
-
-!--------------------------------------------------------------------
-! --- CONVECTIVE FEED
-!--------------------------------------------------------------------
-
-      if (iflag_con.eq.3) then
-       CALL cv3_feed(len,nd,t1,q1,qs1,p1,ph1,hm1,gz1           ! nd->na
-     o         ,nk1,icb1,icbmax,iflag1,tnk1,qnk1,gznk1,plcl1)
-      endif 
-
-      if (iflag_con.eq.4) then
-       CALL cv_feed(len,nd,t1,q1,qs1,p1,hm1,gz1
-     o         ,nk1,icb1,icbmax,iflag1,tnk1,qnk1,gznk1,plcl1)
-      endif 
-
-!--------------------------------------------------------------------
-! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part 
-! (up through ICB for convect4, up through ICB+1 for convect3)
-!     Calculates the lifted parcel virtual temperature at nk, the
-!     actual temperature, and the adiabatic liquid water content. 
-!--------------------------------------------------------------------
-
-      if (iflag_con.eq.3) then
-       CALL cv3_undilute1(len,nd,t1,q1,qs1,gz1,plcl1,p1,nk1,icb1  ! nd->na
-     o                        ,tp1,tvp1,clw1,icbs1)
-      endif
-
-      if (iflag_con.eq.4) then
-       CALL cv_undilute1(len,nd,t1,q1,qs1,gz1,p1,nk1,icb1,icbmax
-     :                        ,tp1,tvp1,clw1)
-      endif
-
-!-------------------------------------------------------------------
-! --- TRIGGERING
-!-------------------------------------------------------------------
-
-      if (iflag_con.eq.3) then
-       CALL cv3_trigger(len,nd,icb1,plcl1,p1,th1,tv1,tvp1      ! nd->na
-     o                 ,pbase1,buoybase1,iflag1,sig1,w01)
-      endif
-
-      if (iflag_con.eq.4) then
-       CALL cv_trigger(len,nd,icb1,cbmf1,tv1,tvp1,iflag1)
-      endif
-
-!=====================================================================
-! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
-!=====================================================================
-
-      ncum=0
-      do 400 i=1,len
-        if(iflag1(i).eq.0)then
-           ncum=ncum+1
-           idcum(ncum)=i
-        endif
- 400  continue
-
-c       print*,'klon, ncum = ',len,ncum
-
-      IF (ncum.gt.0) THEN
-
-!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-! --- COMPRESS THE FIELDS
-!		(-> vectorization over convective gridpoints)
-!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-
-      if (iflag_con.eq.3) then
-       CALL cv3_compress( len,nloc,ncum,nd,ntra
-     :    ,iflag1,nk1,icb1,icbs1
-     :    ,plcl1,tnk1,qnk1,gznk1,pbase1,buoybase1
-     :    ,t1,q1,qs1,u1,v1,gz1,th1
-     :    ,tra1
-     :    ,h1,lv1,cpn1,p1,ph1,tv1,tp1,tvp1,clw1 
-     :    ,sig1,w01
-     o    ,iflag,nk,icb,icbs
-     o    ,plcl,tnk,qnk,gznk,pbase,buoybase
-     o    ,t,q,qs,u,v,gz,th
-     o    ,tra
-     o    ,h,lv,cpn,p,ph,tv,tp,tvp,clw 
-     o    ,sig,w0  )
-      endif
-
-      if (iflag_con.eq.4) then
-       CALL cv_compress( len,nloc,ncum,nd
-     :    ,iflag1,nk1,icb1
-     :    ,cbmf1,plcl1,tnk1,qnk1,gznk1
-     :    ,t1,q1,qs1,u1,v1,gz1
-     :    ,h1,lv1,cpn1,p1,ph1,tv1,tp1,tvp1,clw1
-     o    ,iflag,nk,icb
-     o    ,cbmf,plcl,tnk,qnk,gznk
-     o    ,t,q,qs,u,v,gz,h,lv,cpn,p,ph,tv,tp,tvp,clw 
-     o    ,dph )
-      endif
-
-!-------------------------------------------------------------------
-! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
-! ---   FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
-! ---   &
-! ---   COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
-! ---   FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
-! ---   &
-! ---   FIND THE LEVEL OF NEUTRAL BUOYANCY
-!-------------------------------------------------------------------
-
-      if (iflag_con.eq.3) then
-       CALL cv3_undilute2(nloc,ncum,nd,icb,icbs,nk        !na->nd
-     :                        ,tnk,qnk,gznk,t,q,qs,gz
-     :                        ,p,h,tv,lv,pbase,buoybase,plcl
-     o                        ,inb,tp,tvp,clw,hp,ep,sigp,buoy)
-      endif
-
-      if (iflag_con.eq.4) then
-       CALL cv_undilute2(nloc,ncum,nd,icb,nk
-     :                        ,tnk,qnk,gznk,t,q,qs,gz
-     :                        ,p,dph,h,tv,lv
-     o             ,inb,inbis,tp,tvp,clw,hp,ep,sigp,frac)
-      endif
-
-!-------------------------------------------------------------------
-! --- CLOSURE
-!-------------------------------------------------------------------
-
-      if (iflag_con.eq.3) then
-       CALL cv3_closure(nloc,ncum,nd,icb,inb              ! na->nd
-     :                       ,pbase,p,ph,tv,buoy
-     o                       ,sig,w0,cape,m)
-      endif
-
-      if (iflag_con.eq.4) then
-       CALL cv_closure(nloc,ncum,nd,nk,icb
-     :                ,tv,tvp,p,ph,dph,plcl,cpn
-     o                ,iflag,cbmf)
-      endif
-
-!-------------------------------------------------------------------
-! --- MIXING
-!-------------------------------------------------------------------
-
-      if (iflag_con.eq.3) then
-       CALL cv3_mixing(nloc,ncum,nd,nd,ntra,icb,nk,inb    ! na->nd
-     :                     ,ph,t,q,qs,u,v,tra,h,lv,qnk
-     :                     ,hp,tv,tvp,ep,clw,m,sig
-     o ,ment,qent,uent,vent,sij,elij,ments,qents,traent)
-      endif
-
-      if (iflag_con.eq.4) then
-       CALL cv_mixing(nloc,ncum,nd,icb,nk,inb,inbis
-     :                     ,ph,t,q,qs,u,v,h,lv,qnk
-     :                     ,hp,tv,tvp,ep,clw,cbmf
-     o                     ,m,ment,qent,uent,vent,nent,sij,elij)
-      endif
-
-!-------------------------------------------------------------------
-! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
-!-------------------------------------------------------------------
-
-      if (iflag_con.eq.3) then
-       CALL cv3_unsat(nloc,ncum,nd,nd,ntra,icb,inb    ! na->nd
-     :               ,t,q,qs,gz,u,v,tra,p,ph
-     :               ,th,tv,lv,cpn,ep,sigp,clw
-     :               ,m,ment,elij,delt,plcl
-     o          ,mp,qp,up,vp,trap,wt,water,evap,b)
-      endif
-
-      if (iflag_con.eq.4) then
-       CALL cv_unsat(nloc,ncum,nd,inb,t,q,qs,gz,u,v,p,ph
-     :                   ,h,lv,ep,sigp,clw,m,ment,elij
-     o                   ,iflag,mp,qp,up,vp,wt,water,evap)
-      endif
-
-!-------------------------------------------------------------------
-! --- YIELD
-!     (tendencies, precipitation, variables of interface with other
-!      processes, etc)
-!-------------------------------------------------------------------
-
-      if (iflag_con.eq.3) then
-       CALL cv3_yield(nloc,ncum,nd,nd,ntra            ! na->nd
-     :                     ,icb,inb,delt
-     :                     ,t,q,u,v,tra,gz,p,ph,h,hp,lv,cpn,th
-     :                     ,ep,clw,m,tp,mp,qp,up,vp,trap
-     :                     ,wt,water,evap,b
-     :                     ,ment,qent,uent,vent,nent,elij,traent,sig
-     :                     ,tv,tvp
-     o                     ,iflag,precip,ft,fq,fu,fv,ftra
-     o                     ,upwd,dnwd,dnwd0,ma,mike,tls,tps,qcondc,wd)
-      endif
-
-      if (iflag_con.eq.4) then
-       CALL cv_yield(nloc,ncum,nd,nk,icb,inb,delt
-     :              ,t,q,u,v,gz,p,ph,h,hp,lv,cpn
-     :              ,ep,clw,frac,m,mp,qp,up,vp
-     :              ,wt,water,evap
-     :              ,ment,qent,uent,vent,nent,elij
-     :              ,tv,tvp
-     o              ,iflag,wd,qprime,tprime
-     o              ,precip,cbmf,ft,fq,fu,fv,Ma,qcondc)
-      endif
-
-!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-! --- UNCOMPRESS THE FIELDS
-!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-
-
-      if (iflag_con.eq.3) then
-       CALL cv3_uncompress(nloc,len,ncum,nd,ntra,idcum
-     :          ,iflag
-     :          ,precip,sig,w0
-     :          ,ft,fq,fu,fv,ftra
-     :          ,Ma,upwd,dnwd,dnwd0,qcondc,wd,cape
-     o          ,iflag1
-     o          ,precip1,sig1,w01
-     o          ,ft1,fq1,fu1,fv1,ftra1
-     o          ,Ma1,upwd1,dnwd1,dnwd01,qcondc1,wd1,cape1 )
-      endif
-
-      if (iflag_con.eq.4) then
-       CALL cv_uncompress(nloc,len,ncum,nd,idcum
-     :          ,iflag
-     :          ,precip,cbmf
-     :          ,ft,fq,fu,fv
-     :          ,Ma,qcondc            
-     o          ,iflag1
-     o          ,precip1,cbmf1
-     o          ,ft1,fq1,fu1,fv1
-     o          ,Ma1,qcondc1 )           
-      endif
-
-      ENDIF ! ncum>0
-
-9999  continue
-
-      return
-      end
-
-!==================================================================
-      SUBROUTINE cv_flag
-      implicit none
-
-#include "cvflag.h"
-
-c -- si .TRUE., on rend la gravite plus explicite et eventuellement
-c differente de 10.0 dans convect3: 
-      cvflag_grav = .FALSE.
-
-      return
-      end
-
-!==================================================================
-      SUBROUTINE cv_thermo(iflag_con)
-	  implicit none
-
-c-------------------------------------------------------------
-c Set thermodynamical constants for convectL
-c-------------------------------------------------------------
-
-#include "YOMCST.h" 
-#include "cvthermo.h" 
-
-      integer iflag_con
-
-
-c original set from convect:
-      if (iflag_con.eq.4) then
-       cpd=1005.7
-       cpv=1870.0
-       cl=4190.0
-       rrv=461.5
-       rrd=287.04
-       lv0=2.501E6
-       g=9.8
-       t0=273.15
-       grav=g
-      endif
-
-c constants consistent with LMDZ:
-      if (iflag_con.eq.3) then
-       cpd = RCPD
-       cpv = RCPV
-       cl  = RCW
-       rrv = RV
-       rrd = RD
-       lv0 = RLVTT
-       g   = RG     ! not used in convect3
-c ori      t0  = RTT
-       t0  = 273.15 ! convect3 (RTT=273.16)
-       grav= 10.    ! implicitely or explicitely used in convect3
-      endif
-
-      rowl=1000.0 !(a quelle variable de YOMCST cela correspond-il?)
-
-      clmcpv=cl-cpv
-      clmcpd=cl-cpd
-      cpdmcp=cpd-cpv
-      cpvmcpd=cpv-cpd
-      cpvmcl=cl-cpv ! for convect3
-      eps=rrd/rrv
-      epsi=1.0/eps
-      epsim1=epsi-1.0
-c      ginv=1.0/g
-      ginv=1.0/grav
-      hrd=0.5*rrd
-
-      return
-      end
-
Index: LMDZ.3.3/branches/rel-/libf/phylmd/cv_routines.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/cv_routines.F	(revision 416)
+++ 	(revision )
@@ -1,1752 +1,0 @@
-      SUBROUTINE cv_param(nd)
-      implicit none
-
-c------------------------------------------------------------
-c Set parameters for convectL
-c (includes microphysical parameters and parameters that 
-c  control the rate of approach to quasi-equilibrium) 
-c------------------------------------------------------------
-
-C   *** ELCRIT IS THE AUTOCONVERSION THERSHOLD WATER CONTENT (gm/gm) ***
-C   ***  TLCRIT IS CRITICAL TEMPERATURE BELOW WHICH THE AUTO-        ***
-C   ***       CONVERSION THRESHOLD IS ASSUMED TO BE ZERO             ***
-C   ***     (THE AUTOCONVERSION THRESHOLD VARIES LINEARLY            ***
-C   ***               BETWEEN 0 C AND TLCRIT)                        ***
-C   ***   ENTP IS THE COEFFICIENT OF MIXING IN THE ENTRAINMENT       ***
-C   ***                       FORMULATION                            ***
-C   ***  SIGD IS THE FRACTIONAL AREA COVERED BY UNSATURATED DNDRAFT  ***
-C   ***  SIGS IS THE FRACTION OF PRECIPITATION FALLING OUTSIDE       ***
-C   ***                        OF CLOUD                              ***
-C   ***        OMTRAIN IS THE ASSUMED FALL SPEED (P/s) OF RAIN       ***
-C   ***     OMTSNOW IS THE ASSUMED FALL SPEED (P/s) OF SNOW          ***
-C   ***  COEFFR IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION   ***
-C   ***                          OF RAIN                             ***
-C   ***  COEFFS IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION   ***
-C   ***                          OF SNOW                             ***
-C   ***     CU IS THE COEFFICIENT GOVERNING CONVECTIVE MOMENTUM      ***
-C   ***                         TRANSPORT                            ***
-C   ***    DTMAX IS THE MAXIMUM NEGATIVE TEMPERATURE PERTURBATION    ***
-C   ***        A LIFTED PARCEL IS ALLOWED TO HAVE BELOW ITS LFC      ***
-C   ***    ALPHA AND DAMP ARE PARAMETERS THAT CONTROL THE RATE OF    ***
-C   ***                 APPROACH TO QUASI-EQUILIBRIUM                ***
-C   ***   (THEIR STANDARD VALUES ARE  0.20 AND 0.1, RESPECTIVELY)    ***
-C   ***                   (DAMP MUST BE LESS THAN 1)                 ***
-
-#include "cvparam.h"
-      integer nd
-
-c noff: integer limit for convection (nd-noff)
-c minorig: First level of convection
-
-      noff = 2
-      minorig = 2
-
-      nl=nd-noff
-      nlp=nl+1
-      nlm=nl-1
-
-      elcrit=0.0011
-      tlcrit=-55.0
-      entp=1.5
-      sigs=0.12
-      sigd=0.05
-      omtrain=50.0
-      omtsnow=5.5
-      coeffr=1.0
-      coeffs=0.8
-      dtmax=0.9
-c
-      cu=0.70
-c
-      betad=10.0
-c
-      damp=0.1
-      alpha=0.2
-c
-      delta=0.01  ! cld
-c
-      return
-      end
-
-      SUBROUTINE cv_prelim(len,nd,ndp1,t,q,p,ph
-     :                    ,lv,cpn,tv,gz,h,hm)
-      implicit none
-
-!=====================================================================
-! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
-!=====================================================================
-
-c inputs:
-      integer len, nd, ndp1
-      real t(len,nd), q(len,nd), p(len,nd), ph(len,ndp1)
-
-c outputs:
-      real lv(len,nd), cpn(len,nd), tv(len,nd)
-      real gz(len,nd), h(len,nd), hm(len,nd)
-
-c local variables:
-      integer k, i
-      real cpx(len,nd)
-
-#include "cvthermo.h"
-#include "cvparam.h"
-
-
-      do 110 k=1,nlp
-        do 100 i=1,len
-          lv(i,k)= lv0-clmcpv*(t(i,k)-t0)
-          cpn(i,k)=cpd*(1.0-q(i,k))+cpv*q(i,k)
-          cpx(i,k)=cpd*(1.0-q(i,k))+cl*q(i,k)
-          tv(i,k)=t(i,k)*(1.0+q(i,k)*epsim1)
- 100    continue
- 110  continue
-c
-c gz = phi at the full levels (same as p).
-c
-      do 120 i=1,len
-        gz(i,1)=0.0
- 120  continue
-      do 140 k=2,nlp
-        do 130 i=1,len
-          gz(i,k)=gz(i,k-1)+hrd*(tv(i,k-1)+tv(i,k))
-     &         *(p(i,k-1)-p(i,k))/ph(i,k)
- 130    continue
- 140  continue
-c
-c h  = phi + cpT (dry static energy).
-c hm = phi + cp(T-Tbase)+Lq
-c
-      do 170 k=1,nlp
-        do 160 i=1,len
-          h(i,k)=gz(i,k)+cpn(i,k)*t(i,k)
-          hm(i,k)=gz(i,k)+cpx(i,k)*(t(i,k)-t(i,1))+lv(i,k)*q(i,k)
- 160    continue
- 170  continue
-
-      return
-      end
-
-      SUBROUTINE cv_feed(len,nd,t,q,qs,p,hm,gz
-     :                  ,nk,icb,icbmax,iflag,tnk,qnk,gznk,plcl)
-      implicit none
-
-C================================================================
-C Purpose: CONVECTIVE FEED
-C================================================================
-
-#include "cvparam.h"
-
-c inputs:
-	  integer len, nd
-      real t(len,nd), q(len,nd), qs(len,nd), p(len,nd)
-      real hm(len,nd), gz(len,nd)
-
-c outputs:
-	  integer iflag(len), nk(len), icb(len), icbmax
-      real tnk(len), qnk(len), gznk(len), plcl(len)
-
-c local variables:
-      integer i, k
-      integer ihmin(len)
-      real work(len)
-      real pnk(len), qsnk(len), rh(len), chi(len)
-
-!-------------------------------------------------------------------
-! --- Find level of minimum moist static energy
-! --- If level of minimum moist static energy coincides with
-! --- or is lower than minimum allowable parcel origin level,
-! --- set iflag to 6.
-!-------------------------------------------------------------------
-
-      do 180 i=1,len
-       work(i)=1.0e12
-       ihmin(i)=nl
- 180  continue
-      do 200 k=2,nlp
-        do 190 i=1,len
-         if((hm(i,k).lt.work(i)).and.
-     &      (hm(i,k).lt.hm(i,k-1)))then
-           work(i)=hm(i,k)
-           ihmin(i)=k
-         endif
- 190    continue
- 200  continue
-      do 210 i=1,len
-        ihmin(i)=min(ihmin(i),nlm)
-        if(ihmin(i).le.minorig)then
-          iflag(i)=6
-        endif
- 210  continue
-c
-!-------------------------------------------------------------------
-! --- Find that model level below the level of minimum moist static
-! --- energy that has the maximum value of moist static energy
-!-------------------------------------------------------------------
- 
-      do 220 i=1,len
-       work(i)=hm(i,minorig)
-       nk(i)=minorig
- 220  continue
-      do 240 k=minorig+1,nl
-        do 230 i=1,len
-         if((hm(i,k).gt.work(i)).and.(k.le.ihmin(i)))then
-           work(i)=hm(i,k)
-           nk(i)=k
-         endif
- 230     continue
- 240  continue
-!-------------------------------------------------------------------
-! --- Check whether parcel level temperature and specific humidity
-! --- are reasonable
-!-------------------------------------------------------------------
-       do 250 i=1,len
-       if(((t(i,nk(i)).lt.250.0).or.
-     &      (q(i,nk(i)).le.0.0).or.
-     &      (p(i,ihmin(i)).lt.400.0)).and.
-     &      (iflag(i).eq.0))iflag(i)=7
- 250   continue
-!-------------------------------------------------------------------
-! --- Calculate lifted condensation level of air at parcel origin level
-! --- (Within 0.2% of formula of Bolton, MON. WEA. REV.,1980)
-!-------------------------------------------------------------------
-       do 260 i=1,len
-        tnk(i)=t(i,nk(i))
-        qnk(i)=q(i,nk(i))
-        gznk(i)=gz(i,nk(i))
-        pnk(i)=p(i,nk(i))
-        qsnk(i)=qs(i,nk(i))
-c
-        rh(i)=qnk(i)/qsnk(i)
-        rh(i)=min(1.0,rh(i))
-        chi(i)=tnk(i)/(1669.0-122.0*rh(i)-tnk(i))
-        plcl(i)=pnk(i)*(rh(i)**chi(i))
-        if(((plcl(i).lt.200.0).or.(plcl(i).ge.2000.0))
-     &   .and.(iflag(i).eq.0))iflag(i)=8
- 260   continue
-!-------------------------------------------------------------------
-! --- Calculate first level above lcl (=icb)
-!-------------------------------------------------------------------
-      do 270 i=1,len
-       icb(i)=nlm
- 270  continue
-c
-      do 290 k=minorig,nl
-        do 280 i=1,len
-          if((k.ge.(nk(i)+1)).and.(p(i,k).lt.plcl(i)))
-     &    icb(i)=min(icb(i),k)
- 280    continue
- 290  continue
-c
-      do 300 i=1,len
-        if((icb(i).ge.nlm).and.(iflag(i).eq.0))iflag(i)=9
- 300  continue
-c
-c Compute icbmax.
-c
-      icbmax=2
-      do 310 i=1,len
-        icbmax=max(icbmax,icb(i))
- 310  continue
-
-      return
-      end
-
-      SUBROUTINE cv_undilute1(len,nd,t,q,qs,gz,p,nk,icb,icbmax
-     :                       ,tp,tvp,clw)
-      implicit none
-
-#include "cvthermo.h"
-#include "cvparam.h"
-
-c inputs:
-      integer len, nd
-      integer nk(len), icb(len), icbmax
-      real t(len,nd), q(len,nd), qs(len,nd), gz(len,nd)
-      real p(len,nd)
-
-c outputs:
-      real tp(len,nd), tvp(len,nd), clw(len,nd)
-
-c local variables:
-      integer i, k
-      real tg, qg, alv, s, ahg, tc, denom, es, rg
-      real ah0(len), cpp(len)
-      real tnk(len), qnk(len), gznk(len), ticb(len), gzicb(len)
-
-!-------------------------------------------------------------------
-! --- Calculates the lifted parcel virtual temperature at nk,
-! --- the actual temperature, and the adiabatic
-! --- liquid water content. The procedure is to solve the equation.
-!     cp*tp+L*qp+phi=cp*tnk+L*qnk+gznk.
-!-------------------------------------------------------------------
-
-      do 320 i=1,len
-        tnk(i)=t(i,nk(i))
-        qnk(i)=q(i,nk(i))
-        gznk(i)=gz(i,nk(i))
-        ticb(i)=t(i,icb(i))
-        gzicb(i)=gz(i,icb(i))
- 320  continue
-c
-c   ***  Calculate certain parcel quantities, including static energy   ***
-c
-      do 330 i=1,len
-        ah0(i)=(cpd*(1.-qnk(i))+cl*qnk(i))*tnk(i)
-     &         +qnk(i)*(lv0-clmcpv*(tnk(i)-273.15))+gznk(i)
-        cpp(i)=cpd*(1.-qnk(i))+qnk(i)*cpv
- 330  continue
-c
-c   ***   Calculate lifted parcel quantities below cloud base   ***
-c
-        do 350 k=minorig,icbmax-1
-          do 340 i=1,len
-           tp(i,k)=tnk(i)-(gz(i,k)-gznk(i))/cpp(i)
-           tvp(i,k)=tp(i,k)*(1.+qnk(i)*epsi)
-  340     continue
-  350   continue
-c
-c    ***  Find lifted parcel quantities above cloud base    ***
-c
-        do 360 i=1,len
-         tg=ticb(i)
-         qg=qs(i,icb(i))
-         alv=lv0-clmcpv*(ticb(i)-t0)
-c
-c First iteration.
-c
-          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
-          s=1./s
-          ahg=cpd*tg+(cl-cpd)*qnk(i)*ticb(i)+alv*qg+gzicb(i)
-          tg=tg+s*(ah0(i)-ahg)
-          tg=max(tg,35.0)
-          tc=tg-t0
-          denom=243.5+tc
-          if(tc.ge.0.0)then
-           es=6.112*exp(17.67*tc/denom)
-          else
-           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-          endif
-          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
-c
-c Second iteration.
-c
-          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
-          s=1./s
-          ahg=cpd*tg+(cl-cpd)*qnk(i)*ticb(i)+alv*qg+gzicb(i)
-          tg=tg+s*(ah0(i)-ahg)
-          tg=max(tg,35.0)
-          tc=tg-t0
-          denom=243.5+tc
-          if(tc.ge.0.0)then
-           es=6.112*exp(17.67*tc/denom)
-          else
-           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-          end if
-          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
-c
-         alv=lv0-clmcpv*(ticb(i)-273.15)
-         tp(i,icb(i))=(ah0(i)-(cl-cpd)*qnk(i)*ticb(i)
-     &   -gz(i,icb(i))-alv*qg)/cpd
-         clw(i,icb(i))=qnk(i)-qg
-         clw(i,icb(i))=max(0.0,clw(i,icb(i)))
-         rg=qg/(1.-qnk(i))
-         tvp(i,icb(i))=tp(i,icb(i))*(1.+rg*epsi)
-  360   continue
-c
-      do 380 k=minorig,icbmax
-       do 370 i=1,len
-         tvp(i,k)=tvp(i,k)-tp(i,k)*qnk(i)
- 370   continue
- 380  continue
-c
-      return
-      end
-
-      SUBROUTINE cv_trigger(len,nd,icb,cbmf,tv,tvp,iflag)
-      implicit none
-
-!-------------------------------------------------------------------
-! --- Test for instability.
-! --- If there was no convection at last time step and parcel
-! --- is stable at icb, then set iflag to 4.
-!-------------------------------------------------------------------
- 
-#include "cvparam.h"
-
-c inputs:
-       integer len, nd, icb(len)
-       real cbmf(len), tv(len,nd), tvp(len,nd)
-
-c outputs:
-       integer iflag(len) ! also an input
-
-c local variables:
-       integer i
-
-
-      do 390 i=1,len
-        if((cbmf(i).eq.0.0) .and.(iflag(i).eq.0).and.
-     &  (tvp(i,icb(i)).le.(tv(i,icb(i))-dtmax)))iflag(i)=4
- 390  continue
- 
-      return
-      end
-
-      SUBROUTINE cv_compress( len,nloc,ncum,nd
-     :   ,iflag1,nk1,icb1
-     :   ,cbmf1,plcl1,tnk1,qnk1,gznk1
-     :   ,t1,q1,qs1,u1,v1,gz1
-     :   ,h1,lv1,cpn1,p1,ph1,tv1,tp1,tvp1,clw1
-     o   ,iflag,nk,icb
-     o   ,cbmf,plcl,tnk,qnk,gznk
-     o   ,t,q,qs,u,v,gz,h,lv,cpn,p,ph,tv,tp,tvp,clw 
-     o   ,dph          )
-      implicit none
-
-#include "cvparam.h"
-
-c inputs:
-      integer len,ncum,nd,nloc
-      integer iflag1(len),nk1(len),icb1(len)
-      real cbmf1(len),plcl1(len),tnk1(len),qnk1(len),gznk1(len)
-      real t1(len,nd),q1(len,nd),qs1(len,nd),u1(len,nd),v1(len,nd)
-      real gz1(len,nd),h1(len,nd),lv1(len,nd),cpn1(len,nd)
-      real p1(len,nd),ph1(len,nd+1),tv1(len,nd),tp1(len,nd)
-      real tvp1(len,nd),clw1(len,nd)
-
-c outputs:
-      integer iflag(nloc),nk(nloc),icb(nloc)
-      real cbmf(nloc),plcl(nloc),tnk(nloc),qnk(nloc),gznk(nloc)
-      real t(nloc,nd),q(nloc,nd),qs(nloc,nd),u(nloc,nd),v(nloc,nd)
-      real gz(nloc,nd),h(nloc,nd),lv(nloc,nd),cpn(nloc,nd)
-      real p(nloc,nd),ph(nloc,nd+1),tv(nloc,nd),tp(nloc,nd)
-      real tvp(nloc,nd),clw(nloc,nd)
-      real dph(nloc,nd)
-
-c local variables:
-      integer i,k,nn
-
-
-      do 110 k=1,nl+1
-       nn=0
-      do 100 i=1,len
-      if(iflag1(i).eq.0)then
-        nn=nn+1
-        t(nn,k)=t1(i,k)
-        q(nn,k)=q1(i,k)
-        qs(nn,k)=qs1(i,k)
-        u(nn,k)=u1(i,k)
-        v(nn,k)=v1(i,k)
-        gz(nn,k)=gz1(i,k)
-        h(nn,k)=h1(i,k)
-        lv(nn,k)=lv1(i,k)
-        cpn(nn,k)=cpn1(i,k)
-        p(nn,k)=p1(i,k)
-        ph(nn,k)=ph1(i,k)
-        tv(nn,k)=tv1(i,k)
-        tp(nn,k)=tp1(i,k)
-        tvp(nn,k)=tvp1(i,k)
-        clw(nn,k)=clw1(i,k)
-      endif
- 100    continue
- 110  continue
-
-      if (nn.ne.ncum) then
-         print*,'strange! nn not equal to ncum: ',nn,ncum
-         stop
-      endif
-
-      nn=0
-      do 150 i=1,len
-      if(iflag1(i).eq.0)then
-      nn=nn+1
-      cbmf(nn)=cbmf1(i)
-      plcl(nn)=plcl1(i)
-      tnk(nn)=tnk1(i)
-      qnk(nn)=qnk1(i)
-      gznk(nn)=gznk1(i)
-      nk(nn)=nk1(i)
-      icb(nn)=icb1(i)
-      iflag(nn)=iflag1(i)
-      endif
- 150  continue
-
-      do 170 k=1,nl
-       do 160 i=1,ncum
-        dph(i,k)=ph(i,k)-ph(i,k+1)
- 160   continue
- 170  continue
-
-      return
-      end
-
-      SUBROUTINE cv_undilute2(nloc,ncum,nd,icb,nk
-     :                       ,tnk,qnk,gznk,t,q,qs,gz
-     :                       ,p,dph,h,tv,lv
-     o                       ,inb,inb1,tp,tvp,clw,hp,ep,sigp,frac)
-      implicit none
-
-C---------------------------------------------------------------------
-C Purpose:
-C     FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
-C     &
-C     COMPUTE THE PRECIPITATION EFFICIENCIES AND THE 
-C     FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
-C     &
-C     FIND THE LEVEL OF NEUTRAL BUOYANCY
-C---------------------------------------------------------------------
-
-#include "cvthermo.h"
-#include "cvparam.h"
-
-c inputs:
-      integer ncum, nd, nloc
-      integer icb(nloc), nk(nloc)
-      real t(nloc,nd), q(nloc,nd), qs(nloc,nd), gz(nloc,nd)
-      real p(nloc,nd), dph(nloc,nd)
-      real tnk(nloc), qnk(nloc), gznk(nloc)
-      real lv(nloc,nd), tv(nloc,nd), h(nloc,nd)
-
-c outputs:
-      integer inb(nloc), inb1(nloc)
-      real tp(nloc,nd), tvp(nloc,nd), clw(nloc,nd)
-      real ep(nloc,nd), sigp(nloc,nd), hp(nloc,nd)
-      real frac(nloc)
-
-c local variables:
-      integer i, k
-      real tg,qg,ahg,alv,s,tc,es,denom,rg,tca,elacrit
-      real by, defrac
-      real ah0(nloc), cape(nloc), capem(nloc), byp(nloc)
-      logical lcape(nloc)
-
-!=====================================================================
-! --- SOME INITIALIZATIONS
-!=====================================================================
-
-      do 170 k=1,nl
-      do 160 i=1,ncum
-       ep(i,k)=0.0
-       sigp(i,k)=sigs
- 160  continue
- 170  continue
-
-!=====================================================================
-! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
-!=====================================================================
-c
-c ---       The procedure is to solve the equation.
-c              cp*tp+L*qp+phi=cp*tnk+L*qnk+gznk.
-c
-c   ***  Calculate certain parcel quantities, including static energy   ***
-c
-c
-      do 240 i=1,ncum
-         ah0(i)=(cpd*(1.-qnk(i))+cl*qnk(i))*tnk(i)
-     &         +qnk(i)*(lv0-clmcpv*(tnk(i)-t0))+gznk(i)
- 240  continue
-c
-c
-c    ***  Find lifted parcel quantities above cloud base    ***
-c
-c
-	do 300 k=minorig+1,nl
-	  do 290 i=1,ncum
-	    if(k.ge.(icb(i)+1))then
-	      tg=t(i,k)
-	      qg=qs(i,k)
-	      alv=lv0-clmcpv*(t(i,k)-t0)
-c
-c First iteration.
-c
-	       s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
-	       s=1./s
-	       ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
-	       tg=tg+s*(ah0(i)-ahg)
-	       tg=max(tg,35.0)
-	       tc=tg-t0
-	       denom=243.5+tc
-	       if(tc.ge.0.0)then
-			es=6.112*exp(17.67*tc/denom)
-	       else
-			es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-	       endif
-			qg=eps*es/(p(i,k)-es*(1.-eps))
-c
-c Second iteration.
-c
-	       s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
-	       s=1./s
-	       ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
-	       tg=tg+s*(ah0(i)-ahg)
-	       tg=max(tg,35.0)
-	       tc=tg-t0
-	       denom=243.5+tc
-	       if(tc.ge.0.0)then
-			es=6.112*exp(17.67*tc/denom)
-	       else
-			es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-	       endif
-			qg=eps*es/(p(i,k)-es*(1.-eps))
-c
-	       alv=lv0-clmcpv*(t(i,k)-t0)
-c      print*,'cpd dans convect2 ',cpd
-c      print*,'tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd'
-c      print*,tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd
-        tp(i,k)=(ah0(i)-(cl-cpd)*qnk(i)*t(i,k)-gz(i,k)-alv*qg)/cpd
-c              if (.not.cpd.gt.1000.) then
-c                  print*,'CPD=',cpd
-c                  stop
-c              endif
-               clw(i,k)=qnk(i)-qg
-               clw(i,k)=max(0.0,clw(i,k))
-               rg=qg/(1.-qnk(i))
-               tvp(i,k)=tp(i,k)*(1.+rg*epsi)
-            endif
-  290     continue
-  300   continue
-c
-!=====================================================================
-! --- SET THE PRECIPITATION EFFICIENCIES AND THE FRACTION OF
-! --- PRECIPITATION FALLING OUTSIDE OF CLOUD
-! --- THESE MAY BE FUNCTIONS OF TP(I), P(I) AND CLW(I)
-!=====================================================================
-c
-      do 320 k=minorig+1,nl
-        do 310 i=1,ncum
-          if(k.ge.(nk(i)+1))then
-            tca=tp(i,k)-t0
-            if(tca.ge.0.0)then
-              elacrit=elcrit
-            else
-              elacrit=elcrit*(1.0-tca/tlcrit)
-            endif
-            elacrit=max(elacrit,0.0)
-            ep(i,k)=1.0-elacrit/max(clw(i,k),1.0e-8)
-            ep(i,k)=max(ep(i,k),0.0 )
-            ep(i,k)=min(ep(i,k),1.0 )
-            sigp(i,k)=sigs
-          endif
- 310    continue
- 320  continue
-c
-!=====================================================================
-! --- CALCULATE VIRTUAL TEMPERATURE AND LIFTED PARCEL
-! --- VIRTUAL TEMPERATURE
-!=====================================================================
-c
-      do 340 k=minorig+1,nl
-        do 330 i=1,ncum
-        if(k.ge.(icb(i)+1))then
-          tvp(i,k)=tvp(i,k)*(1.0-qnk(i)+ep(i,k)*clw(i,k))
-c         print*,'i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)'
-c         print*, i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)
-        endif
- 330    continue
- 340  continue
-      do 350 i=1,ncum
-       tvp(i,nlp)=tvp(i,nl)-(gz(i,nlp)-gz(i,nl))/cpd
- 350  continue
-c
-c=====================================================================
-c  --- FIND THE FIRST MODEL LEVEL (INB1) ABOVE THE PARCEL'S
-c  --- HIGHEST LEVEL OF NEUTRAL BUOYANCY
-c  --- AND THE HIGHEST LEVEL OF POSITIVE CAPE (INB)
-c=====================================================================
-c
-      do 510 i=1,ncum
-        cape(i)=0.0
-        capem(i)=0.0
-        inb(i)=icb(i)+1
-        inb1(i)=inb(i)
- 510  continue
-c
-c Originial Code
-c
-c     do 530 k=minorig+1,nl-1
-c       do 520 i=1,ncum
-c         if(k.ge.(icb(i)+1))then
-c           by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
-c           byp=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
-c           cape(i)=cape(i)+by
-c           if(by.ge.0.0)inb1(i)=k+1
-c           if(cape(i).gt.0.0)then
-c             inb(i)=k+1
-c             capem(i)=cape(i)
-c           endif
-c         endif
-c520    continue
-c530  continue
-c     do 540 i=1,ncum
-c         byp=(tvp(i,nl)-tv(i,nl))*dph(i,nl)/p(i,nl)
-c         cape(i)=capem(i)+byp
-c         defrac=capem(i)-cape(i)
-c         defrac=max(defrac,0.001)
-c         frac(i)=-cape(i)/defrac
-c         frac(i)=min(frac(i),1.0)
-c         frac(i)=max(frac(i),0.0)
-c540   continue
-c
-c K Emanuel fix
-c
-c     call zilch(byp,ncum)
-c     do 530 k=minorig+1,nl-1
-c       do 520 i=1,ncum
-c         if(k.ge.(icb(i)+1))then
-c           by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
-c           cape(i)=cape(i)+by
-c           if(by.ge.0.0)inb1(i)=k+1
-c           if(cape(i).gt.0.0)then
-c             inb(i)=k+1
-c             capem(i)=cape(i)
-c             byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
-c           endif
-c         endif
-c520    continue
-c530  continue
-c     do 540 i=1,ncum
-c         inb(i)=max(inb(i),inb1(i))
-c         cape(i)=capem(i)+byp(i)
-c         defrac=capem(i)-cape(i)
-c         defrac=max(defrac,0.001)
-c         frac(i)=-cape(i)/defrac
-c         frac(i)=min(frac(i),1.0)
-c         frac(i)=max(frac(i),0.0)
-c540   continue
-c
-c J Teixeira fix
-c
-      call zilch(byp,ncum)
-      do 515 i=1,ncum
-        lcape(i)=.true.
- 515  continue
-      do 530 k=minorig+1,nl-1
-        do 520 i=1,ncum
-          if(cape(i).lt.0.0)lcape(i)=.false.
-          if((k.ge.(icb(i)+1)).and.lcape(i))then
-            by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
-            byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
-            cape(i)=cape(i)+by
-            if(by.ge.0.0)inb1(i)=k+1
-            if(cape(i).gt.0.0)then
-              inb(i)=k+1
-              capem(i)=cape(i)
-            endif
-          endif
- 520    continue
- 530  continue
-      do 540 i=1,ncum
-          cape(i)=capem(i)+byp(i)
-          defrac=capem(i)-cape(i)
-          defrac=max(defrac,0.001)
-          frac(i)=-cape(i)/defrac
-          frac(i)=min(frac(i),1.0)
-          frac(i)=max(frac(i),0.0)
- 540  continue
-c
-c=====================================================================
-c ---   CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL
-c=====================================================================
-c
-c initialization:
-      do i=1,ncum*nlp
-       hp(i,1)=h(i,1)
-      enddo
-
-      do 600 k=minorig+1,nl
-        do 590 i=1,ncum
-        if((k.ge.icb(i)).and.(k.le.inb(i)))then
-          hp(i,k)=h(i,nk(i))+(lv(i,k)+(cpd-cpv)*t(i,k))*ep(i,k)*clw(i,k)
-        endif
- 590    continue
- 600  continue
-c
-        return
-        end
-c
-      SUBROUTINE cv_closure(nloc,ncum,nd,nk,icb
-     :                     ,tv,tvp,p,ph,dph,plcl,cpn
-     :                     ,iflag,cbmf)
-      implicit none
-
-c inputs:
-      integer ncum, nd, nloc
-      integer nk(nloc), icb(nloc)
-      real tv(nloc,nd), tvp(nloc,nd), p(nloc,nd), dph(nloc,nd)
-      real ph(nloc,nd+1) ! caution nd instead ndp1 to be consistent...
-      real plcl(nloc), cpn(nloc,nd)
-
-c outputs:
-      integer iflag(nloc)
-      real cbmf(nloc) ! also an input
-
-c local variables:
-      integer i, k, icbmax
-      real dtpbl(nloc), dtmin(nloc), tvpplcl(nloc), tvaplcl(nloc)
-      real work(nloc)
-
-#include "cvthermo.h"
-#include "cvparam.h"
-
-c-------------------------------------------------------------------
-c Compute icbmax. 
-c-------------------------------------------------------------------
-
-      icbmax=2
-      do 230 i=1,ncum
-       icbmax=max(icbmax,icb(i))
- 230  continue
-
-c=====================================================================
-c ---  CALCULATE CLOUD BASE MASS FLUX 
-c=====================================================================
-c
-c tvpplcl = parcel temperature lifted adiabatically from level
-c           icb-1 to the LCL.
-c tvaplcl = virtual temperature at the LCL.
-c
-      do 610 i=1,ncum
-        dtpbl(i)=0.0
-        tvpplcl(i)=tvp(i,icb(i)-1)
-     &  -rrd*tvp(i,icb(i)-1)*(p(i,icb(i)-1)-plcl(i))
-     &  /(cpn(i,icb(i)-1)*p(i,icb(i)-1))
-        tvaplcl(i)=tv(i,icb(i))
-     &  +(tvp(i,icb(i))-tvp(i,icb(i)+1))*(plcl(i)-p(i,icb(i)))
-     &  /(p(i,icb(i))-p(i,icb(i)+1))
- 610  continue
-
-c-------------------------------------------------------------------
-c --- Interpolate difference between lifted parcel and
-c --- environmental temperatures to lifted condensation level
-c-------------------------------------------------------------------
-c
-c dtpbl = average of tvp-tv in the PBL (k=nk to icb-1).
-c
-      do 630 k=minorig,icbmax
-        do 620 i=1,ncum
-        if((k.ge.nk(i)).and.(k.le.(icb(i)-1)))then
-          dtpbl(i)=dtpbl(i)+(tvp(i,k)-tv(i,k))*dph(i,k)
-        endif
- 620    continue
- 630  continue
-      do 640 i=1,ncum
-        dtpbl(i)=dtpbl(i)/(ph(i,nk(i))-ph(i,icb(i)))
-        dtmin(i)=tvpplcl(i)-tvaplcl(i)+dtmax+dtpbl(i)
- 640  continue
-c
-c-------------------------------------------------------------------
-c --- Adjust cloud base mass flux
-c-------------------------------------------------------------------
-c
-      do 650 i=1,ncum
-       work(i)=cbmf(i)
-       cbmf(i)=max(0.0,(1.0-damp)*cbmf(i)+0.1*alpha*dtmin(i))
-       if((work(i).eq.0.0).and.(cbmf(i).eq.0.0))then
-         iflag(i)=3
-       endif
- 650  continue
-
-       return
-       end
-
-      SUBROUTINE cv_mixing(nloc,ncum,nd,icb,nk,inb,inb1
-     :                    ,ph,t,q,qs,u,v,h,lv,qnk
-     :                    ,hp,tv,tvp,ep,clw,cbmf
-     :                    ,m,ment,qent,uent,vent,nent,sij,elij)
-      implicit none
-
-#include "cvthermo.h"
-#include "cvparam.h"
-
-c inputs:
-      integer ncum, nd, nloc
-      integer icb(nloc), inb(nloc), inb1(nloc), nk(nloc)
-      real cbmf(nloc), qnk(nloc)
-      real ph(nloc,nd+1)
-      real t(nloc,nd), q(nloc,nd), qs(nloc,nd), lv(nloc,nd)
-      real u(nloc,nd), v(nloc,nd), h(nloc,nd), hp(nloc,nd)
-      real tv(nloc,nd), tvp(nloc,nd), ep(nloc,nd), clw(nloc,nd)
-
-c outputs:
-      integer nent(nloc,nd)
-      real m(nloc,nd), ment(nloc,nd,nd), qent(nloc,nd,nd)
-      real uent(nloc,nd,nd), vent(nloc,nd,nd)
-      real sij(nloc,nd,nd), elij(nloc,nd,nd)
-
-c local variables:
-      integer i, j, k, ij
-      integer num1, num2
-      real dbo, qti, bf2, anum, denom, dei, altem, cwat, stemp
-      real alt, qp1, smid, sjmin, sjmax, delp, delm
-      real work(nloc), asij(nloc), smin(nloc), scrit(nloc)
-      real bsum(nloc,nd)
-      logical lwork(nloc)
-
-c=====================================================================
-c --- INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS
-c=====================================================================
-c
-        do 360 i=1,ncum*nlp
-          nent(i,1)=0
-          m(i,1)=0.0
- 360    continue
-c
-      do 400 k=1,nlp
-       do 390 j=1,nlp
-          do 385 i=1,ncum
-            qent(i,k,j)=q(i,j)
-            uent(i,k,j)=u(i,j)
-            vent(i,k,j)=v(i,j)
-            elij(i,k,j)=0.0
-            ment(i,k,j)=0.0
-            sij(i,k,j)=0.0
- 385      continue
- 390    continue
- 400  continue
-c
-c-------------------------------------------------------------------
-c --- Calculate rates of mixing,  m(i)
-c-------------------------------------------------------------------
-c
-      call zilch(work,ncum)
-c
-      do 670 j=minorig+1,nl
-        do 660 i=1,ncum
-          if((j.ge.(icb(i)+1)).and.(j.le.inb(i)))then
-             k=min(j,inb1(i))
-             dbo=abs(tv(i,k+1)-tvp(i,k+1)-tv(i,k-1)+tvp(i,k-1))
-     &       +entp*0.04*(ph(i,k)-ph(i,k+1))
-             work(i)=work(i)+dbo
-             m(i,j)=cbmf(i)*dbo
-          endif
- 660    continue
- 670  continue
-      do 690 k=minorig+1,nl
-        do 680 i=1,ncum
-          if((k.ge.(icb(i)+1)).and.(k.le.inb(i)))then
-            m(i,k)=m(i,k)/work(i)
-          endif
- 680    continue
- 690  continue
-c
-c
-c=====================================================================
-c --- CALCULATE ENTRAINED AIR MASS FLUX (ment), TOTAL WATER MIXING
-c --- RATIO (QENT), TOTAL CONDENSED WATER (elij), AND MIXING
-c --- FRACTION (sij)
-c=====================================================================
-c
-c
-       do 750 i=minorig+1,nl
-         do 710 j=minorig+1,nl
-           do 700 ij=1,ncum
-             if((i.ge.(icb(ij)+1)).and.(j.ge.icb(ij))
-     &         .and.(i.le.inb(ij)).and.(j.le.inb(ij)))then
-               qti=qnk(ij)-ep(ij,i)*clw(ij,i)
-               bf2=1.+lv(ij,j)*lv(ij,j)*qs(ij,j)
-     &         /(rrv*t(ij,j)*t(ij,j)*cpd)
-               anum=h(ij,j)-hp(ij,i)+(cpv-cpd)*t(ij,j)*(qti-q(ij,j))
-               denom=h(ij,i)-hp(ij,i)+(cpd-cpv)*(q(ij,i)-qti)*t(ij,j)
-               dei=denom
-               if(abs(dei).lt.0.01)dei=0.01
-               sij(ij,i,j)=anum/dei
-               sij(ij,i,i)=1.0
-               altem=sij(ij,i,j)*q(ij,i)+(1.-sij(ij,i,j))*qti-qs(ij,j)
-               altem=altem/bf2
-               cwat=clw(ij,j)*(1.-ep(ij,j))
-               stemp=sij(ij,i,j)
-               if((stemp.lt.0.0.or.stemp.gt.1.0.or.
-     1           altem.gt.cwat).and.j.gt.i)then
-                 anum=anum-lv(ij,j)*(qti-qs(ij,j)-cwat*bf2)
-                 denom=denom+lv(ij,j)*(q(ij,i)-qti)
-                 if(abs(denom).lt.0.01)denom=0.01
-                 sij(ij,i,j)=anum/denom
-                 altem=sij(ij,i,j)*q(ij,i)+(1.-sij(ij,i,j))*qti-qs(ij,j)
-                 altem=altem-(bf2-1.)*cwat
-               endif
-               if(sij(ij,i,j).gt.0.0.and.sij(ij,i,j).lt.0.9)then
-                 qent(ij,i,j)=sij(ij,i,j)*q(ij,i)
-     &                        +(1.-sij(ij,i,j))*qti
-                 uent(ij,i,j)=sij(ij,i,j)*u(ij,i)
-     &                        +(1.-sij(ij,i,j))*u(ij,nk(ij))
-                 vent(ij,i,j)=sij(ij,i,j)*v(ij,i)
-     &                        +(1.-sij(ij,i,j))*v(ij,nk(ij))
-                 elij(ij,i,j)=altem
-                 elij(ij,i,j)=max(0.0,elij(ij,i,j))
-                 ment(ij,i,j)=m(ij,i)/(1.-sij(ij,i,j))
-                 nent(ij,i)=nent(ij,i)+1
-               endif
-             sij(ij,i,j)=max(0.0,sij(ij,i,j))
-             sij(ij,i,j)=min(1.0,sij(ij,i,j))
-             endif
-  700      continue
-  710    continue
-c
-c   ***   If no air can entrain at level i assume that updraft detrains  ***
-c   ***   at that level and calculate detrained air flux and properties  ***
-c
-           do 740 ij=1,ncum
-             if((i.ge.(icb(ij)+1)).and.(i.le.inb(ij))
-     &       .and.(nent(ij,i).eq.0))then
-               ment(ij,i,i)=m(ij,i)
-               qent(ij,i,i)=q(ij,nk(ij))-ep(ij,i)*clw(ij,i)
-               uent(ij,i,i)=u(ij,nk(ij))
-               vent(ij,i,i)=v(ij,nk(ij))
-               elij(ij,i,i)=clw(ij,i)
-               sij(ij,i,i)=1.0
-             endif
- 740       continue
- 750   continue
-c
-      do 770 i=1,ncum
-        sij(i,inb(i),inb(i))=1.0
- 770  continue
-c
-c=====================================================================
-c   ---  NORMALIZE ENTRAINED AIR MASS FLUXES
-c   ---  TO REPRESENT EQUAL PROBABILITIES OF MIXING
-c=====================================================================
-c
-       call zilch(bsum,ncum*nlp)
-       do 780 ij=1,ncum
-         lwork(ij)=.false.
- 780   continue
-       do 789 i=minorig+1,nl
-c
-         num1=0
-         do 779 ij=1,ncum
-           if((i.ge.icb(ij)+1).and.(i.le.inb(ij)))num1=num1+1
- 779     continue
-         if(num1.le.0)go to 789
-c
-           do 781 ij=1,ncum
-             if((i.ge.icb(ij)+1).and.(i.le.inb(ij)))then
-                lwork(ij)=(nent(ij,i).ne.0)
-                qp1=q(ij,nk(ij))-ep(ij,i)*clw(ij,i)
-                anum=h(ij,i)-hp(ij,i)-lv(ij,i)*(qp1-qs(ij,i))
-                denom=h(ij,i)-hp(ij,i)+lv(ij,i)*(q(ij,i)-qp1)
-                if(abs(denom).lt.0.01)denom=0.01
-                scrit(ij)=anum/denom
-                alt=qp1-qs(ij,i)+scrit(ij)*(q(ij,i)-qp1)
-                if(scrit(ij).lt.0.0.or.alt.lt.0.0)scrit(ij)=1.0
-                asij(ij)=0.0
-                smin(ij)=1.0
-             endif
- 781       continue
-         do 783 j=minorig,nl
-c
-         num2=0
-         do 778 ij=1,ncum
-             if((i.ge.icb(ij)+1).and.(i.le.inb(ij))
-     &       .and.(j.ge.icb(ij)).and.(j.le.inb(ij))
-     &       .and.lwork(ij))num2=num2+1
- 778     continue
-         if(num2.le.0)go to 783
-c
-           do 782 ij=1,ncum
-             if((i.ge.icb(ij)+1).and.(i.le.inb(ij))
-     &       .and.(j.ge.icb(ij)).and.(j.le.inb(ij)).and.lwork(ij))then
-                  if(sij(ij,i,j).gt.0.0.and.sij(ij,i,j).lt.0.9)then
-                    if(j.gt.i)then
-                      smid=min(sij(ij,i,j),scrit(ij))
-                      sjmax=smid
-                      sjmin=smid
-                        if(smid.lt.smin(ij)
-     &                  .and.sij(ij,i,j+1).lt.smid)then
-                          smin(ij)=smid
-                          sjmax=min(sij(ij,i,j+1),sij(ij,i,j),scrit(ij))
-                          sjmin=max(sij(ij,i,j-1),sij(ij,i,j))
-                          sjmin=min(sjmin,scrit(ij))
-                        endif
-                    else
-                      sjmax=max(sij(ij,i,j+1),scrit(ij))
-                      smid=max(sij(ij,i,j),scrit(ij))
-                      sjmin=0.0
-                      if(j.gt.1)sjmin=sij(ij,i,j-1)
-                      sjmin=max(sjmin,scrit(ij))
-                    endif
-                    delp=abs(sjmax-smid)
-                    delm=abs(sjmin-smid)
-                    asij(ij)=asij(ij)+(delp+delm)
-     &                           *(ph(ij,j)-ph(ij,j+1))
-                    ment(ij,i,j)=ment(ij,i,j)*(delp+delm)
-     &                           *(ph(ij,j)-ph(ij,j+1))
-                  endif
-              endif
-  782    continue
-  783    continue
-            do 784 ij=1,ncum
-            if((i.ge.icb(ij)+1).and.(i.le.inb(ij)).and.lwork(ij))then
-               asij(ij)=max(1.0e-21,asij(ij))
-               asij(ij)=1.0/asij(ij)
-               bsum(ij,i)=0.0
-            endif
- 784        continue
-            do 786 j=minorig,nl+1
-              do 785 ij=1,ncum
-                if((i.ge.icb(ij)+1).and.(i.le.inb(ij))
-     &          .and.(j.ge.icb(ij)).and.(j.le.inb(ij))
-     &          .and.lwork(ij))then
-                   ment(ij,i,j)=ment(ij,i,j)*asij(ij)
-                   bsum(ij,i)=bsum(ij,i)+ment(ij,i,j)
-                endif
- 785     continue
- 786     continue
-             do 787 ij=1,ncum
-               if((i.ge.icb(ij)+1).and.(i.le.inb(ij))
-     &         .and.(bsum(ij,i).lt.1.0e-18).and.lwork(ij))then
-                 nent(ij,i)=0
-                 ment(ij,i,i)=m(ij,i)
-                 qent(ij,i,i)=q(ij,nk(ij))-ep(ij,i)*clw(ij,i)
-                 uent(ij,i,i)=u(ij,nk(ij))
-                 vent(ij,i,i)=v(ij,nk(ij))
-                 elij(ij,i,i)=clw(ij,i)
-                 sij(ij,i,i)=1.0
-               endif
-  787        continue
-  789  continue
-c
-       return
-       end
-
-      SUBROUTINE cv_unsat(nloc,ncum,nd,inb,t,q,qs,gz,u,v,p,ph
-     :                  ,h,lv,ep,sigp,clw,m,ment,elij
-     :                  ,iflag,mp,qp,up,vp,wt,water,evap)
-      implicit none
-
-
-#include "cvthermo.h"
-#include "cvparam.h"
-
-c inputs:
-      integer ncum, nd, nloc
-      integer inb(nloc)
-      real t(nloc,nd), q(nloc,nd), qs(nloc,nd)
-      real gz(nloc,nd), u(nloc,nd), v(nloc,nd)
-      real p(nloc,nd), ph(nloc,nd+1), h(nloc,nd)
-      real lv(nloc,nd), ep(nloc,nd), sigp(nloc,nd), clw(nloc,nd)
-      real m(nloc,nd), ment(nloc,nd,nd), elij(nloc,nd,nd)
-
-c outputs:
-      integer iflag(nloc) ! also an input
-      real mp(nloc,nd), qp(nloc,nd), up(nloc,nd), vp(nloc,nd)
-      real water(nloc,nd), evap(nloc,nd), wt(nloc,nd)
-
-c local variables:
-      integer i,j,k,ij,num1
-      integer jtt(nloc)
-      real awat, coeff, qsm, afac, sigt, b6, c6, revap
-      real dhdp, fac, qstm, rat
-      real wdtrain(nloc)
-      logical lwork(nloc)
-
-c=====================================================================
-c --- PRECIPITATING DOWNDRAFT CALCULATION
-c=====================================================================
-c
-c Initializations:
-c
-         do i = 1, ncum
-         do k = 1, nl+1
-          wt(i,k) = omtsnow
-          mp(i,k) = 0.0
-          evap(i,k) = 0.0
-          water(i,k) = 0.0
-         enddo
-         enddo
-
-         do 420 i=1,ncum
-          qp(i,1)=q(i,1)
-          up(i,1)=u(i,1)
-          vp(i,1)=v(i,1)
- 420     continue
-
-         do 440 k=2,nl+1
-         do 430 i=1,ncum
-          qp(i,k)=q(i,k-1)
-          up(i,k)=u(i,k-1)
-          vp(i,k)=v(i,k-1)
- 430     continue
- 440     continue
-
-
-c   ***  Check whether ep(inb)=0, if so, skip precipitating    ***
-c   ***             downdraft calculation                      ***
-c
-c
-c   ***  Integrate liquid water equation to find condensed water   ***
-c   ***                and condensed water flux                    ***
-c
-c
-      do 890 i=1,ncum
-        jtt(i)=2
-        if(ep(i,inb(i)).le.0.0001)iflag(i)=2
-        if(iflag(i).eq.0)then
-          lwork(i)=.true.
-        else
-          lwork(i)=.false.
-        endif
- 890  continue
-c
-c    ***                    Begin downdraft loop                    ***
-c
-c
-        call zilch(wdtrain,ncum)
-        do 899 i=nl+1,1,-1
-c
-          num1=0
-          do 879 ij=1,ncum
-            if((i.le.inb(ij)).and.lwork(ij))num1=num1+1
- 879      continue
-          if(num1.le.0)go to 899
-c
-c
-c    ***        Calculate detrained precipitation             ***
-c
-          do 891 ij=1,ncum
-            if((i.le.inb(ij)).and.(lwork(ij)))then
-            wdtrain(ij)=g*ep(ij,i)*m(ij,i)*clw(ij,i)
-            endif
- 891      continue
-c
-          if(i.gt.1)then
-            do 893 j=1,i-1
-              do 892 ij=1,ncum
-                if((i.le.inb(ij)).and.(lwork(ij)))then
-                  awat=elij(ij,j,i)-(1.-ep(ij,i))*clw(ij,i)
-                  awat=max(0.0,awat)
-                  wdtrain(ij)=wdtrain(ij)+g*awat*ment(ij,j,i)
-                endif
- 892          continue
- 893      continue
-          endif
-c
-c    ***    Find rain water and evaporation using provisional   ***
-c    ***              estimates of qp(i)and qp(i-1)             ***
-c
-c
-c  ***  Value of terminal velocity and coeffecient of evaporation for snow   ***
-c
-          do 894 ij=1,ncum
-            if((i.le.inb(ij)).and.(lwork(ij)))then
-            coeff=coeffs
-            wt(ij,i)=omtsnow
-c
-c  ***  Value of terminal velocity and coeffecient of evaporation for rain   ***
-c
-            if(t(ij,i).gt.273.0)then
-              coeff=coeffr
-              wt(ij,i)=omtrain
-            endif
-            qsm=0.5*(q(ij,i)+qp(ij,i+1))
-            afac=coeff*ph(ij,i)*(qs(ij,i)-qsm)
-     &       /(1.0e4+2.0e3*ph(ij,i)*qs(ij,i))
-            afac=max(afac,0.0)
-            sigt=sigp(ij,i)
-            sigt=max(0.0,sigt)
-            sigt=min(1.0,sigt)
-            b6=100.*(ph(ij,i)-ph(ij,i+1))*sigt*afac/wt(ij,i)
-            c6=(water(ij,i+1)*wt(ij,i+1)+wdtrain(ij)/sigd)/wt(ij,i)
-            revap=0.5*(-b6+sqrt(b6*b6+4.*c6))
-            evap(ij,i)=sigt*afac*revap
-            water(ij,i)=revap*revap
-c
-c    ***  Calculate precipitating downdraft mass flux under     ***
-c    ***              hydrostatic approximation                 ***
-c
-            if(i.gt.1)then
-              dhdp=(h(ij,i)-h(ij,i-1))/(p(ij,i-1)-p(ij,i))
-              dhdp=max(dhdp,10.0)
-              mp(ij,i)=100.*ginv*lv(ij,i)*sigd*evap(ij,i)/dhdp
-              mp(ij,i)=max(mp(ij,i),0.0)
-c
-c   ***   Add small amount of inertia to downdraft              ***
-c
-              fac=20.0/(ph(ij,i-1)-ph(ij,i))
-              mp(ij,i)=(fac*mp(ij,i+1)+mp(ij,i))/(1.+fac)
-c
-c    ***      Force mp to decrease linearly to zero                 ***
-c    ***      between about 950 mb and the surface                  ***
-c
-              if(p(ij,i).gt.(0.949*p(ij,1)))then
-                 jtt(ij)=max(jtt(ij),i)
-                 mp(ij,i)=mp(ij,jtt(ij))*(p(ij,1)-p(ij,i))
-     &           /(p(ij,1)-p(ij,jtt(ij)))
-              endif
-            endif
-c
-c    ***       Find mixing ratio of precipitating downdraft     ***
-c
-            if(i.ne.inb(ij))then
-              if(i.eq.1)then
-                qstm=qs(ij,1)
-              else
-                qstm=qs(ij,i-1)
-              endif
-              if(mp(ij,i).gt.mp(ij,i+1))then
-                 rat=mp(ij,i+1)/mp(ij,i)
-                 qp(ij,i)=qp(ij,i+1)*rat+q(ij,i)*(1.0-rat)+100.*ginv*
-     &             sigd*(ph(ij,i)-ph(ij,i+1))*(evap(ij,i)/mp(ij,i))
-                 up(ij,i)=up(ij,i+1)*rat+u(ij,i)*(1.-rat)
-                 vp(ij,i)=vp(ij,i+1)*rat+v(ij,i)*(1.-rat)
-               else
-                 if(mp(ij,i+1).gt.0.0)then
-                   qp(ij,i)=(gz(ij,i+1)-gz(ij,i)
-     &               +qp(ij,i+1)*(lv(ij,i+1)+t(ij,i+1)
-     &               *(cl-cpd))+cpd*(t(ij,i+1)-t(ij,i)))
-     &               /(lv(ij,i)+t(ij,i)*(cl-cpd))
-                   up(ij,i)=up(ij,i+1)
-                   vp(ij,i)=vp(ij,i+1)
-                 endif
-              endif
-              qp(ij,i)=min(qp(ij,i),qstm)
-              qp(ij,i)=max(qp(ij,i),0.0)
-            endif
-            endif
- 894      continue
- 899    continue
-c
-        return
-        end
-
-      SUBROUTINE cv_yield(nloc,ncum,nd,nk,icb,inb,delt
-     :             ,t,q,u,v,gz,p,ph,h,hp,lv,cpn
-     :             ,ep,clw,frac,m,mp,qp,up,vp
-     :             ,wt,water,evap
-     :             ,ment,qent,uent,vent,nent,elij
-     :             ,tv,tvp
-     o             ,iflag,wd,qprime,tprime
-     o             ,precip,cbmf,ft,fq,fu,fv,Ma,qcondc)
-      implicit none
-
-#include "cvthermo.h"
-#include "cvparam.h"
-
-c inputs
-      integer ncum, nd, nloc
-      integer nk(nloc), icb(nloc), inb(nloc)
-      integer nent(nloc,nd)
-      real delt
-      real t(nloc,nd), q(nloc,nd), u(nloc,nd), v(nloc,nd)
-      real gz(nloc,nd)
-      real p(nloc,nd), ph(nloc,nd+1), h(nloc,nd)
-      real hp(nloc,nd), lv(nloc,nd)
-      real cpn(nloc,nd), ep(nloc,nd), clw(nloc,nd), frac(nloc)
-      real m(nloc,nd), mp(nloc,nd), qp(nloc,nd)
-      real up(nloc,nd), vp(nloc,nd)
-      real wt(nloc,nd), water(nloc,nd), evap(nloc,nd)
-      real ment(nloc,nd,nd), qent(nloc,nd,nd), elij(nloc,nd,nd)
-      real uent(nloc,nd,nd), vent(nloc,nd,nd)
-      real tv(nloc,nd), tvp(nloc,nd)
-
-c outputs
-      integer iflag(nloc)  ! also an input
-      real cbmf(nloc)      ! also an input
-      real wd(nloc), tprime(nloc), qprime(nloc)
-      real precip(nloc)
-      real ft(nloc,nd), fq(nloc,nd), fu(nloc,nd), fv(nloc,nd)
-      real Ma(nloc,nd)
-      real qcondc(nloc,nd)
-
-c local variables
-      integer i,j,ij,k,num1
-      real dpinv,cpinv,awat,fqold,ftold,fuold,fvold,delti
-      real work(nloc), am(nloc),amp1(nloc),ad(nloc)
-      real ents(nloc), uav(nloc),vav(nloc),lvcp(nloc,nd)
-      real qcond(nloc,nd), nqcond(nloc,nd), wa(nloc,nd) ! cld
-      real siga(nloc,nd), ax(nloc,nd), mac(nloc,nd)     ! cld
-
- 
-c -- initializations:
-
-      delti = 1.0/delt
-
-      do 160 i=1,ncum
-      precip(i)=0.0
-      wd(i)=0.0
-      tprime(i)=0.0
-      qprime(i)=0.0
-       do 170 k=1,nl+1
-        ft(i,k)=0.0
-        fu(i,k)=0.0
-        fv(i,k)=0.0
-        fq(i,k)=0.0
-        lvcp(i,k)=lv(i,k)/cpn(i,k)
-        qcondc(i,k)=0.0              ! cld
-        qcond(i,k)=0.0               ! cld
-        nqcond(i,k)=0.0              ! cld
- 170   continue
- 160  continue
-
-c
-c   ***  Calculate surface precipitation in mm/day     ***
-c
-        do 1190 i=1,ncum
-          if(iflag(i).le.1)then
-cc            precip(i)=precip(i)+wt(i,1)*sigd*water(i,1)*3600.*24000.
-cc     &                /(rowl*g)
-cc            precip(i)=precip(i)*delt/86400.
-            precip(i) = wt(i,1)*sigd*water(i,1)*86400/g
-          endif
- 1190   continue
-c
-c
-c   ***  Calculate downdraft velocity scale and surface temperature and  ***
-c   ***                    water vapor fluctuations                      ***
-c
-      do i=1,ncum
-       wd(i)=betad*abs(mp(i,icb(i)))*0.01*rrd*t(i,icb(i))
-     :           /(sigd*p(i,icb(i)))
-       qprime(i)=0.5*(qp(i,1)-q(i,1))
-       tprime(i)=lv0*qprime(i)/cpd
-      enddo
-c
-c   ***  Calculate tendencies of lowest level potential temperature  ***
-c   ***                      and mixing ratio                        ***
-c
-        do 1200 i=1,ncum
-          work(i)=0.01/(ph(i,1)-ph(i,2))
-          am(i)=0.0
- 1200   continue
-        do 1220 k=2,nl
-          do 1210 i=1,ncum
-            if((nk(i).eq.1).and.(k.le.inb(i)).and.(nk(i).eq.1))then
-              am(i)=am(i)+m(i,k)
-            endif
- 1210     continue
- 1220   continue
-        do 1240 i=1,ncum
-          if((g*work(i)*am(i)).ge.delti)iflag(i)=1
-          ft(i,1)=ft(i,1)+g*work(i)*am(i)*(t(i,2)-t(i,1)
-     &    +(gz(i,2)-gz(i,1))/cpn(i,1))
-          ft(i,1)=ft(i,1)-lvcp(i,1)*sigd*evap(i,1)
-          ft(i,1)=ft(i,1)+sigd*wt(i,2)*(cl-cpd)*water(i,2)*(t(i,2)
-     &     -t(i,1))*work(i)/cpn(i,1)
-          fq(i,1)=fq(i,1)+g*mp(i,2)*(qp(i,2)-q(i,1))*
-     &    work(i)+sigd*evap(i,1)
-          fq(i,1)=fq(i,1)+g*am(i)*(q(i,2)-q(i,1))*work(i)
-          fu(i,1)=fu(i,1)+g*work(i)*(mp(i,2)*(up(i,2)-u(i,1))
-     &    +am(i)*(u(i,2)-u(i,1)))
-          fv(i,1)=fv(i,1)+g*work(i)*(mp(i,2)*(vp(i,2)-v(i,1))
-     &    +am(i)*(v(i,2)-v(i,1)))
- 1240   continue
-        do 1260 j=2,nl
-           do 1250 i=1,ncum
-             if(j.le.inb(i))then
-               fq(i,1)=fq(i,1)
-     &                 +g*work(i)*ment(i,j,1)*(qent(i,j,1)-q(i,1))
-               fu(i,1)=fu(i,1)
-     &                 +g*work(i)*ment(i,j,1)*(uent(i,j,1)-u(i,1))
-               fv(i,1)=fv(i,1)
-     &                 +g*work(i)*ment(i,j,1)*(vent(i,j,1)-v(i,1))
-             endif
- 1250      continue
- 1260   continue
-c
-c   ***  Calculate tendencies of potential temperature and mixing ratio  ***
-c   ***               at levels above the lowest level                   ***
-c
-c   ***  First find the net saturated updraft and downdraft mass fluxes  ***
-c   ***                      through each level                          ***
-c
-        do 1500 i=2,nl+1
-c
-          num1=0
-          do 1265 ij=1,ncum
-            if(i.le.inb(ij))num1=num1+1
- 1265     continue
-          if(num1.le.0)go to 1500
-c
-          call zilch(amp1,ncum)
-          call zilch(ad,ncum)
-c
-          do 1280 k=i+1,nl+1
-            do 1270 ij=1,ncum
-              if((i.ge.nk(ij)).and.(i.le.inb(ij))
-     &            .and.(k.le.(inb(ij)+1)))then
-                amp1(ij)=amp1(ij)+m(ij,k)
-              endif
- 1270         continue
- 1280     continue
-c
-          do 1310 k=1,i
-            do 1300 j=i+1,nl+1
-               do 1290 ij=1,ncum
-                 if((j.le.(inb(ij)+1)).and.(i.le.inb(ij)))then
-                   amp1(ij)=amp1(ij)+ment(ij,k,j)
-                 endif
- 1290          continue
- 1300       continue
- 1310     continue
-          do 1340 k=1,i-1
-            do 1330 j=i,nl+1
-              do 1320 ij=1,ncum
-                if((i.le.inb(ij)).and.(j.le.inb(ij)))then
-                   ad(ij)=ad(ij)+ment(ij,j,k)
-                endif
- 1320         continue
- 1330       continue
- 1340     continue
-c
-          do 1350 ij=1,ncum
-          if(i.le.inb(ij))then
-            dpinv=0.01/(ph(ij,i)-ph(ij,i+1))
-            cpinv=1.0/cpn(ij,i)
-c
-            ft(ij,i)=ft(ij,i)
-     &       +g*dpinv*(amp1(ij)*(t(ij,i+1)-t(ij,i)
-     &       +(gz(ij,i+1)-gz(ij,i))*cpinv)
-     &       -ad(ij)*(t(ij,i)-t(ij,i-1)+(gz(ij,i)-gz(ij,i-1))*cpinv))
-     &       -sigd*lvcp(ij,i)*evap(ij,i)
-            ft(ij,i)=ft(ij,i)+g*dpinv*ment(ij,i,i)*(hp(ij,i)-h(ij,i)+
-     &        t(ij,i)*(cpv-cpd)*(q(ij,i)-qent(ij,i,i)))*cpinv
-            ft(ij,i)=ft(ij,i)+sigd*wt(ij,i+1)*(cl-cpd)*water(ij,i+1)*
-     &        (t(ij,i+1)-t(ij,i))*dpinv*cpinv
-            fq(ij,i)=fq(ij,i)+g*dpinv*(amp1(ij)*(q(ij,i+1)-q(ij,i))-
-     &        ad(ij)*(q(ij,i)-q(ij,i-1)))
-            fu(ij,i)=fu(ij,i)+g*dpinv*(amp1(ij)*(u(ij,i+1)-u(ij,i))-
-     &        ad(ij)*(u(ij,i)-u(ij,i-1)))
-            fv(ij,i)=fv(ij,i)+g*dpinv*(amp1(ij)*(v(ij,i+1)-v(ij,i))-
-     &        ad(ij)*(v(ij,i)-v(ij,i-1)))
-         endif
- 1350    continue
-         do 1370 k=1,i-1
-           do 1360 ij=1,ncum
-             if(i.le.inb(ij))then
-               awat=elij(ij,k,i)-(1.-ep(ij,i))*clw(ij,i)
-               awat=max(awat,0.0)
-               fq(ij,i)=fq(ij,i)
-     &         +g*dpinv*ment(ij,k,i)*(qent(ij,k,i)-awat-q(ij,i))
-               fu(ij,i)=fu(ij,i)
-     &         +g*dpinv*ment(ij,k,i)*(uent(ij,k,i)-u(ij,i))
-               fv(ij,i)=fv(ij,i)
-     &         +g*dpinv*ment(ij,k,i)*(vent(ij,k,i)-v(ij,i))
-c (saturated updrafts resulting from mixing)               ! cld
-               qcond(ij,i)=qcond(ij,i)+(elij(ij,k,i)-awat) ! cld
-               nqcond(ij,i)=nqcond(ij,i)+1.                ! cld
-             endif
- 1360      continue
- 1370    continue
-         do 1390 k=i,nl+1
-           do 1380 ij=1,ncum
-             if((i.le.inb(ij)).and.(k.le.inb(ij)))then
-               fq(ij,i)=fq(ij,i)
-     &                  +g*dpinv*ment(ij,k,i)*(qent(ij,k,i)-q(ij,i))
-               fu(ij,i)=fu(ij,i)
-     &                  +g*dpinv*ment(ij,k,i)*(uent(ij,k,i)-u(ij,i))
-               fv(ij,i)=fv(ij,i)
-     &                  +g*dpinv*ment(ij,k,i)*(vent(ij,k,i)-v(ij,i))
-             endif
- 1380      continue
- 1390    continue
-          do 1400 ij=1,ncum
-           if(i.le.inb(ij))then
-             fq(ij,i)=fq(ij,i)
-     &                +sigd*evap(ij,i)+g*(mp(ij,i+1)*
-     &                (qp(ij,i+1)-q(ij,i))
-     &                -mp(ij,i)*(qp(ij,i)-q(ij,i-1)))*dpinv
-             fu(ij,i)=fu(ij,i)
-     &                +g*(mp(ij,i+1)*(up(ij,i+1)-u(ij,i))-mp(ij,i)*
-     &                (up(ij,i)-u(ij,i-1)))*dpinv
-             fv(ij,i)=fv(ij,i)
-     &               +g*(mp(ij,i+1)*(vp(ij,i+1)-v(ij,i))-mp(ij,i)*
-     &               (vp(ij,i)-v(ij,i-1)))*dpinv
-C (saturated downdrafts resulting from mixing)               ! cld
-            do k=i+1,inb(ij)                                 ! cld
-             qcond(ij,i)=qcond(ij,i)+elij(ij,k,i)            ! cld
-             nqcond(ij,i)=nqcond(ij,i)+1.                    ! cld
-            enddo                                            ! cld
-C (particular case: no detraining level is found)            ! cld
-            if (nent(ij,i).eq.0) then                        ! cld
-             qcond(ij,i)=qcond(ij,i)+(1.-ep(ij,i))*clw(ij,i) ! cld
-             nqcond(ij,i)=nqcond(ij,i)+1.                    ! cld
-            endif                                            ! cld
-            if (nqcond(ij,i).ne.0.) then                     ! cld
-             qcond(ij,i)=qcond(ij,i)/nqcond(ij,i)            ! cld
-            endif                                            ! cld
-           endif
- 1400     continue
- 1500   continue
-c
-c   *** Adjust tendencies at top of convection layer to reflect  ***
-c   ***       actual position of the level zero cape             ***
-c
-        do 503 ij=1,ncum
-        fqold=fq(ij,inb(ij))
-        fq(ij,inb(ij))=fq(ij,inb(ij))*(1.-frac(ij))
-        fq(ij,inb(ij)-1)=fq(ij,inb(ij)-1)
-     &   +frac(ij)*fqold*((ph(ij,inb(ij))-ph(ij,inb(ij)+1))/
-     1   (ph(ij,inb(ij)-1)-ph(ij,inb(ij))))*lv(ij,inb(ij))
-     &   /lv(ij,inb(ij)-1)
-        ftold=ft(ij,inb(ij))
-        ft(ij,inb(ij))=ft(ij,inb(ij))*(1.-frac(ij))
-        ft(ij,inb(ij)-1)=ft(ij,inb(ij)-1)
-     &   +frac(ij)*ftold*((ph(ij,inb(ij))-ph(ij,inb(ij)+1))/
-     1   (ph(ij,inb(ij)-1)-ph(ij,inb(ij))))*cpn(ij,inb(ij))
-     &   /cpn(ij,inb(ij)-1)
-        fuold=fu(ij,inb(ij))
-        fu(ij,inb(ij))=fu(ij,inb(ij))*(1.-frac(ij))
-        fu(ij,inb(ij)-1)=fu(ij,inb(ij)-1)
-     &   +frac(ij)*fuold*((ph(ij,inb(ij))-ph(ij,inb(ij)+1))/
-     1   (ph(ij,inb(ij)-1)-ph(ij,inb(ij))))
-        fvold=fv(ij,inb(ij))
-        fv(ij,inb(ij))=fv(ij,inb(ij))*(1.-frac(ij))
-        fv(ij,inb(ij)-1)=fv(ij,inb(ij)-1)
-     &  +frac(ij)*fvold*((ph(ij,inb(ij))-ph(ij,inb(ij)+1))/
-     1   (ph(ij,inb(ij)-1)-ph(ij,inb(ij))))
- 503    continue
-c
-c   ***   Very slightly adjust tendencies to force exact   ***
-c   ***     enthalpy, momentum and tracer conservation     ***
-c
-        do 682 ij=1,ncum
-        ents(ij)=0.0
-        uav(ij)=0.0
-        vav(ij)=0.0
-        do 681 i=1,inb(ij)
-         ents(ij)=ents(ij)
-     &  +(cpn(ij,i)*ft(ij,i)+lv(ij,i)*fq(ij,i))*(ph(ij,i)-ph(ij,i+1))	
-         uav(ij)=uav(ij)+fu(ij,i)*(ph(ij,i)-ph(ij,i+1))
-         vav(ij)=vav(ij)+fv(ij,i)*(ph(ij,i)-ph(ij,i+1))
-  681	continue
-  682   continue
-        do 683 ij=1,ncum
-        ents(ij)=ents(ij)/(ph(ij,1)-ph(ij,inb(ij)+1))
-        uav(ij)=uav(ij)/(ph(ij,1)-ph(ij,inb(ij)+1))
-        vav(ij)=vav(ij)/(ph(ij,1)-ph(ij,inb(ij)+1))
- 683    continue
-        do 642 ij=1,ncum
-        do 641 i=1,inb(ij)
-         ft(ij,i)=ft(ij,i)-ents(ij)/cpn(ij,i)
-         fu(ij,i)=(1.-cu)*(fu(ij,i)-uav(ij))
-         fv(ij,i)=(1.-cu)*(fv(ij,i)-vav(ij))
-  641	continue
- 642    continue
-c
-        do 1810 k=1,nl+1
-          do 1800 i=1,ncum
-            if((q(i,k)+delt*fq(i,k)).lt.0.0)iflag(i)=10
- 1800     continue
- 1810   continue
-c
-c
-        do 1900 i=1,ncum
-          if(iflag(i).gt.2)then
-          precip(i)=0.0
-          cbmf(i)=0.0
-          endif
- 1900   continue
-        do 1920 k=1,nl
-         do 1910 i=1,ncum
-           if(iflag(i).gt.2)then
-             ft(i,k)=0.0
-             fq(i,k)=0.0
-             fu(i,k)=0.0
-             fv(i,k)=0.0
-             qcondc(i,k)=0.0                               ! cld
-           endif
- 1910    continue
- 1920   continue
-
-        do k=1,nl+1
-        do i=1,ncum
-          Ma(i,k) = 0.
-        enddo
-        enddo
-        do k=nl,1,-1
-        do i=1,ncum
-          Ma(i,k) = Ma(i,k+1)+m(i,k)
-        enddo
-        enddo
-
-c
-c   *** diagnose the in-cloud mixing ratio   ***            ! cld
-c   ***           of condensed water         ***            ! cld
-c                                                           ! cld
-      DO ij=1,ncum                                          ! cld   
-       do i=1,nd                                            ! cld 
-        mac(ij,i)=0.0                                       ! cld   
-        wa(ij,i)=0.0                                        ! cld
-        siga(ij,i)=0.0                                      ! cld
-       enddo                                                ! cld
-       do i=nk(ij),inb(ij)                                  ! cld
-       do k=i+1,inb(ij)+1                                   ! cld
-        mac(ij,i)=mac(ij,i)+m(ij,k)                         ! cld
-       enddo                                                ! cld
-       enddo                                                ! cld
-       do i=icb(ij),inb(ij)-1                               ! cld
-        ax(ij,i)=0.                                         ! cld
-        do j=icb(ij),i                                      ! cld
-         ax(ij,i)=ax(ij,i)+rrd*(tvp(ij,j)-tv(ij,j))         ! cld   
-     :       *(ph(ij,j)-ph(ij,j+1))/p(ij,j)                 ! cld   
-        enddo                                               ! cld
-        if (ax(ij,i).gt.0.0) then                           ! cld   
-         wa(ij,i)=sqrt(2.*ax(ij,i))                         ! cld
-        endif                                               ! cld
-       enddo                                                ! cld
-       do i=1,nl                                            ! cld
-        if (wa(ij,i).gt.0.0)                                ! cld
-     :    siga(ij,i)=mac(ij,i)/wa(ij,i)                     ! cld   
-     :        *rrd*tvp(ij,i)/p(ij,i)/100./delta             ! cld   
-        siga(ij,i) = min(siga(ij,i),1.0)                    ! cld
-        qcondc(ij,i)=siga(ij,i)*clw(ij,i)*(1.-ep(ij,i))     ! cld   
-     :          + (1.-siga(ij,i))*qcond(ij,i)               ! cld   
-       enddo                                                ! cld
-      ENDDO                                                 ! cld   
-
-        return
-        end
-
-      SUBROUTINE cv_uncompress(nloc,len,ncum,nd,idcum
-     :         ,iflag
-     :         ,precip,cbmf
-     :         ,ft,fq,fu,fv
-     :         ,Ma,qcondc            
-     :         ,iflag1
-     :         ,precip1,cbmf1
-     :         ,ft1,fq1,fu1,fv1
-     :         ,Ma1,qcondc1            
-     :                               )
-      implicit none
-
-#include "cvparam.h"
-
-c inputs:
-      integer len, ncum, nd, nloc
-      integer idcum(nloc)
-      integer iflag(nloc)
-      real precip(nloc), cbmf(nloc)
-      real ft(nloc,nd), fq(nloc,nd), fu(nloc,nd), fv(nloc,nd)
-      real Ma(nloc,nd)
-      real qcondc(nloc,nd) !cld
-
-c outputs:
-      integer iflag1(len)
-      real precip1(len), cbmf1(len)
-      real ft1(len,nd), fq1(len,nd), fu1(len,nd), fv1(len,nd)
-      real Ma1(len,nd)
-      real qcondc1(len,nd) !cld
-
-c local variables:
-      integer i,k
-
-        do 2000 i=1,ncum
-         precip1(idcum(i))=precip(i)
-         cbmf1(idcum(i))=cbmf(i)
-         iflag1(idcum(i))=iflag(i)
- 2000   continue
-
-        do 2020 k=1,nl
-          do 2010 i=1,ncum
-            ft1(idcum(i),k)=ft(i,k)
-            fq1(idcum(i),k)=fq(i,k)
-            fu1(idcum(i),k)=fu(i,k)
-            fv1(idcum(i),k)=fv(i,k)
-            Ma1(idcum(i),k)=Ma(i,k)
-            qcondc1(idcum(i),k)=qcondc(i,k)
- 2010     continue
- 2020   continue
-
-        return
-        end
-
Index: LMDZ.3.3/branches/rel-/libf/phylmd/cvparam.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/cvparam.h	(revision 416)
+++ 	(revision )
@@ -1,25 +1,0 @@
-c------------------------------------------------------------
-c Parameters for convectL:
-c (includes - microphysical parameters, 
-c			- parameters that control the rate of approach 
-c               to quasi-equilibrium)
-c			- noff & minorig (previously in input of convect1)
-c------------------------------------------------------------
-
-      integer noff, minorig, nl, nlp, nlm
-      real elcrit, tlcrit
-      real entp
-      real sigs, sigd
-      real omtrain, omtsnow, coeffr, coeffs
-      real dtmax
-      real cu
-      real betad
-      real alpha, damp
-      real delta
-
-      COMMON /cvparam/ noff, minorig, nl, nlp, nlm
-     :                ,elcrit, tlcrit
-     :                ,entp, sigs, sigd
-     :                ,omtrain, omtsnow, coeffr, coeffs
-     :                ,dtmax, cu, betad, alpha, damp, delta
-
Index: LMDZ.3.3/branches/rel-/libf/phylmd/diagphy.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/diagphy.F	(revision 416)
+++ 	(revision )
@@ -1,400 +1,0 @@
-      SUBROUTINE diagphy(tit,iprt
-     $    , tops, topl, sols, soll, sens
-     $    , evap, rain_fall, snow_fall, ts
-     $    , d_etp_tot, d_qt_tot, d_ec_tot
-     $    , fs_bound, fq_bound)
-C======================================================================
-C
-C Purpose:
-C    Compute the thermal flux and the watter mass flux at the atmosphere
-c    boundaries. Print them and also the atmospheric enthalpy change and
-C    the  atmospheric mass change.
-C
-C Arguments: 
-C tit---------input-A15- Comment to be added in PRINT (CHARACTER*15)
-C iprt--------input-I-  PRINT level ( <=0 : no PRINT)
-C tops(klon)--input-R-  SW rad. at TOA (W/m2), positive up.
-C topl(klon)--input-R-  LW rad. at TOA (W/m2), positive down
-C sols(klon)--input-R-  Net SW flux above surface (W/m2), positive up 
-C                   (i.e. -1 * flux absorbed by the surface)
-C soll(klon)--input-R-  Net LW flux above surface (W/m2), positive up 
-C                   (i.e. flux emited - flux absorbed by the surface)
-C sens(klon)--input-R-  Sensible Flux at surface  (W/m2), positive down
-C evap(klon)--input-R-  Evaporation + sublimation watter vapour mass flux
-C                   (kg/m2/s), positive up
-C rain_fall(klon)
-C           --input-R- Liquid  watter mass flux (kg/m2/s), positive down
-C snow_fall(klon)
-C           --input-R- Solid  watter mass flux (kg/m2/s), positive down
-C ts(klon)----input-R- Surface temperature (K)
-C d_etp_tot---input-R- Heat flux equivalent to atmospheric enthalpy 
-C                    change (W/m2)
-C d_qt_tot----input-R- Mass flux equivalent to atmospheric watter mass 
-C                    change (kg/m2/s)
-C d_ec_tot----input-R- Flux equivalent to atmospheric cinetic energy
-C                    change (W/m2)
-C
-C fs_bound---output-R- Thermal flux at the atmosphere boundaries (W/m2)
-C fq_bound---output-R- Watter mass flux at the atmosphere boundaries (kg/m2/s)
-C
-C J.L. Dufresne, July 2002
-C======================================================================
-C 
-      implicit none
-
-#include "dimensions.h"
-#include "dimphy.h"
-#include "comgeophy.h"
-#include "YOMCST.h"
-#include "YOETHF.h"
-C
-C     Input variables
-      CHARACTER*15 tit
-      INTEGER iprt
-      real tops(klon),topl(klon),sols(klon),soll(klon)
-      real sens(klon),evap(klon),rain_fall(klon),snow_fall(klon)
-      REAL ts(klon)
-      REAL d_etp_tot, d_qt_tot, d_ec_tot
-c     Output variables
-      REAL fs_bound, fq_bound
-C
-C     Local variables
-      real stops,stopl,ssols,ssoll
-      real ssens,sfront,slat
-      real airetot, zcpvap, zcwat, zcice
-      REAL rain_fall_tot, snow_fall_tot, evap_tot
-C
-      integer i
-C
-      integer pas
-      save pas
-      data pas/0/
-C
-      pas=pas+1
-      stops=0.
-      stopl=0.
-      ssols=0.
-      ssoll=0.
-      ssens=0.
-      sfront = 0.
-      evap_tot = 0.
-      rain_fall_tot = 0.
-      snow_fall_tot = 0.
-      airetot=0.
-C
-C     Pour les chaleur specifiques de la vapeur d'eau, de l'eau et de
-C     la glace, on travaille par difference a la chaleur specifique de l'
-c     air sec. En effet, comme on travaille a niveau de pression donne,
-C     toute variation de la masse d'un constituant est totalement
-c     compense par une variation de masse d'air.
-C
-      zcpvap=RCPV-RCPD
-      zcwat=RCW-RCPD
-      zcice=RCS-RCPD
-C
-      do i=1,klon
-           stops=stops+tops(i)*airephy(i)
-           stopl=stopl+topl(i)*airephy(i)
-           ssols=ssols+sols(i)*airephy(i)
-           ssoll=ssoll+soll(i)*airephy(i)
-           ssens=ssens+sens(i)*airephy(i)
-           sfront = sfront
-     $         + ( evap(i)*zcpvap-rain_fall(i)*zcwat-snow_fall(i)*zcice
-     $           ) *ts(i) *airephy(i)
-           evap_tot = evap_tot + evap(i)*airephy(i)
-           rain_fall_tot = rain_fall_tot + rain_fall(i)*airephy(i)
-           snow_fall_tot = snow_fall_tot + snow_fall(i)*airephy(i)
-           airetot=airetot+airephy(i)
-      enddo
-      stops=stops/airetot
-      stopl=stopl/airetot
-      ssols=ssols/airetot
-      ssoll=ssoll/airetot
-      ssens=ssens/airetot
-      sfront = sfront/airetot
-      evap_tot = evap_tot /airetot
-      rain_fall_tot = rain_fall_tot/airetot
-      snow_fall_tot = snow_fall_tot/airetot
-C
-      slat = RLVTT * rain_fall_tot + RLSTT * snow_fall_tot
-C     Heat flux at atm. boundaries
-      fs_bound = stops-stopl - (ssols+ssoll)+ssens+sfront
-     $    + slat
-C     Watter flux at atm. boundaries
-      fq_bound = evap_tot - rain_fall_tot -snow_fall_tot
-C
-      IF (iprt.ge.1) write(6,6666) 
-     $    tit, pas, fs_bound, d_etp_tot, fq_bound, d_qt_tot
-C
-      IF (iprt.ge.2) write(6,6667) 
-     $    tit, pas, stops,stopl,ssols,ssoll,ssens,slat,evap_tot
-     $    ,rain_fall_tot+snow_fall_tot
-
-      return
-
- 6666 format('Flux Budget ',a15,1i6,2f8.2,2(1pE13.5))
- 6667 format('Boundary Flux ',a15,1i6,6f8.2,2(1pE13.5))
-
-      end
-
-C======================================================================
-      SUBROUTINE diagetpq(tit,iprt,idiag,idiag2,dtime
-     e  ,t,q,ql,qs,u,v,paprs,pplay
-     s  , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
-C======================================================================
-C
-C Purpose:
-C    Calcul la difference d'enthalpie et de masse d'eau entre 2 appels,
-C    et calcul le flux de chaleur et le flux d'eau necessaire a ces 
-C    changements. Ces valeurs sont moyennees sur la surface de tout
-C    le globe et sont exprime en W/2 et kg/s/m2
-C    Outil pour diagnostiquer la conservation de l'energie
-C    et de la masse dans la physique. Suppose que les niveau de
-c    pression entre couche ne varie pas entre 2 appels.
-C
-C Plusieurs de ces diagnostics peuvent etre fait en parallele: les
-c bilans sont sauvegardes dans des tableaux indices. On parlera
-C "d'indice de diagnostic"
-c 
-C
-c======================================================================
-C Arguments: 
-C tit-----imput-A15- Comment added in PRINT (CHARACTER*15)
-C iprt----input-I-  PRINT level ( <=1 : no PRINT)
-C idiag---input-I- indice dans lequel sera range les nouveaux
-C                  bilans d' entalpie et de masse
-C idiag2--input-I-les nouveaux bilans d'entalpie et de masse 
-C                 sont compare au bilan de d'enthalpie de masse de
-C                 l'indice numero idiag2 
-C                 Cas parriculier : si idiag2=0, pas de comparaison, on
-c                 sort directement les bilans d'enthalpie et de masse 
-C dtime----input-R- time step (s)
-c t--------input-R- temperature (K)
-c q--------input-R- vapeur d'eau (kg/kg)
-c ql-------input-R- liquid watter (kg/kg)
-c qs-------input-R- solid watter (kg/kg)
-c u--------input-R- vitesse u
-c v--------input-R- vitesse v
-c paprs----input-R- pression a intercouche (Pa)
-c pplay----input-R- pression au milieu de couche (Pa)
-c
-C the following total value are computed by UNIT of earth surface
-C
-C d_h_vcol--output-R- Heat flux (W/m2) define as the Enthalpy 
-c            change (J/m2) during one time step (dtime) for the whole 
-C            atmosphere (air, watter vapour, liquid and solid)
-C d_qt------output-R- total water mass flux (kg/m2/s) defined as the 
-C           total watter (kg/m2) change during one time step (dtime),
-C d_qw------output-R- same, for the watter vapour only (kg/m2/s)
-C d_ql------output-R- same, for the liquid watter only (kg/m2/s)
-C d_qs------output-R- same, for the solid watter only (kg/m2/s)
-C d_ec------output-R- Cinetic Energy Budget (W/m2) for vertical air column
-C
-C     other (COMMON...)
-C     RG : gravity
-C     airephy(klon) : mesh surface
-C
-C J.L. Dufresne, July 2002
-c======================================================================
- 
-      IMPLICIT NONE
-C
-#include "dimensions.h"
-#include "dimphy.h"
-#include "comgeophy.h"
-#include "YOMCST.h"
-#include "YOETHF.h"
-C
-c     Input variables
-      CHARACTER*15 tit
-      INTEGER iprt,idiag, idiag2
-      REAL dtime
-      REAL t(klon,klev), q(klon,klev), ql(klon,klev), qs(klon,klev)
-      REAL u(klon,klev), v(klon,klev)
-      REAL paprs(klon,klev+1), pplay(klon,klev)
-c     Output variables
-      REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec
-C
-C     Local variables
-c
-      REAL h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot
-     .  , h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot
-c h_vcol_tot--  total enthalpy of vertical air column 
-C            (air with watter vapour, liquid and solid) (J/m2)
-c h_dair_tot-- total enthalpy of dry air (J/m2)
-c h_qw_tot----  total enthalpy of watter vapour (J/m2)
-c h_ql_tot----  total enthalpy of liquid watter (J/m2)
-c h_qs_tot----  total enthalpy of solid watter  (J/m2)
-c qw_tot------  total mass of watter vapour (kg/m2)
-c ql_tot------  total mass of liquid watter (kg/m2)
-c qs_tot------  total mass of solid watter (kg/m2)
-c ec_tot------  total cinetic energy (kg/m2)
-C
-      REAL zairm(klon,klev) ! layer air mass (kg/m2)
-      REAL  zqw_col(klon)
-      REAL  zql_col(klon)
-      REAL  zqs_col(klon)
-      REAL  zec_col(klon)
-      REAL  zh_dair_col(klon)
-      REAL  zh_qw_col(klon), zh_ql_col(klon), zh_qs_col(klon)
-C
-      REAL      d_h_dair, d_h_qw, d_h_ql, d_h_qs
-C
-      REAL airetot, zcpvap, zcwat, zcice
-C
-      INTEGER i, k
-C
-      INTEGER ndiag     ! max number of diagnostic in parallel
-      PARAMETER (ndiag=10)
-      integer pas(ndiag)
-      save pas
-      data pas/ndiag*0/
-C     
-      REAL      h_vcol_pre(ndiag), h_dair_pre(ndiag), h_qw_pre(ndiag)
-     $    , h_ql_pre(ndiag), h_qs_pre(ndiag), qw_pre(ndiag)
-     $    , ql_pre(ndiag), qs_pre(ndiag) , ec_pre(ndiag)
-      SAVE      h_vcol_pre, h_dair_pre, h_qw_pre, h_ql_pre
-     $        , h_qs_pre, qw_pre, ql_pre, qs_pre , ec_pre
-
-c======================================================================
-C
-      DO k = 1, klev
-        DO i = 1, klon
-C         layer air mass
-          zairm(i,k) = (paprs(i,k)-paprs(i,k+1))/RG
-        ENDDO
-      END DO
-C
-C     Reset variables
-      DO i = 1, klon
-        zqw_col(i)=0.
-        zql_col(i)=0.
-        zqs_col(i)=0.
-        zec_col(i) = 0.
-        zh_dair_col(i) = 0.
-        zh_qw_col(i) = 0.
-        zh_ql_col(i) = 0.
-        zh_qs_col(i) = 0.
-      ENDDO
-C
-      zcpvap=RCPV
-      zcwat=RCW
-      zcice=RCS
-C
-C     Compute vertical sum for each atmospheric column
-C     ================================================
-      DO k = 1, klev
-        DO i = 1, klon
-C         Watter mass
-          zqw_col(i) = zqw_col(i) + q(i,k)*zairm(i,k)
-          zql_col(i) = zql_col(i) + ql(i,k)*zairm(i,k)
-          zqs_col(i) = zqs_col(i) + qs(i,k)*zairm(i,k)
-C         Cinetic Energy
-          zec_col(i) =  zec_col(i)
-     $        +0.5*SQRT(u(i,k)**2+v(i,k)**2)*zairm(i,k)
-C         Air enthalpy
-          zh_dair_col(i) = zh_dair_col(i) 
-     $        + RCPD*(1.-q(i,k)-ql(i,k)-qs(i,k))*zairm(i,k)*t(i,k)
-          zh_qw_col(i) = zh_qw_col(i)
-     $        + zcpvap*q(i,k)*zairm(i,k)*t(i,k) 
-          zh_ql_col(i) = zh_ql_col(i)
-     $        + zcwat*ql(i,k)*zairm(i,k)*t(i,k) 
-     $        - RLVTT*ql(i,k)*zairm(i,k)
-          zh_qs_col(i) = zh_qs_col(i)
-     $        + zcice*qs(i,k)*zairm(i,k)*t(i,k) 
-     $        - RLSTT*qs(i,k)*zairm(i,k)
-
-        END DO
-      ENDDO
-C
-C     Mean over the planete surface
-C     =============================
-      qw_tot = 0.
-      ql_tot = 0.
-      qs_tot = 0.
-      ec_tot = 0.
-      h_vcol_tot = 0.
-      h_dair_tot = 0.
-      h_qw_tot = 0.
-      h_ql_tot = 0.
-      h_qs_tot = 0.
-      airetot=0.
-C
-      do i=1,klon
-        qw_tot = qw_tot + zqw_col(i)*airephy(i)
-        ql_tot = ql_tot + zql_col(i)*airephy(i)
-        qs_tot = qs_tot + zqs_col(i)*airephy(i)
-        ec_tot = ec_tot + zec_col(i)*airephy(i)
-        h_dair_tot = h_dair_tot + zh_dair_col(i)*airephy(i)
-        h_qw_tot = h_qw_tot + zh_qw_col(i)*airephy(i)
-        h_ql_tot = h_ql_tot + zh_ql_col(i)*airephy(i)
-        h_qs_tot = h_qs_tot + zh_qs_col(i)*airephy(i)
-        airetot=airetot+airephy(i)
-      END DO
-C
-      qw_tot = qw_tot/airetot
-      ql_tot = ql_tot/airetot
-      qs_tot = qs_tot/airetot
-      ec_tot = ec_tot/airetot
-      h_dair_tot = h_dair_tot/airetot
-      h_qw_tot = h_qw_tot/airetot
-      h_ql_tot = h_ql_tot/airetot
-      h_qs_tot = h_qs_tot/airetot
-C
-      h_vcol_tot = h_dair_tot+h_qw_tot+h_ql_tot+h_qs_tot
-C
-C     Compute the change of the atmospheric state compare to the one 
-C     stored in "idiag2", and convert it in flux. THis computation
-C     is performed IF idiag2 /= 0 and IF it is not the first CALL
-c     for "idiag"
-C     ===================================
-C
-      IF ( (idiag2.gt.0) .and. (pas(idiag2) .ne. 0) ) THEN
-        d_h_vcol  = (h_vcol_tot - h_vcol_pre(idiag2) )/dtime
-        d_h_dair = (h_dair_tot- h_dair_pre(idiag2))/dtime
-        d_h_qw   = (h_qw_tot  - h_qw_pre(idiag2)  )/dtime
-        d_h_ql   = (h_ql_tot  - h_ql_pre(idiag2)  )/dtime 
-        d_h_qs   = (h_qs_tot  - h_qs_pre(idiag2)  )/dtime 
-        d_qw     = (qw_tot    - qw_pre(idiag2)    )/dtime
-        d_ql     = (ql_tot    - ql_pre(idiag2)    )/dtime
-        d_qs     = (qs_tot    - qs_pre(idiag2)    )/dtime
-        d_ec     = (ec_tot    - ec_pre(idiag2)    )/dtime
-        d_qt = d_qw + d_ql + d_qs
-      ELSE 
-        d_h_vcol = 0.
-        d_h_dair = 0.
-        d_h_qw   = 0.
-        d_h_ql   = 0.
-        d_h_qs   = 0. 
-        d_qw     = 0.
-        d_ql     = 0.
-        d_qs     = 0.
-        d_ec     = 0.
-        d_qt     = 0.
-      ENDIF 
-C
-      IF (iprt.ge.2) THEN
-        WRITE(6,9000) tit,pas(idiag),d_qt,d_qw,d_ql,d_qs
- 9000   format('Watter Mass Budget (kg/m2/s)',A15
-     $      ,1i6,10(1pE14.6))
-        WRITE(6,9001) tit,pas(idiag), d_h_vcol
- 9001   format('Enthalpy Budget (W/m2) ',A15,1i6,10(F8.2))
-        WRITE(6,9002) tit,pas(idiag), d_ec
- 9002   format('Cinetic Energy Budget (W/m2) ',A15,1i6,10(F8.2))
-      END IF 
-C
-C     Store the new atmospheric state in "idiag"
-C
-      pas(idiag)=pas(idiag)+1
-      h_vcol_pre(idiag)  = h_vcol_tot
-      h_dair_pre(idiag) = h_dair_tot
-      h_qw_pre(idiag)   = h_qw_tot
-      h_ql_pre(idiag)   = h_ql_tot
-      h_qs_pre(idiag)   = h_qs_tot
-      qw_pre(idiag)     = qw_tot
-      ql_pre(idiag)     = ql_tot
-      qs_pre(idiag)     = qs_tot
-      ec_pre (idiag)    = ec_tot
-C
-      RETURN 
-      END 
Index: LMDZ.3.3/branches/rel-/libf/phylmd/dimphy.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/dimphy.h	(revision 416)
+++ 	(revision )
@@ -1,8 +1,0 @@
-c-----------------------------------------------------------------------
-      INTEGER KIDIA, KFDIA, KLON, KLEV
-      PARAMETER (KIDIA=1,KFDIA=iim*(jjm-1)+2-1/jjm,
-     .           KLON=KFDIA-KIDIA+1,KLEV=llm)
-c-----------------------------------------------------------------------
-      INTEGER nbtr ! nombre de vrais traceurs
-      PARAMETER (nbtr=nqmx-2+1/(nqmx-1))
-c-----------------------------------------------------------------------
Index: LMDZ.3.3/branches/rel-/libf/phylmd/dimsoil.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/dimsoil.h	(revision 416)
+++ 	(revision )
@@ -1,2 +1,0 @@
-      INTEGER nsoilmx
-      PARAMETER (nsoilmx=11)
Index: LMDZ.3.3/branches/rel-/libf/phylmd/ecribin.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/ecribin.F	(revision 416)
+++ 	(revision )
@@ -1,99 +1,0 @@
-      SUBROUTINE ecribins(unit,pz)
-      IMPLICIT none
-c-----------------------------------------------------------------------
-#include "dimensions.h"
-#include "dimphy.h"
-#include "paramet.h"
-#include "comgeom.h"
-#include "comvert.h"
-c
-c   arguments:
-c   ----------
-      INTEGER unit
-      REAL pz(klon)
-c
-c   local:
-c   ------
-      INTEGER i,j, ig
-      REAL zz(iim +1,jjm+1)
-c-----------------------------------------------------------------------
-c   passage a la grille dynamique:
-c   ------------------------------
-         DO i=1,iim +1
-            zz(i,1)=pz(1)
-            zz(i,jjm+1)=pz(klon)
-         ENDDO
-c   traitement des point normaux
-         DO j=2,jjm
-            ig=2+(j-2)*iim
-            CALL SCOPY(iim,pz(ig),1,zz(1,j),1)
-            zz(iim+1,j)=zz(1,j)
-         ENDDO
-c-----------------------------------------------------------------------
-#ifdef VPP
-      CALL ecriture(unit,zz,(iim+1)*(jjm+1))
-#else
-      WRITE(unit) zz
-#endif
-c
-
-      RETURN
-      END
-      SUBROUTINE ecribina(unit,pz)
-      IMPLICIT none
-c-----------------------------------------------------------------------
-#include "dimensions.h"
-#include "dimphy.h"
-#include "paramet.h"
-#include "comgeom.h"
-#include "comvert.h"
-c
-c   arguments:
-c   ----------
-      INTEGER unit
-      REAL pz(klon,klev)
-c
-c   local:
-c   ------
-      INTEGER i,j,ilay,ig
-      REAL zz(iim+1,jjm+1,llm)
-c-----------------------------------------------------------------------
-c   passage a la grille dynamique:
-c   ------------------------------
-      DO ilay=1,llm
-c   traitement des poles
-         DO i=1,iim +1
-            zz(i,1,ilay)=pz(1,ilay)
-            zz(i,jjm+1,ilay)=pz(klon,ilay)
-         ENDDO
-c   traitement des point normaux
-         DO j=2,jjm
-            ig=2+(j-2)*iim
-            CALL SCOPY(iim,pz(ig,ilay),1,zz(1,j,ilay),1)
-            zz(iim+1,j,ilay)=zz(1,j,ilay)
-         ENDDO
-      ENDDO
-c-----------------------------------------------------------------------
-      DO ilay = 1, llm
-#ifdef VPP
-         CALL ecriture(unit, zz(1,1,ilay), (iim+1)*(jjm+1))
-#else
-         WRITE(unit) ((zz(i,j,ilay),i=1,iim +1),j=1,jjm+1)
-#endif
-      ENDDO
-c
-      RETURN
-      END
-#ifdef VPP
-@OPTIONS NODOUBLE
-      SUBROUTINE ecriture(nunit, r8, n)
-      INTEGER nunit, n, i
-      REAL*8 r8(n)
-      REAL*4 r4(n)
-      DO i = 1, n
-         r4(i) = r8(i)
-      ENDDO
-      WRITE(nunit)r4
-      RETURN
-      END
-#endif
Index: LMDZ.3.3/branches/rel-/libf/phylmd/ecrireg.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/ecrireg.F	(revision 416)
+++ 	(revision )
@@ -1,116 +1,0 @@
-      SUBROUTINE ecriregs(unit,pz)
-      IMPLICIT none
-c-----------------------------------------------------------------------
-#include "dimensions.h"
-#include "dimphy.h"
-#include "paramet.h"
-#include "comgeom.h"
-#include "comvert.h"
-#include "regdim.h"
-c
-c   arguments:
-c   ----------
-      INTEGER unit
-      REAL pz(klon)
-c
-c   local:
-c   ------
-      INTEGER i,j, ig
-      REAL zz(iim,jjm+1)
-      INTEGER nleng
-      PARAMETER (nleng=(i2_fin-i2_deb+1+i1_fin-i1_deb+1)
-     .                *(j_fin-j_deb+1))
-      REAL zzz(nleng)
-c
-c-----------------------------------------------------------------------
-c   passage a la grille dynamique:
-c   ------------------------------
-         DO i=1,iim
-            zz(i,1)=pz(1)
-            zz(i,jjm+1)=pz(klon)
-         ENDDO
-c
-c   traitement des point normaux
-         DO j=2,jjm
-            ig=2+(j-2)*iim
-            CALL SCOPY(iim,pz(ig),1,zz(1,j),1)
-         ENDDO
-c-----------------------------------------------------------------------
-      ig = 0
-      DO j = j_deb, j_fin
-         DO i=i1_deb,i1_fin
-            ig = ig + 1
-            zzz(ig) = zz(i,j)
-         ENDDO
-         DO i=i2_deb,i2_fin
-            ig = ig + 1
-            zzz(ig) = zz(i,j)
-         ENDDO
-      ENDDO
-#ifdef VPP
-      CALL ecriture(unit,zzz,nleng)
-#else
-      WRITE(unit) zzz
-#endif
-      RETURN
-      END
-      SUBROUTINE ecrirega(unit,pz)
-      IMPLICIT none
-c-----------------------------------------------------------------------
-#include "dimensions.h"
-#include "dimphy.h"
-#include "paramet.h"
-#include "comgeom.h"
-#include "comvert.h"
-#include "regdim.h"
-c
-c   arguments:
-c   ----------
-      INTEGER unit
-      REAL pz(klon,klev)
-c
-c   local:
-c   ------
-      INTEGER i,j,ilay,ig
-      REAL zz(iim,jjm+1,llm)
-      INTEGER nleng
-      PARAMETER (nleng=(i2_fin-i2_deb+1+i1_fin-i1_deb+1)
-     .                *(j_fin-j_deb+1))
-      REAL zzz(nleng)
-c-----------------------------------------------------------------------
-c   passage a la grille dynamique:
-c   ------------------------------
-      DO ilay=1,llm
-c   traitement des poles
-         DO i=1,iim
-            zz(i,1,ilay)=pz(1,ilay)
-            zz(i,jjm+1,ilay)=pz(klon,ilay)
-         ENDDO
-c   traitement des point normaux
-         DO j=2,jjm
-            ig=2+(j-2)*iim
-            CALL SCOPY(iim,pz(ig,ilay),1,zz(1,j,ilay),1)
-         ENDDO
-      ENDDO
-c-----------------------------------------------------------------------
-      DO ilay = 1, llm
-      ig = 0
-      DO j = j_deb, j_fin
-         DO i=i1_deb,i1_fin
-            ig = ig + 1
-            zzz(ig) = zz(i,j,ilay)
-         ENDDO
-         DO i=i2_deb,i2_fin
-            ig = ig + 1
-            zzz(ig) = zz(i,j,ilay)
-         ENDDO
-      ENDDO
-#ifdef VPP
-      CALL ecriture(unit,zzz,nleng)
-#else
-      WRITE(unit) zzz
-#endif
-      ENDDO
-
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/fisrtilp.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/fisrtilp.F	(revision 416)
+++ 	(revision )
@@ -1,311 +1,0 @@
-      SUBROUTINE fisrtilp(dtime,paprs,pplay,t,q,
-     s                   d_t, d_q, d_ql, rneb, radliq, rain, snow,
-     s                   prfl, psfl)
-c
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS)
-c Date: le 20 mars 1995
-c Objet: condensation et precipitation stratiforme.
-c        schema de nuage
-c======================================================================
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-c
-c Arguments:
-c
-      REAL dtime ! intervalle du temps (s)
-      REAL paprs(klon,klev+1) ! pression a inter-couche
-      REAL pplay(klon,klev) ! pression au milieu de couche
-      REAL t(klon,klev) ! temperature (K)
-      REAL q(klon,klev) ! humidite specifique (kg/kg)
-      REAL d_t(klon,klev) ! incrementation de la temperature (K)
-      REAL d_q(klon,klev) ! incrementation de la vapeur d'eau
-      REAL d_ql(klon,klev) ! incrementation de l'eau liquide
-      REAL rneb(klon,klev) ! fraction nuageuse
-      REAL radliq(klon,klev) ! eau liquide utilisee dans rayonnements
-      REAL rain(klon) ! pluies (mm/s)
-      REAL snow(klon) ! neige (mm/s)
-      REAL prfl(klon,klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s)
-      REAL psfl(klon,klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s)
-c
-c Options du programme:
-c
-      REAL seuil_neb ! un nuage existe vraiment au-dela
-      PARAMETER (seuil_neb=0.001)
-      REAL ct ! inverse du temps pour qu'un nuage precipite
-      PARAMETER (ct=1./1800.)
-      REAL cl ! seuil de precipitation
-      PARAMETER (cl=2.6e-4)
-ccc      PARAMETER (cl=2.3e-4)
-ccc      PARAMETER (cl=2.0e-4)
-      INTEGER ninter ! sous-intervals pour la precipitation
-      PARAMETER (ninter=5)
-      LOGICAL evap_prec ! evaporation de la pluie
-      PARAMETER (evap_prec=.TRUE.)
-      REAL coef_eva
-      PARAMETER (coef_eva=2.0E-05)
-      LOGICAL calcrat ! calculer ratqs au lieu de fixer sa valeur
-      REAL ratqs ! determine la largeur de distribution de vapeur
-      PARAMETER (calcrat=.TRUE.)
-      REAL zx_min, rat_max
-      PARAMETER (zx_min=1.0, rat_max=0.01)
-      REAL zx_max, rat_min
-      PARAMETER (zx_max=0.1, rat_min=0.3)
-      REAL zx
-c
-      LOGICAL cpartiel ! condensation partielle
-      PARAMETER (cpartiel=.TRUE.)
-      REAL t_coup
-      PARAMETER (t_coup=234.0)
-c
-c Variables locales:
-c
-      INTEGER i, k, n
-      REAL zqs(klon), zdqs(klon), zdelta, zcor, zcvm5
-      REAL zrfl(klon), zrfln(klon), zqev, zqevt
-      REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon), zdelq
-      REAL ztglace, zt(klon)
-      INTEGER nexpo ! exponentiel pour glace/eau
-      REAL zdz(klon),zrho(klon),ztot(klon), zrhol(klon)
-      REAL zchau(klon),zfroi(klon),zfice(klon),zneb(klon)
-c
-      LOGICAL appel1er
-      SAVE appel1er
-c
-c Fonctions en ligne:
-c
-      REAL fallv ! vitesse de chute pour crystaux de glace
-      REAL zzz
-#include "YOETHF.h"
-#include "FCTTRE.h"
-      fallv (zzz) = 3.29/2.0 * ((zzz)**0.16)
-ccc      fallv (zzz) = 3.29/3.0 * ((zzz)**0.16)
-ccc      fallv (zzz) = 3.29 * ((zzz)**0.16)
-c
-      DATA appel1er /.TRUE./
-c
-      IF (appel1er) THEN
-         PRINT*, 'fisrtilp, calcrat:', calcrat
-         PRINT*, 'fisrtilp, ninter:', ninter
-         PRINT*, 'fisrtilp, evap_prec:', evap_prec
-         PRINT*, 'fisrtilp, cpartiel:', cpartiel
-         IF (ABS(dtime/FLOAT(ninter)-360.0).GT.0.001) THEN
-          PRINT*, 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime
-          PRINT*, 'Je prefere un sous-intervalle de 6 minutes'
-          CALL abort
-         ENDIF
-         appel1er = .FALSE.
-      ENDIF
-c
-c Determiner les nuages froids par leur temperature
-c
-      ztglace = RTT - 15.0
-      nexpo = 6
-ccc      nexpo = 1
-c
-c Initialiser les sorties:
-c
-      DO k = 1, klev+1
-      DO i = 1, klon
-         prfl(i,k) = 0.0
-         psfl(i,k) = 0.0
-      ENDDO
-      ENDDO
-      DO k = 1, klev
-      DO i = 1, klon
-         d_t(i,k) = 0.0
-         d_q(i,k) = 0.0
-         d_ql(i,k) = 0.0
-         rneb(i,k) = 0.0
-         radliq(i,k) = 0.0
-      ENDDO
-      ENDDO
-      DO i = 1, klon
-         rain(i) = 0.0
-         snow(i) = 0.0
-      ENDDO
-c
-c Initialiser le flux de precipitation a zero
-c
-      DO i = 1, klon
-         zrfl(i) = 0.0
-         zneb(i) = seuil_neb
-      ENDDO
-c
-c Boucle verticale (du haut vers le bas)
-c
-      DO 9999 k = klev, 1, -1
-c
-      DO i = 1, klon
-         zt(i)=t(i,k)
-         zq(i)=q(i,k)
-      ENDDO
-c
-c Calculer l'evaporation de la precipitation
-c
-      IF (evap_prec) THEN
-      DO i = 1, klon
-      IF (zrfl(i) .GT.0.) THEN
-         IF (thermcep) THEN
-           zdelta=MAX(0.,SIGN(1.,RTT-zt(i)))
-           zqs(i)= R2ES*FOEEW(zt(i),zdelta)/pplay(i,k)
-           zqs(i)=MIN(0.5,zqs(i))
-           zcor=1./(1.-RETV*zqs(i))
-           zqs(i)=zqs(i)*zcor
-         ELSE
-           IF (zt(i) .LT. t_coup) THEN
-              zqs(i) = qsats(zt(i)) / pplay(i,k)
-           ELSE
-              zqs(i) = qsatl(zt(i)) / pplay(i,k)
-           ENDIF
-         ENDIF
-         zqev = MAX (0.0, (zqs(i)-zq(i))*zneb(i) )
-         zqevt = coef_eva * (1.0-zq(i)/zqs(i)) * SQRT(zrfl(i))
-     .         * (paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
-         zqevt = MAX(0.0,MIN(zqevt,zrfl(i)))
-     .         * RG*dtime/(paprs(i,k)-paprs(i,k+1))
-         zqev = MIN (zqev, zqevt)
-         zrfln(i) = zrfl(i) - zqev*(paprs(i,k)-paprs(i,k+1))
-     .                            /RG/dtime
-         zq(i) = zq(i) - (zrfln(i)-zrfl(i))
-     .             * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
-         zt(i) = zt(i) + (zrfln(i)-zrfl(i))
-     .             * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
-     .             * RLVTT/RCPD/(1.0+RVTMP2*zq(i))
-         zrfl(i) = zrfln(i)
-      ENDIF
-      ENDDO
-      ENDIF
-c
-c Calculer Qs et L/Cp*dQs/dT:
-c
-      IF (thermcep) THEN
-         DO i = 1, klon
-           zdelta = MAX(0.,SIGN(1.,RTT-zt(i)))
-           zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
-           zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*zq(i))
-           zqs(i) = R2ES*FOEEW(zt(i),zdelta)/pplay(i,k)
-           zqs(i) = MIN(0.5,zqs(i))
-           zcor = 1./(1.-RETV*zqs(i))
-           zqs(i) = zqs(i)*zcor
-           zdqs(i) = FOEDE(zt(i),zdelta,zcvm5,zqs(i),zcor)
-         ENDDO
-      ELSE
-         DO i = 1, klon
-            IF (zt(i).LT.t_coup) THEN
-               zqs(i) = qsats(zt(i))/pplay(i,k)
-               zdqs(i) = dqsats(zt(i),zqs(i))
-            ELSE
-               zqs(i) = qsatl(zt(i))/pplay(i,k)
-               zdqs(i) = dqsatl(zt(i),zqs(i))
-            ENDIF
-         ENDDO
-      ENDIF
-c
-c Determiner la condensation partielle et calculer la quantite
-c de l'eau condensee:
-c
-      IF (cpartiel) THEN
-         DO i = 1, klon
-c
-            zx = pplay(i,k)/paprs(i,1)
-            zx = (zx_max-zx)/(zx_max-zx_min)
-            zx = MIN(MAX(zx,0.0),1.0)
-            zx = zx * zx * zx
-            ratqs = zx * (rat_max-rat_min) + rat_min
-            IF (.NOT.calcrat) ratqs=0.05
-ccc            IF (.NOT.calcrat) ratqs=0.2
-c
-            zdelq = ratqs * zq(i)
-            rneb(i,k) = (zq(i)+zdelq-zqs(i)) / (2.0*zdelq)
-            zqn(i) = (zq(i)+zdelq+zqs(i))/2.0
-            IF (rneb(i,k) .LE. 0.0) zqn(i) = 0.0
-            IF (rneb(i,k) .GE. 1.0) zqn(i) = zq(i)
-            rneb(i,k) = MAX(0.0,MIN(1.0,rneb(i,k)))
-            zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)/(1.+zdqs(i))
-         ENDDO
-      ELSE
-         DO i = 1, klon
-            IF (zq(i).GT.zqs(i)) THEN
-               rneb(i,k) = 1.0
-            ELSE
-               rneb(i,k) = 0.0
-            ENDIF
-            zcond(i) = MAX(0.0,zq(i)-zqs(i))/(1.+zdqs(i))
-         ENDDO
-      ENDIF
-c
-      DO i = 1, klon
-         zq(i) = zq(i) - zcond(i)
-         zt(i) = zt(i) + zcond(i) * RLVTT/RCPD
-      ENDDO
-c
-c Partager l'eau condensee en precipitation et eau liquide nuageuse
-c
-      DO i = 1, klon
-      IF (rneb(i,k).GT.0.0) THEN
-         zoliq(i) = zcond(i)
-         zrho(i) = pplay(i,k) / zt(i) / RD
-         zdz(i) = (paprs(i,k)-paprs(i,k+1)) / (zrho(i)*RG)
-         zfice(i) = 1.0 - (zt(i)-ztglace) / (273.13-ztglace)
-         zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
-         zfice(i) = zfice(i)**nexpo
-         zneb(i) = MAX(rneb(i,k), seuil_neb)
-         radliq(i,k) = zoliq(i)/FLOAT(ninter+1)
-      ENDIF
-      ENDDO
-c
-      DO n = 1, ninter
-      DO i = 1, klon
-      IF (rneb(i,k).GT.0.0) THEN
-         zchau(i) = ct*dtime/FLOAT(ninter) * zoliq(i)
-     .          * (1.0-EXP(-(zoliq(i)/zneb(i)/cl)**2)) *(1.-zfice(i))
-         zrhol(i) = zrho(i) * zoliq(i) / zneb(i)
-         zfroi(i) = dtime/FLOAT(ninter)/zdz(i)*zoliq(i)
-     .              *fallv(zrhol(i)) * zfice(i)
-         ztot(i) = zchau(i) + zfroi(i)
-         IF (zneb(i).EQ.seuil_neb) ztot(i) = 0.0
-         ztot(i) = MIN(MAX(ztot(i),0.0),zoliq(i))
-         zoliq(i) = MAX(zoliq(i)-ztot(i), 0.0)
-         radliq(i,k) = radliq(i,k) + zoliq(i)/FLOAT(ninter+1)
-      ENDIF
-      ENDDO
-      ENDDO
-c
-      DO i = 1, klon
-      IF (rneb(i,k).GT.0.0) THEN
-         d_ql(i,k) = zoliq(i)
-         zrfl(i) = zrfl(i)+ MAX(zcond(i)-zoliq(i),0.0)
-     .                    * (paprs(i,k)-paprs(i,k+1))/(RG*dtime)
-      ENDIF
-      IF (zt(i).LT.RTT) THEN
-        psfl(i,k)=zrfl(i)
-      ELSE
-        prfl(i,k)=zrfl(i)
-      ENDIF
-      ENDDO
-c
-c Calculer les tendances de q et de t:
-c
-      DO i = 1, klon
-         d_q(i,k) = zq(i) - q(i,k)
-         d_t(i,k) = zt(i) - t(i,k)
-      ENDDO
-c
- 9999 CONTINUE
-c
-c Pluie ou neige au sol selon la temperature de la 1ere couche
-c
-      DO i = 1, klon
-      IF ((t(i,1)+d_t(i,1)) .LT. RTT) THEN
-         snow(i) = zrfl(i)
-      ELSE
-         rain(i) = zrfl(i)
-      ENDIF
-      ENDDO
-c
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/fisrtilp.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/fisrtilp.h	(revision 416)
+++ 	(revision )
@@ -1,18 +1,0 @@
-      REAL cld_lc_lsc,cld_lc_con
-      REAL cld_tau_lsc,cld_tau_con
-      REAL ffallv_lsc,ffallv_con
-      REAL coef_eva
-      LOGICAL reevap_ice
-      INTEGER iflag_pdf
-
-      common/comfisrtilp/
-     s     cld_lc_lsc     ! 2.6e-4
-     s     ,cld_lc_con    ! 2.6e-4
-     s     ,cld_tau_lsc   ! 3600.
-     s     ,cld_tau_con   ! 3600.
-     s     ,ffallv_lsc    ! 1.
-     s     ,ffallv_con    ! 1.
-     s     ,coef_eva      ! 2.e-5
-     s     ,reevap_ice    ! F
-     s     ,iflag_pdf     ! 0
-
Index: LMDZ.3.3/branches/rel-/libf/phylmd/fisrtilp.inc
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/fisrtilp.inc	(revision 416)
+++ 	(revision )
@@ -1,18 +1,0 @@
-      REAL cld_lc_lsc,cld_lc_con
-      REAL cld_tau_lsc,cld_tau_con
-      REAL ffallv_lsc,ffallv_con
-      REAL coef_eva
-      LOGICAL reevap_ice
-      INTEGER iflag_pdf
-
-      common/comfisrtilp/ &
-     &     cld_lc_lsc     &
-     &     ,cld_lc_con   &
-     &     ,cld_tau_lsc &
-     &     ,cld_tau_con &
-     &     ,ffallv_lsc &
-     &     ,ffallv_con &
-     &     ,coef_eva  &
-     &     ,reevap_ice  &
-     &     ,iflag_pdf  
-
Index: LMDZ.3.3/branches/rel-/libf/phylmd/fisrtilp_tr.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/fisrtilp_tr.F	(revision 416)
+++ 	(revision )
@@ -1,424 +1,0 @@
-c $Header$
-c
-      SUBROUTINE fisrtilp_tr(dtime,paprs,pplay,t,q,ratqs,
-     s                   d_t, d_q, d_ql, rneb, radliq, rain, snow,
-     s                   pfrac_impa, pfrac_nucl, pfrac_1nucl,
-     s                   frac_impa, frac_nucl,
-     s                   prfl, psfl, rhcl)
-
-c
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS)
-c Date: le 20 mars 1995
-c Objet: condensation et precipitation stratiforme.
-c        schema de nuage
-c======================================================================
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "tracstoke.h"
-c
-c Arguments:
-c
-      REAL dtime ! intervalle du temps (s)
-      REAL paprs(klon,klev+1) ! pression a inter-couche
-      REAL pplay(klon,klev) ! pression au milieu de couche
-      REAL t(klon,klev) ! temperature (K)
-      REAL q(klon,klev) ! humidite specifique (kg/kg)
-      REAL d_t(klon,klev) ! incrementation de la temperature (K)
-      REAL d_q(klon,klev) ! incrementation de la vapeur d'eau
-      REAL d_ql(klon,klev) ! incrementation de l'eau liquide
-      REAL rneb(klon,klev) ! fraction nuageuse
-      REAL radliq(klon,klev) ! eau liquide utilisee dans rayonnements
-      REAL rhcl(klon,klev) ! humidite relative en ciel clair
-      REAL rain(klon) ! pluies (mm/s)
-      REAL snow(klon) ! neige (mm/s)
-      REAL prfl(klon,klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s)
-      REAL psfl(klon,klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s)
-cAA
-c Coeffients de fraction lessivee : pour OFF-LINE
-c
-      REAL pfrac_nucl(klon,klev)
-      REAL pfrac_1nucl(klon,klev)
-      REAL pfrac_impa(klon,klev)
-c
-c Fraction d'aerosols lessivee par impaction et par nucleation
-c POur ON-LINE
-c
-      REAL frac_impa(klon,klev)
-      REAL frac_nucl(klon,klev)
-cAA
-c
-c Options du programme:
-c
-      REAL seuil_neb ! un nuage existe vraiment au-dela
-      PARAMETER (seuil_neb=0.001)
-      REAL ct ! inverse du temps pour qu'un nuage precipite
-      PARAMETER (ct=1./1800.)
-      REAL cl ! seuil de precipitation
-      PARAMETER (cl=2.6e-4)
-ccc      PARAMETER (cl=2.3e-4)
-ccc      PARAMETER (cl=2.0e-4)
-      INTEGER ninter ! sous-intervals pour la precipitation
-      PARAMETER (ninter=5)
-      LOGICAL evap_prec ! evaporation de la pluie
-      PARAMETER (evap_prec=.TRUE.)
-      REAL coef_eva
-      PARAMETER (coef_eva=2.0E-05)
-      LOGICAL calcrat ! calculer ratqs au lieu de fixer sa valeur
-      REAL ratqs(klon,klev) ! determine la largeur de distribution de vapeur
-      PARAMETER (calcrat=.TRUE.)
-      REAL zx_min, rat_max
-      PARAMETER (zx_min=1.0, rat_max=0.01)
-      REAL zx_max, rat_min
-      PARAMETER (zx_max=0.1, rat_min=0.3)
-      REAL zx
-c
-      LOGICAL cpartiel ! condensation partielle
-      PARAMETER (cpartiel=.TRUE.)
-      REAL t_coup
-      PARAMETER (t_coup=234.0)
-c
-c Variables locales:
-c
-      INTEGER i, k, n, kk
-      REAL zqs(klon), zdqs(klon), zdelta, zcor, zcvm5
-      REAL zrfl(klon), zrfln(klon), zqev, zqevt
-      REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon), zdelq
-      REAL ztglace, zt(klon)
-      INTEGER nexpo ! exponentiel pour glace/eau
-      REAL zdz(klon),zrho(klon),ztot(klon), zrhol(klon)
-      REAL zchau(klon),zfroi(klon),zfice(klon),zneb(klon)
-c
-      LOGICAL appel1er
-      SAVE appel1er
-c
-c---------------------------------------------------------------
-c
-cAA Variables traceurs:
-cAA  Provisoire !!! Parametres alpha du lessivage
-cAA  A priori on a 4 scavenging # possibles
-c
-      REAL a_tr_sca(4)
-      save a_tr_sca
-c
-c Variables intermediaires
-c
-      REAL zalpha_tr
-      REAL zfrac_lessi
-      REAL zprec_cond(klon)
-cAA
-c---------------------------------------------------------------
-c
-c Fonctions en ligne:
-c
-      REAL fallv ! vitesse de chute pour crystaux de glace
-      REAL zzz
-#include "YOETHF.h"
-#include "FCTTRE.h"
-      fallv (zzz) = 3.29/2.0 * ((zzz)**0.16)
-ccc      fallv (zzz) = 3.29/3.0 * ((zzz)**0.16)
-ccc      fallv (zzz) = 3.29 * ((zzz)**0.16)
-c
-      DATA appel1er /.TRUE./
-c
-      IF (appel1er) THEN
-c
-         PRINT*, 'fisrtilp, calcrat:', calcrat
-         PRINT*, 'fisrtilp, ninter:', ninter
-         PRINT*, 'fisrtilp, evap_prec:', evap_prec
-         PRINT*, 'fisrtilp, cpartiel:', cpartiel
-         IF (ABS(dtime/FLOAT(ninter)-360.0).GT.0.001) THEN
-          PRINT*, 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime
-          PRINT*, 'Je prefere un sous-intervalle de 6 minutes'
-          CALL abort
-         ENDIF
-         appel1er = .FALSE.
-c
-cAA initialiation provisoire
-       a_tr_sca(1) = -0.5
-       a_tr_sca(2) = -0.5
-       a_tr_sca(3) = -0.5
-       a_tr_sca(4) = -0.5
-c
-cAA Initialisation a 1 des coefs des fractions lessivees 
-c
-      DO k = 1, klev
-       DO i = 1, klon
-          pfrac_nucl(i,k)=1.
-          pfrac_1nucl(i,k)=1.
-          pfrac_impa(i,k)=1.
-       ENDDO 
-      ENDDO 
-
-      ENDIF          !  test sur appel1er
-c
-cMAf Initialisation a 0 de zoliq
-       DO i = 1, klon
-          zoliq(i)=0.
-       ENDDO 
-c Determiner les nuages froids par leur temperature
-c
-      ztglace = RTT - 15.0
-      nexpo = 6
-ccc      nexpo = 1
-c
-c Initialiser les sorties:
-c
-      DO k = 1, klev+1
-      DO i = 1, klon
-         prfl(i,k) = 0.0
-         psfl(i,k) = 0.0
-      ENDDO
-      ENDDO
-
-      DO k = 1, klev
-      DO i = 1, klon
-         d_t(i,k) = 0.0
-         d_q(i,k) = 0.0
-         d_ql(i,k) = 0.0
-         rneb(i,k) = 0.0
-         radliq(i,k) = 0.0
-         frac_nucl(i,k) = 1. 
-         frac_impa(i,k) = 1. 
-      ENDDO
-      ENDDO
-      DO i = 1, klon
-         rain(i) = 0.0
-         snow(i) = 0.0
-      ENDDO
-c
-c Initialiser le flux de precipitation a zero
-c
-      DO i = 1, klon
-         zrfl(i) = 0.0
-         zneb(i) = seuil_neb
-      ENDDO
-c
-c
-cAA Pour plus de securite 
-
-      zalpha_tr   = 0.
-      zfrac_lessi = 0.
-
-cAA----------------------------------------------------------
-c
-c Boucle verticale (du haut vers le bas)
-c
-      DO 9999 k = klev, 1, -1
-c
-cAA----------------------------------------------------------
-c
-      DO i = 1, klon
-         zt(i)=t(i,k)
-         zq(i)=q(i,k)
-      ENDDO
-c
-c Calculer l'evaporation de la precipitation
-c
-      IF (evap_prec) THEN
-      DO i = 1, klon
-      IF (zrfl(i) .GT.0.) THEN
-         IF (thermcep) THEN
-           zdelta=MAX(0.,SIGN(1.,RTT-zt(i)))
-           zqs(i)= R2ES*FOEEW(zt(i),zdelta)/pplay(i,k)
-           zqs(i)=MIN(0.5,zqs(i))
-           zcor=1./(1.-RETV*zqs(i))
-           zqs(i)=zqs(i)*zcor
-         ELSE
-           IF (zt(i) .LT. t_coup) THEN
-              zqs(i) = qsats(zt(i)) / pplay(i,k)
-           ELSE
-              zqs(i) = qsatl(zt(i)) / pplay(i,k)
-           ENDIF
-         ENDIF
-         zqev = MAX (0.0, (zqs(i)-zq(i))*zneb(i) )
-         zqevt = coef_eva * (1.0-zq(i)/zqs(i)) * SQRT(zrfl(i))
-     .         * (paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
-         zqevt = MAX(0.0,MIN(zqevt,zrfl(i)))
-     .         * RG*dtime/(paprs(i,k)-paprs(i,k+1))
-         zqev = MIN (zqev, zqevt)
-         zrfln(i) = zrfl(i) - zqev*(paprs(i,k)-paprs(i,k+1))
-     .                            /RG/dtime
-         zq(i) = zq(i) - (zrfln(i)-zrfl(i))
-     .             * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
-         zt(i) = zt(i) + (zrfln(i)-zrfl(i))
-     .             * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
-     .             * RLVTT/RCPD/(1.0+RVTMP2*zq(i))
-         zrfl(i) = zrfln(i)
-      ENDIF
-      ENDDO
-      ENDIF
-c
-c Calculer Qs et L/Cp*dQs/dT:
-c
-      IF (thermcep) THEN
-         DO i = 1, klon
-           zdelta = MAX(0.,SIGN(1.,RTT-zt(i)))
-           zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
-           zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*zq(i))
-           zqs(i) = R2ES*FOEEW(zt(i),zdelta)/pplay(i,k)
-           zqs(i) = MIN(0.5,zqs(i))
-           zcor = 1./(1.-RETV*zqs(i))
-           zqs(i) = zqs(i)*zcor
-           zdqs(i) = FOEDE(zt(i),zdelta,zcvm5,zqs(i),zcor)
-         ENDDO
-      ELSE
-         DO i = 1, klon
-            IF (zt(i).LT.t_coup) THEN
-               zqs(i) = qsats(zt(i))/pplay(i,k)
-               zdqs(i) = dqsats(zt(i),zqs(i))
-            ELSE
-               zqs(i) = qsatl(zt(i))/pplay(i,k)
-               zdqs(i) = dqsatl(zt(i),zqs(i))
-            ENDIF
-         ENDDO
-      ENDIF
-c
-c Determiner la condensation partielle et calculer la quantite
-c de l'eau condensee:
-c
-      IF (cpartiel) THEN
-         DO i = 1, klon
-c
-            zdelq = ratqs(i,k) * zq(i)
-            rneb(i,k) = (zq(i)+zdelq-zqs(i)) / (2.0*zdelq)
-            zqn(i) = (zq(i)+zdelq+zqs(i))/2.0
-            IF (rneb(i,k) .LE. 0.0) zqn(i) = 0.0
-            IF (rneb(i,k) .GE. 1.0) zqn(i) = zq(i)
-            rneb(i,k) = MAX(0.0,MIN(1.0,rneb(i,k)))
-            zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)/(1.+zdqs(i))
-c--Olivier
-            rhcl(i,k)=(zqs(i)+zq(i)-zdelq)/2./zqs(i)
-            IF (rneb(i,k) .LE. 0.0) rhcl(i,k)=zq(i)/zqs(i)
-            IF (rneb(i,k) .GE. 1.0) rhcl(i,k)=1.0
-c--fin
-         ENDDO
-      ELSE
-         DO i = 1, klon
-            IF (zq(i).GT.zqs(i)) THEN
-               rneb(i,k) = 1.0
-            ELSE
-               rneb(i,k) = 0.0
-            ENDIF
-            zcond(i) = MAX(0.0,zq(i)-zqs(i))/(1.+zdqs(i))
-         ENDDO
-      ENDIF
-c
-      DO i = 1, klon
-         zq(i) = zq(i) - zcond(i)
-         zt(i) = zt(i) + zcond(i) * RLVTT/RCPD
-      ENDDO
-c
-c Partager l'eau condensee en precipitation et eau liquide nuageuse
-c
-      DO i = 1, klon
-      IF (rneb(i,k).GT.0.0) THEN
-         zoliq(i) = zcond(i)
-         zrho(i) = pplay(i,k) / zt(i) / RD
-         zdz(i) = (paprs(i,k)-paprs(i,k+1)) / (zrho(i)*RG)
-         zfice(i) = 1.0 - (zt(i)-ztglace) / (273.13-ztglace)
-         zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
-         zfice(i) = zfice(i)**nexpo
-         zneb(i) = MAX(rneb(i,k), seuil_neb)
-         radliq(i,k) = zoliq(i)/FLOAT(ninter+1)
-      ENDIF
-      ENDDO
-c
-      DO n = 1, ninter
-      DO i = 1, klon
-      IF (rneb(i,k).GT.0.0) THEN
-         zchau(i) = ct*dtime/FLOAT(ninter) * zoliq(i)
-     .          * (1.0-EXP(-(zoliq(i)/zneb(i)/cl)**2)) *(1.-zfice(i))
-         zrhol(i) = zrho(i) * zoliq(i) / zneb(i)
-         zfroi(i) = dtime/FLOAT(ninter)/zdz(i)*zoliq(i)
-     .              *fallv(zrhol(i)) * zfice(i)
-         ztot(i) = zchau(i) + zfroi(i)
-         IF (zneb(i).EQ.seuil_neb) ztot(i) = 0.0
-         ztot(i) = MIN(MAX(ztot(i),0.0),zoliq(i))
-         zoliq(i) = MAX(zoliq(i)-ztot(i), 0.0)
-         radliq(i,k) = radliq(i,k) + zoliq(i)/FLOAT(ninter+1)
-      ENDIF
-      ENDDO
-      ENDDO
-c
-      DO i = 1, klon
-      IF (rneb(i,k).GT.0.0) THEN
-         d_ql(i,k) = zoliq(i)
-         zrfl(i) = zrfl(i)+ MAX(zcond(i)-zoliq(i),0.0)
-     .                    * (paprs(i,k)-paprs(i,k+1))/(RG*dtime)
-      ENDIF
-      IF (zt(i).LT.RTT) THEN
-        psfl(i,k)=zrfl(i)
-      ELSE
-        prfl(i,k)=zrfl(i)
-      ENDIF
-      ENDDO
-c
-c Calculer les tendances de q et de t:
-c
-      DO i = 1, klon
-         d_q(i,k) = zq(i) - q(i,k)
-         d_t(i,k) = zt(i) - t(i,k)
-      ENDDO
-c
-cAA--------------- Calcul du lessivage stratiforme  -------------
-
-      DO i = 1,klon
-c
-         zprec_cond(i) = MAX(zcond(i)-zoliq(i),0.0)
-     .                * (paprs(i,k)-paprs(i,k+1))/RG
-         IF (rneb(i,k).GT.0.0.and.zprec_cond(i).gt.0.) THEN
-cAA lessivage nucleation LMD5 dans la couche elle-meme
-            if (t(i,k) .GE. ztglace) THEN
-               zalpha_tr = a_tr_sca(3)
-            else
-               zalpha_tr = a_tr_sca(4)
-            endif
-            zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
-            pfrac_nucl(i,k)=pfrac_nucl(i,k)*(1.-zneb(i)*zfrac_lessi)
-            frac_nucl(i,k)= 1.-zneb(i)*zfrac_lessi 
-c
-c nucleation avec un facteur -1 au lieu de -0.5
-            zfrac_lessi = 1. - EXP(-zprec_cond(i)/zneb(i))
-            pfrac_1nucl(i,k)=pfrac_1nucl(i,k)*(1.-zneb(i)*zfrac_lessi)
-         ENDIF
-c
-      ENDDO      ! boucle sur i
-c
-cAA Lessivage par impaction dans les couches en-dessous
-      DO kk = k-1, 1, -1
-        DO i = 1, klon
-          IF (rneb(i,k).GT.0.0.and.zprec_cond(i).gt.0.) THEN
-            if (t(i,kk) .GE. ztglace) THEN
-              zalpha_tr = a_tr_sca(1)
-            else
-              zalpha_tr = a_tr_sca(2)
-            endif
-            zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
-            pfrac_impa(i,kk)=pfrac_impa(i,kk)*(1.-zneb(i)*zfrac_lessi)
-            frac_impa(i,kk)= 1.-zneb(i)*zfrac_lessi
-          ENDIF
-        ENDDO
-      ENDDO
-c
-cAA----------------------------------------------------------
-c                     FIN DE BOUCLE SUR K   
- 9999 CONTINUE
-c
-cAA-----------------------------------------------------------
-c
-c Pluie ou neige au sol selon la temperature de la 1ere couche
-c
-      DO i = 1, klon
-      IF ((t(i,1)+d_t(i,1)) .LT. RTT) THEN
-         snow(i) = zrfl(i)
-      ELSE
-         rain(i) = zrfl(i)
-      ENDIF
-      ENDDO
-c
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/flxtr.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/flxtr.F	(revision 416)
+++ 	(revision )
@@ -1,203 +1,0 @@
-      SUBROUTINE flxtr(pdtime,pmfu,pmfd,pen_u,pde_u,pen_d,pde_d,
-     .                 pt,pplay,paprs,kcbot,kctop,kdtop,x,dx) 
-      IMPLICIT NONE 
-c=====================================================================
-c Objet : Melange convectif de traceurs a partir des flux de masse 
-c Date : 13/12/1996 -- 13/01/97
-c Auteur: O. Boucher (LOA) sur inspiration de Z. X. Li (LMD),
-c         Brinkop et Sausen (1996) et Boucher et al. (1996).
-c ATTENTION : meme si cette routine se veut la plus generale possible, 
-c             elle a herite de certaines notations et conventions du 
-c             schema de Tiedtke (1993). 
-c --En particulier, les couches sont numerotees de haut en bas !!!
-c   Ceci est valable pour les flux, kcbot, kctop et kdtop
-c   mais pas pour les entrees x, pplay, paprs !!!!
-c --Un schema amont est choisi pour calculer les flux pour s'assurer 
-c   de la positivite des valeurs de traceurs, cela implique des eqs 
-c   differentes pour les flux de traceurs montants et descendants.
-c --pmfu est positif, pmfd est negatif 
-c --Tous les flux d'entrainements et de detrainements sont positifs 
-c   contrairement au schema de Tiedtke d'ou les changements de signe!!!! 
-c=====================================================================
-c
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "YOECUMF.h" 
-c
-      REAL pdtime
-c--les flux sont definis au 1/2 niveaux
-c--pmfu(klev+1) et pmfd(klev+1) sont implicitement nuls
-      REAL pmfu(klon,klev)  ! flux de masse dans le panache montant 
-      REAL pmfd(klon,klev)  ! flux de masse dans le panache descendant
-      REAL pen_u(klon,klev) ! flux entraine dans le panache montant
-      REAL pde_u(klon,klev) ! flux detraine dans le panache montant
-      REAL pen_d(klon,klev) ! flux entraine dans le panache descendant
-      REAL pde_d(klon,klev) ! flux detraine dans le panache descendant
-c--idem mais en variables locales
-      REAL zpen_u(klon,klev) 
-      REAL zpde_u(klon,klev)
-      REAL zpen_d(klon,klev) 
-      REAL zpde_d(klon,klev)
-c
-      REAL pplay(klon,klev)    ! pression aux couches (bas en haut)
-      REAL pap(klon,klev)      ! pression aux couches (haut en bas)
-      REAL pt(klon,klev)       ! temperature aux couches (bas en haut) 
-      REAL zt(klon,klev)       ! temperature aux couches (haut en bas)
-      REAL paprs(klon,klev+1)  ! pression aux 1/2 couches (bas en haut)
-      REAL paph(klon,klev+1)   ! pression aux 1/2 couches (haut en bas)
-      INTEGER kcbot(klon)      ! niveau de base de la convection
-      INTEGER kctop(klon)      ! niveau du sommet de la convection +1 
-      INTEGER kdtop(klon)      ! niveau de sommet du panache descendant
-      REAL x(klon,klev)        ! q de traceur (bas en haut) 
-      REAL zx(klon,klev)       ! q de traceur (haut en bas)
-      REAL dx(klon,klev)     ! tendance de traceur  (bas en haut)
-c
-c--variables locales      
-c--les flux de x sont definis aux 1/2 niveaux 
-c--xu et xd sont definis aux niveaux complets
-      REAL xu(klon,klev)        ! q de traceurs dans le panache montant
-      REAL xd(klon,klev)        ! q de traceurs dans le panache descendant
-      REAL xe(klon,klev)        ! q de traceurs dans l'environnement 
-      REAL zmfux(klon,klev+1)   ! flux de x dans le panache montant
-      REAL zmfdx(klon,klev+1)   ! flux de x dans le panache descendant
-      REAL zmfex(klon,klev+1)   ! flux de x dans l'environnement 
-      INTEGER i, k 
-      REAL zmfmin
-      PARAMETER (zmfmin=1.E-10)
-c
-c On remet les taux d'entrainement et de detrainement dans le panache
-c descendant a des valeurs positives. 
-c On ajuste les valeurs de pen_u, pen_d pde_u et pde_d pour que la 
-c conservation de la masse soit realisee a chaque niveau dans les 2 
-c panaches.
-      DO k=1, klev
-      DO i=1, klon
-        zpen_u(i,k)= pen_u(i,k)
-        zpde_u(i,k)= pde_u(i,k)
-      ENDDO 
-      ENDDO
-c
-      DO k=1, klev-1
-      DO i=1, klon
-        zpen_d(i,k)=-pen_d(i,k+1)
-        zpde_d(i,k)=-pde_d(i,k+1)
-      ENDDO 
-      ENDDO
-c
-      DO i=1, klon 
-      zpen_d(i,klev)       = 0.0
-      zpde_d(i,klev)       = -pmfd(i,klev)
-c   Correction 03 11 97
-c     zpen_d(i,kdtop(i)-1) = pmfd(i,kdtop(i)-1)-pmfd(i,kdtop(i))
-      IF (kdtop(i).EQ.klev+1) THEN
-      zpen_d(i,kdtop(i)-1) = pmfd(i,kdtop(i)-1)
-      ELSE
-      zpen_d(i,kdtop(i)-1) = pmfd(i,kdtop(i)-1)-pmfd(i,kdtop(i))
-      ENDIF
-
-      zpde_u(i,kctop(i)-2) = pmfu(i,kctop(i)-1)
-      zpen_u(i,klev)       = pmfu(i,klev) 
-      ENDDO
-c
-      DO i=1, klon
-      DO k=kcbot(i), klev-1
-      zpen_u(i,k) = pmfu(i,k) - pmfu(i,k+1)
-      ENDDO 
-      ENDDO 
-c
-c conversion des sens de notations bas-haut et haut-bas
-c
-      DO k=1, klev+1 
-      DO i=1, klon 
-        paph(i,klev+2-k)=paprs(i,k)
-      ENDDO 
-      ENDDO
-c
-      DO i=1, klon
-      DO k=1, klev 
-        pap(i,klev+1-k)=pplay(i,k)
-        zt(i,klev+1-k) =pt(i,k)
-        zx(i,klev+1-k) =x(i,k) 
-      ENDDO 
-      ENDDO
-c
-c--initialisations des flux de traceurs aux extremites de la colonne
-c
-      DO i=1, klon 
-        zmfux(i,klev+1) = 0.0 
-        zmfdx(i,1) = 0.0 
-        zmfex(i,1) = 0.0 
-      ENDDO
-c
-c--calcul des flux dans le panache montant
-c
-      DO k=klev, 1, -1
-      DO i=1, klon
-       IF (k.GE.kcbot(i)) THEN 
-         xu(i,k)=zx(i,k)
-         zmfux(i,k)=pmfu(i,k)*xu(i,k)
-       ELSE 
-         zmfux(i,k)= (zmfux(i,k+1) + zpen_u(i,k)*zx(i,k) ) / 
-     .               (1.+zpde_u(i,k)/MAX(zmfmin,pmfu(i,k)))
-         xu(i,k)=zmfux(i,k)/MAX(zmfmin,pmfu(i,k))
-       ENDIF
-      ENDDO
-      ENDDO
-c
-c--calcul des flux dans le panache descendant
-c
-      DO k=1, klev-1
-      DO i=1, klon
-       IF (k.LE.kdtop(i)-1) THEN
-         xd(i,k)=( zx(i,k)+xu(i,k) ) / 2. 
-         zmfdx(i,k+1)=pmfd(i,k+1)*xd(i,k)
-       ELSE
-         zmfdx(i,k+1)= (zmfdx(i,k) - zpen_d(i,k)*zx(i,k) ) /
-     .               (1.-zpde_d(i,k)/MIN(-zmfmin,pmfd(i,k+1)))
-         xd(i,k)=zmfdx(i,k+1)/MIN(-zmfmin,pmfd(i,k+1))
-       ENDIF
-      ENDDO
-      ENDDO
-      DO i=1, klon 
-         zmfdx(i,klev+1) = 0.0 
-         xd(i,klev) = (zpen_d(i,klev)*zx(i,klev) - zmfdx(i,klev)) / 
-     .                   MAX(zmfmin,zpde_d(i,klev)) 
-      ENDDO 
-c
-c--introduction du flux de retour dans l'environnement
-c
-      DO k=1, klev-1
-      DO i=1, klon
-       IF (k.LE.kctop(i)-3) THEN 
-         xe(i,k)= zx(i,k) 
-         zmfex(i,k+1)=-(pmfu(i,k+1)+pmfd(i,k+1))*xe(i,k)
-       ELSE 
-         zmfex(i,k+1)= (zmfex(i,k) - 
-     .      (zpde_u(i,k)*xu(i,k)+zpde_d(i,k)*xd(i,k))) /
-     .      (1.-(zpen_d(i,k)+zpen_u(i,k))/
-     .      MIN(-zmfmin,-pmfu(i,k+1)-pmfd(i,k+1)) )
-         xe(i,k)=zmfex(i,k+1)/MIN(-zmfmin,-pmfu(i,k+1)-pmfd(i,k+1))
-       ENDIF
-      ENDDO
-      ENDDO
-      DO i=1, klon 
-         zmfex(i,klev+1) = 0.0
-         xe(i,klev) = (zpde_u(i,klev)*xu(i,klev) + 
-     .                 zpde_d(i,klev)*xd(i,klev) -zmfex(i,klev)) /
-     .                 MAX(zmfmin,zpen_u(i,klev)+zpen_d(i,klev)) 
-      ENDDO
-c
-c--calcul final des tendances
-c
-      DO k=1 , klev
-      DO i=1, klon
-        dx(i,klev+1-k) = RG/(paph(i,k+1)-paph(i,k))*pdtime*
-     .                      ( zmfux(i,k+1) - zmfux(i,k) +
-     .                        zmfdx(i,k+1) - zmfdx(i,k) +
-     .                        zmfex(i,k+1) - zmfex(i,k) )
-      ENDDO
-      ENDDO
-c
-      RETURN 
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/hgardfou.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/hgardfou.F	(revision 416)
+++ 	(revision )
@@ -1,113 +1,0 @@
-      SUBROUTINE hgardfou (t,tsol,text)
-      IMPLICIT none
-c======================================================================
-c Verifier la temperature
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "indicesol.h"
-      REAL t(klon,klev), tsol(klon,nbsrf)
-      CHARACTER*(*) text
-C
-      INTEGER i, k, nsrf
-      REAL zt(klon)
-      INTEGER jadrs(klon), jbad
-      LOGICAL ok
-c
-      LOGICAL firstcall
-      SAVE firstcall
-      DATA firstcall /.TRUE./
-      IF (firstcall) THEN
-         PRINT*, 'hgardfou garantit la temperature dans [100,370] K'
-         firstcall = .FALSE.
-      ENDIF
-c
-      ok = .TRUE.
-      DO k = 1, klev
-         DO i = 1, klon
-            zt(i) = t(i,k)
-         ENDDO
-#ifdef CRAY
-         CALL WHENFGT(klon, zt, 1, 370.0, jadrs, jbad)
-#else
-         jbad = 0
-         DO i = 1, klon
-         IF (zt(i).GT.370.0) THEN
-            jbad = jbad + 1
-            jadrs(jbad) = i
-         ENDIF
-         ENDDO
-#endif
-         IF (jbad .GT. 0) THEN
-           ok = .FALSE.
-           DO i = 1, jbad
-             PRINT *,'i,k,temperature =',jadrs(i),k,zt(jadrs(i))
-           ENDDO
-         ENDIF
-#ifdef CRAY
-         CALL WHENFLT(klon, zt, 1, 100.0, jadrs, jbad)
-#else
-         jbad = 0
-         DO i = 1, klon
-         IF (zt(i).LT.100.0) THEN
-            jbad = jbad + 1
-            jadrs(jbad) = i
-         ENDIF
-         ENDDO
-#endif
-         IF (jbad .GT. 0) THEN
-           ok = .FALSE.
-           DO i = 1, jbad
-             PRINT *,'i,k,temperature =',jadrs(i),k,zt(jadrs(i))
-           ENDDO
-         ENDIF
-      ENDDO
-c
-      DO nsrf = 1, nbsrf
-         DO i = 1, klon
-            zt(i) = tsol(i,nsrf)
-         ENDDO
-#ifdef CRAY
-         CALL WHENFGT(klon, zt, 1, 370.0, jadrs, jbad)
-#else
-         jbad = 0
-         DO i = 1, klon
-         IF (zt(i).GT.370.0) THEN
-            jbad = jbad + 1
-            jadrs(jbad) = i
-         ENDIF
-         ENDDO
-#endif
-         IF (jbad .GT. 0) THEN
-           ok = .FALSE.
-           DO i = 1, jbad
-             PRINT *,'i,nsrf,temperature =',jadrs(i),nsrf,zt(jadrs(i))
-           ENDDO
-         ENDIF
-#ifdef CRAY
-         CALL WHENFLT(klon, zt, 1, 100.0, jadrs, jbad)
-#else
-         jbad = 0
-         DO i = 1, klon
-         IF (zt(i).LT.100.0) THEN
-            jbad = jbad + 1
-            jadrs(jbad) = i
-         ENDIF
-         ENDDO
-#endif
-         IF (jbad .GT. 0) THEN
-           ok = .FALSE.
-           DO i = 1, jbad
-             PRINT *,'i,nsrf,temperature =',jadrs(i),nsrf,zt(jadrs(i))
-           ENDDO
-         ENDIF
-      ENDDO
-c
-      IF (.NOT. ok) THEN
-         PRINT*, 'hgardfou s arrete ', text
-         CALL abort
-      ENDIF
-
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/homogene.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/homogene.F	(revision 416)
+++ 	(revision )
@@ -1,96 +1,0 @@
-      SUBROUTINE homogene(paprs, q, dq, u,v, du, dv)
-      IMPLICIT NONE
-c==============================================================
-c Schema ad hoc du melange vertical pour les vitesses u et v,
-c a appliquer apres le schema de convection (fiajc et fiajh).
-c
-c paprs:input, pression demi-couche (inter-couche)
-c q:    input, vapeur d'eau (kg/kg)
-c dq:   input, incrementation de vapeur d'eau (de la convection)
-c u:    input, vitesse u
-c v:    input, vitesse v
-c
-c du:   output, incrementation pour u
-c dv:   output, incrementation pour v
-c==============================================================
-#include "dimensions.h"
-#include "dimphy.h"
-c
-      REAL paprs(klon,klev+1)
-      REAL q(klon,klev), dq(klon,klev)
-      REAL u(klon,klev), du(klon,klev)
-      REAL v(klon,klev), dv(klon,klev)
-c
-      REAL zm_dq(klon) ! quantite totale de l'eau deplacee
-      REAL zm_q(klon)  ! quantite totale de la vapeur d'eau
-      REAL zm_u(klon)  ! moyenne de u (brassage parfait et total)
-      REAL zm_v(klon)  ! moyenne de v (brassage parfait et total)
-      REAL z_frac(klon) ! fraction du brassage parfait et total
-      REAL zm_dp(klon)
-c
-      REAL zx
-      INTEGER i, k
-      REAL frac_max
-      PARAMETER (frac_max=0.1)
-      REAL seuil
-      PARAMETER (seuil=1.0e-10)
-      LOGICAL faisrien
-      PARAMETER (faisrien=.true.)
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         du(i,k) = 0.0
-         dv(i,k) = 0.0
-      ENDDO
-      ENDDO
-c
-      IF (faisrien) RETURN
-c
-      DO i = 1, klon
-         zm_dq(i)=0.
-         zm_q(i) =0.
-         zm_u(i)=0.
-         zm_v(i)=0.
-         zm_dp(i)=0.
-      ENDDO
-      DO k = 1, klev
-      DO i = 1, klon
-      IF (ABS(dq(i,k)).GT.seuil) THEN
-         zx = paprs(i,k) - paprs(i,k+1)
-         zm_dq(i) = zm_dq(i) + ABS(dq(i,k))*zx
-         zm_q(i) = zm_q(i) + q(i,k)*zx
-         zm_dp(i) = zm_dp(i) + zx
-         zm_u(i) = zm_u(i) + u(i,k)*zx
-         zm_v(i) = zm_v(i) + v(i,k)*zx
-      ENDIF
-      ENDDO
-      ENDDO
-c
-c Hypothese principale: apres la convection, la vitesse de chaque
-c couche est composee de deux parties: celle (1-z_frac) de la vitesse 
-c original et celle (z_frac) de la vitesse moyenne qui serait la
-c vitesse de chaque couche si le brassage etait parfait et total.
-c La fraction du brassage est calculee par le rapport entre la quantite
-c totale de la vapeur d'eau deplacee (ou condensee) et la quantite
-c totale de la vapeur d'eau. Et cette fraction est limitee a frac_max 
-c (Est-ce vraiment raisonnable ? Z.X. Li, le 07-09-1995).
-c
-      DO i = 1, klon
-      IF (zm_dp(i).GE.1.0E-15 .AND. zm_q(i).GE.1.0E-15) THEN
-         z_frac(i)=MIN(frac_max,zm_dq(i)/zm_q(i))
-         zm_u(i)=zm_u(i)/zm_dp(i)
-         zm_v(i)=zm_v(i)/zm_dp(i)
-      ENDIF
-      ENDDO
-      DO k = 1, klev
-      DO i = 1, klon
-      IF (zm_dp(i).GE.1.e-15 .AND. zm_q(i).GE.1.e-15
-     .                         .AND. ABS(dq(i,k)).GT.seuil) THEN
-         du(i,k) = u(i,k)*(1.-z_frac(i)) + zm_u(i)*z_frac(i) - u(i,k)
-         dv(i,k) = v(i,k)*(1.-z_frac(i)) + zm_v(i)*z_frac(i) - v(i,k)
-      ENDIF
-      ENDDO
-      ENDDO
-c
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/hydrol.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/hydrol.F	(revision 416)
+++ 	(revision )
@@ -1,111 +1,0 @@
-      SUBROUTINE hydrol(dtime,pctsrf,rain_fall,snow_fall,evap,
-     .                  agesno, tsol,qsol,snow,runoff)
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS)
-c date: 19940414
-c======================================================================
-c
-c Traitement de l'hydrologie du sol
-c ---------------------------------
-c rain_fall: taux de pluie
-c snow_fall: taux de neige
-c agesno: age de la neige
-c evap: taux d'evaporation
-c tsol: temperature du sol
-c qsol: humidite du sol
-c snow: couverture neigeuse
-C
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "indicesol.h"
-c
-      REAL chasno ! epaisseur du sol: 0.15 m
-      PARAMETER (chasno=3.334E+05/(2.3867E+06*0.15))
-      REAL mx_eau_sol
-      PARAMETER (mx_eau_sol=150.0)
-c
-      REAL dtime
-      REAL pctsrf(klon,nbsrf)
-      REAL snow(klon,nbsrf), tsol(klon,nbsrf), qsol(klon,nbsrf)
-      REAL snow_fall(klon), rain_fall(klon), evap(klon)
-      REAL runoff(klon), agesno(klon)
-C
-      INTEGER i, is
-      REAL subli, fsno
-C-----------------------------------------------------------------------
-      DO 99999 i = 1, klon
-c
-         runoff(i) = 0.0
-c
-         is = is_ter
-         snow(i,is) = snow(i,is) + snow_fall(i) * dtime * pctsrf(i,is)
-         IF (pctsrf(i,is) .GT. epsfra) THEN
-            subli = MIN(evap(i)*dtime,snow(i,is))
-            snow(i,is) = snow(i,is) - subli
-            fsno = MIN(MAX((tsol(i,is)-RTT)/chasno,0.0),snow(i,is))
-            snow(i,is) = snow(i,is) - fsno
-            tsol(i,is) = tsol(i,is) - fsno*chasno
-            qsol(i,is) = qsol(i,is) + (rain_fall(i)-evap(i))*dtime
-     .                              + subli + fsno
-            qsol(i,is) = MAX(qsol(i,is),0.0)
-            runoff(i) = runoff(i) + MAX(qsol(i,is)-mx_eau_sol, 0.0)
-     .                            * pctsrf(i,is)
-            qsol(i,is) = MIN(qsol(i,is),mx_eau_sol)
-ccc         ELSE
-ccc            snow(i,is) = 0.0
-ccc            qsol(i,is) = 0.0
-ccc            tsol(i,is) = 0.0
-         ENDIF
-c
-         is = is_lic
-         snow(i,is) = snow(i,is) + snow_fall(i) * dtime * pctsrf(i,is)
-         IF (pctsrf(i,is) .GT. epsfra) THEN
-            subli = MIN(evap(i)*dtime,snow(i,is))
-            snow(i,is) = snow(i,is) - subli
-            fsno = MIN(MAX((tsol(i,is)-RTT)/chasno,0.0),snow(i,is))
-            snow(i,is) = snow(i,is) - fsno
-            tsol(i,is) = tsol(i,is) - fsno*chasno
-            qsol(i,is) = qsol(i,is) + (rain_fall(i)-evap(i))*dtime
-     .                              + subli + fsno
-            qsol(i,is) = MAX(qsol(i,is),0.0)
-            runoff(i) = runoff(i) + MAX(qsol(i,is)-mx_eau_sol, 0.0)
-     .                            * pctsrf(i,is)
-            qsol(i,is) = MIN(qsol(i,is),mx_eau_sol)
-c je limite la temperature a RTT-1.8 (il faudrait aussi prendre l'eau de
-c la fonte) (Laurent Li, le 14mars98):
-      tsol(i,is) = MIN(tsol(i,is),RTT-1.8)
-c
-ccc         ELSE
-ccc            snow(i,is) = 0.0
-ccc            qsol(i,is) = 0.0
-ccc            tsol(i,is) = 0.0
-         ENDIF
-c
-         is = is_sic
-         qsol(i,is) = 0.0
-         snow(i,is) = snow(i,is) + snow_fall(i) * dtime * pctsrf(i,is)
-         IF (pctsrf(i,is) .GT. epsfra) THEN
-            subli = MIN(evap(i)*dtime,snow(i,is))
-            snow(i,is) = snow(i,is) - subli
-            fsno = MIN(MAX((tsol(i,is)-RTT)/chasno,0.0),snow(i,is))
-            snow(i,is) = snow(i,is) - fsno
-            tsol(i,is) = tsol(i,is) - fsno*chasno
-c je limite la temperature a RTT-1.8 (il faudrait aussi prendre l'eau de
-c la fonte) (Laurent Li, le 14mars98):
-      tsol(i,is) = MIN(tsol(i,is),RTT-1.8)
-c
-ccc         ELSE
-ccc            snow(i,is) = 0.0
-ccc            tsol(i,is) = 0.0
-         ENDIF
-c
-         agesno(i) = (agesno(i)+ (1.-agesno(i)/50.)*dtime/86400.)
-     .             * EXP(-1.*MAX(0.0,snow_fall(i))*dtime/0.3)
-         agesno(i) = MAX(agesno(i),0.0)
-c
-99999 CONTINUE
-c
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/inc_cpl.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/inc_cpl.h	(revision 416)
+++ 	(revision )
@@ -1,16 +1,0 @@
-C
-C -- inc_cpl.h  
-C    **********
-C@
-C@  Contents : variables describing field restart file names 
-C@  --------
-C@
-C@ -- cl_write/cl_read  : for fields to write/READ
-C@ -- cl_f_write/cl_f_read  : for fields to write/read
-C@
-C     -------------------------------------------------------------------
-C
-      CHARACTER*8 cl_writ(jpmaxfld), cl_read(jpmaxfld)
-      CHARACTER*8 cl_f_writ(jpmaxfld), cl_f_read(jpmaxfld)
-      COMMON / comcpl / cl_writ, cl_read, cl_f_writ, cl_f_read
-C     -------------------------------------------------------------------
Index: LMDZ.3.3/branches/rel-/libf/phylmd/inc_sipc.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/inc_sipc.h	(revision 416)
+++ 	(revision )
@@ -1,23 +1,0 @@
-C
-C -- inc_sipc.h   97-08-11   Version 2.0   Author: S&A
-C    **********
-C@
-C@  Contents : variables describing pools formed of shared memory segments 
-C@  --------
-C@
-C@ -- mpoolinit(r/w) : handles associated to model pools for passing initial info
-C@
-C@ -- mpoolwrit : handles associated to pools used to pass fields exchanged 
-C@               from model to coupler (see libsipc/SIPC_Write_Model.f)
-C@
-C@ -- mpoolread : handles associated to pools used to pass fields exchanged
-C@               from model to coupler (see libsipc/SIPC_Read_Model.f) 
-C@ 
-C     -------------------------------------------------------------------
-C
-      INTEGER  mpoolinitr
-      INTEGER  mpoolinitw
-      INTEGER  mpoolwrit(jpflda2o)
-      INTEGER  mpoolread(jpfldo2a)
-      COMMON / compool / mpoolinitr, mpoolinitw, mpoolwrit, mpoolread
-C     -------------------------------------------------------------------
Index: LMDZ.3.3/branches/rel-/libf/phylmd/indicesol.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/indicesol.h	(revision 416)
+++ 	(revision )
@@ -1,14 +1,0 @@
-      INTEGER nbsrf
-      PARAMETER (nbsrf=4) ! nombre de sous-fractions pour une maille
-c
-      INTEGER is_oce
-      PARAMETER (is_oce=1) ! ocean
-      INTEGER is_sic
-      PARAMETER (is_sic=2) ! glace de mer
-      INTEGER is_ter
-      PARAMETER (is_ter=3) ! terre
-      INTEGER is_lic
-      PARAMETER (is_lic=4) ! glacier continental
-c
-      REAL epsfra
-      PARAMETER (epsfra=1.0E-05)
Index: LMDZ.3.3/branches/rel-/libf/phylmd/indicesol.inc
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/indicesol.inc	(revision 416)
+++ 	(revision )
@@ -1,9 +1,0 @@
-      INTEGER, parameter :: nbsrf=4
-      INTEGER, parameter :: is_oce=3 !ocean
-      INTEGER, parameter :: is_sic = 4 ! glace de mer
-      INTEGER, parameter :: is_ter = 1 ! terre
-      INTEGER, parameter :: is_lic = 2 ! glacier continental
-      REAL,parameter :: epsfra = 1.0E-05
-!
-      CHARACTER (len=3),dimension(nbsrf) :: clnsurf(nbsrf)
-      DATA clnsurf/'ter', 'lic', 'oce', 'sic'/
Index: LMDZ.3.3/branches/rel-/libf/phylmd/ini_histday.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/ini_histday.h	(revision 416)
+++ 	(revision )
@@ -1,342 +1,0 @@
-      IF (ok_journe) THEN
-c
-         idayref = day_ref
-         CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
-c
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
-         DO i = 1, iim
-            zx_lon(i,1) = rlon(i+1)
-            zx_lon(i,jjmp1) = rlon(i+1)
-         ENDDO
-         DO ll=1,klev
-            znivsig(ll)=float(ll)
-         ENDDO
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
-         write(*,*)'zx_lon = ',zx_lon(:,1)
-         write(*,*)'zx_lat = ',zx_lat(1,:)
-         CALL histbeg("histday", iim,zx_lon(:,1), jjmp1,zx_lat(1,:),
-     .                 1,iim,1,jjmp1, itau_phy, zjulian, dtime, 
-     .                 nhori, nid_day)
-         write(*,*)'Journee ', itau_phy, zjulian
-         CALL histvert(nid_day, "presnivs", "Vertical levels", "mb",
-     .                 klev, presnivs, nvert)
-c        call histvert(nid_day, 'sig_s', 'Niveaux sigma','-',
-c    .              klev, znivsig, nvert)
-c
-         zsto = dtime
-         zout = dtime * FLOAT(ecrit_day)
-C Essai writephys
-c        nom_fichier = 'histday1'
-c        call writephy_ini(fid_day,nom_fichier,klon,iim,jjmp1,klev,
-c    .                     rlon,rlat, presnivs,
-c    .                     zjulian, dtime)
-c        call writephy_def(prof2d_on, fid_day, "once", zsto, zout, 0)
-c        call writephy_def(prof3d_on, fid_day, "once", zsto, zout,
-c    .                                                         klev)
-c        call writephy_def(prof2d_av, fid_day, "ave(X)", zsto, zout, 0) 
-c        call writephy_def(prof3d_av, fid_day, "ave(X)", zsto, zout, 
-c    .                                                         klev)
- 
-c
-         CALL histdef(nid_day, "phis", "Surface geop. height", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "once", zsto,zout)
-c
-         CALL histdef(nid_day, "aire", "Grid area", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "once", zsto,zout)
-c
-c Champs 2D:
-c
-         CALL histdef(nid_day, "tsol", "Surface Temperature", "K",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "tter", "Surface Temperature", "K",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "tlic", "Surface Temperature", "K",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "toce", "Surface Temperature", "K",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "tsic", "Surface Temperature", "K",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-cccIM
-c
-         CALL histdef(nid_day, "t2m", "Temperature 2m", "K",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "t2mter", "Temp.terre 2m", "K",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "t2mlic", "Temp.lic 2m", "K",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "t2moce", "Temp.oce 2m", "K",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "t2msic", "Temp.sic 2m", "K",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "t2m_min", "Temp. 2m min.",
-     .                "K",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                t2mincels, zsto,zout)
-c
-         CALL histdef(nid_day, "t2m_max", "Temp. 2m max.",
-     .                "K",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                t2maxcels, zsto,zout)
-c
-         CALL histdef(nid_day, "t2mter_min", "Temp.terre 2m min.",
-     .                "K",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                t2mincels, zsto,zout)
-c
-         CALL histdef(nid_day, "t2mter_max", "Temp.terre 2m max.",
-     .                "K",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                t2maxcels, zsto,zout)
-c
-         CALL histdef(nid_day, "q2m", "Specific humidity", "Kg/Kg",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "u10m", "Vent zonal 10m", "m/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "u10mter", "Vent zonal ter 10m", "m/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "u10mlic", "Vent zonal lic 10m", "m/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "u10moce", "Vent zonal oce 10m", "m/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "u10msic", "Vent zonal sic 10m",
-     .                 "m/s",iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "v10m", "Vent meridien 10m", "m/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "v10mter", "Vent meridien ter 10m", 
-     .                "m/s", iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "v10mlic", "Vent meridien lic 10m",
-     .                 "m/s",iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "v10moce", "Vent meridien oce 10m",
-     .                 "m/s",iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "v10msic", "Vent meridien sic 10m",
-     .                 "m/s",iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "psol", "Surface Pressure", "Pa",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "precip","Precipitation Totale liq+sol"
-     .                , "kg/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "snow", "Snow fall", "kg/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "snow_mass", "Snow Mass", "kg/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "evap", "Evaporation", "kg/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "tops", "Solar rad. at TOA", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "topl", "IR rad. at TOA", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "sols", "Net Solar rad. at surf.", 
-     .                "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "soll", "Net IR rad. at surface", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "solldown", "Down. IR rad. at surface", 
-     .                "W/m2", iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "bils", "Surf. total heat flux", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "sens", "Sensible heat flux", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "fder", "Heat flux derivation", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "frtu", "Zonal wind stress", "Pa",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "frtv", "Meridional wind stress", "Pa",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-CXXX PB flux pour chaque sous surface
-C
-         DO nsrf = 1, nbsrf
-C
-           call histdef(nid_day, "pourc_"//clnsurf(nsrf), 
-     $         "Fraction"//clnsurf(nsrf), "W/m2",  
-     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
-     $         "ave(X)", zsto,zout)
-C
-           call histdef(nid_day, "tsol_"//clnsurf(nsrf), 
-     $         "Fraction"//clnsurf(nsrf), "W/m2",  
-     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
-     $         "ave(X)", zsto,zout)
-C
-           call histdef(nid_day, "sens_"//clnsurf(nsrf), 
-     $         "Sensible heat flux "//clnsurf(nsrf), "W/m2",  
-     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
-     $         "ave(X)", zsto,zout)
-c
-           call histdef(nid_day, "lat_"//clnsurf(nsrf), 
-     $         "Latent heat flux "//clnsurf(nsrf), "W/m2",  
-     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
-     $         "ave(X)", zsto,zout)
-C
-           call histdef(nid_day, "taux_"//clnsurf(nsrf), 
-     $         "Zonal wind stress"//clnsurf(nsrf),"Pa",
-     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
-     $         "ave(X)", zsto,zout)
-
-           call histdef(nid_day, "tauy_"//clnsurf(nsrf), 
-     $         "Meridional xind stress "//clnsurf(nsrf), "Pa",  
-     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
-     $         "ave(X)", zsto,zout)
-C
-           call histdef(nid_day, "albe_"//clnsurf(nsrf), 
-     $         "Albedo surf. "//clnsurf(nsrf), "W/m2",  
-     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
-     $         "ave(X)", zsto,zout)
-C
-           call histdef(nid_day, "rugs_"//clnsurf(nsrf), 
-     $         "Latent heat flux "//clnsurf(nsrf), "W/m2",  
-     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
-     $         "ave(X)", zsto,zout)
-
-CXXX
-         END DO 
-           
-         CALL histdef(nid_day, "sicf", "Sea-ice fraction", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "cldl", "Low-level cloudiness", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "cldm", "Mid-level cloudiness", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "cldh", "High-level cloudiness", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "cldt", "Total cloudiness", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "cldq", "Cloud liquid water path", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-c Champs 3D:
-c
-         CALL histdef(nid_day, "temp", "Air temperature", "K",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "ovap", "Specific humidity", "Kg/Kg",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "geop", "Geopotential height", "m",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "vitu", "Zonal wind", "m/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "vitv", "Meridional wind", "m/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "vitw", "Vertical wind", "m/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "pres", "Air pressure", "Pa",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-cccIM   
-         CALL histdef(nid_day, "SWupTOA", "SWup at TOA","W/m2",
-     .                iim,jjmp1,nhori, 1,1,1,-99,
-     .                32, "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "SWupSFC", "SWup at surface","W/m2",
-     .                iim,jjmp1,nhori, 1,1,1,-99,
-     .                32, "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "SWdnTOA", "SWdn at TOA","W/m2",
-     .                iim,jjmp1,nhori, 1,1,1,-99,
-     .                32, "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "SWdnSFC", "SWdn at surface","W/m2",
-     .                iim,jjmp1,nhori, 1,1,1,-99,
-     .                32, "ave(X)", zsto,zout)
-c
-         CALL histend(nid_day)
-c
-         ndex2d = 0
-         ndex3d = 0
-c
-      ENDIF ! fin de test sur ok_journe
Index: LMDZ.3.3/branches/rel-/libf/phylmd/ini_histhf.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/ini_histhf.h	(revision 416)
+++ 	(revision )
@@ -1,91 +1,0 @@
-
-      IF (ok_hf) THEN
-c
-         PRINT*, 'La frequence de sortie instant. est de ', ecrit_hf
-
-cccIM    CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian)
-         CALL ymds2ju(annee_ref, 1, 1, 0.0, zjulian)
-         zjulian = zjulian + day_ini
-c
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
-         DO i = 1, iim
-            zx_lon(i,1) = rlon(i+1)
-            zx_lon(i,jjmp1) = rlon(i+1)
-         ENDDO
-
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
-
-cccIM      CALL histbeg("histhf", iim,zx_lon, jjmp1,zx_lat,
-         CALL histbeg("histhf", iim,zx_lon(:,1), jjmp1,zx_lat(1,:),
-     .                 1,iim,1,jjmp1, 0, zjulian, dtime, 
-     .                 nhori, nid_hf)
-
-         CALL histvert(nid_hf, "presnivs", "Vertical levels", "mb",
-     .                 klev, presnivs, nvert)
-         zsto = dtime
-
-c   pour les champs instantannes, il faut mettre la meme valeur pour
-c   zout et tsto.
-c   dtime est passe par ailleurs a histbeg
-
-         zout = dtime * FLOAT(NINT(86400./dtime*ecrit_hf))
-         zsto = zout
-         print*,'zout,zsto=',zout,zsto
-
-c
-c        CALL histdef(nid_hf, "phis", "Surface geop. height", "-",
-c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-c    .                "once", zsto,zout)
-c
-c        CALL histdef(nid_hf, "aire", "Grid area", "-",
-c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-c    .                "once", zsto,zout)
-c
-c Champs 2D:
-c
-         CALL histdef(nid_hf, "tsol", "Surface Temperature", "K",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_hf, "psol", "Surface Pressure", "Pa",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
-         print*,'ATTENTION METTRE AVE(X) POUR LES PRECIPS'
-
-         CALL histdef(nid_hf, "rain", "Precipitation", "mm/d",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_hf, "u850", "Zonal wind 850mb", "m/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-
-         CALL histdef(nid_hf, "v850", "Meridional wind 850mb", "m/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_hf, "u500", "Zonal wind 500mb", "m/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-
-         CALL histdef(nid_hf, "v500", "Meridional wind 500mb", "m/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-
-         CALL histdef(nid_hf, "u200", "Zonal wind 200mb", "m/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-
-         CALL histdef(nid_hf, "v200", "Meridional wind 200mb", "m/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-
-         CALL histdef(nid_hf, "phi500", "Geopotentiel à 500mb", "m2/s2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-
-c
-         CALL histend(nid_hf)
-
-      endif ! ok_hf
Index: LMDZ.3.3/branches/rel-/libf/phylmd/ini_histins.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/ini_histins.h	(revision 416)
+++ 	(revision )
@@ -1,235 +1,0 @@
-      IF (ok_instan) THEN
-c
-         idayref = day_ref
-         CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
-c
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
-         DO i = 1, iim
-            zx_lon(i,1) = rlon(i+1)
-            zx_lon(i,jjmp1) = rlon(i+1)
-         ENDDO
-         DO ll=1,klev
-            znivsig(ll)=float(ll)
-         ENDDO
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
-         CALL histbeg("histins", iim,zx_lon(:,1), jjmp1,zx_lat(1,:),
-     .                 1,iim,1,jjmp1, itau_phy, zjulian, dtime,
-     .                 nhori, nid_ins)
-         write(*,*)'Inst ', itau_phy, zjulian
-         CALL histvert(nid_ins, "presnivs", "Vertical levels", "mb",
-     .                 klev, presnivs, nvert)
-c        call histvert(nid_ins, 'sig_s', 'Niveaux sigma','-',
-c    .              klev, znivsig, nvert)
-c
-c
-         zsto = dtime * ecrit_ins
-         zout = dtime * ecrit_ins
-C
-         CALL histdef(nid_ins, "phis", "Surface geop. height", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "once", zsto,zout)
-c
-         CALL histdef(nid_ins, "aire", "Grid area", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "once", zsto,zout)
-c
-c Champs 2D:
-c
-        CALL histdef(nid_ins, "tsol", "Surface Temperature", "K",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "t2m", "Temperature 2m", "K",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "q2m", "Specific humidity 2m", "Kg/Kg",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "u10m", "Vent zonal 10m", "m/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "v10m", "Vent meridien 10m", "m/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "inst(X)", zsto,zout)
-c
-        CALL histdef(nid_ins, "psol", "Surface Pressure", "Pa",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "plul", "Large-scale Precip.", "mm/day",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "pluc", "Convective Precip.", "mm/day",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "inst(X)", zsto,zout)
-
-        CALL histdef(nid_ins, "qsol", "Surface humidity", "mm",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "cdrm", "Momentum drag coef.", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "cdrh", "Heat drag coef.", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "precip", "Precipitation Totale liq+sol", 
-     .                "kg/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "snow", "Snow fall", "kg/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "snow_mass", "Snow Mass", "kg/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "topl", "OLR", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "evap", "Evaporation", "kg/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "sols", "Solar rad. at surf.", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "soll", "IR rad. at surface", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "solldown", "Down. IR rad. at surface", 
-     .                "W/m2", iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "bils", "Surf. total heat flux", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "sens", "Sensible heat flux", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "fder", "Heat flux derivation", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
-      CALL histdef(nid_ins, "dtsvdfo", "Boundary-layer dTs(o)", "K/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
-      CALL histdef(nid_ins, "dtsvdft", "Boundary-layer dTs(t)", "K/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
-      CALL histdef(nid_ins, "dtsvdfg", "Boundary-layer dTs(g)", "K/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
-      CALL histdef(nid_ins, "dtsvdfi", "Boundary-layer dTs(g)", "K/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-
-         DO nsrf = 1, nbsrf
-C
-           call histdef(nid_ins, "pourc_"//clnsurf(nsrf), 
-     $         "Fraction"//clnsurf(nsrf), "W/m2",  
-     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
-     $         "inst(X)", zsto,zout)
-
-           call histdef(nid_ins, "sens_"//clnsurf(nsrf), 
-     $         "Sensible heat flux "//clnsurf(nsrf), "W/m2",  
-     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
-     $         "inst(X)", zsto,zout)
-c
-           call histdef(nid_ins, "tsol_"//clnsurf(nsrf), 
-     $         "Surface Temperature"//clnsurf(nsrf), "W/m2",  
-     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
-     $         "inst(X)", zsto,zout)
-c
-           call histdef(nid_ins, "lat_"//clnsurf(nsrf), 
-     $         "Latent heat flux "//clnsurf(nsrf), "W/m2",  
-     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
-     $         "inst(X)", zsto,zout)
-C
-           call histdef(nid_ins, "taux_"//clnsurf(nsrf), 
-     $         "Zonal wind stress"//clnsurf(nsrf),"Pa",
-     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
-     $         "inst(X)", zsto,zout)
-
-           call histdef(nid_ins, "tauy_"//clnsurf(nsrf), 
-     $         "Meridional xind stress "//clnsurf(nsrf), "Pa",  
-     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
-     $         "inst(X)", zsto,zout)
-c
-           call histdef(nid_ins, "albe_"//clnsurf(nsrf), 
-     $         "Albedo "//clnsurf(nsrf), "-",  
-     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
-     $         "inst(X)", zsto,zout)
-c
-           call histdef(nid_ins, "rugs_"//clnsurf(nsrf), 
-     $         "rugosite "//clnsurf(nsrf), "-",  
-     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
-     $         "inst(X)", zsto,zout)
-CXXX
-         END DO 
-         CALL histdef(nid_ins, "rugs", "rugosity", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-
-c
-         CALL histdef(nid_ins, "albs", "Surface albedo", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-         CALL histdef(nid_ins, "albslw", "Surface albedo LW", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
-c
-c Champs 3D:
-c
-         CALL histdef(nid_ins, "temp", "Temperature", "K",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "vitu", "Zonal wind", "m/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "vitv", "Merid wind", "m/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "geop", "Geopotential height", "m",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "pres", "Air pressure", "Pa",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "dtvdf", "Boundary-layer dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "dqvdf", "Boundary-layer dQ", "Kg/Kg/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "inst(X)", zsto,zout)
-c
-
-         CALL histend(nid_ins)
-c
-         ndex2d = 0
-         ndex3d = 0
-c
-      ENDIF
Index: LMDZ.3.3/branches/rel-/libf/phylmd/ini_histmth.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/ini_histmth.h	(revision 416)
+++ 	(revision )
@@ -1,489 +1,0 @@
-      IF (ok_mensuel) THEN
-c
-         idayref = day_ref
-         CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
-c
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
-         DO i = 1, iim
-            zx_lon(i,1) = rlon(i+1)
-            zx_lon(i,jjmp1) = rlon(i+1)
-         ENDDO
-         DO ll=1,klev
-            znivsig(ll)=float(ll)
-         ENDDO
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
-         CALL histbeg("histmth.nc", iim,zx_lon(:,1), jjmp1,zx_lat(1,:),
-     .                 1,iim,1,jjmp1, itau_phy, zjulian, dtime, 
-     .                 nhori, nid_mth)
-         write(*,*)'Mensuel ', itau_phy, zjulian
-         CALL histvert(nid_mth, "presnivs", "Vertical levels", "mb",
-     .                 klev, presnivs, nvert)
-c        call histvert(nid_mth, 'sig_s', 'Niveaux sigma','-',
-c    .              klev, znivsig, nvert)
-c
-         zsto = dtime
-         zout = dtime * ecrit_mth
-c
-         CALL histdef(nid_mth, "phis", "Surface geop. height", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "once",  zsto,zout)
-c
-         CALL histdef(nid_mth, "aire", "Grid area", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "once",  zsto,zout)
-c
-c Champs 2D:
-c
-         CALL histdef(nid_mth, "tsol", "Surface Temperature", "K",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "t2m", "Temperature 2m", "K",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "q2m", "Specific humidity 2m", "Kg/Kg",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "u10m", "Vent zonal 10m", "m/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "v10m", "Vent meridien 10m", "m/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-c
-         CALL histdef(nid_mth, "psol", "Surface Pressure", "Pa",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "qsol", "Surface humidity", "mm",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "precip", "Precipitation Totale liq+sol", 
-     .                "kg/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "plul", "Large-scale Precip.", "kg/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "pluc", "Convective Precip.", "kg/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "snow", "Snow fall", "kg/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "snow_mass", "Snow Mass", "kg/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "evap", "Evaporation", "kg/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "tops", "Solar rad. at TOA", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "topl", "IR rad. at TOA", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "sols", "Solar rad. at surf.", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "soll", "IR rad. at surface", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "solldown", "Down. IR rad. at surface", 
-     .                "W/m2", iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "tops0", "Solar rad. at TOA", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "topl0", "IR rad. at TOA", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "sols0", "Solar rad. at surf.", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "soll0", "IR rad. at surface", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "bils", "Surf. total heat flux", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "sens", "Sensible heat flux", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "fder", "Heat flux derivation", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "frtu", "Zonal wind stress", "Pa",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "frtv", "Meridional wind stress", "Pa",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         DO nsrf = 1, nbsrf
-C
-           call histdef(nid_mth, "pourc_"//clnsurf(nsrf), 
-     $         "Fraction "//clnsurf(nsrf), "W/m2",  
-     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
-     $         "ave(X)", zsto,zout)
-C
-           call histdef(nid_mth, "tsol_"//clnsurf(nsrf), 
-     $         "Fraction "//clnsurf(nsrf), "W/m2",  
-     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
-     $         "ave(X)", zsto,zout)
-C
-           call histdef(nid_mth, "sens_"//clnsurf(nsrf), 
-     $         "Sensible heat flux "//clnsurf(nsrf), "W/m2",  
-     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
-     $         "ave(X)", zsto,zout)
-c
-           call histdef(nid_mth, "lat_"//clnsurf(nsrf), 
-     $         "Latent heat flux "//clnsurf(nsrf), "W/m2",  
-     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
-     $         "ave(X)", zsto,zout)
-C
-           call histdef(nid_mth, "taux_"//clnsurf(nsrf), 
-     $         "Zonal wind stress"//clnsurf(nsrf), "Pa",  
-     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
-     $         "ave(X)", zsto,zout)
-
-           call histdef(nid_mth, "tauy_"//clnsurf(nsrf), 
-     $         "Meridional xind stress "//clnsurf(nsrf), "Pa",  
-     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
-     $         "ave(X)", zsto,zout)
-c
-           call histdef(nid_mth, "albe_"//clnsurf(nsrf), 
-     $         "Albedo surf. "//clnsurf(nsrf), "W/m2",  
-     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
-     $         "ave(X)", zsto,zout)
-c
-           call histdef(nid_mth, "rugs_"//clnsurf(nsrf), 
-     $         "Latent heat flux "//clnsurf(nsrf), "W/m2",  
-     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
-     $         "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "ages_"//clnsurf(nsrf), "Snow age","day",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-
-         END DO
-C
-         CALL histdef(nid_mth, "sicf", "Sea-ice fraction", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "albs", "Surface albedo", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-         CALL histdef(nid_mth, "albslw", "Surface albedo LW", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "cdrm", "Momentum drag coef.", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "cdrh", "Heat drag coef.", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "cldl", "Low-level cloudiness", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "cldm", "Mid-level cloudiness", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "cldh", "High-level cloudiness", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "cldt", "Total cloudiness", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "cldq", "Cloud liquid water path", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "ue", "Zonal energy transport", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "ve", "Merid energy transport", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "uq", "Zonal humidity transport", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "vq", "Merid humidity transport", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-cKE43
-      IF (iflag_con .GE. 3) THEN ! sb
-c
-         CALL histdef(nid_mth, "cape", "Conv avlbl pot ener", "J/Kg",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "pbase", "Cld base pressure", "hPa",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "ptop", "Cld top pressure", "hPa",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "fbase", "Cld base mass flux", "Kg/m2/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-c
-      ENDIF
-c34EK
-c
-c Champs 3D:
-c
-         CALL histdef(nid_mth, "temp", "Air temperature", "K",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "ovap", "Specific humidity", "Kg/Kg",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "geop", "Geopotential height", "m",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "vitu", "Zonal wind", "m/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "vitv", "Meridional wind", "m/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "vitw", "Vertical wind", "m/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "pres", "Air pressure", "Pa",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "rneb", "Cloud fraction", "-",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "rhum", "Relative humidity", "-",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "clwcon", "Cloud Liquid water content"
-     .                , "kg/kg",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "oliq", "Liquid water content", "kg/kg",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dtdyn", "Dynamics dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dqdyn", "Dynamics dQ", "Kg/Kg/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dtcon", "Convection dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "ducon", "Convection du", "m/s2",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dqcon", "Convection dQ", "Kg/Kg/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dtlsc", "Condensation dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dqlsc", "Condensation dQ", "Kg/Kg/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dtvdf", "Boundary-layer dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dqvdf", "Boundary-layer dQ", "Kg/Kg/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dteva", "Reevaporation dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dqeva", "Reevaporation dQ", "Kg/Kg/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-
-         CALL histdef(nid_mth, "ptconv", "POINTS CONVECTIFS"," ",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-
-         CALL histdef(nid_mth, "ratqs", "RATQS"," ",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-
-c
-         CALL histdef(nid_mth, "dtajs", "Dry adjust. dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-
-         CALL histdef(nid_mth, "dqajs", "Dry adjust. dQ", "Kg/Kg/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dtswr", "SW radiation dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dtsw0", "SW radiation dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dtlwr", "LW radiation dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dtlw0", "LW radiation dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dtec", "Cinetic dissip dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "duvdf", "Boundary-layer dU", "m/s2",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dvvdf", "Boundary-layer dV", "m/s2",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         IF (ok_orodr) THEN
-         CALL histdef(nid_mth, "duoro", "Orography dU", "m/s2",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dvoro", "Orography dV", "m/s2",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         ENDIF
-C
-         IF (ok_orolf) THEN
-         CALL histdef(nid_mth, "dulif", "Orography dU", "m/s2",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dvlif", "Orography dV", "m/s2",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-         ENDIF
-C
-         CALL histdef(nid_mth, "ozone", "Ozone concentration", "-",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         if (nqmax.GE.3) THEN
-         DO iq=1,nqmax-2
-         IF (iq.LE.99) THEN
-         WRITE(str2,'(i2.2)') iq
-         CALL histdef(nid_mth, "trac"//str2, "Tracer No."//str2, "-",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-         ELSE
-         PRINT*, "Trop de traceurs"
-         CALL abort
-         ENDIF
-         ENDDO
-         ENDIF
-c
-cKE43
-      IF (iflag_con.GE.3) THEN ! (sb)
-c
-         CALL histdef(nid_mth, "upwd", "saturated updraft", "Kg/m2/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dnwd", "saturated downdraft","Kg/m2/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dnwd0", "unsat. downdraft", "Kg/m2/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth,"Ma","undilute adiab updraft","Kg/m2/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-cccIM
-         CALL histdef(nid_mth, "SWupTOA", "SWup at TOA","W/m2",
-     .                iim,jjmp1,nhori, 1,1,1,-99,
-     .                32, "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "SWupSFC", "SWup at surface","W/m2",
-     .                iim,jjmp1,nhori, 1,1,1,-99,
-     .                32, "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "SWdnTOA", "SWdn at TOA","W/m2",
-     .                iim,jjmp1,nhori, 1,1,1,-99,
-     .                32, "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "SWdnSFC", "SWdn at surface","W/m2",
-     .                iim,jjmp1,nhori, 1,1,1,-99,
-     .                32, "ave(X)", zsto,zout)
-c
-      ENDIF
-c34EK
-         CALL histend(nid_mth)
-c
-         ndex2d = 0
-         ndex3d = 0
-c
-      ENDIF ! fin de test sur ok_mensuel
Index: LMDZ.3.3/branches/rel-/libf/phylmd/inifis.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/inifis.F	(revision 416)
+++ 	(revision )
@@ -1,69 +1,0 @@
-      SUBROUTINE inifis(ngrid,nlayer,
-     $           punjours,
-     $           pdayref,ptimestep,
-     $           plat,plon,parea,
-     $           prad,pg,pr,pcpp)
-      IMPLICIT NONE
-c
-c=======================================================================
-c
-c   subject:
-c   --------
-c
-c   Initialisation for the physical parametrisations of the LMD 
-c   martian atmospheric general circulation modele.
-c
-c   author: Frederic Hourdin 15 / 10 /93
-c   -------
-c
-c   arguments:
-c   ----------
-c
-c   input:
-c   ------
-c
-c    ngrid                 Size of the horizontal grid.
-c                          All internal loops are performed on that grid.
-c    nlayer                Number of vertical layers.
-c    pdayref               Day of reference for the simulation
-c    firstcall             True at the first call
-c    lastcall              True at the last call
-c    pday                  Number of days counted from the North. Spring
-c                          equinoxe.
-c
-c=======================================================================
-c
-c-----------------------------------------------------------------------
-c   declarations:
-c   -------------
- 
-#include "dimensions.h"
-#include "dimphy.h"
-
-      REAL prad,pg,pr,pcpp,punjours
- 
-      INTEGER ngrid,nlayer
-      REAL plat(ngrid),plon(ngrid),parea(klon)
-      INTEGER pdayref
- 
-      REAL ptimestep
- 
-      IF (nlayer.NE.klev) THEN
-         PRINT*,'STOP in inifis'
-         PRINT*,'Probleme de dimensions :'
-         PRINT*,'nlayer     = ',nlayer
-         PRINT*,'klev   = ',klev
-         STOP
-      ENDIF
-
-      IF (ngrid.NE.klon) THEN
-         PRINT*,'STOP in inifis'
-         PRINT*,'Probleme de dimensions :'
-         PRINT*,'ngrid     = ',ngrid
-         PRINT*,'klon   = ',klon
-         STOP
-      ENDIF
-
-      RETURN
-9999  STOP'Cette version demande les fichier rnatur.dat et surf.def'
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/initphysto.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/initphysto.F	(revision 416)
+++ 	(revision )
@@ -1,288 +1,0 @@
-C
-C $Header$
-C
-      subroutine initphysto
-     .  (infile,
-     .  rlon, rlat, tstep,t_ops,t_wrt,nq,fileid)
-
-       USE IOIPSL
-
-      implicit none
-
-C
-C   Routine d'initialisation des ecritures des fichiers histoires LMDZ
-C   au format IOIPSL
-C
-C   Appels succesifs des routines: histbeg
-C                                  histhori
-C                                  histver
-C                                  histdef
-C                                  histend
-C
-C   Entree:
-C
-C      infile: nom du fichier histoire a creer
-C      day0,anne0: date de reference
-C      tstep: duree du pas de temps en seconde
-C      t_ops: frequence de l'operation pour IOIPSL
-C      t_wrt: frequence d'ecriture sur le fichier
-C      nq: nombre de traceurs
-C
-C   Sortie:
-C      fileid: ID du fichier netcdf cree
-C      filevid:ID du fichier netcdf pour la grille v
-C
-C   L. Fairhead, LMD, 03/99
-C
-C =====================================================================
-C
-C   Declarations
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comgeom.h"
-#include "temps.h"
-#include "ener.h"
-#include "logic.h"
-#include "description.h"
-#include "serre.h"
-#include "indicesol.h"
-#include "control.h"
-#include "dimphy.h"
-
-C   Arguments
-      character*(*) infile
-      integer*4 nhoriid, i
-      real tstep, t_ops, t_wrt
-      integer fileid, filevid
-      integer nq,l
-      real nivsigs(llm)
-
-C   Variables locales
-C
-      integer tau0
-      real zjulian
-      character*3 str
-      character*10 ctrac
-      integer iq
-      integer uhoriid, vhoriid, thoriid, zvertiid
-      integer ii,jj
-      integer zan, idayref
-      logical ok_sync
-      REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)
-C
-      REAL rlon(klon), rlat(klon)
-
-C  Initialisations
-C
-      pi = 4. * atan (1.)
-      str='q  '
-      ctrac = 'traceur   '
-      ok_sync= .true.
-C
-C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
-C         
-
-      zan = anneeref
-      idayref = dayref
-      CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
-      tau0 = 0
-	
-	CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon)
-         DO i = 1, iim
-            zx_lon(i,1) = rlon(i+1)
-            zx_lon(i,jjm+1) = rlon(i+1)
-         ENDDO
-         CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlat,zx_lat)
-
-
-      call histbeg(infile, iim, zx_lon, jjm+1, zx_lat,
-     .             1, iim, 1, jjm+1,
-     .             tau0, zjulian, tstep, nhoriid, fileid)
-
-C  Appel a histvert pour la grille verticale
-C
-	DO l=1,llm
-            nivsigs(l)=float(l)
-         ENDDO
-	
-	write(*,*) 'avant histvert ds initphysto'
-
-      call histvert(fileid, 'sig_s', 'Niveaux sigma',
-     . 'sigma_level',
-     .              llm, nivsigs, zvertiid)
-C
-C  Appels a histdef pour la definition des variables a sauvegarder
-C
-	write(*,*) 'apres histvert ds initphysto'
-
-       CALL histdef(fileid, "phis", "Surface geop. height", "-",
-     .                iim,jjm+1,nhoriid, 1,1,1, -99, 32,
-     .                "once", t_ops, t_wrt)
-c
-	write(*,*) 'apres phis ds initphysto'
-
-         CALL histdef(fileid, "aire", "Grid area", "-",
-     .                iim,jjm+1,nhoriid, 1,1,1, -99, 32,
-     .                "once", t_ops, t_wrt)
-         write(*,*) 'apres aire ds initphysto'
-
-         CALL histdef(fileid, "dtime", "tps phys ", "s",
-     .                1,1,nhoriid, 1,1,1, -99, 32,
-     .                "once", t_ops, t_wrt)
-	
-	 CALL histdef(fileid, "istphy", "tps stock", "s",
-     .                1,1,nhoriid, 1,1,1, -99, 32,
-     .                "once", t_ops, t_wrt)
-
-C T 
-C
-      call histdef(fileid, 't', 'Temperature', 'K',
-     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-        write(*,*) 'apres t ds initphysto'
-C mfu 
-C
-      call histdef(fileid, 'mfu', 'flx m. pan. mt', 'kg m/s',
-     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-        write(*,*) 'apres mfu ds initphysto'
-C
-C mfd 
-C
-      call histdef(fileid, 'mfd', 'flx m. pan. des', 'kg m/s',
-     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-
-C
-C en_u 
-C
-      call histdef(fileid, 'en_u', 'flx ent pan mt', 'kg m/s',
-     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-               write(*,*) 'apres en_u ds initphysto'
-C
-C de_u 
-C
-      call histdef(fileid, 'de_u', 'flx det pan mt', 'kg m/s',
-     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-
-C
-C en_d 
-C
-      call histdef(fileid, 'en_d', 'flx ent pan dt', 'kg m/s',
-     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-C
-
-C
-C de_d 
-C
-      call histdef(fileid, 'de_d', 'flx det pan dt', 'kg m/s',
-     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-
-c coefh frac_impa,frac_nucl
-	
-	call histdef(fileid, 'coefh', ' ', ' ',
-     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-	
-	write(*,*) 'apres coefh ds initphysto'	
-
-	call histdef(fileid, 'frac_impa', ' ', ' ',
-     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-	
-	call histdef(fileid, 'frac_nucl', ' ', ' ',
-     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-
-c
-c pyu1
-c
-      CALL histdef(fileid, "pyu1", " ", " ",
-     .                iim,jjm+1,nhoriid, 1,1,1, -99, 32,
-     .                "inst(X)", t_ops, t_wrt)
-
-c
-c pyv1
-c
-	CALL histdef(fileid, "pyv1", " ", " ",
-     .                iim,jjm+1,nhoriid, 1,1,1, -99, 32,
-     .                "inst(X)", t_ops, t_wrt)
-	
-	write(*,*) 'apres pyv1 ds initphysto'
-c
-c ftsol1
-c
-	call histdef(fileid, "ftsol1", " ", " ",
-     .             iim, jjm+1, nhoriid, 1, 1,1, -99,32,
-     .             "inst(X)", t_ops, t_wrt)
-
-c
-c ftsol2
-c
-        call histdef(fileid, "ftsol2", " ", " ",
-     .             iim, jjm+1, nhoriid, 1, 1,1, -99,32,
-     .             "inst(X)", t_ops, t_wrt)
-
-c
-c ftsol3
-c
-        call histdef(fileid, "ftsol3", " ", " ",
-     .             iim, jjm+1, nhoriid, 1, 1,1, -99,
-     .             32, "inst(X)", t_ops, t_wrt)
-
-c
-c ftsol4
-c
-        call histdef(fileid, "ftsol4", " ", " ",
-     .             iim, jjm+1, nhoriid, 1, 1,1, -99,
-     .             32, "inst(X)", t_ops, t_wrt)
-	
-c
-c rain
-c
-        call histdef(fileid, "rain", " ", " ",
-     .             iim, jjm+1, nhoriid, 1, 1,1, -99,
-     .             32, "inst(X)", t_ops, t_wrt)
-
-c
-c psrf1
-c
-	call histdef(fileid, "psrf1", " ", " ",
-     .             iim, jjm+1, nhoriid, 1, 1, 1, -99,
-     .             32, "inst(X)", t_ops, t_wrt)
-	
-c
-c psrf2
-c
-        call histdef(fileid, "psrf2", " ", " ",
-     .             iim, jjm+1, nhoriid, 1, 1, 1, -99,
-     .             32, "inst(X)", t_ops, t_wrt)
-
-c
-c psrf3
-c
-        call histdef(fileid, "psrf3", " ", " ",
-     .             iim, jjm+1, nhoriid, 1, 1, 1, -99,
-     .             32, "inst(X)", t_ops, t_wrt)
-
-c
-c psrf4
-c
-        call histdef(fileid, "psrf4", " ", " ",
-     .             iim, jjm+1, nhoriid, 1, 1, 1, -99,
-     .             32, "inst(X)", t_ops, t_wrt)
-	
-	write(*,*) 'avant histend ds initphysto'	
-
-      call histend(fileid)
-      if (ok_sync) call histsync(fileid)
-
-	
-
-      return
-      end
Index: LMDZ.3.3/branches/rel-/libf/phylmd/initrrnpb.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/initrrnpb.F	(revision 416)
+++ 	(revision )
@@ -1,119 +1,0 @@
-      SUBROUTINE  initrrnpb(ftsol,pctsrf,masktr,fshtr,hsoltr,tautr
-     .                   ,vdeptr,scavtr)
-      IMPLICIT none
-c======================================================================
-c Auteur(s): AA + CG (LGGE/CNRS) Date 24-06-94
-c Objet: initialisation des constantes des traceurs
-CAA Revison pour le controle avec la temperature du sol
-cAA
-CAA   it = 1 radon ss controle de ts
-cAA   it = 2 plomb ss controle de ts  
-c======================================================================
-c Arguments:
-c nbtr------input-I- nombre de vrais traceurs (sans l'eau)
-c ftsol-------input-R- Temperature du sol (Kelvin)
-c pctsrf-----input-R-  Nature de sol (pourcentage de sol)
-c masktr---output-R- Masque reservoir de sol traceur (1 = reservoir)
-c fshtr----output-R- Flux surfacique de production dans le sol
-c hsoltr---output-R- Epaisseur du reservoir de sol
-c tautr----output-R- Constante de decroissance du traceur
-c vdeptr---output-R- Vitesse de depot sec dans la couche Brownienne
-c scavtr---output-R- Coefficient de lessivage
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "indicesol.h"
-c======================================================================
-C
-      INTEGER i, it
-      REAL pctsrf(klon,nbsrf) !Pourcentage de sol (f(nature du sol))
-      REAL ftsol(klon,nbsrf)  ! Temperature du sol pour le controle Rn
-c                             ! le cas echeant
-      REAL masktr(klon,nbtr)  ! Masque de l'echange avec la surface
-c                                 (possible => 1 )
-      REAL fshtr(klon,nbtr)  ! Flux surfacique dans le reservoir de sol
-      REAL hsoltr(nbtr)      ! Epaisseur equivalente du reservoir de sol
-      REAL tautr(nbtr)       ! Constante de decroissance radioactive
-      REAL vdeptr(nbtr)      ! Vitesse de depot sec dans la couche Brownienne
-      REAL scavtr(nbtr)      ! Coefficient de lessivage
-      REAL s
-C
-      WRITE(*,'(''PASSAGE initrrnpb ...'',$)')
-      print*,'nbtr= ',nbtr
-      print*,'nbsrf= ',nbsrf
-      print*,'klon= ',klon
-C
-C Puis les initialisation specifiques a chaque traceur (pour le moment, Rn222)
-C
-C
-C Radon it = 1
-c
-      IF ( nbtr .LE. 0 ) STOP 'initrrnpb pas glop pas glop' 
-      it = 1
-      s = 1.E4  !  Source: atome par m2
-      hsoltr(it) = 0.1      ! Hauteur equivalente du reservoir : 
-c                              1 m * porosite 0.1
-      tautr(it) = 4.765E5  ! Decroissance du radon, secondes
-cAA
-c      tautr(it) = 4.765E55  ! Decroissance du radon,infinie
-cAA
-      vdeptr(it) = 0. ! Pas de depot sec pour le radon
-      scavtr(it) = 0. ! Pas de lessivage pour le radon
-
-      print*, '-------------- SOURCE DU RADON ------------------------ '
-      print*,'it = ',it
-      print*,'Source : ', s
-      print*,'Hauteur equivalente du reservoir de sol: ',hsoltr(it) 
-      print*,'Decroissance (s): ', tautr(it)
-      print*,'Vitesse de depot sec: ',vdeptr(it) 
-      print*,'Facteur de lessivage: ',scavtr(it)
-
-      DO i = 1,klon
-        masktr(i,it) = 0.
-        IF ( NINT(pctsrf(i,3)) .EQ. 1 ) masktr(i,it) = 1.
-        fshtr(i,it) = s * masktr(i,it) * pctsrf(i,3)
-cAA
-cAA quelques tests
-cAA POur l'instant le pctsrf(i,3) = 1.0 
-cAA lorsqu'il ya de la terre mias ne prend aucune autre valeur
-cAA il n'est donc pas necessaire de multiplier fshtr par pctsrf
-cAA 
-c       print*, '------------------------------------------ '
-c        print*, 'masktr(',i,it,')= ',masktr(i,it)
-c        print*, 'fshtr(',i,it,')= ',fshtr(i,it)
-c        print*, 'pctsrf(',i,',1)= ',pctsrf(i,1)
-c        print*, 'pctsrf(',i,',2)= ',pctsrf(i,2)
-c        print*, 'pctsrf(',i,',3)= ',pctsrf(i,3)
-c        print*, 'pctsrf(',i,',4)= ',pctsrf(i,4)
-c        print*, 's = ',s
-c        print*, '------------------------------------------ '
-
-      END DO
-C
-C 210Pb it = 2
-C
-      IF ( nbtr .LE. 1 ) STOP 'initrrnpb pas glop pas glop' 
-      it = 2
-      s = 0. !  Pas de source !!!
-      hsoltr(it) = 10.     ! Hauteur equivalente du reservoir 
-c                              a partir duquel le
-c                              depot Brownien a lieu
-      tautr(it) = 1.028E9 ! Decroissance du Pb210, secondes
-      vdeptr(it) = 1.E-3 ! 1 mm/s pour le 210Pb
-      scavtr(it) =  .5   ! Lessivage du Pb210
-      DO i = 1,klon
-        masktr(i,it) = 1. ! Le depot sec peut avoir lieu partout
-        fshtr(i,it) = s * masktr(i,it)
-      END DO
-      print*, '-------------- SOURCE DU PLOMB ------------------------ '
-      print*,'it = ',it
-      print*,'Source : ', s
-      print*,'Hauteur equivalente du reservoir : ',hsoltr(it) 
-      print*,'Decroissance (s): ', tautr(it)
-      print*,'Vitesse de depot sec: ',vdeptr(it) 
-      print*,'Facteur de lessivage: ',scavtr(it)
-c
-      WRITE(*,*) 'initialisation rnpb ok'
-c
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/interface_surf.F90
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/interface_surf.F90	(revision 416)
+++ 	(revision )
@@ -1,980 +1,0 @@
-
-  MODULE interface_surf
-
-! Ce module regroupe toutes les routines gerant l'interface entre le modele 
-! atmospherique et les modeles de surface (sols continentaux, oceans, glaces)
-! Les routines sont les suivantes:
-!
-!   interfsurf_*: routines d'aiguillage vers les interfaces avec les 
-!                 differents modeles de surface
-!   interfsol\
-!             > routines d'interface proprement dite
-!   interfoce/
-!
-!   interfstart: routine d'initialisation et de lecture de l'etat initial
-!                "interface"
-!   interffin  : routine d'ecriture de l'etat de redemmarage de l'interface
-!
-! 
-! L. Fairhead, LMD, 02/2000
-
-  USE ioipsl
-
-  IMPLICIT none
-
-  PRIVATE
-  PUBLIC :: interfsurf,interfsurf_hq 
-
-  INTERFACE interfsurf
-    module procedure interfsurf_hq, interfsurf_vent
-  END INTERFACE
-
-  INTERFACE interfoce
-    module procedure interfoce_cpl, interfoce_slab, interfoce_lim
-  END INTERFACE
-
-#include "YOMCST.inc"
-#include "indicesol.inc"
-
-
-! run_off      ruissellement total
-  real, allocatable, dimension(:),save    :: run_off
-
-
-  CONTAINS
-!
-!############################################################################
-!
-  SUBROUTINE interfsurf_hq(itime, dtime, jour, &
-      & klon, nisurf, knon, knindex, rlon, rlat, &
-      & debut, lafin, ok_veget, &
-      & zlev, zlflu, u1_lay, v1_lay, temp_air, spechum, hum_air, ccanopy, & 
-      & tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
-      & precip_rain, precip_snow, lwdown, swnet, swdown, &
-      & tsurf, p1lay, cal, beta, coef1lay, ps, radsol, dif_grnd, &
-      & ocean, &
-      & evap, fluxsens, fluxlat, dflux_l, dflux_s, &              
-      & tsol_rad, tsurf_new, alb_new, emis_new, z0_new, pctsrf_new)
-
-
-! Cette routine sert d'aiguillage entre l'atmosphere et la surface en general 
-! (sols continentaux, oceans, glaces) pour les fluxs de chaleur et d'humidite.
-! En pratique l'interface se fait entre la couche limite du modele 
-! atmospherique (clmain.F) et les routines de surface (sechiba, oasis, ...)
-!
-! 
-! L.Fairhead 02/2000
-!
-! input:
-!   itime        numero du pas de temps
-!   klon         nombre total de points de grille
-!   dtime        pas de temps de la physique (en s)
-!   jour         jour dans l'annee en cours
-!   nisurf       index de la surface a traiter (1 = sol continental)
-!   knon         nombre de points de la surface a traiter
-!   knindex      index des points de la surface a traiter
-!   rlon         longitudes
-!   rlat         latitudes
-!   debut        logical: 1er appel a la physique
-!   lafin        logical: dernier appel a la physique
-!   ok_veget     logical: appel ou non au schema de surface continental
-!                     (si false calcul simplifie des fluxs sur les continents)
-!   zlev         hauteur de la premiere couche
-!   zlflu        epaisseur de la premier couche
-!   u1_lay       vitesse u 1ere couche
-!   v1_lay       vitesse v 1ere couche
-!   temp_air     temperature de l'air 1ere couche
-!   spechum      humidite specifique 1ere couche
-!   hum_air      humidite de l'air
-!   ccanopy      concentration CO2 canopee
-!   tq_cdrag     cdrag
-!   petAcoef     coeff. A de la resolution de la CL pour t
-!   peqAcoef     coeff. A de la resolution de la CL pour q
-!   petBcoef     coeff. B de la resolution de la CL pour t
-!   peqBcoef     coeff. B de la resolution de la CL pour q
-!   precip_rain  precipitation liquide
-!   precip_snow  precipitation solide
-!   lwdown       flux IR entrant a la surface
-!   swnet        flux solaire net
-!   swdown       flux solaire entrant a la surface
-!   tsurf        temperature de surface
-!   p1lay        pression 1er niveau (milieu de couche)
-!   cal          capacite calorifique du sol
-!   beta         evap reelle
-!   coef1lay     coefficient d'echange
-!   ps           pression au sol
-!   radsol       rayonnement net aus sol (LW + SW)
-!   dif_grnd     coeff. diffusion vers le sol profond
-!   ocean        type d'ocean utilise (force, slab, couple)
-!
-! output:
-!   evap         evaporation totale
-!   fluxsens     flux de chaleur sensible
-!   fluxlat      flux de chaleur latente
-!   tsol_rad     
-!   tsurf_new    temperature au sol
-!   alb_new      albedo
-!   emis_new     emissivite
-!   z0_new       surface roughness
-
-
-! Parametres d'entree
-  integer, intent(IN) :: itime
-  integer, intent(IN) :: klon
-  real, intent(IN) :: dtime
-  integer, intent(IN) :: jour
-  integer, intent(IN) :: nisurf
-  integer, intent(IN) :: knon
-  integer, dimension(knon), intent(in) :: knindex
-  logical, intent(IN) :: debut, lafin, ok_veget
-  real, dimension(klon), intent(IN) :: rlon, rlat
-  real, dimension(knon), intent(IN) :: zlev, zlflu
-  real, dimension(knon), intent(IN) :: u1_lay, v1_lay
-  real, dimension(knon), intent(IN) :: temp_air, spechum
-  real, dimension(knon), intent(IN) :: hum_air, ccanopy
-  real, dimension(knon), intent(IN) :: tq_cdrag, petAcoef, peqAcoef
-  real, dimension(knon), intent(IN) :: petBcoef, peqBcoef
-  real, dimension(knon), intent(IN) :: precip_rain, precip_snow
-  real, dimension(knon), intent(IN) :: lwdown, swnet, swdown, ps
-  real, dimension(knon), intent(IN) :: tsurf, p1lay, cal, beta, coef1lay
-  real, dimension(knon), intent(IN) :: radsol, dif_grnd
-  character (len = 6)  :: ocean
-
-! Parametres de sortie
-  real, dimension(knon), intent(OUT):: evap, fluxsens, fluxlat
-  real, dimension(knon), intent(OUT):: tsol_rad, tsurf_new, alb_new
-  real, dimension(knon), intent(OUT):: emis_new, z0_new
-  real, dimension(knon), intent(OUT):: dflux_l, dflux_s
-  real, dimension(klon,nbsrf), intent(OUT) :: pctsrf_new
-
-! Local
-  character (len = 20) :: modname = 'interfsurf_hq'
-  character (len = 80) :: abort_message 
-  logical, save        :: first_call = .true.
-  integer              :: error
-  logical              :: check = .true.
-
-  if (check) write(*,*) 'Entree ', modname
-!
-! On doit commencer par appeler les schemas de surfaces continentales
-! car l'ocean a besoin du ruissellement qui est y calcule
-!
-  if (first_call) then
-    if (nisurf /= is_ter .and. klon > 1) then 
-      write(*,*)' *** Warning ***'
-      write(*,*)' nisurf = ',nisurf,' /= is_ter = ',is_ter
-      write(*,*)'or on doit commencer par les surfaces continentales'
-      abort_message='voir ci-dessus'
-      call abort_gcm(modname,abort_message,1)
-    endif
-    if (ocean /= 'slab  ' .and. ocean /= 'force ' .and. ocean /= 'couple') then
-      write(*,*)' *** Warning ***'
-      write(*,*)'Option couplage pour l''ocean = ', ocean
-      abort_message='option pour l''ocean non valable'
-      call abort_gcm(modname,abort_message,1)
-    endif
-  endif
-  first_call = .false.
-
-! Aiguillage vers les differents schemas de surface
-
-  if (nisurf == is_ter) then
-!
-! Surface "terre" appel a l'interface avec les sols continentaux
-!
-! allocation du run-off
-    if (.not. allocated(run_off)) then
-      allocate(run_off(knon), stat = error)
-      if (error /= 0) then
-        abort_message='Pb allocation run_off'
-        call abort_gcm(modname,abort_message,1)
-      endif
-    else if (size(run_off) /= knon) then
-      write(*,*)'Bizarre, le nombre de points continentaux'
-      write(*,*)'a change entre deux appels. Je continue ...'
-      deallocate(run_off, stat = error)
-      allocate(run_off(knon), stat = error)
-      if (error /= 0) then
-        abort_message='Pb allocation run_off'
-        call abort_gcm(modname,abort_message,1)
-      endif
-    endif
-!
-    call interfsol(itime, klon, dtime, nisurf, knon, &
-     &  knindex, rlon, rlat, &
-     &  debut, lafin, ok_veget, &
-     &  zlev, zlflu, u1_lay, v1_lay, temp_air, spechum, hum_air, ccanopy, & 
-     &  tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
-     &  precip_rain, precip_snow, lwdown, swnet, swdown, &
-     &  tsurf, p1lay, cal, beta, coef1lay, ps, radsol, dif_grnd, &
-     &  evap, fluxsens, fluxlat, &              
-     &  tsol_rad, tsurf_new, alb_new, emis_new, z0_new, dflux_l, dflux_s)
-      
-!
-  else if (nisurf == is_oce) then
-
-    if (check) write(*,*)'ocean, nisurf = ',nisurf 
-!
-! Surface "ocean" appel a l'interface avec l'ocean
-!
-!    if (ocean == 'couple') then
-!      call interfoce(nisurf, ocean)
-!    else if (ocean == 'slab  ') then
-!      call interfoce(nisurf)
-!    else                              ! lecture conditions limites
-!      call interfoce(itime, dtime, jour, & 
-!     &  klon, nisurf, knon, knindex, &
-!     &  debut, &
-!     &  tsurf_new, alb_new, z0_new, pctsrf_new)
-!    endif
-!
-    call calcul_fluxs( knon, dtime, &
-     &   tsurf, p1lay, cal, beta, coef1lay, ps, &
-     &   radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
-     &   petAcoef, peqAcoef, petBcoef, peqBcoef, &
-     &   tsurf_new, fluxlat, fluxsens, dflux_s, dflux_l)
-!
-  else if (nisurf == is_sic) then
-
-    if (check) write(*,*)'sea ice, nisurf = ',nisurf 
-
-!
-! Surface "glace de mer" appel a l'interface avec l'ocean
-!
-!    call interfoce(nisurf, ocean)
-!
-    call calcul_fluxs( knon, dtime, &
-     &   tsurf, p1lay, cal, beta, coef1lay, ps, &
-     &   radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
-     &   petAcoef, peqAcoef, petBcoef, peqBcoef, &
-     &   tsurf_new, fluxlat, fluxsens, dflux_s, dflux_l)
-
-  else if (nisurf == is_lic) then
-
-    if (check) write(*,*)'glacier, nisurf = ',nisurf 
-
-!
-! Surface "glacier continentaux" appel a l'interface avec le sol
-!
-!    call interfsol(nisurf)
-    call calcul_fluxs( knon, dtime, &
-     &   tsurf, p1lay, cal, beta, coef1lay, ps, &
-     &   radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
-     &   petAcoef, peqAcoef, petBcoef, peqBcoef, &
-     &   tsurf_new, fluxlat, fluxsens, dflux_s, dflux_l)
-
-  else
-    write(*,*)'Index surface = ',nisurf
-    abort_message = 'Index surface non valable'
-    call abort_gcm(modname,abort_message,1)
-  endif
-
-  END SUBROUTINE interfsurf_hq
-
-!
-!#########################################################################
-!
-  SUBROUTINE interfsurf_vent(nisurf, knon   &         
-  &                     )
-!
-! Cette routine sert d'aiguillage entre l'atmosphere et la surface en general 
-! (sols continentaux, oceans, glaces) pour les tensions de vents.
-! En pratique l'interface se fait entre la couche limite du modele 
-! atmospherique (clmain.F) et les routines de surface (sechiba, oasis, ...)
-!
-! 
-! L.Fairhead 02/2000
-!
-! input:
-!   nisurf       index de la surface a traiter (1 = sol continental)
-!   knon         nombre de points de la surface a traiter
-
-! Parametres d'entree
-  integer, intent(IN) :: nisurf
-  integer, intent(IN) :: knon
-
-
-  return
-  END SUBROUTINE interfsurf_vent
-!
-!#########################################################################
-!
-  SUBROUTINE interfsol(itime, klon, dtime, nisurf, knon, &
-     & knindex, rlon, rlat, &
-     & debut, lafin, ok_veget, &
-     & zlev, zlflu, u1_lay, v1_lay, temp_air, spechum, hum_air, ccanopy, & 
-     & tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
-     & precip_rain, precip_snow, lwdown, swnet, swdown, &
-     & tsurf, p1lay, cal, beta, coef1lay, ps, radsol, dif_grnd, &
-     & evap, fluxsens, fluxlat, &              
-     & tsol_rad, tsurf_new, alb_new, emis_new, z0_new, dflux_l, dflux_s)
-
-! Cette routine sert d'interface entre le modele atmospherique et le 
-! modele de sol continental. Appel a sechiba
-!
-! L. Fairhead 02/2000
-!
-! input:
-!   itime        numero du pas de temps
-!   klon         nombre total de points de grille
-!   dtime        pas de temps de la physique (en s)
-!   nisurf       index de la surface a traiter (1 = sol continental)
-!   knon         nombre de points de la surface a traiter
-!   knindex      index des points de la surface a traiter
-!   rlon         longitudes de la grille entiere
-!   rlat         latitudes de la grille entiere
-!   debut        logical: 1er appel a la physique (lire les restart)
-!   lafin        logical: dernier appel a la physique (ecrire les restart)
-!   ok_veget     logical: appel ou non au schema de surface continental
-!                     (si false calcul simplifie des fluxs sur les continents)
-!   zlev         hauteur de la premiere couche
-!   zlflu        
-!   u1_lay       vitesse u 1ere couche
-!   v1_lay       vitesse v 1ere couche
-!   temp_air     temperature de l'air 1ere couche
-!   spechum      humidite specifique 1ere couche
-!   hum_air      humidite de l'air
-!   ccanopy      concentration CO2 canopee
-!   tq_cdrag     cdrag
-!   petAcoef     coeff. A de la resolution de la CL pour t
-!   peqAcoef     coeff. A de la resolution de la CL pour q
-!   petBcoef     coeff. B de la resolution de la CL pour t
-!   peqBcoef     coeff. B de la resolution de la CL pour q
-!   precip_rain  precipitation liquide
-!   precip_snow  precipitation solide
-!   lwdown       flux IR entrant a la surface
-!   swnet        flux solaire net
-!   swdown       flux solaire entrant a la surface
-!   tsurf        temperature de surface
-!   p1lay        pression 1er niveau (milieu de couche)
-!   cal          capacite calorifique du sol
-!   beta         evap reelle
-!   coef1lay     coefficient d'echange
-!   ps           pression au sol
-!   radsol       rayonnement net aus sol (LW + SW)
-!   dif_grnd     coeff. diffusion vers le sol profond      
-!   
-!
-! input/output
-!   run_off      ruissellement total
-!
-! output:
-!   evap         evaporation totale
-!   fluxsens     flux de chaleur sensible
-!   fluxlat      flux de chaleur latente
-!   tsol_rad     
-!   tsurf_new    temperature au sol
-!   alb_new      albedo
-!   emis_new     emissivite
-!   z0_new       surface roughness
-
-! Parametres d'entree
-  integer, intent(IN) :: itime
-  integer, intent(IN) :: klon
-  real, intent(IN)    :: dtime
-  integer, intent(IN) :: nisurf
-  integer, intent(IN) :: knon
-  integer, dimension(knon), intent(IN) :: knindex
-  logical, intent(IN) :: debut, lafin, ok_veget
-  real, dimension(klon), intent(IN) :: rlon, rlat
-  real, dimension(knon), intent(IN) :: zlev, zlflu
-  real, dimension(knon), intent(IN) :: u1_lay, v1_lay
-  real, dimension(knon), intent(IN) :: temp_air, spechum
-  real, dimension(knon), intent(IN) :: hum_air, ccanopy
-  real, dimension(knon), intent(IN) :: tq_cdrag, petAcoef, peqAcoef
-  real, dimension(knon), intent(IN) :: petBcoef, peqBcoef
-  real, dimension(knon), intent(IN) :: precip_rain, precip_snow
-  real, dimension(knon), intent(IN) :: lwdown, swnet, swdown, ps
-  real, dimension(knon), intent(IN) :: tsurf, p1lay, cal, beta, coef1lay
-  real, dimension(knon), intent(IN) :: radsol, dif_grnd
-! Parametres de sortie
-  real, dimension(knon), intent(OUT):: evap, fluxsens, fluxlat
-  real, dimension(knon), intent(OUT):: tsol_rad, tsurf_new, alb_new
-  real, dimension(knon), intent(OUT):: emis_new, z0_new
-  real, dimension(knon), intent(OUT):: dflux_s, dflux_l
-
-! Local
-!
-  integer              :: ii
-  integer              :: error
-  character (len = 20) :: modname = 'interfsol'
-  character (len = 80) :: abort_message
-  logical              :: check = .true.
-! type de couplage dans sechiba
-!  character (len=10)   :: coupling = 'implicit' 
-! drapeaux controlant les appels dans SECHIBA
-!  type(control_type), save   :: control_in
-! coordonnees geographiques
-  real, allocatable, dimension(:,:), save :: lalo
-! pts voisins
-  integer,allocatable, dimension(:,:), save :: neighbours
-! resolution de la grille
-  real, allocatable, dimension (:,:), save :: resolution
-! Identifieurs des fichiers restart et histoire
-  integer, save          :: rest_id, hist_id 
-  integer, save          :: rest_id_stom, hist_id_stom
-
-  if (check) write(*,*)'Entree ', modname
-  if (check) write(*,*)'ok_veget = ',ok_veget
-
-! initialisation
-  if (.not. ok_veget) then
-    call calcul_fluxs( knon, dtime, &
-     &   tsurf, p1lay, cal, beta, coef1lay, ps, &
-     &   radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
-     &   petAcoef, peqAcoef, petBcoef, peqBcoef, &
-     &   tsurf_new, fluxlat, fluxsens, dflux_s, dflux_l)
-  else
-!    if (debut) then
-!      !
-!      ! Configuration de parametres specifiques a la SSL
-!      !
-!      call intsurf_config(control_in)
-!      !
-!      ! Allouer et initialiser le tableau de coordonnees du sol
-!      !
-!      if (( .not. allocated(lalo))) then
-!        allocate(lalo(knon,2), stat = error)
-!        if (error /= 0) then
-!          abort_message='Pb allocation lalo'
-!          call abort_gcm(modname,abort_message,1)
-!        endif      
-!      endif
-!      do ii = 1, knon
-!        lalo(ii,1) = rlat(knindex(ii))
-!        lalo(ii,2) = rlon(knindex(ii))
-!      enddo
-      !-
-      !- Compute variable to help describe the grid
-      !- once the points are gathered.
-      !-
-!      IF ( (.NOT.ALLOCATED(neighbours))) THEN
-!        ALLOCATE(neighbours(knon,4), stat = error)
-!        if (error /= 0) then
-!          abort_message='Pb allocation neighbours'
-!          call abort_gcm(modname,abort_message,1)
-!        endif
-!      ENDIF
-!      IF ( (.NOT.ALLOCATED(resolution))) THEN
-!        ALLOCATE(resolution(knon,2), stat = error)
-!        if (error /= 0) then
-!          abort_message='Pb allocation resolution'
-!          call abort_gcm(modname,abort_message,1)
-!        endif
-!      ENDIF
-
-! call grid_stuff
-! call sechiba_restart_init
-! call sechiba_history_init
-
-!    endif                          ! (fin debut) 
-
-! 
-! Appel a la routine sols continentaux
-!
-
-!    call sechiba_main(itime, klon, knon, knindex, dtime, &
-!     & debut, lafin, coupling, control_in, &
-!     & lalo, neighbours, resolution,&
-!     & zlev, zlflu, u1_lay, v1_lay, spechum, temp_air,hum_air , ccanopy, &
-!     & tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
-!     & precip_rain, precip_snow, lwdown, swnet, swdown, ps, &
-!     & evap, fluxsens, fluxlat, &
-!     & tsol_rad, tsurf_new, alb_new, emis_new, z0_new, &
-!     & rest_id, hist_id, rest_id_stom, hist_id_stom)
-
-!
-! Sauvegarde dans fichiers histoire
-!
-  endif  ! fin ok_veget
-
-  END SUBROUTINE interfsol
-!
-!#########################################################################
-!
-  SUBROUTINE interfoce_cpl(nisurf, ocean)
-
-! Cette routine sert d'interface entre le modele atmospherique et un 
-! coupleur avec un modele d'ocean 'complet'
-!
-! L. Fairhead 02/2000
-!
-! input:
-!   nisurf       index de la surface a traiter (1 = sol continental)
-!   ocean        type d'ocean
-!
-! output:
-!
-
-! Parametres d'entree
-  integer, intent(IN) :: nisurf
-  character (len = 6)  :: ocean
-
-! Parametres de sortie
-
-! Variables locales
-
-
-! Initialisation
-! fichier restart et fichiers histoires
-
-! calcul des fluxs a passer
-
-  END SUBROUTINE interfoce_cpl
-!
-!#########################################################################
-!
-  SUBROUTINE interfoce_slab(nisurf)
-
-! Cette routine sert d'interface entre le modele atmospherique et un 
-! modele de 'slab' ocean
-!
-! L. Fairhead 02/2000
-!
-! input:
-!   nisurf       index de la surface a traiter (1 = sol continental)
-!
-! output:
-!
-
-! Parametres d'entree
-  integer, intent(IN) :: nisurf
-
-  END SUBROUTINE interfoce_slab
-!
-!#########################################################################
-!
-  SUBROUTINE interfoce_lim(itime, dtime, jour, &
-     & klon, nisurf, knon, knindex, &
-     & debut,  &
-     & lmt_sst, lmt_alb, lmt_rug, pctsrf_new)
-
-! Cette routine sert d'interface entre le modele atmospherique et un fichier
-! de conditions aux limites
-!
-! L. Fairhead 02/2000
-!
-! input:
-!   itime        numero du pas de temps courant
-!   dtime        pas de temps de la physique (en s)
-!   jour         jour a lire dans l'annee
-!   nisurf       index de la surface a traiter (1 = sol continental)
-!   knon         nombre de points dans le domaine a traiter
-!   knindex      index des points de la surface a traiter
-!   klon         taille de la grille
-!   debut        logical: 1er appel a la physique (initialisation)
-!
-! output:
-!   lmt_sst      SST lues dans le fichier de CL
-!   lmt_alb      Albedo lu 
-!   lmt_rug      longueur de rugosité lue
-!   pctsrf_new   sous-maille fractionnelle
-!
-
-
-! Parametres d'entree
-  integer, intent(IN) :: itime
-  real   , intent(IN) :: dtime
-  integer, intent(IN) :: jour
-  integer, intent(IN) :: nisurf
-  integer, intent(IN) :: knon
-  integer, intent(IN) :: klon
-  integer, dimension(knon), intent(in) :: knindex
-  logical, intent(IN) :: debut
-
-! Parametres de sortie
-  real, intent(out), dimension(knon) :: lmt_sst
-  real, intent(out), dimension(knon) :: lmt_alb
-  real, intent(out), dimension(knon) :: lmt_rug
-  real, intent(out), dimension(klon,nbsrf) :: pctsrf_new
-
-! Variables locales
-  integer     :: ii
-  integer     :: lmt_pas     ! frequence de lecture des conditions limites 
-                             ! (en pas de physique)
-  logical,save :: deja_lu    ! pour indiquer que le jour a lire a deja
-                             ! lu pour une surface precedente
-  integer,save :: jour_lu 
-  integer      :: ierr
-  character (len = 20) :: modname = 'interfoce_lim'
-  character (len = 80) :: abort_message
-  character (len = 20) :: fich ='limit'
-  logical     :: newlmt = .false.
-  logical     :: check = .true.
-! Champs lus dans le fichier de CL
-  real, allocatable , save, dimension(:) :: sst_lu, alb_lu, rug_lu, nat_lu
-  real, allocatable , save, dimension(:,:) :: pct_tmp
-!
-! quelques variables pour netcdf
-!
-#include "netcdf.inc"
-  integer              :: nid, nvarid
-  integer, dimension(2) :: start, epais
-!
-! Fin déclaration
-!
-    
-  if (debut) then
-    lmt_pas = nint(86400./dtime * 1.0) ! pour une lecture une fois par jour
-    jour_lu = jour - 1
-    allocate(sst_lu(klon))
-    allocate(alb_lu(klon))
-    allocate(rug_lu(klon))
-    allocate(nat_lu(klon))
-    allocate(pct_tmp(klon,nbsrf))
-  endif
-
-  if ((jour - jour_lu) /= 0) deja_lu = .false.
-  
-  if (check) write(*,*)modname,' :: jour_lu, deja_lu', jour_lu, deja_lu 
-
-! Tester d'abord si c'est le moment de lire le fichier
-  if (mod(itime-1, lmt_pas) == 0 .and. .not. deja_lu) then
-!
-! Ouverture du fichier
-!
-    ierr = NF_OPEN (fich, NF_NOWRITE,nid)
-    if (ierr.NE.NF_NOERR) then
-      abort_message = 'Pb d''ouverture du fichier de conditions aux limites'
-      call abort_gcm(modname,abort_message,1)
-    endif
-! 
-! La tranche de donnees a lire:
-!
-    start(1) = 1
-    start(2) = jour + 1
-    epais(1) = klon
-    epais(2) = 1
-!
-    if (newlmt) then
-!
-! Fraction "ocean" 
-!
-      ierr = NF_INQ_VARID(nid, 'FOCE', nvarid)
-      if (ierr /= NF_NOERR) then
-        abort_message = 'Le champ <FOCE> est absent'
-        call abort_gcm(modname,abort_message,1)
-      endif
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pctsrf_new(1,is_oce))
-#else
-      ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pctsrf_new(1,is_oce))
-#endif
-      if (ierr /= NF_NOERR) then
-        abort_message = 'Lecture echouee pour <FOCE>'
-        call abort_gcm(modname,abort_message,1)
-      endif
-!
-! Fraction "glace de mer" 
-!
-      ierr = NF_INQ_VARID(nid, 'FSIC', nvarid)
-      if (ierr /= NF_NOERR) then
-        abort_message = 'Le champ <FSIC> est absent'
-        call abort_gcm(modname,abort_message,1)
-      endif
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pctsrf_new(1,is_sic))
-#else
-      ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pctsrf_new(1,is_sic))
-#endif
-      if (ierr /= NF_NOERR) then
-        abort_message = 'Lecture echouee pour <FSIC>'
-        call abort_gcm(modname,abort_message,1)
-      endif
-!
-! Fraction "terre" 
-!
-      ierr = NF_INQ_VARID(nid, 'FTER', nvarid)
-      if (ierr /= NF_NOERR) then
-        abort_message = 'Le champ <FTER> est absent'
-        call abort_gcm(modname,abort_message,1)
-      endif
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pctsrf_new(1,is_ter))
-#else
-      ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pctsrf_new(1,is_ter))
-#endif
-      if (ierr /= NF_NOERR) then
-        abort_message = 'Lecture echouee pour <FTER>'
-        call abort_gcm(modname,abort_message,1)
-      endif
-!
-! Fraction "glacier terre" 
-!
-      ierr = NF_INQ_VARID(nid, 'FLIC', nvarid)
-      if (ierr /= NF_NOERR) then
-        abort_message = 'Le champ <FLIC> est absent'
-        call abort_gcm(modname,abort_message,1)
-      endif
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pctsrf_new(1,is_lic))
-#else
-      ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pctsrf_new(1,is_lic))
-#endif
-      if (ierr /= NF_NOERR) then
-        abort_message = 'Lecture echouee pour <FLIC>'
-        call abort_gcm(modname,abort_message,1)
-      endif
-!
-    else  ! on en est toujours a rnatur
-! 
-      ierr = NF_INQ_VARID(nid, 'NAT', nvarid)
-      if (ierr /= NF_NOERR) then
-        abort_message = 'Le champ <NAT> est absent'
-        call abort_gcm(modname,abort_message,1)
-      endif
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais, nat_lu)
-#else
-      ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais, nat_lu)
-#endif
-      if (ierr /= NF_NOERR) then
-        abort_message = 'Lecture echouee pour <NAT>'
-        call abort_gcm(modname,abort_message,1)
-      endif
-!
-! Remplissage des fractions de surface
-! nat = 0, 1, 2, 3 pour ocean, terre, glacier, seaice
-! 
-      pct_tmp = 0.0
-      do ii = 1, klon
-        pct_tmp(ii,nint(nat_lu(ii)) + 1) = 1.
-      enddo
-
-!
-!  On se retrouve avec ocean en 1 et terre en 2 alors qu'on veut le contraire
-!
-      pctsrf_new = pct_tmp
-      pctsrf_new (:,2)= pct_tmp (:,1)
-      pctsrf_new (:,1)= pct_tmp (:,2)
-      pct_tmp = pctsrf_new 
-    endif ! fin test sur newlmt
-!
-! Lecture SST
-!
-    ierr = NF_INQ_VARID(nid, 'SST', nvarid)
-    if (ierr /= NF_NOERR) then
-      abort_message = 'Le champ <SST> est absent'
-      call abort_gcm(modname,abort_message,1)
-    endif
-#ifdef NC_DOUBLE
-    ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais, sst_lu)
-#else
-    ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais, sst_lu)
-#endif
-    if (ierr /= NF_NOERR) then
-      abort_message = 'Lecture echouee pour <SST>'
-      call abort_gcm(modname,abort_message,1)
-    endif    
-!
-! Lecture Albedo
-!
-    ierr = NF_INQ_VARID(nid, 'ALB', nvarid)
-    if (ierr /= NF_NOERR) then
-      abort_message = 'Le champ <ALB> est absent'
-      call abort_gcm(modname,abort_message,1)
-    endif
-#ifdef NC_DOUBLE
-    ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais, alb_lu)
-#else
-    ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais, alb_lu)
-#endif
-    if (ierr /= NF_NOERR) then
-      abort_message = 'Lecture echouee pour <ALB>'
-      call abort_gcm(modname,abort_message,1)
-    endif
-!
-! Lecture rugosité
-!
-    ierr = NF_INQ_VARID(nid, 'RUG', nvarid)
-    if (ierr /= NF_NOERR) then
-      abort_message = 'Le champ <RUG> est absent'
-      call abort_gcm(modname,abort_message,1)
-    endif
-#ifdef NC_DOUBLE
-    ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais, rug_lu)
-#else
-    ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais, rug_lu)
-#endif
-    if (ierr /= NF_NOERR) then
-      abort_message = 'Lecture echouee pour <RUG>'
-      call abort_gcm(modname,abort_message,1)
-    endif
-
-!
-! Fin de lecture
-!
-    ierr = NF_CLOSE(nid)
-    deja_lu = .true.
-    jour_lu = jour
-  endif
-!
-! Recopie des variables dans les champs de sortie
-!
-  do ii = 1, knon
-    lmt_sst(ii) = sst_lu(knindex(ii))
-    lmt_alb(ii) = alb_lu(knindex(ii))
-    lmt_rug(ii) = rug_lu(knindex(ii))
-  enddo
-  pctsrf_new = pct_tmp
-
-  END SUBROUTINE interfoce_lim
-
-!
-!#########################################################################
-!
-
-  SUBROUTINE calcul_fluxs( knon, dtime, &
-     & tsurf, p1lay, cal, beta, coef1lay, ps, &
-     & radsol, dif_grnd, t1lay, q1lay, u1lay, v1lay, &
-     & petAcoef, peqAcoef, petBcoef, peqBcoef, &
-     & tsurf_new, fluxlat, fluxsens, dflux_s, dflux_l)
-
-! Cette routine calcule les fluxs en h et q a l'interface et eventuellement
-! une temperature de surface (au cas ou ok_veget = false)
-!
-! L. Fairhead 4/2000
-!
-! input:
-!   knon         nombre de points a traiter
-!   tsurf        temperature de surface
-!   p1lay        pression 1er niveau (milieu de couche)
-!   cal          capacite calorifique du sol
-!   beta         evap reelle
-!   coef1lay     coefficient d'echange
-!   ps           pression au sol
-!   petAcoef     coeff. A de la resolution de la CL pour t
-!   peqAcoef     coeff. A de la resolution de la CL pour q
-!   petBcoef     coeff. B de la resolution de la CL pour t
-!   peqBcoef     coeff. B de la resolution de la CL pour q
-!   radsol       rayonnement net aus sol (LW + SW)
-!   dif_grnd     coeff. diffusion vers le sol profond
-!
-! output:
-!   tsurf_new    temperature au sol
-!   fluxsens     flux de chaleur sensible
-!   fluxlat      flux de chaleur latente
-!   dflux_s      derivee du flux de chaleur sensible / Ts
-!   dflux_l      derivee du flux de chaleur latente  / Ts
-!
-
-#include "YOMCST.inc"
-#include "YOETHF.inc"
-#include "FCTTRE.inc"
-
-! Parametres d'entree
-  integer, intent(IN) :: knon
-  real   , intent(IN) :: dtime
-  real, dimension(knon), intent(IN) :: petAcoef, peqAcoef
-  real, dimension(knon), intent(IN) :: petBcoef, peqBcoef
-  real, dimension(knon), intent(IN) :: ps, q1lay
-  real, dimension(knon), intent(IN) :: tsurf, p1lay, cal, beta, coef1lay
-  real, dimension(knon), intent(IN) :: radsol, dif_grnd
-  real, dimension(knon), intent(IN) :: t1lay, u1lay, v1lay
-
-! Parametres sorties
-  real, dimension(knon), intent(OUT):: tsurf_new, fluxlat, fluxsens
-  real, dimension(knon), intent(OUT):: dflux_s, dflux_l
-
-! Variables locales
-  integer :: i
-  real, dimension(knon) :: zx_mh, zx_nh, zx_oh
-  real, dimension(knon) :: zx_mq, zx_nq, zx_oq
-  real, dimension(knon) :: zx_pkh, zx_dq_s_dt, zx_qsat, zx_coef
-  real, dimension(knon) :: zx_sl, zx_k1,  zx_dq,  zx_cq,  zx_dh, zx_ch
-  real, dimension(knon) :: zx_h_ts, zx_q_0 , d_ts
-  real                  :: zdelta, zcvm5, zx_qs, zcor, zx_dq_s_dh
-  real, parameter :: t_grnd = 271.35, t_coup = 273.15
-  logical         :: check = .true.
-  character (len = 20)  :: modname = 'calcul_fluxs'
-
-  if (check) write(*,*)'Entree ', modname
-! 
-! Initialisation
-!
-!
-! zx_qs = qsat en kg/kg
-!
-  DO i = 1, knon
-    zx_pkh(i) = (ps(i)/ps(i))**RKAPPA
-  IF (thermcep) THEN
-      zdelta=MAX(0.,SIGN(1.,rtt-tsurf(i)))
-      zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
-      zcvm5 = zcvm5 / RCPD / (1.0+RVTMP2*q1lay(i))
-      zx_qs= r2es * FOEEW(tsurf(i),zdelta)/ps(i)
-      zx_qs=MIN(0.5,zx_qs)
-      zcor=1./(1.-retv*zx_qs)
-      zx_qs=zx_qs*zcor
-      zx_dq_s_dh = FOEDE(tsurf(i),zdelta,zcvm5,zx_qs,zcor) &
-     &                 /RLVTT / zx_pkh(i)
-    ELSE
-      IF (tsurf(i).LT.t_coup) THEN
-        zx_qs = qsats(tsurf(i)) / ps(i)
-        zx_dq_s_dh = dqsats(tsurf(i),zx_qs)/RLVTT &
-     &                    / zx_pkh(i)
-      ELSE
-        zx_qs = qsatl(tsurf(i)) / ps(i)
-        zx_dq_s_dh = dqsatl(tsurf(i),zx_qs)/RLVTT &
-     &               / zx_pkh(i)
-      ENDIF
-    ENDIF
-    zx_dq_s_dt(i) = RCPD * zx_pkh(i) * zx_dq_s_dh
-    zx_qsat(i) = zx_qs
-    zx_coef(i) = coef1lay(i) &
-     & * (1.0+SQRT(u1lay(i)**2+v1lay(i)**2)) &
-     & * p1lay(i)/(RD*t1lay(i))
-    
-  ENDDO
-
-
-! === Calcul de la temperature de surface ===
-! 
-! zx_sl = chaleur latente d'evaporation ou de sublimation
-!
-  do i = 1, knon
-    zx_sl(i) = RLVTT
-    if (tsurf(i) .LT. RTT) zx_sl(i) = RLSTT
-    zx_k1(i) = zx_coef(i)
-  enddo
-
-
-  do i = 1, knon
-! Q
-    zx_oq(i) = 1. - (beta(i) * zx_k1(i) * peqBcoef(i) * dtime)
-    zx_mq(i) = beta(i) * zx_k1(i) * &
-     &             (peqAcoef(i) - zx_qsat(i) &
-     &                          + zx_dq_s_dt(i) * tsurf(i)) &
-     &             / zx_oq(i)
-    zx_nq(i) = beta(i) * zx_k1(i) * (-1. * zx_dq_s_dt(i)) &
-     &                              / zx_oq(i)
-
-! H
-    zx_oh(i) = 1. - (zx_k1(i) * petBcoef(i) * dtime)
-    zx_mh(i) = zx_k1(i) * petAcoef(i) / zx_oh(i)
-    zx_nh(i) = - (zx_k1(i) * RCPD * zx_pkh(i))/ zx_oh(i)
-
-! Tsurface
-    tsurf_new(i) = (tsurf(i) + cal(i)/(RCPD * zx_pkh(i)) * dtime * &
-     &             (radsol(i) + zx_mh(i) + zx_sl(i) * zx_mq(i)) & 
-     &                 + dif_grnd(i) * t_grnd * dtime)/ &
-     &          ( 1. - dtime * cal(i)/(RCPD * zx_pkh(i)) * ( &
-     &                       zx_nh(i) + zx_sl(i) * zx_nq(i)) &  
-     &                     + dtime * dif_grnd(i))
-    zx_h_ts(i) = tsurf_new(i) * RCPD * zx_pkh(i)
-    d_ts(i) = tsurf_new(i) - tsurf(i)
-    zx_q_0(i) = zx_qsat(i) + zx_dq_s_dt(i) * d_ts(i)
-!== flux_q est le flux de vapeur d'eau: kg/(m**2 s)  positive vers bas
-!== flux_t est le flux de cpt (energie sensible): j/(m**2 s)
-    fluxlat(i) = zx_mq(i) + zx_nq(i) * tsurf_new(i) 
-    fluxsens(i) = zx_mh(i) + zx_nh(i) * tsurf_new(i)
-! Derives des flux dF/dTs (W m-2 K-1):
-    dflux_s(i) = zx_nh(i)
-    dflux_l(i) = (zx_sl(i) * zx_nq(i))
-  ENDDO
-
-  END SUBROUTINE calcul_fluxs
-!
-!#########################################################################
-!
-
-  END MODULE interface_surf
Index: LMDZ.3.3/branches/rel-/libf/phylmd/minmaxqfi.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/minmaxqfi.F	(revision 416)
+++ 	(revision )
@@ -1,30 +1,0 @@
-      SUBROUTINE minmaxqfi(zq,qmin,qmax,comment)
-      IMPLICIT none
-
-#include "dimensions.h"
-#include "dimphy.h"
-
-      CHARACTER*(*) comment
-      real qmin,qmax
-      real zq(klon,klev)
-
-      INTEGER jadrs(klon), jbad, k, i
-
-      DO k = 1, klev
-         jbad = 0
-         DO i = 1, klon
-         IF (zq(i,k).GT.qmax .OR. zq(i,k).LT.qmin) THEN
-            jbad = jbad + 1
-            jadrs(jbad) = i
-         ENDIF
-         ENDDO
-         IF (jbad.GT.0) THEN
-         PRINT*, comment
-         DO i = 1, jbad
-            PRINT*, "i,k,q=", jadrs(i),k,zq(jadrs(i),k)
-         ENDDO
-         ENDIF
-      ENDDO
-
-      return
-      end
Index: LMDZ.3.3/branches/rel-/libf/phylmd/mpiclim.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/mpiclim.h	(revision 416)
+++ 	(revision )
@@ -1,21 +1,0 @@
-C
-C -- mpiclim.h  26-10-99   Version 2.4   Author: Jean Latour (F.S.E.)
-C    *********
-C@
-C@  Contents : variables related to MPI-2 message passing
-C@  --------
-C@
-C@ -- mpi_totproc: number of processors on which to launch each model
-C@
-C@ -- mpi_nproc: number of processors involved in the coupling for
-C@               each model
-C@ -- cmpi_modnam: models name
-C     -----------------------------------------------------------------
-C
-      INTEGER*4 mpi_totproc(1:CLIM_MaxMod-1),mpi_nproc(0:CLIM_MaxMod-1)
-C
-      CHARACTER*6 cmpi_modnam(1:CLIM_MaxMod-1)
-C
-      common/CLIM_mpiclim/mpi_totproc, mpi_nproc, cmpi_modnam 
-C
-C     -----------------------------------------------------------------
Index: LMDZ.3.3/branches/rel-/libf/phylmd/newmicro.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/newmicro.F	(revision 416)
+++ 	(revision )
@@ -1,192 +1,0 @@
-      SUBROUTINE newmicro (paprs, pplay,ok_newmicro,
-     .                  t, pqlwp, pclc, pcltau, pclemi,
-     .                  pch, pcl, pcm, pct, pctlwp)
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930910
-c Objet: Calculer epaisseur optique et emmissivite des nuages
-c======================================================================
-c Arguments:
-c t-------input-R-temperature
-c pqlwp---input-R-eau liquide nuageuse dans l'atmosphere (kg/kg)
-c pclc----input-R-couverture nuageuse pour le rayonnement (0 a 1)
-c 
-c pcltau--output-R-epaisseur optique des nuages
-c pclemi--output-R-emissivite des nuages (0 a 1)
-c======================================================================
-C
-#include "YOMCST.h"
-c
-#include "dimensions.h"
-#include "dimphy.h"
-#include "nuage.h"
-      REAL paprs(klon,klev+1), pplay(klon,klev)
-      REAL t(klon,klev)
-c
-      REAL pclc(klon,klev)
-      REAL pqlwp(klon,klev)
-      REAL pcltau(klon,klev), pclemi(klon,klev)
-c
-      REAL pct(klon), pctlwp(klon), pch(klon), pcl(klon), pcm(klon)
-c
-      LOGICAL lo
-c
-      REAL cetahb, cetamb
-      PARAMETER (cetahb = 0.45, cetamb = 0.80)
-C
-      INTEGER i, k
-      REAL zflwp, zradef, zfice, zmsac
-c
-      REAL radius, rad_chaud
-cc      PARAMETER (rad_chau1=13.0, rad_chau2=9.0, rad_froid=35.0)
-ccc      PARAMETER (rad_chaud=15.0, rad_froid=35.0)
-c sintex initial      PARAMETER (rad_chaud=10.0, rad_froid=30.0)
-      REAL coef, coef_froi, coef_chau
-      PARAMETER (coef_chau=0.13, coef_froi=0.09)
-      REAL seuil_neb, t_glace
-      PARAMETER (seuil_neb=0.001, t_glace=273.0-15.0)
-      INTEGER nexpo ! exponentiel pour glace/eau
-      PARAMETER (nexpo=6)
-ccc      PARAMETER (nexpo=1)
-
-c -- sb:
-      logical ok_newmicro
-c     parameter (ok_newmicro=.FALSE.)
-      real rel, tc, rei, zfiwp
-      real k_liq, k_ice0, k_ice, DF
-      parameter (k_liq=0.0903, k_ice0=0.005) ! units=m2/g
-      parameter (DF=1.66) ! diffusivity factor
-c sb --
-
-c
-c Calculer l'epaisseur optique et l'emmissivite des nuages
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         rad_chaud = rad_chau1
-         IF (k.LE.3) rad_chaud = rad_chau2
-         pclc(i,k) = MAX(pclc(i,k), seuil_neb)
-         zflwp = 1000.*pqlwp(i,k)/RG/pclc(i,k)
-     .          *(paprs(i,k)-paprs(i,k+1))
-         zfice = 1.0 - (t(i,k)-t_glace) / (273.13-t_glace)
-         zfice = MIN(MAX(zfice,0.0),1.0)
-         zfice = zfice**nexpo
-         radius = rad_chaud * (1.-zfice) + rad_froid * zfice
-         coef = coef_chau * (1.-zfice) + coef_froi * zfice
-         pcltau(i,k) = 3.0/2.0 * zflwp / radius
-         pclemi(i,k) = 1.0 - EXP( - coef * zflwp)
-
-         if (ok_newmicro) then
-
-c -- liquid/ice cloud water paths:
-
-         zfice = 1.0 - (t(i,k)-t_glace) / (273.13-t_glace)
-         zfice = MIN(MAX(zfice,0.0),1.0)
-
-         zflwp = 1000.*(1.-zfice)*pqlwp(i,k)/pclc(i,k)
-     :          *(paprs(i,k)-paprs(i,k+1))/RG
-         zfiwp = 1000.*zfice*pqlwp(i,k)/pclc(i,k)
-     :          *(paprs(i,k)-paprs(i,k+1))/RG
-
-c -- effective cloud droplet radius (microns):
-
-c for liquid water clouds: 
-         rel = rad_chaud
-
-c for ice clouds: as a function of the ambiant temperature
-c [formula used by Iacobellis and Somerville (2000), with an 
-c asymptotical value of 3.5 microns at T<-81.4 C added to be 
-c consistent with observations of Heymsfield et al. 1986]:
-         tc = t(i,k)-273.15
-         rei = 0.71*tc + 61.29 
-         if (tc.le.-81.4) rei = 3.5 
-
-c -- cloud optical thickness :
-
-c [for liquid clouds, traditional formula, 
-c  for ice clouds, Ebert & Curry (1992)] 
-
-         if (zflwp.eq.0.) rel = 1. 
-         if (zfiwp.eq.0. .or. rei.le.0.) rei = 1. 
-         pcltau(i,k) = 3.0/2.0 * ( zflwp/rel )
-     .             + zfiwp * (3.448e-03  + 2.431/rei)
-
-c -- cloud infrared emissivity:
-
-c [the broadband infrared absorption coefficient is parameterized
-c  as a function of the effective cld droplet radius]
-
-c Ebert and Curry (1992) formula as used by Kiehl & Zender (1995):
-         k_ice = k_ice0 + 1.0/rei
-
-         pclemi(i,k) = 1.0
-     .      - EXP( - coef_chau*zflwp - DF*k_ice*zfiwp )
-
-         endif ! ok_newmicro
-
-         lo = (pclc(i,k) .LE. seuil_neb)
-         IF (lo) pclc(i,k) = 0.0
-         IF (lo) pcltau(i,k) = 0.0
-         IF (lo) pclemi(i,k) = 0.0
-      ENDDO
-      ENDDO
-ccc      DO k = 1, klev
-ccc      DO i = 1, klon
-ccc         t(i,k) = t(i,k)
-ccc         pclc(i,k) = MAX( 1.e-5 , pclc(i,k) )
-ccc         lo = pclc(i,k) .GT. (2.*1.e-5)
-ccc         zflwp = pqlwp(i,k)*1000.*(paprs(i,k)-paprs(i,k+1))
-ccc     .          /(rg*pclc(i,k))
-ccc         zradef = 10.0 + (1.-sigs(k))*45.0
-ccc         pcltau(i,k) = 1.5 * zflwp / zradef
-ccc         zfice=1.0-MIN(MAX((t(i,k)-263.)/(273.-263.),0.0),1.0)
-ccc         zmsac = 0.13*(1.0-zfice) + 0.08*zfice
-ccc         pclemi(i,k) = 1.-EXP(-zmsac*zflwp)
-ccc         if (.NOT.lo) pclc(i,k) = 0.0
-ccc         if (.NOT.lo) pcltau(i,k) = 0.0
-ccc         if (.NOT.lo) pclemi(i,k) = 0.0
-ccc      ENDDO
-ccc      ENDDO
-cccccc      print*, 'pas de nuage dans le rayonnement'
-cccccc      DO k = 1, klev
-cccccc      DO i = 1, klon
-cccccc         pclc(i,k) = 0.0
-cccccc         pcltau(i,k) = 0.0
-cccccc         pclemi(i,k) = 0.0
-cccccc      ENDDO
-cccccc      ENDDO
-C
-C COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS
-C
-      DO i = 1, klon
-         pct(i)=1.0
-         pch(i)=1.0
-         pcm(i) = 1.0
-         pcl(i) = 1.0
-         pctlwp(i) = 0.0
-      ENDDO
-C
-      DO k = klev, 1, -1
-      DO i = 1, klon
-         pctlwp(i) = pctlwp(i) 
-     .             + pqlwp(i,k)*(paprs(i,k)-paprs(i,k+1))/RG
-         pct(i) = pct(i)*(1.0-pclc(i,k))
-         if (pplay(i,k).LE.cetahb*paprs(i,1))
-     .      pch(i) = pch(i)*(1.0-pclc(i,k))
-         if (pplay(i,k).GT.cetahb*paprs(i,1) .AND.
-     .       pplay(i,k).LE.cetamb*paprs(i,1)) 
-     .      pcm(i) = pcm(i)*(1.0-pclc(i,k))
-         if (pplay(i,k).GT.cetamb*paprs(i,1))
-     .      pcl(i) = pcl(i)*(1.0-pclc(i,k))
-      ENDDO
-      ENDDO
-C
-      DO i = 1, klon
-         pct(i)=1.-pct(i)
-         pch(i)=1.-pch(i)
-         pcm(i)=1.-pcm(i)
-         pcl(i)=1.-pcl(i)
-      ENDDO
-C
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/nflxtr.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/nflxtr.F	(revision 416)
+++ 	(revision )
@@ -1,162 +1,0 @@
-      SUBROUTINE nflxtr(pdtime,pmfu,pmfd,pen_u,pde_u,pen_d,pde_d,
-     .                 pplay,paprs,x,dx) 
-      IMPLICIT NONE 
-c=====================================================================
-c Objet : Melange convectif de traceurs a partir des flux de masse 
-c Date : 13/12/1996 -- 13/01/97
-c Auteur: O. Boucher (LOA) sur inspiration de Z. X. Li (LMD),
-c         Brinkop et Sausen (1996) et Boucher et al. (1996).
-c ATTENTION : meme si cette routine se veut la plus generale possible, 
-c             elle a herite de certaines notations et conventions du 
-c             schema de Tiedtke (1993). 
-c --En particulier, les couches sont numerotees de haut en bas !!!
-c   Ceci est valable pour les flux
-c   mais pas pour les entrees x, pplay, paprs !!!!
-c --pmfu est positif, pmfd est negatif 
-c --Tous les flux d'entrainements et de detrainements sont positifs 
-c   contrairement au schema de Tiedtke d'ou les changements de signe!!!! 
-c=====================================================================
-c
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "YOECUMF.h" 
-c
-      REAL pdtime
-c--les flux sont definis au 1/2 niveaux
-c--pmfu(klev+1) et pmfd(klev+1) sont implicitement nuls
-      REAL pmfu(klon,klev)  ! flux de masse dans le panache montant 
-      REAL pmfd(klon,klev)  ! flux de masse dans le panache descendant
-      REAL pen_u(klon,klev) ! flux entraine dans le panache montant
-      REAL pde_u(klon,klev) ! flux detraine dans le panache montant
-      REAL pen_d(klon,klev) ! flux entraine dans le panache descendant
-      REAL pde_d(klon,klev) ! flux detraine dans le panache descendant
-
-      REAL pplay(klon,klev)    ! pression aux couches (bas en haut)
-      REAL paprs(klon,klev+1)  ! pression aux 1/2 couches (bas en haut)
-      REAL x(klon,klev)        ! q de traceur (bas en haut) 
-      REAL dx(klon,klev)     ! tendance de traceur  (bas en haut)
-c
-c--flux convectifs mais en variables locales
-      REAL zmfu(klon,klev+1) 
-      REAL zmfd(klon,klev+1) 
-      REAL zen_u(klon,klev) 
-      REAL zde_u(klon,klev)
-      REAL zen_d(klon,klev) 
-      REAL zde_d(klon,klev)
-      real zmfe
-c
-c--variables locales      
-c--les flux de x sont definis aux 1/2 niveaux 
-c--xu et xd sont definis aux niveaux complets
-      REAL xu(klon,klev)        ! q de traceurs dans le panache montant
-      REAL xd(klon,klev)        ! q de traceurs dans le panache descendant
-      REAL zmfux(klon,klev+1)   ! flux de x dans le panache montant
-      REAL zmfdx(klon,klev+1)   ! flux de x dans le panache descendant
-      REAL zmfex(klon,klev+1)   ! flux de x dans l'environnement 
-      INTEGER i, k 
-      REAL zmfmin
-      PARAMETER (zmfmin=1.E-10)
-
-c =========================================
-c
-c
-c   Extension des flux UP et DN sur klev+1 niveaux
-c =========================================
-      do k=1,klev
-         do i=1,klon
-            zmfu(i,k)=pmfu(i,k)
-            zmfd(i,k)=pmfd(i,k)
-         enddo
-      enddo
-      do i=1,klon
-         zmfu(i,klev+1)=0.
-         zmfd(i,klev+1)=0.
-      enddo
-
-c--modif pour diagnostiquer les detrainements
-c =========================================
-c   on privilegie l'ajustement de l'entrainement dans l'ascendance.
-
-      do k=1, klev
-         do i=1, klon
-            zen_d(i,k)=pen_d(i,k)
-            zde_u(i,k)=pde_u(i,k)
-            zde_d(i,k) =-zmfd(i,k+1)+zmfd(i,k)+zen_d(i,k)
-            zen_u(i,k) = zmfu(i,k+1)-zmfu(i,k)+zde_u(i,k)
-         enddo 
-      enddo 
-c
-c--calcul des flux dans le panache montant
-c =========================================
-c
-c Dans la premiere couche, on prend q comme valeur de qu
-c
-      do i=1, klon
-         zmfux(i,1)=0.0 
-      enddo
-c
-c Autres couches
-      do k=1,klev
-         do i=1, klon
-            if ((zmfu(i,k+1)+zde_u(i,k)).lt.zmfmin) THEN
-               xu(i,k)=x(i,k)
-            else
-               xu(i,k)=(zmfux(i,k)+zen_u(i,k)*x(i,k))
-     s               /(zmfu(i,k+1)+zde_u(i,k))
-            endif
-            zmfux(i,k+1)=zmfu(i,k+1)*xu(i,k)
-         enddo
-      enddo
-c
-c--calcul des flux dans le panache descendant
-c =========================================
-c   
-      do i=1, klon
-         zmfdx(i,klev+1)=0.0 
-      enddo
-c
-      do k=klev,1,-1
-         do i=1, klon
-            if ((zde_d(i,k)-zmfd(i,k)).lt.zmfmin) THEN
-               xd(i,k)=x(i,k)
-            else
-               xd(i,k)=(zmfdx(i,k+1)-zen_d(i,k)*x(i,k)) /
-     .               (zmfd(i,k)-zde_d(i,k))
-            endif
-            zmfdx(i,k)=zmfd(i,k)*xd(i,k)
-         enddo
-      enddo
-c
-c--introduction du flux de retour dans l'environnement
-c =========================================
-c
-      do k=2, klev
-         do i=1, klon
-            zmfe=-zmfu(i,k)-zmfd(i,k)
-            if (zmfe.le.0.) then
-               zmfex(i,k)= zmfe*x(i,k)
-            else
-               zmfex(i,k)= zmfe*x(i,k-1)
-            endif
-         enddo
-      enddo
-
-      do i=1, klon
-         zmfex(i,1)=0.
-         zmfex(i,klev+1)=0.
-      enddo
-c
-c--calcul final des tendances
-c
-      do k=1, klev
-         do i=1, klon
-            dx(i,k)=RG/(paprs(i,k)-paprs(i,k+1))*pdtime*
-     .                      ( zmfux(i,k) - zmfux(i,k+1) +
-     .                        zmfdx(i,k) - zmfdx(i,k+1) +
-     .                        zmfex(i,k) - zmfex(i,k+1) )
-         enddo
-      enddo
-c
-      return 
-      end
Index: LMDZ.3.3/branches/rel-/libf/phylmd/nuage.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/nuage.F	(revision 416)
+++ 	(revision )
@@ -1,310 +1,0 @@
-      SUBROUTINE nuage (paprs, pplay,
-     .                  t, pqlwp, pclc, pcltau, pclemi,
-     .                  pch, pcl, pcm, pct, pctlwp)
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930910
-c Objet: Calculer epaisseur optique et emmissivite des nuages
-c======================================================================
-c Arguments:
-c t-------input-R-temperature
-c pqlwp---input-R-eau liquide nuageuse dans l'atmosphere (kg/kg)
-c pclc----input-R-couverture nuageuse pour le rayonnement (0 a 1)
-c 
-c pcltau--output-R-epaisseur optique des nuages
-c pclemi--output-R-emissivite des nuages (0 a 1)
-c======================================================================
-C
-#include "YOMCST.h"
-c
-#include "dimensions.h"
-#include "dimphy.h"
-      REAL paprs(klon,klev+1), pplay(klon,klev)
-      REAL t(klon,klev)
-c
-      REAL pclc(klon,klev)
-      REAL pqlwp(klon,klev)
-      REAL pcltau(klon,klev), pclemi(klon,klev)
-c
-      REAL pct(klon), pctlwp(klon), pch(klon), pcl(klon), pcm(klon)
-c
-      LOGICAL lo
-c
-      REAL cetahb, cetamb
-      PARAMETER (cetahb = 0.45, cetamb = 0.80)
-C
-      INTEGER i, k
-      REAL zflwp, zradef, zfice, zmsac
-c
-      REAL radius, rad_froid, rad_chaud, rad_chau1, rad_chau2
-      PARAMETER (rad_chau1=13.0, rad_chau2=9.0, rad_froid=35.0)
-ccc      PARAMETER (rad_chaud=15.0, rad_froid=35.0)
-c sintex initial      PARAMETER (rad_chaud=10.0, rad_froid=30.0)
-      REAL coef, coef_froi, coef_chau
-      PARAMETER (coef_chau=0.13, coef_froi=0.09)
-      REAL seuil_neb, t_glace
-      PARAMETER (seuil_neb=0.001, t_glace=273.0-15.0)
-      INTEGER nexpo ! exponentiel pour glace/eau
-      PARAMETER (nexpo=6)
-ccc      PARAMETER (nexpo=1)
-c
-c Calculer l'epaisseur optique et l'emmissivite des nuages
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         rad_chaud = rad_chau1
-         IF (k.LE.3) rad_chaud = rad_chau2
-         pclc(i,k) = MAX(pclc(i,k), seuil_neb)
-         zflwp = 1000.*pqlwp(i,k)/RG/pclc(i,k)
-     .          *(paprs(i,k)-paprs(i,k+1))
-         zfice = 1.0 - (t(i,k)-t_glace) / (273.13-t_glace)
-         zfice = MIN(MAX(zfice,0.0),1.0)
-         zfice = zfice**nexpo
-         radius = rad_chaud * (1.-zfice) + rad_froid * zfice
-         coef = coef_chau * (1.-zfice) + coef_froi * zfice
-         pcltau(i,k) = 3.0/2.0 * zflwp / radius
-         pclemi(i,k) = 1.0 - EXP( - coef * zflwp)
-         lo = (pclc(i,k) .LE. seuil_neb)
-         IF (lo) pclc(i,k) = 0.0
-         IF (lo) pcltau(i,k) = 0.0
-         IF (lo) pclemi(i,k) = 0.0
-      ENDDO
-      ENDDO
-ccc      DO k = 1, klev
-ccc      DO i = 1, klon
-ccc         t(i,k) = t(i,k)
-ccc         pclc(i,k) = MAX( 1.e-5 , pclc(i,k) )
-ccc         lo = pclc(i,k) .GT. (2.*1.e-5)
-ccc         zflwp = pqlwp(i,k)*1000.*(paprs(i,k)-paprs(i,k+1))
-ccc     .          /(rg*pclc(i,k))
-ccc         zradef = 10.0 + (1.-sigs(k))*45.0
-ccc         pcltau(i,k) = 1.5 * zflwp / zradef
-ccc         zfice=1.0-MIN(MAX((t(i,k)-263.)/(273.-263.),0.0),1.0)
-ccc         zmsac = 0.13*(1.0-zfice) + 0.08*zfice
-ccc         pclemi(i,k) = 1.-EXP(-zmsac*zflwp)
-ccc         if (.NOT.lo) pclc(i,k) = 0.0
-ccc         if (.NOT.lo) pcltau(i,k) = 0.0
-ccc         if (.NOT.lo) pclemi(i,k) = 0.0
-ccc      ENDDO
-ccc      ENDDO
-cccccc      print*, 'pas de nuage dans le rayonnement'
-cccccc      DO k = 1, klev
-cccccc      DO i = 1, klon
-cccccc         pclc(i,k) = 0.0
-cccccc         pcltau(i,k) = 0.0
-cccccc         pclemi(i,k) = 0.0
-cccccc      ENDDO
-cccccc      ENDDO
-C
-C COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS
-C
-      DO i = 1, klon
-         pct(i)=1.0
-         pch(i)=1.0
-         pcm(i) = 1.0
-         pcl(i) = 1.0
-         pctlwp(i) = 0.0
-      ENDDO
-C
-      DO k = klev, 1, -1
-      DO i = 1, klon
-         pctlwp(i) = pctlwp(i) 
-     .             + pqlwp(i,k)*(paprs(i,k)-paprs(i,k+1))/RG
-         pct(i) = pct(i)*(1.0-pclc(i,k))
-         if (pplay(i,k).LE.cetahb*paprs(i,1))
-     .      pch(i) = pch(i)*(1.0-pclc(i,k))
-         if (pplay(i,k).GT.cetahb*paprs(i,1) .AND.
-     .       pplay(i,k).LE.cetamb*paprs(i,1)) 
-     .      pcm(i) = pcm(i)*(1.0-pclc(i,k))
-         if (pplay(i,k).GT.cetamb*paprs(i,1))
-     .      pcl(i) = pcl(i)*(1.0-pclc(i,k))
-      ENDDO
-      ENDDO
-C
-      DO i = 1, klon
-         pct(i)=1.-pct(i)
-         pch(i)=1.-pch(i)
-         pcm(i)=1.-pcm(i)
-         pcl(i)=1.-pcl(i)
-      ENDDO
-C
-      RETURN
-      END
-      SUBROUTINE diagcld1(paprs,pplay,rain,snow,kbot,ktop,
-     .                   diafra,dialiq)
-      IMPLICIT none
-c
-c Laurent Li (LMD/CNRS), le 12 octobre 1998
-c                        (adaptation du code ECMWF)
-c
-c Dans certains cas, le schema pronostique des nuages n'est
-c pas suffisament performant. On a donc besoin de diagnostiquer
-c ces nuages. Je dois avouer que c'est une frustration.
-c
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-c
-c Arguments d'entree:
-      REAL paprs(klon,klev+1) ! pression (Pa) a inter-couche
-      REAL pplay(klon,klev) ! pression (Pa) au milieu de couche
-      REAL t(klon,klev) ! temperature (K)
-      REAL q(klon,klev) ! humidite specifique (Kg/Kg)
-      REAL rain(klon) ! pluie convective (kg/m2/s)
-      REAL snow(klon) ! neige convective (kg/m2/s)
-      INTEGER ktop(klon) ! sommet de la convection
-      INTEGER kbot(klon) ! bas de la convection
-c
-c Arguments de sortie:
-      REAL diafra(klon,klev) ! fraction nuageuse diagnostiquee
-      REAL dialiq(klon,klev) ! eau liquide nuageuse
-c
-c Constantes ajustables:
-      REAL CANVA, CANVB, CANVH
-      PARAMETER (CANVA=2.0, CANVB=0.3, CANVH=0.4)
-      REAL CCA, CCB, CCC
-      PARAMETER (CCA=0.125, CCB=1.5, CCC=0.8)
-      REAL CCFCT, CCSCAL
-      PARAMETER (CCFCT=0.400)
-      PARAMETER (CCSCAL=1.0E+11)
-      REAL CETAHB, CETAMB
-      PARAMETER (CETAHB=0.45, CETAMB=0.80)
-      REAL CCLWMR
-      PARAMETER (CCLWMR=1.E-04)
-      REAL ZEPSCR
-      PARAMETER (ZEPSCR=1.0E-10)
-c
-c Variables locales:
-      INTEGER i, k
-      REAL zcc(klon)
-c
-c Initialisation:
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         diafra(i,k) = 0.0
-         dialiq(i,k) = 0.0
-      ENDDO
-      ENDDO
-c
-      DO i = 1, klon ! Calculer la fraction nuageuse
-      zcc(i) = 0.0
-      IF((rain(i)+snow(i)).GT.0.) THEN
-         zcc(i)= CCA * LOG(MAX(ZEPSCR,(rain(i)+snow(i))*CCSCAL))-CCB
-         zcc(i)= MIN(CCC,MAX(0.0,zcc(i)))
-      ENDIF
-      ENDDO
-c
-      DO i = 1, klon ! pour traiter les enclumes
-      diafra(i,ktop(i)) = MAX(diafra(i,ktop(i)),zcc(i)*CCFCT)
-      IF ((zcc(i).GE.CANVH) .AND.
-     .    (pplay(i,ktop(i)).LE.CETAHB*paprs(i,1)))
-     . diafra(i,ktop(i)) = MAX(diafra(i,ktop(i)),
-     .                         MAX(zcc(i)*CCFCT,CANVA*(zcc(i)-CANVB)))
-      dialiq(i,ktop(i))=CCLWMR*diafra(i,ktop(i))
-      ENDDO
-c
-      DO k = 1, klev ! nuages convectifs (sauf enclumes)
-      DO i = 1, klon
-      IF (k.LT.ktop(i) .AND. k.GE.kbot(i)) THEN
-         diafra(i,k)=MAX(diafra(i,k),zcc(i)*CCFCT)
-         dialiq(i,k)=CCLWMR*diafra(i,k)
-      ENDIF
-      ENDDO
-      ENDDO
-c
-      RETURN
-      END
-      SUBROUTINE diagcld2(paprs,pplay,t,q, diafra,dialiq)
-      IMPLICIT none
-c
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-c
-c Arguments d'entree:
-      REAL paprs(klon,klev+1) ! pression (Pa) a inter-couche
-      REAL pplay(klon,klev) ! pression (Pa) au milieu de couche
-      REAL t(klon,klev) ! temperature (K)
-      REAL q(klon,klev) ! humidite specifique (Kg/Kg)
-c
-c Arguments de sortie:
-      REAL diafra(klon,klev) ! fraction nuageuse diagnostiquee
-      REAL dialiq(klon,klev) ! eau liquide nuageuse
-c
-      REAL CETAMB
-      PARAMETER (CETAMB=0.80)
-      REAL CLOIA, CLOIB, CLOIC, CLOID
-      PARAMETER (CLOIA=1.0E+02, CLOIB=-10.00, CLOIC=-0.6, CLOID=5.0)
-ccc      PARAMETER (CLOIA=1.0E+02, CLOIB=-10.00, CLOIC=-0.9, CLOID=5.0)
-      REAL RGAMMAS
-      PARAMETER (RGAMMAS=0.05)
-      REAL CRHL
-      PARAMETER (CRHL=0.15)
-ccc      PARAMETER (CRHL=0.70)
-      REAL t_coup
-      PARAMETER (t_coup=234.0)
-c
-c Variables locales:
-      INTEGER i, k, kb, invb(klon)
-      REAL zqs, zrhb, zcll, zdthmin(klon), zdthdp
-      REAL zdelta, zcor
-c
-c Fonctions thermodynamiques:
-#include "YOETHF.h"
-#include "FCTTRE.h"
-c
-c Initialisation:
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         diafra(i,k) = 0.0
-         dialiq(i,k) = 0.0
-      ENDDO
-      ENDDO
-c
-      DO i = 1, klon
-         invb(i) = klev
-         zdthmin(i)=0.0
-      ENDDO
-
-      DO k = 2, klev/2-1
-      DO i = 1, klon
-         zdthdp = (t(i,k)-t(i,k+1))/(pplay(i,k)-pplay(i,k+1))
-     .          - RD * 0.5*(t(i,k)+t(i,k+1))/RCPD/paprs(i,k+1)
-         zdthdp = zdthdp * CLOIA
-         IF (pplay(i,k).GT.CETAMB*paprs(i,1) .AND.
-     .       zdthdp.LT.zdthmin(i) ) THEN
-            zdthmin(i) = zdthdp
-            invb(i) = k
-         ENDIF
-      ENDDO
-      ENDDO
-
-      DO i = 1, klon
-         kb=invb(i)
-         IF (thermcep) THEN
-           zdelta=MAX(0.,SIGN(1.,RTT-t(i,kb)))
-           zqs= R2ES*FOEEW(t(i,kb),zdelta)/pplay(i,kb)
-           zqs=MIN(0.5,zqs)
-           zcor=1./(1.-RETV*zqs)
-           zqs=zqs*zcor
-         ELSE
-           IF (t(i,kb) .LT. t_coup) THEN
-              zqs = qsats(t(i,kb)) / pplay(i,kb)
-           ELSE
-              zqs = qsatl(t(i,kb)) / pplay(i,kb)
-           ENDIF
-         ENDIF
-         zcll = CLOIB * zdthmin(i) + CLOIC
-         zcll = MIN(1.0,MAX(0.0,zcll))
-         zrhb= q(i,kb)/zqs
-         IF (zcll.GT.0.0.AND.zrhb.LT.CRHL)
-     .   zcll=zcll*(1.-(CRHL-zrhb)*CLOID)
-         zcll=MIN(1.0,MAX(0.0,zcll))
-         diafra(i,kb) = MAX(diafra(i,kb),zcll)
-         dialiq(i,kb)= diafra(i,kb) * RGAMMAS*zqs
-      ENDDO
-c
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/nuage.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/nuage.h	(revision 416)
+++ 	(revision )
@@ -1,3 +1,0 @@
-      REAL rad_froid, rad_chau1, rad_chau2
-
-      common /nuage/ rad_froid,rad_chau1, rad_chau2
Index: LMDZ.3.3/branches/rel-/libf/phylmd/o3cm.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/o3cm.F	(revision 416)
+++ 	(revision )
@@ -1,58 +1,0 @@
-      SUBROUTINE o3cm (amb, bmb, sortie, ntab)
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
-c Objet: Ce programme calcule le contenu en ozone "sortie"
-c        (unite: cm.atm) entre deux niveaux "amb" et "bmb" (unite: mb)
-c        "ntab" est le nombre d'intervalles pour l'integration, sa
-c        valeur depend bien sur de l'epaisseur de la couche et de
-c        la precision qu'on souhaite a obtenir
-c======================================================================
-      REAL amb, bmb, sortie
-      INTEGER ntab
-c======================================================================
-      INTEGER n
-      REAL xtab(500), xa, xb, ya, yb, xincr
-c======================================================================
-      external mbtozm
-c======================================================================
-c la fonction en ligne w(x) donne le profil de l'ozone en fonction
-c de l'altitude (unite: cm.atm / km)
-c (Green 1964, Appl. Opt. 3: 203-208)
-      REAL wp, xp, h, x, w, con
-      PARAMETER (wp=0.218, xp=23.25, h=4.63, con=1.0)
-      w(x) = wp/h * EXP((x-xp)/h)/ (con+EXP((x-xp)/h))**2
-c======================================================================
-      IF (ntab .GT. 499) STOP 'BIG ntab'
-      xincr = (bmb-amb) / FLOAT(ntab)
-      xtab(1) = amb
-      DO n = 2, ntab
-         xtab(n) = xtab(n-1) + xincr
-      ENDDO
-      xtab(ntab+1) = bmb
-      sortie = 0.0
-      DO n = 1, ntab
-         CALL mbtozm(xtab(n), xa)
-         CALL mbtozm(xtab(n+1), xb)
-         xa = xa / 1000.
-         xb = xb / 1000.
-         ya = w(xa)
-         yb = w(xb)
-         sortie = sortie + (ya+yb)/2.0 * ABS(xb-xa)
-      ENDDO
-      RETURN
-      END
-      SUBROUTINE mbtozm(rmb,zm)
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS)
-c Objet: transformer une hauteur de mb (rmb) en metre (zm)
-c======================================================================
-      REAL rmb, zm
-c======================================================================
-      REAL gama, tzero, pzero, g, r
-      PARAMETER (gama=6.5e-3, tzero=288., pzero=1013.25)
-      PARAMETER (g=9.81, r=287.0)
-      zm = tzero/gama * ( 1.-(rmb/pzero)**(r*gama/g) )
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/oasis.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/oasis.F	(revision 416)
+++ 	(revision )
@@ -1,918 +1,0 @@
-c
-C****
-C               *****************
-C               * OASIS ROUTINE *
-C               * ------------- *
-C               *****************
-C
-C**** *INICMA*  - Initialize coupled mode communication for atmosphere
-C
-C     Purpose:
-C     -------
-C     Exchange process identifiers and timestep information
-C     between AGCM, OGCM and COUPLER.
-C
-C     Input:
-C     -----
-C       KASTP  : total number of timesteps in atmospheric model
-C       KEXCH  : frequency of exchange (in time steps)
-C       KSTEP  : timestep value (in seconds)
-C
-C     Method:
-C     ------
-C     Use named pipes(FIFO) to exchange process identifiers
-C     between the programs
-C
-C     Externals:
-C     ---------
-C     GETPID, MKNOD
-C
-C     Reference:
-C     ---------
-C     See Epicoa 0803 (1992)
-C
-C     Author:
-C     -------
-C     Laurent Terray  92-09-01
-C
-C     -----------------------------------------------------------
-C
-      SUBROUTINE inicma(kastp,kexch,kstep)
-c
-      INTEGER kastp, kexch, kstep
-c
-      INTEGER ime
-      PARAMETER (ime = 1)
-
-      INTEGER iparal(3)
-      INTEGER ifcpl, idt, info, imxtag, istep
-c
-#include "dimensions.h"
-#include "dimphy.h"
-#include "oasis.h"
-#include "clim.h"
-c
-c     Addition for SIPC CASE
-#include "param_sipc.h"
-#include "param_cou.h"
-#include "inc_sipc.h"
-#include "inc_cpl.h"
-      CHARACTER*9 clpoolnam 
-      INTEGER ipoolhandle, imrc, ipoolsize, index, jf
-      CHARACTER*3 cljobnam      ! experiment name
-      CHARACTER*6 clmodnam      ! model name
-      CHARACTER*5 cloasis       ! coupler name (Oasis)
-      INTEGER imess(4), imesso(4)
-      INTEGER getpid, mknod ! system functions
-      CHARACTER*80 clcmd
-      CHARACTER*8 pipnom, fldnom
-      INTEGER ierror, iretcode
-C
-      INTEGER nuout
-      PARAMETER (nuout = 6)
-c
-C
-c
-
-C     -----------------------------------------------------------
-C
-C*    1. Initializations
-C        ---------------
-C
-      WRITE(nuout,*) ' '
-      WRITE(nuout,*) ' '
-      WRITE(nuout,*) ' ROUTINE INICMA'
-      WRITE(nuout,*) ' **************'
-      WRITE(nuout,*) ' '
-      WRITE(nuout,*) ' '
-c
-c     1.2.1-Define the model name
-c
-      clmodnam = 'lmd.xx'       ! as $NBMODEL in namcouple
-c
-c     1.2.2-Define the coupler name
-c
-      cloasis = 'Oasis'        !  as in coupler
-c
-c
-c     1.3.1-Define symbolic name for fields exchanged from atmos to coupler,
-c         must be the same as (1) of the field  definition in namcouple:
-c
-      cl_writ(1)='CONSFTOT'
-      cl_writ(2)='COSHFTOT'
-      cl_writ(3)='COTOPRSU'
-      cl_writ(4)='COTFSHSU'
-      cl_writ(5)='CORUNCOA'
-      cl_writ(6)='CORIVFLU'
-      cl_writ(7)='COZOTAUX'
-      cl_writ(8)='COZOTAU2'
-      cl_writ(9)='COMETAUY'
-      cl_writ(10)='COMETAU2'
-c
-c     1.3.2-Define files name for fields exchanged from atmos to coupler,
-c         must be the same as (6) of the field  definition in namcouple:
-c
-      cl_f_writ(1)='atmflx'
-      cl_f_writ(2)='atmflx'
-      cl_f_writ(3)='atmflx'
-      cl_f_writ(4)='atmflx'
-      cl_f_writ(5)='atmflx'
-      cl_f_writ(6)='atmflx'
-      cl_f_writ(7)='atmtau'
-      cl_f_writ(8)='atmtau'
-      cl_f_writ(9)='atmtau'
-      cl_f_writ(10)='atmtau'
-c
-c
-c     1.4.1-Define symbolic name for fields exchanged from coupler to atmosphere,
-c         must be the same as (2) of the field  definition in namcouple:
-c
-      cl_read(1)='SISUTESU'
-      cl_read(2)='SIICECOV'
-c
-c     1.4.2-Define files names for fields exchanged from coupler to atmosphere,
-c         must be the same as (7) of the field  definition in namcouple:
-c
-      cl_f_read(1)='atmsst'
-      cl_f_read(2)='atmice'
-c
-c     1.5-Define infos for sending to oasis
-c
-      imess(1) = kastp
-      imess(2) = kexch
-      imess(3) = kstep
-      imess(4) = getpid()
-
-c
-c
-      IF (cchan.eq.'PIPE') THEN 
-c
-          ierror=0
-c
-c
-          WRITE(nuout,*) ' '
-          WRITE(nuout,*) 'Making pipes for fields to receive from CPL'
-          WRITE(nuout,*) ' '
-c
-c loop to define pipes (ocean=CPL to atmos)
-c
-          DO jf=1, jpfldo2a
-            CALL PIPE_Model_Define(nuout, cl_read(jf), jpread, iretcode)
-            IF (iretcode.ne.0) ierror=ierror+1
-          END DO 
-c
-          WRITE(nuout,*) ' '
-          WRITE(nuout,*) 'Making pipes for fields to send to CPL'
-          WRITE(nuout,*) ' '
-c
-c loop to define pipes (atmos to ocean=CPL)
-c
-          DO jf=1, jpflda2o
-            CALL PIPE_Model_Define(nuout, cl_writ(jf), jpwrit, iretcode)
-            IF (iretcode.ne.0) ierror=ierror+1
-          END DO 
-c
-          IF (ierror.ne.0) THEN
-              WRITE (nuout,*) 'Error in pipes definitions'
-              WRITE (nuout,*) 'STOP inicma'
-              CALL abort
-          END IF 
-c
-          WRITE(nuout,*) ' '
-          WRITE(nuout,*) 'All pipes have been made'
-          WRITE(nuout,*) ' '
-c
-          WRITE(nuout,*) ' '
-          WRITE(nuout,*) 'Communication test between ATM and CPL'
-          WRITE(nuout,*) ' '
-          CALL flush(nuout)
-c
-          CALL PIPE_Model_Stepi(nuout, imess, ime, imesso, ierror)
-c
-          IF (ierror.ne.0) THEN
-              WRITE (nuout,*)
-     $            'Error in exchange first informations with Oasis' 
-              WRITE (nuout,*) 'STOP inicma'
-              CALL abort
-          END IF 
-c
-          WRITE(nuout,*) ' '
-          WRITE(nuout,*) 'Communication test between ATM and CPL is OK'
-          WRITE(nuout,*) ' total simulation time in oasis = ', imesso(1)
-          WRITE(nuout,*) ' total number of iterations is  = ', imesso(2)
-          WRITE(nuout,*) ' value of oasis timestep  is    = ', imesso(3)
-          WRITE(nuout,*) ' process id for oasis  is       = ', imesso(4)
-          WRITE(nuout,*) ' '
-          CALL flush(nuout)
-c
-      ELSE  IF (cchan.eq.'SIPC') THEN
-c
-c debug for more information
-c
-c          CALL SVIPC_debug(1)
-c  
-c
-c     1.1-Define the experiment name :
-c
-          cljobnam = 'IPC'      ! as $JOBNAM in namcouple
-c
-c         3-Attach to shared memory pool used to exchange initial infos 
-c
-          imrc = 0
-          CALL SIPC_Init_Model (cljobnam, clmodnam, 1, imrc)
-          IF (imrc .NE. 0) THEN 
-            WRITE (nuout,*)'   '
-            WRITE (nuout,*)'WARNING: Problem with attachement to', imrc 
-            WRITE (nuout,*)'         initial memory pool(s) in atmos'
-            WRITE (nuout,*)'   '
-            CALL ABORT('STOP in atmos')
-          ENDIF
-c
-c         4-Attach to pools used to exchange fields from atmos to coupler
-c
- 	  DO jf = 1, jpflda2o
-c
-C
-c           Pool name:
-            clpoolnam = 'P'//cl_writ(jf)
-C
-            CALL SIPC_Attach(clpoolnam, ipoolhandle)
-c     
-c           Resulting pool handle:
-            mpoolwrit(jf) = ipoolhandle  
-C
-            END DO 
-C
-c         5-Attach to pools used to exchange fields from coupler to atmos
-c
-          DO jf = 1, jpfldo2a
-c
-c           Pool name:
-            clpoolnam = 'P'//cl_read(jf)
-c
-            CALL SIPC_Attach(clpoolnam, ipoolhandle)
-c
-c           Resulting pool handle:
-            mpoolread(jf) = ipoolhandle  
-c
-          END DO 
-c
-c         6-Exchange of initial infos
-c
-c         Write data array isend to pool READ by Oasis
-c
-          imrc = 0
-          ipoolsize = 4*jpbyteint
-          CALL SVIPC_Write(mpoolinitr, imess, ipoolsize, imrc)
-C
-C         Find error if any
-C
-          IF (imrc .LT. 0) THEN
-              WRITE (nuout,*) '   '
-              WRITE (nuout,*) 'Problem in atmos in writing initial' 
-              WRITE (nuout,*) 'infos to the shared memory segment(s)'
-              WRITE (nuout,*) '   '
-          ELSE
-              WRITE (nuout,*) '   '
-              WRITE (nuout,*) 'Initial infos written in atmos'            
-              WRITE (nuout,*) 'to the shared memory segment(s)'
-              WRITE (nuout,*) '   '
-          ENDIF
-C
-C         Read data array irecv from pool written by Oasis
-C
-          imrc = 0
-          ipoolsize = 4*jpbyteint
-          CALL SVIPC_Read(mpoolinitw, imesso, ipoolsize, imrc)
-C
-C*        Find error if any
-C
-          IF (imrc .LT. 0) THEN
-              WRITE (nuout,*) '   '
-              WRITE (nuout,*) 'Problem in atmos in reading initial' 
-              WRITE (nuout,*) 'infos from the shared memory segment(s)'
-              WRITE (nuout,*) '   '
-          ELSE
-              WRITE (nuout,*) '   '
-              WRITE (nuout,*) 'Initial infos read by atmos'                
-              WRITE (nuout,*) 'from the shared memory segment(s)'
-              WRITE (nuout,*) '   '
-              WRITE(*,*) ' ntime, niter, nstep, Oasis pid:'
-              WRITE(*,*) imesso(1), imesso(2), imesso(3), imesso(4) 
-          ENDIF
-C
-C         Detach from shared memory segment(s)
-C
-          imrc = 0
-          CALL SVIPC_close(mpoolinitw, 0, imrc)
-C
-C         Find error if any
-C
-          IF (imrc .LT. 0) THEN
-              WRITE (nuout,*) 
-     $          'Problem in detaching from shared memory segment(s)'
-              WRITE (nuout,*)
-     $          'used by atmos to read initial infos' 
-          ENDIF
-c
-c
-      ELSE IF (cchan.eq.'CLIM') THEN
-
-c
-c     1.1-Define the experiment name :
-c
-          cljobnam = 'CLI'      ! as $JOBNAM in namcouple
-
-          OPEN ( UNIT = 7, FILE = 'trace', STATUS = 'unknown',
-     $          FORM = 'formatted')
-          CALL CLIM_Init ( cljobnam, clmodnam, 3, 7,
-     *                 kastp, kexch, kstep,
-     *                 5, 3600, 3600, info )
-c
-          IF (info.ne.clim_ok) THEN
-              WRITE ( nuout, *) ' inicma : pb init clim '
-              WRITE ( nuout, *) ' error code is = ', info
-              CALL abort('STOP in inicma')
-            ELSE
-              WRITE(nuout,*) 'inicma : init clim ok '
-          ENDIF
-c
-          iparal ( clim_strategy ) = clim_serial
-          iparal ( clim_length   ) = iim*(jjm+1)
-          iparal ( clim_offset   ) = 0
-c
-c loop to define messages (CPL=ocean to atmos)
-c
-          DO jf=1, jpfldo2a
-            CALL CLIM_Define (cl_read(jf), clim_in , clim_double, iparal
-     $          , info )  
-          END DO 
-
-c
-c loop to define messages (atmos to ocean=CPL)
-c
-          DO jf=1, jpflda2o
-            CALL CLIM_Define (cl_writ(jf), clim_out , clim_double,
-     $          iparal, info )   
-          END DO 
-
-          WRITE(nuout,*) 'inicma : clim_define ok '
-          CALL CLIM_Start ( imxtag, info )
-          IF (info.ne.clim_ok) THEN
-              WRITE ( nuout, *) 'inicma : pb start clim '
-              WRITE ( nuout, *) ' error code is = ', info
-              CALL abort('stop in inicma')
-            ELSE
-              WRITE ( nuout, *)  'inicma : start clim ok '
-          ENDIF
-c
-          CALL CLIM_Stepi (cloasis, istep, ifcpl, idt, info)
-          IF (info .NE. clim_ok) THEN
-              WRITE ( UNIT = nuout, FMT = *)
-     $            ' warning : problem in getting step info ',
-     $            'from oasis '
-              WRITE (UNIT = nuout, FMT = *)
-     $            ' =======   error code number = ', info
-            ELSE
-              WRITE (UNIT = nuout, FMT = *)
-     $            ' got step information from oasis '
-          ENDIF
-          WRITE ( nuout, *) ' number of tstep in oasis ', istep
-          WRITE ( nuout, *) ' exchange frequency in oasis ', ifcpl
-          WRITE ( nuout, *) ' length of tstep in oasis ', idt
-      ENDIF 
-
-      RETURN
-      END
-
-      SUBROUTINE fromcpl(kt, imjm, sst, gla)
-      IMPLICIT none
-c
-c Laurent Z.X Li (Feb. 10, 1997): It reads the SST and Sea-Ice
-c provided by the coupler. Of course, it waits until it receives
-c the signal from the corresponding pipes.
-c 3 techniques:
-c  - pipes and signals (only on Cray C90 and Cray J90)
-c  - CLIM (PVM exchange messages)
-c  - SVIPC shared memory segments and semaphores
-c
-      INTEGER imjm, kt
-      REAL sst(imjm)          ! sea-surface-temperature
-      REAL gla(imjm)          ! sea-ice
-c
-      INTEGER nuout             ! listing output unit
-      PARAMETER (nuout=6)
-c
-      INTEGER nuread, ios, iflag, icpliter
-      CHARACTER*8 pipnom        ! name for the pipe
-      CHARACTER*8 fldnom        ! name for the field
-      CHARACTER*8 filnom        ! name for the data file
-
-      INTEGER info, jf
-
-c
-#include "oasis.h"
-#include "clim.h"
-c
-#include "param_cou.h"
-c
-#include "inc_sipc.h"
-#include "inc_cpl.h"
-c
-c     Addition for SIPC CASE
-      INTEGER index
-      CHARACTER*3 cmodinf       ! Header or not
-      CHARACTER*3 cljobnam_r    ! Experiment name in the field brick, if any 
-      INTEGER infos(3)          ! infos in the field brick, if any
-c
-c
-      WRITE (nuout,*) ' '
-      WRITE (nuout,*) 'Fromcpl: Read fields from CPL, kt=',kt
-      WRITE (nuout,*) ' '
-      CALL flush (nuout)
-
-      IF (cchan.eq.'PIPE') THEN 
-c
-c UNIT number for fields
-c
-          nuread = 99
-c
-c exchanges from ocean=CPL to atmosphere
-c
-          DO jf=1,jpfldo2a
-            CALL PIPE_Model_Recv(cl_read(jf), icpliter, nuout)
-            OPEN (nuread, FILE=cl_f_read(jf), FORM='UNFORMATTED')
-            IF (jf.eq.1)
-     $          CALL locread(cl_read(jf), sst, imjm, nuread, iflag,
-     $          nuout)
-            IF (jf.eq.2)
-     $          CALL locread(cl_read(jf), gla, imjm, nuread, iflag,
-     $          nuout)
-            CLOSE (nuread)
-          END DO 
-
-c
-      ELSE IF (cchan.eq.'SIPC') THEN 
-c
-c         Define IF a header must be encapsulated within the field brick :
-          cmodinf = 'NOT'                 ! as $MODINFO in namcouple  
-c 
-c         reading of input field sea-surface-temperature SISUTESU
-c
-c
-c         Index of sst in total number of fields jpfldo2a: 
-          index = 1
-c
-          CALL SIPC_Read_Model(index, imjm, cmodinf, 
-     $              cljobnam_r,infos, sst)
-c
-c         reading of input field sea-ice SIICECOV
-c
-c
-c         Index of sea-ice in total number of fields jpfldo2a: 
-          index = 2
-c
-          CALL SIPC_Read_Model(index, imjm, cmodinf, 
-     $              cljobnam_r,infos, gla)
-c
-c
-      ELSE IF (cchan.eq.'CLIM') THEN 
-
-c
-c exchanges from ocean=CPL to atmosphere
-c
-          DO jf=1,jpfldo2a
-            IF (jf.eq.1) CALL CLIM_Import (cl_read(jf) , kt, sst, info)
-            IF (jf.eq.2) CALL CLIM_Import (cl_read(jf) , kt, gla, info)
-            IF ( info .NE. CLIM_Ok) THEN
-                WRITE(nuout,*)'Pb in reading ', cl_read(jf), jf
-                WRITE(nuout,*)'Couplage kt is = ',kt
-                WRITE(nuout,*)'CLIM error code is = ', info
-                WRITE(nuout,*)'STOP in Fromcpl'
-                STOP 'Fromcpl'
-            ENDIF
-          END DO 
-
-      ENDIF 
-c
-      RETURN
-      END
-
-
-      SUBROUTINE intocpl(kt,imjm,
-     .                   fsol, fnsol,
-     .                   rain, snow, evap, ruisoce, ruisriv,
-     .                   taux, tauy, last)
-      IMPLICIT NONE
-c
-c Laurent Z.X Li (Feb. 10, 1997): It provides several fields to the
-c coupler. Of course, it sends a message to the corresponding pipes
-c after the writting.
-c 3 techniques : pipes
-c                clim
-c                svipc
-c IF last time step WRITE output files anway
-c
-#include "oasis.h"
-
-      INTEGER kt, imjm
-c
-      REAL fsol(imjm)
-      REAL fnsol(imjm)
-      REAL rain(imjm)
-      REAL snow(imjm)
-      REAL evap(imjm)
-      REAL ruisoce(imjm)
-      REAL ruisriv(imjm)
-      REAL taux(imjm)
-      REAL tauy(imjm)
-      LOGICAL last
-c
-      INTEGER nuout
-      PARAMETER (nuout = 6)
-c
-c Additions for SVIPC
-c
-      INTEGER index
-      INTEGER infos(3)
-      CHARACTER*3 cmodinf       ! Header or not
-      CHARACTER*3 cljobnam      ! experiment name
-c
-#include "clim.h"
-c
-#include "param_cou.h"
-c
-#include "inc_sipc.h"
-#include "inc_cpl.h"
-c
-C
-      INTEGER nuwrit, ios
-      CHARACTER*8 pipnom
-      CHARACTER*8 fldnom
-      CHARACTER*6 file_name(jpmaxfld)
-      INTEGER max_file
-      INTEGER file_unit_max, file_unit(jpmaxfld),
-     $    file_unit_field(jpmaxfld) 
-
-      INTEGER icstep, info, jn, jf, ierror
-      LOGICAL trouve
-c
-c
-      icstep=kt 
-c
-      WRITE(nuout,*) ' '
-      WRITE(nuout,*) 'Intocpl: send fields to CPL, kt= ', kt
-      WRITE(nuout,*) ' '
-
-      IF (last.or.(cchan.eq.'PIPE')) THEN 
-c
-c
-c WRITE fields for coupler with pipe technique or for last time step
-c
-c         initialisation
-c
-          max_file=1
-          file_unit_max=99
-c keeps first file name
-          file_name(max_file)=cl_f_writ(max_file)
-c keeps first file unit
-          file_unit(max_file)=file_unit_max
-c decrements file unit maximum
-          file_unit_max=file_unit_max-1
-c keeps file unit for field
-          file_unit_field(1)=file_unit(max_file)
-c
-c different files names counter
-c
-          
-          DO jf= 2, jpflda2o
-            trouve=.false.
-            DO jn= 1, max_file
-              IF (.not.trouve) THEN
-                  IF (cl_f_writ(jf).EQ.file_name(jn)) THEN
-c keep file unit for field
-                      file_unit_field(jf)=file_unit(jn)
-                      trouve=.true.
-                  END IF 
-              END IF 
-            END DO 
-            IF (.not.trouve) then
-c increment the number of different files
-                max_file=max_file+1
-c keep file name
-                file_name(max_file)=cl_f_writ(jf)
-c keep file unit for file
-                file_unit(max_file)=file_unit_max
-c keep file unit for field
-                file_unit_field(jf)=file_unit(max_file)
-c decrement unit maximum number from 99 to 98, ...
-                file_unit_max=file_unit_max-1
-            END IF 
-          END DO 
-          
-          DO jn=1, max_file 
-            OPEN (file_unit(jn), FILE=file_name(jn), FORM='UNFORMATTED')
-          END DO 
-          
-          DO jf=1, jpflda2o
-            IF (jf.eq.1)
-     $          CALL locwrite(cl_writ(jf),fnsol, imjm,
-     $          file_unit_field(jf), ierror, nuout) 
-            IF (jf.eq.2)
-     $          CALL locwrite(cl_writ(jf),fsol, imjm,
-     $          file_unit_field(jf), ierror, nuout) 
-            IF (jf.eq.3)
-     $          CALL locwrite(cl_writ(jf),rain, imjm,
-     $          file_unit_field(jf), ierror, nuout) 
-            IF (jf.eq.4)
-     $          CALL locwrite(cl_writ(jf),evap, imjm,
-     $          file_unit_field(jf), ierror, nuout) 
-            IF (jf.eq.5)
-     $          CALL locwrite(cl_writ(jf),ruisoce, imjm,
-     $          file_unit_field(jf),ierror, nuout) 
-            IF (jf.eq.6)
-     $          CALL locwrite(cl_writ(jf),ruisriv, imjm,
-     $          file_unit_field(jf),ierror, nuout) 
-            IF (jf.eq.7)
-     $          CALL locwrite(cl_writ(jf),taux, imjm,
-     $          file_unit_field(jf), ierror, nuout) 
-            IF (jf.eq.8)
-     $          CALL locwrite(cl_writ(jf),taux, imjm,
-     $          file_unit_field(jf), ierror, nuout) 
-            IF (jf.eq.9)
-     $          CALL locwrite(cl_writ(jf),tauy, imjm,
-     $          file_unit_field(jf), ierror, nuout) 
-            IF (jf.eq.10)
-     $          CALL locwrite(cl_writ(jf),tauy, imjm,
-     $          file_unit_field(jf), ierror, nuout) 
-          END DO 
-C
-C simulate a FLUSH
-C
-          DO jn=1, max_file 
-            CLOSE (file_unit(jn))
-          END DO 
-c
-c 
-c
-          IF(cchan.eq.'CLIM') THEN 
-c
-c inform PVM daemon, I have finished
-c
-              CALL CLIM_Quit (CLIM_ContPvm, info)
-              IF (info .NE. CLIM_Ok) THEN
-                  WRITE (6, *) 
-     $                'An error occured while leaving CLIM. Error = ',
-     $                info
-              ENDIF
-              
-          END IF 
-          
-      END IF 
-      
-c
-c IF last we have finished
-c
-      IF (last) RETURN 
-      
-      IF (cchan.eq.'PIPE') THEN 
-c
-c Send message to pipes for CPL=ocean
-c
-          DO jf=1, jpflda2o
-            CALL PIPE_Model_Send(cl_writ(jf), kt, nuout)
-          END DO 
-c
-c 
-c
-      ELSE  IF(cchan.eq.'SIPC') THEN 
-c
-c         Define IF a header must be encapsulated within the field brick :
-          cmodinf = 'NOT'                 ! as $MODINFO in namcouple  
-c
-c         IF cmodinf = 'YES', define encapsulated infos to be exchanged
-c		  infos(1) = initial date
-c		  infos(2) = timestep
-c		  infos(3) = actual time
-c
-c         Writing of output field non solar heat flux CONSFTOT
-c
-c         Index of non solar heat flux in total number of fields jpflda2o: 
-          index = 1
-c   
-          CALL SIPC_Write_Model(index, imjm, cmodinf,
-     $                          cljobnam,infos,fnsol)
-c
-c
-c         Writing of output field solar heat flux COSHFTOT
-c
-c         Index of solar heat flux in total number of fields jpflda2o: 
-          index = 2
-c   
-          CALL SIPC_Write_Model(index, imjm, cmodinf,
-     $                          cljobnam,infos,fsol)
-c
-c         Writing of output field rain COTOPRSU
-c
-c         Index of rain in total number of fields jpflda2o: 
-          index = 3
-c   
-          CALL SIPC_Write_Model(index, imjm, cmodinf,
-     $                          cljobnam,infos, rain)
-c
-c         Writing of output field evap COTFSHSU
-c
-c         Index of evap in total number of fields jpflda2o: 
-          index = 4
-c   
-          CALL SIPC_Write_Model(index, imjm, cmodinf,
-     $                          cljobnam,infos, evap)
-c
-c         Writing of output field ruisoce CORUNCOA
-c
-c         Index of ruisoce in total number of fields jpflda2o: 
-          index = 5
-c   
-          CALL SIPC_Write_Model(index, imjm, cmodinf,
-     $                          cljobnam,infos, ruisoce)
-c
-c
-c         Writing of output field ruisriv CORIVFLU
-c
-c         Index of ruisriv in total number of fields jpflda2o: 
-          index = 6
-c   
-          CALL SIPC_Write_Model(index, imjm, cmodinf,
-     $                          cljobnam,infos, ruisriv)
-c
-c
-c         Writing of output field zonal wind stress COZOTAUX
-c
-c         Index of runoff in total number of fields jpflda2o: 
-          index = 7
-c   
-          CALL SIPC_Write_Model(index, imjm, cmodinf,
-     $                          cljobnam,infos, taux)
-c
-c         Writing of output field meridional wind stress COMETAUY
-c
-c         Index of runoff in total number of fields jpflda2o: 
-          index = 8
-c   
-          CALL SIPC_Write_Model(index, imjm, cmodinf,
-     $                          cljobnam,infos, taux)
-c
-c
-c         Writing of output field zonal wind stress COMETAU2 (at v point)
-c
-c         Index of runoff in total number of fields jpflda2o: 
-          index = 9
-c   
-          CALL SIPC_Write_Model(index, imjm, cmodinf,
-     $                          cljobnam,infos, tauy)
-c
-c         Writing of output field meridional wind stress COMETAU2
-c
-c         Index of runoff in total number of fields jpflda2o: 
-          index = 10
-c   
-          CALL SIPC_Write_Model(index, imjm, cmodinf,
-     $                          cljobnam,infos, tauy)
-c
-c
-      ELSE IF(cchan.eq.'CLIM') THEN 
-          
-          DO jn=1, jpflda2o
-            
-            IF (jn.eq.1) CALL CLIM_Export(cl_writ(jn), kt, fnsol, info)
-            IF (jn.eq.2) CALL CLIM_Export(cl_writ(jn), kt, fsol, info)
-            IF (jn.eq.3) CALL CLIM_Export(cl_writ(jn), kt, rain, info)
-            IF (jn.eq.4) CALL CLIM_Export(cl_writ(jn), kt, evap, info)
-            IF (jn.eq.5) CALL CLIM_Export(cl_writ(jn), kt, ruisoce, info
-     $          )
-            IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, ruisriv, info
-     $          )
-            IF (jn.eq.7) CALL CLIM_Export(cl_writ(jn), kt, taux, info)
-            IF (jn.eq.8) CALL CLIM_Export(cl_writ(jn), kt, taux, info)
-            IF (jn.eq.9) CALL CLIM_Export(cl_writ(jn), kt, tauy, info)
-            IF (jn.eq.10) CALL CLIM_Export(cl_writ(jn), kt, tauy, info)
-            
-            IF (info .NE. CLIM_Ok) THEN
-                WRITE (nuout,*) 'STEP : Pb giving ',cl_writ(jn), ':',jn
-                WRITE (nuout,*) ' at timestep = ', icstep,'kt = ',kt
-                WRITE (nuout,*) 'Clim error code is = ',info
-                WRITE (nuout,*) 'STOP in intocpl '
-                CALL abort(' intocpl ')
-            ENDIF
-            
-          END DO 
-          
-      ENDIF 
-c
-      RETURN
-      END
-
-      SUBROUTINE locread
-      print *, 'Attention dans oasis.F, locread est non defini'
-      RETURN
-      END
-
-      SUBROUTINE locwrite
-      print *, 'Attention dans oasis.F, locwrite est non defini'
-      RETURN
-      END
-
-      SUBROUTINE pipe_model_define
-      print*,'Attention dans oasis.F, pipe_model_define est non defini'
-      RETURN
-      END
-
-      SUBROUTINE pipe_model_stepi
-      print*,'Attention dans oasis.F, pipe_model_stepi est non defini'
-      RETURN
-      END
-
-      SUBROUTINE pipe_model_recv
-      print *, 'Attention dans oasis.F, pipe_model_recv est non defini'
-      RETURN
-      END
-
-      SUBROUTINE pipe_model_send
-      print *, 'Attention dans oasis.F, pipe_model_send est non defini'
-      RETURN
-      END
-
-      SUBROUTINE clim_stepi
-      print *, 'Attention dans oasis.F, clim_stepi est non defini'
-      RETURN
-      END
-
-      SUBROUTINE clim_start
-      print *, 'Attention dans oasis.F, clim_start est non defini'
-      RETURN
-      END
-
-      SUBROUTINE clim_import
-      print *, 'Attention dans oasis.F, clim_import est non defini'
-      RETURN
-      END
-
-      SUBROUTINE clim_export
-      print *, 'Attention dans oasis.F, clim_export est non defini'
-      RETURN
-      END
-
-      SUBROUTINE clim_init
-      print *, 'Attention dans oasis.F, clim_init est non defini'
-      RETURN
-      END
-
-      SUBROUTINE clim_define
-      print *, 'Attention dans oasis.F, clim_define est non defini'
-      RETURN
-      END
-
-      SUBROUTINE clim_quit
-      print *, 'Attention dans oasis.F, clim_quit est non defini'
-      RETURN
-      END
-
-      SUBROUTINE svipc_write
-      print *, 'Attention dans oasis.F, svipc_write est non defini'
-      RETURN
-      END
-
-      SUBROUTINE svipc_close
-      print *, 'Attention dans oasis.F, svipc_close est non defini'
-      RETURN
-      END
-
-      SUBROUTINE svipc_read
-      print *, 'Attention dans oasis.F, svipc_read est non defini'
-      RETURN
-      END
-
-      SUBROUTINE quitcpl
-      print *, 'Attention dans oasis.F, quitcpl est non defini'
-      RETURN
-      END
-
-      SUBROUTINE sipc_write_model
-      print *, 'Attention dans oasis.F, sipc_write_model est non defini'
-      RETURN
-      END
-
-      SUBROUTINE sipc_attach
-      print *, 'Attention dans oasis.F, sipc_attach est non defini'
-      RETURN
-      END
-
-      SUBROUTINE sipc_init_model
-      print *, 'Attention dans oasis.F, sipc_init_model est non defini'
-      RETURN
-      END
-
-      SUBROUTINE sipc_read_model
-      print *, 'Attention dans oasis.F, sipc_read_model est non defini'
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/oasis.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/oasis.h	(revision 416)
+++ 	(revision )
@@ -1,9 +1,0 @@
-      LOGICAL ok_oasis
-      PARAMETER (ok_oasis = .FALSE.)
-c
-      CHARACTER*4 cchan
-      PARAMETER (cchan="PIPE")
-c      PARAMETER (cchan="CLIM")
-
-      INTEGER jpmaxfld
-      PARAMETER(jpmaxfld = 20)
Index: LMDZ.3.3/branches/rel-/libf/phylmd/oasis.true
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/oasis.true	(revision 416)
+++ 	(revision )
@@ -1,546 +1,0 @@
-C $Id$
-C****
-C
-C**** *INICMA*  - Initialize coupled mode communication for atmosphere
-C                 and exchange some initial information with Oasis
-C
-C     Input:
-C     -----
-C       KASTP  : total number of timesteps in atmospheric model
-C       KEXCH  : frequency of exchange (in time steps)
-C       KSTEP  : length of timestep (in seconds)
-C
-C     -----------------------------------------------------------
-C
-      SUBROUTINE inicma(kastp,kexch,kstep,imjm)
-c
-c     INCLUDE 'param.h'
-c
-      INTEGER kastp, kexch, kstep,imjm
-      INTEGER iparal(3)
-      INTEGER ifcpl, idt, info, imxtag, istep, jf
-c
-      INCLUDE 'param_cou.h'
-      INCLUDE 'inc_cpl.h'
-      CHARACTER*3 cljobnam      ! experiment name
-      CHARACTER*6 clmodnam      ! model name
-c     EM: not used by Oasis2.4
-CEM      CHARACTER*6 clbid(2)      ! for CLIM_Init call (not used)
-CEM                                ! must be dimensioned by the number of models
-CEM      INTEGER nbid(2)           ! for CLIM_Init call (not used)
-CEM                                ! must be dimensioned by the number of models
-      CHARACTER*5 cloasis       ! coupler name (Oasis)
-      INTEGER imess(4)
-      INTEGER getpid            ! system functions
-      INTEGER nuout
-CEM      LOGICAL llmodel
-      PARAMETER (nuout = 6)
-c
-      INCLUDE 'clim.h'
-      INCLUDE 'mpiclim.h'
-c
-      INCLUDE 'oasis.h' ! contains the name of communication technique. Here
-                        ! cchan=CLIM only is possible.
-c			! ctype=MPI2
-c
-C     -----------------------------------------------------------
-C
-C*    1. Initializations
-C        ---------------
-C
-      WRITE(nuout,*) ' '
-      WRITE(nuout,*) ' '
-      WRITE(nuout,*) ' ROUTINE INICMA'
-      WRITE(nuout,*) ' **************'
-      WRITE(nuout,*) ' '
-      WRITE(nuout,*) ' '
-c
-c     Define the model name
-c
-      clmodnam = 'lmdz.x'       ! as in $NBMODEL in Cpl/Nam/namcouple.tmp
-c
-c     Define the coupler name
-c
-      cloasis = 'Oasis'        !  always 'Oasis' as in the coupler
-c
-c
-c     Define symbolic name for fields exchanged from atmos to coupler,
-c         must be the same as (1) of the field  definition in namcouple:
-c
-      cl_writ(1)='COSHFICE'
-      cl_writ(2)='COSHFOCE'
-      cl_writ(3)='CONSFICE'
-      cl_writ(4)='CONSFOCE'
-      cl_writ(5)='CODFLXDT'
-c      cl_writ(6)='COICTEMP'
-      cl_writ(6)='COTFSICE'
-      cl_writ(7)='COTFSOCE'
-      cl_writ(8)='COTOLPSU'
-      cl_writ(9)='COTOSPSU'
-      cl_writ(10)='CORUNCOA'
-      cl_writ(11)='CORIVFLU'
-      cl_writ(12)='COZOTAUX'
-      cl_writ(13)='COZOTAUV'
-      cl_writ(14)='COMETAUY'
-      cl_writ(15)='COMETAUU'
-c
-c     Define files name for fields exchanged from atmos to coupler,
-c         must be the same as (6) of the field  definition in namcouple:
-c
-      cl_f_writ(1)='flxatmos'
-      cl_f_writ(2)='flxatmos'
-      cl_f_writ(3)='flxatmos'
-      cl_f_writ(4)='flxatmos'
-      cl_f_writ(5)='flxatmos'
-      cl_f_writ(6)='flxatmos'
-      cl_f_writ(7)='flxatmos'
-      cl_f_writ(8)='flxatmos'
-      cl_f_writ(9)='flxatmos'
-      cl_f_writ(10)='flxatmos'
-      cl_f_writ(11)='flxatmos'
-      cl_f_writ(12)='flxatmos'
-      cl_f_writ(13)='flxatmos'
-      cl_f_writ(14)='flxatmos'
-      cl_f_writ(15)='flxatmos'
-c      cl_f_writ(16)='flxatmos'
-c
-c
-c     Define symbolic name for fields exchanged from coupler to atmosphere,
-c         must be the same as (2) of the field  definition in namcouple:
-c
-      cl_read(1)='SISUTESW'
-      cl_read(2)='SIICECOV'
-      cl_read(3)='SIICEALW'
-      cl_read(4)='SIICTEMW'
-c
-c     Define files names for fields exchanged from coupler to atmosphere,
-c         must be the same as (7) of the field  definition in namcouple:
-c
-      cl_f_read(1)='sstatmos'
-      cl_f_read(2)='sstatmos'
-      cl_f_read(3)='sstatmos'
-      cl_f_read(4)='sstatmos'
-c
-c
-c     Define the number of processors involved in the coupling for
-c     Oasis (=1) and each model (as last two INTEGER on $CHATYPE line
-c     in the namcouple); they will be stored in a COMMON in mpiclim.h
-c     (used for CLIM/MPI2 only)
-      mpi_nproc(0)=1
-      mpi_nproc(1)=1
-      mpi_nproc(2)=1 
-c
-c     Define infos to be sent initially to oasis
-c
-      imess(1) = kastp      ! total number of timesteps in atmospheric model
-      imess(2) = kexch      ! period of exchange (in time steps)
-      imess(3) = kstep      ! length of atmospheric timestep (in seconds)
-      imess(4) = getpid()   ! PID of atmospheric model
-c
-c     Initialization and exchange of initial info in the CLIM technique
-c
-      IF (cchan.eq.'CLIM') THEN
-c
-c     Define the experiment name :
-c
-          cljobnam = 'CLI'      ! as $JOBNAM in namcouple
-c
-c         Start the coupling 
-c         (see lib/clim/src/CLIM_Init for the definition of input parameters)
-c
-cEM          clbid(1)='      '
-cEM          clbid(2)='      '
-cEM          nbid(1)=0
-cEM          nbid(2)=0
-CEM          llmodel=.true.
-c
-c         Define the number of processors used by each model as in
-c         $CHATYPE line of namcouple (used for CLIM/MPI2 only) 
-          mpi_totproc(1)=1
-          mpi_totproc(2)=1
-c
-c         Define names of each model as in $NBMODEL line of namcouple
-c         (used for CLIM/MPI2 only)        
-          cmpi_modnam(1)='lmdz.x'
-          cmpi_modnam(2)='oce.xx'
-c         Start the coupling 
-c
-          CALL CLIM_Init ( cljobnam, clmodnam, 3, 7,
-     *                 kastp, kexch, kstep,
-     *                 5, 3600, 3600, info )
-c
-          IF (info.ne.CLIM_Ok) THEN
-              WRITE ( nuout, *) ' inicma : pb init clim '
-              WRITE ( nuout, *) ' error code is = ', info
-              CALL halte('STOP in inicma')
-            ELSE
-              WRITE(nuout,*) 'inicma : init clim ok '
-          ENDIF
-c
-c         For each coupling field, association of a port to its symbolic name
-c
-c         -Define the parallel decomposition associated to the port of each
-c          field; here no decomposition for all ports.
-          iparal ( clim_strategy ) = clim_serial 
-          iparal ( clim_length   ) = imjm
-          iparal ( clim_offset   ) = 0
-c
-c         -Loop on total number of coupler-to-atmosphere fields
-c         (see lib/clim/src/CLIM_Define for the definition of input parameters)
-          DO jf=1, jpfldo2a
-            CALL CLIM_Define (cl_read(jf), clim_in , clim_double, iparal
-     $          , info )  
-          END DO 
-c
-c         -Loop on total number of atmosphere-to-coupler fields 
-c         (see lib/clim/src/CLIM_Define for the definition of input parameters)
-          DO jf=1, jpflda2o1+jpflda2o2
-            CALL CLIM_Define (cl_writ(jf), clim_out , clim_double,
-     $          iparal, info )   
-          END DO 
-c
-          WRITE(nuout,*) 'inicma : clim_define ok '
-c
-c         -Join a pvm group, wait for other programs and broadcast usefull 
-c          informations to Oasis and to the ocean (see lib/clim/src/CLIM_Start)
-          CALL CLIM_Start ( imxtag, info )
-          IF (info.ne.clim_ok) THEN
-              WRITE ( nuout, *) 'inicma : pb start clim '
-              WRITE ( nuout, *) ' error code is = ', info
-              CALL halte('stop in inicma')
-            ELSE
-              WRITE ( nuout, *)  'inicma : start clim ok '
-          ENDIF
-c
-c         -Get initial information from Oasis
-c          (see lib/clim/src/CLIM_Stepi)
-          CALL CLIM_Stepi (cloasis, istep, ifcpl, idt, info)
-          IF (info .NE. clim_ok) THEN
-              WRITE ( UNIT = nuout, FMT = *)
-     $            ' warning : problem in getting step info ',
-     $            'from oasis '
-              WRITE (UNIT = nuout, FMT = *)
-     $            ' =======   error code number = ', info
-            ELSE
-              WRITE (UNIT = nuout, FMT = *)
-     $            ' got step information from oasis '
-          ENDIF
-          WRITE ( nuout, *) ' number of tstep in oasis ', istep
-          WRITE ( nuout, *) ' exchange frequency in oasis ', ifcpl
-          WRITE ( nuout, *) ' length of tstep in oasis ', idt
-      ENDIF 
-
-      RETURN
-      END
-
-c $Id$
-      SUBROUTINE fromcpl(kt, imjm, sst, gla, tice, albedo)
-c ======================================================================
-c S. Valcke (02/99) adapted From L.Z.X Li: this subroutine reads the SST 
-c and Sea-Ice provided by the coupler with the CLIM (PVM exchange messages)
-c technique. 
-c======================================================================
-      IMPLICIT none
-      INTEGER imjm, kt
-      REAL sst(imjm)          ! sea-surface-temperature
-      REAL gla(imjm)          ! sea-ice
-      REAL tice(imjm)          ! temp glace
-      REAL albedo(imjm)          ! albedo glace
-c
-      INTEGER nuout             ! listing output unit
-      PARAMETER (nuout=6)
-c
-      INTEGER nuread, ios, iflag, icpliter
-      INTEGER info, jf
-c
-      INCLUDE 'clim.h'
-c
-      INCLUDE 'oasis.h'
-      INCLUDE 'param_cou.h'
-c
-      INCLUDE 'inc_cpl.h'
-c
-c
-      WRITE (nuout,*) ' '
-      WRITE (nuout,*) 'Fromcpl: Reading fields from CPL, kt=',kt
-      WRITE (nuout,*) ' '
-      CALL flush (nuout)
-
-
-      IF (cchan.eq.'CLIM') THEN 
-
-c
-c     -Get interpolated oceanic fields from Oasis
-c
-          DO jf=1,jpfldo2a
-            IF (jf.eq.1) CALL CLIM_Import (cl_read(jf) , kt, sst, info)
-            IF (jf.eq.2) CALL CLIM_Import (cl_read(jf) , kt, gla, info)
-            IF (jf.eq.3) CALL CLIM_Import (cl_read(jf), kt,albedo, info)
-            IF (jf.eq.4) CALL CLIM_Import (cl_read(jf) , kt, tice, info)
-            IF ( info .NE. CLIM_Ok) THEN
-                WRITE(nuout,*)'Pb in reading ', cl_read(jf), jf
-                WRITE(nuout,*)'Couplage kt is = ',kt
-                WRITE(nuout,*)'CLIM error code is = ', info
-                CALL halte('STOP in fromcpl.F')
-            ENDIF
-          END DO 
-
-      ENDIF 
-c
-      RETURN
-      END
-
-c $Id$
-      SUBROUTINE intocpl(kt, imjm, fsolice, fsolwat, fnsolice, fnsolwat,
-     $    fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff,
-     $    tauxu, tauxv, tauyv, tauyu, last) 
-c ======================================================================
-c S. Valcke (02/99) adapted From L.Z.X Li: this subroutine provides the 
-c atmospheric coupling fields to the coupler with the CLIM (PVM exchange 
-c messages) technique. 
-c IF last time step, writes output fields to binary files.
-c ======================================================================
-      IMPLICIT NONE
-      INTEGER kt, imjm
-c
-      REAL fsolice(imjm)
-      REAL fsolwat(imjm)
-      REAL fnsolice(imjm)
-      REAL fnsolwat(imjm)
-      REAL fnsicedt(imjm)
-      REAL ictemp(imjm)
-      REAL evice(imjm)
-      REAL evwat(imjm)
-      REAL lpre(imjm)
-      REAL spre(imjm)
-      REAL dirunoff(imjm)
-      REAL rivrunoff(imjm)
-      REAL tauxu(imjm)
-      REAL tauxv(imjm)
-      REAL tauyu(imjm)
-      REAL tauyv(imjm)
-      LOGICAL last
-c
-      INTEGER nuout
-      PARAMETER (nuout = 6)
-c
-      INCLUDE 'clim.h'
-      INCLUDE 'param_cou.h'
-      INCLUDE 'inc_cpl.h'
-c
-      CHARACTER*8 file_name(jpmaxfld)
-      INTEGER max_file
-      INTEGER file_unit_max, file_unit(jpmaxfld),
-     $    file_unit_field(jpmaxfld) 
-
-      INTEGER icstep, info, jn, jf, ierror
-      LOGICAL trouve
-c
-      INCLUDE 'oasis.h'
-c
-      icstep=kt 
-c
-      WRITE(nuout,*) ' '
-      WRITE(nuout,*) 'Intocpl: sending fields to CPL, kt= ', kt
-      WRITE(nuout,*) ' '
-
-      IF (last) THEN 
-c
-c     -WRITE fields to binary files for coupler restart at last time step
-c
-c         -initialisation and files opening
-c
-          max_file=1
-          file_unit_max=99
-c         -keeps first file name
-          file_name(max_file)=cl_f_writ(max_file)
-c         -keeps first file unit
-          file_unit(max_file)=file_unit_max
-c         -decrements file unit maximum
-          file_unit_max=file_unit_max-1
-c         -keeps file unit for field
-          file_unit_field(1)=file_unit(max_file)
-c
-c         -different files names counter
-c
-          DO jf= 2, jpflda2o1 + jpflda2o2
-            trouve=.false.
-            DO jn= 1, max_file
-              IF (.not.trouve) THEN
-                  IF (cl_f_writ(jf).EQ.file_name(jn)) THEN
-c                 -keep file unit for field
-                      file_unit_field(jf)=file_unit(jn)
-                      trouve=.true.
-                  END IF 
-              END IF 
-            END DO 
-            IF (.not.trouve) then
-c           -increment the number of different files
-                max_file=max_file+1
-c           -keep file name
-                file_name(max_file)=cl_f_writ(jf)
-c           -keep file unit for file
-                file_unit(max_file)=file_unit_max
-c           -keep file unit for field
-                file_unit_field(jf)=file_unit(max_file)
-c           -decrement unit maximum number from 99 to 98, ...
-                file_unit_max=file_unit_max-1
-            END IF 
-          END DO 
-c          
-          DO jn=1, max_file 
-            OPEN (file_unit(jn), FILE=file_name(jn), FORM='UNFORMATTED')
-          END DO
-c 
-c         WRITE fields to files          
-          DO jf=1, jpflda2o1 + jpflda2o2
-            IF (jf.eq.1)
-     $          CALL locwrite(cl_writ(jf),fsolice, imjm,
-     $          file_unit_field(jf), ierror, nuout) 
-            IF (jf.eq.2)
-     $          CALL locwrite(cl_writ(jf),fsolwat, imjm,
-     $          file_unit_field(jf), ierror, nuout) 
-            IF (jf.eq.3)
-     $          CALL locwrite(cl_writ(jf),fnsolice, imjm,
-     $          file_unit_field(jf), ierror, nuout) 
-            IF (jf.eq.4)
-     $          CALL locwrite(cl_writ(jf),fnsolwat, imjm,
-     $          file_unit_field(jf), ierror, nuout) 
-            IF (jf.eq.5)
-     $          CALL locwrite(cl_writ(jf),fnsicedt, imjm,
-     $          file_unit_field(jf), ierror, nuout) 
-c            IF (jf.eq.6)
-c     $          CALL locwrite(cl_writ(jf),ictemp, imjm,
-c     $          file_unit_field(jf), ierror, nuout) 
-            IF (jf.eq.6)
-     $          CALL locwrite(cl_writ(jf),evice, imjm,
-     $          file_unit_field(jf), ierror, nuout) 
-            IF (jf.eq.7)
-     $          CALL locwrite(cl_writ(jf),evwat, imjm,
-     $          file_unit_field(jf), ierror, nuout) 
-            IF (jf.eq.8)
-     $          CALL locwrite(cl_writ(jf),lpre, imjm,
-     $          file_unit_field(jf), ierror, nuout) 
-            IF (jf.eq.9)
-     $          CALL locwrite(cl_writ(jf),spre, imjm,
-     $          file_unit_field(jf), ierror, nuout) 
-            IF (jf.eq.10)
-     $          CALL locwrite(cl_writ(jf),dirunoff, imjm,
-     $          file_unit_field(jf), ierror, nuout) 
-            IF (jf.eq.11)
-     $          CALL locwrite(cl_writ(jf),rivrunoff, imjm,
-     $          file_unit_field(jf), ierror, nuout) 
-            IF (jf.eq.12)
-     $          CALL locwrite(cl_writ(jf),tauxu, imjm,
-     $          file_unit_field(jf),ierror, nuout) 
-            IF (jf.eq.13)
-     $          CALL locwrite(cl_writ(jf),tauxv, imjm,
-     $          file_unit_field(jf),ierror, nuout) 
-            IF (jf.eq.14)
-     $          CALL locwrite(cl_writ(jf),tauyv, imjm,
-     $          file_unit_field(jf),ierror, nuout) 
-            IF (jf.eq.15)
-     $          CALL locwrite(cl_writ(jf),tauyu, imjm,
-     $          file_unit_field(jf), ierror, nuout) 
-          END DO 
-C
-C         -simulate a FLUSH
-C
-          DO jn=1, max_file 
-            CLOSE (file_unit(jn))
-          END DO 
-C
-C
-          IF(cchan.eq.'CLIM') THEN 
-C
-C         -inform PVM daemon that message exchange is finished
-C
-              CALL CLIM_Quit (CLIM_ContPvm, info)
-              IF (info .NE. CLIM_Ok) THEN
-                  WRITE (6, *) 
-     $                'An error occured while leaving CLIM. Error = ',
-     $                info
-              ENDIF
-          END IF 
-          RETURN    
-      END IF 
-C
-      IF(cchan.eq.'CLIM') THEN 
-C
-C     -Give atmospheric fields to Oasis
-C 
-          DO jn=1, jpflda2o1 + jpflda2o2
-C            
-          IF (jn.eq.1) CALL CLIM_Export(cl_writ(jn), kt, fsolice, info)
-          IF (jn.eq.2) CALL CLIM_Export(cl_writ(jn), kt, fsolwat, info)
-          IF (jn.eq.3) CALL CLIM_Export(cl_writ(jn), kt, fnsolice, info)
-          IF (jn.eq.4) CALL CLIM_Export(cl_writ(jn), kt, fnsolwat, info)
-          IF (jn.eq.5) CALL CLIM_Export(cl_writ(jn), kt, fnsicedt, info)
-c          IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, ictemp, info)
-          IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, evice, info)
-          IF (jn.eq.7) CALL CLIM_Export(cl_writ(jn), kt, evwat, info)
-          IF (jn.eq.8) CALL CLIM_Export(cl_writ(jn), kt, lpre, info)
-          IF (jn.eq.9) CALL CLIM_Export(cl_writ(jn), kt, spre, info)
-          IF (jn.eq.10) CALL CLIM_Export(cl_writ(jn),kt,dirunoff, info)
-          IF (jn.eq.11) CALL CLIM_Export(cl_writ(jn),kt,rivrunoff,info)
-          IF (jn.eq.12) CALL CLIM_Export(cl_writ(jn), kt, tauxu, info)
-          IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxv, info)
-          IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauyv, info)
-          IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauyu, info)
-          
-            IF (info .NE. CLIM_Ok) THEN
-                WRITE (nuout,*) 'STEP : Pb giving ',cl_writ(jn), ':',jn
-                WRITE (nuout,*) ' at timestep = ', icstep,'kt = ',kt
-                WRITE (nuout,*) 'Clim error code is = ',info
-                CALL halte('STOP in intocpl ')
-            ENDIF
-          END DO 
-      ENDIF 
-C
-      RETURN
-      END
-
-      SUBROUTINE pipe_model_define
-      print*,'Attention dans oasis.F, pipe_model_define est non defini'
-      RETURN
-      END
-
-      SUBROUTINE pipe_model_stepi
-      print*,'Attention dans oasis.F, pipe_model_stepi est non defini'
-      RETURN
-      END
-
-      SUBROUTINE pipe_model_recv
-      print *, 'Attention dans oasis.F, pipe_model_recv est non defini'
-      RETURN
-      END
-
-      SUBROUTINE pipe_model_send
-      print *, 'Attention dans oasis.F, pipe_model_send est non defini'
-      RETURN
-      END
-
-      SUBROUTINE quitcpl
-      print *, 'Attention dans oasis.F, quitcpl est non defini'
-      RETURN
-      END
-
-      SUBROUTINE sipc_write_model
-      print *, 'Attention dans oasis.F, sipc_write_model est non defini'
-      RETURN
-      END
-
-      SUBROUTINE sipc_attach
-      print *, 'Attention dans oasis.F, sipc_attach est non defini'
-      RETURN
-      END
-
-      SUBROUTINE sipc_init_model
-      print *, 'Attention dans oasis.F, sipc_init_model est non defini'
-      RETURN
-      END
-
-      SUBROUTINE sipc_read_model
-      print *, 'Attention dans oasis.F, sipc_read_model est non defini'
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/orbite.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/orbite.F	(revision 416)
+++ 	(revision )
@@ -1,319 +1,0 @@
-c======================================================================
-      SUBROUTINE orbite(xjour,longi,dist)
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS) (adapte du GCM du LMD) date: 19930818
-c Objet: pour un jour donne, calculer la longitude vraie de la terre
-c        (par rapport au point vernal-21 mars) dans son orbite solaire
-c        calculer aussi la distance terre-soleil (unite astronomique)
-c======================================================================
-c Arguments:
-c xjour--INPUT--R- jour de l'annee a compter du 1er janvier
-c longi--OUTPUT-R- longitude vraie en degres par rapport au point
-c                  vernal (21 mars) en degres
-c dist---OUTPUT-R- distance terre-soleil (par rapport a la moyenne)
-      REAL xjour, longi, dist
-c======================================================================
-#include "YOMCST.h"
-C
-C  -- Variables dynamiques locales
-      REAL pir,xl,xllp,xee,xse,xlam,dlamm,anm,ranm,anv,ranv
-C
-      pir = 4.0*ATAN(1.0) / 180.0
-      xl=R_peri+180.0
-      xllp=xl*pir
-      xee=R_ecc*R_ecc
-      xse=SQRT(1.0-xee)
-      xlam = (R_ecc/2.0+R_ecc*xee/8.0)*(1.0+xse)*SIN(xllp)
-     .     - xee/4.0*(0.5+xse)*SIN(2.0*xllp)
-     .     + R_ecc*xee/8.0*(1.0/3.0+xse)*SIN(3.0*xllp)
-      xlam=2.0*xlam/pir
-      dlamm=xlam+(xjour-81.0)
-      anm=dlamm-xl
-      ranm=anm*pir
-      xee=xee*R_ecc
-      ranv=ranm+(2.0*R_ecc-xee/4.0)*SIN(ranm)
-     .         +5.0/4.0*R_ecc*R_ecc*SIN(2.0*ranm)
-     .         +13.0/12.0*xee*SIN(3.0*ranm)
-c
-      anv=ranv/pir
-      longi=anv+xl
-C
-      dist = (1-R_ecc*R_ecc)
-     .      /(1+R_ecc*COS(pir*(longi-(R_peri+180.0))))
-      RETURN
-      END
-c======================================================================
-      SUBROUTINE angle(longi, lati, frac, muzero)
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
-c Objet: Calculer la duree d'ensoleillement pour un jour et la hauteur
-c        du soleil (cosinus de l'angle zinithal) moyenne sur la journee
-c======================================================================
-c Arguments:
-c longi----INPUT-R- la longitude vraie de la terre dans son plan 
-c                   solaire a partir de l'equinoxe de printemps (degre)
-c lati-----INPUT-R- la latitude d'un point sur la terre (degre)
-c frac-----OUTPUT-R la duree d'ensoleillement dans la journee divisee
-c                   par 24 heures (unite en fraction de 0 a 1)
-c muzero---OUTPUT-R la moyenne du cosinus de l'angle zinithal sur
-c                   la journee (0 a 1)
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-      REAL longi
-      REAL lati(klon), frac(klon), muzero(klon)
-#include "YOMCST.h"
-      REAL lat, omega, lon_sun, lat_sun
-      REAL pi_local, incl
-      INTEGER i
-c
-      pi_local = 4.0 * ATAN(1.0)
-      incl=R_incl * pi_local / 180.
-c
-      lon_sun = longi * pi_local / 180.0
-      lat_sun = ASIN (sin(lon_sun)*SIN(incl) )
-c
-      DO i = 1, klon
-      lat = lati(i) * pi_local / 180.0
-c
-      IF ( lat .GE. (pi_local/2.+lat_sun)
-     .    .OR. lat.LE.(-pi_local/2.+lat_sun)) THEN
-         omega = 0.0   ! nuit polaire
-      ELSE IF ( lat.GE.(pi_local/2.-lat_sun)
-     .          .OR. lat.LE.(-pi_local/2.-lat_sun)) THEN
-         omega = pi_local   ! journee polaire
-      ELSE
-         omega = -TAN(lat)*TAN(lat_sun)
-         omega = ACOS (omega)
-      ENDIF
-c
-      frac(i) = omega / pi_local
-c
-      IF (omega .GT. 0.0) THEN
-         muzero(i) = SIN(lat)*SIN(lat_sun)
-     .          + COS(lat)*COS(lat_sun)*SIN(omega) / omega
-      ELSE
-         muzero(i) = 0.0
-      ENDIF
-      ENDDO
-c
-      RETURN
-      END
-c====================================================================
-      SUBROUTINE zenang(longi,gmtime,pdtrad,lat,long,
-     s                  pmu0,frac)
-      IMPLICIT none
-c=============================================================
-c Auteur : O. Boucher (LMD/CNRS)
-c          d'apres les routines zenith et angle de Z.X. Li 
-c Objet  : calculer les valeurs moyennes du cos de l'angle zenithal
-c          et l'ensoleillement moyen entre gmtime1 et gmtime2 
-c          connaissant la declinaison, la latitude et la longitude.
-c Rque   : Different de la routine angle en ce sens que zenang 
-c          fournit des moyennes de pmu0 et non des valeurs 
-c          instantanees, du coup frac prend toutes les valeurs 
-c          entre 0 et 1.
-c Date   : premiere version le 13 decembre 1994
-c          revu pour  GCM  le 30 septembre 1996
-c===============================================================
-c longi----INPUT : la longitude vraie de la terre dans son plan
-c                  solaire a partir de l'equinoxe de printemps (degre)
-c gmtime---INPUT : temps universel en fraction de jour
-c pdtrad---INPUT : pas de temps du rayonnement (secondes)
-c lat------INPUT : latitude en degres
-c long-----INPUT : longitude en degres
-c pmu0-----OUTPUT: angle zenithal moyen entre gmtime et gmtime+pdtrad
-c frac-----OUTPUT: ensoleillement moyen entre gmtime et gmtime+pdtrad
-c================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-c================================================================
-      real longi, gmtime, pdtrad
-      real lat(klon), long(klon), pmu0(klon), frac(klon)
-c================================================================
-      integer i
-      real gmtime1, gmtime2
-      real pi_local, deux_pi_local, incl
-      real omega1, omega2, omega
-c omega1, omega2 : temps 1 et 2 exprime en radian avec 0 a midi.
-c omega : heure en radian du coucher de soleil 
-c -omega est donc l'heure en radian de lever du soleil
-      real omegadeb, omegafin
-      real zfrac1, zfrac2, z1_mu, z2_mu
-      real lat_sun          ! declinaison en radian
-      real lon_sun          ! longitude solaire en radian
-      real latr             ! latitude du pt de grille en radian
-c================================================================
-c
-      pi_local = 4.0 * ATAN(1.0)
-      deux_pi_local = 2.0 * pi_local
-      incl=R_incl * pi_local / 180.
-c
-      lon_sun = longi * pi_local / 180.0
-      lat_sun = ASIN (SIN(lon_sun)*SIN(incl) )
-c
-      gmtime1=gmtime*86400.
-      gmtime2=gmtime*86400.+pdtrad
-c
-      DO i = 1, klon
-c
-      latr = lat(i) * pi_local / 180.
-c
-c--pose probleme quand lat=+/-90 degres
-c
-c      omega = -TAN(latr)*TAN(lat_sun)
-c      omega = ACOS(omega)
-c      IF (latr.GE.(pi_local/2.+lat_sun)
-c     .    .OR. latr.LE.(-pi_local/2.+lat_sun)) THEN
-c         omega = 0.0       ! nuit polaire
-c      ENDIF
-c      IF (latr.GE.(pi_local/2.-lat_sun)
-c     .          .OR. latr.LE.(-pi_local/2.-lat_sun)) THEN
-c         omega = pi_local  ! journee polaire
-c      ENDIF
-c
-c--remplace par cela (le cas par defaut est different)
-c
-      omega=0.0  !--nuit polaire
-      IF (latr.GE.(pi_local/2.-lat_sun)
-     .          .OR. latr.LE.(-pi_local/2.-lat_sun)) THEN
-         omega = pi_local  ! journee polaire
-      ENDIF
-      IF (latr.LT.(pi_local/2.+lat_sun).AND.
-     .    latr.GT.(-pi_local/2.+lat_sun).AND.
-     .    latr.LT.(pi_local/2.-lat_sun).AND.
-     .    latr.GT.(-pi_local/2.-lat_sun)) THEN
-      omega = -TAN(latr)*TAN(lat_sun)
-      omega = ACOS(omega)
-      ENDIF
-c
-         omega1 = gmtime1 + long(i)*86400.0/360.0
-         omega1 = omega1 / 86400.0*deux_pi_local
-         omega1 = MOD (omega1+deux_pi_local, deux_pi_local)
-         omega1 = omega1 - pi_local
-c
-         omega2 = gmtime2 + long(i)*86400.0/360.0
-         omega2 = omega2 / 86400.0*deux_pi_local
-         omega2 = MOD (omega2+deux_pi_local, deux_pi_local)
-         omega2 = omega2 - pi_local
-c
-      IF (omega1.LE.omega2) THEN  !--on est dans la meme journee locale
-c
-      IF (omega2.LE.-omega .OR. omega1.GE.omega
-     .                     .OR. omega.LT.1e-5) THEN   !--nuit
-         frac(i)=0.0
-         pmu0(i)=0.0
-      ELSE                                              !--jour+nuit/jour
-        omegadeb=MAX(-omega,omega1)
-        omegafin=MIN(omega,omega2)
-        frac(i)=(omegafin-omegadeb)/(omega2-omega1)
-        pmu0(i)=SIN(latr)*SIN(lat_sun) + 
-     .          COS(latr)*COS(lat_sun)*
-     .          (SIN(omegafin)-SIN(omegadeb))/
-     .          (omegafin-omegadeb)        
-      ENDIF
-c
-      ELSE  !---omega1 GT omega2 -- a cheval sur deux journees
-c
-c-------------------entre omega1 et pi
-      IF (omega1.GE.omega) THEN  !--nuit
-         zfrac1=0.0
-         z1_mu =0.0
-      ELSE                       !--jour+nuit
-        omegadeb=MAX(-omega,omega1)
-        omegafin=omega
-        zfrac1=omegafin-omegadeb
-        z1_mu =SIN(latr)*SIN(lat_sun) +
-     .          COS(latr)*COS(lat_sun)*
-     .          (SIN(omegafin)-SIN(omegadeb))/
-     .          (omegafin-omegadeb)
-      ENDIF 
-c---------------------entre -pi et omega2
-      IF (omega2.LE.-omega) THEN   !--nuit
-         zfrac2=0.0
-         z2_mu =0.0
-      ELSE                         !--jour+nuit
-         omegadeb=-omega
-         omegafin=MIN(omega,omega2)
-         zfrac2=omegafin-omegadeb
-         z2_mu =SIN(latr)*SIN(lat_sun) +
-     .           COS(latr)*COS(lat_sun)*
-     .           (SIN(omegafin)-SIN(omegadeb))/
-     .           (omegafin-omegadeb)
-c
-      ENDIF
-c-----------------------moyenne 
-      frac(i)=(zfrac1+zfrac2)/(omega2+deux_pi_local-omega1)
-      pmu0(i)=(zfrac1*z1_mu+zfrac2*z2_mu)/MAX(zfrac1+zfrac2,1.E-10)
-c
-      ENDIF   !---comparaison omega1 et omega2
-c
-      ENDDO
-c
-      END
-c===================================================================
-      SUBROUTINE zenith (longi, gmtime, lat, long,
-     s                   pmu0, fract)
-      IMPLICIT none
-c
-c Auteur(s): Z.X. Li (LMD/ENS)
-c
-c Objet: calculer le cosinus de l'angle zenithal du soleil en
-c        connaissant la declinaison du soleil, la latitude et la
-c        longitude du point sur la terre, et le temps universel
-c
-c Arguments d'entree:
-c     longi  : declinaison du soleil (en degres)
-c     gmtime : temps universel en second qui varie entre 0 et 86400
-c     lat    : latitude en degres
-c     long   : longitude en degres
-c Arguments de sortie:
-c     pmu0   : cosinus de l'angle zenithal
-c
-c====================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-c====================================================================
-      REAL longi, gmtime
-      REAL lat(klon), long(klon), pmu0(klon), fract(klon)
-c=====================================================================
-      INTEGER n
-      REAL zpi, zpir, omega, zgmtime
-      REAL incl, lat_sun, lon_sun
-c----------------------------------------------------------------------
-      zpi = 4.0*ATAN(1.0)
-      zpir = zpi / 180.0
-      zgmtime=gmtime*86400.
-c
-      incl=R_incl * zpir
-c
-      lon_sun = longi * zpir
-      lat_sun = ASIN (SIN(lon_sun)*SIN(incl) )
-c
-c--initialisation a la nuit
-c
-      DO n =1, klon
-        pmu0(n)=0.
-        fract(n)=0.0
-      ENDDO
-c
-c 1 degre en longitude = 240 secondes en temps
-c
-      DO n = 1, klon
-         omega = zgmtime + long(n)*86400.0/360.0
-         omega = omega / 86400.0 * 2.0 * zpi
-         omega = MOD(omega + 2.0 * zpi, 2.0 * zpi)
-         omega = omega - zpi
-         pmu0(n) = sin(lat(n)*zpir) * sin(lat_sun)
-     .           + cos(lat(n)*zpir) * cos(lat_sun)
-     .           * cos(omega)
-         pmu0(n) = MAX (pmu0(n), 0.0)
-         IF (pmu0(n).GT.1.E-6) fract(n)=1.0
-      ENDDO
-c
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/orografi.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/orografi.F	(revision 416)
+++ 	(revision )
@@ -1,1750 +1,0 @@
-      SUBROUTINE drag_noro (nlon,nlev,dtime,paprs,pplay,
-     e                   pmea,pstd, psig, pgam, pthe,ppic,pval,
-     e                   kgwd,kgwdim,kdx,ktest,
-     e                   t, u, v,
-     s                   pulow, pvlow, pustr, pvstr,
-     s                   d_t, d_u, d_v)
-c
-      IMPLICIT none
-c======================================================================
-c Auteur(s): F.Lott (LMD/CNRS) date: 19950201
-c Objet: Frottement de la montagne Interface
-c======================================================================
-c Arguments:
-c dtime---input-R- pas d'integration (s)
-c paprs---input-R-pression pour chaque inter-couche (en Pa)
-c pplay---input-R-pression pour le mileu de chaque couche (en Pa)
-c t-------input-R-temperature (K)
-c u-------input-R-vitesse horizontale (m/s)
-c v-------input-R-vitesse horizontale (m/s)
-c
-c d_t-----output-R-increment de la temperature             
-c d_u-----output-R-increment de la vitesse u
-c d_v-----output-R-increment de la vitesse v
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-c
-c ARGUMENTS
-c
-      INTEGER nlon,nlev
-      REAL dtime
-      REAL paprs(klon,klev+1)
-      REAL pplay(klon,klev)
-      REAL pmea(nlon),pstd(nlon),psig(nlon),pgam(nlon),pthe(nlon)
-      REAL ppic(nlon),pval(nlon)
-      REAL pulow(nlon),pvlow(nlon),pustr(nlon),pvstr(nlon)
-      REAL t(nlon,nlev), u(nlon,nlev), v(nlon,nlev)
-      REAL d_t(nlon,nlev), d_u(nlon,nlev), d_v(nlon,nlev)
-c
-      INTEGER i, k, kgwd, kgwdim, kdx(nlon), ktest(nlon)
-c
-c Variables locales:
-c
-      REAL zgeom(klon,klev)
-      REAL pdtdt(klon,klev), pdudt(klon,klev), pdvdt(klon,klev)
-      REAL pt(klon,klev), pu(klon,klev), pv(klon,klev)
-      REAL papmf(klon,klev),papmh(klon,klev+1)
-c
-c initialiser les variables de sortie (pour securite)
-c
-      DO i = 1,klon
-         pulow(i) = 0.0
-         pvlow(i) = 0.0
-         pustr(i) = 0.0
-         pvstr(i) = 0.0
-      ENDDO
-      DO k = 1, klev
-      DO i = 1, klon
-         d_t(i,k) = 0.0
-         d_u(i,k) = 0.0
-         d_v(i,k) = 0.0
-         pdudt(i,k)=0.0
-         pdvdt(i,k)=0.0
-         pdtdt(i,k)=0.0
-      ENDDO
-      ENDDO
-c
-c preparer les variables d'entree (attention: l'ordre des niveaux 
-c verticaux augmente du haut vers le bas)
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         pt(i,k) = t(i,klev-k+1) 
-         pu(i,k) = u(i,klev-k+1)
-         pv(i,k) = v(i,klev-k+1)
-         papmf(i,k) = pplay(i,klev-k+1)
-      ENDDO
-      ENDDO
-      DO k = 1, klev+1
-      DO i = 1, klon
-         papmh(i,k) = paprs(i,klev-k+2)
-      ENDDO
-      ENDDO
-      DO i = 1, klon
-         zgeom(i,klev) = RD * pt(i,klev)
-     .                  * LOG(papmh(i,klev+1)/papmf(i,klev))
-      ENDDO
-      DO k = klev-1, 1, -1
-      DO i = 1, klon
-         zgeom(i,k) = zgeom(i,k+1) + RD * (pt(i,k)+pt(i,k+1))/2.0
-     .               * LOG(papmf(i,k+1)/papmf(i,k))
-      ENDDO
-      ENDDO
-c
-c appeler la routine principale
-c
-      CALL orodrag(klon,klev,kgwd,kgwdim,kdx,ktest,
-     .            dtime,
-     .            papmh, papmf, zgeom,
-     .            pt, pu, pv,
-     .            pmea, pstd, psig, pgam, pthe, ppic,pval,
-     .            pulow,pvlow,
-     .            pdudt,pdvdt,pdtdt)
-C
-      DO k = 1, klev
-      DO i = 1, klon
-         d_u(i,klev+1-k) = dtime*pdudt(i,k)
-         d_v(i,klev+1-k) = dtime*pdvdt(i,k)
-         d_t(i,klev+1-k) = dtime*pdtdt(i,k)
-         pustr(i)        = pustr(i)
-     .                    +rg*pdudt(i,k)*(papmh(i,k+1)-papmh(i,k))
-         pvstr(i)        = pvstr(i)
-     .                    +rg*pdvdt(i,k)*(papmh(i,k+1)-papmh(i,k))
-      ENDDO
-      ENDDO
-c
-      RETURN
-      END
-      SUBROUTINE orodrag( nlon,nlev 
-     i                 , kgwd, kgwdim, kdx, ktest
-     r                 , ptsphy
-     r                 , paphm1,papm1,pgeom1,ptm1,pum1,pvm1
-     r                 , pmea, pstd, psig, pgamma, ptheta, ppic, pval
-c outputs
-     r                 , pulow,pvlow
-     r                 , pvom,pvol,pte )
-c
-c
-c**** *gwdrag* - does the gravity wave parametrization.
-c
-c     purpose.
-c     --------
-c
-c          this routine computes the physical tendencies of the
-c     prognostic variables u,v  and t due to  vertical transports by
-c     subgridscale orographically excited gravity waves
-c
-c**   interface.
-c     ----------
-c          called from *callpar*.
-c
-c          the routine takes its input from the long-term storage:
-c          u,v,t and p at t-1.
-c
-c        explicit arguments :
-c        --------------------
-c     ==== inputs ===
-c     ==== outputs ===
-c
-c        implicit arguments :   none
-c        --------------------
-c
-      implicit logical (l)
-c
-c     method.
-c     -------
-c
-c     externals.
-c     ----------
-      integer ismin, ismax
-      external ismin, ismax
-c
-c     reference.
-c     ----------
-c
-c     author.
-c     -------
-c     m.miller + b.ritter   e.c.m.w.f.     15/06/86.
-c
-c     f.lott + m. miller    e.c.m.w.f.     22/11/94
-c-----------------------------------------------------------------------
-c
-c
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "YOEGWD.h"
-c-----------------------------------------------------------------------
-c
-c*       0.1   arguments
-c              ---------
-c
-c
-      real  pte(nlon,nlev),
-     *      pvol(nlon,nlev),
-     *      pvom(nlon,nlev),
-     *      pulow(klon),
-     *      pvlow(klon)
-      real  pum1(nlon,nlev),
-     *      pvm1(nlon,nlev),
-     *      ptm1(nlon,nlev),
-     *      pmea(nlon),pstd(nlon),psig(nlon),
-     *      pgamma(nlon),ptheta(nlon),ppic(nlon),pval(nlon),
-     *      pgeom1(nlon,nlev),
-     *      papm1(nlon,nlev),
-     *      paphm1(nlon,nlev+1)
-c
-      integer  kdx(nlon),ktest(nlon)
-c-----------------------------------------------------------------------
-c
-c*       0.2   local arrays
-c              ------------
-      integer  isect(klon),
-     *         icrit(klon),
-     *         ikcrith(klon),
-     *         ikenvh(klon),
-     *         iknu(klon),
-     *         iknu2(klon),
-     *         ikcrit(klon),
-     *         ikhlim(klon)
-c
-      real   ztau(klon,klev+1),
-     *       zstab(klon,klev+1),
-     *       zvph(klon,klev+1),
-     *       zrho(klon,klev+1),
-     *       zri(klon,klev+1),
-     *       zpsi(klon,klev+1),
-     *       zzdep(klon,klev)
-      real   zdudt(klon),
-     *       zdvdt(klon),
-     *       zdtdt(klon),
-     *       zdedt(klon),
-     *       zvidis(klon),
-     *       ztfr(klon),
-     *       znu(klon),
-     *       zd1(klon),
-     *       zd2(klon),
-     *       zdmod(klon)
-c
-c------------------------------------------------------------------
-c
-c*         1.    initialization
-c                --------------
-c
- 100  continue
-c
-c     ------------------------------------------------------------------
-c
-c*         1.1   computational constants
-c                -----------------------
-c
- 110  continue
-c
-c     ztmst=twodt
-c     if(nstep.eq.nstart) ztmst=0.5*twodt
-      klevm1=klev-1
-      ztmst=ptsphy
-      zrtmst=1./ztmst
-c     ------------------------------------------------------------------
-c
- 120  continue
-c
-c     ------------------------------------------------------------------
-c
-c*         1.3   check whether row contains point for printing
-c                ---------------------------------------------
-c
- 130  continue
-c
-c     ------------------------------------------------------------------
-c
-c*         2.     precompute basic state variables.
-c*                ---------- ----- ----- ----------
-c*                define low level wind, project winds in plane of
-c*                low level wind, determine sector in which to take
-c*                the variance and set indicator for critical levels.
-c
-  200 continue
-c
-c
-c
-      call orosetup
-     *     ( nlon, nlev , ktest 
-     *     , ikcrit, ikcrith, icrit, isect, ikhlim, ikenvh,iknu,iknu2
-     *     , paphm1, papm1 , pum1   , pvm1 , ptm1 , pgeom1, pstd
-     *     , zrho  , zri   , zstab  , ztau , zvph , zpsi, zzdep
-     *     , pulow, pvlow 
-     *     , ptheta,pgamma,pmea,ppic,pval,znu  ,zd1,  zd2,  zdmod )
-c
-c
-c
-c***********************************************************
-c
-c
-c*         3.      compute low level stresses using subcritical and
-c*                 supercritical forms.computes anisotropy coefficient
-c*                 as measure of orographic twodimensionality.
-c
-  300 continue
-c
-      call gwstress
-     *    ( nlon  , nlev
-     *    , ikcrit, isect, ikhlim, ktest, ikcrith, icrit, ikenvh, iknu
-     *    , zrho  , zstab, zvph  , pstd,  psig, pmea, ppic, pval
-     *    , ztfr   , ztau 
-     *    , pgeom1,pgamma,zd1,zd2,zdmod,znu)
-c
-c
-c*         4.      compute stress profile.
-c*                 ------- ------ --------
-c
-  400 continue
-c
-c
-      call gwprofil
-     *       (  nlon , nlev
-     *       , kgwd   , kdx  , ktest
-     *       , ikcrit, ikcrith, icrit  , ikenvh, iknu
-     *       ,iknu2 , paphm1, zrho   , zstab , ztfr   , zvph
-     *       , zri   , ztau   , ztauf
-c
-     *       , zdmod , znu    , psig  , pgamma , pstd , ppic , pval)
-c
-c
-c*         5.      compute tendencies.
-c*                 -------------------
-c
-  500 continue
-c
-c  explicit solution at all levels for the gravity wave
-c  implicit solution for the blocked levels
-
-      do 510 jl=kidia,kfdia
-      zvidis(jl)=0.0
-      zdudt(jl)=0.0
-      zdvdt(jl)=0.0
-      zdtdt(jl)=0.0
-  510 continue
-c
-      ilevp1=klev+1
-c
-c
-      do 524 jk=1,klev
-c
-c
-      do 523 jl=1,kgwd
-      ji=kdx(jl)
-      zdelp=paphm1(ji,jk+1)-paphm1(ji,jk)
-      ztemp=-rg*(ztau(ji,jk+1)-ztau(ji,jk))/(zvph(ji,ilevp1)*zdelp)
-      zdudt(ji)=(pulow(ji)*zd1(ji)-pvlow(ji)*zd2(ji))*ztemp/zdmod(ji)
-      zdvdt(ji)=(pvlow(ji)*zd1(ji)+pulow(ji)*zd2(ji))*ztemp/zdmod(ji)
-c
-c controle des overshoots:
-c
-      zforc=sqrt(zdudt(ji)**2+zdvdt(ji)**2)+1.E-12
-      ztend=sqrt(pum1(ji,jk)**2+pvm1(ji,jk)**2)/ztmst+1.E-12
-      rover=0.25
-      if(zforc.ge.rover*ztend)then
-        zdudt(ji)=rover*ztend/zforc*zdudt(ji)
-        zdvdt(ji)=rover*ztend/zforc*zdvdt(ji)
-      endif
-c
-c fin du controle des overshoots
-c
-      if(jk.ge.ikenvh(ji)) then
-         zb=1.0-0.18*pgamma(ji)-0.04*pgamma(ji)**2
-         zc=0.48*pgamma(ji)+0.3*pgamma(ji)**2
-         zconb=2.*ztmst*gkwake*psig(ji)/(4.*pstd(ji))
-         zabsv=sqrt(pum1(ji,jk)**2+pvm1(ji,jk)**2)/2.
-         zzd1=zb*cos(zpsi(ji,jk))**2+zc*sin(zpsi(ji,jk))**2
-	     ratio=(cos(zpsi(ji,jk))**2+pgamma(ji)*sin(zpsi(ji,jk))**2)/
-     *   (pgamma(ji)*cos(zpsi(ji,jk))**2+sin(zpsi(ji,jk))**2)
-         zbet=max(0.,2.-1./ratio)*zconb*zzdep(ji,jk)*zzd1*zabsv
-c
-c simplement oppose au vent
-c
-         zdudt(ji)=-pum1(ji,jk)/ztmst
-         zdvdt(ji)=-pvm1(ji,jk)/ztmst
-c
-c  projection dans la direction de l'axe principal de l'orographie
-cmod     zdudt(ji)=-(pum1(ji,jk)*cos(ptheta(ji)*rpi/180.)
-cmod *              +pvm1(ji,jk)*sin(ptheta(ji)*rpi/180.))
-cmod *              *cos(ptheta(ji)*rpi/180.)/ztmst
-cmod     zdvdt(ji)=-(pum1(ji,jk)*cos(ptheta(ji)*rpi/180.)
-cmod *              +pvm1(ji,jk)*sin(ptheta(ji)*rpi/180.))
-cmod *              *sin(ptheta(ji)*rpi/180.)/ztmst
-         zdudt(ji)=zdudt(ji)*(zbet/(1.+zbet))
-         zdvdt(ji)=zdvdt(ji)*(zbet/(1.+zbet))
-      end if
-      pvom(ji,jk)=zdudt(ji)
-      pvol(ji,jk)=zdvdt(ji)
-      zust=pum1(ji,jk)+ztmst*zdudt(ji)
-      zvst=pvm1(ji,jk)+ztmst*zdvdt(ji)
-      zdis=0.5*(pum1(ji,jk)**2+pvm1(ji,jk)**2-zust**2-zvst**2)
-      zdedt(ji)=zdis/ztmst
-      zvidis(ji)=zvidis(ji)+zdis*zdelp
-      zdtdt(ji)=zdedt(ji)/rcpd
-c     pte(ji,jk)=zdtdt(ji)
-c
-c  ENCORE UN TRUC POUR EVITER LES EXPLOSIONS
-c
-      pte(ji,jk)=0.0
-
-  523 continue
-
-  524 continue
-c
-c
-      return
-      end
-      SUBROUTINE orosetup
-     *         ( nlon   , nlev  , ktest
-     *         , kkcrit, kkcrith, kcrit, ksect , kkhlim
-     *         , kkenvh, kknu  , kknu2
-     *         , paphm1, papm1 , pum1   , pvm1 , ptm1  , pgeom1, pstd
-     *         , prho  , pri   , pstab  , ptau , pvph  ,ppsi, pzdep
-     *         , pulow , pvlow  
-     *         , ptheta, pgamma, pmea, ppic, pval
-     *         , pnu  ,  pd1  ,  pd2  ,pdmod  )
-c
-c**** *gwsetup*
-c
-c     purpose.
-c     --------
-c
-c**   interface.
-c     ----------
-c          from *orodrag*
-c
-c        explicit arguments :
-c        --------------------
-c     ==== inputs ===
-c     ==== outputs ===
-c
-c        implicit arguments :   none
-c        --------------------
-c
-c     method.
-c     -------
-c
-c
-c     externals.
-c     ----------
-c
-c
-c     reference.
-c     ----------
-c
-c        see ecmwf research department documentation of the "i.f.s."
-c
-c     author.
-c     -------
-c
-c     modifications.
-c     --------------
-c     f.lott  for the new-gwdrag scheme november 1993
-c
-c-----------------------------------------------------------------------
-      implicit logical (l)
-c
-
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "YOEGWD.h"
-
-c-----------------------------------------------------------------------
-c
-c*       0.1   arguments
-c              ---------
-c
-      integer kkcrit(nlon),kkcrith(nlon),kcrit(nlon),ksect(nlon),
-     *        kkhlim(nlon),ktest(nlon),kkenvh(nlon)
-
-c
-      real paphm1(nlon,klev+1),papm1(nlon,klev),pum1(nlon,klev),
-     *     pvm1(nlon,klev),ptm1(nlon,klev),pgeom1(nlon,klev),
-     *     prho(nlon,klev+1),pri(nlon,klev+1),pstab(nlon,klev+1),
-     *     ptau(nlon,klev+1),pvph(nlon,klev+1),ppsi(nlon,klev+1),
-     *     pzdep(nlon,klev)
-       real pulow(nlon),pvlow(nlon),ptheta(nlon),pgamma(nlon),pnu(nlon),
-     *     pd1(nlon),pd2(nlon),pdmod(nlon)
-      real pstd(nlon),pmea(nlon),ppic(nlon),pval(nlon)
-c
-c-----------------------------------------------------------------------
-c
-c*       0.2   local arrays
-c              ------------
-c
-c
-      logical ll1(klon,klev+1)
-      integer kknu(klon),kknu2(klon),kknub(klon),kknul(klon),
-     *        kentp(klon),ncount(klon)  
-c
-      real zhcrit(klon,klev),zvpf(klon,klev),
-     *     zdp(klon,klev)
-      real znorm(klon),zpsi(klon),zb(klon),zc(klon),
-     *      zulow(klon),zvlow(klon),znup(klon),znum(klon)
-c
-c     ------------------------------------------------------------------
-c
-c*         1.    initialization
-c                --------------
-c
-c     print *,' entree gwsetup'
- 100  continue
-c
-c     ------------------------------------------------------------------
-c
-c*         1.1   computational constants
-c                -----------------------
-c
- 110  continue
-c
-      ilevm1=klev-1
-      ilevm2=klev-2
-      ilevh =klev/3
-c
-      zcons1=1./rd
-cold  zcons2=g**2/cpd
-      zcons2=rg**2/rcpd
-cold  zcons3=1.5*api
-      zcons3=1.5*rpi
-c
-c
-c     ------------------------------------------------------------------
-c
-c*         2.
-c                --------------
-c
- 200  continue
-c
-c     ------------------------------------------------------------------
-c
-c*         2.1     define low level wind, project winds in plane of
-c*                 low level wind, determine sector in which to take
-c*                 the variance and set indicator for critical levels.
-c
-c
-c
-      do 2001 jl=kidia,kfdia
-      kknu(jl)    =klev
-      kknu2(jl)   =klev
-      kknub(jl)   =klev
-      kknul(jl)   =klev
-      pgamma(jl) =max(pgamma(jl),gtsec)
-      ll1(jl,klev+1)=.false.
- 2001 continue
-c
-c Ajouter une initialisation (L. Li, le 23fev99):
-c
-      do jk=klev,ilevh,-1
-      do jl=kidia,kfdia
-      ll1(jl,jk)= .FALSE.
-      ENDDO
-      ENDDO
-c
-c*      define top of low level flow
-c       ----------------------------
-      do 2002 jk=klev,ilevh,-1
-      do 2003 jl=kidia,kfdia
-      lo=(paphm1(jl,jk)/paphm1(jl,klev+1)).ge.gsigcr
-      if(lo) then
-        kkcrit(jl)=jk
-      endif
-      zhcrit(jl,jk)=ppic(jl)
-      zhgeo=pgeom1(jl,jk)/rg
-      ll1(jl,jk)=(zhgeo.gt.zhcrit(jl,jk))
-      if(ll1(jl,jk).xor.ll1(jl,jk+1)) then
-        kknu(jl)=jk
-      endif
-      if(.not.ll1(jl,ilevh))kknu(jl)=ilevh
- 2003 continue
- 2002 continue
-      do 2004 jk=klev,ilevh,-1
-      do 2005 jl=kidia,kfdia
-      zhcrit(jl,jk)=ppic(jl)-pval(jl)
-      zhgeo=pgeom1(jl,jk)/rg
-      ll1(jl,jk)=(zhgeo.gt.zhcrit(jl,jk))
-      if(ll1(jl,jk).xor.ll1(jl,jk+1)) then
-        kknu2(jl)=jk
-      endif
-      if(.not.ll1(jl,ilevh))kknu2(jl)=ilevh
- 2005 continue
- 2004 continue
-      do 2006 jk=klev,ilevh,-1
-      do 2007 jl=kidia,kfdia
-      zhcrit(jl,jk)=amax1(ppic(jl)-pmea(jl),pmea(jl)-pval(jl))
-      zhgeo=pgeom1(jl,jk)/rg
-      ll1(jl,jk)=(zhgeo.gt.zhcrit(jl,jk))
-      if(ll1(jl,jk).xor.ll1(jl,jk+1)) then
-        kknub(jl)=jk
-      endif
-      if(.not.ll1(jl,ilevh))kknub(jl)=ilevh
- 2007 continue
- 2006 continue
-c
-      do 2010 jl=kidia,kfdia  
-      kknu(jl)=min(kknu(jl),nktopg)
-      kknu2(jl)=min(kknu2(jl),nktopg)
-      kknub(jl)=min(kknub(jl),nktopg)
-      kknul(jl)=klev
- 2010 continue      
-c
-
- 210  continue
-c
-c
-cc*     initialize various arrays
-c
-      do 2107 jl=kidia,kfdia
-      prho(jl,klev+1)  =0.0
-      pstab(jl,klev+1) =0.0
-      pstab(jl,1)      =0.0
-      pri(jl,klev+1)   =9999.0
-      ppsi(jl,klev+1)  =0.0
-      pri(jl,1)        =0.0
-      pvph(jl,1)       =0.0
-      pulow(jl)        =0.0
-      pvlow(jl)        =0.0
-      zulow(jl)        =0.0
-      zvlow(jl)        =0.0
-      kkcrith(jl)      =klev
-      kkenvh(jl)       =klev
-      kentp(jl)        =klev
-      kcrit(jl)        =1
-      ncount(jl)       =0
-      ll1(jl,klev+1)   =.false.
- 2107 continue
-c
-c*     define low-level flow
-c      ---------------------
-c
-      do 223 jk=klev,2,-1
-      do 222 jl=kidia,kfdia
-      if(ktest(jl).eq.1) then
-        zdp(jl,jk)=papm1(jl,jk)-papm1(jl,jk-1)
-        prho(jl,jk)=2.*paphm1(jl,jk)*zcons1/(ptm1(jl,jk)+ptm1(jl,jk-1))
-        pstab(jl,jk)=2.*zcons2/(ptm1(jl,jk)+ptm1(jl,jk-1))*
-     *  (1.-rcpd*prho(jl,jk)*(ptm1(jl,jk)-ptm1(jl,jk-1))/zdp(jl,jk))
-        pstab(jl,jk)=max(pstab(jl,jk),gssec)
-      endif
-  222 continue
-  223 continue
-c
-c********************************************************************
-c
-c*     define blocked flow
-c      -------------------
-      do 2115 jk=klev,ilevh,-1
-      do 2116 jl=kidia,kfdia
-      if(jk.ge.kknub(jl).and.jk.le.kknul(jl)) then
-        pulow(jl)=pulow(jl)+pum1(jl,jk)*(paphm1(jl,jk+1)-paphm1(jl,jk))
-        pvlow(jl)=pvlow(jl)+pvm1(jl,jk)*(paphm1(jl,jk+1)-paphm1(jl,jk))
-      end if
- 2116 continue
- 2115 continue
-      do 2110 jl=kidia,kfdia
-      pulow(jl)=pulow(jl)/(paphm1(jl,kknul(jl)+1)-paphm1(jl,kknub(jl)))
-      pvlow(jl)=pvlow(jl)/(paphm1(jl,kknul(jl)+1)-paphm1(jl,kknub(jl)))
-      znorm(jl)=max(sqrt(pulow(jl)**2+pvlow(jl)**2),gvsec)
-      pvph(jl,klev+1)=znorm(jl)
- 2110 continue
-c
-c*******  setup orography axes and define plane of profiles  *******
-c
-      do 2112 jl=kidia,kfdia
-      lo=(pulow(jl).lt.gvsec).and.(pulow(jl).ge.-gvsec)
-      if(lo) then
-        zu=pulow(jl)+2.*gvsec
-      else
-        zu=pulow(jl)
-      endif
-      zphi=atan(pvlow(jl)/zu)
-      ppsi(jl,klev+1)=ptheta(jl)*rpi/180.-zphi
-      zb(jl)=1.-0.18*pgamma(jl)-0.04*pgamma(jl)**2
-      zc(jl)=0.48*pgamma(jl)+0.3*pgamma(jl)**2
-      pd1(jl)=zb(jl)-(zb(jl)-zc(jl))*(sin(ppsi(jl,klev+1))**2)
-      pd2(jl)=(zb(jl)-zc(jl))*sin(ppsi(jl,klev+1))*cos(ppsi(jl,klev+1))
-      pdmod(jl)=sqrt(pd1(jl)**2+pd2(jl)**2)
- 2112 continue
-c
-c  ************ define flow in plane of lowlevel stress *************
-c
-      do 213 jk=1,klev
-      do 212 jl=kidia,kfdia
-      if(ktest(jl).eq.1)  then
-        zvt1       =pulow(jl)*pum1(jl,jk)+pvlow(jl)*pvm1(jl,jk)
-        zvt2       =-pvlow(jl)*pum1(jl,jk)+pulow(jl)*pvm1(jl,jk)
-        zvpf(jl,jk)=(zvt1*pd1(jl)+zvt2*pd2(jl))/(znorm(jl)*pdmod(jl))
-      endif
-      ptau(jl,jk)  =0.0
-      pzdep(jl,jk) =0.0
-      ppsi(jl,jk)  =0.0
-      ll1(jl,jk)   =.false.
-  212 continue
-  213 continue
-      do 215 jk=2,klev
-      do 214 jl=kidia,kfdia
-      if(ktest(jl).eq.1) then
-        zdp(jl,jk)=papm1(jl,jk)-papm1(jl,jk-1)
-        pvph(jl,jk)=((paphm1(jl,jk)-papm1(jl,jk-1))*zvpf(jl,jk)+
-     *            (papm1(jl,jk)-paphm1(jl,jk))*zvpf(jl,jk-1))
-     *            /zdp(jl,jk)
-        if(pvph(jl,jk).lt.gvsec) then
-          pvph(jl,jk)=gvsec
-          kcrit(jl)=jk
-        endif
-      endif
-  214 continue
-  215 continue
-c
-c
-c*         2.2     brunt-vaisala frequency and density at half levels.
-c
-  220 continue
-c
-      do 2211 jk=ilevh,klev
-      do 221 jl=kidia,kfdia
-      if(ktest(jl).eq.1) then
-      if(jk.ge.(kknub(jl)+1).and.jk.le.kknul(jl)) then
-           zst=zcons2/ptm1(jl,jk)*(1.-rcpd*prho(jl,jk)*
-     *                   (ptm1(jl,jk)-ptm1(jl,jk-1))/zdp(jl,jk))
-           pstab(jl,klev+1)=pstab(jl,klev+1)+zst*zdp(jl,jk)
-           pstab(jl,klev+1)=max(pstab(jl,klev+1),gssec)
-           prho(jl,klev+1)=prho(jl,klev+1)+paphm1(jl,jk)*2.*zdp(jl,jk)
-     *                   *zcons1/(ptm1(jl,jk)+ptm1(jl,jk-1))
-      endif
-      endif
-  221 continue
- 2211 continue
-c
-      do 2212 jl=kidia,kfdia
-        pstab(jl,klev+1)=pstab(jl,klev+1)/(papm1(jl,kknul(jl))
-     *                                          -papm1(jl,kknub(jl)))
-        prho(jl,klev+1)=prho(jl,klev+1)/(papm1(jl,kknul(jl))
-     *                                          -papm1(jl,kknub(jl)))
-        zvar=pstd(jl)
- 2212 continue
-c
-c*         2.3     mean flow richardson number.
-c*                 and critical height for froude layer
-c
-  230 continue
-c
-      do 232 jk=2,klev
-      do 231 jl=kidia,kfdia
-      if(ktest(jl).eq.1) then
-        zdwind=max(abs(zvpf(jl,jk)-zvpf(jl,jk-1)),gvsec)
-        pri(jl,jk)=pstab(jl,jk)*(zdp(jl,jk)
-     *          /(rg*prho(jl,jk)*zdwind))**2
-        pri(jl,jk)=max(pri(jl,jk),grcrit)
-      endif
-  231 continue
-  232 continue
-  
-c
-c
-c*      define top of 'envelope' layer
-c       ----------------------------
-
-      do 233 jl=kidia,kfdia
-      pnu (jl)=0.0
-      znum(jl)=0.0
- 233  continue
-      
-      do 234 jk=2,klev-1
-      do 234 jl=kidia,kfdia
-      
-      if(ktest(jl).eq.1) then
-       
-      if (jk.ge.kknub(jl)) then
-          
-            znum(jl)=pnu(jl)
-            zwind=(pulow(jl)*pum1(jl,jk)+pvlow(jl)*pvm1(jl,jk))/
-     *            max(sqrt(pulow(jl)**2+pvlow(jl)**2),gvsec)
-            zwind=max(sqrt(zwind**2),gvsec)
-            zdelp=paphm1(jl,jk+1)-paphm1(jl,jk)
-            zstabm=sqrt(max(pstab(jl,jk  ),gssec))
-            zstabp=sqrt(max(pstab(jl,jk+1),gssec))
-            zrhom=prho(jl,jk  )
-            zrhop=prho(jl,jk+1)
-            pnu(jl) = pnu(jl) + (zdelp/rg)*
-     *            ((zstabp/zrhop+zstabm/zrhom)/2.)/zwind     
-            if((znum(jl).le.gfrcrit).and.(pnu(jl).gt.gfrcrit)
-     *                          .and.(kkenvh(jl).eq.klev))
-     *      kkenvh(jl)=jk
-     
-      endif    
-
-      endif
-      
- 234  continue
-      
-c  calculation of a dynamical mixing height for the breaking
-c  of gravity waves:
-
-              
-      do 235 jl=kidia,kfdia
-      znup(jl)=0.0
-      znum(jl)=0.0
- 235  continue
-
-      do 236 jk=klev-1,2,-1
-      do 236 jl=kidia,kfdia
-      
-      if(ktest(jl).eq.1) then
-
-            znum(jl)=znup(jl)
-            zwind=(pulow(jl)*pum1(jl,jk)+pvlow(jl)*pvm1(jl,jk))/
-     *            max(sqrt(pulow(jl)**2+pvlow(jl)**2),gvsec)
-            zwind=max(sqrt(zwind**2),gvsec)
-            zdelp=paphm1(jl,jk+1)-paphm1(jl,jk)
-            zstabm=sqrt(max(pstab(jl,jk  ),gssec))
-            zstabp=sqrt(max(pstab(jl,jk+1),gssec))
-            zrhom=prho(jl,jk  )
-            zrhop=prho(jl,jk+1)
-            znup(jl) = znup(jl) + (zdelp/rg)*
-     *            ((zstabp/zrhop+zstabm/zrhom)/2.)/zwind     
-            if((znum(jl).le.rpi/2.).and.(znup(jl).gt.rpi/2.)
-     *                          .and.(kkcrith(jl).eq.klev))
-     *      kkcrith(jl)=jk
-     
-      endif
-      
- 236  continue
- 
-      do 237 jl=kidia,kfdia
-      kkcrith(jl)=min0(kkcrith(jl),kknu2(jl))
-      kkcrith(jl)=max0(kkcrith(jl),ilevh*2)
- 237  continue         
-c
-c     directional info for flow blocking ************************* 
-c
-      do 251 jk=ilevh,klev    
-      do 252 jl=kidia,kfdia
-      if(jk.ge.kkenvh(jl)) then
-      lo=(pum1(jl,jk).lt.gvsec).and.(pum1(jl,jk).ge.-gvsec)
-      if(lo) then
-        zu=pum1(jl,jk)+2.*gvsec
-      else
-        zu=pum1(jl,jk)
-      endif
-       zphi=atan(pvm1(jl,jk)/zu)
-       ppsi(jl,jk)=ptheta(jl)*rpi/180.-zphi
-      end if
- 252  continue
- 251  continue
-c      forms the vertical 'leakiness' **************************
-
-      alpha=3.
-      
-      do 254  jk=ilevh,klev
-      do 253  jl=kidia,kfdia
-      if(jk.ge.kkenvh(jl)) then
-        zggeenv=amax1(1.,
-     *          (pgeom1(jl,kkenvh(jl))+pgeom1(jl,kkenvh(jl)-1))/2.)      
-        zggeom1=amax1(pgeom1(jl,jk),1.)
-        zgvar=amax1(pstd(jl)*rg,1.)     
-cmod    pzdep(jl,jk)=sqrt((zggeenv-zggeom1)/(zggeom1+zgvar))      
-        pzdep(jl,jk)=(pgeom1(jl,kkenvh(jl)-1)-pgeom1(jl,  jk))/
-     *               (pgeom1(jl,kkenvh(jl)-1)-pgeom1(jl,klev))
-      end if
- 253  continue
- 254  continue
-
- 260  continue
-
-      return
-      end
-      SUBROUTINE gwstress
-     *         (  nlon  , nlev
-     *         , kkcrit, ksect, kkhlim, ktest, kkcrith, kcrit, kkenvh
-     *         , kknu
-     *         , prho  , pstab , pvph  , pstd, psig
-     *         , pmea , ppic , pval  , ptfr  , ptau  
-     *         , pgeom1 , pgamma , pd1  , pd2   , pdmod , pnu )
-c
-c**** *gwstress*
-c
-c     purpose.
-c     --------
-c
-c**   interface.
-c     ----------
-c     call *gwstress*  from *gwdrag*
-c
-c        explicit arguments :
-c        --------------------
-c     ==== inputs ===
-c     ==== outputs ===
-c
-c        implicit arguments :   none
-c        --------------------
-c
-c     method.
-c     -------
-c
-c
-c     externals.
-c     ----------
-c
-c
-c     reference.
-c     ----------
-c
-c        see ecmwf research department documentation of the "i.f.s."
-c
-c     author.
-c     -------
-c
-c     modifications.
-c     --------------
-c     f. lott put the new gwd on ifs      22/11/93
-c
-c-----------------------------------------------------------------------
-      implicit logical (l)
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "YOEGWD.h"
-
-c-----------------------------------------------------------------------
-c
-c*       0.1   arguments
-c              ---------
-c
-      integer kkcrit(nlon),kkcrith(nlon),kcrit(nlon),ksect(nlon),
-     *        kkhlim(nlon),ktest(nlon),kkenvh(nlon),kknu(nlon)
-c
-      real prho(nlon,nlev+1),pstab(nlon,nlev+1),ptau(nlon,nlev+1),
-     *     pvph(nlon,nlev+1),ptfr(nlon),
-     *     pgeom1(nlon,nlev),pstd(nlon)
-c
-      real pd1(nlon),pd2(nlon),pnu(nlon),psig(nlon),pgamma(nlon)
-      real pmea(nlon),ppic(nlon),pval(nlon)
-      real pdmod(nlon)
-c
-c-----------------------------------------------------------------------
-c
-c*       0.2   local arrays
-c              ------------
-c
-c-----------------------------------------------------------------------
-c
-c*       0.3   functions
-c              ---------
-c     ------------------------------------------------------------------
-c
-c*         1.    initialization
-c                --------------
-c
- 100  continue
-c
-c*         3.1     gravity wave stress.
-c
-  300 continue
-c
-c
-      do 301 jl=kidia,kfdia
-      if(ktest(jl).eq.1) then
-      
-c  effective mountain height above the blocked flow
-  
-         if(kkenvh(jl).eq.klev)then
-         zblock=0.0 
-         else
-         zblock=(pgeom1(jl,kkenvh(jl))+pgeom1(jl,kkenvh(jl)+1))/2./rg          
-         endif
-      
-        zvar=ppic(jl)-pmea(jl)
-        zeff=amax1(0.,zvar-zblock)
-
-        ptau(jl,klev+1)=prho(jl,klev+1)*gkdrag*psig(jl)*zeff**2
-     *    /4./pstd(jl)*pvph(jl,klev+1)*pdmod(jl)*sqrt(pstab(jl,klev+1))
-
-c  too small value of stress or  low level flow include critical level
-c  or low level flow:  gravity wave stress nul.
-                
-        lo=(ptau(jl,klev+1).lt.gtsec).or.(kcrit(jl).ge.kknu(jl))
-     *      .or.(pvph(jl,klev+1).lt.gvcrit)
-c       if(lo) ptau(jl,klev+1)=0.0
-      
-      else
-      
-          ptau(jl,klev+1)=0.0
-          
-      endif
-      
-  301 continue
-c
-      return
-      end
-      SUBROUTINE GWPROFIL
-     *         ( NLON, NLEV
-     *         , kgwd ,kdx  , ktest
-     *         , KKCRIT, KKCRITH, KCRIT ,  kkenvh, kknu,kknu2
-     *         , PAPHM1, PRHO   , PSTAB , PTFR , PVPH , PRI , PTAU
-     *         , ptauf ,pdmod   , pnu   , psig ,pgamma, pvar, ppic,pval)
-
-C**** *GWPROFIL*
-C
-C     PURPOSE.
-C     --------
-C
-C**   INTERFACE.
-C     ----------
-C          FROM *GWDRAG*
-C
-C        EXPLICIT ARGUMENTS :
-C        --------------------
-C     ==== INPUTS ===
-C     ==== OUTPUTS ===
-C
-C        IMPLICIT ARGUMENTS :   NONE
-C        --------------------
-C
-C     METHOD:
-C     -------
-C     THE STRESS PROFILE FOR GRAVITY WAVES IS COMPUTED AS FOLLOWS:
-C     IT IS CONSTANT (NO GWD) AT THE LEVELS BETWEEN THE GROUND
-C     AND THE TOP OF THE BLOCKED LAYER (KKENVH).
-C     IT DECREASES LINEARLY WITH HEIGHTS FROM THE TOP OF THE 
-C     BLOCKED LAYER TO 3*VAROR (kKNU), TO SIMULATES LEE WAVES OR 
-C     NONLINEAR GRAVITY WAVE BREAKING.
-C     ABOVE IT IS CONSTANT, EXCEPT WHEN THE WAVE ENCOUNTERS A CRITICAL
-C     LEVEL (KCRIT) OR WHEN IT BREAKS.
-C     
-C
-C
-C     EXTERNALS.
-C     ----------
-C
-C
-C     REFERENCE.
-C     ----------
-C
-C        SEE ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "I.F.S."
-C
-C     AUTHOR.
-C     -------
-C
-C     MODIFICATIONS.
-C     --------------
-C     PASSAGE OF THE NEW GWDRAG TO I.F.S. (F. LOTT, 22/11/93)
-C-----------------------------------------------------------------------
-      IMPLICIT LOGICAL (L)
-C
-
-C
-
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "YOEGWD.h"
-
-C-----------------------------------------------------------------------
-C
-C*       0.1   ARGUMENTS
-C              ---------
-C
-      INTEGER KKCRIT(NLON),KKCRITH(NLON),KCRIT(NLON)
-     *       ,kdx(nlon),ktest(NLON)
-     *       ,kkenvh(NLON),kknu(NLON),kknu2(NLON)
-C
-      REAL PAPHM1(NLON,NLEV+1), PSTAB(NLON,NLEV+1),
-     *     PRHO  (NLON,NLEV+1), PVPH (NLON,NLEV+1),
-     *     PRI   (NLON,NLEV+1), PTFR (NLON), PTAU(NLON,NLEV+1),
-     *     ptauf (NLON,nlev+1)
-     
-      REAL pdmod (NLON) , pnu (NLON) , psig(NLON),
-     *     pgamma(NLON) , pvar(NLON) , ppic(NLON), pval(NLON)
-     
-C-----------------------------------------------------------------------
-C
-C*       0.2   LOCAL ARRAYS
-C              ------------
-C
-      REAL ZDZ2 (KLON,KLEV) , ZNORM(KLON) , zoro(KLON)
-      REAL ZTAU (KLON,KLEV+1)
-C
-C-----------------------------------------------------------------------
-C
-C*         1.    INITIALIZATION
-C                --------------
-C
-c      print *,' entree gwprofil' 
- 100  CONTINUE
-C
-C
-C*    COMPUTATIONAL CONSTANTS.
-C     ------------- ----------
-C
-      ilevh=KLEV/3
-C
-      DO 400 ji=1,kgwd
-      jl=kdx(ji)
-      Zoro(JL)=Psig(JL)*Pdmod(JL)/4./max(pvar(jl),1.0)
-      ZTAU(JL,KLEV+1)=PTAU(JL,KLEV+1)
-  400 CONTINUE
-  
-C
-      DO 430 JK=KLEV,2,-1
-C
-C
-C*         4.1    CONSTANT WAVE STRESS UNTIL TOP OF THE
-C                 BLOCKING LAYER.
-  410 CONTINUE
-C
-      DO 411 ji=1,kgwd
-      jl=kdx(ji)
-           IF(JK.GT.KKCRITH(JL)) THEN
-           PTAU(JL,JK)=ZTAU(JL,KLEV+1)
-C          ENDIF
-C          IF(JK.EQ.KKCRITH(JL)) THEN
-           ELSE                    
-           PTAU(JL,JK)=GRAHILO*ZTAU(JL,KLEV+1)
-           ENDIF
- 411  CONTINUE             
-C
-C*         4.15   CONSTANT SHEAR STRESS UNTIL THE TOP OF THE
-C                 LOW LEVEL FLOW LAYER.
- 415  CONTINUE
-C        
-C
-C*         4.2    WAVE DISPLACEMENT AT NEXT LEVEL.
-C
-  420 CONTINUE
-C
-      DO 421 ji=1,kgwd
-      jl=kdx(ji)
-      IF(JK.LT.KKCRITH(JL)) THEN
-      ZNORM(JL)=gkdrag*PRHO(JL,JK)*SQRT(PSTAB(JL,JK))*PVPH(JL,JK)
-     *                                                    *zoro(jl)
-      ZDZ2(JL,JK)=PTAU(JL,JK+1)/max(ZNORM(JL),gssec)
-      ENDIF
-  421 CONTINUE
-C
-C*         4.3    WAVE RICHARDSON NUMBER, NEW WAVE DISPLACEMENT
-C*                AND STRESS:  BREAKING EVALUATION AND CRITICAL 
-C                 LEVEL
-C
-                          
-      DO 431 ji=1,kgwd
-      jl=kdx(ji)
-          IF(JK.LT.KKCRITH(JL)) THEN
-          IF((PTAU(JL,JK+1).LT.GTSEC).OR.(JK.LE.KCRIT(JL))) THEN
-            PTAU(JL,JK)=0.0
-          ELSE
-               ZSQR=SQRT(PRI(JL,JK))
-               ZALFA=SQRT(PSTAB(JL,JK)*ZDZ2(JL,JK))/PVPH(JL,JK)
-               ZRIW=PRI(JL,JK)*(1.-ZALFA)/(1+ZALFA*ZSQR)**2
-               IF(ZRIW.LT.GRCRIT) THEN
-                 ZDEL=4./ZSQR/GRCRIT+1./GRCRIT**2+4./GRCRIT
-                 ZB=1./GRCRIT+2./ZSQR
-                 ZALPHA=0.5*(-ZB+SQRT(ZDEL))
-                 ZDZ2N=(PVPH(JL,JK)*ZALPHA)**2/PSTAB(JL,JK)
-                 PTAU(JL,JK)=ZNORM(JL)*ZDZ2N
-               ELSE
-                 PTAU(JL,JK)=ZNORM(JL)*ZDZ2(JL,JK)
-               ENDIF
-            PTAU(JL,JK)=MIN(PTAU(JL,JK),PTAU(JL,JK+1))
-          ENDIF
-          ENDIF
-  431 CONTINUE
-  
-  430 CONTINUE
-  440 CONTINUE
-  
-C  REORGANISATION OF THE STRESS PROFILE AT LOW LEVEL
-
-      DO 530 ji=1,kgwd
-      jl=kdx(ji)
-      ZTAU(JL,KKCRITH(JL))=PTAU(JL,KKCRITH(JL))
-      ZTAU(JL,NSTRA)=PTAU(JL,NSTRA)
- 530  CONTINUE      
-
-      DO 531 JK=1,KLEV
-      
-      DO 532 ji=1,kgwd
-      jl=kdx(ji)
-                
-         IF(JK.GT.KKCRITH(JL))THEN
-
-          ZDELP=PAPHM1(JL,JK)-PAPHM1(JL,KLEV+1    )
-          ZDELPT=PAPHM1(JL,KKCRITH(JL))-PAPHM1(JL,KLEV+1    )
-          PTAU(JL,JK)=ZTAU(JL,KLEV+1    ) +
-     .                (ZTAU(JL,KKCRITH(JL))-ZTAU(JL,KLEV+1    ) )*
-     .                ZDELP/ZDELPT
-     
-        ENDIF
-            
- 532  CONTINUE    
- 
-C  REORGANISATION IN THE STRATOSPHERE
-
-      DO 533 ji=1,kgwd
-      jl=kdx(ji)
-
-         IF(JK.LT.NSTRA)THEN
-
-          ZDELP =PAPHM1(JL,NSTRA)
-          ZDELPT=PAPHM1(JL,JK)
-          PTAU(JL,JK)=ZTAU(JL,NSTRA)*ZDELPT/ZDELP 
-
-        ENDIF
-
- 533  CONTINUE
-
-C REORGANISATION IN THE TROPOSPHERE
-
-       DO 534 ji=1,kgwd
-       jl=kdx(ji)
-
-         IF(JK.LT.KKCRITH(JL).AND.JK.GT.NSTRA)THEN
-
-           ZDELP=PAPHM1(JL,JK)-PAPHM1(JL,KKCRITH(JL))
-           ZDELPT=PAPHM1(JL,NSTRA)-PAPHM1(JL,KKCRITH(JL))
-           PTAU(JL,JK)=ZTAU(JL,KKCRITH(JL)) +
-     *                 (ZTAU(JL,NSTRA)-ZTAU(JL,KKCRITH(JL)))*ZDELP/ZDELPT
-
-       ENDIF
- 534   CONTINUE
-
- 
- 531  CONTINUE        
-
-
-      RETURN
-      END
-      SUBROUTINE lift_noro (nlon,nlev,dtime,paprs,pplay,      
-     e                   plat,pmea,pstd, psig, pgam, pthe, ppic,pval,
-     e                   kgwd,kgwdim,kdx,ktest,
-     e                   t, u, v,
-     s                   pulow, pvlow, pustr, pvstr,
-     s                   d_t, d_u, d_v)
-c
-      IMPLICIT none
-c======================================================================
-c Auteur(s): F.Lott (LMD/CNRS) date: 19950201
-c Objet: Frottement de la montagne Interface
-c======================================================================
-c Arguments:
-c dtime---input-R- pas d'integration (s)
-c paprs---input-R-pression pour chaque inter-couche (en Pa)
-c pplay---input-R-pression pour le mileu de chaque couche (en Pa)
-c t-------input-R-temperature (K)
-c u-------input-R-vitesse horizontale (m/s)
-c v-------input-R-vitesse horizontale (m/s)
-c
-c d_t-----output-R-increment de la temperature
-c d_u-----output-R-increment de la vitesse u
-c d_v-----output-R-increment de la vitesse v
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-c
-c ARGUMENTS
-c
-      INTEGER nlon,nlev
-      REAL dtime
-      REAL paprs(klon,klev+1)
-      REAL pplay(klon,klev)
-      REAL plat(nlon),pmea(nlon)
-      REAL pstd(nlon),psig(nlon),pgam(nlon),pthe(nlon)
-      REAL ppic(nlon),pval(nlon)
-      REAL pulow(nlon),pvlow(nlon),pustr(nlon),pvstr(nlon)
-      REAL t(nlon,nlev), u(nlon,nlev), v(nlon,nlev)
-      REAL d_t(nlon,nlev), d_u(nlon,nlev), d_v(nlon,nlev)
-c
-      INTEGER i, k, kgwd, kgwdim, kdx(nlon), ktest(nlon)
-c
-c Variables locales:
-c
-      REAL zgeom(klon,klev)
-      REAL pdtdt(klon,klev), pdudt(klon,klev), pdvdt(klon,klev)
-      REAL pt(klon,klev), pu(klon,klev), pv(klon,klev)
-      REAL papmf(klon,klev),papmh(klon,klev+1)
-c
-c initialiser les variables de sortie (pour securite)
-c
-      DO i = 1,klon
-         pulow(i) = 0.0
-         pvlow(i) = 0.0
-         pustr(i) = 0.0
-         pvstr(i) = 0.0
-      ENDDO
-      DO k = 1, klev
-      DO i = 1, klon
-         d_t(i,k) = 0.0
-         d_u(i,k) = 0.0
-         d_v(i,k) = 0.0
-         pdudt(i,k)=0.0
-         pdvdt(i,k)=0.0
-         pdtdt(i,k)=0.0
-      ENDDO
-      ENDDO
-c
-c preparer les variables d'entree (attention: l'ordre des niveaux 
-c verticaux augmente du haut vers le bas)
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         pt(i,k) = t(i,klev-k+1) 
-         pu(i,k) = u(i,klev-k+1)
-         pv(i,k) = v(i,klev-k+1)
-         papmf(i,k) = pplay(i,klev-k+1)
-      ENDDO
-      ENDDO
-      DO k = 1, klev+1
-      DO i = 1, klon
-         papmh(i,k) = paprs(i,klev-k+2)
-      ENDDO
-      ENDDO
-      DO i = 1, klon
-         zgeom(i,klev) = RD * pt(i,klev)
-     .                  * LOG(papmh(i,klev+1)/papmf(i,klev))
-      ENDDO
-      DO k = klev-1, 1, -1
-      DO i = 1, klon
-         zgeom(i,k) = zgeom(i,k+1) + RD * (pt(i,k)+pt(i,k+1))/2.0
-     .               * LOG(papmf(i,k+1)/papmf(i,k))
-      ENDDO
-      ENDDO
-c
-c appeler la routine principale
-c
-      CALL OROLIFT(klon,klev,kgwd,kgwdim,kdx,ktest,
-     .            dtime,
-     .            papmh, papmf, zgeom,
-     .            pt, pu, pv,
-     .            plat,pmea, pstd, psig, pgam, pthe, ppic,pval,
-     .            pulow,pvlow,
-     .            pdudt,pdvdt,pdtdt)
-C
-      DO k = 1, klev
-      DO i = 1, klon
-         d_u(i,klev+1-k) = dtime*pdudt(i,k)
-         d_v(i,klev+1-k) = dtime*pdvdt(i,k)
-         d_t(i,klev+1-k) = dtime*pdtdt(i,k)
-         pustr(i)        = pustr(i)
-     .                    +RG*pdudt(i,k)*(papmh(i,k+1)-papmh(i,k))
-         pvstr(i)        = pvstr(i)
-     .                    +RG*pdvdt(i,k)*(papmh(i,k+1)-papmh(i,k))
-      ENDDO
-      ENDDO
-c
-      RETURN
-      END
-      SUBROUTINE OROLIFT( NLON,NLEV
-     I                 , KGWD, KGWDIM, KDX, KTEST
-     R                 , PTSPHY
-     R                 , PAPHM1,PAPM1,PGEOM1,PTM1,PUM1,PVM1
-     R                 , PLAT
-     R                 , PMEA, PVAROR, PSIG, PGAMMA, PTHETA,ppic,pval
-C OUTPUTS
-     R                 , PULOW,PVLOW
-     R                 , PVOM,PVOL,PTE )
-
-C
-C**** *OROLIFT: SIMULATE THE GEOSTROPHIC LIFT.
-C
-C     PURPOSE.
-C     --------
-C
-C**   INTERFACE.
-C     ----------
-C          CALLED FROM *lift_noro
-C     ----------
-C
-C     AUTHOR.
-C     -------
-C     F.LOTT  LMD 22/11/95
-C
-      IMPLICIT LOGICAL (L)
-C
-C
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "YOEGWD.h"
-C-----------------------------------------------------------------------
-C
-C*       0.1   ARGUMENTS
-C              ---------
-C
-C
-      REAL  PTE(NLON,NLEV),
-     *      PVOL(NLON,NLEV),
-     *      PVOM(NLON,NLEV),
-     *      PULOW(NLON),
-     *      PVLOW(NLON)
-      REAL  PUM1(NLON,NLEV),
-     *      PVM1(NLON,NLEV),
-     *      PTM1(NLON,NLEV),
-     *      PLAT(NLON),PMEA(NLON),
-     *      PVAROR(NLON),PSIG(NLON),PGAMMA(NLON),
-     *      PTHETA(NLON),ppic(NLON),pval(NLON),
-     *      PGEOM1(NLON,NLEV),
-     *      PAPM1(NLON,NLEV),
-     *      PAPHM1(NLON,NLEV+1)
-C
-      INTEGER  KDX(NLON),KTEST(NLON)
-C-----------------------------------------------------------------------
-C
-C*       0.2   LOCAL ARRAYS
-C              ------------
-      INTEGER  ISECT(KLON),
-     *         ICRIT(KLON),
-     *         IKCRITH(KLON),
-     *         IKenvh(klon),
-     *         IKNUB(klon),
-     *         IKNUL(klon),
-     *         IKCRIT(KLON),
-     *         IKHLIM(KLON)
-      LOGICAL LL1(KLON,KLEV+1)
-C
-      REAL   ZTAU(KLON,KLEV+1),
-     *       ZTAV(KLON,KLEV+1),
-     *       ZSTAB(KLON,KLEV+1),
-     *       ZVPH(KLON,KLEV+1),
-     *       ZRHO(KLON,KLEV+1),
-     *       ZRI(KLON,KLEV+1),
-     *       ZpsI(KLON,KLEV+1),
-     *       Zzdep(KLON,KLEV)
-      REAL   ZDUDT(KLON),
-     *       ZDVDT(KLON),
-     *       ZDTDT(KLON),
-     *       ZDEDT(KLON),
-     *       ZVIDIS(KLON),
-     *       ZTFR(KLON),
-     *       Znu(KLON),
-     *       Zd1(KLON),
-     *       Zd2(KLON),
-     *       Zdmod(KLON)
-      REAL ZHCRIT(KLON,KLEV)
-C-----------------------------------------------------------------------
-C
-C*         1.1  INITIALIZATIONS
-C               ---------------
-
-      LIFTHIGH=.FALSE.
-
-      IF(NLON.NE.KLON.OR.NLEV.NE.KLEV)STOP
-      ZCONS1=1./RD
-      KLEVM1=KLEV-1
-      ZTMST=PTSPHY
-      ZRTMST=1./ZTMST
-      ZPI=ACOS(-1.)
-C
-      DO 1001 JL=kidia,kfdia
-      ZRHO(JL,KLEV+1)  =0.0
-      PULOW(JL)        =0.0
-      PVLOW(JL)        =0.0
-      iknub(JL)   =klev
-      iknul(JL)   =klev
-      ilevh=klev/3
-      ll1(jl,klev+1)=.false.
-      DO 1000 JK=1,KLEV
-      PVOM(JL,JK)=0.0
-      PVOL(JL,JK)=0.0
-      PTE (JL,JK)=0.0
- 1000 CONTINUE
- 1001 CONTINUE
-
-C
-C*         2.1     DEFINE LOW LEVEL WIND, PROJECT WINDS IN PLANE OF
-C*                 LOW LEVEL WIND, DETERMINE SECTOR IN WHICH TO TAKE
-C*                 THE VARIANCE AND SET INDICATOR FOR CRITICAL LEVELS.
-C
-C
-C
-      DO 2006 JK=KLEV,1,-1
-      DO 2007 JL=kidia,kfdia
-      IF(KTEST(JL).EQ.1) THEN
-      ZHCRIT(JL,JK)=amax1(Ppic(JL)-pmea(JL),100.)
-      ZHGEO=PGEOM1(JL,JK)/RG
-      ll1(JL,JK)=(ZHGEO.GT.ZHCRIT(JL,JK))
-      IF(ll1(JL,JK).XOR.ll1(JL,JK+1)) THEN
-        iknub(JL)=JK
-      ENDIF
-      ENDIF
- 2007 CONTINUE
- 2006 CONTINUE
-C
-      do 2010 jl=kidia,kfdia
-      IF(KTEST(JL).EQ.1) THEN
-      iknub(jl)=max(iknub(jl),klev/2)
-      iknul(jl)=max(iknul(jl),2*klev/3)
-      if(iknub(jl).gt.nktopg) iknub(jl)=nktopg
-      if(iknub(jl).eq.nktopg) iknul(jl)=klev
-      if(iknub(jl).eq.iknul(jl)) iknub(jl)=iknul(jl)-1
-      ENDIF
- 2010 continue
-
-C     do 2011 jl=kidia,kfdia
-C     IF(KTEST(JL).EQ.1) THEN
-C       print *,' iknul= ',iknul(jl),'  iknub=',iknub(jl)
-C     ENDIF
-C2011 continue
-
-C     PRINT *,'  DANS OROLIFT: 2010'
-
-      DO 223 JK=KLEV,2,-1
-      DO 222 JL=kidia,kfdia
-        ZRHO(JL,JK)=2.*PAPHM1(JL,JK)*ZCONS1/(PTM1(JL,JK)+PTM1(JL,JK-1))
-  222 CONTINUE
-  223 CONTINUE
-C     PRINT *,'  DANS OROLIFT: 223'
-
-C********************************************************************
-C
-C*     DEFINE LOW LEVEL FLOW
-C      -------------------
-      DO 2115 JK=klev,1,-1
-      DO 2116 JL=kidia,kfdia
-      IF(KTEST(JL).EQ.1) THEN
-      if(jk.ge.iknub(jl).and.jk.le.iknul(jl)) then
-        pulow(JL)=pulow(JL)+PUM1(JL,JK)*(PAPHM1(JL,JK+1)-PAPHM1(JL,JK))
-        pvlow(JL)=pvlow(JL)+PVM1(JL,JK)*(PAPHM1(JL,JK+1)-PAPHM1(JL,JK))
-        zrho(JL,klev+1)=zrho(JL,klev+1)
-     *                 +zrho(JL,JK)*(PAPHM1(JL,JK+1)-PAPHM1(JL,JK))
-      end if
-      ENDIF
- 2116 CONTINUE
- 2115 CONTINUE
-      DO 2110 JL=kidia,kfdia
-      IF(KTEST(JL).EQ.1) THEN
-      pulow(JL)=pulow(JL)/(PAPHM1(JL,iknul(jl)+1)-PAPHM1(JL,iknub(jl)))
-      pvlow(JL)=pvlow(JL)/(PAPHM1(JL,iknul(jl)+1)-PAPHM1(JL,iknub(jl)))
-      zrho(JL,klev+1)=zrho(JL,klev+1)
-     *               /(PAPHM1(JL,iknul(jl)+1)-PAPHM1(JL,iknub(jl)))
-      ENDIF
- 2110 CONTINUE
-
-
-200   CONTINUE
-
-C***********************************************************
-C
-C*         3.      COMPUTE MOUNTAIN LIFT
-C
-  300 CONTINUE
-C
-      DO 301 JL=kidia,kfdia
-      IF(KTEST(JL).EQ.1) THEN
-       ZTAU(JL,KLEV+1)= - GKLIFT*ZRHO(JL,KLEV+1)*2.*ROMEGA*
-C    *                 (2*PVAROR(JL)+PMEA(JL))*
-     *                 2*PVAROR(JL)*
-     *                 SIN(ZPI/180.*PLAT(JL))*PVLOW(JL)
-       ZTAV(JL,KLEV+1)=   GKLIFT*ZRHO(JL,KLEV+1)*2.*ROMEGA*
-C    *                 (2*PVAROR(JL)+PMEA(JL))*
-     *                 2*PVAROR(JL)*
-     *                 SIN(ZPI/180.*PLAT(JL))*PULOW(JL)
-      ELSE
-       ZTAU(JL,KLEV+1)=0.0
-       ZTAV(JL,KLEV+1)=0.0
-      ENDIF
-301   CONTINUE
-
-C
-C*         4.      COMPUTE LIFT PROFILE         
-C*                 --------------------   
-C
-
-  400 CONTINUE
-
-      DO 401 JK=1,KLEV
-      DO 401 JL=kidia,kfdia
-      IF(KTEST(JL).EQ.1) THEN
-      ZTAU(JL,JK)=ZTAU(JL,KLEV+1)*PAPHM1(JL,JK)/PAPHM1(JL,KLEV+1)
-      ZTAV(JL,JK)=ZTAV(JL,KLEV+1)*PAPHM1(JL,JK)/PAPHM1(JL,KLEV+1)
-      ELSE
-      ZTAU(JL,JK)=0.0
-      ZTAV(JL,JK)=0.0
-      ENDIF
-401   CONTINUE
-C
-C
-C*         5.      COMPUTE TENDENCIES.
-C*                 -------------------
-      IF(LIFTHIGH)THEN
-C
-  500 CONTINUE
-C     PRINT *,'  DANS OROLIFT: 500'
-C
-C  EXPLICIT SOLUTION AT ALL LEVELS
-C
-      DO 524 JK=1,klev
-      DO 523 JL=KIDIA,KFDIA
-      IF(KTEST(JL).EQ.1) THEN
-      ZDELP=PAPHM1(JL,JK+1)-PAPHM1(JL,JK)
-      ZDUDT(JL)=-RG*(ZTAU(JL,JK+1)-ZTAU(JL,JK))/ZDELP
-      ZDVDT(JL)=-RG*(ZTAV(JL,JK+1)-ZTAV(JL,JK))/ZDELP
-      ENDIF  
-  523 CONTINUE
-  524 CONTINUE
-C
-C  PROJECT PERPENDICULARLY TO U NOT TO DESTROY ENERGY
-C
-      DO 530 JK=1,klev
-      DO 530 JL=KIDIA,KFDIA
-      IF(KTEST(JL).EQ.1) THEN
-
-        ZSLOW=SQRT(PULOW(JL)**2+PVLOW(JL)**2)
-        ZSQUA=AMAX1(SQRT(PUM1(JL,JK)**2+PVM1(JL,JK)**2),GVSEC)
-        ZSCAV=-ZDUDT(JL)*PVM1(JL,JK)+ZDVDT(JL)*PUM1(JL,JK)
-        IF(ZSQUA.GT.GVSEC)THEN
-          PVOM(JL,JK)=-ZSCAV*PVM1(JL,JK)/ZSQUA**2
-          PVOL(JL,JK)= ZSCAV*PUM1(JL,JK)/ZSQUA**2
-        ELSE
-          PVOM(JL,JK)=0.0
-          PVOL(JL,JK)=0.0      
-        ENDIF  
-        ZSQUA=SQRT(PUM1(JL,JK)**2+PUM1(JL,JK)**2)               
-        IF(ZSQUA.LT.ZSLOW)THEN
-          PVOM(JL,JK)=ZSQUA/ZSLOW*PVOM(JL,JK)
-          PVOL(JL,JK)=ZSQUA/ZSLOW*PVOL(JL,JK)
-        ENDIF 
-
-      ENDIF  
-530   CONTINUE
-C
-C  6.  LOW LEVEL LIFT, SEMI IMPLICIT:
-C  ----------------------------------
-
-      ELSE
-
-        DO 601 JL=KIDIA,KFDIA
-        IF(KTEST(JL).EQ.1) THEN
-          DO JK=KLEV,IKNUB(JL),-1
-          ZBET=GKLIFT*2.*ROMEGA*SIN(ZPI/180.*PLAT(JL))*ztmst*
-     *        (PGEOM1(JL,IKNUB(JL)-1)-PGEOM1(JL,  JK))/
-     *        (PGEOM1(JL,IKNUB(JL)-1)-PGEOM1(JL,KLEV))
-          ZDUDT(JL)=-PUM1(JL,JK)/ztmst/(1+ZBET**2)
-          ZDVDT(JL)=-PVM1(JL,JK)/ztmst/(1+ZBET**2)
-          PVOM(JL,JK)= ZBET**2*ZDUDT(JL) - ZBET   *ZDVDT(JL)
-          PVOL(JL,JK)= ZBET   *ZDUDT(JL) + ZBET**2*ZDVDT(JL)    
-          ENDDO
-        ENDIF
- 601    CONTINUE
-
-      ENDIF
-
-      RETURN
-      END
-      SUBROUTINE SUGWD(NLON,NLEV,paprs,pplay)
-C
-C**** *SUGWD* INITIALIZE COMMON YOEGWD CONTROLLING GRAVITY WAVE DRAG
-C
-C     PURPOSE.
-C     --------
-C           INITIALIZE YOEGWD, THE COMMON THAT CONTROLS THE
-C           GRAVITY WAVE DRAG PARAMETRIZATION.
-C
-C**   INTERFACE.
-C     ----------
-C        CALL *SUGWD* FROM *SUPHEC*
-C              -----        ------
-C
-C        EXPLICIT ARGUMENTS :
-C        --------------------
-C        PSIG        : VERTICAL COORDINATE TABLE
-C        NLEV        : NUMBER OF MODEL LEVELS
-C
-C        IMPLICIT ARGUMENTS :
-C        --------------------
-C        COMMON YOEGWD
-C
-C     METHOD.
-C     -------
-C        SEE DOCUMENTATION
-C
-C     EXTERNALS.
-C     ----------
-C        NONE
-C
-C     REFERENCE.
-C     ----------
-C        ECMWF Research Department documentation of the IFS
-C
-C     AUTHOR.
-C     -------
-C        MARTIN MILLER             *ECMWF*
-C
-C     MODIFICATIONS.
-C     --------------
-C        ORIGINAL : 90-01-01
-C     ------------------------------------------------------------------
-      IMPLICIT LOGICAL(L)
-C
-C     -----------------------------------------------------------------
-#include "YOEGWD.h"
-C      ----------------------------------------------------------------
-C
-      integer nlon,nlev
-      REAL paprs(nlon,nlev+1)
-      REAL pplay(nlon,nlev)
-C
-C*       1.    SET THE VALUES OF THE PARAMETERS
-C              --------------------------------
-C
- 100  CONTINUE
-C
-      PRINT *,' DANS SUGWD NLEV=',NLEV
-      GHMAX=10000.
-C
-      ZPR=100000.
-      ZSTRA=0.1 
-      ZSIGT=0.94
-cold  ZPR=80000.
-cold  ZSIGT=0.85
-C
-      DO 110 JK=1,NLEV
-      ZPM1R=pplay(nlon/2,jk)/paprs(nlon/2,1) 
-      IF(ZPM1R.GE.ZSIGT)THEN
-         nktopg=JK
-      ENDIF
-      ZPM1R=pplay(nlon/2,jk)/paprs(nlon/2,1) 
-      IF(ZPM1R.GE.ZSTRA)THEN
-         NSTRA=JK
-      ENDIF
-  110 CONTINUE
-c
-c  inversion car dans orodrag on compte les niveaux a l'envers
-      nktopg=nlev-nktopg+1
-      nstra=nlev-nstra
-      print *,' DANS SUGWD nktopg=', nktopg
-      print *,' DANS SUGWD nstra=', nstra
-C
-      GSIGCR=0.80
-C
-      GKDRAG=0.2 
-      GRAHILO=1    
-      GRCRIT=0.01
-      GFRCRIT=1.0
-      GKWAKE=0.50 
-C
-      GKLIFT=0.50
-      GVCRIT =0.0
-C
-C
-C      ----------------------------------------------------------------
-C
-C*       2.    SET VALUES OF SECURITY PARAMETERS
-C              ---------------------------------
-C
- 200  CONTINUE
-C
-      GVSEC=0.10
-      GSSEC=1.E-12
-C
-      GTSEC=1.E-07
-C
-C      ----------------------------------------------------------------
-C
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/ozonecm.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/ozonecm.F	(revision 416)
+++ 	(revision )
@@ -1,67 +1,0 @@
-      SUBROUTINE ozonecm(rjour, rlat, paprs, o3)
-      IMPLICIT none
-#include "dimensions.h"
-#include "dimphy.h"
-      REAL rlat(klon), paprs(klon,klev+1)
-      REAL o3(klon,klev)
-      REAL tozon, rjour, pi, pl
-      INTEGER i, k
-C----------------------------------------------------------
-      REAL field(klon,klev+1)
-      REAL ps
-      PARAMETER (ps=101325.0)
-      REAL an, unit, zo3q3
-      SAVE an, unit, zo3q3
-      REAL mu,gms, zslat, zsint, zcost, z, ppm, qpm, a
-      REAL asec, bsec, aprim, zo3a3
-C----------------------------------------------------------
-c         data an /365.25/   (meteo)
-      DATA an /360.00/
-      DATA unit /2.1415e-05/
-      DATA zo3q3 /4.0e-08/
-
-      pi = 4.0 * ATAN(1.0)
-      DO k = 1, klev
-      DO i = 1, klon
-      zslat = SIN(pi/180.*rlat(i))
-      zsint = SIN(2.*pi*(rjour+15.)/an)
-      zcost = COS(2.*pi*(rjour+15.)/an)
-      z = 0.0531+zsint*(-0.001595+0.009443*zslat) +
-     .  zcost*(-0.001344-0.00346*zslat) +
-     .  zslat**2*(.056222+zslat**2*(-.037609
-     . +.012248*zsint+.00521*zcost+.008890*zslat))
-      zo3a3 = zo3q3/ps/2.
-      z = z-zo3q3*ps
-      gms = z
-      mu = ABS(sin(pi/180.*rlat(i)))
-      ppm = 800.-(500.*zslat+150.*zcost)*zslat
-      qpm = 1.74e-5-(7.5e-6*zslat+1.7e-6*zcost)*zslat
-      bsec = 2650.+5000.*zslat**2
-      a = 4.0*(bsec)**(3./2.)*(ppm)**(3./2.)*(1.0+(bsec/ps)**(3./2.))
-      a = a/(bsec**(3./2.)+ppm**(3./2.))**2
-      aprim = (2.666666*qpm*ppm-a*gms)/(1.0-a)
-      aprim = amax1(0.,aprim)
-      asec = (gms-aprim)*(1.0+(bsec/ps)**(3./2.))
-      asec = AMAX1(0.0,asec)
-      aprim = gms-asec/(1.+(bsec/ps)**(3./2.))
-      pl = paprs(i,k)
-      tozon = aprim/(1.+3.*(ppm/pl)**2)+asec/(1.+(bsec/pl)**(3./2.))
-     .  + zo3a3*pl*pl
-      tozon = tozon / 9.81  ! en kg/m**2
-      tozon = tozon / unit  ! en kg/m**2  > u dobson (10e-5 m)
-      tozon = tozon / 1000. ! en cm
-      field(i,k) = tozon
-      ENDDO
-      ENDDO
-c
-      DO i = 1, klon
-         field(i,klev+1) = 0.0
-      ENDDO
-      DO k = 1, klev
-      DO i = 1, klon
-         o3(i,k) = field(i,k) - field(i,k+1)
-      ENDDO
-      ENDDO
-c
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/param_cou.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/param_cou.h	(revision 416)
+++ 	(revision )
@@ -1,11 +1,0 @@
-C
-C -- param_cou.h
-C
-	INTEGER jpflda2o
-	PARAMETER(jpflda2o = 1)          ! Number of fields exchanged from
-                                         ! atmosphere to ocean
-C
-	INTEGER jpfldo2a
-	PARAMETER(jpfldo2a = 1)          ! Number of fields exchanged from
-                                         ! ocean to atmosphere
-C
Index: LMDZ.3.3/branches/rel-/libf/phylmd/param_sipc.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/param_sipc.h	(revision 416)
+++ 	(revision )
@@ -1,21 +1,0 @@
-C@
-C@ -- param_sipc.h
-C@
-C@ -- jpbyteint : number of bytes per integer
-C@
-C@ -- jpbyterea : number of bytes per real
-C@
-C@ -- jpbytecha : number of bytes per character
-C@
-	INTEGER jpbyteint,jpbyterea, jpbytecha  
-        PARAMETER (jpbyteint = 4)
-	PARAMETER (jpbyterea = 4)
-	PARAMETER (jpbytecha = 1)
-C@
-C@ -- jptest :  The models will test during 2*jptest seconds if the file 
-C@              DUMMY_SIPC has been created by OASIS, signaling that the
-C@              SHM pools are opened. After, they will abort.
-C@
-        INTEGER jptest
-        PARAMETER(jptest = 100)      
-
Index: LMDZ.3.3/branches/rel-/libf/phylmd/phyetat0.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/phyetat0.F	(revision 416)
+++ 	(revision )
@@ -1,722 +1,0 @@
-      SUBROUTINE phyetat0 (fichnom,dtime,co2_ppm,solaire,
-     .            rlat,rlon,tsol,tsoil,deltat,qsol,snow,
-     .           radsol,rugmer,agesno,clesphy0,
-     .           zmea,zstd,zsig,zgam,zthe,zpic,zval,rugsrel,tabcntr0,
-     .           t_ancien,q_ancien,ancien_ok)
-      IMPLICIT none
-c======================================================================
-c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
-c Objet: Lecture de l'etat initial pour la physique
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "netcdf.inc"
-#include "indicesol.h"
-#include "dimsoil.h"
-#include "clesphys.h"
-c======================================================================
-      CHARACTER*(*) fichnom
-      REAL dtime
-      INTEGER radpas
-      REAL rlat(klon), rlon(klon)
-      REAL co2_ppm
-      REAL solaire
-      REAL tsol(klon,nbsrf)
-      REAL tsoil(klon,nsoilmx,nbsrf)
-      REAL deltat(klon)
-      REAL qsol(klon,nbsrf)
-      REAL snow(klon,nbsrf)
-      REAL radsol(klon)
-      REAL rugmer(klon)
-      REAL agesno(klon)
-      REAL zmea(klon)
-      REAL zstd(klon)
-      REAL zsig(klon)
-      REAL zgam(klon)
-      REAL zthe(klon)
-      REAL zpic(klon)
-      REAL zval(klon)
-      REAL rugsrel(klon)
-
-      REAL t_ancien(klon,klev), q_ancien(klon,klev)
-      LOGICAL ancien_ok
-
-      INTEGER        longcles
-      PARAMETER    ( longcles = 20 )
-      REAL clesphy0( longcles )
-c
-      REAL xmin, xmax
-c
-      INTEGER nid, nvarid
-      INTEGER ierr, i, nsrf, isoil 
-      INTEGER length
-      PARAMETER (length=100)
-      REAL tab_cntrl(length), tabcntr0(length)
-      CHARACTER*7 str7
-      CHARACTER*2 str2
-c
-c Ouvrir le fichier contenant l'etat initial:
-c
-      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
-      IF (ierr.NE.NF_NOERR) THEN
-        write(6,*)' Pb d''ouverture du fichier '//fichnom
-        write(6,*)' ierr = ', ierr
-        CALL ABORT
-      ENDIF
-c
-c Lecture des parametres de controle:
-c
-      ierr = NF_INQ_VARID (nid, "controle", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <controle> est absent'
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
-#endif
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <controle>'
-         CALL abort
-      ELSE
-c
-         DO i = 1, length
-           tabcntr0( i ) = tab_cntrl( i )
-         ENDDO
-c
-         cycle_diurne   = .FALSE.
-         soil_model     = .FALSE.
-         new_oliq       = .FALSE.
-         ok_orodr       = .FALSE.
-         ok_orolf       = .FALSE.
-         ok_limitvrai   = .FALSE.
-
-
-         IF( clesphy0(1).NE.tab_cntrl( 5 ) )  THEN
-             tab_cntrl( 5 ) = clesphy0(1)
-         ENDIF
-
-         IF( clesphy0(2).NE.tab_cntrl( 6 ) )  THEN
-             tab_cntrl( 6 ) = clesphy0(2)
-         ENDIF
-
-         IF( clesphy0(3).NE.tab_cntrl( 7 ) )  THEN
-             tab_cntrl( 7 ) = clesphy0(3)
-         ENDIF
-
-         IF( clesphy0(4).NE.tab_cntrl( 8 ) )  THEN
-             tab_cntrl( 8 ) = clesphy0(4)
-         ENDIF
-
-         IF( clesphy0(5).NE.tab_cntrl( 9 ) )  THEN
-             tab_cntrl( 9 ) = clesphy0( 5 )
-         ENDIF
-
-         IF( clesphy0(6).NE.tab_cntrl( 10 ) )  THEN
-             tab_cntrl( 10 ) = clesphy0( 6 )
-         ENDIF
-
-         IF( clesphy0(7).NE.tab_cntrl( 11 ) )  THEN
-             tab_cntrl( 11 ) = clesphy0( 7 )
-         ENDIF
-
-         IF( clesphy0(8).NE.tab_cntrl( 12 ) )  THEN
-             tab_cntrl( 12 ) = clesphy0( 8 )
-         ENDIF
-
-
-         dtime        = tab_cntrl(1)
-         radpas       = tab_cntrl(2)
-         co2_ppm      = tab_cntrl(3)
-         solaire      = tab_cntrl(4)
-         iflag_con    = tab_cntrl(5)
-         nbapp_rad    = tab_cntrl(6)
-
-
-         cycle_diurne    = .FALSE.
-         soil_model      = .FALSE.
-         new_oliq        = .FALSE.
-         ok_orodr        = .FALSE.
-         ok_orolf        = .FALSE.
-         ok_limitvrai    = .FALSE.
-
-         IF( tab_cntrl( 7) .EQ. 1. )    cycle_diurne  = .TRUE.
-         IF( tab_cntrl( 8) .EQ. 1. )       soil_model = .TRUE.
-         IF( tab_cntrl( 9) .EQ. 1. )         new_oliq = .TRUE.
-         IF( tab_cntrl(10) .EQ. 1. )         ok_orodr = .TRUE.
-         IF( tab_cntrl(11) .EQ. 1. )         ok_orolf = .TRUE.
-         IF( tab_cntrl(12) .EQ. 1. )     ok_limitvrai = .TRUE.
-
-      ENDIF
-c
-c Lecture des latitudes (coordonnees):
-c
-      ierr = NF_INQ_VARID (nid, "latitude", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <latitude> est absent'
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlat)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, rlat)
-#endif
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
-         CALL abort
-      ENDIF
-c
-c Lecture des longitudes (coordonnees):
-c
-      ierr = NF_INQ_VARID (nid, "longitude", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <longitude> est absent'
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlon)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, rlon)
-#endif
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
-         CALL abort
-      ENDIF
-c
-c Lecture des temperatures du sol:
-c
-      ierr = NF_INQ_VARID (nid, "TS", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <TS> est absent'
-         PRINT*, '          Mais je vais essayer de lire TS**'
-         DO nsrf = 1, nbsrf
-           IF (nsrf.GT.99) THEN
-             PRINT*, "Trop de sous-mailles"
-             CALL abort
-           ENDIF
-           WRITE(str2,'(i2.2)') nsrf
-           ierr = NF_INQ_VARID (nid, "TS"//str2, nvarid)
-           IF (ierr.NE.NF_NOERR) THEN
-              PRINT*, "phyetat0: Le champ <TS"//str2//"> est absent"
-              CALL abort
-           ENDIF
-#ifdef NC_DOUBLE
-           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1,nsrf))
-#else
-           ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1,nsrf))
-#endif
-           IF (ierr.NE.NF_NOERR) THEN
-             PRINT*, "phyetat0: Lecture echouee pour <TS"//str2//">"
-             CALL abort
-           ENDIF
-           xmin = 1.0E+20
-           xmax = -1.0E+20
-           DO i = 1, klon
-              xmin = MIN(tsol(i,nsrf),xmin)
-              xmax = MAX(tsol(i,nsrf),xmax)
-           ENDDO
-           PRINT*,'Temperature du sol TS**:', nsrf, xmin, xmax
-         ENDDO
-      ELSE
-         PRINT*, 'phyetat0: Le champ <TS> est present'
-         PRINT*, '          J ignore donc les autres temperatures TS**'
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1,1))
-#else
-         ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1,1))
-#endif
-         IF (ierr.NE.NF_NOERR) THEN
-            PRINT*, "phyetat0: Lecture echouee pour <TS>"
-            CALL abort
-         ENDIF
-         xmin = 1.0E+20
-         xmax = -1.0E+20
-         DO i = 1, klon
-            xmin = MIN(tsol(i,1),xmin)
-            xmax = MAX(tsol(i,1),xmax)
-         ENDDO
-         PRINT*,'Temperature du sol <TS>', xmin, xmax
-         DO nsrf = 2, nbsrf
-         DO i = 1, klon
-            tsol(i,nsrf) = tsol(i,1)
-         ENDDO
-         ENDDO
-      ENDIF
-c
-c Lecture des temperatures du sol profond:
-c
-      DO nsrf = 1, nbsrf
-      DO isoil=1, nsoilmx
-      IF (isoil.GT.99 .AND. nsrf.GT.99) THEN
-         PRINT*, "Trop de couches ou sous-mailles"
-         CALL abort
-      ENDIF
-      WRITE(str7,'(i2.2,"srf",i2.2)') isoil, nsrf
-      ierr = NF_INQ_VARID (nid, 'Tsoil'//str7, nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, "phyetat0: Le champ <Tsoil"//str7//"> est absent"
-         PRINT*, "          Il prend donc la valeur de surface"
-         DO i=1, klon
-             tsoil(i,isoil,nsrf)=tsol(i,nsrf)
-         ENDDO
-      ELSE
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,isoil,nsrf))
-#else
-         ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil,nsrf))
-#endif
-         IF (ierr.NE.NF_NOERR) THEN
-            PRINT*, "Lecture echouee pour <Tsoil"//str7//">"
-            CALL abort
-         ENDIF
-      ENDIF
-      ENDDO
-      ENDDO
-c
-c Lecture de deltat (pour slab ocean seulement):
-c
-      ierr = NF_INQ_VARID (nid, "DELTAT", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, "phyetat0: Le champ <DELTAT> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, deltat)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, deltat)
-#endif
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, "phyetat0: Lecture echouee pour <DELTAT>"
-         CALL abort
-      ENDIF
-      xmin = 1.0E+20
-      xmax = -1.0E+20
-      DO i = 1, klon
-         xmin = MIN(deltat(i),xmin)
-         xmax = MAX(deltat(i),xmax)
-      ENDDO
-      PRINT*,'Ecart de la SST deltat:', xmin, xmax
-c
-c Lecture de l'humidite du sol:
-c
-      ierr = NF_INQ_VARID (nid, "QS", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <QS> est absent'
-         PRINT*, '          Mais je vais essayer de lire QS**'
-         DO nsrf = 1, nbsrf
-           IF (nsrf.GT.99) THEN
-             PRINT*, "Trop de sous-mailles"
-             CALL abort
-           ENDIF
-           WRITE(str2,'(i2.2)') nsrf
-           ierr = NF_INQ_VARID (nid, "QS"//str2, nvarid)
-           IF (ierr.NE.NF_NOERR) THEN
-              PRINT*, "phyetat0: Le champ <QS"//str2//"> est absent"
-              CALL abort
-           ENDIF
-#ifdef NC_DOUBLE
-           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, qsol(1,nsrf))
-#else
-           ierr = NF_GET_VAR_REAL(nid, nvarid, qsol(1,nsrf))
-#endif
-           IF (ierr.NE.NF_NOERR) THEN
-             PRINT*, "phyetat0: Lecture echouee pour <QS"//str2//">"
-             CALL abort
-           ENDIF
-           xmin = 1.0E+20
-           xmax = -1.0E+20
-           DO i = 1, klon
-              xmin = MIN(qsol(i,nsrf),xmin)
-              xmax = MAX(qsol(i,nsrf),xmax)
-           ENDDO
-           PRINT*,'Humidite du sol QS**:', nsrf, xmin, xmax
-         ENDDO
-      ELSE
-         PRINT*, 'phyetat0: Le champ <QS> est present'
-         PRINT*, '          J ignore donc les autres humidites QS**'
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, qsol(1,1))
-#else
-         ierr = NF_GET_VAR_REAL(nid, nvarid, qsol(1,1))
-#endif
-         IF (ierr.NE.NF_NOERR) THEN
-            PRINT*, "phyetat0: Lecture echouee pour <QS>"
-            CALL abort
-         ENDIF
-         xmin = 1.0E+20
-         xmax = -1.0E+20
-         DO i = 1, klon
-            xmin = MIN(qsol(i,1),xmin)
-            xmax = MAX(qsol(i,1),xmax)
-         ENDDO
-         PRINT*,'Humidite du sol <QS>', xmin, xmax
-         DO nsrf = 2, nbsrf
-         DO i = 1, klon
-            qsol(i,nsrf) = qsol(i,1)
-         ENDDO
-         ENDDO
-      ENDIF
-c
-c Lecture de neige au sol:
-c
-      ierr = NF_INQ_VARID (nid, "SNOW", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <SNOW> est absent'
-         PRINT*, '          Mais je vais essayer de lire SNOW**'
-         DO nsrf = 1, nbsrf
-           IF (nsrf.GT.99) THEN
-             PRINT*, "Trop de sous-mailles"
-             CALL abort
-           ENDIF
-           WRITE(str2,'(i2.2)') nsrf
-           ierr = NF_INQ_VARID (nid, "SNOW"//str2, nvarid)
-           IF (ierr.NE.NF_NOERR) THEN
-              PRINT*, "phyetat0: Le champ <SNOW"//str2//"> est absent"
-              CALL abort
-           ENDIF
-#ifdef NC_DOUBLE
-           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, snow(1,nsrf))
-#else
-           ierr = NF_GET_VAR_REAL(nid, nvarid, snow(1,nsrf))
-#endif
-           IF (ierr.NE.NF_NOERR) THEN
-             PRINT*, "phyetat0: Lecture echouee pour <SNOW"//str2//">"
-             CALL abort
-           ENDIF
-           xmin = 1.0E+20
-           xmax = -1.0E+20
-           DO i = 1, klon
-              xmin = MIN(snow(i,nsrf),xmin)
-              xmax = MAX(snow(i,nsrf),xmax)
-           ENDDO
-           PRINT*,'Neige du sol SNOW**:', nsrf, xmin, xmax
-         ENDDO
-      ELSE
-         PRINT*, 'phyetat0: Le champ <SNOW> est present'
-         PRINT*, '          J ignore donc les autres neiges SNOW**'
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, snow(1,1))
-#else
-         ierr = NF_GET_VAR_REAL(nid, nvarid, snow(1,1))
-#endif
-         IF (ierr.NE.NF_NOERR) THEN
-            PRINT*, "phyetat0: Lecture echouee pour <SNOW>"
-            CALL abort
-         ENDIF
-         xmin = 1.0E+20
-         xmax = -1.0E+20
-         DO i = 1, klon
-            xmin = MIN(snow(i,1),xmin)
-            xmax = MAX(snow(i,1),xmax)
-         ENDDO
-         PRINT*,'Neige du sol <SNOW>', xmin, xmax
-         DO nsrf = 2, nbsrf
-         DO i = 1, klon
-            snow(i,nsrf) = snow(i,1)
-         ENDDO
-         ENDDO
-      ENDIF
-c
-c Lecture du rayonnement net au sol:
-c
-      ierr = NF_INQ_VARID (nid, "RADS", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <RADS> est absent'
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, radsol)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, radsol)
-#endif
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <RADS>'
-         CALL abort
-      ENDIF
-      xmin = 1.0E+20
-      xmax = -1.0E+20
-      DO i = 1, klon
-         xmin = MIN(radsol(i),xmin)
-         xmax = MAX(radsol(i),xmax)
-      ENDDO
-      PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
-c
-c Lecture de la longueur de rugosite en mer:
-c
-      ierr = NF_INQ_VARID (nid, "RUGMER", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <RUGMER> est absent'
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rugmer)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, rugmer)
-#endif
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <RUGMER>'
-         CALL abort
-      ENDIF
-      xmin = 1.0E+20
-      xmax = -1.0E+20
-      DO i = 1, klon
-         xmin = MIN(rugmer(i),xmin)
-         xmax = MAX(rugmer(i),xmax)
-      ENDDO
-      PRINT*,'Rugosite sur la mer rugmer:', xmin, xmax
-c
-c Lecture de l'age de la neige:
-c
-      ierr = NF_INQ_VARID (nid, "AGESNO", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <AGESNO> est absent'
-         PRINT*, "          Valeur par default: 50"
-         DO i = 1, klon
-            agesno(i) = 50.0
-         ENDDO
-      ELSE
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, agesno)
-#else
-         ierr = NF_GET_VAR_REAL(nid, nvarid, agesno)
-#endif
-         IF (ierr.NE.NF_NOERR) THEN
-            PRINT*, 'phyetat0: Lecture echouee pour <AGESNO>'
-            CALL abort
-         ENDIF
-         xmin = 1.0E+20
-         xmax = -1.0E+20
-         DO i = 1, klon
-            xmin = MIN(agesno(i),xmin)
-            xmax = MAX(agesno(i),xmax)
-         ENDDO
-         PRINT*,'Age de la neige agesno:', xmin, xmax
-      ENDIF
-c
-c
-      ierr = NF_INQ_VARID (nid, "ZMEA", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <ZMEA> est absent'
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmea)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, zmea)
-#endif
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <ZMEA>'
-         CALL abort
-      ENDIF
-      xmin = 1.0E+20
-      xmax = -1.0E+20
-      DO i = 1, klon
-         xmin = MIN(zmea(i),xmin)
-         xmax = MAX(zmea(i),xmax)
-      ENDDO
-      PRINT*,'OROGRAPHIE SOUS-MAILLE zmea:', xmin, xmax
-c
-c
-      ierr = NF_INQ_VARID (nid, "ZSTD", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <ZSTD> est absent'
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zstd)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, zstd)
-#endif
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <ZSTD>'
-         CALL abort
-      ENDIF
-      xmin = 1.0E+20
-      xmax = -1.0E+20
-      DO i = 1, klon
-         xmin = MIN(zstd(i),xmin)
-         xmax = MAX(zstd(i),xmax)
-      ENDDO
-      PRINT*,'OROGRAPHIE SOUS-MAILLE zstd:', xmin, xmax
-c
-c
-      ierr = NF_INQ_VARID (nid, "ZSIG", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <ZSIG> est absent'
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zsig)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, zsig)
-#endif
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <ZSIG>'
-         CALL abort
-      ENDIF
-      xmin = 1.0E+20
-      xmax = -1.0E+20
-      DO i = 1, klon
-         xmin = MIN(zsig(i),xmin)
-         xmax = MAX(zsig(i),xmax)
-      ENDDO
-      PRINT*,'OROGRAPHIE SOUS-MAILLE zsig:', xmin, xmax
-c
-c
-      ierr = NF_INQ_VARID (nid, "ZGAM", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <ZGAM> est absent'
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zgam)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, zgam)
-#endif
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <ZGAM>'
-         CALL abort
-      ENDIF
-      xmin = 1.0E+20
-      xmax = -1.0E+20
-      DO i = 1, klon
-         xmin = MIN(zgam(i),xmin)
-         xmax = MAX(zgam(i),xmax)
-      ENDDO
-      PRINT*,'OROGRAPHIE SOUS-MAILLE zgam:', xmin, xmax
-c
-c
-      ierr = NF_INQ_VARID (nid, "ZTHE", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <ZTHE> est absent'
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zthe)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, zthe)
-#endif
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <ZTHE>'
-         CALL abort
-      ENDIF
-      xmin = 1.0E+20
-      xmax = -1.0E+20
-      DO i = 1, klon
-         xmin = MIN(zthe(i),xmin)
-         xmax = MAX(zthe(i),xmax)
-      ENDDO
-      PRINT*,'OROGRAPHIE SOUS-MAILLE zthe:', xmin, xmax
-c
-c
-      ierr = NF_INQ_VARID (nid, "ZPIC", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <ZPIC> est absent'
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zpic)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, zpic)
-#endif
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <ZPIC>'
-         CALL abort
-      ENDIF
-      xmin = 1.0E+20
-      xmax = -1.0E+20
-      DO i = 1, klon
-         xmin = MIN(zpic(i),xmin)
-         xmax = MAX(zpic(i),xmax)
-      ENDDO
-      PRINT*,'OROGRAPHIE SOUS-MAILLE zpic:', xmin, xmax
-c
-      ierr = NF_INQ_VARID (nid, "ZVAL", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <ZVAL> est absent'
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zval)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, zval)
-#endif
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <ZVAL>'
-         CALL abort
-      ENDIF
-      xmin = 1.0E+20
-      xmax = -1.0E+20
-      DO i = 1, klon
-         xmin = MIN(zval(i),xmin)
-         xmax = MAX(zval(i),xmax)
-      ENDDO
-      PRINT*,'OROGRAPHIE SOUS-MAILLE zval:', xmin, xmax
-c
-c
-      ierr = NF_INQ_VARID (nid, "RUGSREL", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <RUGSREL> est absent'
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rugsrel)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, rugsrel)
-#endif
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <RUGSREL>'
-         CALL abort
-      ENDIF
-      xmin = 1.0E+20
-      xmax = -1.0E+20
-      DO i = 1, klon
-         xmin = MIN(rugsrel(i),xmin)
-         xmax = MAX(rugsrel(i),xmax)
-      ENDDO
-      PRINT*,'Rugosite relief (ecart-type) rugsrel:', xmin, xmax
-c
-c
-      ancien_ok = .TRUE.
-c
-      ierr = NF_INQ_VARID (nid, "TANCIEN", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, "phyetat0: Le champ <TANCIEN> est absent"
-         PRINT*, "Depart legerement fausse. Mais je continue"
-         ancien_ok = .FALSE.
-      ELSE
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, t_ancien)
-#else
-         ierr = NF_GET_VAR_REAL(nid, nvarid, t_ancien)
-#endif
-         IF (ierr.NE.NF_NOERR) THEN
-            PRINT*, "phyetat0: Lecture echouee pour <TANCIEN>"
-            CALL abort
-         ENDIF
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "QANCIEN", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, "phyetat0: Le champ <QANCIEN> est absent"
-         PRINT*, "Depart legerement fausse. Mais je continue"
-         ancien_ok = .FALSE.
-      ELSE
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q_ancien)
-#else
-         ierr = NF_GET_VAR_REAL(nid, nvarid, q_ancien)
-#endif
-         IF (ierr.NE.NF_NOERR) THEN
-            PRINT*, "phyetat0: Lecture echouee pour <QANCIEN>"
-            CALL abort
-         ENDIF
-      ENDIF
-c
-c Fermer le fichier:
-c
-      ierr = NF_CLOSE(nid)
-c
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/phyredem.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/phyredem.F	(revision 416)
+++ 	(revision )
@@ -1,425 +1,0 @@
-      SUBROUTINE phyredem (fichnom,dtime,radpas,co2_ppm,solaire,
-     .           rlat,rlon,tsol,tsoil,deltat,qsol,snow,
-     .           radsol,rugmer,agesno,
-     .           zmea,zstd,zsig,zgam,zthe,zpic,zval,rugsrel,
-     .           t_ancien, q_ancien)
-      IMPLICIT none
-c======================================================================
-c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
-c Objet: Ecriture de l'etat de redemarrage pour la physique
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "netcdf.inc"
-#include "indicesol.h"
-#include "dimsoil.h"
-#include "clesphys.h"
-#include "control.h"
-#include "temps.h"
-c======================================================================
-      CHARACTER*(*) fichnom
-      REAL dtime
-      INTEGER radpas
-      REAL rlat(klon), rlon(klon)
-      REAL co2_ppm
-      REAL solaire
-      REAL tsol(klon,nbsrf)
-      REAL tsoil(klon,nsoilmx,nbsrf)
-      REAL deltat(klon)
-      REAL qsol(klon,nbsrf)
-      REAL snow(klon,nbsrf)
-      REAL radsol(klon)
-      REAL rugmer(klon)
-      REAL agesno(klon)
-      REAL zmea(klon)
-      REAL zstd(klon)
-      REAL zsig(klon)
-      REAL zgam(klon)
-      REAL zthe(klon)
-      REAL zpic(klon)
-      REAL zval(klon)
-      REAL rugsrel(klon)
-      REAL t_ancien(klon,klev), q_ancien(klon,klev)
-c
-      INTEGER nid, nvarid, idim1, idim2, idim3
-      INTEGER ierr
-      INTEGER length
-      PARAMETER (length=100)
-      REAL tab_cntrl(length)
-c
-      INTEGER isoil, nsrf
-      CHARACTER*7 str7
-      CHARACTER*2 str2
-c
-      ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
-      IF (ierr.NE.NF_NOERR) THEN
-        write(6,*)' Pb d''ouverture du fichier '//fichnom
-        write(6,*)' ierr = ', ierr
-        CALL ABORT
-      ENDIF
-c
-      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 28,
-     .                       "Fichier redemmarage physique")
-c
-      ierr = NF_DEF_DIM (nid, "index", length, idim1)
-      ierr = NF_DEF_DIM (nid, "points_physiques", klon, idim2)
-      ierr = NF_DEF_DIM (nid, "horizon_vertical", klon*klev, idim3)
-c
-      ierr = NF_ENDDEF(nid)
-c
-      DO ierr = 1, length
-         tab_cntrl(ierr) = 0.0
-      ENDDO
-      tab_cntrl(1) = dtime
-      tab_cntrl(2) = radpas
-      tab_cntrl(3) = co2_ppm
-      tab_cntrl(4) = solaire
-      tab_cntrl(5) = iflag_con
-      tab_cntrl(6) = nbapp_rad
-
-      IF( cycle_diurne ) tab_cntrl( 7 ) = 1.
-      IF(   soil_model ) tab_cntrl( 8 ) = 1.
-      IF(     new_oliq ) tab_cntrl( 9 ) = 1.
-      IF(     ok_orodr ) tab_cntrl(10 ) = 1.
-      IF(     ok_orolf ) tab_cntrl(11 ) = 1.
-
-      tab_cntrl(13) = dayref
-      tab_cntrl(14) = anneeref
-      tab_cntrl(13) = day_end
-      tab_cntrl(14) = anne_ini
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, idim1,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, idim1,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
-     .                        "Parametres de controle")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "longitude", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "longitude", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
-     .                        "Longitudes de la grille physique")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlon)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlon)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "latitude", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 31,
-     .                        "Latitudes de la grille physique")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlat)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlat)
-#endif
-c
-c
-      DO nsrf = 1, nbsrf
-        IF (nsrf.LE.99) THEN
-        WRITE(str2,'(i2.2)') nsrf
-        ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid, "TS"//str2, NF_DOUBLE, 1, idim2,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid, "TS"//str2, NF_FLOAT, 1, idim2,nvarid)
-#endif
-        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
-     .                        "Temperature de surface No."//str2)
-        ierr = NF_ENDDEF(nid)
-        ELSE
-        PRINT*, "Trop de sous-mailles"
-        CALL abort
-        ENDIF
-#ifdef NC_DOUBLE
-        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsol(1,nsrf))
-#else
-        ierr = NF_PUT_VAR_REAL (nid,nvarid,tsol(1,nsrf))
-#endif
-      ENDDO
-c
-      DO nsrf = 1, nbsrf
-      DO isoil=1, nsoilmx
-        IF (isoil.LE.99 .AND. nsrf.LE.99) THEN
-        WRITE(str7,'(i2.2,"srf",i2.2)') isoil,nsrf
-        ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid, "Tsoil"//str7,NF_DOUBLE,1,idim2,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid, "Tsoil"//str7,NF_FLOAT,1,idim2,nvarid)
-#endif
-        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 29,
-     .                        "Temperature du sol No."//str7)
-        ierr = NF_ENDDEF(nid)
-        ELSE
-        PRINT*, "Trop de couches"
-        CALL abort
-        ENDIF
-#ifdef NC_DOUBLE
-        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsoil(1,isoil,nsrf))
-#else
-        ierr = NF_PUT_VAR_REAL (nid,nvarid,tsoil(1,isoil,nsrf))
-#endif
-      ENDDO
-      ENDDO
-c
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "DELTAT", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "DELTAT", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 33,
-     .                        "Ecart de la SST (pour slab-ocean)")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,deltat)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,deltat)
-#endif
-c
-      DO nsrf = 1, nbsrf
-        IF (nsrf.LE.99) THEN
-        WRITE(str2,'(i2.2)') nsrf
-        ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid,"QS"//str2,NF_DOUBLE,1,idim2,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid,"QS"//str2,NF_FLOAT,1,idim2,nvarid)
-#endif
-        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 25,
-     .                        "Humidite de surface No."//str2)
-        ierr = NF_ENDDEF(nid)
-        ELSE
-        PRINT*, "Trop de sous-mailles"
-        CALL abort
-        ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,qsol(1,nsrf))
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,qsol(1,nsrf))
-#endif
-      ENDDO
-c
-      DO nsrf = 1, nbsrf
-        IF (nsrf.LE.99) THEN
-        WRITE(str2,'(i2.2)') nsrf
-        ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid,"SNOW"//str2,NF_DOUBLE,1,idim2,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid,"SNOW"//str2,NF_FLOAT,1,idim2,nvarid)
-#endif
-        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
-     .                        "Neige de surface No."//str2)
-        ierr = NF_ENDDEF(nid)
-        ELSE
-        PRINT*, "Trop de sous-mailles"
-        CALL abort
-        ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,snow(1,nsrf))
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,snow(1,nsrf))
-#endif
-      ENDDO
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "RADS", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "RADS", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
-     .                        "Rayonnement net a la surface")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,radsol)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,radsol)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "RUGMER", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "RUGMER", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
-     .                        "Longueur de rugosite sur mer")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rugmer)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rugmer)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "AGESNO", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "AGESNO", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 15,
-     .                        "Age de la neige")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,agesno)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,agesno)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZMEA", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZMEA", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zmea)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,zmea)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZSTD", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZSTD", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zstd)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,zstd)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZSIG", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZSIG", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zsig)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,zsig)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZGAM", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZGAM", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zgam)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,zgam)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZTHE", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZTHE", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zthe)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,zthe)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZPIC", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZPIC", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zpic)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,zpic)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZVAL", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZVAL", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zval)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,zval)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "RUGSREL", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "RUGSREL", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rugsrel)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rugsrel)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "TANCIEN", NF_DOUBLE, 1, idim3,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "TANCIEN", NF_FLOAT, 1, idim3,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,t_ancien)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,t_ancien)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "QANCIEN", NF_DOUBLE, 1, idim3,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "QANCIEN", NF_FLOAT, 1, idim3,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q_ancien)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,q_ancien)
-#endif
-c
-      ierr = NF_CLOSE(nid)
-c
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/physiq.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/physiq.F	(revision 416)
+++ 	(revision )
@@ -1,3058 +1,0 @@
-c $Header$
-c
-      SUBROUTINE physiq (nlon,
-     .                   nlev,
-     .                   nqmax,
-     .                   debut,
-     .                   lafin,
-     .                   rjourvrai,
-     .                   rjour_ecri,
-     .                   gmtime,
-     .                   pdtphys,
-     .                   paprs,
-     .                   pplay,
-     .                   pphi,
-     .                   pphis,
-     .                   paire,
-     .                   presnivs,
-     .                   clesphy0,
-     .                   u,
-     .                   v,
-     .                   t,
-     .                   qx,
-     .                   omega,
-#ifdef INCA_CH4
-     .                   flxmass_w,
-#endif
-     .                   d_u, 
-     .                   d_v, 
-     .                   d_t, 
-     .                   d_qx, 
-     .                   d_ps)
-      USE ioipsl
-#ifdef INCA
-      USE chemshut 
-      USE obs_pos
-#endif
-      IMPLICIT none
-c======================================================================
-c
-c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
-c
-c Objet: Moniteur general de la physique du modele
-cAA      Modifications quant aux traceurs :
-cAA                  -  uniformisation des parametrisations ds phytrac
-cAA                  -  stockage des moyennes des champs necessaires
-cAA                     en mode traceur off-line 
-c======================================================================
-c    modif   ( P. Le Van ,  12/10/98 )
-c
-c  Arguments:
-c
-c nlon----input-I-nombre de points horizontaux
-c nlev----input-I-nombre de couches verticales
-c nqmax---input-I-nombre de traceurs (y compris vapeur d'eau) = 1
-c debut---input-L-variable logique indiquant le premier passage
-c lafin---input-L-variable logique indiquant le dernier passage
-c rjour---input-R-numero du jour de l'experience
-c gmtime--input-R-temps universel dans la journee (0 a 86400 s)
-c pdtphys-input-R-pas d'integration pour la physique (seconde)
-c paprs---input-R-pression pour chaque inter-couche (en Pa)
-c pplay---input-R-pression pour le mileu de chaque couche (en Pa)
-c pphi----input-R-geopotentiel de chaque couche (g z) (reference sol)
-c pphis---input-R-geopotentiel du sol
-c paire---input-R-aire de chaque maille
-c presnivs-input_R_pressions approximat. des milieux couches ( en PA)
-c u-------input-R-vitesse dans la direction X (de O a E) en m/s
-c v-------input-R-vitesse Y (de S a N) en m/s
-c t-------input-R-temperature (K)
-c qx------input-R-humidite specifique (kg/kg) et d'autres traceurs
-c d_t_dyn-input-R-tendance dynamique pour "t" (K/s)
-c d_q_dyn-input-R-tendance dynamique pour "q" (kg/kg/s)
-c omega---input-R-vitesse verticale en Pa/s
-c
-c d_u-----output-R-tendance physique de "u" (m/s/s)
-c d_v-----output-R-tendance physique de "v" (m/s/s)
-c d_t-----output-R-tendance physique de "t" (K/s)
-c d_qx----output-R-tendance physique de "qx" (kg/kg/s)
-c d_ps----output-R-tendance physique de la pression au sol
-c======================================================================
-#include "dimensions.h"
-      integer jjmp1
-      parameter (jjmp1=jjm+1-1/jjm)
-#include "dimphy.h"
-#include "regdim.h"
-#include "indicesol.h"
-#include "dimsoil.h"
-#include "clesphys.h"
-#include "control.h"
-#include "temps.h"
-c======================================================================
-      LOGICAL check ! Verifier la conservation du modele en eau
-      PARAMETER (check=.FALSE.)
-      LOGICAL ok_stratus ! Ajouter artificiellement les stratus
-      PARAMETER (ok_stratus=.FALSE.)
-c======================================================================
-c Parametres lies au coupleur OASIS:
-#include "oasis.h"
-      INTEGER npas, nexca, itimestep
-      logical rnpb
-#ifdef INCA
-      parameter(rnpb=.false.)
-#else
-      parameter(rnpb=.true.)
-#endif
-      PARAMETER (npas=1440)
-      PARAMETER (nexca=48)
-      PARAMETER (itimestep=1800)
-      EXTERNAL fromcpl, intocpl, inicma
-      REAL cpl_sst(iim,jjmp1), cpl_sic(iim,jjmp1)
-      REAL cpl_alb_sst(iim,jjmp1), cpl_alb_sic(iim,jjmp1)
-c======================================================================
-c ok_ocean indique l'utilisation du modele oceanique "slab ocean",
-c il faut bien sur s'assurer que le bilan energetique de reference
-c a la surface de l'ocean est bien present dans le fichier des
-c conditions aux limites, ainsi que l'indicateur du sol ne contient
-c pas de glace oceanique (pas de valeur 3).
-c
-      LOGICAL ok_ocean
-      PARAMETER (ok_ocean=.FALSE.)
-      REAL cyang  ! capacite thermique de l'ocean superficiel
-      PARAMETER (cyang=30.0 * 4.228e+06)
-      REAL cbing  ! capacite thermique de la glace oceanique
-      PARAMETER (cbing=1.0 * 4.228e+06)
-      REAL cthermiq
-c======================================================================
-c Clef controlant l'activation du cycle diurne:
-ccc      LOGICAL cycle_diurne
-ccc      PARAMETER (cycle_diurne=.FALSE.)
-c======================================================================
-c Modele thermique du sol, a activer pour le cycle diurne:
-ccc      LOGICAL soil_model
-ccc      PARAMETER (soil_model=.FALSE.)
-      REAL soilcap(klon,nbsrf), soilflux(klon,nbsrf)
-      SAVE soilcap, soilflux
-c======================================================================
-c Dans les versions precedentes, l'eau liquide nuageuse utilisee dans
-c le calcul du rayonnement est celle apres la precipitation des nuages.
-c Si cette cle new_oliq est activee, ce sera une valeur moyenne entre
-c la condensation et la precipitation. Cette cle augmente les impacts
-c radiatifs des nuages.
-ccc      LOGICAL new_oliq
-ccc      PARAMETER (new_oliq=.FALSE.)
-c======================================================================
-c Clefs controlant deux parametrisations de l'orographie:
-cc      LOGICAL ok_orodr
-ccc      PARAMETER (ok_orodr=.FALSE.)
-ccc      LOGICAL ok_orolf
-ccc      PARAMETER (ok_orolf=.FALSE.)
-c======================================================================
-      LOGICAL ok_journe ! sortir le fichier journalier
-      PARAMETER (ok_journe=.FALSE.)
-c
-      LOGICAL ok_mensuel ! sortir le fichier mensuel
-      PARAMETER (ok_mensuel=.TRUE.)
-c
-      LOGICAL ok_instan ! sortir le fichier instantane
-      PARAMETER (ok_instan=.FALSE.)
-c
-      LOGICAL ok_region ! sortir le fichier regional
-      PARAMETER (ok_region=.FALSE.)
-c======================================================================
-c
-      INTEGER ivap          ! indice de traceurs pour vapeur d'eau
-      PARAMETER (ivap=1)
-      INTEGER iliq          ! indice de traceurs pour eau liquide
-      PARAMETER (iliq=2)
-c
-      INTEGER nvm           ! nombre de vegetations
-      PARAMETER (nvm=8)
-      REAL veget(klon,nvm)  ! couverture vegetale
-      SAVE veget
-c
-c Variables argument:
-c
-      INTEGER nlon
-      INTEGER nlev
-      INTEGER nqmax
-      REAL rjourvrai, rjour_ecri
-      REAL gmtime
-      REAL pdtphys
-      LOGICAL debut, lafin
-      REAL paprs(klon,klev+1)
-      REAL pplay(klon,klev)
-      REAL pphi(klon,klev)
-      REAL pphis(klon)
-      REAL paire(klon)
-      REAL presnivs(klev)
-      REAL znivsig(klev)
-
-      REAL u(klon,klev)
-      REAL v(klon,klev)
-      REAL t(klon,klev)
-      REAL qx(klon,klev,nqmax)
-
-      REAL t_ancien(klon,klev), q_ancien(klon,klev)
-      SAVE t_ancien, q_ancien
-      LOGICAL ancien_ok
-      SAVE ancien_ok
-
-      REAL d_u_dyn(klon,klev)
-      REAL d_v_dyn(klon,klev)
-      REAL d_t_dyn(klon,klev)
-      REAL d_q_dyn(klon,klev)
-
-      REAL omega(klon,klev)
-
-      REAL flxmass_w(klon,klev)
-
-      REAL d_u(klon,klev)
-      REAL d_v(klon,klev)
-      REAL d_t(klon,klev)
-      REAL d_qx(klon,klev,nqmax)
-      REAL d_ps(klon)
-
-      INTEGER        longcles
-      PARAMETER    ( longcles = 20 )
-      REAL clesphy0( longcles      )
-c
-c Variables quasi-arguments
-c
-      REAL xjour
-      SAVE xjour
-c
-c
-c Variables propres a la physique
-c
-      REAL dtime
-      SAVE dtime                  ! pas temporel de la physique
-c
-      INTEGER radpas
-      SAVE radpas                 ! frequence d'appel rayonnement
-c
-      REAL radsol(klon)
-      SAVE radsol                 ! bilan radiatif au sol
-c
-      REAL rlat(klon)
-      SAVE rlat                   ! latitude pour chaque point
-c
-      REAL rlon(klon)
-      SAVE rlon                   ! longitude pour chaque point
-c
-cc      INTEGER iflag_con
-cc      SAVE iflag_con              ! indicateur de la convection
-c
-      INTEGER itap
-      SAVE itap                   ! compteur pour la physique
-c
-      REAL co2_ppm
-      SAVE co2_ppm                ! concentration du CO2
-c
-      REAL solaire
-      SAVE solaire                ! constante solaire
-c
-      REAL ftsol(klon,nbsrf)
-      SAVE ftsol                  ! temperature du sol
-c
-      REAL ftsoil(klon,nsoilmx,nbsrf)
-      SAVE ftsoil                 ! temperature dans le sol
-c
-      REAL deltat(klon)
-      SAVE deltat                 ! ecart avec la SST de reference
-c
-      REAL fqsol(klon,nbsrf)
-      SAVE fqsol                  ! humidite du sol
-c
-      REAL fsnow(klon,nbsrf)
-      SAVE fsnow                  ! epaisseur neigeuse
-c
-      REAL rugmer(klon)
-      SAVE rugmer                 ! longeur de rugosite sur mer (m)
-c
-c  Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):
-c
-      REAL zmea(klon)
-      SAVE zmea                   ! orographie moyenne
-c
-      REAL zstd(klon)
-      SAVE zstd                   ! deviation standard de l'OESM
-c
-      REAL zsig(klon)
-      SAVE zsig                   ! pente de l'OESM
-c
-      REAL zgam(klon)
-      save zgam                   ! anisotropie de l'OESM
-c
-      REAL zthe(klon)
-      SAVE zthe                   ! orientation de l'OESM
-c
-      REAL zpic(klon)
-      SAVE zpic                   ! Maximum de l'OESM
-c
-      REAL zval(klon)
-      SAVE zval                   ! Minimum de l'OESM
-c
-      REAL rugoro(klon)
-      SAVE rugoro                 ! longueur de rugosite de l'OESM
-c
-      REAL zulow(klon),zvlow(klon),zustr(klon), zvstr(klon)
-c
-      REAL zuthe(klon),zvthe(klon)
-      SAVE zuthe
-      SAVE zvthe
-      INTEGER igwd,igwdim,idx(klon),itest(klon)
-c
-      REAL agesno(klon)
-      SAVE agesno                 ! age de la neige
-c
-      REAL alb_neig(klon)
-      SAVE alb_neig               ! albedo de la neige
-cKE43
-c Variables liees a la convection de K. Emanuel (sb):
-c
-      REAL ema_workcbmf(klon)   ! cloud base mass flux
-      SAVE ema_workcbmf
-
-      REAL ema_cbmf(klon)       ! cloud base mass flux
-      SAVE ema_cbmf
-
-      REAL ema_pcb(klon)        ! cloud base pressure
-      SAVE ema_pcb
-
-      REAL ema_pct(klon)        ! cloud top pressure
-      SAVE ema_pct
-
-      REAL bas, top             ! cloud base and top levels
-      SAVE bas
-      SAVE top
-
-      REAL Ma(klon,klev)        ! undilute upward mass flux
-      SAVE Ma
-      REAL ema_work1(klon, klev), ema_work2(klon, klev)
-      SAVE ema_work1, ema_work2
-      REAL wdn(klon), tdn(klon), qdn(klon)
-c Variables locales pour la couche limite (al1):
-c
-cAl1      REAL pblh(klon)           ! Hauteur de couche limite
-cAl1      SAVE pblh
-c34EK
-c
-c Variables locales:
-c
-      REAL cdragh(klon) ! drag coefficient pour T and Q
-      REAL cdragm(klon) ! drag coefficient pour vent
-cAA
-cAA  Pour phytrac 
-cAA
-      REAL ycoefh(klon,klev)    ! coef d'echange pour phytrac
-      REAL yu1(klon)            ! vents dans la premiere couche U
-      REAL yv1(klon)            ! vents dans la premiere couche V
-      LOGICAL offline           ! Controle du stockage ds "physique"
-      PARAMETER (offline=.false.)
-      INTEGER physid
-      REAL pfrac_impa(klon,klev)! Produits des coefs lessivage impaction
-      save pfrac_impa
-      REAL pfrac_nucl(klon,klev)! Produits des coefs lessivage nucleation
-      save pfrac_nucl
-      REAL pfrac_1nucl(klon,klev)! Produits des coefs lessi nucl (alpha = 1)
-      save pfrac_1nucl
-      REAL frac_impa(klon,klev) ! fractions d'aerosols lessivees (impaction)
-      REAL frac_nucl(klon,klev) ! idem (nucleation)
-
-#ifdef INCA
-      REAL          :: calday
-#endif
-
-cAA
-      REAL rain_fall(klon) ! pluie
-      REAL snow_fall(klon) ! neige
-      REAL evap(klon), devap(klon) ! evaporation et sa derivee
-      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
-      REAL bils(klon) ! bilan de chaleur au sol
-      REAL fder(klon) ! Derive de flux (sensible et latente) 
-      REAL ruis(klon) ! ruissellement
-      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
-      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
-      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
-      REAL uq(klon) ! integr. verticale du transport zonal de l'eau
-c
-      REAL frugs(klon,nbsrf) ! longueur de rugosite
-      REAL zxrugs(klon) ! longueur de rugosite
-c
-c Conditions aux limites
-c
-      INTEGER julien
-      INTEGER idayvrai
-      SAVE idayvrai
-c
-      INTEGER lmt_pas
-      SAVE lmt_pas                ! frequence de mise a jour
-      REAL pctsrf(klon,nbsrf)
-      SAVE pctsrf                 ! sous-fraction du sol
-      REAL lmt_sst(klon)
-      SAVE lmt_sst                ! temperature de la surface ocean
-      REAL lmt_bils(klon)
-      SAVE lmt_bils               ! bilan de chaleur au sol
-      REAL lmt_alb(klon)
-      SAVE lmt_alb                ! temperature de la surface ocean
-      REAL lmt_rug(klon)
-      SAVE lmt_rug                ! longueur de rugosite
-      REAL alb_eau(klon)
-      SAVE alb_eau                ! albedo sur l'ocean
-      REAL albsol(klon)
-      SAVE albsol                 ! albedo du sol total
-      REAL wo(klon,klev)
-      SAVE wo                     ! ozone
-c======================================================================
-c
-c Declaration des procedures appelees
-c
-      EXTERNAL angle     ! calculer angle zenithal du soleil
-      EXTERNAL alboc     ! calculer l'albedo sur ocean
-      EXTERNAL albsno    ! calculer albedo sur neige
-      EXTERNAL ajsec     ! ajustement sec
-      EXTERNAL clmain    ! couche limite 
-      EXTERNAL condsurf  ! lire les conditions aux limites
-      EXTERNAL conlmd    ! convection (schema LMD)
-cKE43
-      EXTERNAL conema  ! convect4.3
-      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)
-cAA 
-      EXTERNAL fisrtilp_tr ! schema de condensation a grande echelle (pluie)
-c                          ! stockage des coefficients necessaires au
-c                          ! lessivage OFF-LINE et ON-LINE
-cAA
-      EXTERNAL hgardfou  ! verifier les temperatures
-      EXTERNAL hydrol    ! hydrologie du sol
-      EXTERNAL nuage     ! calculer les proprietes radiatives
-      EXTERNAL o3cm      ! initialiser l'ozone
-      EXTERNAL orbite    ! calculer l'orbite terrestre
-      EXTERNAL ozonecm   ! prescrire l'ozone
-      EXTERNAL phyetat0  ! lire l'etat initial de la physique
-      EXTERNAL phyredem  ! ecrire l'etat de redemarrage de la physique
-      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge
-      EXTERNAL suphec    ! initialiser certaines constantes
-      EXTERNAL transp    ! transport total de l'eau et de l'energie
-      EXTERNAL ecribina  ! ecrire le fichier binaire global
-      EXTERNAL ecribins  ! ecrire le fichier binaire global
-      EXTERNAL ecrirega  ! ecrire le fichier binaire regional
-      EXTERNAL ecriregs  ! ecrire le fichier binaire regional
-c
-c Variables locales
-c
-      REAL rhcl(klon,klev)    ! humiditi relative ciel clair
-      REAL dialiq(klon,klev)  ! eau liquide nuageuse
-      REAL diafra(klon,klev)  ! fraction nuageuse
-      REAL cldliq(klon,klev)  ! eau liquide nuageuse
-      REAL cldfra(klon,klev)  ! fraction nuageuse
-      REAL cldtau(klon,klev)  ! epaisseur optique
-      REAL cldemi(klon,klev)  ! emissivite infrarouge
-c
-      REAL fluxq(klon,klev)   ! flux turbulent d'humidite
-      REAL fluxt(klon,klev)   ! flux turbulent de chaleur
-      REAL fluxu(klon,klev)   ! flux turbulent de vitesse u
-      REAL fluxv(klon,klev)   ! flux turbulent de vitesse v
-c
-      REAL heat(klon,klev)    ! chauffage solaire
-      REAL heat0(klon,klev)   ! chauffage solaire ciel clair
-      REAL cool(klon,klev)    ! refroidissement infrarouge
-      REAL cool0(klon,klev)   ! refroidissement infrarouge ciel clair
-      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)
-      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
-      REAL albpla(klon)
-c Le rayonnement n'est pas calcule tous les pas, il faut donc
-c                      sauvegarder les sorties du rayonnement
-      SAVE  heat,cool,albpla,topsw,toplw,solsw,sollw
-      SAVE  topsw0,toplw0,solsw0,sollw0, heat0, cool0
-      INTEGER itaprad
-      SAVE itaprad
-c
-      REAL conv_q(klon,klev) ! convergence de l'humidite (kg/kg/s)
-      REAL conv_t(klon,klev) ! convergence de la temperature(K/s)
-c
-      REAL cldl(klon),cldm(klon),cldh(klon) !nuages bas, moyen et haut
-      REAL cldt(klon),cldq(klon) !nuage total, eau liquide integree
-c
-      REAL zx_alb_lic, zx_alb_oce, zx_alb_ter, zx_alb_sic
-      REAL zxtsol(klon), zxqsol(klon), zxsnow(klon)
-c
-      REAL dist, rmu0(klon), fract(klon)
-      REAL zdtime, zlongi
-c
-      CHARACTER*2 str2
-      CHARACTER*2 iqn
-c
-      REAL qcheck
-      REAL z_avant(klon), z_apres(klon), z_factor(klon)
-      LOGICAL zx_ajustq
-c
-      REAL za, zb
-      REAL zx_t, zx_qs, zdelta, zcor, zfra, zlvdcp, zlsdcp
-      INTEGER i, k, iq, ig, j, nsrf, ll
-      REAL t_coup
-      PARAMETER (t_coup=234.0)
-c
-      REAL zphi(klon,klev)
-      REAL zx_tmp_x(iim), zx_tmp_yjjmp1
-      REAL zx_relief(iim,jjmp1)
-      REAL zx_aire(iim,jjmp1)
-cKE43
-c Variables locales pour la convection de K. Emanuel (sb):
-c
-      REAL upwd(klon,klev)      ! saturated updraft mass flux
-      REAL dnwd(klon,klev)      ! saturated downdraft mass flux
-      REAL dnwd0(klon,klev)     ! unsaturated downdraft mass flux
-      REAL tvp(klon,klev)       ! virtual temp of lifted parcel
-      REAL cape(klon)           ! CAPE
-      SAVE cape
-      REAL pbase(klon)          ! cloud base pressure
-      SAVE pbase
-      REAL bbase(klon)          ! cloud base buoyancy
-      SAVE bbase
-      REAL rflag(klon)          ! flag fonctionnement de convect
-      INTEGER iflagctrl(klon)          ! flag fonctionnement de convect
-c -- convect43:
-      INTEGER ntra              ! nb traceurs pour convect4.3
-      REAL pori_con(klon)    ! pressure at the origin level of lifted parcel
-      REAL plcl_con(klon),dtma_con(klon),dtlcl_con(klon)
-      REAL dtvpdt1(klon,klev), dtvpdq1(klon,klev)
-      REAL dplcldt(klon), dplcldr(klon)
-c?     .     condm_con(klon,klev),conda_con(klon,klev),
-c?     .     mr_con(klon,klev),ep_con(klon,klev)
-c?     .    ,sadiab(klon,klev),wadiab(klon,klev)
-c --
-c34EK
-c
-c Variables du changement
-c
-c con: convection
-c lsc: condensation a grande echelle (Large-Scale-Condensation)
-c ajs: ajustement sec
-c eva: evaporation de l'eau liquide nuageuse
-c vdf: couche limite (Vertical DiFfusion)
-      REAL d_t_con(klon,klev),d_q_con(klon,klev)
-      REAL d_u_con(klon,klev),d_v_con(klon,klev)
-      REAL d_t_lsc(klon,klev),d_q_lsc(klon,klev),d_ql_lsc(klon,klev)
-      REAL d_t_ajs(klon,klev), d_q_ajs(klon,klev)
-      REAL d_t_eva(klon,klev),d_q_eva(klon,klev)
-      REAL rneb(klon,klev)
-c
-      REAL pmfu(klon,klev), pmfd(klon,klev)
-      REAL pen_u(klon,klev), pen_d(klon,klev)
-      REAL pde_u(klon,klev), pde_d(klon,klev)
-      INTEGER kcbot(klon), kctop(klon), kdtop(klon)
-      REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1)
-      REAL prfl(klon,klev+1), psfl(klon,klev+1)
-c
-      INTEGER ibas_con(klon), itop_con(klon)
-      REAL rain_con(klon), rain_lsc(klon)
-      REAL snow_con(klon), snow_lsc(klon)
-      REAL d_ts(klon,nbsrf)
-c
-      REAL d_u_vdf(klon,klev), d_v_vdf(klon,klev)
-      REAL d_t_vdf(klon,klev), d_q_vdf(klon,klev)
-c
-      REAL d_u_oro(klon,klev), d_v_oro(klon,klev)
-      REAL d_t_oro(klon,klev)
-      REAL d_u_lif(klon,klev), d_v_lif(klon,klev)
-      REAL d_t_lif(klon,klev)
-
-      REAL ratqs(klon,klev)
-      integer flag_ratqs
-      real zpt_conv(klon,klev)
-
-c
-c Variables liees a l'ecriture de la bande histoire physique
-c
-      INTEGER ecrit_mth
-      SAVE ecrit_mth   ! frequence d'ecriture (fichier mensuel)
-c
-      INTEGER ecrit_day
-      SAVE ecrit_day   ! frequence d'ecriture (fichier journalier)
-c
-      INTEGER ecrit_ins
-      SAVE ecrit_ins   ! frequence d'ecriture (fichier instantane)
-c
-      INTEGER ecrit_reg
-      SAVE ecrit_reg   ! frequence d'ecriture
-c
-      REAL oas_sols(klon), z_sols(iim,jjmp1)
-      SAVE oas_sols
-      REAL oas_nsol(klon), z_nsol(iim,jjmp1)
-      SAVE oas_nsol
-      REAL oas_rain(klon), z_rain(iim,jjmp1)
-      SAVE oas_rain
-      REAL oas_snow(klon), z_snow(iim,jjmp1)
-      SAVE oas_snow
-      REAL oas_evap(klon), z_evap(iim,jjmp1)
-      SAVE oas_evap
-      REAL oas_ruis(klon), z_ruis(iim,jjmp1)
-      SAVE oas_ruis
-      REAL oas_tsol(klon), z_tsol(iim,jjmp1)
-      SAVE oas_tsol
-      REAL oas_fder(klon), z_fder(iim,jjmp1)
-      SAVE oas_fder
-      REAL oas_albe(klon), z_albe(iim,jjmp1)
-      SAVE oas_albe
-      REAL oas_taux(klon), z_taux(iim,jjmp1)
-      SAVE oas_taux
-      REAL oas_tauy(klon), z_tauy(iim,jjmp1)
-      SAVE oas_tauy
-      REAL oas_ruisoce(klon), z_ruisoce(iim,jjmp1)
-      SAVE oas_ruisoce
-      REAL oas_ruisriv(klon), z_ruisriv(iim,jjmp1)
-      SAVE oas_ruisriv
-c
-c
-c Variables locales pour effectuer les appels en serie
-c
-      REAL t_seri(klon,klev), q_seri(klon,klev)
-      REAL ql_seri(klon,klev)
-      REAL u_seri(klon,klev), v_seri(klon,klev)
-c
-      REAL tr_seri(klon,klev,nbtr)
-      REAL d_tr(klon,klev,nbtr)
-      REAL source_tr(klon,nbtr)
-
-      REAL zx_rh(klon,klev)
-      REAL dtimeday,dtimecri,dtimexp9,fecri_pas,fecri86400,fecritday
-
-      INTEGER        length
-      PARAMETER    ( length = 100 )
-      REAL tabcntr0( length       )
-c
-      INTEGER ndex2d(iim*jjmp1),ndex3d(iim*jjmp1*klev)
-      REAL zx_tmp_fi2d(klon)
-      REAL zx_tmp_2d(iim,jjmp1), zx_tmp_3d(iim,jjmp1,klev)
-      REAL zx_lon(iim,jjmp1), zx_lat(iim,jjmp1)
-c
-      INTEGER nid_day, nid_mth, nid_ins
-      SAVE nid_day, nid_mth, nid_ins
-c
-      INTEGER nhori, nvert
-      REAL zsto, zout, zjulian
-      integer idayref
-
-      character*20 modname
-      character*80 abort_message
-      logical ok_sync
-
-c
-c Declaration des constantes et des fonctions thermodynamiques
-c
-#include "YOMCST.h"
-#include "YOETHF.h"
-#include "FCTTRE.h"
-c======================================================================
-      modname = 'physiq'
-      ok_sync=.TRUE.
-      IF (nqmax .LT. 2) THEN
-         PRINT*, 'eaux vapeur et liquide sont indispensables'
-         CALL ABORT
-      ENDIF
-      IF (debut) THEN
-         CALL suphec ! initialiser constantes et parametres phys.
-      ENDIF
-c======================================================================
-      xjour = rjourvrai
-c
-c Si c'est le debut, il faut initialiser plusieurs choses
-c          ********
-c
-       IF (debut) THEN
-c
- 
-         IF (ok_oasis) THEN
-            PRINT*, "Attentions! les parametres suivants sont fixes:"
-            PRINT *,'***********************************************'
-            PRINT*, "npas, nexca, itimestep=", npas, nexca, itimestep
-            PRINT*, "Changer-les manuellement s il le faut"
-            PRINT *,'***********************************************'
-            CALL inicma( npas, nexca, itimestep)
-         ENDIF
-c
-         IF (ok_ocean) THEN
-            PRINT*, '************************'
-            PRINT*, 'SLAB OCEAN est active, prenez precautions !'
-            PRINT*, '************************'
-         ENDIF
-c
-         DO k = 2, nvm          ! pas de vegetation
-            DO i = 1, klon
-               veget(i,k) = 0.0
-            ENDDO
-         ENDDO
-         DO i = 1, klon
-            veget(i,1) = 1.0    ! il n'y a que du desert
-         ENDDO
-         PRINT*, 'Pas de vegetation; desert partout'
-c
-c Initialiser les compteurs:
-c
-
-         itap    = 0
-         itaprad = 0
-c
-         CALL phyetat0 ("startphy.nc",dtime,co2_ppm,solaire,
-     .         rlat,rlon,ftsol,ftsoil,deltat,fqsol,fsnow,
-     .        radsol,rugmer,agesno,clesphy0,
-     .       zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,tabcntr0,
-     .       t_ancien, q_ancien, ancien_ok )
-
-c
-         radpas = NINT( 86400./dtime/nbapp_rad)
-
-c
-         CALL printflag( tabcntr0,radpas,ok_ocean,ok_oasis ,ok_journe,
-     ,                    ok_instan, ok_region )
-c
-         IF (ABS(dtime-pdtphys).GT.0.001) THEN
-            PRINT*, 'Pas physique n est pas correcte',dtime,pdtphys
-            abort_message=' See above '
-            call abort_gcm(modname,abort_message,1)
-         ENDIF
-         IF (nlon .NE. klon) THEN
-            PRINT*, 'nlon et klon ne sont pas coherents', nlon, klon
-            abort_message=' See above '
-            call abort_gcm(modname,abort_message,1)
-         ENDIF
-         IF (nlev .NE. klev) THEN
-            PRINT*, 'nlev et klev ne sont pas coherents', nlev, klev
-            abort_message=' See above '
-            call abort_gcm(modname,abort_message,1)
-         ENDIF
-c
-         IF (dtime*FLOAT(radpas).GT.21600..AND.cycle_diurne) THEN 
-           PRINT*, 'Nbre d appels au rayonnement insuffisant'
-           PRINT*, "Au minimum 4 appels par jour si cycle diurne"
-           abort_message=' See above '
-           call abort_gcm(modname,abort_message,1)
-         ENDIF
-         PRINT*, "Clef pour la convection, iflag_con=", iflag_con
-c
-cKE43
-c Initialisation pour la convection de K.E. (sb):
-         IF (iflag_con.GE.3) THEN
-
-         PRINT*, "*** Convection de Kerry Emanuel 4.3  "
-         PRINT*, "On va utiliser le melange convectif des traceurs qui"
-         PRINT*, "est calcule dans convect4.3"
-         PRINT*, " !!! penser aux logical flags de phytrac"
-
-          DO i = 1, klon
-           ema_cbmf(i) = 0.
-           ema_pcb(i)  = 0.
-           ema_pct(i)  = 0.
-           ema_workcbmf(i) = 0.
-          ENDDO
-         ENDIF
-c34EK
-         IF (ok_orodr) THEN
-         DO i=1,klon
-         rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
-         ENDDO
-         CALL SUGWD(klon,klev,paprs,pplay)
-         DO i=1,klon
-         zuthe(i)=0.
-         zvthe(i)=0.
-         if(zstd(i).gt.10.)then
-           zuthe(i)=(1.-zgam(i))*cos(zthe(i))
-           zvthe(i)=(1.-zgam(i))*sin(zthe(i))
-         endif
-         ENDDO
-         ENDIF
-c
-         IF (soil_model) THEN
-            DO nsrf = 1, nbsrf
-            CALL soil(dtime, nsrf, fsnow(1,nsrf),
-     .                ftsol(1,nsrf), ftsoil(1,1,nsrf),
-     .                soilcap(1,nsrf), soilflux(1,nsrf))
-            ENDDO
-         ENDIF
-c
-         lmt_pas = NINT(86400./dtime * 1.0)   ! tous les jours
-         PRINT*,'La frequence de lecture surface est de ', lmt_pas
-c
-         ecrit_mth = NINT(86400./dtime *ecritphy)  ! tous les ecritphy jours
-         IF (ok_mensuel) THEN
-         PRINT*, 'La frequence de sortie mensuelle est de ', ecrit_mth
-         ENDIF
-         ecrit_day = NINT(86400./dtime *1.0)  ! tous les jours
-         IF (ok_journe) THEN
-         PRINT*, 'La frequence de sortie journaliere est de ',ecrit_day
-         ENDIF
-ccc         ecrit_ins = NINT(86400./dtime *0.5)  ! 2 fois par jour
-         ecrit_ins = NINT(86400./dtime *0.25)  ! tous les jours
-         IF (ok_instan) THEN
-         PRINT*, 'La frequence de sortie instant. est de ', ecrit_ins
-         ENDIF
-         ecrit_reg = NINT(86400./dtime *0.25)  ! 4 fois par jour
-         IF (ok_region) THEN
-         PRINT*, 'La frequence de sortie region est de ', ecrit_reg
-         ENDIF
-c
-c
-      IF (ok_journe) THEN
-c
-         idayref = day_ini
-         CALL ymds2ju(anne_ini, 1, idayref, 0.0, zjulian)
-c
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
-         DO i = 1, iim
-            zx_lon(i,1) = rlon(i+1)
-            zx_lon(i,jjmp1) = rlon(i+1)
-         ENDDO
-         DO ll=1,klev
-            znivsig(ll)=float(ll)
-         ENDDO
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
-         CALL histbeg("histday", iim,zx_lon, jjmp1,zx_lat,
-     .                 1,iim,1,jjmp1, 0, zjulian, dtime, 
-     .                 nhori, nid_day)
-         CALL histvert(nid_day, "presnivs", "Vertical levels", "mb",
-     .                 klev, presnivs, nvert)
-c        call histvert(nid_day, 'sig_s', 'Niveaux sigma','-',
-c    .              klev, znivsig, nvert)
-c
-         zsto = dtime
-         zout = dtime * FLOAT(ecrit_day)
-c
-         CALL histdef(nid_day, "phis", "Surface geop. height", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "once", zsto,zout)
-c
-         CALL histdef(nid_day, "aire", "Grid area", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "once", zsto,zout)
-c
-c Champs 2D:
-c
-         CALL histdef(nid_day, "tsol", "Surface Temperature", "K",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "psol", "Surface Pressure", "Pa",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "rain", "Precipitation", "mm/day",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "snow", "Snow fall", "mm/day",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "evap", "Evaporation", "mm/day",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "tops", "Solar rad. at TOA", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "topl", "IR rad. at TOA", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "sols", "Solar rad. at surf.", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "soll", "IR rad. at surface", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "bils", "Surf. total heat flux", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "sens", "Sensible heat flux", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "fder", "Heat flux derivation", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "frtu", "Zonal wind stress", "Pa",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "frtv", "Meridional wind stress", "Pa",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "ruis", "Runoff", "mm/day",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "sicf", "Sea-ice fraction", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "cldl", "Low-level cloudiness", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "cldm", "Mid-level cloudiness", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "cldh", "High-level cloudiness", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "cldt", "Total cloudiness", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "cldq", "Cloud liquid water path", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-c Champs 3D:
-c
-         CALL histdef(nid_day, "temp", "Air temperature", "K",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "ovap", "Specific humidity", "Kg/Kg",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "geop", "Geopotential height", "m",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "vitu", "Zonal wind", "m/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "vitv", "Meridional wind", "m/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "vitw", "Vertical wind", "m/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "pres", "Air pressure", "Pa",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histend(nid_day)
-c
-         ndex2d = 0
-         ndex3d = 0
-c
-      ENDIF ! fin de test sur ok_journe
-c
-      IF (ok_mensuel) THEN
-c
-         idayref = day_ini
-         CALL ymds2ju(anne_ini, 1, idayref, 0.0, zjulian)
-c
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
-         DO i = 1, iim
-            zx_lon(i,1) = rlon(i+1)
-            zx_lon(i,jjmp1) = rlon(i+1)
-         ENDDO
-         DO ll=1,klev
-            znivsig(ll)=float(ll)
-         ENDDO
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
-         CALL histbeg("histmth", iim,zx_lon, jjmp1,zx_lat,
-     .                 1,iim,1,jjmp1, 0, zjulian, dtime, 
-     .                 nhori, nid_mth)
-         CALL histvert(nid_mth, "presnivs", "Vertical levels", "mb",
-     .                 klev, presnivs, nvert)
-c        call histvert(nid_mth, 'sig_s', 'Niveaux sigma','-',
-c    .              klev, znivsig, nvert)
-c
-         zsto = dtime
-         zout = dtime * FLOAT(ecrit_mth)
-c
-         CALL histdef(nid_mth, "phis", "Surface geop. height", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "once",  zsto,zout)
-c
-         CALL histdef(nid_mth, "aire", "Grid area", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "once",  zsto,zout)
-c
-c Champs 2D:
-c
-         CALL histdef(nid_mth, "tsol", "Surface Temperature", "K",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "psol", "Surface Pressure", "Pa",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "qsol", "Surface humidity", "mm",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "rain", "Precipitation", "mm/day",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "plul", "Large-scale Precip.", "mm/day",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "pluc", "Convective Precip.", "mm/day",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "snow", "Snow fall", "mm/day",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "ages", "Snow age", "day",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "evap", "Evaporation", "mm/day",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "tops", "Solar rad. at TOA", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "topl", "IR rad. at TOA", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "sols", "Solar rad. at surf.", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "soll", "IR rad. at surface", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "tops0", "Solar rad. at TOA", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "topl0", "IR rad. at TOA", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "sols0", "Solar rad. at surf.", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "soll0", "IR rad. at surface", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "bils", "Surf. total heat flux", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "sens", "Sensible heat flux", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "fder", "Heat flux derivation", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "frtu", "Zonal wind stress", "Pa",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "frtv", "Meridional wind stress", "Pa",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "ruis", "Runoff", "mm/day",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "sicf", "Sea-ice fraction", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "albs", "Surface albedo", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "cdrm", "Momentum drag coef.", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "cdrh", "Heat drag coef.", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "cldl", "Low-level cloudiness", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "cldm", "Mid-level cloudiness", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "cldh", "High-level cloudiness", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "cldt", "Total cloudiness", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "cldq", "Cloud liquid water path", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "ue", "Zonal energy transport", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "ve", "Merid energy transport", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "uq", "Zonal humidity transport", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "vq", "Merid humidity transport", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-cKE43
-      IF (iflag_con .GE. 3) THEN ! sb
-c
-         CALL histdef(nid_mth, "cape", "Conv avlbl pot ener", "J/Kg",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "pbase", "Cld base pressure", "hPa",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "ptop", "Cld top pressure", "hPa",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "fbase", "Cld base mass flux", "Kg/m2/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto,zout)
-c
-c
-      ENDIF
-c34EK
-c
-c Champs 3D:
-c
-         CALL histdef(nid_mth, "temp", "Air temperature", "K",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "ovap", "Specific humidity", "Kg/Kg",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "geop", "Geopotential height", "m",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "vitu", "Zonal wind", "m/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "vitv", "Meridional wind", "m/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "vitw", "Vertical wind", "m/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "pres", "Air pressure", "Pa",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "rneb", "Cloud fraction", "-",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "rhum", "Relative humidity", "-",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "oliq", "Liquid water content", "kg/kg",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dtdyn", "Dynamics dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dqdyn", "Dynamics dQ", "Kg/Kg/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dtcon", "Convection dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dqcon", "Convection dQ", "Kg/Kg/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dtlsc", "Condensation dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dqlsc", "Condensation dQ", "Kg/Kg/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dtvdf", "Boundary-layer dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dqvdf", "Boundary-layer dQ", "Kg/Kg/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dteva", "Reevaporation dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dqeva", "Reevaporation dQ", "Kg/Kg/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-
-         CALL histdef(nid_mth, "ptconv", "POINTS CONVECTIFS"," ",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-
-         CALL histdef(nid_mth, "ratqs", "RATQS"," ",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-
-c
-         CALL histdef(nid_mth, "dtajs", "Dry adjust. dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-
-         CALL histdef(nid_mth, "dqajs", "Dry adjust. dQ", "Kg/Kg/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dtswr", "SW radiation dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dtsw0", "SW radiation dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dtlwr", "LW radiation dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dtlw0", "LW radiation dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "duvdf", "Boundary-layer dU", "m/s2",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dvvdf", "Boundary-layer dV", "m/s2",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         IF (ok_orodr) THEN
-         CALL histdef(nid_mth, "duoro", "Orography dU", "m/s2",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dvoro", "Orography dV", "m/s2",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         ENDIF
-C
-         IF (ok_orolf) THEN
-         CALL histdef(nid_mth, "dulif", "Orography dU", "m/s2",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dvlif", "Orography dV", "m/s2",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-         ENDIF
-C
-         CALL histdef(nid_mth, "ozone", "Ozone concentration", "-",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         if (nqmax.GE.3) THEN
-         DO iq=1,nqmax-2
-         IF (iq.LE.99) THEN
-         WRITE(str2,'(i2.2)') iq
-         CALL histdef(nid_mth, "trac"//str2, "Tracer No."//str2, "-",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-         ELSE
-         PRINT*, "Trop de traceurs"
-         CALL abort
-         ENDIF
-         ENDDO
-         ENDIF
-c
-cKE43
-      IF (iflag_con.GE.3) THEN ! (sb)
-c
-         CALL histdef(nid_mth, "upwd", "saturated updraft", "Kg/m2/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dnwd", "saturated downdraft","Kg/m2/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dnwd0", "unsat. downdraft", "Kg/m2/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth,"Ma","undilute adiab updraft","Kg/m2/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-c
-      ENDIF
-c34EK
-         CALL histend(nid_mth)
-c
-         ndex2d = 0
-         ndex3d = 0
-c
-      ENDIF ! fin de test sur ok_mensuel
-c
-c
-      IF (ok_instan) THEN
-c
-         idayref = day_ini
-         CALL ymds2ju(anne_ini, 1, idayref, 0.0, zjulian)
-c
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
-         DO i = 1, iim
-            zx_lon(i,1) = rlon(i+1)
-            zx_lon(i,jjmp1) = rlon(i+1)
-         ENDDO
-         DO ll=1,klev
-            znivsig(ll)=float(ll)
-         ENDDO
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
-         CALL histbeg("histins", iim,zx_lon, jjmp1,zx_lat,
-     .                 1,iim,1,jjmp1, 0, zjulian, dtime,
-     .                 nhori, nid_ins)
-         CALL histvert(nid_ins, "presnivs", "Vertical levels", "mb",
-     .                 klev, presnivs, nvert)
-c        call histvert(nid_ins, 'sig_s', 'Niveaux sigma','-',
-c    .              klev, znivsig, nvert)
-c
-         zsto = dtime * ecrit_ins
-         zout = dtime * ecrit_ins
-C
-         CALL histdef(nid_ins, "phis", "Surface geop. height", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "once", zsto,zout)
-c
-         CALL histdef(nid_ins, "aire", "Grid area", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "once", zsto,zout)
-c
-c Champs 2D:
-c
-         CALL histdef(nid_ins, "psol", "Surface Pressure", "Pa",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "topl", "OLR", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "inst(X)", zsto,zout)
-c
-c Champs 3D:
-c
-         CALL histdef(nid_ins, "temp", "Temperature", "K",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "vitu", "Zonal wind", "m/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "vitv", "Merid wind", "m/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "geop", "Geopotential height", "m",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "inst(X)", zsto,zout)
-c
-         CALL histdef(nid_ins, "pres", "Air pressure", "Pa",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "inst(X)", zsto,zout)
-c
-         CALL histend(nid_ins)
-c
-         ndex2d = 0
-         ndex3d = 0
-c
-      ENDIF
-c
-c
-c
-c Prescrire l'ozone dans l'atmosphere
-c
-c
-cc         DO i = 1, klon
-cc         DO k = 1, klev
-cc            CALL o3cm (paprs(i,k)/100.,paprs(i,k+1)/100., wo(i,k),20)
-cc         ENDDO
-cc         ENDDO
-c
-         IF (ok_oasis) THEN
-         DO i = 1, klon
-           oas_sols(i) = 0.0
-           oas_nsol(i) = 0.0
-           oas_rain(i) = 0.0
-           oas_snow(i) = 0.0
-           oas_evap(i) = 0.0
-           oas_ruis(i) = 0.0
-           oas_tsol(i) = 0.0
-           oas_fder(i) = 0.0
-           oas_albe(i) = 0.0
-           oas_taux(i) = 0.0
-           oas_tauy(i) = 0.0
-         ENDDO
-         ENDIF
-c
-
-#ifdef INCA
-           calday = FLOAT(MOD(NINT(xjour),360)) + gmtime
-           print *, 'initial time ', xjour, calday
-#ifdef INCAINFO
-           PRINT *, 'Appel CHEMINI ...'
-#endif
-           CALL chemini( rpi,
-     $                   rg,
-     $                   ra,
-     $                   paire,
-     $                   rlat,
-     $                   rlon,
-     $                   calday,
-     $                   tracnam,
-     $                   natsnam,
-     $                   mxoutflds,
-     $                   outinst,
-     $                   outtimav,
-     $                   klon,
-     $                   nqmax)
-#ifdef INCAINFO
-           PRINT *, 'OK.'
-#endif
-#endif
-
-      ENDIF
-c
-c   ****************     Fin  de   IF ( debut  )   ***************
-c
-c
-c Mettre a zero des variables de sortie (pour securite)
-c
-      DO i = 1, klon
-         d_ps(i) = 0.0
-      ENDDO
-      DO k = 1, klev
-      DO i = 1, klon
-         d_t(i,k) = 0.0
-         d_u(i,k) = 0.0
-         d_v(i,k) = 0.0
-      ENDDO
-      ENDDO
-      DO iq = 1, nqmax
-      DO k = 1, klev
-      DO i = 1, klon
-         d_qx(i,k,iq) = 0.0
-      ENDDO
-      ENDDO
-      ENDDO
-c
-c Ne pas affecter les valeurs entrees de u, v, h, et q
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         t_seri(i,k)  = t(i,k)
-         u_seri(i,k)  = u(i,k)
-         v_seri(i,k)  = v(i,k)
-         q_seri(i,k)  = qx(i,k,ivap)
-         ql_seri(i,k) = qx(i,k,iliq)
-      ENDDO
-      ENDDO
-      IF (nqmax.GE.3) THEN
-      DO iq = 3, nqmax
-      DO  k = 1, klev
-      DO  i = 1, klon
-         tr_seri(i,k,iq-2) = qx(i,k,iq)
-      ENDDO
-      ENDDO
-      ENDDO
-      ELSE
-      DO k = 1, klev
-      DO i = 1, klon
-         tr_seri(i,k,1) = 0.0
-      ENDDO
-      ENDDO
-      ENDIF
-c
-c Diagnostiquer la tendance dynamique
-c
-      IF (ancien_ok) THEN
-         DO k = 1, klev
-         DO i = 1, klon
-            d_t_dyn(i,k) = (t_seri(i,k)-t_ancien(i,k))/dtime
-            d_q_dyn(i,k) = (q_seri(i,k)-q_ancien(i,k))/dtime
-         ENDDO
-         ENDDO
-      ELSE
-         DO k = 1, klev
-         DO i = 1, klon
-            d_t_dyn(i,k) = 0.0
-            d_q_dyn(i,k) = 0.0
-         ENDDO
-         ENDDO
-         ancien_ok = .TRUE.
-      ENDIF
-c
-c Ajouter le geopotentiel du sol:
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         zphi(i,k) = pphi(i,k) + pphis(i)
-      ENDDO
-      ENDDO
-c
-c Verifier les temperatures
-c
-
-      CALL hgardfou(t_seri,ftsol,'debutphy')
-c
-c Incrementer le compteur de la physique
-c
-      itap   = itap + 1
-      julien = MOD(NINT(xjour),360)
-c
-c Mettre en action les conditions aux limites (albedo, sst, etc.).
-c Prescrire l'ozone et calculer l'albedo sur l'ocean.
-c
-      IF (MOD(itap-1,lmt_pas) .EQ. 0) THEN
-         idayvrai = NINT(xjour)
-         PRINT *,' PHYS cond  julien ',julien,idayvrai,ok_limitvrai
-         CALL condsurf(julien,idayvrai, pctsrf ,
-     .                  lmt_sst,lmt_alb,lmt_rug,lmt_bils  )
-         CALL ozonecm( FLOAT(julien), rlat, paprs, wo)
-      ENDIF
-cccccccccc
-      IF (ok_oasis .AND. MOD(itap-1,nexca).EQ.0) THEN
-C
-         CALL fromcpl(itap,jjmp1*iim,
-     .        cpl_sst,cpl_sic,cpl_alb_sst,cpl_alb_sic)
-         DO i = 1, iim-1 ! un seul point pour le pole nord
-            cpl_sst(i,1) = cpl_sst(iim,1)
-            cpl_sic(i,1) = cpl_sic(iim,1)
-            cpl_alb_sst(i,1) = cpl_alb_sst(iim,1)
-            cpl_alb_sic(i,1) = cpl_alb_sic(iim,1)
-         ENDDO
-         DO i = 2, iim ! un seul point pour le pole sud
-            cpl_sst(i,jjmp1) = cpl_sst(1,jjmp1)
-            cpl_sic(i,jjmp1) = cpl_sic(1,jjmp1)
-            cpl_alb_sst(i,jjmp1) = cpl_alb_sst(1,jjmp1)
-            cpl_alb_sic(i,jjmp1) = cpl_alb_sic(1,jjmp1)
-         ENDDO
-c
-         ig = 1
-         IF (pctsrf(ig,is_oce).GT.epsfra .OR.
-     .       pctsrf(ig,is_sic).GT.epsfra) THEN
-            pctsrf(ig,is_oce) = pctsrf(ig,is_oce)
-     .                        - (cpl_sic(1,1)-pctsrf(ig,is_sic))
-            pctsrf(ig,is_sic) = cpl_sic(1,1)
-            lmt_sst(ig) = cpl_sst(1,1)
-         ENDIF
-         DO j = 2, jjm
-         DO i = 1, iim
-         ig = ig + 1
-         IF (pctsrf(ig,is_oce).GT.epsfra .OR.
-     .       pctsrf(ig,is_sic).GT.epsfra) THEN
-           pctsrf(ig,is_oce) = pctsrf(ig,is_oce)
-     .                       - (cpl_sic(i,j)-pctsrf(ig,is_sic))
-           pctsrf(ig,is_sic) = cpl_sic(i,j)
-           lmt_sst(ig) = cpl_sst(i,j)
-         ENDIF
-         ENDDO
-         ENDDO
-         ig = ig + 1
-         IF (pctsrf(ig,is_oce).GT.epsfra .OR.
-     .       pctsrf(ig,is_sic).GT.epsfra) THEN
-            pctsrf(ig,is_oce) = pctsrf(ig,is_oce)
-     .                        - (cpl_sic(1,jjmp1)-pctsrf(ig,is_sic))
-            pctsrf(ig,is_sic) = cpl_sic(1,jjmp1)
-            lmt_sst(ig) = cpl_sst(1,jjmp1)
-         ENDIF
-c
-      ENDIF ! ok_oasis
-cccccccccc
-c
- 
-      IF (ok_ocean) THEN
-         DO i = 1, klon
-            ftsol(i,is_oce) = lmt_sst(i) + deltat(i)
-         ENDDO
-
-      ELSE
-         DO i = 1, klon
-            ftsol(i,is_oce) = lmt_sst(i)
-         ENDDO
-
-      ENDIF
-c
-c Re-evaporer l'eau liquide nuageuse
-c
-      DO k = 1, klev  ! re-evaporation de l'eau liquide nuageuse
-      DO i = 1, klon
-         zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
-         zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
-         zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
-         zb = MAX(0.0,ql_seri(i,k))
-         za = - MAX(0.0,ql_seri(i,k))
-     .                  * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
-         t_seri(i,k) = t_seri(i,k) + za
-         q_seri(i,k) = q_seri(i,k) + zb
-         ql_seri(i,k) = 0.0
-         d_t_eva(i,k) = za
-         d_q_eva(i,k) = zb
-      ENDDO
-      ENDDO
-c
-c Appeler la diffusion verticale (programme de couche limite)
-c
-      DO i = 1, klon
-         frugs(i,is_ter) = SQRT(lmt_rug(i)**2+rugoro(i)**2)
-         frugs(i,is_lic) = rugoro(i)
-         frugs(i,is_oce) = rugmer(i)
-         frugs(i,is_sic) = 0.001
-         zxrugs(i) = 0.0
-      ENDDO
-      DO nsrf = 1, nbsrf
-      DO i = 1, klon
-         frugs(i,nsrf) = MAX(frugs(i,nsrf),0.001)
-      ENDDO
-      ENDDO
-      DO nsrf = 1, nbsrf
-      DO i = 1, klon
-         zxrugs(i) = zxrugs(i) + frugs(i,nsrf)*pctsrf(i,nsrf)
-      ENDDO
-      ENDDO
-c
-      CALL clmain(dtime,pctsrf,
-     e            t_seri,q_seri,u_seri,v_seri,soil_model,
-     e            ftsol,soilcap,soilflux,paprs,pplay,radsol,
-     e            fsnow,fqsol,
-     e            rlat, frugs,
-     s            d_t_vdf,d_q_vdf,d_u_vdf,d_v_vdf,d_ts,
-     s            fluxt,fluxq,fluxu,fluxv,cdragh,cdragm,rugmer,
-     s            dsens, devap,
-     s            ycoefh,yu1,yv1) 
-c
-      DO i = 1, klon
-         sens(i) = - fluxt(i,1) ! flux de chaleur sensible au sol
-         evap(i) = - fluxq(i,1) ! flux d'evaporation au sol
-         fder(i) = dsens(i) + devap(i)
-      ENDDO
-      DO k = 1, klev
-      DO i = 1, klon
-         t_seri(i,k) = t_seri(i,k) + d_t_vdf(i,k)
-         q_seri(i,k) = q_seri(i,k) + d_q_vdf(i,k)
-         u_seri(i,k) = u_seri(i,k) + d_u_vdf(i,k)
-         v_seri(i,k) = v_seri(i,k) + d_v_vdf(i,k)
-      ENDDO
-      ENDDO
-c
-c Incrementer la temperature du sol
-c
-      DO i = 1, klon
-         zxtsol(i) = 0.0
-         IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) + 
-     $       pctsrf(i, is_oce) + pctsrf(i, is_sic)  - 1.) .GT. EPSFRA) 
-     $       THEN 
-             WRITE(*,*) 'physiq : pb sous surface au point ', i, 
-     $           pctsrf(i, 1 : nbsrf)
-         ENDIF 
-      ENDDO
-      DO nsrf = 1, nbsrf
-      DO i = 1, klon
-         ftsol(i,nsrf) = ftsol(i,nsrf) + d_ts(i,nsrf)
-         zxtsol(i) = zxtsol(i) + ftsol(i,nsrf)*pctsrf(i,nsrf)
-      ENDDO
-      ENDDO
-
-c
-c Si une sous-fraction n'existe pas, elle prend la temp. moyenne
-c
-      DO nsrf = 1, nbsrf
-        DO i = 1, klon
-          IF (pctsrf(i,nsrf) .LT. epsfra) ftsol(i,nsrf) = zxtsol(i)
-        ENDDO
-      ENDDO
-
-c
-c Appeler le modele du sol
-c
-      IF (soil_model) THEN
-         DO nsrf = 1, nbsrf
-         CALL soil(dtime, nsrf, fsnow(1,nsrf),
-     .             ftsol(1,nsrf), ftsoil(1,1,nsrf),
-     .             soilcap(1,nsrf), soilflux(1,nsrf))
-         ENDDO
-      ENDIF
-c
-c Calculer la derive du flux infrarouge
-c
-      DO nsrf = 1, nbsrf
-      DO i = 1, klon
-         fder(i) = fder(i) - 4.0*RSIGMA*zxtsol(i)**3 *
-     .                       (ftsol(i,nsrf)-zxtsol(i))
-     .                      *pctsrf(i,nsrf)
-      ENDDO
-      ENDDO
-c
-c Appeler la convection (au choix)
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         conv_q(i,k) = d_q_dyn(i,k) 
-     .               + d_q_vdf(i,k)/dtime
-         conv_t(i,k) = d_t_dyn(i,k) 
-     .               + d_t_vdf(i,k)/dtime
-      ENDDO
-      ENDDO
-      IF (check) THEN
-         za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
-         PRINT*, "avantcon=", za
-      ENDIF
-      zx_ajustq = .FALSE.
-      IF (iflag_con.EQ.2) zx_ajustq=.TRUE.
-      IF (zx_ajustq) THEN
-         DO i = 1, klon
-            z_avant(i) = 0.0
-         ENDDO
-         DO k = 1, klev
-         DO i = 1, klon
-            z_avant(i) = z_avant(i) + (q_seri(i,k)+ql_seri(i,k))
-     .                        *(paprs(i,k)-paprs(i,k+1))/RG
-         ENDDO
-         ENDDO
-      ENDIF
-      IF (iflag_con.EQ.1) THEN
-          stop'reactiver le call conlmd dans physiq.F'
-c     CALL conlmd (dtime, paprs, pplay, t_seri, q_seri, conv_q,
-c    .             d_t_con, d_q_con,
-c    .             rain_con, snow_con, ibas_con, itop_con)
-      ELSE IF (iflag_con.EQ.2) THEN
-      CALL conflx(dtime, paprs, pplay, t_seri, q_seri,
-     e            conv_t, conv_q, fluxq(1,1), omega,
-     s            d_t_con, d_q_con, rain_con, snow_con,
-     s            pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
-     s            kcbot, kctop, kdtop, pmflxr, pmflxs)
-      DO i = 1, klon
-         ibas_con(i) = klev+1 - kcbot(i)
-         itop_con(i) = klev+1 - kctop(i)
-      ENDDO
-      ELSE IF (iflag_con.GE.3) THEN
-c nb of tracers for the KE convection:
-          if (nqmax .GE. 4) then
-              ntra = nbtr
-          else
-              ntra = 1 
-          endif
-          if (iflag_con.eq.4) then ! vectorise
-          CALL conemav (dtime,paprs,pplay,t_seri,q_seri,
-     .        u_seri,v_seri,tr_seri,nbtr,
-     .        ema_work1,ema_work2,
-     .        d_t_con,d_q_con,d_u_con,d_v_con,d_tr,
-     .        rain_con, snow_con, ibas_con, itop_con,
-     .        upwd,dnwd,dnwd0,
-c    .        Ma,cape,tvp,(/(nint(rflag(i)),i=1,size(rflag))/),
-     .        Ma,cape,tvp,iflagctrl,
-     .        pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr)
-
-          else
-
-          CALL conema (dtime,paprs,pplay,t_seri,q_seri,
-     .        u_seri,v_seri,tr_seri,nbtr,
-     .        ema_work1,ema_work2,
-     .        d_t_con,d_q_con,d_u_con,d_v_con,d_tr,
-     .        rain_con, snow_con, ibas_con, itop_con,
-     .        upwd,dnwd,dnwd0,bas,top,
-     .        Ma,cape,tvp,rflag,
-     .       pbase
-     .        ,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr)
-          endif
-
-
-          DO i = 1, klon
-            ema_pcb(i)  = pbase(i)
-          ENDDO
-          DO i = 1, klon
-            ema_pct(i)  = paprs(i,itop_con(i))
-          ENDDO
-          DO i = 1, klon
-            ema_cbmf(i) = ema_workcbmf(i)
-          ENDDO      
-      ELSE
-          PRINT*, "iflag_con non-prevu", iflag_con
-          CALL abort
-      ENDIF
-      CALL homogene(paprs, q_seri, d_q_con, u_seri,v_seri,
-     .              d_u_con, d_v_con)
-      DO k = 1, klev
-        DO i = 1, klon
-          t_seri(i,k) = t_seri(i,k) + d_t_con(i,k)
-          q_seri(i,k) = q_seri(i,k) + d_q_con(i,k)
-          u_seri(i,k) = u_seri(i,k) + d_u_con(i,k)
-          v_seri(i,k) = v_seri(i,k) + d_v_con(i,k)
-        ENDDO
-      ENDDO
-      IF (check) THEN
-          za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
-          PRINT*, "aprescon=", za
-          zx_t = 0.0
-          za = 0.0
-          DO i = 1, klon
-            za = za + paire(i)/FLOAT(klon)
-            zx_t = zx_t + (rain_con(i)+snow_con(i))*paire(i)/FLOAT(klon)
-          ENDDO
-          zx_t = zx_t/za*dtime
-          PRINT*, "Precip=", zx_t
-      ENDIF
-      IF (zx_ajustq) THEN
-          DO i = 1, klon
-            z_apres(i) = 0.0
-          ENDDO
-          DO k = 1, klev
-            DO i = 1, klon
-              z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k))
-     .            *(paprs(i,k)-paprs(i,k+1))/RG
-            ENDDO
-          ENDDO
-          DO i = 1, klon
-            z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime)
-     .          /z_apres(i)
-          ENDDO
-          DO k = 1, klev
-            DO i = 1, klon
-              IF (z_factor(i).GT.(1.0+1.0E-08) .OR.
-     .            z_factor(i).LT.(1.0-1.0E-08)) THEN
-                  q_seri(i,k) = q_seri(i,k) * z_factor(i)
-              ENDIF
-            ENDDO
-          ENDDO
-      ENDIF
-      zx_ajustq=.FALSE.
-c
-      IF (nqmax.GT.2) THEN !--melange convectif de traceurs
-c
-          IF (iflag_con .NE. 2 .AND.  iflag_con .LT. 3 ) THEN 
-              PRINT*, 'Pour l instant, seul conflx fonctionne ',
-     $            'avec traceurs', iflag_con
-              PRINT*,' Mettre iflag_con', 
-     $            ' = 2  ou 4 dans run.def et repasser'
-              CALL abort
-              ENDIF 
-c
-      ENDIF !--nqmax.GT.2
-c
-c Appeler l'ajustement sec
-c
-      CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)
-      DO k = 1, klev
-      DO i = 1, klon
-         t_seri(i,k) = t_seri(i,k) + d_t_ajs(i,k)
-         q_seri(i,k) = q_seri(i,k) + d_q_ajs(i,k)
-      ENDDO
-      ENDDO
-
-c   RATQS
-      if (iflag_con.eq.2) then
-          flag_ratqs=0
-      else
-          flag_ratqs=1
-      endif
-      call calcratqs (flag_ratqs ,
-     I            paprs,pplay,q_seri,d_t_con,d_t_ajs
-     O           ,ratqs,zpt_conv)
-c
-c Appeler le processus de condensation a grande echelle
-c et le processus de precipitation
-c
-      CALL fisrtilp_tr(dtime,paprs,pplay,
-     .           t_seri, q_seri,ratqs,
-     .           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq,
-     .           rain_lsc, snow_lsc,
-     .           pfrac_impa, pfrac_nucl, pfrac_1nucl,
-     .           frac_impa, frac_nucl,
-     .           prfl, psfl, rhcl)
-      DO k = 1, klev
-      DO i = 1, klon
-         t_seri(i,k) = t_seri(i,k) + d_t_lsc(i,k)
-         q_seri(i,k) = q_seri(i,k) + d_q_lsc(i,k)
-         ql_seri(i,k) = ql_seri(i,k) + d_ql_lsc(i,k)
-         cldfra(i,k) = rneb(i,k)
-         IF (.NOT.new_oliq) cldliq(i,k) = ql_seri(i,k)
-      ENDDO
-      ENDDO
-      IF (check) THEN
-         za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
-         PRINT*, "apresilp=", za
-         zx_t = 0.0
-         za = 0.0
-         DO i = 1, klon
-            za = za + paire(i)/FLOAT(klon)
-            zx_t = zx_t + (rain_lsc(i)+snow_lsc(i))*paire(i)/FLOAT(klon)
-        ENDDO
-         zx_t = zx_t/za*dtime
-         PRINT*, "Precip=", zx_t
-      ENDIF
-c
-c Nuages diagnostiques:
-c
-      IF (iflag_con.EQ.2) THEN ! seulement pour Tiedtke
-      CALL diagcld1(paprs,pplay,
-     .             rain_con,snow_con,ibas_con,itop_con,
-     .             diafra,dialiq)
-      DO k = 1, klev
-      DO i = 1, klon
-      IF (diafra(i,k).GT.cldfra(i,k)) THEN
-         cldliq(i,k) = dialiq(i,k)
-         cldfra(i,k) = diafra(i,k)
-      ENDIF
-      ENDDO
-      ENDDO
-      ENDIF
-c
-c Nuages stratus artificiels:
-c
-      IF (ok_stratus) THEN
-      CALL diagcld2(paprs,pplay,t_seri,q_seri, diafra,dialiq)
-      DO k = 1, klev
-      DO i = 1, klon
-      IF (diafra(i,k).GT.cldfra(i,k)) THEN
-         cldliq(i,k) = dialiq(i,k)
-         cldfra(i,k) = diafra(i,k)
-      ENDIF
-      ENDDO
-      ENDDO
-      ENDIF
-c
-c Precipitation totale
-c
-      DO i = 1, klon
-         rain_fall(i) = rain_con(i) + rain_lsc(i)
-         snow_fall(i) = snow_con(i) + snow_lsc(i)
-      ENDDO
-c
-c Calculer l'humidite relative pour diagnostique
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         zx_t = t_seri(i,k)
-         IF (thermcep) THEN
-            zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
-            zx_qs  = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
-            zx_qs  = MIN(0.5,zx_qs)
-            zcor   = 1./(1.-retv*zx_qs)
-            zx_qs  = zx_qs*zcor
-         ELSE
-           IF (zx_t.LT.t_coup) THEN
-              zx_qs = qsats(zx_t)/pplay(i,k)
-           ELSE
-              zx_qs = qsatl(zx_t)/pplay(i,k)
-           ENDIF
-         ENDIF
-         zx_rh(i,k) = q_seri(i,k)/zx_qs
-      ENDDO
-      ENDDO
-
-#ifdef INCA
-           calday = FLOAT(julien) + gmtime
-
-#ifdef INCA_AER
-      call AEROSOL_METEO_CALC(calday,pdtphys,pplay,paprs,t,pmflxr,pmflxs,
-     &   prfl,psfl,pctsrf,paire)
-#endif
-
-#ifdef INCAINFO
-           PRINT *, 'Appel CHEMHOOK_BEGIN ...'
-#endif
-           CALL chemhook_begin (calday,
-     $                          pctsrf(1,3),
-     $                          rlat,
-     $                          rlon,
-     $                          paire,
-     $                          paprs,
-     $                          pplay,
-     $                          ycoefh,
-     $                          pphi,
-     $                          t_seri,
-     $                          u,
-     $                          v,
-     $                          wo,
-     $                          q_seri,
-     $                          zxtsol,
-     $                          zxsnow,
-     $                          solsw,
-     $                          albsol,
-     $                          rain_fall,
-     $                          snow_fall,
-     $                          itop_con, 
-     $                          ibas_con, 
-     $                          cldfra,
-     $                          iim, 
-     $                          jjm, 
-     $                          tr_seri)
-#ifdef INCAINFO
-           PRINT *, 'OK.'
-#endif
-#endif
-
-c
-c Calculer les parametres optiques des nuages et quelques
-c parametres pour diagnostiques:
-c
-      CALL nuage (paprs, pplay,
-     .            t_seri, cldliq, cldfra, cldtau, cldemi,
-     .            cldh, cldl, cldm, cldt, cldq)
-c
-c Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
-c
-      IF (MOD(itaprad,radpas).EQ.0) THEN
-      CALL orbite(FLOAT(julien),zlongi,dist)
-      IF (cycle_diurne) THEN
-        zdtime=dtime*FLOAT(radpas) ! pas de temps du rayonnement (s)
-        CALL zenang(zlongi,gmtime,zdtime,rlat,rlon,rmu0,fract)
-c        CALL zenith(zlongi,gmtime,rlat,rlon,rmu0,fract) !va disparaitre
-        CALL alboc_cd(rmu0,alb_eau)
-      ELSE
-        CALL angle(zlongi,rlat,fract,rmu0)
-        CALL alboc(FLOAT(julien),rlat,alb_eau)
-      ENDIF
-      CALL albsno(veget,agesno,alb_neig)
-      DO i = 1, klon
-         zx_alb_oce = alb_eau(i)
-         IF (pctsrf(i,is_oce).GT.epsfra .AND. ftsol(i,is_oce).LT.271.35)
-     .   zx_alb_oce = 0.6 ! pour slab_ocean
-         zfra = MAX(0.0,MIN(1.0,fsnow(i,is_lic)/(fsnow(i,is_lic)+10.0)))
-         zx_alb_lic = alb_neig(i)*zfra + 0.6*(1.0-zfra)
-         zfra = MAX(0.0,MIN(1.0,fsnow(i,is_ter)/(fsnow(i,is_ter)+10.0)))
-         zx_alb_ter = alb_neig(i)*zfra + lmt_alb(i)*(1.0-zfra)
-         zfra = MAX(0.0,MIN(1.0,fsnow(i,is_sic)/(fsnow(i,is_sic)+10.0)))
-         zx_alb_sic = alb_neig(i)*zfra + 0.6*(1.0-zfra)
-         albsol(i) = zx_alb_oce * pctsrf(i,is_oce)
-     .             + zx_alb_lic * pctsrf(i,is_lic)
-     .             + zx_alb_ter * pctsrf(i,is_ter)
-     .             + zx_alb_sic * pctsrf(i,is_sic)
-      ENDDO
-      CALL radlwsw ! nouveau rayonnement (compatible Arpege-IFS)
-     e            (dist, rmu0, fract, co2_ppm, solaire,
-     e             paprs, pplay,zxtsol,albsol, t_seri,q_seri,wo,
-     e             cldfra, cldemi, cldtau,
-     s             heat,heat0,cool,cool0,radsol,albpla,
-     s             topsw,toplw,solsw,sollw,
-     s             topsw0,toplw0,solsw0,sollw0)
-      itaprad = 0
-      ENDIF
-      itaprad = itaprad + 1
-c
-c Ajouter la tendance des rayonnements (tous les pas)
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         t_seri(i,k) = t_seri(i,k)
-     .               + (heat(i,k)-cool(i,k)) * dtime/86400.
-      ENDDO
-      ENDDO
-c
-c Calculer l'hydrologie de la surface
-c
-      CALL hydrol(dtime,pctsrf,rain_fall, snow_fall, evap,
-     .            agesno, ftsol,fqsol,fsnow, ruis)
-c
-      DO i = 1, klon
-         zxqsol(i) = 0.0
-         zxsnow(i) = 0.0
-      ENDDO
-      DO nsrf = 1, nbsrf
-      DO i = 1, klon
-         zxqsol(i) = zxqsol(i) + fqsol(i,nsrf)*pctsrf(i,nsrf)
-         zxsnow(i) = zxsnow(i) + fsnow(i,nsrf)*pctsrf(i,nsrf)
-      ENDDO
-      ENDDO
-c
-c Si une sous-fraction n'existe pas, elle prend la valeur moyenne
-c
-      DO nsrf = 1, nbsrf
-      DO i = 1, klon
-         IF (pctsrf(i,nsrf).LT.epsfra) THEN
-            fqsol(i,nsrf) = zxqsol(i)
-            fsnow(i,nsrf) = zxsnow(i)
-         ENDIF
-      ENDDO
-      ENDDO
-c
-c Calculer le bilan du sol et la derive de temperature (couplage)
-c
-      DO i = 1, klon
-         bils(i) = radsol(i) - sens(i) - evap(i)*RLVTT
-      ENDDO
-      IF (ok_ocean) THEN
-         DO i = 1, klon
-            cthermiq = cyang
-            IF (ftsol(i,is_oce).LT. 271.35) cthermiq = cbing
-            IF (pctsrf(i,is_oce).GT.epsfra) deltat(i) = deltat(i) +
-     .                          (bils(i)-lmt_bils(i))/cthermiq * dtime
-            IF (deltat(i).GT.15.0 ) deltat(i) = 15.0
-            IF (deltat(i).LT.-15.0) deltat(i) = -15.0
-         ENDDO
-      ENDIF
-c
-cmoddeblott(jan95)
-c Appeler le programme de parametrisation de l'orographie
-c a l'echelle sous-maille:
-c
-      IF (ok_orodr) THEN
-c
-c  selection des points pour lesquels le shema est actif:
-        igwd=0
-        DO i=1,klon
-        itest(i)=0
-c        IF ((zstd(i).gt.10.0)) THEN
-        IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
-          itest(i)=1
-          igwd=igwd+1
-          idx(igwd)=i
-        ENDIF
-        ENDDO
-        igwdim=MAX(1,igwd)
-c
-        CALL drag_noro(klon,klev,dtime,paprs,pplay,
-     e                   zmea,zstd, zsig, zgam, zthe,zpic,zval,
-     e                   igwd,igwdim,idx,itest,
-     e                   t_seri, u_seri, v_seri,
-     s                   zulow, zvlow, zustr, zvstr,
-     s                   d_t_oro, d_u_oro, d_v_oro)
-c
-c  ajout des tendances
-        DO k = 1, klev
-        DO i = 1, klon
-           t_seri(i,k) = t_seri(i,k) + d_t_oro(i,k)
-           u_seri(i,k) = u_seri(i,k) + d_u_oro(i,k)
-           v_seri(i,k) = v_seri(i,k) + d_v_oro(i,k)
-        ENDDO
-        ENDDO
-c
-      ENDIF ! fin de test sur ok_orodr
-c
-      IF (ok_orolf) THEN
-c
-c  selection des points pour lesquels le shema est actif:
-        igwd=0
-        DO i=1,klon
-        itest(i)=0
-        IF ((zpic(i)-zmea(i)).GT.100.) THEN
-          itest(i)=1
-          igwd=igwd+1
-          idx(igwd)=i
-        ENDIF
-        ENDDO
-        igwdim=MAX(1,igwd)
-c
-        CALL lift_noro(klon,klev,dtime,paprs,pplay,
-     e                   rlat,zmea,zstd, zsig, zgam, zthe,zpic,zval,
-     e                   igwd,igwdim,idx,itest,
-     e                   t_seri, u_seri, v_seri,
-     s                   zulow, zvlow, zustr, zvstr,
-     s                   d_t_lif, d_u_lif, d_v_lif)
-c
-c  ajout des tendances
-        DO k = 1, klev
-        DO i = 1, klon
-           t_seri(i,k) = t_seri(i,k) + d_t_lif(i,k)
-           u_seri(i,k) = u_seri(i,k) + d_u_lif(i,k)
-           v_seri(i,k) = v_seri(i,k) + d_v_lif(i,k)
-        ENDDO
-        ENDDO
-c
-      ENDIF ! fin de test sur ok_orolf
-c
-cAA
-cAA Installation de l'interface online-offline pour traceurs
-cAA
-c====================================================================
-c   Calcul  des tendances traceurs
-c====================================================================
-C Pascale : il faut quand meme apeller phytrac car il gere les sorties
-cKE43       des traceurs => il faut donc mettre des flags a .false.
-      IF (iflag_con.GE.3) THEN
-c           on ajoute les tendances calculees par KE43
-        DO iq=1, nqmax-2 ! Sandrine a -3 ???
-        DO k = 1, nlev
-        DO i = 1, klon
-          tr_seri(i,k,iq) = tr_seri(i,k,iq) + d_tr(i,k,iq)
-        ENDDO
-        ENDDO
-        WRITE(iqn,'(i2.2)') iq
-        CALL minmaxqfi(tr_seri(1,1,iq),0.,1.e33,'couche lim iq='//iqn)
-        ENDDO
-CMAF modif pour garder info du nombre de traceurs auxquels
-C la physique s'applique
-      ELSE
-CMAF modif pour garder info du nombre de traceurs auxquels
-C la physique s'applique
-C
-      call phytrac (rnpb,
-     I                   itap, julien, gmtime, 
-     I                   debut,lafin,
-     I                   nqmax-2,
-     I                   nlon,nlev,dtime,
-     I                   u,v,t,paprs,pplay,
-     I                   pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
-     I                   ycoefh,yu1,yv1,ftsol,pctsrf,rlat,
-     I                   frac_impa, frac_nucl,
-     I                   rlon,paire,pphis,pphi,
-     I                   albsol, 
-     I                   qx(1,1,1), rhcl, 
-     I                   cldfra, rneb, diafra, cldliq, itop_con,
-     I                   ibas_con,
-     I                   pmflxr,pmflxs,prfl,psfl,flxmass_w,
-     O                   tr_seri)
-      ENDIF 
-
-      IF (offline) THEN
-
-	 call phystokenc (
-     I                   nlon,nlev,pdtphys,rlon,rlat,
-     I                   t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
-     I                   ycoefh,yu1,yv1,ftsol,pctsrf,
-     I                   frac_impa, frac_nucl,
-     I                   pphis,paire,dtime,itap)
-
-
-      ENDIF
-
-c
-c Calculer le transport de l'eau et de l'energie (diagnostique)
-c
-      CALL transp (paprs,zxtsol,
-     e                   t_seri, q_seri, u_seri, v_seri, zphi,
-     s                   ve, vq, ue, uq)
-c
-c Accumuler les variables a stocker dans les fichiers histoire:
-c
-      IF (ok_oasis) THEN ! couplage oasis
-      DO i = 1, klon
-        oas_sols(i) = oas_sols(i) + solsw(i)          / FLOAT(nexca)
-        oas_nsol(i) = oas_nsol(i) + (bils(i)-solsw(i))/ FLOAT(nexca)
-        oas_rain(i) = oas_rain(i) + rain_fall(i)      / FLOAT(nexca)
-        oas_snow(i) = oas_snow(i) + snow_fall(i)      / FLOAT(nexca)
-        oas_evap(i) = oas_evap(i) + evap(i)           / FLOAT(nexca)
-        oas_tsol(i) = oas_tsol(i) + zxtsol(i)         / FLOAT(nexca)
-        oas_fder(i) = oas_fder(i) + fder(i)           / FLOAT(nexca)
-        oas_albe(i) = oas_albe(i) + albsol(i)         / FLOAT(nexca)
-        oas_taux(i) = oas_taux(i) + fluxu(i,1)        / FLOAT(nexca)
-        oas_tauy(i) = oas_tauy(i) + fluxv(i,1)        / FLOAT(nexca)
-        oas_ruis(i) = oas_ruis(i) + ruis(i)       /FLOAT(nexca)/dtime
-      ENDDO
-      ENDIF
-c
-c
-      IF (ok_journe) THEN
-c
-      ndex2d = 0
-      ndex3d = 0
-c
-c Champs 2D:
-c
-         i = NINT(zout/zsto)
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
-         CALL histwrite(nid_day,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-         i = NINT(zout/zsto)
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
-         CALL histwrite(nid_day,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
-C
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
-      CALL histwrite(nid_day,"tsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      DO i = 1, klon
-         zx_tmp_fi2d(i) = paprs(i,1)
-      ENDDO
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day,"psol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      DO i = 1, klon
-         zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
-      ENDDO
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day,"rain",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
-      CALL histwrite(nid_day,"snow",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
-      CALL histwrite(nid_day,"evap",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
-      CALL histwrite(nid_day,"tops",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
-      CALL histwrite(nid_day,"topl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
-      CALL histwrite(nid_day,"sols",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
-      CALL histwrite(nid_day,"soll",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
-      CALL histwrite(nid_day,"bils",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
-      CALL histwrite(nid_day,"sens",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
-      CALL histwrite(nid_day,"fder",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ruis,zx_tmp_2d)
-      CALL histwrite(nid_day,"ruis",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      DO i = 1, klon
-         zx_tmp_fi2d(i) = fluxu(i,1)
-      ENDDO
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day,"frtu",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      DO i = 1, klon
-         zx_tmp_fi2d(i) = fluxv(i,1)
-      ENDDO
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day,"frtv",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      DO i = 1, klon
-         zx_tmp_fi2d(i) = pctsrf(i,is_sic)
-      ENDDO
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day,"sicf",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldl,zx_tmp_2d)
-      CALL histwrite(nid_day,"cldl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldm,zx_tmp_2d)
-      CALL histwrite(nid_day,"cldm",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldh,zx_tmp_2d)
-      CALL histwrite(nid_day,"cldh",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
-      CALL histwrite(nid_day,"cldt",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldq,zx_tmp_2d)
-      CALL histwrite(nid_day,"cldq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-c Champs 3D:
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
-      CALL histwrite(nid_day,"temp",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,ivap), zx_tmp_3d)
-      CALL histwrite(nid_day,"ovap",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
-      CALL histwrite(nid_day,"geop",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
-      CALL histwrite(nid_day,"vitu",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
-      CALL histwrite(nid_day,"vitv",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
-      CALL histwrite(nid_day,"vitw",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
-      CALL histwrite(nid_day,"pres",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      if (ok_sync) then
-        call histsync(nid_day)
-      endif
-      ENDIF
-C
-      IF (ok_mensuel) THEN
-c
-      ndex2d = 0
-      ndex3d = 0
-c
-c Champs 2D:
-c
-         i = NINT(zout/zsto)
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
-         CALL histwrite(nid_mth,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
-C
-         i = NINT(zout/zsto)
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
-         CALL histwrite(nid_mth,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
-
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
-      CALL histwrite(nid_mth,"tsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      DO i = 1, klon
-         zx_tmp_fi2d(i) = paprs(i,1)
-      ENDDO
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_mth,"psol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxqsol,zx_tmp_2d)
-      CALL histwrite(nid_mth,"qsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      DO i = 1, klon
-         zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
-      ENDDO
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_mth,"rain",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      DO i = 1, klon
-         zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
-      ENDDO
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_mth,"plul",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      DO i = 1, klon
-         zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
-      ENDDO
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_mth,"pluc",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
-      CALL histwrite(nid_mth,"snow",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, agesno,zx_tmp_2d)
-      CALL histwrite(nid_mth,"ages",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
-      CALL histwrite(nid_mth,"evap",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
-      CALL histwrite(nid_mth,"tops",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
-      CALL histwrite(nid_mth,"topl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
-      CALL histwrite(nid_mth,"sols",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
-      CALL histwrite(nid_mth,"soll",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw0,zx_tmp_2d)
-      CALL histwrite(nid_mth,"tops0",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw0,zx_tmp_2d)
-      CALL histwrite(nid_mth,"topl0",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw0,zx_tmp_2d)
-      CALL histwrite(nid_mth,"sols0",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw0,zx_tmp_2d)
-      CALL histwrite(nid_mth,"soll0",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
-      CALL histwrite(nid_mth,"bils",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
-      CALL histwrite(nid_mth,"sens",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
-      CALL histwrite(nid_mth,"fder",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ruis,zx_tmp_2d)
-      CALL histwrite(nid_mth,"ruis",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      DO i = 1, klon
-         zx_tmp_fi2d(i) = fluxu(i,1)
-      ENDDO
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_mth,"frtu",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      DO i = 1, klon
-         zx_tmp_fi2d(i) = fluxv(i,1)
-      ENDDO
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_mth,"frtv",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      DO i = 1, klon
-         zx_tmp_fi2d(i) = pctsrf(i,is_sic)
-      ENDDO
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_mth,"sicf",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol,zx_tmp_2d)
-      CALL histwrite(nid_mth,"albs",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
-      CALL histwrite(nid_mth,"cdrm",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
-      CALL histwrite(nid_mth,"cdrh",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldl,zx_tmp_2d)
-      CALL histwrite(nid_mth,"cldl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldm,zx_tmp_2d)
-      CALL histwrite(nid_mth,"cldm",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldh,zx_tmp_2d)
-      CALL histwrite(nid_mth,"cldh",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
-      CALL histwrite(nid_mth,"cldt",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldq,zx_tmp_2d)
-      CALL histwrite(nid_mth,"cldq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
-      CALL histwrite(nid_mth,"ue",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
-      CALL histwrite(nid_mth,"ve",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, uq,zx_tmp_2d)
-      CALL histwrite(nid_mth,"uq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, vq,zx_tmp_2d)
-      CALL histwrite(nid_mth,"vq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-cKE43
-      IF (iflag_con .GE. 3) THEN ! sb
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cape,zx_tmp_2d)
-      CALL histwrite(nid_mth,"cape",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1,pbase,zx_tmp_2d)
-      CALL histwrite(nid_mth,"pbase",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1,ema_pct,zx_tmp_2d)
-      CALL histwrite(nid_mth,"ptop",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1,ema_cbmf,zx_tmp_2d)
-      CALL histwrite(nid_mth,"fbase",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-c
-      ENDIF
-c34EK
-c
-c Champs 3D:
-C
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
-      CALL histwrite(nid_mth,"temp",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,ivap), zx_tmp_3d)
-      CALL histwrite(nid_mth,"ovap",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
-      CALL histwrite(nid_mth,"geop",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
-      CALL histwrite(nid_mth,"vitu",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
-      CALL histwrite(nid_mth,"vitv",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
-      CALL histwrite(nid_mth,"vitw",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
-      CALL histwrite(nid_mth,"pres",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cldfra, zx_tmp_3d)
-      CALL histwrite(nid_mth,"rneb",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zx_rh, zx_tmp_3d)
-      CALL histwrite(nid_mth,"rhum",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cldliq, zx_tmp_3d)
-      CALL histwrite(nid_mth,"oliq",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtdyn",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_dyn, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dqdyn",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_con, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtcon",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_con, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dqcon",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_lsc, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtlsc",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_lsc, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dqlsc",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_vdf, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtvdf",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_vdf, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dqvdf",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_eva, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dteva",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_eva, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dqeva",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zpt_conv, zx_tmp_3d)
-      CALL histwrite(nid_mth,"ptconv",itap,zx_tmp_3d,
-     .                                   iim*(jjmp1)*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, ratqs, zx_tmp_3d)
-      CALL histwrite(nid_mth,"ratqs",itap,zx_tmp_3d,
-     .                                   iim*(jjmp1)*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_ajs, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtajs",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_ajs, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dqajs",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtswr",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat0, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtsw0",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtlwr",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool0, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtlw0",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
-      CALL histwrite(nid_mth,"duvdf",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dvvdf",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      IF (ok_orodr) THEN
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_oro, zx_tmp_3d)
-      CALL histwrite(nid_mth,"duoro",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_oro, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dvoro",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      ENDIF
-C
-      IF (ok_orolf) THEN
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_lif, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dulif",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_lif, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dvlif",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-      ENDIF
-C
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, wo, zx_tmp_3d)
-      CALL histwrite(nid_mth,"ozone",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      IF (nqmax.GE.3) THEN
-      DO iq=1,nqmax-2
-      IF (iq.LE.99) THEN
-         CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,iq+2), zx_tmp_3d)
-         WRITE(str2,'(i2.2)') iq
-         CALL histwrite(nid_mth,"trac"//str2,itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-      ELSE
-         PRINT*, "Trop de traceurs"
-         CALL abort
-      ENDIF
-      ENDDO
-      ENDIF
-cKE43
-      IF (iflag_con.GE.3) THEN ! (sb)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, upwd, zx_tmp_3d)
-      CALL histwrite(nid_mth,"upwd",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, dnwd, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dnwd",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, dnwd0, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dnwd0",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, Ma, zx_tmp_3d)
-      CALL histwrite(nid_mth,"Ma",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-c
-      ENDIF
-c34EK
-c
-      if (ok_sync) then
-        call histsync(nid_mth)
-      endif
-      ENDIF
-c
-      IF (ok_instan) THEN
-c
-      ndex2d = 0
-      ndex3d = 0
-c
-c Champs 2D:
-c
-         i = NINT(zout/zsto)
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
-         CALL histwrite(nid_ins,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-         i = NINT(zout/zsto)
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
-         CALL histwrite(nid_ins,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
-
-      DO i = 1, klon
-         zx_tmp_fi2d(i) = paprs(i,1)
-      ENDDO
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_ins,"psol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
-      CALL histwrite(nid_ins,"topl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-c Champs 3D:
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
-      CALL histwrite(nid_ins,"temp",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
-      CALL histwrite(nid_ins,"vitu",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
-      CALL histwrite(nid_ins,"vitv",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
-      CALL histwrite(nid_ins,"geop",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
-      CALL histwrite(nid_ins,"pres",itap,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      if (ok_sync) then
-        call histsync(nid_ins)
-      endif
-      ENDIF
-c
-      IF (ok_oasis .AND. mod(itap,nexca).EQ.0) THEN
-c
-c Je ne traite pas le ruissellement, pour l'instant (qui m'aidera ?)
-         DO i = 1, klon
-            oas_ruisoce(i) = 0.0
-            oas_ruisriv(i) = 0.0
-         ENDDO
-c
-         ig = 1
-         DO i = 1, iim
-            z_sols(i,1) = oas_sols(ig)
-            z_nsol(i,1) = oas_nsol(ig)
-            z_rain(i,1) = oas_rain(ig)
-            z_snow(i,1) = oas_snow(ig)
-            z_evap(i,1) = oas_evap(ig)
-            z_ruisoce(i,1) = oas_ruisoce(ig)
-            z_ruisriv(i,1) = oas_ruisriv(ig)
-            z_tsol(i,1) = oas_tsol(ig)
-            z_fder(i,1) = oas_fder(ig)
-            z_albe(i,1) = oas_albe(ig)
-            z_taux(i,1) = oas_taux(ig)
-            z_tauy(i,1) = oas_tauy(ig)
-         ENDDO
-         DO j = 2, jjm
-         DO i = 1, iim
-            ig = ig + 1
-            z_sols(i,j) = oas_sols(ig)
-            z_nsol(i,j) = oas_nsol(ig)
-            z_rain(i,j) = oas_rain(ig)
-            z_snow(i,j) = oas_snow(ig)
-            z_evap(i,j) = oas_evap(ig)
-            z_ruisoce(i,j) = oas_ruisoce(ig)
-            z_ruisriv(i,j) = oas_ruisriv(ig)
-            z_tsol(i,j) = oas_tsol(ig)
-            z_fder(i,j) = oas_fder(ig)
-            z_albe(i,j) = oas_albe(ig)
-            z_taux(i,j) = oas_taux(ig)
-            z_tauy(i,j) = oas_tauy(ig)
-         ENDDO
-         ENDDO
-         ig = ig + 1
-         DO i = 1, iim
-            z_sols(i,jjmp1)    = oas_sols(ig)
-            z_nsol(i,jjmp1)    = oas_nsol(ig)
-            z_rain(i,jjmp1)    = oas_rain(ig)
-            z_snow(i,jjmp1)    = oas_snow(ig)
-            z_evap(i,jjmp1)    = oas_evap(ig)
-            z_ruisoce(i,jjmp1) = oas_ruisoce(ig)
-            z_ruisriv(i,jjmp1) = oas_ruisriv(ig)
-            z_tsol(i,jjmp1)    = oas_tsol(ig)
-            z_fder(i,jjmp1)    = oas_fder(ig)
-            z_albe(i,jjmp1)    = oas_albe(ig)
-            z_taux(i,jjmp1)    = oas_taux(ig)
-            z_tauy(i,jjmp1)    = oas_tauy(ig)
-         ENDDO
-c
-c Passer les champs au coupleur:
-c
-         CALL intocpl(itap,jjmp1*iim,
-     .                   z_sols, z_nsol,
-     .                   z_rain, z_snow, z_evap,
-     .                   z_ruisoce, z_ruisriv,
-     .                   z_tsol, z_fder, z_albe,
-     .                   z_taux, z_tauy)
-         DO i = 1, klon
-           oas_sols(i) = 0.0
-           oas_nsol(i) = 0.0
-           oas_rain(i) = 0.0
-           oas_snow(i) = 0.0
-           oas_evap(i) = 0.0
-           oas_ruis(i) = 0.0
-           oas_tsol(i) = 0.0
-           oas_fder(i) = 0.0
-           oas_albe(i) = 0.0
-           oas_taux(i) = 0.0
-           oas_tauy(i) = 0.0
-         ENDDO
-      ENDIF
-c
-c Ecrire la bande regionale (binaire grads)
-      IF (ok_region .AND. mod(itap,ecrit_reg).eq.0) THEN
-         CALL ecriregs(84,zxtsol)
-         CALL ecriregs(84,paprs(1,1))
-         CALL ecriregs(84,topsw)
-         CALL ecriregs(84,toplw)
-         CALL ecriregs(84,solsw)
-         CALL ecriregs(84,sollw)
-         CALL ecriregs(84,rain_fall)
-         CALL ecriregs(84,snow_fall)
-         CALL ecriregs(84,evap)
-         CALL ecriregs(84,sens)
-         CALL ecriregs(84,bils)
-         CALL ecriregs(84,pctsrf(1,is_sic))
-         CALL ecriregs(84,fluxu(1,1))
-         CALL ecriregs(84,fluxv(1,1))
-         CALL ecriregs(84,ue)
-         CALL ecriregs(84,ve)
-         CALL ecriregs(84,uq)
-         CALL ecriregs(84,vq)
-c
-         CALL ecrirega(84,u_seri)
-         CALL ecrirega(84,v_seri)
-         CALL ecrirega(84,omega)
-         CALL ecrirega(84,t_seri)
-         CALL ecrirega(84,zphi)
-         CALL ecrirega(84,q_seri)
-         CALL ecrirega(84,cldfra)
-         CALL ecrirega(84,cldliq)
-         CALL ecrirega(84,pplay)
-
-
-cc         CALL ecrirega(84,d_t_dyn)
-cc         CALL ecrirega(84,d_q_dyn)
-cc         CALL ecrirega(84,heat)
-cc         CALL ecrirega(84,cool)
-cc         CALL ecrirega(84,d_t_con)
-cc         CALL ecrirega(84,d_q_con)
-cc         CALL ecrirega(84,d_t_lsc)
-cc         CALL ecrirega(84,d_q_lsc)
-      ENDIF
-
-#ifdef INCA
-#ifdef INCAINFO
-           PRINT *, 'Appel CHEMHOOK_END ...'
-#endif
-           CALL chemhook_end (calday,
-     $                        dtime,
-     $                        pplay,
-     $                        t_seri,
-     $                        tr_seri,
-     $                        nbtr,
-     $                        paprs,
-     $                        anne_ini,
-     $                        day_ini,
-     $                        xjour)
-#ifdef INCAINFO
-           PRINT *, 'OK.'
-#endif
-#endif
-
-c
-c Convertir les incrementations en tendances
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / dtime
-         d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / dtime
-         d_t(i,k) = ( t_seri(i,k)-t(i,k) ) / dtime
-         d_qx(i,k,ivap) = ( q_seri(i,k) - qx(i,k,ivap) ) / dtime
-         d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / dtime
-      ENDDO
-      ENDDO
-c
-      IF (nqmax.GE.3) THEN
-      DO iq = 3, nqmax
-      DO  k = 1, klev
-      DO  i = 1, klon
-         d_qx(i,k,iq) = ( tr_seri(i,k,iq-2) - qx(i,k,iq) ) / dtime
-      ENDDO
-      ENDDO
-      ENDDO
-      ENDIF
-c
-c Sauvegarder les valeurs de t et q a la fin de la physique:
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         t_ancien(i,k) = t_seri(i,k)
-         q_ancien(i,k) = q_seri(i,k)
-      ENDDO
-      ENDDO
-c
-c====================================================================
-c Si c'est la fin, il faut conserver l'etat de redemarrage
-c====================================================================
-c
-      IF (lafin) THEN
-ccc         IF (ok_oasis) CALL quitcpl
-         CALL phyredem ("restartphy.nc",dtime,radpas,co2_ppm,solaire,
-     .        rlat,rlon,ftsol,ftsoil,deltat,fqsol,fsnow,
-     .        radsol,rugmer,agesno,
-     .        zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,
-     .        t_ancien, q_ancien)
-      ENDIF
-
-      RETURN
-      END
-      FUNCTION qcheck(klon,klev,paprs,q,ql,aire)
-      IMPLICIT none
-c
-c Calculer et imprimer l'eau totale. A utiliser pour verifier
-c la conservation de l'eau
-c
-#include "YOMCST.h"
-      INTEGER klon,klev
-      REAL paprs(klon,klev+1), q(klon,klev), ql(klon,klev)
-      REAL aire(klon)
-      REAL qtotal, zx, qcheck
-      INTEGER i, k
-c
-      zx = 0.0
-      DO i = 1, klon
-         zx = zx + aire(i)
-      ENDDO
-      qtotal = 0.0
-      DO k = 1, klev
-      DO i = 1, klon
-         qtotal = qtotal + (q(i,k)+ql(i,k)) * aire(i)
-     .                     *(paprs(i,k)-paprs(i,k+1))/RG
-      ENDDO
-      ENDDO
-c
-      qcheck = qtotal/zx
-c
-      RETURN
-      END
-      SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit)
-      IMPLICIT none
-c
-c Tranformer une variable de la grille physique a
-c la grille d'ecriture
-c
-      INTEGER nfield,nlon,iim,jjmp1, jjm
-      REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield)
-c
-      INTEGER i, j, n, ig
-c
-      jjm = jjmp1 - 1
-      DO n = 1, nfield
-         DO i=1,iim
-            ecrit(i,n) = fi(1,n)
-            ecrit(i+jjm*iim,n) = fi(nlon,n)
-         ENDDO
-         DO ig = 1, nlon - 2
-           ecrit(iim+ig,n) = fi(1+ig,n)
-         ENDDO
-      ENDDO
-      RETURN
-      END
-
Index: LMDZ.3.3/branches/rel-/libf/phylmd/phystokenc.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/phystokenc.F	(revision 416)
+++ 	(revision )
@@ -1,341 +1,0 @@
-c
-c $Header$
-c
-      SUBROUTINE phystokenc (
-     I                   nlon,nlev,pdtphys,rlon,rlat,
-     I                   pt,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
-     I                   pcoefh,yu1,yv1,ftsol,pctsrf,
-     I                   pfrac_impa,pfrac_nucl,
-     I                   pphis,paire,dtime,itap)
-      USE ioipsl
-
-      IMPLICIT none
-
-c======================================================================
-c Auteur(s) FH
-c Objet: Moniteur general des tendances traceurs
-c
-
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "tracstoke.h"
-#include "indicesol.h"
-#include "control.h"
-c======================================================================
-
-c Arguments:
-c
-c   EN ENTREE:
-c   ==========
-c
-c   divers:
-c   -------
-c
-      integer nlon ! nombre de points horizontaux
-      integer nlev ! nombre de couches verticales
-      real pdtphys ! pas d'integration pour la physique (seconde)
-c
-      integer physid, itap,ndex(1)
-
-c   convection:
-c   -----------
-c
-      REAL pmfu(klon,klev)  ! flux de masse dans le panache montant
-      REAL pmfd(klon,klev)  ! flux de masse dans le panache descendant
-      REAL pen_u(klon,klev) ! flux entraine dans le panache montant
-      REAL pde_u(klon,klev) ! flux detraine dans le panache montant
-      REAL pen_d(klon,klev) ! flux entraine dans le panache descendant
-      REAL pde_d(klon,klev) ! flux detraine dans le panache descendant
-	REAL pt(klon,klev)
-c
-      REAL rlon(klon), rlat(klon), dtime
-      REAL zx_tmp_3d(iim,jjm+1,klev),zx_tmp_2d(iim,jjm+1)
-
-c   Couche limite:
-c   --------------
-c
-      REAL pcoefh(klon,klev)    ! coeff melange CL
-      REAL yv1(klon)
-      REAL yu1(klon),pphis(klon),paire(klon)
-c
-c   Lessivage:
-c   ----------
-c
-      REAL pfrac_impa(klon,klev)
-      REAL pfrac_nucl(klon,klev)
-c
-c Arguments necessaires pour les sources et puits de traceur
-C
-      real ftsol(klon,nbsrf)  ! Temperature du sol (surf)(Kelvin)
-      real pctsrf(klon,nbsrf) ! Pourcentage de sol f(nature du sol)
-c======================================================================
-c
-      INTEGER i, k
-c
-      REAL mfu(klon,klev)  ! flux de masse dans le panache montant
-      REAL mfd(klon,klev)  ! flux de masse dans le panache descendant
-      REAL en_u(klon,klev) ! flux entraine dans le panache montant
-      REAL de_u(klon,klev) ! flux detraine dans le panache montant
-      REAL en_d(klon,klev) ! flux entraine dans le panache descendant
-      REAL de_d(klon,klev) ! flux detraine dans le panache descendant
-      REAL coefh(klon,klev) ! flux detraine dans le panache descendant
-	REAL t(klon,klev)
-      REAL frac_impa(klon,klev)
-      REAL frac_nucl(klon,klev)
-      REAL rain(klon)
-
-      REAL pyu1(klon),pyv1(klon)
-      REAL pftsol(klon,nbsrf),ppsrf(klon,nbsrf)
-      real pftsol1(klon),pftsol2(klon),pftsol3(klon),pftsol4(klon)
-      real ppsrf1(klon),ppsrf2(klon),ppsrf3(klon),ppsrf4(klon)
-
-      REAL dtcum
-
-      integer iadvtr,irec
-      real zmin,zmax
-
-      save t,mfu,mfd,en_u,de_u,en_d,de_d,coefh,dtcum
-      save iadvtr,irec
-      save frac_impa,frac_nucl,rain
-      save pyu1,pyv1,pftsol,ppsrf
-
-      data iadvtr,irec/0,1/
-c
-c   Couche limite:
-c======================================================================
-
-      print*,'iadvtr= ',iadvtr
-      print*,'istphy= ',istphy
-      print*,'istdyn= ',istdyn
-
-      IF (iadvtr.eq.0) THEN
-	
-	CALL initphysto('phystoke',
-     . rlon,rlat,dtime, dtime*istphy,dtime*istphy,nqmx,physid)
-  	
-	write(*,*) 'apres initphysto ds phystokenc' 
-
-       ndex(1) = 0
-         i=itap 
-         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
-         CALL histwrite(physid,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex)
-c
-         i=itap
-         CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
-         CALL histwrite(physid,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex)
-	
-      ENDIF
-c
-      iadvtr=iadvtr+1
-c
-c
-c   reinitialisation des champs cumules
-      if (mod(iadvtr,istphy).eq.1.or.istphy.eq.1) then
-	print*,'reinitialisation des champs cumules 
-     s          a iadvtr=',iadvtr
-         do k=1,klev
-            do i=1,klon
-               frac_impa(i,k)=1.
-               frac_nucl(i,k)=1.
-               mfu(i,k)=0.
-               mfd(i,k)=0.
-               en_u(i,k)=0.
-               de_u(i,k)=0.
-               en_d(i,k)=0.
-               de_d(i,k)=0.
-               coefh(i,k)=0.
-		t(i,k)=0.
-            enddo
-         enddo
-         do i=1,klon
-            rain(i)=0.
-            pyv1(i)=0.
-            pyu1(i)=0.
-         end do
-         do k=1,nbsrf
-             do i=1,klon
-               pftsol(i,k)=0.
-               ppsrf(i,k)=0.
-            enddo
-         enddo
-
-         dtcum=0.
-      endif
-
-      do k=1,klev
-         do i=1,klon
-            frac_impa(i,k)=frac_impa(i,k)*pfrac_impa(i,k)
-            frac_nucl(i,k)=frac_nucl(i,k)*pfrac_nucl(i,k)
-            mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys
-            mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys
-            en_u(i,k)=en_u(i,k)+pen_u(i,k)*pdtphys
-            de_u(i,k)=de_u(i,k)+pde_u(i,k)*pdtphys
-            en_d(i,k)=en_d(i,k)+pen_d(i,k)*pdtphys
-            de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys
-            coefh(i,k)=coefh(i,k)+pcoefh(i,k)*pdtphys
-		t(i,k)=t(i,k)+pt(i,k)*pdtphys
-         enddo
-      enddo
-         do i=1,klon
-            pyv1(i)=pyv1(i)+yv1(i)*pdtphys
-            pyu1(i)=pyu1(i)+yu1(i)*pdtphys
-         end do
-         do k=1,nbsrf
-             do i=1,klon
-               pftsol(i,k)=pftsol(i,k)+ftsol(i,k)*pdtphys
-               ppsrf(i,k)=ppsrf(i,k)+pctsrf(i,k)*pdtphys
-            enddo
-         enddo
-
-      dtcum=dtcum+pdtphys
-c
-      IF(mod(iadvtr,istphy).eq.0) THEN
-c
-c   normalisation par le temps cumule
-         do k=1,klev
-            do i=1,klon
-c              frac_impa=frac_impa : c'est la fraction cumulee qu'on stoke
-c              frac_nucl=frac_nucl : c'est la fraction cumulee qu'on stoke
-               mfu(i,k)=mfu(i,k)/dtcum
-               mfd(i,k)=mfd(i,k)/dtcum
-               en_u(i,k)=en_u(i,k)/dtcum
-               de_u(i,k)=de_u(i,k)/dtcum
-               en_d(i,k)=en_d(i,k)/dtcum
-               de_d(i,k)=de_d(i,k)/dtcum
-               coefh(i,k)=coefh(i,k)/dtcum
-		t(i,k)=t(i,k)/dtcum
-            enddo
-         enddo
-         do i=1,klon
-            rain(i)=rain(i)/dtcum
-            pyv1(i)=pyv1(i)/dtcum
-            pyu1(i)=pyu1(i)/dtcum
-         end do
-c modif abderr 23 11 00         do k=1,nbsrf
-             do i=1,klon
-	      do k=1,nbsrf
-               pftsol(i,k)=pftsol(i,k)/dtcum
-	       ppsrf(i,k)=ppsrf(i,k)/dtcum
-	      enddo
-               pftsol1(i) = pftsol(i,1)
-               pftsol2(i) = pftsol(i,2)
-               pftsol3(i) = pftsol(i,3)
-               pftsol4(i) = pftsol(i,4)
-
-c               ppsrf(i,k)=ppsrf(i,k)/dtcum
-               ppsrf1(i) = ppsrf(i,1)
-               ppsrf2(i) = ppsrf(i,2)
-               ppsrf3(i) = ppsrf(i,3)
-               ppsrf4(i) = ppsrf(i,4)
-
-            enddo
-c         enddo
-c
-c   ecriture des champs
-c
-         irec=irec+1
-
-ccccc
-      print*,'AVANT ECRITURE'
-         CALL gr_fi_ecrit(klev,klon,iim,jjm+1, t, zx_tmp_3d)
-         CALL histwrite(physid,"t",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-      print*,'APRES ECRITURE'
-
-         CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfu, zx_tmp_3d)
-      CALL histwrite(physid,"mfu",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfd, zx_tmp_3d)
-      CALL histwrite(physid,"mfd",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_u, zx_tmp_3d)
-      CALL histwrite(physid,"en_u",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_u, zx_tmp_3d)
-      CALL histwrite(physid,"de_u",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_d, zx_tmp_3d)
-      CALL histwrite(physid,"en_d",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_d, zx_tmp_3d)
-      CALL histwrite(physid,"de_d",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, coefh, zx_tmp_3d)
-      CALL histwrite(physid,"coefh",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-cccc
-       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_impa,zx_tmp_3d)
-        CALL histwrite(physid,"frac_impa",itap,zx_tmp_3d,
-     .  iim*(jjm+1)*klev,ndex)
-
-        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_nucl,zx_tmp_3d)
-        CALL histwrite(physid,"frac_nucl",itap,zx_tmp_3d,
-     .  iim*(jjm+1)*klev,ndex)
-
-        CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyu1,zx_tmp_2d)
-      CALL histwrite(physid,"pyu1",itap,zx_tmp_2d,iim*(jjm+1),ndex)
-
-        CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyv1,zx_tmp_2d)
-      CALL histwrite(physid,"pyv1",itap,zx_tmp_2d,iim*(jjm+1),ndex)
-
-        CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol1, zx_tmp_2d)
-      CALL histwrite(physid,"ftsol1",itap,zx_tmp_2d,
-     .                                   iim*(jjm+1),ndex)
-         CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol2, zx_tmp_2d)
-      CALL histwrite(physid,"ftsol2",itap,zx_tmp_2d,
-     .                                   iim*(jjm+1),ndex)
-          CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol3, zx_tmp_2d)
-      CALL histwrite(physid,"ftsol3",itap,zx_tmp_2d,
-     .                                   iim*(jjm+1),ndex)
-
-c
-         CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol4, zx_tmp_2d)
-      CALL histwrite(physid,"ftsol4",itap,zx_tmp_2d,
-     .                                   iim*(jjm+1),ndex)
-
-        CALL gr_fi_ecrit(1,klon,iim,jjm+1, rain, zx_tmp_2d)
-      CALL histwrite(physid,"rain",itap,zx_tmp_2d,
-     .                                   iim*(jjm+1),ndex)
-
-        CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf1, zx_tmp_2d)
-      CALL histwrite(physid,"psrf1",itap,zx_tmp_2d,
-     .                                   iim*(jjm+1),ndex)
-        CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf2, zx_tmp_2d)
-      CALL histwrite(physid,"psrf2",itap,zx_tmp_2d,
-     .                                   iim*(jjm+1),ndex)
-        CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf3, zx_tmp_2d)
-      CALL histwrite(physid,"psrf3",itap,zx_tmp_2d,
-     .                                   iim*(jjm+1),ndex)
-        CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf4, zx_tmp_2d)
-      CALL histwrite(physid,"psrf4",itap,zx_tmp_2d,
-     .                                   iim*(jjm+1),ndex)
-
-c
-cAA Test sur la valeur des coefficients de lessivage
-c
-         zmin=1e33
-         zmax=-1e33
-         do k=1,klev
-            do i=1,klon
-                  zmax=max(zmax,frac_nucl(i,k))
-                  zmin=min(zmin,frac_nucl(i,k))
-            enddo
-         enddo
-         Print*,'------ coefs de lessivage (min et max) --------'
-         Print*,'facteur de nucleation ',zmin,zmax
-         zmin=1e33
-         zmax=-1e33
-         do k=1,klev
-            do i=1,klon
-                  zmax=max(zmax,frac_impa(i,k))
-                  zmin=min(zmin,frac_impa(i,k))
-            enddo
-         enddo
-         Print*,'facteur d impaction ',zmin,zmax
-
-      ENDIF
-
-
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/phytrac.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/phytrac.F	(revision 416)
+++ 	(revision )
@@ -1,1193 +1,0 @@
-c
-c $Header$
-c
-      SUBROUTINE phytrac (rnpb,
-     I                    nstep, 
-     I                    julien, 
-     I                    gmtime,
-     I                    debutphy,
-     I                    lafin,
-     I                    nqmax,
-     I                    nlon,
-     I                    nlev,
-     I                    pdtphys,
-     I                    u,
-     I                    v,
-     I                    t_seri,
-     I                    paprs,
-     I                    pplay,
-     I                    pmfu, 
-     I                    pmfd, 
-     I                    pen_u, 
-     I                    pde_u, 
-     I                    pen_d, 
-     I                    pde_d,
-     I                    coefh,
-     I                    yu1,
-     I                    yv1,
-     I                    ftsol,
-     I                    pctsrf,
-     I                    xlat,
-     I                    frac_impa, 
-     I                    frac_nucl,
-     I                    xlon,
-     I                    paire,
-     I                    pphis,
-     I                    pphi,
-     I                    albsol,
-     I                    sh,
-     I                    rh,
-     I                    cldfra, 
-     I                    rneb, 
-     I                    diafra, 
-     I                    cldliq, 
-     I                    itop_con,
-     I                    ibas_con,
-     I                    pmflxr,
-     I                    pmflxs,
-     I                    prfl,
-     I                    psfl,
-     I                    flxmass_w,
-     O                    tr_seri)
-      USE ioipsl
-
-#ifdef INCA
-      USE sflx
-      USE chem_tracnm
-      USE species_names
-      USE chem_mods
-      USE pht_tables, ONLY : jrates
-      USE transport_controls, ONLY : conv_flg, pbl_flg
-      USE airplane_src, ONLY : ptrop
-      USE lightning, ONLY : prod_light
-#ifdef INCA_AER
-      USE AEROSOL_DIAG
-#endif
-#endif
-
-      IMPLICIT none
-c======================================================================
-c Auteur(s) FH
-c Objet: Moniteur general des tendances traceurs
-c
-cAA Remarques en vrac:
-cAA--------------------
-cAA 1/ le call phytrac se fait avec nqmax-2 donc nous avons bien 
-cAA les vrais traceurs (nbtr) dans phytrac (pas la vapeur ni eau liquide)
-cAA 2/ Le choix du radon et du pb se fait juste avec un data 
-cAA    (peu propre). Peut-etre pourrait-on prevoir dans l'avenir 
-cAA    une variable "type de traceur" 
-c======================================================================
-#include "YOMCST.h"
-#include "dimensions.h"
-#include "paramet.h"
-#include "dimphy.h"
-#include "indicesol.h"
-#include "comvert.h"
-#include "temps.h"
-#include "control.h"
-c======================================================================
-
-c Arguments:
-c
-c   EN ENTREE:
-c   ==========
-c
-c   divers:
-c   -------
-c
-      integer nlon   ! nombre de points horizontaux
-      integer nlev   ! nombre de couches verticales
-      integer nqmax  ! nombre de traceurs auxquels on applique la physique
-      integer nstep  ! appel physique
-      integer julien !jour julien
-      integer itop_con(nlon) 
-      integer ibas_con(nlon) 
-      real gmtime
-      real pdtphys  ! pas d'integration pour la physique (seconde)
-      real t_seri(nlon,nlev) ! temperature
-      real u(klon,klev)
-      real v(klon,klev)
-      real sh(nlon,nlev)     ! humidite specifique
-      real rh(nlon,nlev)     ! humidite relative
-      real cldliq(nlon,nlev) ! eau liquide nuageuse
-      real cldfra(nlon,nlev) ! fraction nuageuse (tous les nuages)
-      real diafra(nlon,nlev) ! fraction nuageuse (convection ou stratus artificiels)
-      real rneb(nlon,nlev)   ! fraction nuageuse (grande echelle)
-      real albsol(nlon)      ! albedo surface
-      real tr_seri(nlon,nlev,nbtr) ! traceur  
-      real paprs(nlon,nlev+1)  ! pression pour chaque inter-couche (en Pa)
-      real ps(nlon)  ! pression surface
-      real pplay(nlon,nlev)  ! pression pour le mileu de chaque couche (en Pa)
-      real pphi(nlon,klev) ! geopotentiel
-      real znivsig(klev) ! niveaux sigma
-      real paire(klon)
-      real pphis(klon)
-      REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1)   !--lessivage convection
-      REAL prfl(klon,klev+1),   psfl(klon,klev+1)     !--lessivage large-scale
-      REAL flxmass_w(klon,klev)
-      logical debutphy       ! le flag de l'initialisation de la physique
-      logical lafin          ! le flag de la fin de la physique
-
-      integer ll
-c
-cAA Rem : nbtr : nombre de vrais traceurs est defini dans dimphy.h
-c
-c   convection:
-c   -----------
-c
-      REAL pmfu(nlon,nlev)  ! flux de masse dans le panache montant
-      REAL pmfd(nlon,nlev)  ! flux de masse dans le panache descendant
-      REAL pen_u(nlon,nlev) ! flux entraine dans le panache montant
-      REAL pde_u(nlon,nlev) ! flux detraine dans le panache montant
-      REAL pen_d(nlon,nlev) ! flux entraine dans le panache descendant
-      REAL pde_d(nlon,nlev) ! flux detraine dans le panache descendant
-c
-c   Couche limite:
-c   --------------
-c
-      REAL coefh(nlon,nlev) ! coeff melange CL
-      REAL yu1(nlon)        ! vents au premier niveau
-      REAL yv1(nlon)        ! vents au premier niveau
-      REAL xlat(nlon)       ! latitudes pour chaque point 
-      REAL xlon(nlon)       ! longitudes pour chaque point 
-
-c
-c   Lessivage:
-c   ----------
-c
-c pour le ON-LINE
-c
-      REAL frac_impa(nlon,nlev)  ! fraction d'aerosols impactes
-      REAL frac_nucl(nlon,nlev)  ! fraction d'aerosols nuclees
-c
-cAA
-cAA Arguments necessaires pour les sources et puits de traceur:
-cAA ----------------
-cAA
-      real ftsol(nlon,nbsrf)  ! Temperature du sol (surf)(Kelvin)
-      real pctsrf(nlon,nbsrf) ! Pourcentage de sol f(nature du sol)
-c abder
-      real pftsol1(nlon),pftsol2(nlon),pftsol3(nlon),pftsol4(nlon)
-      real ppsrf1(nlon),ppsrf2(nlon),ppsrf3(nlon),ppsrf4(nlon)
-c fin
-cAA ----------------------------
-cAA  VARIABLES LOCALES TRACEURS
-cAA ----------------------------
-cAA
-cAA Sources et puits des traceurs:
-cAA ------------------------------
-cAA
-cAA Pour l'instant seuls les cas du rn et du pb ont ete envisages.
-
-      REAL source(klon)       ! a voir lorsque le flux est prescrit 
-      REAL topuits(klev,nbtr)  ! a voir 
-cAA 
-cAA Pour la source de radon et son reservoir de sol
-cAA ................................................
- 
-      REAL trs(klon,nbtr)    ! Conc. radon ds le sol
-      SAVE trs
-
-      REAL masktr(klon,nbtr) ! Masque reservoir de sol traceur
-c                            Masque de l'echange avec la surface
-c                           (1 = reservoir) ou (possible => 1 )
-      SAVE masktr
-      REAL fshtr(klon,nbtr)  ! Flux surfacique dans le reservoir de sol
-      SAVE fshtr
-      REAL hsoltr(nbtr)      ! Epaisseur equivalente du reservoir de sol
-      SAVE hsoltr
-      REAL tautr(nbtr)       ! Constante de decroissance radioactive
-      SAVE tautr
-      REAL vdeptr(nbtr)      ! Vitesse de depot sec dans la couche Brownienne
-      SAVE vdeptr
-      REAL scavtr(nbtr)      ! Coefficient de lessivage
-      SAVE scavtr
-cAA
-      CHARACTER*2 itn
-C maf ioipsl
-      CHARACTER*2 str2
-      INTEGER nhori, nvert, nverta, nvertb, nverts
-      REAL zsto, zout, zjulian
-      integer idayref
-      INTEGER nid_tra
-      SAVE nid_tra
-c     REAL x(klon,klev,nbtr+2) ! traceurs 
-      INTEGER ndex(1)
-      REAL zx_tmp_2d(iim,jjm+1), zx_tmp_3d(iim,jjm+1,klev)
-      REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)
-      INTEGER itra
-      SAVE itra                   ! compteur pour la physique
-C
-C Variables liees a l'ecriture de la bande histoire : phytrac.nc
-c
-      INTEGER ecrit_tra
-      SAVE ecrit_tra   
-      logical ok_sync
-      parameter (ok_sync = .true.)
-C
-C nature du traceur
-c
-      logical aerosol(nbtr)  ! Nature du traceur
-c                            ! aerosol(it) = true  => aerosol 
-c                            ! aerosol(it) = false => gaz 
-c                            ! nat_trac(it) = 1. aerosolc
-      logical clsol(nbtr)    ! clsol(it) = true => CL sol calculee
-      logical radio(nbtr)    ! radio(it)=true => decroisssance radioactive
-      save aerosol,clsol,radio
-C
-c======================================================================
-c
-c Declaration des procedures appelees
-c
-c--modif convection tiedtke
-      INTEGER i, k, it,itap
-	save itap
-      REAL delp(klon,klev)
-c--end modif
-c
-c Variables liees a l'ecriture de la bande histoire physique
-c
-c Variables locales pour effectuer les appels en serie
-c----------------------------------------------------
-c
-      REAL d_tr(klon,klev), d_trs(klon) ! tendances de traceurs 
-      REAL d_tr_cl(klon,klev) ! tendance de traceurs  couche limite
-      REAL d_tr_cv(klon,klev) ! tendance de traceurs  convection 
-      REAL d_tr_dec(klon,klev,nbtr) ! la tendance de la decroissance 
-c                                   ! radioactive du rn - > pb 
-      REAL d_tr_lessi_impa(klon,klev,nbtr) ! la tendance du lessivage 
-c                                          ! par impaction
-      REAL d_tr_lessi_nucl(klon,klev,nbtr) ! la tendance du lessivage 
-c                                          ! par nucleation 
-      REAL fluxrn(klon,klev) 
-      REAL fluxpb(klon,klev) 
-      REAL pbimpa(klon,klev) 
-      REAL pbnucl(klon,klev) 
-      REAL rn(klon,klev) 
-      REAL pb(klon,klev) 
-      REAL flestottr(klon,klev,nbtr) ! flux de lessivage 
-c                                    ! dans chaque couche 
-
-C
-      character*20 modname
-      character*80 abort_message
-c
-c   Controles
-c-------------
-      logical first,couchelimite,convection,lessivage,sorties,
-     s        rnpb,inirnpb
-      save first,couchelimite,convection,lessivage,sorties,
-     s     inirnpb
-      data first,couchelimite,convection,lessivage,sorties
-     s     /.true.,.true.,.true.,.true.,.true./
-
-#ifdef INCA
-      INTEGER           :: ncsec
-      INTEGER           :: prt_flag_ts(nbtr)=(/1,1,1
-#ifdef INCA_CH4
-     .                                              ,0,0,1,1,1,1,1,
-     .                                         0,1,0,0,0,0,0,1,0,0,
-     .                                         0,1,1,1,1,0,1,1,1,0,
-     .                                         1,1,1,1,1,1,1,1,1,1,
-     .                                         1,0,0
-#endif
-#ifdef INCA_AER
-     .                                              ,1,1,1,1,1,1
-#endif
-     .                                         /)
-      REAL, PARAMETER   :: dry_mass = 28.966
-      REAL, POINTER     :: hbuf(:)
-      REAL, ALLOCATABLE :: obuf(:)
-      REAL              :: calday
-      REAL              :: pdel(klon,klev)
-      REAL              :: dummy(klon,klev) = 0.
-#endif
-
-c
-c======================================================================
-c         ecrit_tra = NINT(86400./pdtphys *1.0)  ! tous les jours
-         modname='phytrac'
-         ecrit_tra = NINT(86400./pdtphys *ecritphy)   
-!DH      print*,'dans phytrac ',pdtphys,ecritphy,ecrit_tra
-         ps(:) = paprs(:,1) 
-
-c        print*,'DANS PHYTRAC debutphy=',debutphy
-
-         if (debutphy) then
-
-          print*,'dans phytrac ',pdtphys,ecritphy,ecrit_tra
-          ecrit_tra = NINT(86400./pdtphys/2.) ! tous les 12H
-c         ecrit_tra = NINT(86400./pdtphys) ! tous les 24H
-
-         if(nbtr.lt.nqmax) then
-           print*,'NQMAX=',nqmax
-           print*,'NBTR=',nbtr
-           abort_message='See above'
-           call abort_gcm(modname,abort_message,1)
-         endif
-
-         inirnpb=rnpb
-!DH      PRINT*, 'La frequence de sortie traceurs est  ', ecrit_tra
-
-C         
-         idayref = 1
-         CALL ymds2ju(anne_ini, 1, idayref, 0.0, zjulian)
-         itra = NINT(FLOAT(day_ini)*86400./pdtphys)
-         itap = NINT(FLOAT(day_ini)*86400./pdtphys)
-!        itra=0
-!        itap=0
-!        zjulian = zjulian + day_ini
- 
-         CALL gr_fi_ecrit(1,klon,iim,jjm+1,xlon,zx_lon)
-         DO i = 1, iim
-            zx_lon(i,1) = xlon(i+1)
-            zx_lon(i,jjm+1) = xlon(i+1)
-         ENDDO
-         DO ll=1,klev
-            znivsig(ll)=float(ll)
-         ENDDO
-         CALL gr_fi_ecrit(1,klon,iim,jjm+1,xlat,zx_lat)
-         CALL histbeg("histrac", iim,zx_lon, jjm+1,zx_lat,
-     .                 1,iim,1,jjm+1, itra, zjulian, pdtphys,
-     .                 nhori, nid_tra)
-
-         call histvert(nid_tra, "presnivs", "presnivs", "mb",
-     .                 klev, presnivs, nvert)
-#ifdef INCA
-!        call histvert(nid_tra, "ap", "Hybrid A parameter", "-",
-!    .                 klev+1, ap, nverta)
-!        call histvert(nid_tra, "bp", "Hybrid B parameter", "-",
-!    .                 klev+1, bp, nvertb)
-#endif
-
-         zsto = pdtphys
-         zout = pdtphys * FLOAT(ecrit_tra)
-c
-         CALL histdef(nid_tra, "phis", "Surface geop. height", "-",
-     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
-     .                "once",  zsto,zout)
-c
-         CALL histdef(nid_tra, "aire", "Grid area", "-",
-     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
-     .                "once",  zsto,zout)
-
-#ifdef INCA
-         CALL histdef(nid_tra, "ps", "Surface pressure", "Pa",
-     .                iim,jjm+1,nhori, 1,1,1,-99, 32,
-     .                "ave(X)", zsto,zout)
-
-         CALL histdef(nid_tra, "ptrop", "Tropopause pressure", "Pa",
-     .                iim,jjm+1,nhori, 1,1,1,-99, 32,
-     .                "ave(X)", zsto,zout)
-
-         CALL histdef(nid_tra, "temp", "Air temperature", "K",
-     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-
-         CALL histdef(nid_tra, "u", "zonal wind component", "m/s",
-     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-
-         CALL histdef(nid_tra, "v", "zonal wind component", "m/s",
-     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-
-         CALL histdef(nid_tra, "h2o", "Specific Humidity", "MMR",
-     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-
-         CALL histdef(nid_tra, "pmid", "Pressure", "Pa",
-     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-
-         CALL histdef(nid_tra, "pdel", "Delta Pressure", "Pa",
-     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-#ifdef INCA_CH4
-#ifdef INCAINFO
-         DO it=1, phtcnt
-         WRITE(str2,'(i2.2)') it
-         CALL histdef(nid_tra, "j"//str2,"j"//str2, "CM-3 S-1",
-     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-         ENDDO
-         DO it=1, hetcnt
-         WRITE(str2,'(i2.2)') it
-         CALL histdef(nid_tra, "w"//str2,"w"//str2, "S-1",
-     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-         ENDDO
-
-         DO it=1, extcnt
-         WRITE(str2,'(i2.2)') it
-        CALL histdef(nid_tra, "ext"//str2,"ext"//str2, "CM-3 S-1",
-     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-         ENDDO
-
-         DO it=1, nfs
-         WRITE(str2,'(i2.2)') it
-         CALL histdef(nid_tra, "INV"//str2, "INV"//str2, "CM-3",
-     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-         ENDDO
-
-#else
-         CALL histdef(nid_tra, "jO3","jO3", "CM-3 S-1",
-     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-         CALL histdef(nid_tra, "jNO2","jNO2", "CM-3 S-1",
-     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-         CALL histdef(nid_tra, "jH2O2","jH2O2", "CM-3 S-1",
-     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-         CALL histdef(nid_tra, "wHNO3","wHNO3", "S-1",
-     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-         CALL histdef(nid_tra, "kN2O5", "kN2O5","CM-3 S-1",
-     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-         CALL histdef(nid_tra, "LghtNO","LghtNO", "CM-3 S-1",
-     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-#endif
-
-         DO it=1, grpcnt
-         CALL histdef(nid_tra, grpsym(it), grpsym(it), "VMR",
-     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-         ENDDO
-#endif
-#endif
-
-#ifdef INCA_AER
-C   3d FIELDS
-
-        CALL histdef(nid_tra, "scavcoef_st","scavcoef_st", "S-1",
-     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-        CALL histdef(nid_tra, "scavcoef_cv","scavcoef_cv", "S-1",
-     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-#endif
- 
-         DO it=1,nqmax
-         IF (it.LE.99) THEN
-         WRITE(str2,'(i2.2)') it
-C champ 2D
-
-#ifdef INCA
-         IF ( prt_flag_ts(it) == 0 ) CYCLE
-
-         CALL histdef(nid_tra, "Emi_"//solsym(it), "Emi_"//solsym(it),
-     .           "kg/m2/s", iim,jjm+1,nhori, 1,1,1, -99, 32,
-     .           "ave(X)", zsto,zout)
-         CALL histdef(nid_tra, "Dep_"//solsym(it), "Dep_"//solsym(it),
-     .           "cm/s", iim,jjm+1,nhori, 1,1,1, -99, 32,
-     .           "ave(X)", zsto,zout)
-#ifdef INCA_AER
-        IF (solsym(it) .eq. 'CIDUSTM'.or.solsym(it) .eq. 'CIN'
-     .  .or.solsym(it) .eq. 'CSSSM'  .or.solsym(it) .eq. 'CSN'
-     .  .or.solsym(it) .eq. 'ASSSM'  .or.solsym(it) .eq. 'ASN' ) THEN
-         CALL histdef(nid_tra, "Sed_"//solsym(it), "Sed_"//solsym(it),
-     .           "kg/m2", iim,jjm+1,nhori, 1,1,1, -99, 32,
-     .           "ave(X)", zsto,zout)
-        endif
-        IF (solsym(it) .eq. 'CIDUSTM') THEN
-         CALL histdef(nid_tra, "OD_"//solsym(it), "OD_"//solsym(it),
-     .           "opt. depth", iim,jjm+1,nhori, 1,1,1, -99, 32,
-     .           "ave(X)", zsto,zout)
-        endif
-
-#endif
-         CALL histdef(nid_tra, solsym(it), solsym(it), "VMR",
-     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-#else
-         CALL histdef(nid_tra, "tr"//str2, "Tracer No."//str2, "U/kga",
-     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-         IF (lessivage) THEN
-         CALL histdef(nid_tra, "fl"//str2, "Tracer Flux No."//str2, 
-     .                "U/m2/s",iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-         ENDIF
-#endif
-         ELSE
-         PRINT*, "Trop de traceurs"
-         CALL abort
-         ENDIF
-         ENDDO
-
-#ifdef INCA_CH4
-         CALL histdef(nid_tra, "O3_column", "O3_column",
-     .           "DU", iim,jjm+1,nhori, 1,1,1, -99, 32,
-     .           "ave(X)", zsto,zout)
-         CALL histdef(nid_tra, "CO_column", "CO_column",
-     .           "10^18 CM-2", iim,jjm+1,nhori, 1,1,1, -99, 32,
-     .           "ave(X)", zsto,zout)
-         CALL histdef(nid_tra, "CH4_column", "CH4_column",
-     .           "10^18 CM-2", iim,jjm+1,nhori, 1,1,1, -99, 32,
-     .           "ave(X)", zsto,zout)
-         CALL histdef(nid_tra, "NO2_column", "NO2_column",
-     .           "10^15 CM-2", iim,jjm+1,nhori, 1,1,1, -99, 32,
-     .           "ave(X)", zsto,zout)
-         CALL histdef(nid_tra, "O3_ste", "O3_ste",
-     .           "CM-2 S-1", iim,jjm+1,nhori, 1,1,1, -99, 32,
-     .           "ave(X)", zsto,zout)
-         CALL histdef(nid_tra, "O3_prod", "O3_prod", "CM-3 S-1",
-     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-         CALL histdef(nid_tra, "O3_loss", "O3_loss", "CM-3 S-1",
-     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-
-!        Special variables for daytime averaging
-!        CALL histdef(nid_tra, "day_cnt", "day_cnt", "-",
-!    .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-!    .                "t_sum(X)", zsto,zout)
-!        CALL histdef(nid_tra, "NO_day", "NO_day", "VMR",
-!    .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-!    .                "t_sum(X)", zsto,zout)
-
-#endif
-
-         CALL histend(nid_tra)
-         ndex(1) = 0
-c
-         i = NINT(zout/zsto)
-         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
-         CALL histwrite(nid_tra,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex)
-C
-         i = NINT(zout/zsto)
-         CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
-         CALL histwrite(nid_tra,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex)
-
-c======================================================================
-c   Initialisation de certaines variables pour le Rn et le Pb 
-c======================================================================
-
-c Initialisation du traceur dans le sol (couche limite radonique)
-c
-c        print*,'valeur de debut dans phytrac :',debutphy
-         do it=1,nqmax
-            do i=1,klon
-               trs(i,it) = 0.
-            enddo
-         END DO
-
-         open (99,file='starttrac',status='old',
-     .         err=999,form='formatted')
-         read(99,*) (trs(i,1),i=1,klon)
-999      close(99)
-!DH      print*, 'apres starttrac'
-
-c Initialisation de la fraction d'aerosols lessivee
-c
-         DO it=1,nqmax
-           DO k = 1, nlev
-              DO i = 1, klon
-                 d_tr_lessi_impa(i,k,it) =  0.0
-                 d_tr_lessi_nucl(i,k,it) =  0.0 
-             ENDDO
-           ENDDO
-         ENDDO
-c
-c Initialisation de la nature des traceurs
-c
-         DO it = 1, nqmax
-            aerosol(it) = .FALSE.  ! Tous les traceurs sont des gaz par defaut
-            radio(it) = .FALSE.    ! Par defaut pas de passage par radiornpb
-            clsol(it) = .FALSE.  ! Par defaut couche limite avec flux prescrit
-         ENDDO
-c
-      ENDIF  ! fin debutphy 
-c Initialisation du traceur dans le sol (couche limite radonique)
-      if(inirnpb) THEN
-c
-         radio(1)= .true.
-         radio(2)= .true.
-         clsol(1)= .true.
-         clsol(2)= .true.
-         aerosol(2) = .TRUE. ! le Pb est un aerosol 
-c
-         call initrrnpb (ftsol,pctsrf,masktr,fshtr,hsoltr,tautr
-     .                   ,vdeptr,scavtr)
-         inirnpb=.false.
-      endif
-
-#ifdef INCA
-!======================================================================
-!     Chimie
-!======================================================================
-
-        calday = FLOAT(julien) + gmtime
-        ncsec  = NINT (86400.*gmtime)
-
-        DO k = 1, nlev
-        pdel(:,k) = paprs(:,k) - paprs (:,k+1)
-        END DO
-
-#ifdef INCAINFO
-        PRINT *, 'CHEMMAIN @ ', calday, ' ... '
-        DO it = 1, nbtr
-        PRINT *, solsym(it), MINVAL(tr_seri(:,:,it)),
-     $                       MAXVAL(tr_seri(:,:,it))
-      END DO
-#endif
-
-
-#ifdef INCA_AER
-        CALL aerosolmain (tr_seri,
-     $                 pdtphys,
-     $                 pplay,
-     $                 prfl,
-     $                 pmflxr,
-     $                 psfl,
-     $                 pmflxs,
-     $                 pmfu,
-     $                 itop_con,
-     $                 ibas_con,
-     $                 pphi,
-     $                 paire,
-     $                 nstep)
-#endif 
-
-        CALL chemmain (tr_seri,
-     $                 nas,
-     $                 nstep,
-     $                 calday,
-     $                 julien,
-     $                 ncsec,
-     $                 1,
-     $                 pdtphys,
-     $                 paprs(1,1),
-     $                 pplay,
-     $                 pdel,
-     $                 pctsrf(1,3),
-     $                 ftsol,
-     $                 albsol,
-     $                 pphi,
-     $                 pphis,
-     $                 cldfra,
-     $                 rneb,
-     $                 diafra,
-     $                 itop_con,
-     $                 cldliq,
-     $                 prfl,
-     $                 pmflxr,
-     $                 psfl,
-     $                 pmflxs,
-     $                 pmfu,
-     $                 flxmass_w,
-     $                 t_seri,
-     $                 sh,
-     $                 rh,
-     $                 .false.,
-     $                 hbuf,
-     $                 obuf,
-     $                 iip1,
-     $                 jjp1)
-#ifdef INCAINFO
-      PRINT *, 'OK.'
-      DO it = 1, nbtr
-      PRINT *, solsym(it), MINVAL(tr_seri(:,:,it)),
-     $                     MAXVAL(tr_seri(:,:,it))
-      END DO
-#endif
-#endif
-C
-
-c======================================================================
-c   Calcul de l'effet de la convection
-c======================================================================
-!DH   print*,'Avant convection'
-      do it=1,nqmax
-         WRITE(itn,'(i1)') it
-c        call diagtracphy(tr_seri(:,:,it),paprs,'Avant conv'//itn)
-      enddo
-
-      if (convection) then
-
-!DH   print*,'Pas de temps dans phytrac : ',pdtphys
-      DO it=1, nqmax
-#ifdef INCA
-      IF ( conv_flg(it) == 0 ) CYCLE
-#endif
-      CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
-     .            pplay, paprs, tr_seri(1,1,it), d_tr_cv)
-      DO k = 1, nlev
-      DO i = 1, klon
-         tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cv(i,k)
-      ENDDO
-      ENDDO
-c     WRITE(itn,'(i2)') it
-#ifdef INCA
-      CALL minmaxqfi(tr_seri(1,1,it),0.,1.e33,'convection it = '//solsym(it))
-#else
-      CALL minmaxqfi(tr_seri(1,1,it),0.,1.e33,'convection it = '//itn)
-#endif
-      ENDDO
-c     print*,'apres nflxtr'
-
-      endif ! convection
-c        print*,'Apres convection'
-c      do it=1,nqmax
-c         WRITE(itn,'(i1)') it
-c        call diagtracphy(tr_seri(:,:,it),paprs,'Avant conv'//itn)
-c      enddo
-
-c======================================================================
-c   Calcul de l'effet de la couche limite
-c======================================================================
-c	print *,'Avant couchelimite'
-c      do it=1,nqmax
-c         WRITE(itn,'(i1)') it
-c        call diagtracphy(tr_seri(:,:,it),paprs,'Avant CL  '//itn)
-c      enddo
-
-      if (couchelimite) then
-
-      DO k = 1, nlev
-      DO i = 1, klon
-         delp(i,k) = paprs(i,k)-paprs(i,k+1)
-      ENDDO
-      ENDDO
-
-C maf modif pour tenir compte du cas rnpb + traceur
-      DO it=1, nqmax
-#ifdef INCA
-      IF ( pbl_flg(it) == 0 ) CYCLE
-#endif
-C     print *,'it',it,clsol(it)
-      if (clsol(it)) then  ! couche limite avec quantite dans le sol calculee
-          CALL cltracrn(it, pdtphys, yu1, yv1,
-     e                    coefh,t_seri,ftsol,pctsrf,
-     e                    tr_seri(1,1,it),trs(1,it),
-     e                    paprs, pplay, delp,
-     e                    masktr(1,it),fshtr(1,it),hsoltr(it),
-     e                    tautr(it),vdeptr(it),
-     e                    xlat,
-     s                    d_tr_cl,d_trs)
-          DO k = 1, nlev
-            DO i = 1, klon
-              tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cl(i,k)
-            ENDDO
-          ENDDO
-c
-c Traceur ds sol
-c
-          DO i = 1, klon
-            trs(i,it) = trs(i,it) + d_trs(i)
-          END DO
-C
-C maf provisoire suppression des prints
-C         WRITE(itn,'(i1)') it
-C         CALL minmaxqfi(tr_seri(1,1,it),0.,1.e33,'cltracrn it='//itn)
-      else ! couche limite avec flux prescrit
-
-#ifdef INCA
-        DO k =  1, klon
-          source(k) = eflux(k,it)-dflux(k,it)
-        END DO
-#else
-Cmaf provisoire source / traceur a creer
-        DO i=1, klon
-          source(i) = 0.0 ! pas de source, pour l'instant
-        ENDDO
-#endif
-          CALL cltrac(pdtphys, coefh,t_seri,
-     s               tr_seri(1,1,it), source,
-     e               paprs, pplay, delp,
-     s               d_tr )
-            DO k = 1, nlev
-               DO i = 1, klon
-                  tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr(i,k)
-               ENDDO
-            ENDDO
-Cmaf provisoire suppression des prints
-Cmaf          WRITE(itn,'(i1)') it
-cmaf          CALL minmaxqfi(tr_seri(1,1,it),0.,1.e33,'cltracn it='//itn)
-      endif
-      ENDDO
-c
-      endif ! couche limite
-
-c      print*,'Apres couchelimite'
-c      do it=1,nqmax
-c         WRITE(itn,'(i1)') it
-c        call diagtracphy(tr_seri(:,:,it),paprs,'Avant CL  '//itn)
-c      enddo
-
-c======================================================================
-c   Calcul de l'effet du puits radioactif
-c======================================================================
-
-C MAF il faudrait faire une modification pour passer dans radiornpb 
-c si radio=true mais pour l'instant radiornpb propre au cas rnpb
-      if(rnpb) then
-        print *, 'decroissance radiactive activee'
-        call radiornpb (tr_seri,pdtphys,tautr,d_tr_dec)
-C
-        DO it=1,nqmax
-            if(radio(it)) then
-            DO k = 1, nlev
-               DO i = 1, klon
-                  tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_dec(i,k,it)
-               ENDDO
-            ENDDO
-            WRITE(itn,'(i1)') it
-            CALL minmaxqfi(tr_seri(1,1,it),0.,1.e33,'puits rn it='//itn)
-            endif
-        ENDDO
-c
-      endif ! rnpb decroissance  radioactive
-
-c======================================================================
-c   Calcul de l'effet de la precipitation
-c======================================================================
-
-!DH   print*,'LESSIVAGE =',lessivage
-      IF (lessivage) THEN
-
-c     print*,'avant lessivage'
-
-       DO it = 1, nqmax
-           DO k = 1, nlev
-              DO i = 1, klon
-               d_tr_lessi_nucl(i,k,it) = 0.0 
-               d_tr_lessi_impa(i,k,it) = 0.0 
-               flestottr(i,k,it) = 0.0 
-              ENDDO
-           ENDDO
-       ENDDO
-c
-c tendance des aerosols nuclees et impactes 
-c
-       DO it = 1, nqmax
-         IF (aerosol(it)) THEN
-           DO k = 1, nlev
-              DO i = 1, klon
-               d_tr_lessi_nucl(i,k,it) = d_tr_lessi_nucl(i,k,it) +
-     s                  ( 1 - frac_nucl(i,k) )*tr_seri(i,k,it)
-               d_tr_lessi_impa(i,k,it) = d_tr_lessi_impa(i,k,it) +
-     s                  ( 1 - frac_impa(i,k) )*tr_seri(i,k,it)
-              ENDDO
-           ENDDO
-         ENDIF
-       ENDDO
-c
-c Mises a jour des traceurs + calcul des flux de lessivage 
-c Mise a jour due a l'impaction et a la nucleation
-c
-c      call dump2d(iim,jjm-1,frac_impa(2:klon-1,10),'FRACIMPA')
-c      call dump2d(iim,jjm-1,frac_nucl(2:klon-1,10),'FRACNUCL')
-c      call dump2d(iim,jjm-1,tr_seri(2:klon-1,10,3),'TRACEUR3')
-       DO it = 1, nqmax
-c         print*,'IT=',it,aerosol(it)
-         IF (aerosol(it)) THEN
-c           print*,'IT=',it,' On lessive'
-           DO k = 1, nlev
-              DO i = 1, klon
-               tr_seri(i,k,it)=tr_seri(i,k,it)
-     s         *frac_impa(i,k)*frac_nucl(i,k)
-              ENDDO
-           ENDDO
-         ENDIF
-       ENDDO
-c      call dump2d(iim,jjm-1,tr_seri(2:klon-1,10,3),'TRACEUR3B')
-c
-c Flux lessivage total 
-c
-      DO it = 1, nqmax
-           DO k = 1, nlev
-            DO i = 1, klon
-               flestottr(i,k,it) = flestottr(i,k,it) -
-     s                   ( d_tr_lessi_nucl(i,k,it)   +
-     s                     d_tr_lessi_impa(i,k,it) ) *
-     s                   ( paprs(i,k)-paprs(i,k+1) ) / 
-     s                   (RG * pdtphys)
-            ENDDO
-           ENDDO
-c
-Cmaf suppression provisoire
-Cmaf        WRITE(itn,'(i1)') it
-Cmaf    CALL minmaxqfi(tr_seri(1,1,it),0.,1.e33,'tr(lessi) it='//itn)
-      ENDDO
-c
-c     print*,'apres lessivage'
-      ENDIF
-Cc
-      DO k = 1, nlev
-         DO i = 1, klon
-            fluxrn(i,k) = flestottr(i,k,1)
-            fluxpb(i,k) = flestottr(i,k,2)
-            rn(i,k) = tr_seri(i,k,1)
-            pb(i,k) = tr_seri(i,k,2)
-            pbnucl(i,k)=d_tr_lessi_nucl(i,k,2)
-            pbimpa(i,k)=d_tr_lessi_impa(i,k,2)
-         ENDDO
-      ENDDO
-
-
-
-      itra=itra+1
-      ndex(1) = 0
-
-      i = NINT(zout/zsto)
-      CALL gr_fi_ecrit(1, klon,iim,jjm+1, paire,zx_tmp_2d)
-      CALL histwrite(nid_tra,"aire",itra,zx_tmp_2d,
-     .     iim*(jjm+1),ndex)
-
-#ifdef INCA
-      CALL gr_fi_ecrit(1, klon,iim,jjm+1, ps,zx_tmp_2d)
-      CALL histwrite(nid_tra,"ps",itra,zx_tmp_2d,
-     .     iim*(jjm+1),ndex)
-
-      CALL gr_fi_ecrit(1, klon,iim,jjm+1, ptrop,zx_tmp_2d)
-      CALL histwrite(nid_tra,"ptrop",itra,zx_tmp_2d,
-     .     iim*(jjm+1),ndex)
-
-      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,t_seri, zx_tmp_3d)
-      CALL histwrite(nid_tra,"temp",itra,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-
-      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,u, zx_tmp_3d)
-      CALL histwrite(nid_tra,"u",itra,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-
-      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,v, zx_tmp_3d)
-      CALL histwrite(nid_tra,"v",itra,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-
-      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,sh, zx_tmp_3d)
-      CALL histwrite(nid_tra,"h2o",itra,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-
-      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pdel, zx_tmp_3d)
-      CALL histwrite(nid_tra,"pdel",itra,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-
-      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pplay, zx_tmp_3d)
-      CALL histwrite(nid_tra,"pmid",itra,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-
-#ifdef INCA_CH4
-#ifdef INCAINFO
-      DO it=1, phtcnt
-      WRITE(str2,'(i2.2)') it
-      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,jrates(1,1,it),
-     .     zx_tmp_3d)
-      CALL histwrite(nid_tra,"j"//str2,itra,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-      ENDDO
-
-      DO it=1, hetcnt
-      WRITE(str2,'(i2.2)') it
-      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,hrates(1,1,it),
-     .     zx_tmp_3d)
-      CALL histwrite(nid_tra,"w"//str2,itra,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-      ENDDO
-
- 
-      DO it=1, extcnt
-      WRITE(str2,'(i2.2)') it
-
-
-      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,extflx(1,1,it),
-     .     zx_tmp_3d)
-      CALL histwrite(nid_tra,"ext"//str2,itra,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-      ENDDO
-
-      DO it=1, nfs
-      WRITE(str2,'(i2.2)') it
-      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,invariants(1,1,it),
-     .     zx_tmp_3d)
-      CALL histwrite(nid_tra,"INV"//str2,itra,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-      ENDDO
-
-
-#else
-      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,jrates(1,1,2),
-     .     zx_tmp_3d)
-      CALL histwrite(nid_tra,"jO3",itra,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-
-      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,jrates(1,1,4),
-     .     zx_tmp_3d)
-      CALL histwrite(nid_tra,"jNO2",itra,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-
-      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,jrates(1,1,13),
-     .     zx_tmp_3d)
-      CALL histwrite(nid_tra,"jH2O2",itra,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-
-      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,hrates(1,1,1),
-     .     zx_tmp_3d)
-      CALL histwrite(nid_tra,"wHNO3",itra,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-
-      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,krates(1,1,1),
-     .     zx_tmp_3d)
-      CALL histwrite(nid_tra,"kN2O5",itra,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-
-      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,extflx(1,1,1),
-     .     zx_tmp_3d)
-      CALL histwrite(nid_tra,"LghtNO",itra,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-#endif
-      DO it=1, grpcnt
-      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,nas(1,1,it),zx_tmp_3d)
-      zx_tmp_3d = zx_tmp_3d * dry_mass / nadv_mass(it)
-      CALL histwrite(nid_tra,grpsym(it),itra,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-      ENDDO
-#endif
-
-#endif
-#ifdef INCA_AER
-C   3d FIELDS
-
-      it = id_CIDUSTM
-       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,scavcoef_st(1,1,it),
-     .                  zx_tmp_3d)
-       CALL histwrite(nid_tra,"scavcoef_st",itra,zx_tmp_3d,
-     .                  iim*(jjm+1)*klev,ndex)
-
-       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,scavcoef_cv(1,1,it),
-     .                  zx_tmp_3d)
-       CALL histwrite(nid_tra,"scavcoef_cv",itra,zx_tmp_3d,
-     .                  iim*(jjm+1)*klev,ndex)
-
-#endif 
-
-      DO it=1,nqmax
-      IF (it.LE.99) THEN
-       WRITE(str2,'(i2.2)') it
-
-#ifdef INCA
-      IF ( prt_flag_ts(it) == 0 ) CYCLE
-C champs 2D
-      CALL gr_fi_ecrit(1, klon,iim,jjm+1, eflux(1,it),zx_tmp_2d)
-      CALL histwrite(nid_tra,"Emi_"//solsym(it),itra,zx_tmp_2d,
-     .     iim*(jjm+1),ndex)
-
-      CALL gr_fi_ecrit(1, klon,iim,jjm+1, dvel(1,it),zx_tmp_2d)
-      CALL histwrite(nid_tra,"Dep_"//solsym(it),itra,zx_tmp_2d,
-     .     iim*(jjm+1),ndex)
-#ifdef INCA_AER
-        IF (solsym(it) .eq. 'CIDUSTM'.or.solsym(it) .eq. 'CIN'
-     .  .or.solsym(it) .eq. 'CSSSM'  .or.solsym(it) .eq. 'CSN'
-     .  .or.solsym(it) .eq. 'ASSSM'  .or.solsym(it) .eq. 'ASN' ) THEN
-      CALL gr_fi_ecrit(1, klon,iim,jjm+1,sflux(1,it),zx_tmp_2d)
-      CALL histwrite(nid_tra,"Sed_"//solsym(it),itra,zx_tmp_2d,
-     .     iim*(jjm+1),ndex)
-        endif
-        IF (solsym(it) .eq. 'CIDUSTM') THEN
-      CALL gr_fi_ecrit(1, klon,iim,jjm+1,tausum(1),zx_tmp_2d)
-      CALL histwrite(nid_tra,"OD_"//solsym(it),itra,zx_tmp_2d,
-     .     iim*(jjm+1),ndex)
-        endif
-
-#endif 
-C champs 3D
-       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,tr_seri(1,1,it),zx_tmp_3d)
-
-       !Prefer vmr to mmr for transported species
-       if( adv_mass(it) /= 0. ) then
-       zx_tmp_3d = zx_tmp_3d * dry_mass / adv_mass(it)
-       else
-#ifdef INCA_CH4
-       if ( solsym(it) == 'OX' ) then
-       zx_tmp_3d = zx_tmp_3d * dry_mass / nadv_mass(id_o3)
-       end if
-#endif
-       end if
-
-       CALL histwrite(nid_tra,solsym(it),itra,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-#else
-
-C champs 3D
-       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,tr_seri(1,1,it),zx_tmp_3d)
-       CALL histwrite(nid_tra,"tr"//str2,itra,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-       IF (lessivage) THEN
-       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,flestottr(1,1,it),zx_tmp_3d)
-       CALL histwrite(nid_tra,"fl"//str2,itra,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-       ENDIF
-#endif
-      ELSE
-         PRINT*, "Trop de traceurs"
-         CALL abort
-      ENDIF
-      ENDDO
-
-#ifdef INCA_CH4
-      CALL gr_fi_ecrit(1, klon,iim,jjm+1, o3_tr_col(1), zx_tmp_2d)
-      CALL histwrite(nid_tra,"O3_column",itra,zx_tmp_2d,
-     .     iim*(jjm+1),ndex)
-
-      CALL gr_fi_ecrit(1, klon,iim,jjm+1, co_tr_col(1), zx_tmp_2d)
-      CALL histwrite(nid_tra,"CO_column",itra,zx_tmp_2d,
-     .     iim*(jjm+1),ndex)
-
-      CALL gr_fi_ecrit(1, klon,iim,jjm+1, ch4_tr_col(1), zx_tmp_2d)
-      CALL histwrite(nid_tra,"CH4_column",itra,zx_tmp_2d,
-     .     iim*(jjm+1),ndex)
-
-      CALL gr_fi_ecrit(1, klon,iim,jjm+1, no2_tr_col(1), zx_tmp_2d)
-      CALL histwrite(nid_tra,"NO2_column",itra,zx_tmp_2d,
-     .     iim*(jjm+1),ndex)
-
-      CALL gr_fi_ecrit(1, klon,iim,jjm+1, o3_st_flx(1), zx_tmp_2d)
-      CALL histwrite(nid_tra,"O3_ste",itra,zx_tmp_2d,
-     .     iim*(jjm+1),ndex)
-
-      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,o3_prod(1,1),
-     .     zx_tmp_3d)
-      CALL histwrite(nid_tra,"O3_prod",itra,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-
-      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,o3_loss(1,1),
-     .     zx_tmp_3d)
-      CALL histwrite(nid_tra,"O3_loss",itra,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-
-!     ... Special section for daytime averaging
-!       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,day_cnt(1,1),
-!    .       zx_tmp_3d)
-!       CALL histwrite(nid_tra,"day_cnt",itra,zx_tmp_3d,
-!    .                                  iim*(jjm+1)*klev,ndex)
-!       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,no_daytime(1,1),
-!    .       zx_tmp_3d)
-!       CALL histwrite(nid_tra,"NO_day",itra,zx_tmp_3d,
-!    .                                  iim*(jjm+1)*klev,ndex)
-
-#endif
-
-      if (ok_sync) call histsync(nid_tra)
-
-      if (lafin) then
-!DH      print*, 'c est la fin de la physique'
-         open (99,file='restarttrac',  form='formatted')
-         do i=1,klon
-             write(99,*) trs(i,1)
-         enddo
-         PRINT*, 'Ecriture du fichier restarttrac'
-         close(99)
-      else
-!DH      print*, 'physique pas fini'
-      endif
-
-
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/plevel.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/plevel.F	(revision 416)
+++ 	(revision )
@@ -1,114 +1,0 @@
-c================================================================
-c================================================================
-      SUBROUTINE plevel(ilon,ilev,lnew,pgcm,pres,Qgcm,Qpres)
-c================================================================
-c================================================================
-
-      IMPLICIT none
-
-#include "dimensions.h"
-#include "dimphy.h"
-
-c================================================================
-c
-c Interpoler des champs 3-D u, v et g du modele a un niveau de
-c pression donnee (pres)
-c
-c INPUT:  ilon ----- nombre de points
-c         ilev ----- nombre de couches
-c         lnew ----- true si on doit reinitialiser les poids
-c         pgcm ----- pressions modeles
-c         pres ----- pression vers laquelle on interpolle
-c         Qgcm ----- champ GCM
-c         Qpres ---- champ interpolle au niveau pres
-c
-c================================================================
-c
-c   arguments :
-c   -----------
-
-      INTEGER ilon, ilev
-      logical lnew
-
-      REAL pgcm(ilon,ilev)
-      REAL Qgcm(ilon,ilev)
-      real pres
-      REAL Qpres(ilon)
-
-c   local :
-c   -------
-
-      INTEGER lt(klon), lb(klon)
-      REAL ptop, pbot, aist(klon), aisb(klon)
-
-      save lt,lb,ptop,pbot,aist,aisb
-
-      INTEGER i, k
-c
-
-c=====================================================================
-      if (lnew) then
-c   on réinitialise les réindicages et les poids
-c=====================================================================
-
-
-c Chercher les 2 couches les plus proches du niveau a obtenir
-c
-c Eventuellement, faire l'extrapolation a partir des deux couches
-c les plus basses ou les deux couches les plus hautes:
-      DO 130 i = 1, klon
-         IF ( ABS(pres-pgcm(i,ilev) ) .LT.
-     .        ABS(pres-pgcm(i,1)) ) THEN
-            lt(i) = ilev     ! 2
-            lb(i) = ilev-1   ! 1
-         ELSE
-            lt(i) = 2
-            lb(i) = 1
-         ENDIF
-  130 CONTINUE
-      DO 150 k = 1, ilev-1
-         DO 140 i = 1, klon
-            pbot = pgcm(i,k)
-            ptop = pgcm(i,k+1)
-            IF (ptop.LE.pres .AND. pbot.GE.pres) THEN
-               lt(i) = k+1
-               lb(i) = k
-            ENDIF
-  140    CONTINUE
-  150 CONTINUE
-c
-c Interpolation lineaire:
-c
-      DO i = 1, klon
-c interpolation en logarithme de pression:
-c
-c ...   Modif . P. Le Van    ( 20/01/98) ....
-c       Modif Frédéric Hourdin (3/01/02)
-
-        aist(i) = LOG( pgcm(i,lb(i))/ pres )
-     .       / LOG( pgcm(i,lb(i))/ pgcm(i,lt(i)) )
-        aisb(i) = LOG( pres / pgcm(i,lt(i)) )
-     .       / LOG( pgcm(i,lb(i))/ pgcm(i,lt(i)))
-      enddo
-
-
-      endif ! lnew
-
-c======================================================================
-c    inteprollation
-c======================================================================
-
-      do i=1,klon
-         Qpres(i)= Qgcm(i,lb(i))*aisb(i)+Qgcm(i,lt(i))*aist(i)
-      enddo
-c
-c Je mets les vents a zero quand je rencontre une montagne
-      do i = 1, klon
-         if (pgcm(i,1).LT.pres) THEN
-            Qpres(i)=1e33
-         endif
-      enddo
-
-c
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/printflag.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/printflag.F	(revision 416)
+++ 	(revision )
@@ -1,190 +1,0 @@
-       SUBROUTINE  printflag( tabcntr0, radpas, ok_ocean,ok_oasis,
-     ,                        ok_journe,ok_instan,ok_region        )
-c
-
-c
-c      Auteur :  P. Le Van 
-
-       IMPLICIT NONE
-
-       REAL tabcntr0( 100 )
-       LOGICAL cycle_diurn0,soil_model0,new_oliq0,ok_orodr0
-       LOGICAL ok_orolf0,ok_limitvr0
-       LOGICAL ok_ocean,ok_oasis,ok_journe,ok_instan,ok_region
-       INTEGER radpas , radpas0
-c
-#include "clesphys.h"
-c
-c
-       PRINT 100
-       PRINT *,' *******************************************************
-     ,************'
-       PRINT *,' ********   Choix  des principales  cles de la physique 
-     ,   *********'
-       PRINT *,' *******************************************************
-     ,************'
-       PRINT 100
-       PRINT 10, cycle_diurne,  soil_model  
-       PRINT 100
-
-       IF   (    iflag_con.EQ. 1 )   THEN
-           PRINT *,' *****           Shema  convection   LMD            
-     ,          ******'
-       ELSE IF ( iflag_con.EQ. 2 )   THEN
-           PRINT *,' *****           Shema  convection  Tiedtke  
-     ,          ******'
-       ELSE IF ( iflag_con.EQ. 3 )   THEN
-           PRINT *,' *****   Shema  convection Emanuel version LMD
-     ,          ******'
-       ELSE IF ( iflag_con.EQ. 4 )   THEN
-           PRINT *,' *****   Shema  convection Emanuel version 4vec
-     ,          ******'
-       ENDIF
-       PRINT 100
-
-       PRINT 11, new_oliq, ok_orodr, ok_orolf   
-       PRINT 100
-
-       PRINT 7,  ok_limitvrai   
-       PRINT 100
-
-       PRINT 12, nbapp_rad
-       PRINT 100
-
-       PRINT 8, radpas
-       PRINT 100
-
-       PRINT 5,  ok_ocean,ok_oasis
-       PRINT 100
-
-       PRINT 4,ok_journe,ok_instan,ok_region
-       PRINT 100
-       PRINT 100
-c
-c
-        cycle_diurn0  = .FALSE.
-        soil_model0   = .FALSE.
-        new_oliq0     = .FALSE.
-        ok_orodr0     = .FALSE.
-        ok_orolf0     = .FALSE.
-        ok_limitvr0   = .FALSE.
-
-        IF( tabcntr0( 7 ).EQ. 1. )   cycle_diurn0 = .TRUE.
-        IF( tabcntr0( 8 ).EQ. 1. )    soil_model0 = .TRUE.
-        IF( tabcntr0( 9 ).EQ. 1. )      new_oliq0 = .TRUE.
-        IF( tabcntr0(10 ).EQ. 1. )      ok_orodr0 = .TRUE.
-        IF( tabcntr0(11 ).EQ. 1. )      ok_orolf0 = .TRUE.
-        IF( tabcntr0(12 ).EQ. 1. )    ok_limitvr0 = .TRUE.
-
-        PRINT *,' $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
-     ,$$$$$$$$$$$$$'
-        PRINT 100
-c
-       IF( INT( tabcntr0( 5 ) ) .NE. iflag_con  )   THEN
-        PRINT 20, INT(tabcntr0(5)), iflag_con
-        PRINT 100
-       ENDIF
-
-       IF( INT( tabcntr0( 6 ) ) .NE. nbapp_rad  )   THEN
-        PRINT 21,  INT(tabcntr0(6)), nbapp_rad
-        radpas0  = NINT( 86400./tabcntr0(1)/INT( tabcntr0(6) ) )
-        PRINT 100
-        PRINT 22, radpas0, radpas
-        PRINT 100
-       ENDIF
-
-       IF( cycle_diurn0.AND..NOT.cycle_diurne.OR..NOT.cycle_diurn0.AND.
-     ,        cycle_diurne )     THEN
-        PRINT 13, cycle_diurn0, cycle_diurne
-        PRINT 100
-       ENDIF
-
-       IF( soil_model0.AND..NOT.soil_model.OR..NOT.soil_model0.AND.
-     ,        soil_model )     THEN
-        PRINT 14, soil_model0, soil_model
-        PRINT 100
-       ENDIF
-
-       IF( new_oliq0.AND..NOT.new_oliq.OR..NOT.new_oliq0.AND.
-     ,        new_oliq )     THEN
-        PRINT 16, new_oliq0, new_oliq
-        PRINT 100
-       ENDIF
-
-       IF( ok_orodr0.AND..NOT.ok_orodr.OR..NOT.ok_orodr0.AND.
-     ,        ok_orodr )     THEN
-        PRINT 15, ok_orodr0, ok_orodr
-        PRINT 100
-       ENDIF
-
-       IF( ok_orolf0.AND..NOT.ok_orolf.OR..NOT.ok_orolf0.AND.
-     ,        ok_orolf )     THEN
-        PRINT 17, ok_orolf0, ok_orolf
-        PRINT 100
-       ENDIF
-
-       IF( ok_limitvr0.AND..NOT.ok_limitvrai.OR..NOT.ok_limitvr0.
-     ,     AND.ok_limitvrai )     THEN
-        PRINT 18, ok_limitvr0, ok_limitvrai
-        PRINT 100
-       ENDIF
-
-       PRINT 100
-       PRINT *,' *******************************************************
-     ,************'
-       PRINT 100
-
- 4    FORMAT(2x,5(1H*),'  ok_journe= ',l3,3x,',ok_instan = ',
-     , l3,3x,',ok_region = ',l3,3x,5(1H*) )
-
- 5    FORMAT(2x,5(1H*),'      ok_ocean = ',l3,6x,' , ok_oasis = ',
-     , l3,14x,5(1H*) )
-
-
- 7     FORMAT(2x,5(1H*),15x,'      ok_limitvrai   = ',l3,16x,5(1h*) )
-
- 8     FORMAT(2x,'*****             radpas    =                      ' ,
-     , i4,6x,' *****')
-
- 10    FORMAT(2x,5(1H*),'    Cycle_diurne = ',l3,4x,', Soil_model = ',
-     , l3,12x,6(1H*) )
-
-
- 11    FORMAT(2x,5(1H*),'  new_oliq = ',l3,3x,', Ok_orodr = ',
-     , l3,3x,', Ok_orolf = ',l3,3x,5(1H*) )
-
-
- 12    FORMAT(2x,'*****  Nb d appels /jour des routines de rayonn. = ' ,
-     , i4,6x,' *****')
-
- 13    FORMAT(2x,'$$$$$$$$   Attention !!  cycle_diurne  different  sur',
-     , /1x,10x,' startphy = ',l3,2x,' et  run.def = ',l3)
-
- 14    FORMAT(2x,'$$$$$$$$   Attention !!    soil_model  different  sur',
-     , /1x,10x,' startphy = ',l3,2x,' et  run.def = ',l3)
-
- 15    FORMAT(2x,'$$$$$$$$   Attention !!      ok_orodr  different  sur',
-     , /1x,10x,' startphy = ',l3,2x,' et  run.def = ',l3)
-
- 16    FORMAT(2x,'$$$$$$$$   Attention !!      new_oliq  different  sur',
-     , /1x,10x,' startphy = ',l3,2x,' et  run.def = ',l3)
-
- 17    FORMAT(2x,'$$$$$$$$   Attention !!      ok_orolf  different  sur',
-     , /1x,10x,' startphy = ',l3,2x,' et  run.def = ',l3)
-
- 18    FORMAT(2x,'$$$$$$$$   Attention !!  ok_limitvrai  different  sur',
-     , /1x,10x,' startphy = ',l3,2x,' et  run.def = ',l3)
-
- 20    FORMAT(/2x,'$$$$$$$$   Attention !!    iflag_con  different  sur',
-     , /1x,10x,' startphy = ',i3,2x,' et  run.def = ',i3 )
-
- 21    FORMAT(2x,'$$$$$$$$   Attention !!     nbapp_rad  different  sur',
-     , /1x,10x,' startphy = ',i3,2x,' et  run.def = ',i3 )
-
- 22    FORMAT(2x,'$$$$$$$$   Attention !!        radpas  different  sur',
-     , /1x,10x,' startphy = ',i3,2x,' et  run.def = ',i3 )
-
- 100   FORMAT(/)
-
-       RETURN
-       END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/raddim.160.98.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/raddim.160.98.h	(revision 416)
+++ 	(revision )
@@ -1,2 +1,0 @@
-      INTEGER kdlon, kflev
-      PARAMETER (kdlon=78,kflev=klev) ! 78*199
Index: LMDZ.3.3/branches/rel-/libf/phylmd/raddim.192.143.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/raddim.192.143.h	(revision 416)
+++ 	(revision )
@@ -1,2 +1,0 @@
-       INTEGER kdlon, kflev
-      PARAMETER (kdlon=10,kflev=klev)
Index: LMDZ.3.3/branches/rel-/libf/phylmd/raddim.32.24.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/raddim.32.24.h	(revision 416)
+++ 	(revision )
@@ -1,2 +1,0 @@
-      INTEGER kdlon, kflev
-      PARAMETER (kdlon=klon,kflev=klev)
Index: LMDZ.3.3/branches/rel-/libf/phylmd/raddim.48.32.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/raddim.48.32.h	(revision 416)
+++ 	(revision )
@@ -1,2 +1,0 @@
-      INTEGER kdlon, kflev
-      PARAMETER (kdlon=149,kflev=klev)
Index: LMDZ.3.3/branches/rel-/libf/phylmd/raddim.72.46.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/raddim.72.46.h	(revision 416)
+++ 	(revision )
@@ -1,2 +1,0 @@
-      INTEGER kdlon, kflev
-      PARAMETER (kdlon=1621,kflev=klev)
Index: LMDZ.3.3/branches/rel-/libf/phylmd/raddim.96.72.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/raddim.96.72.h	(revision 416)
+++ 	(revision )
@@ -1,2 +1,0 @@
-      INTEGER kdlon, kflev
-      PARAMETER (kdlon=487,kflev=klev)
Index: LMDZ.3.3/branches/rel-/libf/phylmd/raddim.defaut.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/raddim.defaut.h	(revision 416)
+++ 	(revision )
@@ -1,2 +1,0 @@
-      INTEGER kdlon, kflev
-      PARAMETER (kdlon=klon,kflev=klev)
Index: LMDZ.3.3/branches/rel-/libf/phylmd/raddim.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/raddim.h	(revision 416)
+++ 	(revision )
@@ -1,16 +1,0 @@
-      INTEGER kdlon, kflev
-c
-ccc      PARAMETER (kdlon=klon,kflev=klev)
-c
-c resolution 72 45:
-      PARAMETER (kdlon=317,kflev=klev)
-c resolution 64 32:
-ccc      PARAMETER (kdlon=331,kflev=klev)
-c resolution 96 49:
-ccc      PARAMETER (kdlon=461,kflev=klev)
-c resolution 144 73:
-ccc      PARAMETER (kdlon=610,kflev=klev)
-c resolution 96 72:
-c      PARAMETER (kdlon=487,kflev=klev)
-c resolution 128 64:
-ccc       PARAMETER (kdlon=4033,kflev=klev)
Index: LMDZ.3.3/branches/rel-/libf/phylmd/raddimlw.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/raddimlw.h	(revision 416)
+++ 	(revision )
@@ -1,8 +1,0 @@
-      INTEGER NUA
-      PARAMETER (NUA=24)
-      INTEGER NTRA
-      PARAMETER (NTRA=15)
-      INTEGER Ninter
-      PARAMETER (Ninter=6)
-      INTEGER NG1, NG1P1
-      PARAMETER (NG1=2, NG1P1=NG1+1)
Index: LMDZ.3.3/branches/rel-/libf/phylmd/radepsi.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/radepsi.h	(revision 416)
+++ 	(revision )
@@ -1,13 +1,0 @@
-      REAL*8 ZEELOG, ZEPSC, ZEPSCO, ZEPSCQ, ZEPSCT, ZEPSCW
-      REAL*8 ZEPSEC, ZEPSCR
-      PARAMETER (ZEELOG = 1.E-07) !1.e-10 (not good for 32-bit machines)
-      PARAMETER (ZEPSC  = 1.E-20)
-      PARAMETER (ZEPSCO = 1.E-10)
-      PARAMETER (ZEPSCQ = 1.E-10)
-      PARAMETER (ZEPSCT = 1.E-20)
-      PARAMETER (ZEPSCW = 1.E-20)
-      PARAMETER (ZEPSEC = 1.0E-12)
-      PARAMETER (ZEPSCR = 1.0E-10)
-c
-      REAL*8 REPSCT
-      PARAMETER (REPSCT=1.0E-10)
Index: LMDZ.3.3/branches/rel-/libf/phylmd/radiornpb.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/radiornpb.F	(revision 416)
+++ 	(revision )
@@ -1,50 +1,0 @@
-      SUBROUTINE radiornpb(tr,dtime,tautr,d_tr) 
-      IMPLICIT none
-c======================================================================
-c Auteur(s): AA + CG (LGGE/CNRS) Date 24-06-94
-c Objet: Decroissance radioactive d'un traceur dans l'atmosphere
-CG240694 : Pour un traceur, le radon
-CG161294 : Plus un 2eme traceur, le 210Pb. Le radon decroit en plomb.
-c======================================================================
-c Arguments:
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-c======================================================================
-C
-      INTEGER i , k , it
-      REAL tr(klon,klev,nbtr) , d_tr(klon,klev,nbtr)
-      REAL dtime
-      REAL tautr(nbtr)
-C
-      WRITE(*,'(''PASSAGE radiornpb ... '',$)')
-C Attention, pour un pas de temps beaucoup plus petit que la decroissance!!!
-
-      DO it = 1,2
-           IF ( tautr(it) .GT. 0. ) THEN
-          	DO k = 1,klev
-                DO i = 1,klon
-                d_tr(i,k,it) = - tr(i,k,it) * dtime / tautr(it)
-                END DO
-                END DO
-           ELSE
-                DO k = 1,klev
-                DO i = 1,klon
-                d_tr(i,k,it) = 0.
-                END DO
-                END DO
-           END IF
-      END DO
-C
-CG161294 : Cas particulier radon 1 => plomb 2
-c
-      DO k = 1,klev
-        DO i = 1,klon
-          d_tr(i,k,2) = d_tr(i,k,2) - d_tr(i,k,1)
-        ENDDO
-      ENDDO
-c
-      WRITE(*,*) ' radiornpb OK'
-c
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/radlwsw.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/radlwsw.F	(revision 416)
+++ 	(revision )
@@ -1,6144 +1,0 @@
-      SUBROUTINE radlwsw(dist, rmu0, fract, co2_ppm, solaire,
-     .                  paprs, pplay,tsol,albedo, t,q,wo,
-     .                  cldfra, cldemi, cldtau,
-     .                  heat,heat0,cool,cool0,radsol,albpla,
-     .                  topsw,toplw,solsw,sollw,
-     .                  topsw0,toplw0,solsw0,sollw0)
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719
-c Objet: interface entre le modele et les rayonnements
-c Arguments:
-c dist-----input-R- distance astronomique terre-soleil
-c rmu0-----input-R- cosinus de l'angle zenithal
-c fract----input-R- duree d'ensoleillement normalisee
-c co2_ppm--input-R- concentration du gaz carbonique (en ppm)
-c solaire--input-R- constante solaire (W/m**2)
-c paprs----input-R- pression a inter-couche (Pa)
-c pplay----input-R- pression au milieu de couche (Pa)
-c tsol-----input-R- temperature du sol (en K)
-c albedo---input-R- albedo du sol (entre 0 et 1)
-c t--------input-R- temperature (K)
-c q--------input-R- vapeur d'eau (en kg/kg)
-c wo-------input-R- contenu en ozone (en cm.atm)
-c cldfra---input-R- fraction nuageuse (entre 0 et 1)
-c cldtau---input-R- epaisseur optique des nuages dans le visible
-c cldemi---input-R- emissivite des nuages dans l'IR (entre 0 et 1)
-c
-c heat-----output-R- echauffement atmospherique (visible) (K/jour)
-c cool-----output-R- refroidissement dans l'IR (K/jour)
-c radsol---output-R- bilan radiatif net au sol (W/m**2) (+ vers le bas)
-c albpla---output-R- albedo planetaire (entre 0 et 1)
-c topsw----output-R- ray. solaire absorbe au sommet de l'atm.
-c toplw----output-R- ray. IR emis au sommet de l'atmosphere
-c solsw----output-R- ray. solaire net absorbe a la surface
-c sollw----output-R- ray. IR net emis par la surface
-c======================================================================
-#include "dimensions.h"
-#include "dimphy.h"
-#include "raddim.h"
-c
-      real rmu0(klon), fract(klon), dist
-      real co2_ppm
-      real solaire
-c
-      real paprs(klon,klev+1), pplay(klon,klev)
-      real albedo(klon), tsol(klon)
-      real t(klon,klev), q(klon,klev), wo(klon,klev)
-      real cldfra(klon,klev), cldemi(klon,klev), cldtau(klon,klev)
-      real heat(klon,klev), cool(klon,klev)
-      real heat0(klon,klev), cool0(klon,klev)
-      real radsol(klon), topsw(klon), toplw(klon)
-      real solsw(klon), sollw(klon), albpla(klon)
-      real topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
-c
-      REAL*8 zx_alpha1, zx_alpha2
-c
-#include "YOMCST.h"
-c
-      INTEGER k, kk, i, j, iof, nb_gr
-      EXTERNAL lw, sw
-c
-      REAL*8 RCO2, RCH4, RN2O, RCFC11, RCFC12
-      REAL*8 PSCT
-c
-      REAL*8 PALBD(kdlon,2), PALBP(kdlon,2)
-      REAL*8 PEMIS(kdlon), PDT0(kdlon), PVIEW(kdlon)
-      REAL*8 PPSOL(kdlon), PDP(kdlon,klev)
-      REAL*8 PTL(kdlon,kflev+1), PPMB(kdlon,kflev+1)
-      REAL*8 PTAVE(kdlon,kflev)
-      REAL*8 PWV(kdlon,kflev), PQS(kdlon,kflev), POZON(kdlon,kflev)
-      REAL*8 PAER(kdlon,kflev,5)
-      REAL*8 PCLDLD(kdlon,kflev)
-      REAL*8 PCLDLU(kdlon,kflev)
-      REAL*8 PCLDSW(kdlon,kflev)
-      REAL*8 PTAU(kdlon,2,kflev)
-      REAL*8 POMEGA(kdlon,2,kflev)
-      REAL*8 PCG(kdlon,2,kflev)
-c
-      REAL*8 zfract(kdlon), zrmu0(kdlon), zdist
-c
-      REAL*8 zheat(kdlon,kflev), zcool(kdlon,kflev)
-      REAL*8 zheat0(kdlon,kflev), zcool0(kdlon,kflev)
-      REAL*8 ztopsw(kdlon), ztoplw(kdlon)
-      REAL*8 zsolsw(kdlon), zsollw(kdlon), zalbpla(kdlon)
-      REAL*8 ztopsw0(kdlon), ztoplw0(kdlon)
-      REAL*8 zsolsw0(kdlon), zsollw0(kdlon)
-
-c
-c-------------------------------------------
-      nb_gr = klon / kdlon
-      IF (nb_gr*kdlon .NE. klon) THEN
-         PRINT*, "kdlon mauvais:", klon, kdlon, nb_gr
-         CALL abort
-      ENDIF
-      IF (kflev .NE. klev) THEN
-          PRINT*, "kflev differe de klev, kflev, klev"
-          CALL abort
-      ENDIF
-c-------------------------------------------
-      DO k = 1, klev
-      DO i = 1, klon
-         heat(i,k)=0.
-         cool(i,k)=0.
-         heat0(i,k)=0.
-         cool0(i,k)=0.
-      ENDDO
-      ENDDO
-c
-      zdist = dist
-c
-      RCO2 = co2_ppm * 1.0e-06  * 44.011/28.97
-      RCH4 = 1.72E-06* 16.043/28.97
-      RN2O = 310.E-09* 44.013/28.97
-      RCFC11 = 280.E-12* 137.3686/28.97
-      RCFC12 = 484.E-12* 120.9140/28.97
-      PSCT = solaire/zdist/zdist
-c
-      DO 99999 j = 1, nb_gr
-      iof = kdlon*(j-1)
-c
-      DO i = 1, kdlon
-         zfract(i) = fract(iof+i)
-         zrmu0(i) = rmu0(iof+i)
-         PALBD(i,1) = albedo(iof+i)
-         PALBD(i,2) = albedo(iof+i)
-         PALBP(i,1) = albedo(iof+i)
-         PALBP(i,2) = albedo(iof+i)
-         PEMIS(i) = 0.96
-         PVIEW(i) = 1.66
-         PPSOL(i) = paprs(iof+i,1)
-         zx_alpha1 = (paprs(iof+i,1)-pplay(iof+i,2)) 
-     .             / (pplay(iof+i,1)-pplay(iof+i,2))
-         zx_alpha2 = 1.0 - zx_alpha1
-         PTL(i,1) = t(iof+i,1) * zx_alpha1 + t(iof+i,2) * zx_alpha2
-         PTL(i,klev+1) = t(iof+i,klev)
-         PDT0(i) = tsol(iof+i) - PTL(i,1)
-      ENDDO
-      DO k = 2, kflev
-      DO i = 1, kdlon
-         PTL(i,k) = (t(iof+i,k)+t(iof+i,k-1))*0.5
-      ENDDO
-      ENDDO
-      DO k = 1, kflev
-      DO i = 1, kdlon
-         PDP(i,k) = paprs(iof+i,k)-paprs(iof+i,k+1)
-         PTAVE(i,k) = t(iof+i,k)
-         PWV(i,k) = MAX (q(iof+i,k), 1.0e-12)
-         PQS(i,k) = PWV(i,k)
-c wo:    cm.atm (epaisseur en cm dans la situation standard)
-c POZON: kg/kg
-         POZON(i,k) = MAX(wo(iof+i,k),1.0e-12)*RG/46.6968
-     .               /(paprs(iof+i,k)-paprs(iof+i,k+1))
-     .               *(paprs(iof+i,1)/101325.0)
-         PCLDLD(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k)
-         PCLDLU(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k)
-         PCLDSW(i,k) = cldfra(iof+i,k)
-         PTAU(i,1,k) = MAX(cldtau(iof+i,k), 1.0e-05)! 1e-12 serait instable
-         PTAU(i,2,k) = MAX(cldtau(iof+i,k), 1.0e-05)! pour 32-bit machines
-         POMEGA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAU(i,1,k))
-         POMEGA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAU(i,2,k))
-         PCG(i,1,k) = 0.865
-         PCG(i,2,k) = 0.910
-      ENDDO
-      ENDDO
-c
-      DO k = 1, kflev+1
-      DO i = 1, kdlon
-         PPMB(i,k) = paprs(iof+i,k)/100.0
-      ENDDO
-      ENDDO
-c
-      DO kk = 1, 5
-      DO k = 1, kflev
-      DO i = 1, kdlon
-         PAER(i,k,kk) = 1.0E-15
-      ENDDO
-      ENDDO
-      ENDDO
-c
-c======================================================================
-      CALL LW(RCO2,RCH4,RN2O,RCFC11,RCFC12,
-     .        PPMB, PDP,
-     .        PPSOL,PDT0,PEMIS,
-     .        PTL, PTAVE, PWV, POZON, PAER,
-     .        PCLDLD,PCLDLU,
-     .        PVIEW,
-     .        zcool, zcool0,
-     .        ztoplw,zsollw,ztoplw0,zsollw0)
-      CALL SW(PSCT, RCO2, zrmu0, zfract,
-     S        PPMB, PDP,
-     S        PPSOL, PALBD, PALBP,
-     S        PTAVE, PWV, PQS, POZON, PAER,
-     S        PCLDSW, PTAU, POMEGA, PCG,
-     S        zheat, zheat0,
-     S        zalbpla,ztopsw,zsolsw,ztopsw0,zsolsw0)
-c======================================================================
-      DO i = 1, kdlon
-         radsol(iof+i) = zsolsw(i) + zsollw(i)
-         topsw(iof+i) = ztopsw(i)
-         toplw(iof+i) = ztoplw(i)
-         solsw(iof+i) = zsolsw(i)
-         sollw(iof+i) = zsollw(i)
-         topsw0(iof+i) = ztopsw0(i)
-         toplw0(iof+i) = ztoplw0(i)
-         solsw0(iof+i) = zsolsw0(i)
-         sollw0(iof+i) = zsollw0(i)
-         albpla(iof+i) = zalbpla(i)
-      ENDDO
-      DO k = 1, kflev
-      DO i = 1, kdlon
-         heat(iof+i,k) = zheat(i,k)
-         cool(iof+i,k) = zcool(i,k)
-         heat0(iof+i,k) = zheat0(i,k)
-         cool0(iof+i,k) = zcool0(i,k)
-      ENDDO
-      ENDDO
-c
-99999 CONTINUE
-      RETURN
-      END
-      SUBROUTINE SW(PSCT, RCO2, PRMU0, PFRAC, 
-     S              PPMB, PDP, 
-     S              PPSOL, PALBD, PALBP,
-     S              PTAVE, PWV, PQS, POZON, PAER,
-     S              PCLDSW, PTAU, POMEGA, PCG,
-     S              PHEAT, PHEAT0,
-     S              PALBPLA,PTOPSW,PSOLSW,PTOPSW0,PSOLSW0)
-      IMPLICIT none
-
-#include "dimensions.h"
-#include "dimphy.h"
-#include "raddim.h"
-#include "YOMCST.h"
-C
-C     ------------------------------------------------------------------
-C
-C     PURPOSE.
-C     --------
-C
-C          THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO
-C     SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).
-C
-C     METHOD.
-C     -------
-C
-C          1. COMPUTES ABSORBER AMOUNTS                 (SWU)
-C          2. COMPUTES FLUXES IN 1ST SPECTRAL INTERVAL  (SW1S)
-C          3. COMPUTES FLUXES IN 2ND SPECTRAL INTERVAL  (SW2S)
-C
-C     REFERENCE.
-C     ----------
-C
-C        SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
-C        DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
-C
-C     AUTHOR.
-C     -------
-C        JEAN-JACQUES MORCRETTE  *ECMWF*
-C
-C     MODIFICATIONS.
-C     --------------
-C        ORIGINAL : 89-07-14
-C        95-01-01   J.-J. MORCRETTE  Direct/Diffuse Albedo
-C     ------------------------------------------------------------------
-C
-C* ARGUMENTS:
-C
-      REAL*8 PSCT  ! constante solaire (valeur conseillee: 1370)
-      REAL*8 RCO2  ! concentration CO2 (IPCC: 353.E-06*44.011/28.97)
-C
-      REAL*8 PPSOL(KDLON)        ! SURFACE PRESSURE (PA)
-      REAL*8 PDP(KDLON,KFLEV)    ! LAYER THICKNESS (PA)
-      REAL*8 PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
-C
-      REAL*8 PRMU0(KDLON)  ! COSINE OF ZENITHAL ANGLE
-      REAL*8 PFRAC(KDLON)  ! fraction de la journee
-C
-      REAL*8 PTAVE(KDLON,KFLEV)  ! LAYER TEMPERATURE (K)
-      REAL*8 PWV(KDLON,KFLEV)    ! SPECIFIC HUMIDITY (KG/KG)
-      REAL*8 PQS(KDLON,KFLEV)    ! SATURATED WATER VAPOUR (KG/KG)
-      REAL*8 POZON(KDLON,KFLEV)  ! OZONE CONCENTRATION (KG/KG)
-      REAL*8 PAER(KDLON,KFLEV,5) ! AEROSOLS' OPTICAL THICKNESS
-C
-      REAL*8 PALBD(KDLON,2)  ! albedo du sol (lumiere diffuse)
-      REAL*8 PALBP(KDLON,2)  ! albedo du sol (lumiere parallele)
-C
-      REAL*8 PCLDSW(KDLON,KFLEV)    ! CLOUD FRACTION
-      REAL*8 PTAU(KDLON,2,KFLEV)    ! CLOUD OPTICAL THICKNESS
-      REAL*8 PCG(KDLON,2,KFLEV)     ! ASYMETRY FACTOR
-      REAL*8 POMEGA(KDLON,2,KFLEV)  ! SINGLE SCATTERING ALBEDO
-C
-      REAL*8 PHEAT(KDLON,KFLEV) ! SHORTWAVE HEATING (K/DAY)
-      REAL*8 PHEAT0(KDLON,KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky
-      REAL*8 PALBPLA(KDLON)     ! PLANETARY ALBEDO
-      REAL*8 PTOPSW(KDLON)      ! SHORTWAVE FLUX AT T.O.A.
-      REAL*8 PSOLSW(KDLON)      ! SHORTWAVE FLUX AT SURFACE
-      REAL*8 PTOPSW0(KDLON)     ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)
-      REAL*8 PSOLSW0(KDLON)     ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)
-C
-C* LOCAL VARIABLES:
-C
-      REAL*8 ZOZ(KDLON,KFLEV)
-      REAL*8 ZAKI(KDLON,2)     
-      REAL*8 ZCLD(KDLON,KFLEV)
-      REAL*8 ZCLEAR(KDLON) 
-      REAL*8 ZDSIG(KDLON,KFLEV)
-      REAL*8 ZFACT(KDLON)
-      REAL*8 ZFD(KDLON,KFLEV+1)
-      REAL*8 ZFDOWN(KDLON,KFLEV+1)
-      REAL*8 ZFU(KDLON,KFLEV+1)
-      REAL*8 ZFUP(KDLON,KFLEV+1)
-      REAL*8 ZRMU(KDLON)
-      REAL*8 ZSEC(KDLON)
-      REAL*8 ZUD(KDLON,5,KFLEV+1)
-      REAL*8 ZCLDSW0(KDLON,KFLEV)
-c
-      REAL*8 ZFSUP(KDLON,KFLEV+1)
-      REAL*8 ZFSDN(KDLON,KFLEV+1)
-      REAL*8 ZFSUP0(KDLON,KFLEV+1)
-      REAL*8 ZFSDN0(KDLON,KFLEV+1)
-      SAVE ZFSUP, ZFSDN, ZFSUP0, ZFSDN0
-C
-      INTEGER inu, jl, jk, i, k, kpl1
-c
-      INTEGER swpas  ! Every swpas steps, sw is calculated
-      PARAMETER(swpas=1)
-c
-      INTEGER itapsw
-      LOGICAL appel1er
-      DATA itapsw /0/
-      DATA appel1er /.TRUE./
-c
-      IF (appel1er) THEN
-         PRINT*, 'SW calling frequency : ', swpas
-         PRINT*, "   In general, it should be 1"
-         appel1er = .FALSE.
-      ENDIF
-C     ------------------------------------------------------------------
-      IF (MOD(itapsw,swpas).EQ.0) THEN
-c
-      DO JK = 1 , KFLEV
-      DO JL = 1, KDLON
-         ZCLDSW0(JL,JK) = 0.0
-         ZOZ(JL,JK) = POZON(JL,JK)*46.6968/RG
-     .               *PDP(JL,JK)*(101325.0/PPSOL(JL))
-      ENDDO
-      ENDDO
-C
-C
-c clear-sky:
-      CALL SWU(PSCT,RCO2,ZCLDSW0,PPMB,PPSOL,
-     S         PRMU0,PFRAC,PTAVE,PWV,
-     S         ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
-      INU = 1
-      CALL SW1S(INU,
-     S     PAER, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,
-     S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,
-     S     ZFD, ZFU)
-      INU = 2
-      CALL SW2S(INU,
-     S     PAER, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,
-     S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,
-     S     PWV, PQS,
-     S     ZFDOWN, ZFUP)
-      DO JK = 1 , KFLEV+1
-      DO JL = 1, KDLON
-         ZFSUP0(JL,JK) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)
-         ZFSDN0(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
-      ENDDO
-      ENDDO
-c cloudy-sky:
-      CALL SWU(PSCT,RCO2,PCLDSW,PPMB,PPSOL,
-     S         PRMU0,PFRAC,PTAVE,PWV,
-     S         ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
-      INU = 1
-      CALL SW1S(INU,
-     S     PAER, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,
-     S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,
-     S     ZFD, ZFU)
-      INU = 2
-      CALL SW2S(INU,
-     S     PAER, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,
-     S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,
-     S     PWV, PQS,
-     S    ZFDOWN, ZFUP)
-      DO JK = 1 , KFLEV+1
-      DO JL = 1, KDLON
-         ZFSUP(JL,JK) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)
-         ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
-      ENDDO
-      ENDDO
-c
-      itapsw = 0
-      ENDIF
-      itapsw = itapsw + 1
-C
-      DO k = 1, KFLEV
-         kpl1 = k+1
-         DO i = 1, KDLON
-            PHEAT(i,k) = -(ZFSUP(i,kpl1)-ZFSUP(i,k))
-     .                     -(ZFSDN(i,k)-ZFSDN(i,kpl1))
-            PHEAT(i,k) = PHEAT(i,k) * RDAY*RG/RCPD / PDP(i,k)
-            PHEAT0(i,k) = -(ZFSUP0(i,kpl1)-ZFSUP0(i,k))
-     .                     -(ZFSDN0(i,k)-ZFSDN0(i,kpl1))
-            PHEAT0(i,k) = PHEAT0(i,k) * RDAY*RG/RCPD / PDP(i,k)
-         ENDDO
-      ENDDO
-      DO i = 1, KDLON
-         PALBPLA(i) = ZFSUP(i,KFLEV+1)/(ZFSDN(i,KFLEV+1)+1.0e-20)
-c
-         PSOLSW(i) = ZFSDN(i,1) - ZFSUP(i,1)
-         PTOPSW(i) = ZFSDN(i,KFLEV+1) - ZFSUP(i,KFLEV+1)
-c
-         PSOLSW0(i) = ZFSDN0(i,1) - ZFSUP0(i,1)
-         PTOPSW0(i) = ZFSDN0(i,KFLEV+1) - ZFSUP0(i,KFLEV+1)
-      ENDDO
-C
-      RETURN
-      END
-c
-      SUBROUTINE SWU (PSCT,RCO2,PCLDSW,PPMB,PPSOL,PRMU0,PFRAC,
-     S                PTAVE,PWV,PAKI,PCLD,PCLEAR,PDSIG,PFACT,
-     S                PRMU,PSEC,PUD)
-      IMPLICIT none
-#include "dimensions.h"
-#include "dimphy.h"
-#include "raddim.h"
-#include "radepsi.h"
-#include "radopt.h"
-#include "YOMCST.h"
-C
-C* ARGUMENTS:
-C
-      REAL*8 PSCT
-      REAL*8 RCO2
-      REAL*8 PCLDSW(KDLON,KFLEV)
-      REAL*8 PPMB(KDLON,KFLEV+1)
-      REAL*8 PPSOL(KDLON)
-      REAL*8 PRMU0(KDLON)
-      REAL*8 PFRAC(KDLON)
-      REAL*8 PTAVE(KDLON,KFLEV)
-      REAL*8 PWV(KDLON,KFLEV)
-C
-      REAL*8 PAKI(KDLON,2)
-      REAL*8 PCLD(KDLON,KFLEV)
-      REAL*8 PCLEAR(KDLON)
-      REAL*8 PDSIG(KDLON,KFLEV)
-      REAL*8 PFACT(KDLON)
-      REAL*8 PRMU(KDLON)
-      REAL*8 PSEC(KDLON)
-      REAL*8 PUD(KDLON,5,KFLEV+1)
-C
-C* LOCAL VARIABLES:
-C
-      INTEGER IIND(2)
-      REAL*8 ZC1J(KDLON,KFLEV+1)
-      REAL*8 ZCLEAR(KDLON)
-      REAL*8 ZCLOUD(KDLON)
-      REAL*8 ZN175(KDLON)
-      REAL*8 ZN190(KDLON)
-      REAL*8 ZO175(KDLON)
-      REAL*8 ZO190(KDLON)
-      REAL*8 ZSIGN(KDLON)
-      REAL*8 ZR(KDLON,2) 
-      REAL*8 ZSIGO(KDLON)
-      REAL*8 ZUD(KDLON,2)
-      REAL*8 ZRTH, ZRTU, ZWH2O, ZDSCO2, ZDSH2O, ZFPPW
-      INTEGER jl, jk, jkp1, jkl, jklp1, ja
-C
-C* Prescribed Data:
-c
-      REAL*8 ZPDH2O,ZPDUMG
-      SAVE ZPDH2O,ZPDUMG
-      REAL*8 ZPRH2O,ZPRUMG
-      SAVE ZPRH2O,ZPRUMG
-      REAL*8 RTDH2O,RTDUMG
-      SAVE RTDH2O,RTDUMG
-      REAL*8 RTH2O ,RTUMG
-      SAVE RTH2O ,RTUMG
-      DATA ZPDH2O,ZPDUMG / 0.8   , 0.75 /
-      DATA ZPRH2O,ZPRUMG / 30000., 30000. /
-      DATA RTDH2O,RTDUMG /  0.40  , 0.375 /
-      DATA RTH2O ,RTUMG  /  240.  , 240.  /
-C     ------------------------------------------------------------------
-C
-C*         1.     COMPUTES AMOUNTS OF ABSORBERS
-C                 -----------------------------
-C
- 100  CONTINUE
-C
-      IIND(1)=1
-      IIND(2)=2
-C      
-C
-C*         1.1    INITIALIZES QUANTITIES
-C                 ----------------------
-C
- 110  CONTINUE
-C
-      DO 111 JL = 1, KDLON
-      PUD(JL,1,KFLEV+1)=0.
-      PUD(JL,2,KFLEV+1)=0.
-      PUD(JL,3,KFLEV+1)=0.
-      PUD(JL,4,KFLEV+1)=0.
-      PUD(JL,5,KFLEV+1)=0.
-      PFACT(JL)= PRMU0(JL) * PFRAC(JL) * PSCT
-      PRMU(JL)=SQRT(1224.* PRMU0(JL) * PRMU0(JL) + 1.) / 35.
-      PSEC(JL)=1./PRMU(JL)
-      ZC1J(JL,KFLEV+1)=0.
- 111  CONTINUE
-C
-C*          1.3    AMOUNTS OF ABSORBERS
-C                  --------------------
-C
- 130  CONTINUE
-C
-      DO 131 JL= 1, KDLON
-      ZUD(JL,1) = 0.
-      ZUD(JL,2) = 0.
-      ZO175(JL) = PPSOL(JL)** (ZPDUMG+1.)
-      ZO190(JL) = PPSOL(JL)** (ZPDH2O+1.)
-      ZSIGO(JL) = PPSOL(JL)
-      ZCLEAR(JL)=1.
-      ZCLOUD(JL)=0.
- 131  CONTINUE
-C
-      DO 133 JK = 1 , KFLEV
-      JKP1 = JK + 1
-      JKL = KFLEV+1 - JK
-      JKLP1 = JKL+1
-      DO 132 JL = 1, KDLON
-      ZRTH=(RTH2O/PTAVE(JL,JK))**RTDH2O
-      ZRTU=(RTUMG/PTAVE(JL,JK))**RTDUMG
-      ZWH2O = MAX (PWV(JL,JK) , ZEPSCQ )
-      ZSIGN(JL) = 100. * PPMB(JL,JKP1)
-      PDSIG(JL,JK) = (ZSIGO(JL) - ZSIGN(JL))/PPSOL(JL)
-      ZN175(JL) = ZSIGN(JL) ** (ZPDUMG+1.)
-      ZN190(JL) = ZSIGN(JL) ** (ZPDH2O+1.)
-      ZDSCO2 = ZO175(JL) - ZN175(JL)
-      ZDSH2O = ZO190(JL) - ZN190(JL)
-      PUD(JL,1,JK) = 1./( 10.* RG * (ZPDH2O+1.) )/(ZPRH2O**ZPDH2O)
-     .             * ZDSH2O * ZWH2O  * ZRTH
-      PUD(JL,2,JK) = 1./( 10.* RG * (ZPDUMG+1.) )/(ZPRUMG**ZPDUMG)
-     .             * ZDSCO2 * RCO2 * ZRTU
-      ZFPPW=1.6078*ZWH2O/(1.+0.608*ZWH2O)
-      PUD(JL,4,JK)=PUD(JL,1,JK)*ZFPPW
-      PUD(JL,5,JK)=PUD(JL,1,JK)*(1.-ZFPPW)
-      ZUD(JL,1) = ZUD(JL,1) + PUD(JL,1,JK)
-      ZUD(JL,2) = ZUD(JL,2) + PUD(JL,2,JK)
-      ZSIGO(JL) = ZSIGN(JL)
-      ZO175(JL) = ZN175(JL)
-      ZO190(JL) = ZN190(JL)
-C      
-      IF (NOVLP.EQ.1) THEN
-         ZCLEAR(JL)=ZCLEAR(JL)
-     S               *(1.-MAX(PCLDSW(JL,JKL),ZCLOUD(JL)))
-     S               /(1.-MIN(ZCLOUD(JL),1.-ZEPSEC))
-         ZC1J(JL,JKL)= 1.0 - ZCLEAR(JL)
-         ZCLOUD(JL) = PCLDSW(JL,JKL)
-      ELSE IF (NOVLP.EQ.2) THEN
-         ZCLOUD(JL) = MAX(PCLDSW(JL,JKL),ZCLOUD(JL))
-         ZC1J(JL,JKL) = ZCLOUD(JL)
-      ELSE IF (NOVLP.EQ.3) THEN
-         ZCLEAR(JL) = ZCLEAR(JL)*(1.-PCLDSW(JL,JKL))
-         ZCLOUD(JL) = 1.0 - ZCLEAR(JL)
-         ZC1J(JL,JKL) = ZCLOUD(JL)
-      END IF
- 132  CONTINUE
- 133  CONTINUE
-      DO 134 JL=1, KDLON
-      PCLEAR(JL)=1.-ZC1J(JL,1)
- 134  CONTINUE
-      DO 136 JK=1,KFLEV
-      DO 135 JL=1, KDLON
-      IF (PCLEAR(JL).LT.1.) THEN
-         PCLD(JL,JK)=PCLDSW(JL,JK)/(1.-PCLEAR(JL))
-      ELSE
-         PCLD(JL,JK)=0.
-      END IF
- 135  CONTINUE
- 136  CONTINUE           
-C      
-C
-C*         1.4    COMPUTES CLEAR-SKY GREY ABSORPTION COEFFICIENTS
-C                 -----------------------------------------------
-C
- 140  CONTINUE
-C
-      DO 142 JA = 1,2
-      DO 141 JL = 1, KDLON
-      ZUD(JL,JA) = ZUD(JL,JA) * PSEC(JL)
- 141  CONTINUE
- 142  CONTINUE
-C
-      CALL SWTT1(2, 2, IIND, ZUD, ZR)
-C
-      DO 144 JA = 1,2
-      DO 143 JL = 1, KDLON
-      PAKI(JL,JA) = -LOG( ZR(JL,JA) ) / ZUD(JL,JA)
- 143  CONTINUE
- 144  CONTINUE
-C
-C
-C     ------------------------------------------------------------------
-C
-      RETURN
-      END
-      SUBROUTINE SW1S ( KNU
-     S  ,  PAER  , PALBD , PALBP, PCG  , PCLD , PCLEAR, PCLDSW
-     S  ,  PDSIG , POMEGA, POZ  , PRMU , PSEC , PTAU  , PUD  
-     S  ,  PFD   , PFU)
-      IMPLICIT none
-#include "dimensions.h"
-#include "dimphy.h"
-#include "raddim.h"
-C
-C     ------------------------------------------------------------------
-C     PURPOSE.
-C     --------
-C
-C          THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO
-C     SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).
-C
-C     METHOD.
-C     -------
-C
-C          1. COMPUTES UPWARD AND DOWNWARD FLUXES CORRESPONDING TO
-C     CONTINUUM SCATTERING
-C          2. MULTIPLY BY OZONE TRANSMISSION FUNCTION
-C
-C     REFERENCE.
-C     ----------
-C
-C        SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
-C        DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
-C
-C     AUTHOR.
-C     -------
-C        JEAN-JACQUES MORCRETTE  *ECMWF*
-C
-C     MODIFICATIONS.
-C     --------------
-C        ORIGINAL : 89-07-14
-C        94-11-15   J.-J. MORCRETTE    DIRECT/DIFFUSE ALBEDO
-C     ------------------------------------------------------------------
-C
-C* ARGUMENTS:
-C
-      INTEGER KNU
-      REAL*8 PAER(KDLON,KFLEV,5)
-      REAL*8 PALBD(KDLON,2)
-      REAL*8 PALBP(KDLON,2)
-      REAL*8 PCG(KDLON,2,KFLEV)  
-      REAL*8 PCLD(KDLON,KFLEV)
-      REAL*8 PCLDSW(KDLON,KFLEV)
-      REAL*8 PCLEAR(KDLON)
-      REAL*8 PDSIG(KDLON,KFLEV)
-      REAL*8 POMEGA(KDLON,2,KFLEV)
-      REAL*8 POZ(KDLON,KFLEV)
-      REAL*8 PRMU(KDLON)
-      REAL*8 PSEC(KDLON)
-      REAL*8 PTAU(KDLON,2,KFLEV)
-      REAL*8 PUD(KDLON,5,KFLEV+1)
-C
-      REAL*8 PFD(KDLON,KFLEV+1)
-      REAL*8 PFU(KDLON,KFLEV+1)
-C
-C* LOCAL VARIABLES:
-C
-      INTEGER IIND(4)
-C      
-      REAL*8 ZCGAZ(KDLON,KFLEV) 
-      REAL*8 ZDIFF(KDLON)
-      REAL*8 ZDIRF(KDLON)        
-      REAL*8 ZPIZAZ(KDLON,KFLEV)
-      REAL*8 ZRAYL(KDLON)
-      REAL*8 ZRAY1(KDLON,KFLEV+1)
-      REAL*8 ZRAY2(KDLON,KFLEV+1)
-      REAL*8 ZREFZ(KDLON,2,KFLEV+1)
-      REAL*8 ZRJ(KDLON,6,KFLEV+1)
-      REAL*8 ZRJ0(KDLON,6,KFLEV+1)
-      REAL*8 ZRK(KDLON,6,KFLEV+1)
-      REAL*8 ZRK0(KDLON,6,KFLEV+1)
-      REAL*8 ZRMUE(KDLON,KFLEV+1)
-      REAL*8 ZRMU0(KDLON,KFLEV+1)
-      REAL*8 ZR(KDLON,4)
-      REAL*8 ZTAUAZ(KDLON,KFLEV)
-      REAL*8 ZTRA1(KDLON,KFLEV+1)
-      REAL*8 ZTRA2(KDLON,KFLEV+1)
-      REAL*8 ZW(KDLON,4)
-C
-      INTEGER jl, jk, k, jaj, ikm1, ikl
-c
-c Prescribed Data:
-c
-      REAL*8 RSUN(2)
-      SAVE RSUN
-      REAL*8 RRAY(2,6)
-      SAVE RRAY
-      DATA RSUN(1) / 0.441676 /
-      DATA RSUN(2) / 0.558324 /
-      DATA (RRAY(1,K),K=1,6) /
-     S .428937E-01, .890743E+00,-.288555E+01,
-     S .522744E+01,-.469173E+01, .161645E+01/
-      DATA (RRAY(2,K),K=1,6) /
-     S .697200E-02, .173297E-01,-.850903E-01,
-     S .248261E+00,-.302031E+00, .129662E+00/
-C     ------------------------------------------------------------------
-C
-C*         1.     FIRST SPECTRAL INTERVAL (0.25-0.68 MICRON)
-C                 ----------------------- ------------------
-C
- 100  CONTINUE
-C
-C
-C*         1.1    OPTICAL THICKNESS FOR RAYLEIGH SCATTERING
-C                 -----------------------------------------
-C
- 110  CONTINUE
-C
-      DO 111 JL = 1, KDLON
-      ZRAYL(JL) =  RRAY(KNU,1) + PRMU(JL) * (RRAY(KNU,2) + PRMU(JL)
-     S          * (RRAY(KNU,3) + PRMU(JL) * (RRAY(KNU,4) + PRMU(JL)
-     S          * (RRAY(KNU,5) + PRMU(JL) *  RRAY(KNU,6)       ))))
- 111  CONTINUE
-C
-C
-C     ------------------------------------------------------------------
-C
-C*         2.    CONTINUUM SCATTERING CALCULATIONS
-C                ---------------------------------
-C
- 200  CONTINUE
-C
-C*         2.1   CLEAR-SKY FRACTION OF THE COLUMN
-C                --------------------------------
-C  
- 210  CONTINUE
-C
-      CALL SWCLR ( KNU
-     S  , PAER   , PALBP , PDSIG , ZRAYL, PSEC
-     S  , ZCGAZ  , ZPIZAZ, ZRAY1 , ZRAY2, ZREFZ, ZRJ0
-     S  , ZRK0   , ZRMU0 , ZTAUAZ, ZTRA1, ZTRA2)
-C
-C
-C*         2.2   CLOUDY FRACTION OF THE COLUMN
-C                -----------------------------
-C
- 220  CONTINUE
-C
-      CALL SWR ( KNU
-     S  , PALBD ,PCG   ,PCLD  ,PDSIG ,POMEGA,ZRAYL
-     S  , PSEC  ,PTAU
-     S  , ZCGAZ ,ZPIZAZ,ZRAY1 ,ZRAY2 ,ZREFZ ,ZRJ  ,ZRK,ZRMUE
-     S  , ZTAUAZ,ZTRA1 ,ZTRA2)
-C
-C
-C     ------------------------------------------------------------------
-C
-C*         3.    OZONE ABSORPTION
-C                ----------------
-C
- 300  CONTINUE
-C
-      IIND(1)=1
-      IIND(2)=3
-      IIND(3)=1
-      IIND(4)=3
-C      
-C
-C*         3.1   DOWNWARD FLUXES
-C                ---------------
-C
- 310  CONTINUE
-C
-      JAJ = 2
-C
-      DO 311 JL = 1, KDLON
-      ZW(JL,1)=0.
-      ZW(JL,2)=0.
-      ZW(JL,3)=0.
-      ZW(JL,4)=0.
-      PFD(JL,KFLEV+1)=((1.-PCLEAR(JL))*ZRJ(JL,JAJ,KFLEV+1)
-     S     + PCLEAR(JL) *ZRJ0(JL,JAJ,KFLEV+1)) * RSUN(KNU)
- 311  CONTINUE
-      DO 314 JK = 1 , KFLEV
-      IKL = KFLEV+1-JK
-      DO 312 JL = 1, KDLON
-      ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKL)/ZRMUE(JL,IKL)
-      ZW(JL,2)=ZW(JL,2)+POZ(JL,  IKL)/ZRMUE(JL,IKL)
-      ZW(JL,3)=ZW(JL,3)+PUD(JL,1,IKL)/ZRMU0(JL,IKL)
-      ZW(JL,4)=ZW(JL,4)+POZ(JL,  IKL)/ZRMU0(JL,IKL)
- 312  CONTINUE
-C
-      CALL SWTT1(KNU, 4, IIND, ZW, ZR)
-C
-      DO 313 JL = 1, KDLON
-      ZDIFF(JL) = ZR(JL,1)*ZR(JL,2)*ZRJ(JL,JAJ,IKL)
-      ZDIRF(JL) = ZR(JL,3)*ZR(JL,4)*ZRJ0(JL,JAJ,IKL)
-      PFD(JL,IKL) = ((1.-PCLEAR(JL)) * ZDIFF(JL)
-     S                  +PCLEAR(JL)  * ZDIRF(JL)) * RSUN(KNU)
- 313  CONTINUE
- 314  CONTINUE
-C
-C
-C*         3.2   UPWARD FLUXES
-C                -------------
-C
- 320  CONTINUE
-C
-      DO 325 JL = 1, KDLON
-      PFU(JL,1) = ((1.-PCLEAR(JL))*ZDIFF(JL)*PALBD(JL,KNU)
-     S               + PCLEAR(JL) *ZDIRF(JL)*PALBP(JL,KNU))
-     S          * RSUN(KNU)
- 325  CONTINUE
-C
-      DO 328 JK = 2 , KFLEV+1
-      IKM1=JK-1
-      DO 326 JL = 1, KDLON
-      ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKM1)*1.66
-      ZW(JL,2)=ZW(JL,2)+POZ(JL,  IKM1)*1.66
-      ZW(JL,3)=ZW(JL,3)+PUD(JL,1,IKM1)*1.66
-      ZW(JL,4)=ZW(JL,4)+POZ(JL,  IKM1)*1.66
- 326  CONTINUE
-C
-      CALL SWTT1(KNU, 4, IIND, ZW, ZR)
-C
-      DO 327 JL = 1, KDLON
-      ZDIFF(JL) = ZR(JL,1)*ZR(JL,2)*ZRK(JL,JAJ,JK)
-      ZDIRF(JL) = ZR(JL,3)*ZR(JL,4)*ZRK0(JL,JAJ,JK)
-      PFU(JL,JK) = ((1.-PCLEAR(JL)) * ZDIFF(JL)
-     S                 +PCLEAR(JL)  * ZDIRF(JL)) * RSUN(KNU)
- 327  CONTINUE
- 328  CONTINUE
-C
-C     ------------------------------------------------------------------
-C
-      RETURN
-      END
-      SUBROUTINE SW2S ( KNU
-     S  ,  PAER  ,PAKI, PALBD, PALBP, PCG   , PCLD, PCLEAR, PCLDSW
-     S  ,  PDSIG ,POMEGA,POZ , PRMU , PSEC  , PTAU
-     S  ,  PUD   ,PWV , PQS
-     S  ,  PFDOWN,PFUP                                            )
-      IMPLICIT none
-#include "dimensions.h"
-#include "dimphy.h"
-#include "raddim.h"
-#include "radepsi.h"
-C
-C     ------------------------------------------------------------------
-C     PURPOSE.
-C     --------
-C
-C          THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN THE
-C     SECOND SPECTRAL INTERVAL FOLLOWING FOUQUART AND BONNEL (1980).
-C
-C     METHOD.
-C     -------
-C
-C          1. COMPUTES REFLECTIVITY/TRANSMISSIVITY CORRESPONDING TO
-C     CONTINUUM SCATTERING
-C          2. COMPUTES REFLECTIVITY/TRANSMISSIVITY CORRESPONDING FOR
-C     A GREY MOLECULAR ABSORPTION
-C          3. LAPLACE TRANSFORM ON THE PREVIOUS TO GET EFFECTIVE AMOUNTS
-C     OF ABSORBERS
-C          4. APPLY H2O AND U.M.G. TRANSMISSION FUNCTIONS
-C          5. MULTIPLY BY OZONE TRANSMISSION FUNCTION
-C
-C     REFERENCE.
-C     ----------
-C
-C        SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
-C        DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
-C
-C     AUTHOR.
-C     -------
-C        JEAN-JACQUES MORCRETTE  *ECMWF*
-C
-C     MODIFICATIONS.
-C     --------------
-C        ORIGINAL : 89-07-14
-C        94-11-15   J.-J. MORCRETTE    DIRECT/DIFFUSE ALBEDO
-C     ------------------------------------------------------------------
-C* ARGUMENTS:
-C
-      INTEGER KNU
-      REAL*8 PAER(KDLON,KFLEV,5)
-      REAL*8 PAKI(KDLON,2)
-      REAL*8 PALBD(KDLON,2)
-      REAL*8 PALBP(KDLON,2)
-      REAL*8 PCG(KDLON,2,KFLEV)
-      REAL*8 PCLD(KDLON,KFLEV)
-      REAL*8 PCLDSW(KDLON,KFLEV)
-      REAL*8 PCLEAR(KDLON)
-      REAL*8 PDSIG(KDLON,KFLEV)
-      REAL*8 POMEGA(KDLON,2,KFLEV)
-      REAL*8 POZ(KDLON,KFLEV)
-      REAL*8 PQS(KDLON,KFLEV)
-      REAL*8 PRMU(KDLON)
-      REAL*8 PSEC(KDLON)
-      REAL*8 PTAU(KDLON,2,KFLEV)
-      REAL*8 PUD(KDLON,5,KFLEV+1)
-      REAL*8 PWV(KDLON,KFLEV)
-C
-      REAL*8 PFDOWN(KDLON,KFLEV+1)
-      REAL*8 PFUP(KDLON,KFLEV+1)
-C
-C* LOCAL VARIABLES:
-C
-      INTEGER IIND2(2), IIND3(3)
-      REAL*8 ZCGAZ(KDLON,KFLEV)
-      REAL*8 ZFD(KDLON,KFLEV+1)
-      REAL*8 ZFU(KDLON,KFLEV+1) 
-      REAL*8 ZG(KDLON)
-      REAL*8 ZGG(KDLON)
-      REAL*8 ZPIZAZ(KDLON,KFLEV)
-      REAL*8 ZRAYL(KDLON)
-      REAL*8 ZRAY1(KDLON,KFLEV+1)
-      REAL*8 ZRAY2(KDLON,KFLEV+1)
-      REAL*8 ZREF(KDLON)
-      REAL*8 ZREFZ(KDLON,2,KFLEV+1)
-      REAL*8 ZRE1(KDLON)
-      REAL*8 ZRE2(KDLON)
-      REAL*8 ZRJ(KDLON,6,KFLEV+1)
-      REAL*8 ZRJ0(KDLON,6,KFLEV+1)
-      REAL*8 ZRK(KDLON,6,KFLEV+1)
-      REAL*8 ZRK0(KDLON,6,KFLEV+1)
-      REAL*8 ZRL(KDLON,8)
-      REAL*8 ZRMUE(KDLON,KFLEV+1)
-      REAL*8 ZRMU0(KDLON,KFLEV+1)
-      REAL*8 ZRMUZ(KDLON)
-      REAL*8 ZRNEB(KDLON)
-      REAL*8 ZRUEF(KDLON,8)
-      REAL*8 ZR1(KDLON) 
-      REAL*8 ZR2(KDLON,2)
-      REAL*8 ZR3(KDLON,3)
-      REAL*8 ZR4(KDLON)
-      REAL*8 ZR21(KDLON)
-      REAL*8 ZR22(KDLON)
-      REAL*8 ZS(KDLON)
-      REAL*8 ZTAUAZ(KDLON,KFLEV)
-      REAL*8 ZTO1(KDLON)
-      REAL*8 ZTR(KDLON,2,KFLEV+1)
-      REAL*8 ZTRA1(KDLON,KFLEV+1)
-      REAL*8 ZTRA2(KDLON,KFLEV+1)
-      REAL*8 ZTR1(KDLON)
-      REAL*8 ZTR2(KDLON)
-      REAL*8 ZW(KDLON)   
-      REAL*8 ZW1(KDLON)
-      REAL*8 ZW2(KDLON,2)
-      REAL*8 ZW3(KDLON,3)
-      REAL*8 ZW4(KDLON)
-      REAL*8 ZW5(KDLON)
-C
-      INTEGER jl, jk, k, jaj, ikm1, ikl, jn, jabs, jkm1
-      INTEGER jref, jkl, jklp1, jajp, jkki, jkkp4, jn2j, iabs
-      REAL*8 ZRMUM1, ZWH2O, ZCNEB, ZAA, ZBB, ZRKI, ZRE11
-C
-C* Prescribed Data:
-C
-      REAL*8 RSUN(2)
-      SAVE RSUN
-      REAL*8 RRAY(2,6)
-      SAVE RRAY
-      DATA RSUN(1) / 0.441676 /
-      DATA RSUN(2) / 0.558324 /
-      DATA (RRAY(1,K),K=1,6) /
-     S .428937E-01, .890743E+00,-.288555E+01,
-     S .522744E+01,-.469173E+01, .161645E+01/
-      DATA (RRAY(2,K),K=1,6) /
-     S .697200E-02, .173297E-01,-.850903E-01,
-     S .248261E+00,-.302031E+00, .129662E+00/
-C
-C     ------------------------------------------------------------------
-C
-C*         1.     SECOND SPECTRAL INTERVAL (0.68-4.00 MICRON)
-C                 -------------------------------------------
-C
- 100  CONTINUE
-C
-C
-C*         1.1    OPTICAL THICKNESS FOR RAYLEIGH SCATTERING
-C                 -----------------------------------------
-C
- 110  CONTINUE
-C
-      DO 111 JL = 1, KDLON
-      ZRMUM1 = 1. - PRMU(JL)
-      ZRAYL(JL) =  RRAY(KNU,1) + ZRMUM1   * (RRAY(KNU,2) + ZRMUM1
-     S          * (RRAY(KNU,3) + ZRMUM1   * (RRAY(KNU,4) + ZRMUM1
-     S          * (RRAY(KNU,5) + ZRMUM1   *  RRAY(KNU,6)     ))))
- 111  CONTINUE
-C
-C
-C     ------------------------------------------------------------------
-C
-C*         2.    CONTINUUM SCATTERING CALCULATIONS
-C                ---------------------------------
-C
- 200  CONTINUE
-C
-C*         2.1   CLEAR-SKY FRACTION OF THE COLUMN
-C                --------------------------------
-C  
- 210  CONTINUE
-C
-      CALL SWCLR ( KNU
-     S  , PAER   , PALBP , PDSIG , ZRAYL, PSEC 
-     S  , ZCGAZ  , ZPIZAZ, ZRAY1 , ZRAY2, ZREFZ, ZRJ0
-     S  , ZRK0   , ZRMU0 , ZTAUAZ, ZTRA1, ZTRA2)
-C
-C
-C*         2.2   CLOUDY FRACTION OF THE COLUMN
-C                -----------------------------
-C
- 220  CONTINUE
-C
-      CALL SWR ( KNU
-     S  , PALBD , PCG   , PCLD , PDSIG, POMEGA, ZRAYL
-     S  , PSEC  , PTAU
-     S  , ZCGAZ , ZPIZAZ, ZRAY1, ZRAY2, ZREFZ , ZRJ  , ZRK, ZRMUE
-     S  , ZTAUAZ, ZTRA1 , ZTRA2)
-C
-C
-C     ------------------------------------------------------------------
-C
-C*         3.    SCATTERING CALCULATIONS WITH GREY MOLECULAR ABSORPTION
-C                ------------------------------------------------------
-C
- 300  CONTINUE
-C
-      JN = 2
-C
-      DO 361 JABS=1,2
-C
-C
-C*         3.1  SURFACE CONDITIONS
-C               ------------------
-C
- 310  CONTINUE
-C
-      DO 311 JL = 1, KDLON
-      ZREFZ(JL,2,1) = PALBD(JL,KNU)
-      ZREFZ(JL,1,1) = PALBD(JL,KNU)
- 311  CONTINUE
-C
-C
-C*         3.2  INTRODUCING CLOUD EFFECTS
-C               -------------------------
-C
- 320  CONTINUE
-C
-      DO 324 JK = 2 , KFLEV+1
-      JKM1 = JK - 1
-      IKL=KFLEV+1-JKM1
-      DO 322 JL = 1, KDLON
-      ZRNEB(JL) = PCLD(JL,JKM1)
-      IF (JABS.EQ.1 .AND. ZRNEB(JL).GT.2.*ZEELOG) THEN
-         ZWH2O=MAX(PWV(JL,JKM1),ZEELOG)
-         ZCNEB=MAX(ZEELOG,MIN(ZRNEB(JL),1.-ZEELOG))
-         ZBB=PUD(JL,JABS,JKM1)*PQS(JL,JKM1)/ZWH2O
-         ZAA=MAX((PUD(JL,JABS,JKM1)-ZCNEB*ZBB)/(1.-ZCNEB),ZEELOG)
-      ELSE
-         ZAA=PUD(JL,JABS,JKM1)
-         ZBB=ZAA
-      END IF
-      ZRKI = PAKI(JL,JABS)
-      ZS(JL) = EXP(-ZRKI * ZAA * 1.66)
-      ZG(JL) = EXP(-ZRKI * ZAA / ZRMUE(JL,JK))
-      ZTR1(JL) = 0.
-      ZRE1(JL) = 0.
-      ZTR2(JL) = 0.
-      ZRE2(JL) = 0.
-C
-      ZW(JL)= POMEGA(JL,KNU,JKM1)
-      ZTO1(JL) = PTAU(JL,KNU,JKM1) / ZW(JL)
-     S               + ZTAUAZ(JL,JKM1) / ZPIZAZ(JL,JKM1)
-     S               + ZBB * ZRKI
-
-      ZR21(JL) = PTAU(JL,KNU,JKM1) + ZTAUAZ(JL,JKM1)
-      ZR22(JL) = PTAU(JL,KNU,JKM1) / ZR21(JL)
-      ZGG(JL) = ZR22(JL) * PCG(JL,KNU,JKM1)
-     S              + (1. - ZR22(JL)) * ZCGAZ(JL,JKM1)
-      ZW(JL) = ZR21(JL) / ZTO1(JL)
-      ZREF(JL) = ZREFZ(JL,1,JKM1)
-      ZRMUZ(JL) = ZRMUE(JL,JK)
- 322  CONTINUE
-C
-      CALL SWDE(ZGG, ZREF, ZRMUZ, ZTO1, ZW,
-     S          ZRE1, ZRE2, ZTR1, ZTR2)
-C
-      DO 323 JL = 1, KDLON
-C
-      ZREFZ(JL,2,JK) = (1.-ZRNEB(JL)) * (ZRAY1(JL,JKM1)
-     S               + ZREFZ(JL,2,JKM1) * ZTRA1(JL,JKM1)
-     S               * ZTRA2(JL,JKM1) ) * ZG(JL) * ZS(JL)
-     S               + ZRNEB(JL) * ZRE1(JL)
-C
-      ZTR(JL,2,JKM1)=ZRNEB(JL)*ZTR1(JL)
-     S              + (ZTRA1(JL,JKM1)) * ZG(JL) * (1.-ZRNEB(JL))
-C
-      ZREFZ(JL,1,JK)=(1.-ZRNEB(JL))*(ZRAY1(JL,JKM1)
-     S                  +ZREFZ(JL,1,JKM1)*ZTRA1(JL,JKM1)*ZTRA2(JL,JKM1)
-     S             /(1.-ZRAY2(JL,JKM1)*ZREFZ(JL,1,JKM1)))*ZG(JL)*ZS(JL)
-     S             + ZRNEB(JL) * ZRE2(JL)
-C
-      ZTR(JL,1,JKM1)= ZRNEB(JL) * ZTR2(JL)
-     S              + (ZTRA1(JL,JKM1)/(1.-ZRAY2(JL,JKM1)
-     S              * ZREFZ(JL,1,JKM1)))
-     S              * ZG(JL) * (1. -ZRNEB(JL))
-C
- 323  CONTINUE
- 324  CONTINUE
-C
-C*         3.3  REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
-C               -------------------------------------------------
-C
- 330  CONTINUE
-C
-      DO 351 JREF=1,2
-C
-      JN = JN + 1
-C
-      DO 331 JL = 1, KDLON
-      ZRJ(JL,JN,KFLEV+1) = 1.
-      ZRK(JL,JN,KFLEV+1) = ZREFZ(JL,JREF,KFLEV+1)
- 331  CONTINUE
-C
-      DO 333 JK = 1 , KFLEV
-      JKL = KFLEV+1 - JK
-      JKLP1 = JKL + 1
-      DO 332 JL = 1, KDLON
-      ZRE11 = ZRJ(JL,JN,JKLP1) * ZTR(JL,JREF,JKL)
-      ZRJ(JL,JN,JKL) = ZRE11
-      ZRK(JL,JN,JKL) = ZRE11 * ZREFZ(JL,JREF,JKL)
- 332  CONTINUE
- 333  CONTINUE
- 351  CONTINUE
- 361  CONTINUE
-C
-C
-C     ------------------------------------------------------------------
-C
-C*         4.    INVERT GREY AND CONTINUUM FLUXES
-C                --------------------------------
-C
- 400  CONTINUE
-C
-C
-C*         4.1   UPWARD (ZRK) AND DOWNWARD (ZRJ) PSEUDO-FLUXES
-C                ---------------------------------------------
-C
- 410  CONTINUE
-C
-      DO 414 JK = 1 , KFLEV+1
-      DO 413 JAJ = 1 , 5 , 2
-      JAJP = JAJ + 1
-      DO 412 JL = 1, KDLON
-      ZRJ(JL,JAJ,JK)=        ZRJ(JL,JAJ,JK) - ZRJ(JL,JAJP,JK)
-      ZRK(JL,JAJ,JK)=        ZRK(JL,JAJ,JK) - ZRK(JL,JAJP,JK)
-      ZRJ(JL,JAJ,JK)= MAX( ZRJ(JL,JAJ,JK) , ZEELOG )
-      ZRK(JL,JAJ,JK)= MAX( ZRK(JL,JAJ,JK) , ZEELOG )
- 412  CONTINUE
- 413  CONTINUE
- 414  CONTINUE
-C
-      DO 417 JK = 1 , KFLEV+1
-      DO 416 JAJ = 2 , 6 , 2
-      DO 415 JL = 1, KDLON
-      ZRJ(JL,JAJ,JK)= MAX( ZRJ(JL,JAJ,JK) , ZEELOG )
-      ZRK(JL,JAJ,JK)= MAX( ZRK(JL,JAJ,JK) , ZEELOG )
- 415  CONTINUE
- 416  CONTINUE
- 417  CONTINUE
-C
-C*         4.2    EFFECTIVE ABSORBER AMOUNTS BY INVERSE LAPLACE
-C                 ---------------------------------------------
-C
- 420  CONTINUE
-C
-      DO 437 JK = 1 , KFLEV+1
-      JKKI = 1
-      DO 425 JAJ = 1 , 2
-      IIND2(1)=JAJ
-      IIND2(2)=JAJ
-      DO 424 JN = 1 , 2
-      JN2J = JN + 2 * JAJ
-      JKKP4 = JKKI + 4
-C
-C*         4.2.1  EFFECTIVE ABSORBER AMOUNTS
-C                 --------------------------
-C
- 4210 CONTINUE
-C
-      DO 4211 JL = 1, KDLON
-      ZW2(JL,1) = LOG( ZRJ(JL,JN,JK) / ZRJ(JL,JN2J,JK))
-     S                               / PAKI(JL,JAJ)
-      ZW2(JL,2) = LOG( ZRK(JL,JN,JK) / ZRK(JL,JN2J,JK))
-     S                               / PAKI(JL,JAJ)
- 4211 CONTINUE
-C
-C*         4.2.2  TRANSMISSION FUNCTION
-C                 ---------------------
-C
- 4220 CONTINUE
-C
-      CALL SWTT1(KNU, 2, IIND2, ZW2, ZR2)
-C
-      DO 4221 JL = 1, KDLON
-      ZRL(JL,JKKI) = ZR2(JL,1)
-      ZRUEF(JL,JKKI) = ZW2(JL,1)
-      ZRL(JL,JKKP4) = ZR2(JL,2)
-      ZRUEF(JL,JKKP4) = ZW2(JL,2)
- 4221 CONTINUE
-C
-      JKKI=JKKI+1
- 424  CONTINUE
- 425  CONTINUE
-C
-C*         4.3    UPWARD AND DOWNWARD FLUXES WITH H2O AND UMG ABSORPTION
-C                 ------------------------------------------------------
-C
- 430  CONTINUE
-C
-      DO 431 JL = 1, KDLON
-      PFDOWN(JL,JK) = ZRJ(JL,1,JK) * ZRL(JL,1) * ZRL(JL,3)
-     S              + ZRJ(JL,2,JK) * ZRL(JL,2) * ZRL(JL,4)
-      PFUP(JL,JK)   = ZRK(JL,1,JK) * ZRL(JL,5) * ZRL(JL,7)
-     S              + ZRK(JL,2,JK) * ZRL(JL,6) * ZRL(JL,8)
- 431  CONTINUE
- 437  CONTINUE
-C
-C
-C     ------------------------------------------------------------------
-C
-C*         5.    MOLECULAR ABSORPTION ON CLEAR-SKY FLUXES
-C                ----------------------------------------
-C
- 500  CONTINUE
-C
-C
-C*         5.1   DOWNWARD FLUXES
-C                ---------------
-C
- 510  CONTINUE
-C
-      JAJ = 2
-      IIND3(1)=1
-      IIND3(2)=2
-      IIND3(3)=3
-C      
-      DO 511 JL = 1, KDLON
-      ZW3(JL,1)=0.
-      ZW3(JL,2)=0.
-      ZW3(JL,3)=0.
-      ZW4(JL)  =0.
-      ZW5(JL)  =0.
-      ZR4(JL)  =1.
-      ZFD(JL,KFLEV+1)= ZRJ0(JL,JAJ,KFLEV+1)
- 511  CONTINUE
-      DO 514 JK = 1 , KFLEV
-      IKL = KFLEV+1-JK
-      DO 512 JL = 1, KDLON
-      ZW3(JL,1)=ZW3(JL,1)+PUD(JL,1,IKL)/ZRMU0(JL,IKL)
-      ZW3(JL,2)=ZW3(JL,2)+PUD(JL,2,IKL)/ZRMU0(JL,IKL)
-      ZW3(JL,3)=ZW3(JL,3)+POZ(JL,  IKL)/ZRMU0(JL,IKL)
-      ZW4(JL)  =ZW4(JL)  +PUD(JL,4,IKL)/ZRMU0(JL,IKL)
-      ZW5(JL)  =ZW5(JL)  +PUD(JL,5,IKL)/ZRMU0(JL,IKL)
- 512  CONTINUE
-C
-      CALL SWTT1(KNU, 3, IIND3, ZW3, ZR3)
-C
-      DO 513 JL = 1, KDLON
-C     ZR4(JL) = EXP(-RSWCE*ZW4(JL)-RSWCP*ZW5(JL))
-      ZFD(JL,IKL) = ZR3(JL,1)*ZR3(JL,2)*ZR3(JL,3)*ZR4(JL)
-     S            * ZRJ0(JL,JAJ,IKL)
- 513  CONTINUE
- 514  CONTINUE
-C
-C
-C*         5.2   UPWARD FLUXES
-C                -------------
-C
- 520  CONTINUE
-C
-      DO 525 JL = 1, KDLON
-      ZFU(JL,1) = ZFD(JL,1)*PALBP(JL,KNU)
- 525  CONTINUE
-C
-      DO 528 JK = 2 , KFLEV+1
-      IKM1=JK-1
-      DO 526 JL = 1, KDLON
-      ZW3(JL,1)=ZW3(JL,1)+PUD(JL,1,IKM1)*1.66
-      ZW3(JL,2)=ZW3(JL,2)+PUD(JL,2,IKM1)*1.66
-      ZW3(JL,3)=ZW3(JL,3)+POZ(JL,  IKM1)*1.66
-      ZW4(JL)  =ZW4(JL)  +PUD(JL,4,IKM1)*1.66
-      ZW5(JL)  =ZW5(JL)  +PUD(JL,5,IKM1)*1.66
- 526  CONTINUE
-C
-      CALL SWTT1(KNU, 3, IIND3, ZW3, ZR3)
-C
-      DO 527 JL = 1, KDLON
-C     ZR4(JL) = EXP(-RSWCE*ZW4(JL)-RSWCP*ZW5(JL))
-      ZFU(JL,JK) = ZR3(JL,1)*ZR3(JL,2)*ZR3(JL,3)*ZR4(JL)
-     S           * ZRK0(JL,JAJ,JK)
- 527  CONTINUE
- 528  CONTINUE
-C
-C
-C     ------------------------------------------------------------------
-C
-C*         6.     INTRODUCTION OF OZONE AND H2O CONTINUUM ABSORPTION
-C                 --------------------------------------------------
-C
- 600  CONTINUE
-      IABS=3
-C
-C*         6.1    DOWNWARD FLUXES
-C                 ---------------
-C
- 610  CONTINUE
-      DO 611 JL = 1, KDLON
-      ZW1(JL)=0.
-      ZW4(JL)=0.
-      ZW5(JL)=0.
-      ZR1(JL)=0.
-      PFDOWN(JL,KFLEV+1) = ((1.-PCLEAR(JL))*PFDOWN(JL,KFLEV+1)
-     S                   + PCLEAR(JL) * ZFD(JL,KFLEV+1)) * RSUN(KNU)
- 611  CONTINUE
-C
-      DO 614 JK = 1 , KFLEV
-      IKL=KFLEV+1-JK
-      DO 612 JL = 1, KDLON
-      ZW1(JL) = ZW1(JL)+POZ(JL,  IKL)/ZRMUE(JL,IKL)
-      ZW4(JL) = ZW4(JL)+PUD(JL,4,IKL)/ZRMUE(JL,IKL)
-      ZW5(JL) = ZW5(JL)+PUD(JL,5,IKL)/ZRMUE(JL,IKL)
-C     ZR4(JL) = EXP(-RSWCE*ZW4(JL)-RSWCP*ZW5(JL))
- 612  CONTINUE
-C
-      CALL SWTT(KNU, IABS, ZW1, ZR1)
-C
-      DO 613 JL = 1, KDLON
-      PFDOWN(JL,IKL) = ((1.-PCLEAR(JL))*ZR1(JL)*ZR4(JL)*PFDOWN(JL,IKL)
-     S                     +PCLEAR(JL)*ZFD(JL,IKL)) * RSUN(KNU)
- 613  CONTINUE
- 614  CONTINUE
-C
-C
-C*         6.2    UPWARD FLUXES
-C                 -------------
-C
- 620  CONTINUE
-      DO 621 JL = 1, KDLON
-      PFUP(JL,1) = ((1.-PCLEAR(JL))*ZR1(JL)*ZR4(JL) * PFUP(JL,1)
-     S                 +PCLEAR(JL)*ZFU(JL,1)) * RSUN(KNU)
- 621  CONTINUE
-C
-      DO 624 JK = 2 , KFLEV+1
-      IKM1=JK-1
-      DO 622 JL = 1, KDLON
-      ZW1(JL) = ZW1(JL)+POZ(JL  ,IKM1)*1.66
-      ZW4(JL) = ZW4(JL)+PUD(JL,4,IKM1)*1.66
-      ZW5(JL) = ZW5(JL)+PUD(JL,5,IKM1)*1.66
-C     ZR4(JL) = EXP(-RSWCE*ZW4(JL)-RSWCP*ZW5(JL))
- 622  CONTINUE
-C
-      CALL SWTT(KNU, IABS, ZW1, ZR1)
-C
-      DO 623 JL = 1, KDLON
-      PFUP(JL,JK) = ((1.-PCLEAR(JL))*ZR1(JL)*ZR4(JL) * PFUP(JL,JK)
-     S                 +PCLEAR(JL)*ZFU(JL,JK)) * RSUN(KNU)
- 623  CONTINUE
- 624  CONTINUE
-C
-C     ------------------------------------------------------------------
-C
-      RETURN
-      END
-      SUBROUTINE SWCLR  ( KNU
-     S  , PAER  , PALBP , PDSIG , PRAYL , PSEC
-     S  , PCGAZ , PPIZAZ, PRAY1 , PRAY2 , PREFZ , PRJ  
-     S  , PRK   , PRMU0 , PTAUAZ, PTRA1 , PTRA2                   )
-      IMPLICIT none
-#include "dimensions.h"
-#include "dimphy.h"
-#include "raddim.h"
-#include "radepsi.h"
-#include "radopt.h"
-C
-C     ------------------------------------------------------------------
-C     PURPOSE.
-C     --------
-C           COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF
-C     CLEAR-SKY COLUMN
-C
-C     REFERENCE.
-C     ----------
-C
-C        SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
-C        DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
-C
-C     AUTHOR.
-C     -------
-C        JEAN-JACQUES MORCRETTE  *ECMWF*
-C
-C     MODIFICATIONS.
-C     --------------
-C        ORIGINAL : 94-11-15
-C     ------------------------------------------------------------------
-C* ARGUMENTS:
-C
-      INTEGER KNU
-      REAL*8 PAER(KDLON,KFLEV,5)
-      REAL*8 PALBP(KDLON,2)
-      REAL*8 PDSIG(KDLON,KFLEV)
-      REAL*8 PRAYL(KDLON)
-      REAL*8 PSEC(KDLON)
-C
-      REAL*8 PCGAZ(KDLON,KFLEV)     
-      REAL*8 PPIZAZ(KDLON,KFLEV)
-      REAL*8 PRAY1(KDLON,KFLEV+1)
-      REAL*8 PRAY2(KDLON,KFLEV+1)
-      REAL*8 PREFZ(KDLON,2,KFLEV+1)
-      REAL*8 PRJ(KDLON,6,KFLEV+1)
-      REAL*8 PRK(KDLON,6,KFLEV+1)
-      REAL*8 PRMU0(KDLON,KFLEV+1)
-      REAL*8 PTAUAZ(KDLON,KFLEV)
-      REAL*8 PTRA1(KDLON,KFLEV+1)
-      REAL*8 PTRA2(KDLON,KFLEV+1)
-C
-C* LOCAL VARIABLES:
-C
-      REAL*8 ZC0I(KDLON,KFLEV+1)       
-      REAL*8 ZCLE0(KDLON,KFLEV)
-      REAL*8 ZCLEAR(KDLON)
-      REAL*8 ZR21(KDLON)
-      REAL*8 ZR23(KDLON)
-      REAL*8 ZSS0(KDLON)
-      REAL*8 ZSCAT(KDLON)
-      REAL*8 ZTR(KDLON,2,KFLEV+1)
-C
-      INTEGER jl, jk, ja, jae, jkl, jklp1, jaj, jkm1, in
-      REAL*8 ZTRAY, ZGAR, ZRATIO, ZFF, ZFACOA, ZCORAE
-      REAL*8 ZMUE, ZGAP, ZWW, ZTO, ZDEN, ZMU1, ZDEN1
-      REAL*8 ZBMU0, ZBMU1, ZRE11
-C
-C* Prescribed Data for Aerosols:
-C
-      REAL*8 TAUA(2,5), RPIZA(2,5), RCGA(2,5)
-      SAVE TAUA, RPIZA, RCGA
-      DATA ((TAUA(IN,JA),JA=1,5),IN=1,2) /
-     S .730719, .912819, .725059, .745405, .682188 ,
-     S .730719, .912819, .725059, .745405, .682188 /
-      DATA ((RPIZA(IN,JA),JA=1,5),IN=1,2) /
-     S .872212, .982545, .623143, .944887, .997975 ,
-     S .872212, .982545, .623143, .944887, .997975 /
-      DATA ((RCGA (IN,JA),JA=1,5),IN=1,2) /
-     S .647596, .739002, .580845, .662657, .624246 ,
-     S .647596, .739002, .580845, .662657, .624246 /
-C     ------------------------------------------------------------------
-C
-C*         1.    OPTICAL PARAMETERS FOR AEROSOLS AND RAYLEIGH
-C                --------------------------------------------
-C
- 100  CONTINUE
-C
-      DO 103 JK = 1 , KFLEV+1
-      DO 102 JA = 1 , 6
-      DO 101 JL = 1, KDLON
-      PRJ(JL,JA,JK) = 0.
-      PRK(JL,JA,JK) = 0.
- 101  CONTINUE
- 102  CONTINUE
- 103  CONTINUE
-C
-      DO 108 JK = 1 , KFLEV
-      DO 104 JL = 1, KDLON
-      PCGAZ(JL,JK) = 0.
-      PPIZAZ(JL,JK) =  0.
-      PTAUAZ(JL,JK) = 0.
- 104  CONTINUE
-      DO 106 JAE=1,5
-      DO 105 JL = 1, KDLON
-      PTAUAZ(JL,JK)=PTAUAZ(JL,JK)
-     S        +PAER(JL,JK,JAE)*TAUA(KNU,JAE)
-      PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL,JK,JAE)
-     S        * TAUA(KNU,JAE)*RPIZA(KNU,JAE)
-      PCGAZ(JL,JK) =  PCGAZ(JL,JK) +PAER(JL,JK,JAE)
-     S        * TAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE)
- 105  CONTINUE
- 106  CONTINUE
-C
-      DO 107 JL = 1, KDLON
-      IF (KAER.NE.0) THEN
-         PCGAZ(JL,JK)=PCGAZ(JL,JK)/PPIZAZ(JL,JK)
-         PPIZAZ(JL,JK)=PPIZAZ(JL,JK)/PTAUAZ(JL,JK)
-         ZTRAY = PRAYL(JL) * PDSIG(JL,JK)
-         ZRATIO = ZTRAY / (ZTRAY + PTAUAZ(JL,JK))
-         ZGAR = PCGAZ(JL,JK)
-         ZFF = ZGAR * ZGAR
-         PTAUAZ(JL,JK)=ZTRAY+PTAUAZ(JL,JK)*(1.-PPIZAZ(JL,JK)*ZFF)
-         PCGAZ(JL,JK) = ZGAR * (1. - ZRATIO) / (1. + ZGAR)
-         PPIZAZ(JL,JK) =ZRATIO+(1.-ZRATIO)*PPIZAZ(JL,JK)*(1.-ZFF)
-     S                       / (1. - PPIZAZ(JL,JK) * ZFF)
-      ELSE
-         ZTRAY = PRAYL(JL) * PDSIG(JL,JK)
-         PTAUAZ(JL,JK) = ZTRAY
-         PCGAZ(JL,JK) = 0.
-         PPIZAZ(JL,JK) = 1.-REPSCT
-      END IF
- 107  CONTINUE
-c      PRINT 9107,JK,((PAER(JL,JK,JAE),JAE=1,5)
-c     $ ,PTAUAZ(JL,JK),PPIZAZ(JL,JK),PCGAZ(JL,JK),JL=1,KDLON)
-c 9107 FORMAT(1X,'SWCLR_107',I3,8E12.5)
-C
- 108  CONTINUE
-C
-C     ------------------------------------------------------------------
-C
-C*         2.    TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
-C                ----------------------------------------------
-C
- 200  CONTINUE
-C
-      DO 201 JL = 1, KDLON
-      ZR23(JL) = 0.
-      ZC0I(JL,KFLEV+1) = 0.
-      ZCLEAR(JL) = 1.
-      ZSCAT(JL) = 0.
- 201  CONTINUE
-C
-      JK = 1
-      JKL = KFLEV+1 - JK
-      JKLP1 = JKL + 1
-      DO 202 JL = 1, KDLON
-      ZFACOA = 1. - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL)
-      ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL)
-      ZR21(JL) = EXP(-ZCORAE   )
-      ZSS0(JL) = 1.-ZR21(JL)
-      ZCLE0(JL,JKL) = ZSS0(JL)
-C
-      IF (NOVLP.EQ.1) THEN
-c* maximum-random
-         ZCLEAR(JL) = ZCLEAR(JL)
-     S                  *(1.0-MAX(ZSS0(JL),ZSCAT(JL)))
-     S                  /(1.0-MIN(ZSCAT(JL),1.-ZEPSEC))
-         ZC0I(JL,JKL) = 1.0 - ZCLEAR(JL)
-         ZSCAT(JL) = ZSS0(JL)
-      ELSE IF (NOVLP.EQ.2) THEN
-C* maximum
-         ZSCAT(JL) = MAX( ZSS0(JL) , ZSCAT(JL) )
-         ZC0I(JL,JKL) = ZSCAT(JL)
-      ELSE IF (NOVLP.EQ.3) THEN
-c* random
-         ZCLEAR(JL)=ZCLEAR(JL)*(1.0-ZSS0(JL))
-         ZSCAT(JL) = 1.0 - ZCLEAR(JL)
-         ZC0I(JL,JKL) = ZSCAT(JL)
-      END IF
- 202  CONTINUE
-C
-      DO 205 JK = 2 , KFLEV
-      JKL = KFLEV+1 - JK
-      JKLP1 = JKL + 1
-      DO 204 JL = 1, KDLON
-      ZFACOA = 1. - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL)
-      ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL)
-      ZR21(JL) = EXP(-ZCORAE   )
-      ZSS0(JL) = 1.-ZR21(JL)
-      ZCLE0(JL,JKL) = ZSS0(JL)
-c     
-      IF (NOVLP.EQ.1) THEN
-c* maximum-random
-         ZCLEAR(JL) = ZCLEAR(JL)
-     S                  *(1.0-MAX(ZSS0(JL),ZSCAT(JL)))
-     S                  /(1.0-MIN(ZSCAT(JL),1.-ZEPSEC))
-         ZC0I(JL,JKL) = 1.0 - ZCLEAR(JL)
-         ZSCAT(JL) = ZSS0(JL)
-      ELSE IF (NOVLP.EQ.2) THEN
-C* maximum
-         ZSCAT(JL) = MAX( ZSS0(JL) , ZSCAT(JL) )
-         ZC0I(JL,JKL) = ZSCAT(JL)
-      ELSE IF (NOVLP.EQ.3) THEN
-c* random
-         ZCLEAR(JL)=ZCLEAR(JL)*(1.0-ZSS0(JL))
-         ZSCAT(JL) = 1.0 - ZCLEAR(JL)
-         ZC0I(JL,JKL) = ZSCAT(JL)
-      END IF                  
- 204  CONTINUE
- 205  CONTINUE
-C
-C     ------------------------------------------------------------------
-C
-C*         3.    REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
-C                -----------------------------------------------
-C
- 300  CONTINUE
-C
-      DO 301 JL = 1, KDLON
-      PRAY1(JL,KFLEV+1) = 0.
-      PRAY2(JL,KFLEV+1) = 0.
-      PREFZ(JL,2,1) = PALBP(JL,KNU)
-      PREFZ(JL,1,1) = PALBP(JL,KNU)
-      PTRA1(JL,KFLEV+1) = 1.
-      PTRA2(JL,KFLEV+1) = 1.
- 301  CONTINUE
-C
-      DO 346 JK = 2 , KFLEV+1
-      JKM1 = JK-1
-      DO 342 JL = 1, KDLON
-C
-C
-C     ------------------------------------------------------------------
-C
-C*         3.1  EQUIVALENT ZENITH ANGLE
-C               -----------------------
-C
- 310  CONTINUE
-C
-      ZMUE = (1.-ZC0I(JL,JK)) * PSEC(JL)
-     S            + ZC0I(JL,JK) * 1.66
-      PRMU0(JL,JK) = 1./ZMUE
-C
-C
-C     ------------------------------------------------------------------
-C
-C*         3.2  REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS
-C               ----------------------------------------------------
-C
- 320  CONTINUE
-C
-      ZGAP = PCGAZ(JL,JKM1)
-      ZBMU0 = 0.5 - 0.75 * ZGAP / ZMUE
-      ZWW = PPIZAZ(JL,JKM1)
-      ZTO = PTAUAZ(JL,JKM1)
-      ZDEN = 1. + (1. - ZWW + ZBMU0 * ZWW) * ZTO * ZMUE
-     S       + (1-ZWW) * (1. - ZWW +2.*ZBMU0*ZWW)*ZTO*ZTO*ZMUE*ZMUE
-      PRAY1(JL,JKM1) = ZBMU0 * ZWW * ZTO * ZMUE / ZDEN
-      PTRA1(JL,JKM1) = 1. / ZDEN
-C
-      ZMU1 = 0.5
-      ZBMU1 = 0.5 - 0.75 * ZGAP * ZMU1
-      ZDEN1= 1. + (1. - ZWW + ZBMU1 * ZWW) * ZTO / ZMU1
-     S       + (1-ZWW) * (1. - ZWW +2.*ZBMU1*ZWW)*ZTO*ZTO/ZMU1/ZMU1
-      PRAY2(JL,JKM1) = ZBMU1 * ZWW * ZTO / ZMU1 / ZDEN1
-      PTRA2(JL,JKM1) = 1. / ZDEN1
-C
-C
-C
-      PREFZ(JL,1,JK) = (PRAY1(JL,JKM1)
-     S               + PREFZ(JL,1,JKM1) * PTRA1(JL,JKM1)
-     S               * PTRA2(JL,JKM1)
-     S               / (1.-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1)))
-C
-      ZTR(JL,1,JKM1) = (PTRA1(JL,JKM1)
-     S               / (1.-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1)))
-C
-      PREFZ(JL,2,JK) = (PRAY1(JL,JKM1)
-     S               + PREFZ(JL,2,JKM1) * PTRA1(JL,JKM1)
-     S               * PTRA2(JL,JKM1) )
-C
-      ZTR(JL,2,JKM1) = PTRA1(JL,JKM1) 
-C
- 342  CONTINUE
- 346  CONTINUE
-      DO 347 JL = 1, KDLON
-      ZMUE = (1.-ZC0I(JL,1))*PSEC(JL)+ZC0I(JL,1)*1.66
-      PRMU0(JL,1)=1./ZMUE
- 347  CONTINUE
-C
-C
-C     ------------------------------------------------------------------
-C
-C*         3.5    REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
-C                 -------------------------------------------------
-C
- 350  CONTINUE
-C
-      IF (KNU.EQ.1) THEN
-      JAJ = 2
-      DO 351 JL = 1, KDLON
-      PRJ(JL,JAJ,KFLEV+1) = 1.
-      PRK(JL,JAJ,KFLEV+1) = PREFZ(JL, 1,KFLEV+1)
- 351  CONTINUE
-C
-      DO 353 JK = 1 , KFLEV
-      JKL = KFLEV+1 - JK
-      JKLP1 = JKL + 1
-      DO 352 JL = 1, KDLON
-      ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL,  1,JKL)
-      PRJ(JL,JAJ,JKL) = ZRE11
-      PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL,  1,JKL)
- 352  CONTINUE
- 353  CONTINUE
- 354  CONTINUE
-C
-      ELSE
-C
-      DO 358 JAJ = 1 , 2
-      DO 355 JL = 1, KDLON
-      PRJ(JL,JAJ,KFLEV+1) = 1.
-      PRK(JL,JAJ,KFLEV+1) = PREFZ(JL,JAJ,KFLEV+1)
- 355  CONTINUE
-C
-      DO 357 JK = 1 , KFLEV
-      JKL = KFLEV+1 - JK
-      JKLP1 = JKL + 1
-      DO 356 JL = 1, KDLON
-      ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL,JAJ,JKL)
-      PRJ(JL,JAJ,JKL) = ZRE11
-      PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL,JAJ,JKL)
- 356  CONTINUE
- 357  CONTINUE
- 358  CONTINUE
-C
-      END IF
-C
-C     ------------------------------------------------------------------
-C
-      RETURN
-      END
-      SUBROUTINE SWR ( KNU
-     S  , PALBD , PCG   , PCLD , PDSIG, POMEGA, PRAYL
-     S  , PSEC  , PTAU
-     S  , PCGAZ , PPIZAZ, PRAY1, PRAY2, PREFZ , PRJ  , PRK , PRMUE
-     S  , PTAUAZ, PTRA1 , PTRA2 )
-      IMPLICIT none
-#include "dimensions.h"
-#include "dimphy.h"
-#include "raddim.h"
-#include "radepsi.h"
-#include "radopt.h"
-C
-C     ------------------------------------------------------------------
-C     PURPOSE.
-C     --------
-C           COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF
-C     CONTINUUM SCATTERING
-C
-C     METHOD.
-C     -------
-C
-C          1. COMPUTES CONTINUUM FLUXES CORRESPONDING TO AEROSOL
-C     OR/AND RAYLEIGH SCATTERING (NO MOLECULAR GAS ABSORPTION)
-C
-C     REFERENCE.
-C     ----------
-C
-C        SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
-C        DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
-C
-C     AUTHOR.
-C     -------
-C        JEAN-JACQUES MORCRETTE  *ECMWF*
-C
-C     MODIFICATIONS.
-C     --------------
-C        ORIGINAL : 89-07-14
-C     ------------------------------------------------------------------
-C* ARGUMENTS:
-C
-      INTEGER KNU
-      REAL*8 PALBD(KDLON,2)
-      REAL*8 PCG(KDLON,2,KFLEV)
-      REAL*8 PCLD(KDLON,KFLEV)
-      REAL*8 PDSIG(KDLON,KFLEV)
-      REAL*8 POMEGA(KDLON,2,KFLEV)
-      REAL*8 PRAYL(KDLON)
-      REAL*8 PSEC(KDLON)
-      REAL*8 PTAU(KDLON,2,KFLEV)
-C
-      REAL*8 PRAY1(KDLON,KFLEV+1)
-      REAL*8 PRAY2(KDLON,KFLEV+1)
-      REAL*8 PREFZ(KDLON,2,KFLEV+1)
-      REAL*8 PRJ(KDLON,6,KFLEV+1)
-      REAL*8 PRK(KDLON,6,KFLEV+1)
-      REAL*8 PRMUE(KDLON,KFLEV+1)
-      REAL*8 PCGAZ(KDLON,KFLEV)
-      REAL*8 PPIZAZ(KDLON,KFLEV)
-      REAL*8 PTAUAZ(KDLON,KFLEV)
-      REAL*8 PTRA1(KDLON,KFLEV+1)
-      REAL*8 PTRA2(KDLON,KFLEV+1)
-C
-C* LOCAL VARIABLES:
-C
-      REAL*8 ZC1I(KDLON,KFLEV+1)
-      REAL*8 ZCLEQ(KDLON,KFLEV)
-      REAL*8 ZCLEAR(KDLON)
-      REAL*8 ZCLOUD(KDLON)
-      REAL*8 ZGG(KDLON)
-      REAL*8 ZREF(KDLON)
-      REAL*8 ZRE1(KDLON)
-      REAL*8 ZRE2(KDLON)
-      REAL*8 ZRMUZ(KDLON)
-      REAL*8 ZRNEB(KDLON)
-      REAL*8 ZR21(KDLON)
-      REAL*8 ZR22(KDLON)
-      REAL*8 ZR23(KDLON)
-      REAL*8 ZSS1(KDLON)
-      REAL*8 ZTO1(KDLON)
-      REAL*8 ZTR(KDLON,2,KFLEV+1)
-      REAL*8 ZTR1(KDLON)
-      REAL*8 ZTR2(KDLON)
-      REAL*8 ZW(KDLON)
-C
-      INTEGER jk, jl, ja, jkl, jklp1, jkm1, jaj
-      REAL*8 ZFACOA, ZFACOC, ZCORAE, ZCORCD
-      REAL*8 ZMUE, ZGAP, ZWW, ZTO, ZDEN, ZDEN1
-      REAL*8 ZMU1, ZRE11, ZBMU0, ZBMU1
-C
-C     ------------------------------------------------------------------
-C
-C*         1.    INITIALIZATION
-C                --------------
-C
- 100  CONTINUE
-C
-      DO 103 JK = 1 , KFLEV+1
-      DO 102 JA = 1 , 6
-      DO 101 JL = 1, KDLON
-      PRJ(JL,JA,JK) = 0.
-      PRK(JL,JA,JK) = 0.
- 101  CONTINUE
- 102  CONTINUE
- 103  CONTINUE
-C
-C
-C     ------------------------------------------------------------------
-C
-C*         2.    TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
-C                ----------------------------------------------
-C
- 200  CONTINUE
-C
-      DO 201 JL = 1, KDLON
-      ZR23(JL) = 0.
-      ZC1I(JL,KFLEV+1) = 0.
-      ZCLEAR(JL) = 1.
-      ZCLOUD(JL) = 0.
- 201  CONTINUE
-C
-      JK = 1
-      JKL = KFLEV+1 - JK
-      JKLP1 = JKL + 1
-      DO 202 JL = 1, KDLON
-      ZFACOA = 1. - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL)
-      ZFACOC = 1. - POMEGA(JL,KNU,JKL) * PCG(JL,KNU,JKL)
-     S                                 * PCG(JL,KNU,JKL)
-      ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL)
-      ZCORCD = ZFACOC * PTAU(JL,KNU,JKL) * PSEC(JL)
-      ZR21(JL) = EXP(-ZCORAE   )
-      ZR22(JL) = EXP(-ZCORCD   )
-      ZSS1(JL) = PCLD(JL,JKL)*(1.0-ZR21(JL)*ZR22(JL))
-     S               + (1.0-PCLD(JL,JKL))*(1.0-ZR21(JL))
-      ZCLEQ(JL,JKL) = ZSS1(JL)
-C
-      IF (NOVLP.EQ.1) THEN
-c* maximum-random
-         ZCLEAR(JL) = ZCLEAR(JL)
-     S                  *(1.0-MAX(ZSS1(JL),ZCLOUD(JL)))
-     S                  /(1.0-MIN(ZCLOUD(JL),1.-ZEPSEC))
-         ZC1I(JL,JKL) = 1.0 - ZCLEAR(JL)
-         ZCLOUD(JL) = ZSS1(JL)
-      ELSE IF (NOVLP.EQ.2) THEN
-C* maximum
-         ZCLOUD(JL) = MAX( ZSS1(JL) , ZCLOUD(JL) )
-         ZC1I(JL,JKL) = ZCLOUD(JL)
-      ELSE IF (NOVLP.EQ.3) THEN
-c* random
-         ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - ZSS1(JL))
-         ZCLOUD(JL) = 1.0 - ZCLEAR(JL)
-         ZC1I(JL,JKL) = ZCLOUD(JL)
-      END IF
- 202  CONTINUE
-C
-      DO 205 JK = 2 , KFLEV
-      JKL = KFLEV+1 - JK
-      JKLP1 = JKL + 1
-      DO 204 JL = 1, KDLON
-      ZFACOA = 1. - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL)
-      ZFACOC = 1. - POMEGA(JL,KNU,JKL) * PCG(JL,KNU,JKL)
-     S                                 * PCG(JL,KNU,JKL)
-      ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL)
-      ZCORCD = ZFACOC * PTAU(JL,KNU,JKL) * PSEC(JL)
-      ZR21(JL) = EXP(-ZCORAE   )
-      ZR22(JL) = EXP(-ZCORCD   )
-      ZSS1(JL) = PCLD(JL,JKL)*(1.0-ZR21(JL)*ZR22(JL))
-     S               + (1.0-PCLD(JL,JKL))*(1.0-ZR21(JL))
-      ZCLEQ(JL,JKL) = ZSS1(JL)
-c     
-      IF (NOVLP.EQ.1) THEN
-c* maximum-random
-         ZCLEAR(JL) = ZCLEAR(JL)
-     S                  *(1.0-MAX(ZSS1(JL),ZCLOUD(JL)))
-     S                  /(1.0-MIN(ZCLOUD(JL),1.-ZEPSEC))
-         ZC1I(JL,JKL) = 1.0 - ZCLEAR(JL)
-         ZCLOUD(JL) = ZSS1(JL)
-      ELSE IF (NOVLP.EQ.2) THEN
-C* maximum
-         ZCLOUD(JL) = MAX( ZSS1(JL) , ZCLOUD(JL) )
-         ZC1I(JL,JKL) = ZCLOUD(JL)
-      ELSE IF (NOVLP.EQ.3) THEN
-c* random
-         ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - ZSS1(JL))
-         ZCLOUD(JL) = 1.0 - ZCLEAR(JL)
-         ZC1I(JL,JKL) = ZCLOUD(JL)
-      END IF
- 204  CONTINUE
- 205  CONTINUE
-C
-C     ------------------------------------------------------------------
-C
-C*         3.    REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
-C                -----------------------------------------------
-C
- 300  CONTINUE
-C
-      DO 301 JL = 1, KDLON
-      PRAY1(JL,KFLEV+1) = 0.
-      PRAY2(JL,KFLEV+1) = 0.
-      PREFZ(JL,2,1) = PALBD(JL,KNU)
-      PREFZ(JL,1,1) = PALBD(JL,KNU)
-      PTRA1(JL,KFLEV+1) = 1.
-      PTRA2(JL,KFLEV+1) = 1.
- 301  CONTINUE
-C
-      DO 346 JK = 2 , KFLEV+1
-      JKM1 = JK-1
-      DO 342 JL = 1, KDLON
-      ZRNEB(JL)= PCLD(JL,JKM1)
-      ZRE1(JL)=0.
-      ZTR1(JL)=0.
-      ZRE2(JL)=0.
-      ZTR2(JL)=0.
-C
-C
-C     ------------------------------------------------------------------
-C
-C*         3.1  EQUIVALENT ZENITH ANGLE
-C               -----------------------
-C
- 310  CONTINUE
-C
-      ZMUE = (1.-ZC1I(JL,JK)) * PSEC(JL)
-     S            + ZC1I(JL,JK) * 1.66
-      PRMUE(JL,JK) = 1./ZMUE
-C
-C
-C     ------------------------------------------------------------------
-C
-C*         3.2  REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS
-C               ----------------------------------------------------
-C
- 320  CONTINUE
-C
-      ZGAP = PCGAZ(JL,JKM1)
-      ZBMU0 = 0.5 - 0.75 * ZGAP / ZMUE
-      ZWW = PPIZAZ(JL,JKM1)
-      ZTO = PTAUAZ(JL,JKM1)
-      ZDEN = 1. + (1. - ZWW + ZBMU0 * ZWW) * ZTO * ZMUE
-     S       + (1-ZWW) * (1. - ZWW +2.*ZBMU0*ZWW)*ZTO*ZTO*ZMUE*ZMUE
-      PRAY1(JL,JKM1) = ZBMU0 * ZWW * ZTO * ZMUE / ZDEN
-      PTRA1(JL,JKM1) = 1. / ZDEN
-c      PRINT *,' LOOP 342 ** 3 ** JL=',JL,PRAY1(JL,JKM1),PTRA1(JL,JKM1)
-C
-      ZMU1 = 0.5
-      ZBMU1 = 0.5 - 0.75 * ZGAP * ZMU1
-      ZDEN1= 1. + (1. - ZWW + ZBMU1 * ZWW) * ZTO / ZMU1
-     S       + (1-ZWW) * (1. - ZWW +2.*ZBMU1*ZWW)*ZTO*ZTO/ZMU1/ZMU1
-      PRAY2(JL,JKM1) = ZBMU1 * ZWW * ZTO / ZMU1 / ZDEN1
-      PTRA2(JL,JKM1) = 1. / ZDEN1
-C
-C
-C     ------------------------------------------------------------------
-C
-C*         3.3  EFFECT OF CLOUD LAYER
-C               ---------------------
-C
- 330  CONTINUE
-C
-      ZW(JL) = POMEGA(JL,KNU,JKM1)
-      ZTO1(JL) = PTAU(JL,KNU,JKM1)/ZW(JL)
-     S         + PTAUAZ(JL,JKM1)/PPIZAZ(JL,JKM1)
-      ZR21(JL) = PTAU(JL,KNU,JKM1) + PTAUAZ(JL,JKM1)
-      ZR22(JL) = PTAU(JL,KNU,JKM1) / ZR21(JL)
-      ZGG(JL) = ZR22(JL) * PCG(JL,KNU,JKM1)
-     S              + (1. - ZR22(JL)) * PCGAZ(JL,JKM1)
-C Modif PhD - JJM 19/03/96 pour erreurs arrondis
-C machine
-C PHD PROTECTION ZW(JL) = ZR21(JL) / ZTO1(JL)
-      IF (ZW(JL).EQ.1. .AND. PPIZAZ(JL,JKM1).EQ.1.) THEN
-         ZW(JL)=1.
-      ELSE
-         ZW(JL) = ZR21(JL) / ZTO1(JL)
-      END IF
-      ZREF(JL) = PREFZ(JL,1,JKM1)
-      ZRMUZ(JL) = PRMUE(JL,JK)
- 342  CONTINUE
-C
-      CALL SWDE(ZGG  , ZREF  , ZRMUZ , ZTO1 , ZW,
-     S          ZRE1 , ZRE2  , ZTR1  , ZTR2)
-C
-      DO 345 JL = 1, KDLON
-C
-      PREFZ(JL,1,JK) = (1.-ZRNEB(JL)) * (PRAY1(JL,JKM1)
-     S               + PREFZ(JL,1,JKM1) * PTRA1(JL,JKM1)
-     S               * PTRA2(JL,JKM1)
-     S               / (1.-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1)))
-     S               + ZRNEB(JL) * ZRE2(JL)
-C
-      ZTR(JL,1,JKM1) = ZRNEB(JL) * ZTR2(JL) + (PTRA1(JL,JKM1)
-     S               / (1.-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1)))
-     S               * (1.-ZRNEB(JL))
-C
-      PREFZ(JL,2,JK) = (1.-ZRNEB(JL)) * (PRAY1(JL,JKM1)
-     S               + PREFZ(JL,2,JKM1) * PTRA1(JL,JKM1)
-     S               * PTRA2(JL,JKM1) )
-     S               + ZRNEB(JL) * ZRE1(JL)
-C
-      ZTR(JL,2,JKM1) = ZRNEB(JL) * ZTR1(JL)
-     S               + PTRA1(JL,JKM1) * (1.-ZRNEB(JL))
-C
- 345  CONTINUE
- 346  CONTINUE
-      DO 347 JL = 1, KDLON
-      ZMUE = (1.-ZC1I(JL,1))*PSEC(JL)+ZC1I(JL,1)*1.66
-      PRMUE(JL,1)=1./ZMUE
- 347  CONTINUE
-C
-C
-C     ------------------------------------------------------------------
-C
-C*         3.5    REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
-C                 -------------------------------------------------
-C
- 350  CONTINUE
-C
-      IF (KNU.EQ.1) THEN
-      JAJ = 2
-      DO 351 JL = 1, KDLON
-      PRJ(JL,JAJ,KFLEV+1) = 1.
-      PRK(JL,JAJ,KFLEV+1) = PREFZ(JL, 1,KFLEV+1)
- 351  CONTINUE
-C
-      DO 353 JK = 1 , KFLEV
-      JKL = KFLEV+1 - JK
-      JKLP1 = JKL + 1
-      DO 352 JL = 1, KDLON
-      ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL,  1,JKL)
-      PRJ(JL,JAJ,JKL) = ZRE11
-      PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL,  1,JKL)
- 352  CONTINUE
- 353  CONTINUE
- 354  CONTINUE
-C
-      ELSE
-C
-      DO 358 JAJ = 1 , 2
-      DO 355 JL = 1, KDLON
-      PRJ(JL,JAJ,KFLEV+1) = 1.
-      PRK(JL,JAJ,KFLEV+1) = PREFZ(JL,JAJ,KFLEV+1)
- 355  CONTINUE
-C
-      DO 357 JK = 1 , KFLEV
-      JKL = KFLEV+1 - JK
-      JKLP1 = JKL + 1
-      DO 356 JL = 1, KDLON
-      ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL,JAJ,JKL)
-      PRJ(JL,JAJ,JKL) = ZRE11
-      PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL,JAJ,JKL)
- 356  CONTINUE
- 357  CONTINUE
- 358  CONTINUE
-C
-      END IF
-C
-C     ------------------------------------------------------------------
-C
-      RETURN
-      END
-      SUBROUTINE SWDE (PGG,PREF,PRMUZ,PTO1,PW,
-     S                 PRE1,PRE2,PTR1,PTR2)
-      IMPLICIT none
-#include "dimensions.h"
-#include "dimphy.h"
-#include "raddim.h"
-C
-C     ------------------------------------------------------------------
-C     PURPOSE.
-C     --------
-C           COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY OF A CLOUDY
-C     LAYER USING THE DELTA-EDDINGTON'S APPROXIMATION.
-C
-C     METHOD.
-C     -------
-C
-C          STANDARD DELTA-EDDINGTON LAYER CALCULATIONS.
-C
-C     REFERENCE.
-C     ----------
-C
-C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-C
-C     AUTHOR.
-C     -------
-C        JEAN-JACQUES MORCRETTE  *ECMWF*
-C
-C     MODIFICATIONS.
-C     --------------
-C        ORIGINAL : 88-12-15
-C     ------------------------------------------------------------------
-C* ARGUMENTS:
-C
-      REAL*8 PGG(KDLON)   ! ASSYMETRY FACTOR
-      REAL*8 PREF(KDLON)  ! REFLECTIVITY OF THE UNDERLYING LAYER
-      REAL*8 PRMUZ(KDLON) ! COSINE OF SOLAR ZENITH ANGLE
-      REAL*8 PTO1(KDLON)  ! OPTICAL THICKNESS
-      REAL*8 PW(KDLON)    ! SINGLE SCATTERING ALBEDO
-      REAL*8 PRE1(KDLON)  ! LAYER REFLECTIVITY (NO UNDERLYING-LAYER REFLECTION)
-      REAL*8 PRE2(KDLON)  ! LAYER REFLECTIVITY
-      REAL*8 PTR1(KDLON)  ! LAYER TRANSMISSIVITY (NO UNDERLYING-LAYER REFLECTION)
-      REAL*8 PTR2(KDLON)  ! LAYER TRANSMISSIVITY
-C
-C* LOCAL VARIABLES:
-C
-      INTEGER jl
-      REAL*8 ZFF, ZGP, ZTOP, ZWCP, ZDT, ZX1, ZWM
-      REAL*8 ZRM2, ZRK, ZX2, ZRP, ZALPHA, ZBETA, ZARG
-      REAL*8 ZEXMU0, ZARG2, ZEXKP, ZEXKM, ZXP2P, ZXM2P, ZAP2B, ZAM2B
-      REAL*8 ZA11, ZA12, ZA13, ZA21, ZA22, ZA23
-      REAL*8 ZDENA, ZC1A, ZC2A, ZRI0A, ZRI1A
-      REAL*8 ZRI0B, ZRI1B
-      REAL*8 ZB21, ZB22, ZB23, ZDENB, ZC1B, ZC2B
-      REAL*8 ZRI0C, ZRI1C, ZRI0D, ZRI1D
-C     ------------------------------------------------------------------
-C
-C*         1.      DELTA-EDDINGTON CALCULATIONS
-C
- 100  CONTINUE
-C
-      DO 131 JL   =   1, KDLON
-C
-C*         1.1     SET UP THE DELTA-MODIFIED PARAMETERS
-C
- 110  CONTINUE
-C
-      ZFF = PGG(JL)*PGG(JL)
-      ZGP = PGG(JL)/(1.+PGG(JL))
-      ZTOP = (1.- PW(JL) * ZFF) * PTO1(JL)
-      ZWCP = (1-ZFF)* PW(JL) /(1.- PW(JL) * ZFF)
-      ZDT = 2./3.
-      ZX1 = 1.-ZWCP*ZGP
-      ZWM = 1.-ZWCP
-      ZRM2 =  PRMUZ(JL) * PRMUZ(JL)
-      ZRK = SQRT(3.*ZWM*ZX1)
-      ZX2 = 4.*(1.-ZRK*ZRK*ZRM2)
-      ZRP=ZRK/ZX1
-      ZALPHA = 3.*ZWCP*ZRM2*(1.+ZGP*ZWM)/ZX2
-      ZBETA = 3.*ZWCP* PRMUZ(JL) *(1.+3.*ZGP*ZRM2*ZWM)/ZX2
-CMAF      ZARG=MIN(ZTOP/PRMUZ(JL),200.)
-      ZARG=MIN(ZTOP/PRMUZ(JL),2.0d+2)
-      ZEXMU0=EXP(-ZARG)
-CMAF      ZARG2=MIN(ZRK*ZTOP,200.)
-      ZARG2=MIN(ZRK*ZTOP,2.0d+2)
-      ZEXKP=EXP(ZARG2)
-      ZEXKM = 1./ZEXKP
-      ZXP2P = 1.+ZDT*ZRP
-      ZXM2P = 1.-ZDT*ZRP
-      ZAP2B = ZALPHA+ZDT*ZBETA
-      ZAM2B = ZALPHA-ZDT*ZBETA
-C
-C*         1.2     WITHOUT REFLECTION FROM THE UNDERLYING LAYER
-C
- 120  CONTINUE
-C
-      ZA11 = ZXP2P
-      ZA12 = ZXM2P
-      ZA13 = ZAP2B
-      ZA22 = ZXP2P*ZEXKP
-      ZA21 = ZXM2P*ZEXKM
-      ZA23 = ZAM2B*ZEXMU0
-      ZDENA = ZA11 * ZA22 - ZA21 * ZA12
-      ZC1A = (ZA22*ZA13-ZA12*ZA23)/ZDENA
-      ZC2A = (ZA11*ZA23-ZA21*ZA13)/ZDENA
-      ZRI0A = ZC1A+ZC2A-ZALPHA
-      ZRI1A = ZRP*(ZC1A-ZC2A)-ZBETA
-      PRE1(JL) = (ZRI0A-ZDT*ZRI1A)/ PRMUZ(JL)
-      ZRI0B = ZC1A*ZEXKM+ZC2A*ZEXKP-ZALPHA*ZEXMU0
-      ZRI1B = ZRP*(ZC1A*ZEXKM-ZC2A*ZEXKP)-ZBETA*ZEXMU0
-      PTR1(JL) = ZEXMU0+(ZRI0B+ZDT*ZRI1B)/ PRMUZ(JL)
-C
-C*         1.3     WITH REFLECTION FROM THE UNDERLYING LAYER
-C
- 130  CONTINUE
-C
-      ZB21 = ZA21- PREF(JL) *ZXP2P*ZEXKM
-      ZB22 = ZA22- PREF(JL) *ZXM2P*ZEXKP
-      ZB23 = ZA23- PREF(JL) *ZEXMU0*(ZAP2B - PRMUZ(JL) )
-      ZDENB = ZA11 * ZB22 - ZB21 * ZA12
-      ZC1B = (ZB22*ZA13-ZA12*ZB23)/ZDENB
-      ZC2B = (ZA11*ZB23-ZB21*ZA13)/ZDENB
-      ZRI0C = ZC1B+ZC2B-ZALPHA
-      ZRI1C = ZRP*(ZC1B-ZC2B)-ZBETA
-      PRE2(JL) = (ZRI0C-ZDT*ZRI1C) / PRMUZ(JL)
-      ZRI0D = ZC1B*ZEXKM + ZC2B*ZEXKP - ZALPHA*ZEXMU0
-      ZRI1D = ZRP * (ZC1B*ZEXKM - ZC2B*ZEXKP) - ZBETA*ZEXMU0
-      PTR2(JL) = ZEXMU0 + (ZRI0D + ZDT*ZRI1D) / PRMUZ(JL)
-C
- 131  CONTINUE
-      RETURN
-      END
-      SUBROUTINE SWTT (KNU,KA,PU,PTR)
-      IMPLICIT none
-#include "dimensions.h"
-#include "dimphy.h"
-#include "raddim.h"
-C
-C-----------------------------------------------------------------------
-C     PURPOSE.
-C     --------
-C           THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
-C     ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN THE TWO SPECTRAL
-C     INTERVALS.
-C
-C     METHOD.
-C     -------
-C
-C          TRANSMISSION FUNCTION ARE COMPUTED USING PADE APPROXIMANTS
-C     AND HORNER'S ALGORITHM.
-C
-C     REFERENCE.
-C     ----------
-C
-C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-C
-C     AUTHOR.
-C     -------
-C        JEAN-JACQUES MORCRETTE  *ECMWF*
-C
-C     MODIFICATIONS.
-C     --------------
-C        ORIGINAL : 88-12-15
-C-----------------------------------------------------------------------
-C
-C* ARGUMENTS
-C
-      INTEGER KNU     ! INDEX OF THE SPECTRAL INTERVAL
-      INTEGER KA      ! INDEX OF THE ABSORBER
-      REAL*8 PU(KDLON)  ! ABSORBER AMOUNT
-C
-      REAL*8 PTR(KDLON) ! TRANSMISSION FUNCTION
-C
-C* LOCAL VARIABLES:
-C
-      REAL*8 ZR1(KDLON), ZR2(KDLON)
-      INTEGER jl, i,j
-C
-C* Prescribed Data:
-C
-      REAL*8 APAD(2,3,7), BPAD(2,3,7), D(2,3)
-      SAVE APAD, BPAD, D
-      DATA ((APAD(1,I,J),I=1,3),J=1,7) /
-     S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04,
-     S 0.723613782E+05, 0.000000000E-00, 0.129353723E-01,
-     S 0.596037057E+04, 0.000000000E-00, 0.800821928E+00,
-     S 0.000000000E-00, 0.000000000E-00, 0.242715973E+02,
-     S 0.000000000E-00, 0.000000000E-00, 0.878331486E+02,
-     S 0.000000000E-00, 0.000000000E-00, 0.191559725E+02,
-     S 0.000000000E-00, 0.000000000E-00, 0.000000000E+00 /
-      DATA ((APAD(2,I,J),I=1,3),J=1,7) /
-     S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03,
-     S 0.978576773E-04, 0.131849595E-03, 0.672595424E+02,
-     S 0.387714006E+00, 0.437772681E+00, 0.000000000E-00,
-     S 0.118461660E+03, 0.151345118E+03, 0.000000000E-00,
-     S 0.119079797E+04, 0.233628890E+04, 0.000000000E-00,
-     S 0.293353397E+03, 0.797219934E+03, 0.000000000E-00,
-     S 0.000000000E+00, 0.000000000E+00, 0.000000000E+00 /
-C
-      DATA ((BPAD(1,I,J),I=1,3),J=1,7) /
-     S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04,
-     S 0.724555318E+05, 0.000000000E-00, 0.131812683E-01,
-     S 0.602593328E+04, 0.000000000E-00, 0.812706117E+00,
-     S 0.100000000E+01, 0.000000000E-00, 0.249863591E+02,
-     S 0.000000000E-00, 0.000000000E-00, 0.931071925E+02,
-     S 0.000000000E-00, 0.000000000E-00, 0.252233437E+02,
-     S 0.000000000E-00, 0.000000000E-00, 0.100000000E+01 /
-      DATA ((BPAD(2,I,J),I=1,3),J=1,7) /
-     S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03,
-     S 0.979023421E-04, 0.131861712E-03, 0.731185438E+02,
-     S 0.388611139E+00, 0.437949001E+00, 0.100000000E+01,
-     S 0.120291383E+03, 0.151692730E+03, 0.000000000E+00,
-     S 0.130531005E+04, 0.237071130E+04, 0.000000000E+00,
-     S 0.415049409E+03, 0.867914360E+03, 0.000000000E+00,
-     S 0.100000000E+01, 0.100000000E+01, 0.000000000E+00 /
-c
-      DATA (D(1,I),I=1,3) / 0.00, 0.00, 0.00 /
-      DATA (D(2,I),I=1,3) / 0.000000000, 0.000000000, 0.800000000 /
-C
-C-----------------------------------------------------------------------
-C
-C*         1.      HORNER'S ALGORITHM TO COMPUTE TRANSMISSION FUNCTION
-C
- 100  CONTINUE
-C
-      DO 201 JL = 1, KDLON
-      ZR1(JL) = APAD(KNU,KA,1) + PU(JL) * (APAD(KNU,KA,2) + PU(JL)
-     S      * ( APAD(KNU,KA,3) + PU(JL) * (APAD(KNU,KA,4) + PU(JL)
-     S      * ( APAD(KNU,KA,5) + PU(JL) * (APAD(KNU,KA,6) + PU(JL)
-     S      * ( APAD(KNU,KA,7) ))))))
-C
-      ZR2(JL) = BPAD(KNU,KA,1) + PU(JL) * (BPAD(KNU,KA,2) + PU(JL)
-     S      * ( BPAD(KNU,KA,3) + PU(JL) * (BPAD(KNU,KA,4) + PU(JL)
-     S      * ( BPAD(KNU,KA,5) + PU(JL) * (BPAD(KNU,KA,6) + PU(JL)
-     S      * ( BPAD(KNU,KA,7) ))))))
-C     
-C
-C*         2.      ADD THE BACKGROUND TRANSMISSION
-C
- 200  CONTINUE
-C
-C
-      PTR(JL) = (ZR1(JL) / ZR2(JL)) * (1. - D(KNU,KA)) + D(KNU,KA)
- 201  CONTINUE
-C
-      RETURN
-      END
-      SUBROUTINE SWTT1(KNU,KABS,KIND, PU, PTR)
-      IMPLICIT none
-#include "dimensions.h"
-#include "dimphy.h"
-#include "raddim.h"
-C
-C-----------------------------------------------------------------------
-C     PURPOSE.
-C     --------
-C           THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
-C     ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN THE TWO SPECTRAL
-C     INTERVALS.
-C
-C     METHOD.
-C     -------
-C
-C          TRANSMISSION FUNCTION ARE COMPUTED USING PADE APPROXIMANTS
-C     AND HORNER'S ALGORITHM.
-C
-C     REFERENCE.
-C     ----------
-C
-C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-C
-C     AUTHOR.
-C     -------
-C        JEAN-JACQUES MORCRETTE  *ECMWF*
-C
-C     MODIFICATIONS.
-C     --------------
-C        ORIGINAL : 95-01-20
-C-----------------------------------------------------------------------
-C* ARGUMENTS:
-C
-      INTEGER KNU          ! INDEX OF THE SPECTRAL INTERVAL
-      INTEGER KABS         ! NUMBER OF ABSORBERS
-      INTEGER KIND(KABS)   ! INDICES OF THE ABSORBERS
-      REAL*8 PU(KDLON,KABS)  ! ABSORBER AMOUNT
-C
-      REAL*8 PTR(KDLON,KABS) ! TRANSMISSION FUNCTION
-C
-C* LOCAL VARIABLES:
-C
-      REAL*8 ZR1(KDLON)
-      REAL*8 ZR2(KDLON)
-      REAL*8 ZU(KDLON)
-      INTEGER jl, ja, i, j, ia
-C
-C* Prescribed Data:
-C
-      REAL*8 APAD(2,3,7), BPAD(2,3,7), D(2,3)
-      SAVE APAD, BPAD, D
-      DATA ((APAD(1,I,J),I=1,3),J=1,7) /
-     S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04,
-     S 0.723613782E+05, 0.000000000E-00, 0.129353723E-01,
-     S 0.596037057E+04, 0.000000000E-00, 0.800821928E+00,
-     S 0.000000000E-00, 0.000000000E-00, 0.242715973E+02,
-     S 0.000000000E-00, 0.000000000E-00, 0.878331486E+02,
-     S 0.000000000E-00, 0.000000000E-00, 0.191559725E+02,
-     S 0.000000000E-00, 0.000000000E-00, 0.000000000E+00 /
-      DATA ((APAD(2,I,J),I=1,3),J=1,7) /
-     S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03,
-     S 0.978576773E-04, 0.131849595E-03, 0.672595424E+02,
-     S 0.387714006E+00, 0.437772681E+00, 0.000000000E-00,
-     S 0.118461660E+03, 0.151345118E+03, 0.000000000E-00,
-     S 0.119079797E+04, 0.233628890E+04, 0.000000000E-00,
-     S 0.293353397E+03, 0.797219934E+03, 0.000000000E-00,
-     S 0.000000000E+00, 0.000000000E+00, 0.000000000E+00 /
-C
-      DATA ((BPAD(1,I,J),I=1,3),J=1,7) /
-     S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04,
-     S 0.724555318E+05, 0.000000000E-00, 0.131812683E-01,
-     S 0.602593328E+04, 0.000000000E-00, 0.812706117E+00,
-     S 0.100000000E+01, 0.000000000E-00, 0.249863591E+02,
-     S 0.000000000E-00, 0.000000000E-00, 0.931071925E+02,
-     S 0.000000000E-00, 0.000000000E-00, 0.252233437E+02,
-     S 0.000000000E-00, 0.000000000E-00, 0.100000000E+01 /
-      DATA ((BPAD(2,I,J),I=1,3),J=1,7) /
-     S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03,
-     S 0.979023421E-04, 0.131861712E-03, 0.731185438E+02,
-     S 0.388611139E+00, 0.437949001E+00, 0.100000000E+01,
-     S 0.120291383E+03, 0.151692730E+03, 0.000000000E+00,
-     S 0.130531005E+04, 0.237071130E+04, 0.000000000E+00,
-     S 0.415049409E+03, 0.867914360E+03, 0.000000000E+00,
-     S 0.100000000E+01, 0.100000000E+01, 0.000000000E+00 /
-c
-      DATA (D(1,I),I=1,3) / 0.00, 0.00, 0.00 /
-      DATA (D(2,I),I=1,3) / 0.000000000, 0.000000000, 0.800000000 /
-C-----------------------------------------------------------------------
-C
-C*         1.      HORNER'S ALGORITHM TO COMPUTE TRANSMISSION FUNCTION
-C
- 100  CONTINUE
-C
-      DO 202 JA = 1,KABS
-      IA=KIND(JA)
-      DO 201 JL = 1, KDLON
-      ZU(JL) = PU(JL,JA)
-      ZR1(JL) = APAD(KNU,IA,1) + ZU(JL) * (APAD(KNU,IA,2) + ZU(JL)
-     S      * ( APAD(KNU,IA,3) + ZU(JL) * (APAD(KNU,IA,4) + ZU(JL)
-     S      * ( APAD(KNU,IA,5) + ZU(JL) * (APAD(KNU,IA,6) + ZU(JL)
-     S      * ( APAD(KNU,IA,7) ))))))
-C
-      ZR2(JL) = BPAD(KNU,IA,1) + ZU(JL) * (BPAD(KNU,IA,2) + ZU(JL)
-     S      * ( BPAD(KNU,IA,3) + ZU(JL) * (BPAD(KNU,IA,4) + ZU(JL)
-     S      * ( BPAD(KNU,IA,5) + ZU(JL) * (BPAD(KNU,IA,6) + ZU(JL)
-     S      * ( BPAD(KNU,IA,7) ))))))
-C     
-C
-C*         2.      ADD THE BACKGROUND TRANSMISSION
-C
- 200  CONTINUE
-C
-      PTR(JL,JA) = (ZR1(JL)/ZR2(JL)) * (1.-D(KNU,IA)) + D(KNU,IA) 
- 201  CONTINUE
- 202  CONTINUE
-C
-      RETURN
-      END
-      SUBROUTINE LW(RCO2,RCH4,RN2O,RCFC11,RCFC12,
-     .              PPMB, PDP,
-     .              PPSOL,PDT0,PEMIS,
-     .              PTL, PTAVE, PWV, POZON, PAER,
-     .              PCLDLD,PCLDLU,
-     .              PVIEW,
-     .              PCOLR, PCOLR0,
-     .              PTOPLW,PSOLLW,PTOPLW0,PSOLLW0)
-      IMPLICIT none
-#include "dimensions.h"
-#include "dimphy.h"
-#include "raddim.h"
-#include "raddimlw.h"
-#include "YOMCST.h"
-C
-C-----------------------------------------------------------------------
-C     METHOD.
-C     -------
-C
-C          1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF
-C     ABSORBERS.
-C          2. COMPUTES THE PLANCK FUNCTIONS ON THE INTERFACES AND THE
-C     GRADIENT OF PLANCK FUNCTIONS IN THE LAYERS.
-C          3. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING THE CON-
-C     TRIBUTIONS OF THE ADJACENT AND DISTANT LAYERS AND THOSE FROM THE
-C     BOUNDARIES.
-C          4. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES.
-C          5. INTRODUCES THE EFFECTS OF THE CLOUDS ON THE FLUXES.
-C
-C
-C     REFERENCE.
-C     ----------
-C
-C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-C
-C     AUTHOR.
-C     -------
-C        JEAN-JACQUES MORCRETTE  *ECMWF*
-C
-C     MODIFICATIONS.
-C     --------------
-C        ORIGINAL : 89-07-14
-C-----------------------------------------------------------------------
-      REAL*8 RCO2   ! CO2 CONCENTRATION (IPCC:353.E-06* 44.011/28.97)
-      REAL*8 RCH4   ! CH4 CONCENTRATION (IPCC: 1.72E-06* 16.043/28.97)
-      REAL*8 RN2O   ! N2O CONCENTRATION (IPCC: 310.E-09* 44.013/28.97)
-      REAL*8 RCFC11 ! CFC11 CONCENTRATION (IPCC: 280.E-12* 137.3686/28.97)
-      REAL*8 RCFC12 ! CFC12 CONCENTRATION (IPCC: 484.E-12* 120.9140/28.97)
-      REAL*8 PCLDLD(KDLON,KFLEV)  ! DOWNWARD EFFECTIVE CLOUD COVER
-      REAL*8 PCLDLU(KDLON,KFLEV)  ! UPWARD EFFECTIVE CLOUD COVER
-      REAL*8 PDP(KDLON,KFLEV)     ! LAYER PRESSURE THICKNESS (Pa)
-      REAL*8 PDT0(KDLON)          ! SURFACE TEMPERATURE DISCONTINUITY (K)
-      REAL*8 PEMIS(KDLON)         ! SURFACE EMISSIVITY
-      REAL*8 PPMB(KDLON,KFLEV+1)  ! HALF LEVEL PRESSURE (mb)
-      REAL*8 PPSOL(KDLON)         ! SURFACE PRESSURE (Pa)
-      REAL*8 POZON(KDLON,KFLEV)   ! O3 CONCENTRATION (kg/kg)
-      REAL*8 PTL(KDLON,KFLEV+1)   ! HALF LEVEL TEMPERATURE (K)
-      REAL*8 PAER(KDLON,KFLEV,5)  ! OPTICAL THICKNESS OF THE AEROSOLS
-      REAL*8 PTAVE(KDLON,KFLEV)   ! LAYER TEMPERATURE (K)
-      REAL*8 PVIEW(KDLON)         ! COSECANT OF VIEWING ANGLE
-      REAL*8 PWV(KDLON,KFLEV)     ! SPECIFIC HUMIDITY (kg/kg)
-C
-      REAL*8 PCOLR(KDLON,KFLEV)   ! LONG-WAVE TENDENCY (K/day)
-      REAL*8 PCOLR0(KDLON,KFLEV)  ! LONG-WAVE TENDENCY (K/day) clear-sky
-      REAL*8 PTOPLW(KDLON)        ! LONGWAVE FLUX AT T.O.A.
-      REAL*8 PSOLLW(KDLON)        ! LONGWAVE FLUX AT SURFACE
-      REAL*8 PTOPLW0(KDLON)       ! LONGWAVE FLUX AT T.O.A. (CLEAR-SKY)
-      REAL*8 PSOLLW0(KDLON)       ! LONGWAVE FLUX AT SURFACE (CLEAR-SKY)
-C
-C-------------------------------------------------------------------------
-      REAL*8 ZABCU(KDLON,NUA,3*KFLEV+1)
-      REAL*8 ZOZ(KDLON,KFLEV)
-c
-      REAL*8 ZFLUX(KDLON,2,KFLEV+1) ! RADIATIVE FLUXES (1:up; 2:down)
-      REAL*8 ZFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES
-      REAL*8 ZBINT(KDLON,KFLEV+1)            ! Intermediate variable
-      REAL*8 ZBSUI(KDLON)                    ! Intermediate variable
-      REAL*8 ZCTS(KDLON,KFLEV)               ! Intermediate variable
-      REAL*8 ZCNTRB(KDLON,KFLEV+1,KFLEV+1)   ! Intermediate variable
-      SAVE ZFLUX, ZFLUC, ZBINT, ZBSUI, ZCTS, ZCNTRB
-c
-      INTEGER ilim, i, k, kpl1
-C
-      INTEGER lw0pas ! Every lw0pas steps, clear-sky is done
-      PARAMETER (lw0pas=1)
-      INTEGER lwpas  ! Every lwpas steps, cloudy-sky is done
-      PARAMETER (lwpas=1)
-c
-      INTEGER itaplw0, itaplw
-      LOGICAL appel1er
-      SAVE appel1er, itaplw0, itaplw
-      DATA appel1er /.TRUE./
-      DATA itaplw0,itaplw /0,0/
-C     ------------------------------------------------------------------
-      IF (appel1er) THEN
-         PRINT*, "LW clear-sky calling frequency: ", lw0pas
-         PRINT*, "LW cloudy-sky calling frequency: ", lwpas
-         PRINT*, "   In general, they should be 1"
-         appel1er=.FALSE.
-      ENDIF
-C
-      IF (MOD(itaplw0,lw0pas).EQ.0) THEN
-      DO k = 1, KFLEV  ! convertir ozone de kg/kg en pa/pa
-      DO i = 1, KDLON
-         ZOZ(i,k) = POZON(i,k)*PDP(i,k) * 28.9644/47.9942
-      ENDDO
-      ENDDO
-      CALL LWU(RCO2,RCH4, RN2O, RCFC11, RCFC12,
-     S         PAER,PDP,PPMB,PPSOL,ZOZ,PTAVE,PVIEW,PWV,ZABCU)
-      CALL LWBV(ILIM,PDP,PDT0,PEMIS,PPMB,PTL,PTAVE,ZABCU,
-     S          ZFLUC,ZBINT,ZBSUI,ZCTS,ZCNTRB)
-      itaplw0 = 0
-      ENDIF
-      itaplw0 = itaplw0 + 1
-C
-      IF (MOD(itaplw,lwpas).EQ.0) THEN
-      CALL LWC(ILIM,PCLDLD,PCLDLU,PEMIS,
-     S         ZFLUC,ZBINT,ZBSUI,ZCTS,ZCNTRB,
-     S         ZFLUX)
-      itaplw = 0
-      ENDIF
-      itaplw = itaplw + 1
-C
-      DO k = 1, KFLEV
-         kpl1 = k+1
-         DO i = 1, KDLON
-            PCOLR(i,k) = ZFLUX(i,1,kpl1)+ZFLUX(i,2,kpl1)
-     .                 - ZFLUX(i,1,k)-   ZFLUX(i,2,k)
-            PCOLR(i,k) = PCOLR(i,k) * RDAY*RG/RCPD / PDP(i,k)
-            PCOLR0(i,k) = ZFLUC(i,1,kpl1)+ZFLUC(i,2,kpl1)
-     .                 - ZFLUC(i,1,k)-   ZFLUC(i,2,k)
-            PCOLR0(i,k) = PCOLR0(i,k) * RDAY*RG/RCPD / PDP(i,k)
-         ENDDO
-      ENDDO
-      DO i = 1, KDLON
-         PSOLLW(i) = -ZFLUX(i,1,1)-ZFLUX(i,2,1)
-         PTOPLW(i) = ZFLUX(i,1,KFLEV+1) + ZFLUX(i,2,KFLEV+1)
-c
-         PSOLLW0(i) = -ZFLUC(i,1,1)-ZFLUC(i,2,1)
-         PTOPLW0(i) = ZFLUC(i,1,KFLEV+1) + ZFLUC(i,2,KFLEV+1)
-      ENDDO
-C     ------------------------------------------------------------------
-      RETURN
-      END
-      SUBROUTINE LWU(RCO2, RCH4, RN2O, RCFC11, RCFC12,
-     S               PAER,PDP,PPMB,PPSOL,POZ,PTAVE,PVIEW,PWV,
-     S               PABCU)
-      IMPLICIT none
-#include "dimensions.h"
-#include "dimphy.h"
-#include "raddim.h"
-#include "raddimlw.h"
-#include "YOMCST.h"
-#include "radepsi.h"
-#include "radopt.h"
-C
-C     PURPOSE.
-C     --------
-C           COMPUTES ABSORBER AMOUNTS INCLUDING PRESSURE AND
-C           TEMPERATURE EFFECTS
-C
-C     METHOD.
-C     -------
-C
-C          1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF
-C     ABSORBERS.
-C
-C
-C     REFERENCE.
-C     ----------
-C
-C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-C
-C     AUTHOR.
-C     -------
-C        JEAN-JACQUES MORCRETTE  *ECMWF*
-C
-C     MODIFICATIONS.
-C     --------------
-C        ORIGINAL : 89-07-14
-C        Voigt lines (loop 404 modified) - JJM & PhD - 01/96
-C-----------------------------------------------------------------------
-C* ARGUMENTS:
-      REAL*8 RCO2
-      REAL*8 RCH4, RN2O, RCFC11, RCFC12
-      REAL*8 PAER(KDLON,KFLEV,5)
-      REAL*8 PDP(KDLON,KFLEV)
-      REAL*8 PPMB(KDLON,KFLEV+1)
-      REAL*8 PPSOL(KDLON)
-      REAL*8 POZ(KDLON,KFLEV)
-      REAL*8 PTAVE(KDLON,KFLEV)
-      REAL*8 PVIEW(KDLON)
-      REAL*8 PWV(KDLON,KFLEV)
-C
-      REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! EFFECTIVE ABSORBER AMOUNTS
-C
-C-----------------------------------------------------------------------
-C* LOCAL VARIABLES:
-      REAL*8 ZABLY(KDLON,NUA,3*KFLEV+1)
-      REAL*8 ZDUC(KDLON,3*KFLEV+1)
-      REAL*8 ZPHIO(KDLON)
-      REAL*8 ZPSC2(KDLON)
-      REAL*8 ZPSC3(KDLON)
-      REAL*8 ZPSH1(KDLON)
-      REAL*8 ZPSH2(KDLON)
-      REAL*8 ZPSH3(KDLON)
-      REAL*8 ZPSH4(KDLON)
-      REAL*8 ZPSH5(KDLON)
-      REAL*8 ZPSH6(KDLON)
-      REAL*8 ZPSIO(KDLON)
-      REAL*8 ZTCON(KDLON)
-      REAL*8 ZPHM6(KDLON)
-      REAL*8 ZPSM6(KDLON)
-      REAL*8 ZPHN6(KDLON)
-      REAL*8 ZPSN6(KDLON)
-      REAL*8 ZSSIG(KDLON,3*KFLEV+1)
-      REAL*8 ZTAVI(KDLON)
-      REAL*8 ZUAER(KDLON,Ninter)
-      REAL*8 ZXOZ(KDLON)
-      REAL*8 ZXWV(KDLON)
-C
-      INTEGER jl, jk, jkj, jkjr, jkjp, ig1
-      INTEGER jki, jkip1, ja, jj
-      INTEGER jkl, jkp1, jkk, jkjpn
-      INTEGER jae1, jae2, jae3, jae, jjpn
-      INTEGER ir, jc, jcp1
-      REAL*8 zdpm, zupm, zupmh2o, zupmco2, zupmo3, zu6, zup
-      REAL*8 zfppw, ztx, ztx2, zzably
-      REAL*8 zcah1, zcbh1, zcah2, zcbh2, zcah3, zcbh3
-      REAL*8 zcah4, zcbh4, zcah5, zcbh5, zcah6, zcbh6
-      REAL*8 zcac8, zcbc8
-      REAL*8 zalup, zdiff
-c
-      REAL*8 PVGCO2, PVGH2O, PVGO3
-C
-      REAL*8 R10E  ! DECIMAL/NATURAL LOG.FACTOR
-      PARAMETER (R10E=0.4342945)
-c
-c Used Data Block:
-c
-      REAL*8 TREF
-      SAVE TREF
-      REAL*8 RT1(2)
-      SAVE RT1
-      REAL*8 RAER(5,5)
-      SAVE RAER
-      REAL*8 AT(8,3), BT(8,3)
-      SAVE AT, BT
-      REAL*8 OCT(4)
-      SAVE OCT
-      DATA TREF /250.0/
-      DATA (RT1(IG1),IG1=1,2) / -0.577350269, +0.577350269 /
-      DATA RAER / .038520, .037196, .040532, .054934, .038520
-     1          , .12613 , .18313 , .10357 , .064106, .126130
-     2          , .012579, .013649, .018652, .025181, .012579
-     3          , .011890, .016142, .021105, .028908, .011890
-     4          , .013792, .026810, .052203, .066338, .013792 /
-      DATA (AT(1,IR),IR=1,3) /
-     S 0.298199E-02,-.394023E-03,0.319566E-04 /
-      DATA (BT(1,IR),IR=1,3) /
-     S-0.106432E-04,0.660324E-06,0.174356E-06 /
-      DATA (AT(2,IR),IR=1,3) /
-     S 0.143676E-01,0.366501E-02,-.160822E-02 /
-      DATA (BT(2,IR),IR=1,3) /
-     S-0.553979E-04,-.101701E-04,0.920868E-05 /
-      DATA (AT(3,IR),IR=1,3) /
-     S 0.197861E-01,0.315541E-02,-.174547E-02 /
-      DATA (BT(3,IR),IR=1,3) /
-     S-0.877012E-04,0.513302E-04,0.523138E-06 /
-      DATA (AT(4,IR),IR=1,3) /
-     S 0.289560E-01,-.208807E-02,-.121943E-02 /
-      DATA (BT(4,IR),IR=1,3) /
-     S-0.165960E-03,0.157704E-03,-.146427E-04 /
-      DATA (AT(5,IR),IR=1,3) /
-     S 0.103800E-01,0.436296E-02,-.161431E-02 /
-      DATA (BT(5,IR),IR=1,3) /
-     S -.276744E-04,-.327381E-04,0.127646E-04 /
-      DATA (AT(6,IR),IR=1,3) /
-     S 0.868859E-02,-.972752E-03,0.000000E-00 /
-      DATA (BT(6,IR),IR=1,3) /
-     S -.278412E-04,-.713940E-06,0.117469E-05 /
-      DATA (AT(7,IR),IR=1,3) /
-     S 0.250073E-03,0.455875E-03,0.109242E-03 /
-      DATA (BT(7,IR),IR=1,3) /
-     S 0.199846E-05,-.216313E-05,0.175991E-06 /
-      DATA (AT(8,IR),IR=1,3) /
-     S 0.307423E-01,0.110879E-02,-.322172E-03 /
-      DATA (BT(8,IR),IR=1,3) /
-     S-0.108482E-03,0.258096E-05,-.814575E-06 /
-c
-      DATA OCT /-.326E-03, -.102E-05, .137E-02, -.535E-05/
-C-----------------------------------------------------------------------
-c
-      IF (LEVOIGT) THEN
-         PVGCO2= 60.
-         PVGH2O= 30.
-         PVGO3 =400.
-      ELSE
-         PVGCO2= 0.
-         PVGH2O= 0.
-         PVGO3 = 0.
-      ENDIF
-C
-C
-C*         2.    PRESSURE OVER GAUSS SUB-LEVELS
-C                ------------------------------
-C
- 200  CONTINUE
-C
-      DO 201 JL = 1, KDLON
-      ZSSIG(JL, 1 ) = PPMB(JL,1) * 100.
- 201  CONTINUE
-C
-      DO 206 JK = 1 , KFLEV
-      JKJ=(JK-1)*NG1P1+1
-      JKJR = JKJ
-      JKJP = JKJ + NG1P1
-      DO 203 JL = 1, KDLON
-      ZSSIG(JL,JKJP)=PPMB(JL,JK+1)* 100.
- 203  CONTINUE
-      DO 205 IG1=1,NG1
-      JKJ=JKJ+1
-      DO 204 JL = 1, KDLON
-      ZSSIG(JL,JKJ)= (ZSSIG(JL,JKJR)+ZSSIG(JL,JKJP))*0.5
-     S  + RT1(IG1) * (ZSSIG(JL,JKJP) - ZSSIG(JL,JKJR)) * 0.5
- 204  CONTINUE
- 205  CONTINUE
- 206  CONTINUE
-C
-C-----------------------------------------------------------------------
-C
-C
-C*         4.    PRESSURE THICKNESS AND MEAN PRESSURE OF SUB-LAYERS
-C                --------------------------------------------------
-C
- 400  CONTINUE
-C
-      DO 402 JKI=1,3*KFLEV
-      JKIP1=JKI+1
-      DO 401 JL = 1, KDLON
-      ZABLY(JL,5,JKI)=(ZSSIG(JL,JKI)+ZSSIG(JL,JKIP1))*0.5
-      ZABLY(JL,3,JKI)=(ZSSIG(JL,JKI)-ZSSIG(JL,JKIP1))
-     S                                 /(10.*RG)
- 401  CONTINUE
- 402  CONTINUE
-C
-      DO 406 JK = 1 , KFLEV
-      JKP1=JK+1
-      JKL = KFLEV+1 - JK
-      DO 403 JL = 1, KDLON
-      ZXWV(JL) = MAX (PWV(JL,JK) , ZEPSCQ )
-      ZXOZ(JL) = MAX (POZ(JL,JK) / PDP(JL,JK) , ZEPSCO )
- 403  CONTINUE
-      JKJ=(JK-1)*NG1P1+1
-      JKJPN=JKJ+NG1
-      DO 405 JKK=JKJ,JKJPN
-      DO 404 JL = 1, KDLON
-      ZDPM = ZABLY(JL,3,JKK)
-      ZUPM = ZABLY(JL,5,JKK)             * ZDPM / 101325.
-      ZUPMCO2 = ( ZABLY(JL,5,JKK) + PVGCO2 ) * ZDPM / 101325.
-      ZUPMH2O = ( ZABLY(JL,5,JKK) + PVGH2O ) * ZDPM / 101325.
-      ZUPMO3  = ( ZABLY(JL,5,JKK) + PVGO3  ) * ZDPM / 101325.
-      ZDUC(JL,JKK) = ZDPM
-      ZABLY(JL,12,JKK) = ZXOZ(JL) * ZDPM
-      ZABLY(JL,13,JKK) = ZXOZ(JL) * ZUPMO3
-      ZU6 = ZXWV(JL) * ZUPM
-      ZFPPW = 1.6078 * ZXWV(JL) / (1.+0.608*ZXWV(JL))
-      ZABLY(JL,6,JKK) = ZXWV(JL) * ZUPMH2O
-      ZABLY(JL,11,JKK) = ZU6 * ZFPPW
-      ZABLY(JL,10,JKK) = ZU6 * (1.-ZFPPW)
-      ZABLY(JL,9,JKK) = RCO2 * ZUPMCO2
-      ZABLY(JL,8,JKK) = RCO2 * ZDPM
- 404  CONTINUE
- 405  CONTINUE
- 406  CONTINUE
-C
-C-----------------------------------------------------------------------
-C
-C
-C*         5.    CUMULATIVE ABSORBER AMOUNTS FROM TOP OF ATMOSPHERE
-C                --------------------------------------------------
-C
- 500  CONTINUE
-C
-      DO 502 JA = 1, NUA
-      DO 501 JL = 1, KDLON
-      PABCU(JL,JA,3*KFLEV+1) = 0.
-  501 CONTINUE
-  502 CONTINUE
-C
-      DO 529 JK = 1 , KFLEV
-      JJ=(JK-1)*NG1P1+1
-      JJPN=JJ+NG1
-      JKL=KFLEV+1-JK
-C
-C
-C*         5.1  CUMULATIVE AEROSOL AMOUNTS FROM TOP OF ATMOSPHERE
-C               --------------------------------------------------
-C
- 510  CONTINUE
-C
-      JAE1=3*KFLEV+1-JJ
-      JAE2=3*KFLEV+1-(JJ+1)
-      JAE3=3*KFLEV+1-JJPN
-      DO 512 JAE=1,5
-      DO 511 JL = 1, KDLON
-      ZUAER(JL,JAE) = (RAER(JAE,1)*PAER(JL,JKL,1)
-     S      +RAER(JAE,2)*PAER(JL,JKL,2)+RAER(JAE,3)*PAER(JL,JKL,3)
-     S      +RAER(JAE,4)*PAER(JL,JKL,4)+RAER(JAE,5)*PAER(JL,JKL,5))
-     S      /(ZDUC(JL,JAE1)+ZDUC(JL,JAE2)+ZDUC(JL,JAE3))
- 511  CONTINUE
- 512  CONTINUE
-C
-C
-C
-C*         5.2  INTRODUCES TEMPERATURE EFFECTS ON ABSORBER AMOUNTS
-C               --------------------------------------------------
-C
- 520  CONTINUE
-C
-      DO 521 JL = 1, KDLON
-      ZTAVI(JL)=PTAVE(JL,JKL)
-      ZTCON(JL)=EXP(6.08*(296./ZTAVI(JL)-1.))
-      ZTX=ZTAVI(JL)-TREF
-      ZTX2=ZTX*ZTX
-      ZZABLY = ZABLY(JL,6,JAE1)+ZABLY(JL,6,JAE2)+ZABLY(JL,6,JAE3)
-CMAF      ZUP=MIN( MAX( 0.5*R10E*LOG( ZZABLY ) + 5., 0.), 6.0)
-      ZUP=MIN( MAX( 0.5*R10E*LOG( ZZABLY ) + 5., 0.d+0), 6.d+0)
-      ZCAH1=AT(1,1)+ZUP*(AT(1,2)+ZUP*(AT(1,3)))
-      ZCBH1=BT(1,1)+ZUP*(BT(1,2)+ZUP*(BT(1,3)))
-      ZPSH1(JL)=EXP( ZCAH1 * ZTX + ZCBH1 * ZTX2 )
-      ZCAH2=AT(2,1)+ZUP*(AT(2,2)+ZUP*(AT(2,3)))
-      ZCBH2=BT(2,1)+ZUP*(BT(2,2)+ZUP*(BT(2,3)))
-      ZPSH2(JL)=EXP( ZCAH2 * ZTX + ZCBH2 * ZTX2 )
-      ZCAH3=AT(3,1)+ZUP*(AT(3,2)+ZUP*(AT(3,3)))
-      ZCBH3=BT(3,1)+ZUP*(BT(3,2)+ZUP*(BT(3,3)))
-      ZPSH3(JL)=EXP( ZCAH3 * ZTX + ZCBH3 * ZTX2 )
-      ZCAH4=AT(4,1)+ZUP*(AT(4,2)+ZUP*(AT(4,3)))
-      ZCBH4=BT(4,1)+ZUP*(BT(4,2)+ZUP*(BT(4,3)))
-      ZPSH4(JL)=EXP( ZCAH4 * ZTX + ZCBH4 * ZTX2 )
-      ZCAH5=AT(5,1)+ZUP*(AT(5,2)+ZUP*(AT(5,3)))
-      ZCBH5=BT(5,1)+ZUP*(BT(5,2)+ZUP*(BT(5,3)))
-      ZPSH5(JL)=EXP( ZCAH5 * ZTX + ZCBH5 * ZTX2 )
-      ZCAH6=AT(6,1)+ZUP*(AT(6,2)+ZUP*(AT(6,3)))
-      ZCBH6=BT(6,1)+ZUP*(BT(6,2)+ZUP*(BT(6,3)))
-      ZPSH6(JL)=EXP( ZCAH6 * ZTX + ZCBH6 * ZTX2 )
-      ZPHM6(JL)=EXP(-5.81E-4 * ZTX - 1.13E-6 * ZTX2 )
-      ZPSM6(JL)=EXP(-5.57E-4 * ZTX - 3.30E-6 * ZTX2 )
-      ZPHN6(JL)=EXP(-3.46E-5 * ZTX + 2.05E-7 * ZTX2 )
-      ZPSN6(JL)=EXP( 3.70E-3 * ZTX - 2.30E-6 * ZTX2 )
- 521  CONTINUE
-C
-      DO 522 JL = 1, KDLON
-      ZTAVI(JL)=PTAVE(JL,JKL)
-      ZTX=ZTAVI(JL)-TREF
-      ZTX2=ZTX*ZTX
-      ZZABLY = ZABLY(JL,9,JAE1)+ZABLY(JL,9,JAE2)+ZABLY(JL,9,JAE3)
-      ZALUP = R10E * LOG ( ZZABLY )
-CMAF      ZUP   = MAX( 0.0 , 5.0 + 0.5 * ZALUP )
-      ZUP   = MAX( 0.d+0 , 5.0 + 0.5 * ZALUP )
-      ZPSC2(JL) = (ZTAVI(JL)/TREF) ** ZUP
-      ZCAC8=AT(8,1)+ZUP*(AT(8,2)+ZUP*(AT(8,3)))
-      ZCBC8=BT(8,1)+ZUP*(BT(8,2)+ZUP*(BT(8,3)))
-      ZPSC3(JL)=EXP( ZCAC8 * ZTX + ZCBC8 * ZTX2 )
-      ZPHIO(JL) = EXP( OCT(1) * ZTX + OCT(2) * ZTX2)
-      ZPSIO(JL) = EXP( 2.* (OCT(3)*ZTX+OCT(4)*ZTX2))
- 522  CONTINUE
-C
-      DO 524 JKK=JJ,JJPN
-      JC=3*KFLEV+1-JKK
-      JCP1=JC+1
-      DO 523 JL = 1, KDLON
-      ZDIFF = PVIEW(JL)
-      PABCU(JL,10,JC)=PABCU(JL,10,JCP1)
-     S                +ZABLY(JL,10,JC)           *ZDIFF
-      PABCU(JL,11,JC)=PABCU(JL,11,JCP1)
-     S                +ZABLY(JL,11,JC)*ZTCON(JL)*ZDIFF
-C
-      PABCU(JL,12,JC)=PABCU(JL,12,JCP1)
-     S                +ZABLY(JL,12,JC)*ZPHIO(JL)*ZDIFF
-      PABCU(JL,13,JC)=PABCU(JL,13,JCP1)
-     S                +ZABLY(JL,13,JC)*ZPSIO(JL)*ZDIFF
-C
-      PABCU(JL,7,JC)=PABCU(JL,7,JCP1)
-     S               +ZABLY(JL,9,JC)*ZPSC2(JL)*ZDIFF
-      PABCU(JL,8,JC)=PABCU(JL,8,JCP1)
-     S               +ZABLY(JL,9,JC)*ZPSC3(JL)*ZDIFF
-      PABCU(JL,9,JC)=PABCU(JL,9,JCP1)
-     S               +ZABLY(JL,9,JC)*ZPSC3(JL)*ZDIFF
-C
-      PABCU(JL,1,JC)=PABCU(JL,1,JCP1)
-     S               +ZABLY(JL,6,JC)*ZPSH1(JL)*ZDIFF
-      PABCU(JL,2,JC)=PABCU(JL,2,JCP1)
-     S               +ZABLY(JL,6,JC)*ZPSH2(JL)*ZDIFF
-      PABCU(JL,3,JC)=PABCU(JL,3,JCP1)
-     S               +ZABLY(JL,6,JC)*ZPSH5(JL)*ZDIFF
-      PABCU(JL,4,JC)=PABCU(JL,4,JCP1)
-     S               +ZABLY(JL,6,JC)*ZPSH3(JL)*ZDIFF
-      PABCU(JL,5,JC)=PABCU(JL,5,JCP1)
-     S               +ZABLY(JL,6,JC)*ZPSH4(JL)*ZDIFF
-      PABCU(JL,6,JC)=PABCU(JL,6,JCP1)
-     S               +ZABLY(JL,6,JC)*ZPSH6(JL)*ZDIFF
-C
-      PABCU(JL,14,JC)=PABCU(JL,14,JCP1)
-     S                +ZUAER(JL,1)    *ZDUC(JL,JC)*ZDIFF
-      PABCU(JL,15,JC)=PABCU(JL,15,JCP1)
-     S                +ZUAER(JL,2)    *ZDUC(JL,JC)*ZDIFF
-      PABCU(JL,16,JC)=PABCU(JL,16,JCP1)
-     S                +ZUAER(JL,3)    *ZDUC(JL,JC)*ZDIFF
-      PABCU(JL,17,JC)=PABCU(JL,17,JCP1)
-     S                +ZUAER(JL,4)    *ZDUC(JL,JC)*ZDIFF
-      PABCU(JL,18,JC)=PABCU(JL,18,JCP1)
-     S                +ZUAER(JL,5)    *ZDUC(JL,JC)*ZDIFF
-C
-      PABCU(JL,19,JC)=PABCU(JL,19,JCP1)
-     S               +ZABLY(JL,8,JC)*RCH4/RCO2*ZPHM6(JL)*ZDIFF
-      PABCU(JL,20,JC)=PABCU(JL,20,JCP1)
-     S               +ZABLY(JL,9,JC)*RCH4/RCO2*ZPSM6(JL)*ZDIFF
-      PABCU(JL,21,JC)=PABCU(JL,21,JCP1)
-     S               +ZABLY(JL,8,JC)*RN2O/RCO2*ZPHN6(JL)*ZDIFF
-      PABCU(JL,22,JC)=PABCU(JL,22,JCP1)
-     S               +ZABLY(JL,9,JC)*RN2O/RCO2*ZPSN6(JL)*ZDIFF
-C
-      PABCU(JL,23,JC)=PABCU(JL,23,JCP1)
-     S               +ZABLY(JL,8,JC)*RCFC11/RCO2         *ZDIFF
-      PABCU(JL,24,JC)=PABCU(JL,24,JCP1)
-     S               +ZABLY(JL,8,JC)*RCFC12/RCO2         *ZDIFF
- 523  CONTINUE
- 524  CONTINUE
-C
- 529  CONTINUE
-C
-C
-      RETURN
-      END
-      SUBROUTINE LWBV(KLIM,PDP,PDT0,PEMIS,PPMB,PTL,PTAVE,PABCU,
-     S                PFLUC,PBINT,PBSUI,PCTS,PCNTRB)
-      IMPLICIT none
-#include "dimensions.h"
-#include "dimphy.h"
-#include "raddim.h"
-#include "raddimlw.h"
-#include "YOMCST.h"
-C
-C     PURPOSE.
-C     --------
-C           TO COMPUTE THE PLANCK FUNCTION AND PERFORM THE
-C           VERTICAL INTEGRATION. SPLIT OUT FROM LW FOR MEMORY
-C           SAVING
-C
-C     METHOD.
-C     -------
-C
-C          1. COMPUTES THE PLANCK FUNCTIONS ON THE INTERFACES AND THE
-C     GRADIENT OF PLANCK FUNCTIONS IN THE LAYERS.
-C          2. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING THE CON-
-C     TRIBUTIONS OF THE ADJACENT AND DISTANT LAYERS AND THOSE FROM THE
-C     BOUNDARIES.
-C          3. COMPUTES THE CLEAR-SKY COOLING RATES.
-C
-C     REFERENCE.
-C     ----------
-C
-C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-C
-C     AUTHOR.
-C     -------
-C        JEAN-JACQUES MORCRETTE  *ECMWF*
-C
-C     MODIFICATIONS.
-C     --------------
-C        ORIGINAL : 89-07-14
-C        MODIFICATION : 93-10-15 M.HAMRUD (SPLIT OUT FROM LW TO SAVE
-C                                          MEMORY)
-C-----------------------------------------------------------------------
-C* ARGUMENTS:
-      INTEGER KLIM
-C
-      REAL*8 PDP(KDLON,KFLEV)
-      REAL*8 PDT0(KDLON)
-      REAL*8 PEMIS(KDLON)
-      REAL*8 PPMB(KDLON,KFLEV+1)
-      REAL*8 PTL(KDLON,KFLEV+1)
-      REAL*8 PTAVE(KDLON,KFLEV)
-C
-      REAL*8 PFLUC(KDLON,2,KFLEV+1)
-C     
-      REAL*8 PABCU(KDLON,NUA,3*KFLEV+1)
-      REAL*8 PBINT(KDLON,KFLEV+1)
-      REAL*8 PBSUI(KDLON)
-      REAL*8 PCTS(KDLON,KFLEV)
-      REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1)
-C
-C-------------------------------------------------------------------------
-C
-C* LOCAL VARIABLES:
-      REAL*8 ZB(KDLON,Ninter,KFLEV+1)
-      REAL*8 ZBSUR(KDLON,Ninter)
-      REAL*8 ZBTOP(KDLON,Ninter)
-      REAL*8 ZDBSL(KDLON,Ninter,KFLEV*2)
-      REAL*8 ZGA(KDLON,8,2,KFLEV)
-      REAL*8 ZGB(KDLON,8,2,KFLEV)
-      REAL*8 ZGASUR(KDLON,8,2)
-      REAL*8 ZGBSUR(KDLON,8,2)
-      REAL*8 ZGATOP(KDLON,8,2)
-      REAL*8 ZGBTOP(KDLON,8,2)
-C
-      INTEGER nuaer, ntraer
-C     ------------------------------------------------------------------
-C* COMPUTES PLANCK FUNCTIONS:
-       CALL LWB(PDT0,PTAVE,PTL,
-     S          ZB,PBINT,PBSUI,ZBSUR,ZBTOP,ZDBSL,
-     S          ZGA,ZGB,ZGASUR,ZGBSUR,ZGATOP,ZGBTOP)
-C     ------------------------------------------------------------------
-C* PERFORMS THE VERTICAL INTEGRATION:
-      NUAER = NUA
-      NTRAER = NTRA
-      CALL LWV(NUAER,NTRAER, KLIM
-     R  , PABCU,ZB,PBINT,PBSUI,ZBSUR,ZBTOP,ZDBSL,PEMIS,PPMB,PTAVE
-     R  , ZGA,ZGB,ZGASUR,ZGBSUR,ZGATOP,ZGBTOP
-     S  , PCNTRB,PCTS,PFLUC)
-C     ------------------------------------------------------------------
-      RETURN
-      END
-      SUBROUTINE LWC(KLIM,PCLDLD,PCLDLU,PEMIS,PFLUC,
-     R               PBINT,PBSUIN,PCTS,PCNTRB,
-     S               PFLUX)
-      IMPLICIT none
-#include "dimensions.h"
-#include "dimphy.h"
-#include "raddim.h"
-#include "radepsi.h"
-#include "radopt.h"
-C
-C     PURPOSE.
-C     --------
-C           INTRODUCES CLOUD EFFECTS ON LONGWAVE FLUXES OR
-C           RADIANCES
-C
-C        EXPLICIT ARGUMENTS :
-C        --------------------
-C     ==== INPUTS ===
-C PBINT  : (KDLON,0:KFLEV)     ; HALF LEVEL PLANCK FUNCTION
-C PBSUIN : (KDLON)             ; SURFACE PLANCK FUNCTION
-C PCLDLD : (KDLON,KFLEV)       ; DOWNWARD EFFECTIVE CLOUD FRACTION
-C PCLDLU : (KDLON,KFLEV)       ; UPWARD EFFECTIVE CLOUD FRACTION
-C PCNTRB : (KDLON,KFLEV+1,KFLEV+1); CLEAR-SKY ENERGY EXCHANGE
-C PCTS   : (KDLON,KFLEV)       ; CLEAR-SKY LAYER COOLING-TO-SPACE
-C PEMIS  : (KDLON)             ; SURFACE EMISSIVITY
-C PFLUC
-C     ==== OUTPUTS ===
-C PFLUX(KDLON,2,KFLEV)         ; RADIATIVE FLUXES :
-C                     1  ==>  UPWARD   FLUX TOTAL
-C                     2  ==>  DOWNWARD FLUX TOTAL
-C
-C     METHOD.
-C     -------
-C
-C          1. INITIALIZES ALL FLUXES TO CLEAR-SKY VALUES
-C          2. EFFECT OF ONE OVERCAST UNITY EMISSIVITY CLOUD LAYER
-C          3. EFFECT OF SEMI-TRANSPARENT, PARTIAL OR MULTI-LAYERED
-C     CLOUDS
-C
-C     REFERENCE.
-C     ----------
-C
-C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-C
-C     AUTHOR.
-C     -------
-C        JEAN-JACQUES MORCRETTE  *ECMWF*
-C
-C     MODIFICATIONS.
-C     --------------
-C        ORIGINAL : 89-07-14
-C        Voigt lines (loop 231 to 233)  - JJM & PhD - 01/96
-C-----------------------------------------------------------------------
-C* ARGUMENTS:
-      INTEGER klim
-      REAL*8 PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES
-      REAL*8 PBINT(KDLON,KFLEV+1)   ! HALF LEVEL PLANCK FUNCTION
-      REAL*8 PBSUIN(KDLON)          ! SURFACE PLANCK FUNCTION
-      REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) !CLEAR-SKY ENERGY EXCHANGE
-      REAL*8 PCTS(KDLON,KFLEV)      ! CLEAR-SKY LAYER COOLING-TO-SPACE
-c
-      REAL*8 PCLDLD(KDLON,KFLEV)
-      REAL*8 PCLDLU(KDLON,KFLEV)
-      REAL*8 PEMIS(KDLON)
-C
-      REAL*8 PFLUX(KDLON,2,KFLEV+1)
-C-----------------------------------------------------------------------
-C* LOCAL VARIABLES:
-      INTEGER IMX(KDLON), IMXP(KDLON)
-C
-      REAL*8 ZCLEAR(KDLON),ZCLOUD(KDLON),ZDNF(KDLON,KFLEV+1,KFLEV+1)
-     S  , ZFD(KDLON), ZFN10(KDLON), ZFU(KDLON)
-     S  , ZUPF(KDLON,KFLEV+1,KFLEV+1)
-      REAL*8 ZCLM(KDLON,KFLEV+1,KFLEV+1)
-C
-      INTEGER jk, jl, imaxc, imx1, imx2, jkj, jkp1, jkm1
-      INTEGER jk1, jk2, jkc, jkcp1, jcloud
-      INTEGER imxm1, imxp1
-      REAL*8 zcfrac
-C     ------------------------------------------------------------------
-C
-C*         1.     INITIALIZATION
-C                 --------------
-C
- 100  CONTINUE
-C
-      IMAXC = 0
-C
-      DO 101 JL = 1, KDLON
-      IMX(JL)=0
-      IMXP(JL)=0
-      ZCLOUD(JL) = 0.
- 101  CONTINUE
-C
-C*         1.1    SEARCH THE LAYER INDEX OF THE HIGHEST CLOUD
-C                 -------------------------------------------
-C
- 110  CONTINUE
-C
-      DO 112 JK = 1 , KFLEV
-      DO 111 JL = 1, KDLON
-      IMX1=IMX(JL)
-      IMX2=JK
-      IF (PCLDLU(JL,JK).GT.ZEPSC) THEN
-         IMXP(JL)=IMX2
-      ELSE
-         IMXP(JL)=IMX1
-      END IF
-      IMAXC=MAX(IMXP(JL),IMAXC)
-      IMX(JL)=IMXP(JL)
- 111  CONTINUE
- 112  CONTINUE
-CGM*******
-      IMAXC=KFLEV
-CGM*******
-C
-      DO 114 JK = 1 , KFLEV+1
-      DO 113 JL = 1, KDLON
-      PFLUX(JL,1,JK) = PFLUC(JL,1,JK)
-      PFLUX(JL,2,JK) = PFLUC(JL,2,JK)
- 113  CONTINUE
- 114  CONTINUE
-C
-C     ------------------------------------------------------------------
-C
-C*         2.      EFFECT OF CLOUDINESS ON LONGWAVE FLUXES
-C                  ---------------------------------------
-C
-      IF (IMAXC.GT.0) THEN
-C
-         IMXP1 = IMAXC + 1
-         IMXM1 = IMAXC - 1
-C
-C*         2.0     INITIALIZE TO CLEAR-SKY FLUXES
-C                  ------------------------------
-C
- 200  CONTINUE
-C
-         DO 203 JK1=1,KFLEV+1
-         DO 202 JK2=1,KFLEV+1
-         DO 201 JL = 1, KDLON
-         ZUPF(JL,JK2,JK1)=PFLUC(JL,1,JK1)
-         ZDNF(JL,JK2,JK1)=PFLUC(JL,2,JK1)
- 201     CONTINUE
- 202     CONTINUE
- 203     CONTINUE
-C
-C*         2.1     FLUXES FOR ONE OVERCAST UNITY EMISSIVITY CLOUD
-C                  ----------------------------------------------
-C
- 210  CONTINUE
-C
-         DO 213 JKC = 1 , IMAXC
-         JCLOUD=JKC
-         JKCP1=JCLOUD+1
-C
-C*         2.1.1   ABOVE THE CLOUD
-C                  ---------------
-C
- 2110 CONTINUE
-C
-         DO 2115 JK=JKCP1,KFLEV+1
-         JKM1=JK-1
-         DO 2111 JL = 1, KDLON
-         ZFU(JL)=0.
- 2111    CONTINUE
-         IF (JK .GT. JKCP1) THEN
-            DO 2113 JKJ=JKCP1,JKM1
-            DO 2112 JL = 1, KDLON
-            ZFU(JL) = ZFU(JL) + PCNTRB(JL,JK,JKJ)
- 2112       CONTINUE
- 2113       CONTINUE
-         END IF
-C
-         DO 2114 JL = 1, KDLON
-         ZUPF(JL,JKCP1,JK)=PBINT(JL,JK)-ZFU(JL)
- 2114    CONTINUE
- 2115    CONTINUE
-C
-C*         2.1.2   BELOW THE CLOUD
-C                  ---------------
-C
- 2120 CONTINUE
-C
-         DO 2125 JK=1,JCLOUD
-         JKP1=JK+1
-         DO 2121 JL = 1, KDLON
-         ZFD(JL)=0.
- 2121    CONTINUE
-C
-         IF (JK .LT. JCLOUD) THEN
-            DO 2123 JKJ=JKP1,JCLOUD
-            DO 2122 JL = 1, KDLON
-            ZFD(JL) = ZFD(JL) + PCNTRB(JL,JK,JKJ)
- 2122       CONTINUE
- 2123       CONTINUE
-         END IF
-         DO 2124 JL = 1, KDLON
-         ZDNF(JL,JKCP1,JK)=-PBINT(JL,JK)-ZFD(JL)
- 2124    CONTINUE
- 2125    CONTINUE
-C
- 213     CONTINUE
-C
-C
-C*         2.2     CLOUD COVER MATRIX
-C                  ------------------
-C
-C*    ZCLM(JK1,JK2) IS THE OBSCURATION FACTOR BY CLOUD LAYERS BETWEEN
-C     HALF-LEVELS JK1 AND JK2 AS SEEN FROM JK1
-C
- 220  CONTINUE
-C
-      DO 223 JK1 = 1 , KFLEV+1
-      DO 222 JK2 = 1 , KFLEV+1
-      DO 221 JL = 1, KDLON
-      ZCLM(JL,JK1,JK2) = 0.
- 221  CONTINUE
- 222  CONTINUE
- 223  CONTINUE
-C
-C
-C
-C*         2.4     CLOUD COVER BELOW THE LEVEL OF CALCULATION
-C                  ------------------------------------------
-C
- 240  CONTINUE
-C
-      DO 244 JK1 = 2 , KFLEV+1
-      DO 241 JL = 1, KDLON
-      ZCLEAR(JL)=1.
-      ZCLOUD(JL)=0.
- 241  CONTINUE
-      DO 243 JK = JK1 - 1 , 1 , -1
-      DO 242 JL = 1, KDLON
-      IF (NOVLP.EQ.1) THEN
-c* maximum-random       
-         ZCLEAR(JL)=ZCLEAR(JL)*(1.0-MAX(PCLDLU(JL,JK),ZCLOUD(JL)))
-     *                        /(1.0-MIN(ZCLOUD(JL),1.-ZEPSEC))
-         ZCLM(JL,JK1,JK) = 1.0 - ZCLEAR(JL)
-         ZCLOUD(JL) = PCLDLU(JL,JK)
-      ELSE IF (NOVLP.EQ.2) THEN 
-c* maximum      
-         ZCLOUD(JL) = MAX(ZCLOUD(JL) , PCLDLU(JL,JK))
-         ZCLM(JL,JK1,JK) = ZCLOUD(JL)
-      ELSE IF (NOVLP.EQ.3) THEN
-c* random      
-         ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - PCLDLU(JL,JK))
-         ZCLOUD(JL) = 1.0 - ZCLEAR(JL)
-         ZCLM(JL,JK1,JK) = ZCLOUD(JL)
-      END IF
- 242  CONTINUE
- 243  CONTINUE
- 244  CONTINUE
-C
-C
-C*         2.5     CLOUD COVER ABOVE THE LEVEL OF CALCULATION
-C                  ------------------------------------------
-C
- 250  CONTINUE
-C
-      DO 254 JK1 = 1 , KFLEV
-      DO 251 JL = 1, KDLON
-      ZCLEAR(JL)=1.
-      ZCLOUD(JL)=0.
- 251  CONTINUE
-      DO 253 JK = JK1 , KFLEV
-      DO 252 JL = 1, KDLON
-      IF (NOVLP.EQ.1) THEN
-c* maximum-random       
-         ZCLEAR(JL)=ZCLEAR(JL)*(1.0-MAX(PCLDLD(JL,JK),ZCLOUD(JL)))
-     *                        /(1.0-MIN(ZCLOUD(JL),1.-ZEPSEC))
-         ZCLM(JL,JK1,JK) = 1.0 - ZCLEAR(JL)
-         ZCLOUD(JL) = PCLDLD(JL,JK)
-      ELSE IF (NOVLP.EQ.2) THEN 
-c* maximum      
-         ZCLOUD(JL) = MAX(ZCLOUD(JL) , PCLDLD(JL,JK))
-         ZCLM(JL,JK1,JK) = ZCLOUD(JL)
-      ELSE IF (NOVLP.EQ.3) THEN
-c* random      
-         ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - PCLDLD(JL,JK))
-         ZCLOUD(JL) = 1.0 - ZCLEAR(JL)
-         ZCLM(JL,JK1,JK) = ZCLOUD(JL)
-      END IF
- 252  CONTINUE
- 253  CONTINUE
- 254  CONTINUE
-C
-C
-C
-C*         3.      FLUXES FOR PARTIAL/MULTIPLE LAYERED CLOUDINESS
-C                  ----------------------------------------------
-C
- 300  CONTINUE
-C
-C*         3.1     DOWNWARD FLUXES
-C                  ---------------
-C
- 310  CONTINUE
-C
-      DO 311 JL = 1, KDLON
-      PFLUX(JL,2,KFLEV+1) = 0.
- 311  CONTINUE
-C
-      DO 317 JK1 = KFLEV , 1 , -1
-C
-C*                 CONTRIBUTION FROM CLEAR-SKY FRACTION
-C
-      DO 312 JL = 1, KDLON
-      ZFD (JL) = (1. - ZCLM(JL,JK1,KFLEV)) * ZDNF(JL,1,JK1)
- 312  CONTINUE
-C
-C*                 CONTRIBUTION FROM ADJACENT CLOUD
-C
-      DO 313 JL = 1, KDLON
-      ZFD(JL) = ZFD(JL) + ZCLM(JL,JK1,JK1) * ZDNF(JL,JK1+1,JK1)
- 313  CONTINUE
-C
-C*                 CONTRIBUTION FROM OTHER CLOUDY FRACTIONS
-C
-      DO 315 JK = KFLEV-1 , JK1 , -1
-      DO 314 JL = 1, KDLON
-      ZCFRAC = ZCLM(JL,JK1,JK+1) - ZCLM(JL,JK1,JK)
-      ZFD(JL) =  ZFD(JL) + ZCFRAC * ZDNF(JL,JK+2,JK1)
- 314  CONTINUE
- 315  CONTINUE
-C
-      DO 316 JL = 1, KDLON
-      PFLUX(JL,2,JK1) = ZFD (JL)
- 316  CONTINUE
-C
- 317  CONTINUE
-C
-C
-C
-C
-C*         3.2     UPWARD FLUX AT THE SURFACE
-C                  --------------------------
-C
- 320  CONTINUE
-C
-      DO 321 JL = 1, KDLON
-      PFLUX(JL,1,1) = PEMIS(JL)*PBSUIN(JL)-(1.-PEMIS(JL))*PFLUX(JL,2,1)
- 321  CONTINUE
-C
-C
-C
-C*         3.3     UPWARD FLUXES
-C                  -------------
-C
- 330  CONTINUE
-C
-      DO 337 JK1 = 2 , KFLEV+1
-C
-C*                 CONTRIBUTION FROM CLEAR-SKY FRACTION
-C
-      DO 332 JL = 1, KDLON
-      ZFU (JL) = (1. - ZCLM(JL,JK1,1)) * ZUPF(JL,1,JK1)
- 332  CONTINUE
-C
-C*                 CONTRIBUTION FROM ADJACENT CLOUD
-C
-      DO 333 JL = 1, KDLON
-      ZFU(JL) =  ZFU(JL) + ZCLM(JL,JK1,JK1-1) * ZUPF(JL,JK1,JK1)
- 333  CONTINUE
-C
-C*                 CONTRIBUTION FROM OTHER CLOUDY FRACTIONS
-C
-      DO 335 JK = 2 , JK1-1
-      DO 334 JL = 1, KDLON
-      ZCFRAC = ZCLM(JL,JK1,JK-1) - ZCLM(JL,JK1,JK)
-      ZFU(JL) =  ZFU(JL) + ZCFRAC * ZUPF(JL,JK  ,JK1)
- 334  CONTINUE
- 335  CONTINUE
-C
-      DO 336 JL = 1, KDLON
-      PFLUX(JL,1,JK1) = ZFU (JL)
- 336  CONTINUE
-C
- 337  CONTINUE
-C
-C
-      END IF
-C
-C
-C*         2.3     END OF CLOUD EFFECT COMPUTATIONS
-C
- 230  CONTINUE
-C
-      IF (.NOT.LEVOIGT) THEN
-        DO 231 JL = 1, KDLON
-        ZFN10(JL) = PFLUX(JL,1,KLIM) + PFLUX(JL,2,KLIM)
- 231    CONTINUE
-        DO 233 JK = KLIM+1 , KFLEV+1
-        DO 232 JL = 1, KDLON
-        ZFN10(JL) = ZFN10(JL) + PCTS(JL,JK-1)
-        PFLUX(JL,1,JK) = ZFN10(JL)
-        PFLUX(JL,2,JK) = 0.0
- 232    CONTINUE
- 233    CONTINUE
-      ENDIF
-C
-      RETURN
-      END
-      SUBROUTINE LWB(PDT0,PTAVE,PTL
-     S  , PB,PBINT,PBSUIN,PBSUR,PBTOP,PDBSL
-     S  , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP)
-      IMPLICIT none
-#include "dimensions.h"
-#include "dimphy.h"
-#include "raddim.h"
-#include "raddimlw.h"
-C
-C-----------------------------------------------------------------------
-C     PURPOSE.
-C     --------
-C           COMPUTES PLANCK FUNCTIONS
-C
-C        EXPLICIT ARGUMENTS :
-C        --------------------
-C     ==== INPUTS ===
-C PDT0   : (KDLON)             ; SURFACE TEMPERATURE DISCONTINUITY
-C PTAVE  : (KDLON,KFLEV)       ; TEMPERATURE
-C PTL    : (KDLON,0:KFLEV)     ; HALF LEVEL TEMPERATURE
-C     ==== OUTPUTS ===
-C PB     : (KDLON,Ninter,KFLEV+1); SPECTRAL HALF LEVEL PLANCK FUNCTION
-C PBINT  : (KDLON,KFLEV+1)     ; HALF LEVEL PLANCK FUNCTION
-C PBSUIN : (KDLON)             ; SURFACE PLANCK FUNCTION
-C PBSUR  : (KDLON,Ninter)        ; SURFACE SPECTRAL PLANCK FUNCTION
-C PBTOP  : (KDLON,Ninter)        ; TOP SPECTRAL PLANCK FUNCTION
-C PDBSL  : (KDLON,Ninter,KFLEV*2); SUB-LAYER PLANCK FUNCTION GRADIENT
-C PGA    : (KDLON,8,2,KFLEV); dB/dT-weighted LAYER PADE APPROXIMANTS
-C PGB    : (KDLON,8,2,KFLEV); dB/dT-weighted LAYER PADE APPROXIMANTS
-C PGASUR, PGBSUR (KDLON,8,2)   ; SURFACE PADE APPROXIMANTS
-C PGATOP, PGBTOP (KDLON,8,2)   ; T.O.A. PADE APPROXIMANTS
-C
-C        IMPLICIT ARGUMENTS :   NONE
-C        --------------------
-C
-C     METHOD.
-C     -------
-C
-C          1. COMPUTES THE PLANCK FUNCTION ON ALL LEVELS AND HALF LEVELS
-C     FROM A POLYNOMIAL DEVELOPMENT OF PLANCK FUNCTION
-C
-C     REFERENCE.
-C     ----------
-C
-C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS           "
-C
-C     AUTHOR.
-C     -------
-C        JEAN-JACQUES MORCRETTE  *ECMWF*
-C
-C     MODIFICATIONS.
-C     --------------
-C        ORIGINAL : 89-07-14
-C
-C-----------------------------------------------------------------------
-C
-C ARGUMENTS:
-C
-      REAL*8 PDT0(KDLON)
-      REAL*8 PTAVE(KDLON,KFLEV)
-      REAL*8 PTL(KDLON,KFLEV+1)
-C
-      REAL*8 PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF LEVEL PLANCK FUNCTION
-      REAL*8 PBINT(KDLON,KFLEV+1) ! HALF LEVEL PLANCK FUNCTION
-      REAL*8 PBSUIN(KDLON) ! SURFACE PLANCK FUNCTION
-      REAL*8 PBSUR(KDLON,Ninter) ! SURFACE SPECTRAL PLANCK FUNCTION
-      REAL*8 PBTOP(KDLON,Ninter) ! TOP SPECTRAL PLANCK FUNCTION
-      REAL*8 PDBSL(KDLON,Ninter,KFLEV*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
-      REAL*8 PGA(KDLON,8,2,KFLEV) ! dB/dT-weighted LAYER PADE APPROXIMANTS
-      REAL*8 PGB(KDLON,8,2,KFLEV) ! dB/dT-weighted LAYER PADE APPROXIMANTS
-      REAL*8 PGASUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS
-      REAL*8 PGBSUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS
-      REAL*8 PGATOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS
-      REAL*8 PGBTOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS
-C
-C-------------------------------------------------------------------------
-C*  LOCAL VARIABLES:
-      INTEGER INDB(KDLON),INDS(KDLON)
-      REAL*8 ZBLAY(KDLON,KFLEV),ZBLEV(KDLON,KFLEV+1)
-      REAL*8 ZRES(KDLON),ZRES2(KDLON),ZTI(KDLON),ZTI2(KDLON)
-c
-      INTEGER jk, jl, ic, jnu, jf, jg
-      INTEGER jk1, jk2
-      INTEGER k, j, ixtox, indto, ixtx, indt
-      INTEGER indsu, indtp
-      REAL*8 zdsto1, zdstox, zdst1, zdstx
-c
-C* Quelques parametres:
-      REAL*8 TSTAND
-      PARAMETER (TSTAND=250.0)
-      REAL*8 TSTP
-      PARAMETER (TSTP=12.5)
-      INTEGER MXIXT
-      PARAMETER (MXIXT=10)
-C
-C* Used Data Block:
-      REAL*8 TINTP(11)
-      SAVE TINTP
-      REAL*8 GA(11,16,3), GB(11,16,3)
-      SAVE GA, GB
-      REAL*8 XP(6,6)
-      SAVE XP
-c
-      DATA TINTP / 187.5, 200., 212.5, 225., 237.5, 250.,
-     S             262.5, 275., 287.5, 300., 312.5 /
-C-----------------------------------------------------------------------
-C-- WATER VAPOR -- INT.1 -- 0- 500 CM-1 -- FROM ABS225 ----------------
-C
-C
-C
-C
-C-- R.D. -- G = - 0.2 SLA
-C
-C
-C----- INTERVAL = 1 ----- T =  187.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
-      DATA (GA( 1, 1,IC),IC=1,3) /
-     S 0.63499072E-02,-0.99506586E-03, 0.00000000E+00/
-      DATA (GB( 1, 1,IC),IC=1,3) /
-     S 0.63499072E-02, 0.97222852E-01, 0.10000000E+01/
-      DATA (GA( 1, 2,IC),IC=1,3) /
-     S 0.77266491E-02,-0.11661515E-02, 0.00000000E+00/
-      DATA (GB( 1, 2,IC),IC=1,3) /
-     S 0.77266491E-02, 0.10681591E+00, 0.10000000E+01/
-C
-C----- INTERVAL = 1 ----- T =  200.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
-      DATA (GA( 2, 1,IC),IC=1,3) /
-     S 0.65566348E-02,-0.10184169E-02, 0.00000000E+00/
-      DATA (GB( 2, 1,IC),IC=1,3) /
-     S 0.65566348E-02, 0.98862238E-01, 0.10000000E+01/
-      DATA (GA( 2, 2,IC),IC=1,3) /
-     S 0.81323287E-02,-0.11886130E-02, 0.00000000E+00/
-      DATA (GB( 2, 2,IC),IC=1,3) /
-     S 0.81323287E-02, 0.10921298E+00, 0.10000000E+01/
-C
-C----- INTERVAL = 1 ----- T =  212.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
-      DATA (GA( 3, 1,IC),IC=1,3) /
-     S 0.67849730E-02,-0.10404730E-02, 0.00000000E+00/
-      DATA (GB( 3, 1,IC),IC=1,3) /
-     S 0.67849730E-02, 0.10061504E+00, 0.10000000E+01/
-      DATA (GA( 3, 2,IC),IC=1,3) /
-     S 0.86507620E-02,-0.12139929E-02, 0.00000000E+00/
-      DATA (GB( 3, 2,IC),IC=1,3) /
-     S 0.86507620E-02, 0.11198225E+00, 0.10000000E+01/
-C
-C----- INTERVAL = 1 ----- T =  225.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
-      DATA (GA( 4, 1,IC),IC=1,3) /
-     S 0.70481947E-02,-0.10621792E-02, 0.00000000E+00/
-      DATA (GB( 4, 1,IC),IC=1,3) /
-     S 0.70481947E-02, 0.10256222E+00, 0.10000000E+01/
-      DATA (GA( 4, 2,IC),IC=1,3) /
-     S 0.92776391E-02,-0.12445811E-02, 0.00000000E+00/
-      DATA (GB( 4, 2,IC),IC=1,3) /
-     S 0.92776391E-02, 0.11487826E+00, 0.10000000E+01/
-C
-C----- INTERVAL = 1 ----- T =  237.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
-      DATA (GA( 5, 1,IC),IC=1,3) /
-     S 0.73585943E-02,-0.10847662E-02, 0.00000000E+00/
-      DATA (GB( 5, 1,IC),IC=1,3) /
-     S 0.73585943E-02, 0.10475952E+00, 0.10000000E+01/
-      DATA (GA( 5, 2,IC),IC=1,3) /
-     S 0.99806312E-02,-0.12807672E-02, 0.00000000E+00/
-      DATA (GB( 5, 2,IC),IC=1,3) /
-     S 0.99806312E-02, 0.11751113E+00, 0.10000000E+01/
-C
-C----- INTERVAL = 1 ----- T =  250.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
-      DATA (GA( 6, 1,IC),IC=1,3) /
-     S 0.77242818E-02,-0.11094726E-02, 0.00000000E+00/
-      DATA (GB( 6, 1,IC),IC=1,3) /
-     S 0.77242818E-02, 0.10720986E+00, 0.10000000E+01/
-      DATA (GA( 6, 2,IC),IC=1,3) /
-     S 0.10709803E-01,-0.13208251E-02, 0.00000000E+00/
-      DATA (GB( 6, 2,IC),IC=1,3) /
-     S 0.10709803E-01, 0.11951535E+00, 0.10000000E+01/
-C
-C----- INTERVAL = 1 ----- T =  262.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
-      DATA (GA( 7, 1,IC),IC=1,3) /
-     S 0.81472693E-02,-0.11372949E-02, 0.00000000E+00/
-      DATA (GB( 7, 1,IC),IC=1,3) /
-     S 0.81472693E-02, 0.10985370E+00, 0.10000000E+01/
-      DATA (GA( 7, 2,IC),IC=1,3) /
-     S 0.11414739E-01,-0.13619034E-02, 0.00000000E+00/
-      DATA (GB( 7, 2,IC),IC=1,3) /
-     S 0.11414739E-01, 0.12069945E+00, 0.10000000E+01/
-C
-C----- INTERVAL = 1 ----- T =  275.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
-      DATA (GA( 8, 1,IC),IC=1,3) /
-     S 0.86227527E-02,-0.11687683E-02, 0.00000000E+00/
-      DATA (GB( 8, 1,IC),IC=1,3) /
-     S 0.86227527E-02, 0.11257633E+00, 0.10000000E+01/
-      DATA (GA( 8, 2,IC),IC=1,3) /
-     S 0.12058772E-01,-0.14014165E-02, 0.00000000E+00/
-      DATA (GB( 8, 2,IC),IC=1,3) /
-     S 0.12058772E-01, 0.12108524E+00, 0.10000000E+01/
-C
-C----- INTERVAL = 1 ----- T =  287.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
-      DATA (GA( 9, 1,IC),IC=1,3) /
-     S 0.91396814E-02,-0.12038314E-02, 0.00000000E+00/
-      DATA (GB( 9, 1,IC),IC=1,3) /
-     S 0.91396814E-02, 0.11522980E+00, 0.10000000E+01/
-      DATA (GA( 9, 2,IC),IC=1,3) /
-     S 0.12623992E-01,-0.14378639E-02, 0.00000000E+00/
-      DATA (GB( 9, 2,IC),IC=1,3) /
-     S 0.12623992E-01, 0.12084229E+00, 0.10000000E+01/
-C
-C----- INTERVAL = 1 ----- T =  300.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
-      DATA (GA(10, 1,IC),IC=1,3) /
-     S 0.96825438E-02,-0.12418367E-02, 0.00000000E+00/
-      DATA (GB(10, 1,IC),IC=1,3) /
-     S 0.96825438E-02, 0.11766343E+00, 0.10000000E+01/
-      DATA (GA(10, 2,IC),IC=1,3) /
-     S 0.13108146E-01,-0.14708488E-02, 0.00000000E+00/
-      DATA (GB(10, 2,IC),IC=1,3) /
-     S 0.13108146E-01, 0.12019005E+00, 0.10000000E+01/
-C
-C----- INTERVAL = 1 ----- T =  312.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
-      DATA (GA(11, 1,IC),IC=1,3) /
-     S 0.10233955E-01,-0.12817135E-02, 0.00000000E+00/
-      DATA (GB(11, 1,IC),IC=1,3) /
-     S 0.10233955E-01, 0.11975320E+00, 0.10000000E+01/
-      DATA (GA(11, 2,IC),IC=1,3) /
-     S 0.13518390E-01,-0.15006791E-02, 0.00000000E+00/
-      DATA (GB(11, 2,IC),IC=1,3) /
-     S 0.13518390E-01, 0.11932684E+00, 0.10000000E+01/
-C
-C
-C
-C--- WATER VAPOR --- INTERVAL 2 -- 500-800 CM-1--- FROM ABS225 ---------
-C
-C
-C
-C
-C--- R.D.  ---  G = 0.02 + 0.50 / ( 1 + 4.5 U )
-C
-C
-C----- INTERVAL = 2 ----- T =  187.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 1, 3,IC),IC=1,3) /
-     S 0.11644593E+01, 0.41243390E+00, 0.00000000E+00/
-      DATA (GB( 1, 3,IC),IC=1,3) /
-     S 0.11644593E+01, 0.10346097E+01, 0.10000000E+01/
-      DATA (GA( 1, 4,IC),IC=1,3) /
-     S 0.12006968E+01, 0.48318936E+00, 0.00000000E+00/
-      DATA (GB( 1, 4,IC),IC=1,3) /
-     S 0.12006968E+01, 0.10626130E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 2 ----- T =  200.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 2, 3,IC),IC=1,3) /
-     S 0.11747203E+01, 0.43407282E+00, 0.00000000E+00/
-      DATA (GB( 2, 3,IC),IC=1,3) /
-     S 0.11747203E+01, 0.10433655E+01, 0.10000000E+01/
-      DATA (GA( 2, 4,IC),IC=1,3) /
-     S 0.12108196E+01, 0.50501827E+00, 0.00000000E+00/
-      DATA (GB( 2, 4,IC),IC=1,3) /
-     S 0.12108196E+01, 0.10716026E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 2 ----- T =  212.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 3, 3,IC),IC=1,3) /
-     S 0.11837872E+01, 0.45331413E+00, 0.00000000E+00/
-      DATA (GB( 3, 3,IC),IC=1,3) /
-     S 0.11837872E+01, 0.10511933E+01, 0.10000000E+01/
-      DATA (GA( 3, 4,IC),IC=1,3) /
-     S 0.12196717E+01, 0.52409502E+00, 0.00000000E+00/
-      DATA (GB( 3, 4,IC),IC=1,3) /
-     S 0.12196717E+01, 0.10795108E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 2 ----- T =  225.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 4, 3,IC),IC=1,3) /
-     S 0.11918561E+01, 0.47048604E+00, 0.00000000E+00/
-      DATA (GB( 4, 3,IC),IC=1,3) /
-     S 0.11918561E+01, 0.10582150E+01, 0.10000000E+01/
-      DATA (GA( 4, 4,IC),IC=1,3) /
-     S 0.12274493E+01, 0.54085277E+00, 0.00000000E+00/
-      DATA (GB( 4, 4,IC),IC=1,3) /
-     S 0.12274493E+01, 0.10865006E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 2 ----- T =  237.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 5, 3,IC),IC=1,3) /
-     S 0.11990757E+01, 0.48586286E+00, 0.00000000E+00/
-      DATA (GB( 5, 3,IC),IC=1,3) /
-     S 0.11990757E+01, 0.10645317E+01, 0.10000000E+01/
-      DATA (GA( 5, 4,IC),IC=1,3) /
-     S 0.12343189E+01, 0.55565422E+00, 0.00000000E+00/
-      DATA (GB( 5, 4,IC),IC=1,3) /
-     S 0.12343189E+01, 0.10927103E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 2 ----- T =  250.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 6, 3,IC),IC=1,3) /
-     S 0.12055643E+01, 0.49968044E+00, 0.00000000E+00/
-      DATA (GB( 6, 3,IC),IC=1,3) /
-     S 0.12055643E+01, 0.10702313E+01, 0.10000000E+01/
-      DATA (GA( 6, 4,IC),IC=1,3) /
-     S 0.12404147E+01, 0.56878618E+00, 0.00000000E+00/
-      DATA (GB( 6, 4,IC),IC=1,3) /
-     S 0.12404147E+01, 0.10982489E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 2 ----- T =  262.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 7, 3,IC),IC=1,3) /
-     S 0.12114186E+01, 0.51214132E+00, 0.00000000E+00/
-      DATA (GB( 7, 3,IC),IC=1,3) /
-     S 0.12114186E+01, 0.10753907E+01, 0.10000000E+01/
-      DATA (GA( 7, 4,IC),IC=1,3) /
-     S 0.12458431E+01, 0.58047395E+00, 0.00000000E+00/
-      DATA (GB( 7, 4,IC),IC=1,3) /
-     S 0.12458431E+01, 0.11032019E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 2 ----- T =  275.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 8, 3,IC),IC=1,3) /
-     S 0.12167192E+01, 0.52341830E+00, 0.00000000E+00/
-      DATA (GB( 8, 3,IC),IC=1,3) /
-     S 0.12167192E+01, 0.10800762E+01, 0.10000000E+01/
-      DATA (GA( 8, 4,IC),IC=1,3) /
-     S 0.12506907E+01, 0.59089894E+00, 0.00000000E+00/
-      DATA (GB( 8, 4,IC),IC=1,3) /
-     S 0.12506907E+01, 0.11076379E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 2 ----- T =  287.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 9, 3,IC),IC=1,3) /
-     S 0.12215344E+01, 0.53365803E+00, 0.00000000E+00/
-      DATA (GB( 9, 3,IC),IC=1,3) /
-     S 0.12215344E+01, 0.10843446E+01, 0.10000000E+01/
-      DATA (GA( 9, 4,IC),IC=1,3) /
-     S 0.12550299E+01, 0.60021475E+00, 0.00000000E+00/
-      DATA (GB( 9, 4,IC),IC=1,3) /
-     S 0.12550299E+01, 0.11116160E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 2 ----- T =  300.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA(10, 3,IC),IC=1,3) /
-     S 0.12259226E+01, 0.54298448E+00, 0.00000000E+00/
-      DATA (GB(10, 3,IC),IC=1,3) /
-     S 0.12259226E+01, 0.10882439E+01, 0.10000000E+01/
-      DATA (GA(10, 4,IC),IC=1,3) /
-     S 0.12589256E+01, 0.60856112E+00, 0.00000000E+00/
-      DATA (GB(10, 4,IC),IC=1,3) /
-     S 0.12589256E+01, 0.11151910E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 2 ----- T =  312.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA(11, 3,IC),IC=1,3) /
-     S 0.12299344E+01, 0.55150227E+00, 0.00000000E+00/
-      DATA (GB(11, 3,IC),IC=1,3) /
-     S 0.12299344E+01, 0.10918144E+01, 0.10000000E+01/
-      DATA (GA(11, 4,IC),IC=1,3) /
-     S 0.12624402E+01, 0.61607594E+00, 0.00000000E+00/
-      DATA (GB(11, 4,IC),IC=1,3) /
-     S 0.12624402E+01, 0.11184188E+01, 0.10000000E+01/
-C
-C
-C
-C
-C
-C
-C- WATER VAPOR - INT. 3 -- 800-970 + 1110-1250 CM-1 -- FIT FROM 215 IS -
-C
-C
-C-- WATER VAPOR LINES IN THE WINDOW REGION (800-1250 CM-1)
-C
-C
-C
-C--- G = 3.875E-03 ---------------
-C
-C----- INTERVAL = 3 ----- T =  187.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 1, 7,IC),IC=1,3) /
-     S 0.10192131E+02, 0.80737799E+01, 0.00000000E+00/
-      DATA (GB( 1, 7,IC),IC=1,3) /
-     S 0.10192131E+02, 0.82623280E+01, 0.10000000E+01/
-      DATA (GA( 1, 8,IC),IC=1,3) /
-     S 0.92439050E+01, 0.77425778E+01, 0.00000000E+00/
-      DATA (GB( 1, 8,IC),IC=1,3) /
-     S 0.92439050E+01, 0.79342219E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 3 ----- T =  200.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 2, 7,IC),IC=1,3) /
-     S 0.97258602E+01, 0.79171158E+01, 0.00000000E+00/
-      DATA (GB( 2, 7,IC),IC=1,3) /
-     S 0.97258602E+01, 0.81072291E+01, 0.10000000E+01/
-      DATA (GA( 2, 8,IC),IC=1,3) /
-     S 0.87567422E+01, 0.75443460E+01, 0.00000000E+00/
-      DATA (GB( 2, 8,IC),IC=1,3) /
-     S 0.87567422E+01, 0.77373458E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 3 ----- T =  212.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 3, 7,IC),IC=1,3) /
-     S 0.92992890E+01, 0.77609605E+01, 0.00000000E+00/
-      DATA (GB( 3, 7,IC),IC=1,3) /
-     S 0.92992890E+01, 0.79523834E+01, 0.10000000E+01/
-      DATA (GA( 3, 8,IC),IC=1,3) /
-     S 0.83270144E+01, 0.73526151E+01, 0.00000000E+00/
-      DATA (GB( 3, 8,IC),IC=1,3) /
-     S 0.83270144E+01, 0.75467334E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 3 ----- T =  225.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 4, 7,IC),IC=1,3) /
-     S 0.89154021E+01, 0.76087371E+01, 0.00000000E+00/
-      DATA (GB( 4, 7,IC),IC=1,3) /
-     S 0.89154021E+01, 0.78012527E+01, 0.10000000E+01/
-      DATA (GA( 4, 8,IC),IC=1,3) /
-     S 0.79528337E+01, 0.71711188E+01, 0.00000000E+00/
-      DATA (GB( 4, 8,IC),IC=1,3) /
-     S 0.79528337E+01, 0.73661786E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 3 ----- T =  237.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 5, 7,IC),IC=1,3) /
-     S 0.85730084E+01, 0.74627112E+01, 0.00000000E+00/
-      DATA (GB( 5, 7,IC),IC=1,3) /
-     S 0.85730084E+01, 0.76561458E+01, 0.10000000E+01/
-      DATA (GA( 5, 8,IC),IC=1,3) /
-     S 0.76286839E+01, 0.70015571E+01, 0.00000000E+00/
-      DATA (GB( 5, 8,IC),IC=1,3) /
-     S 0.76286839E+01, 0.71974319E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 3 ----- T =  250.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 6, 7,IC),IC=1,3) /
-     S 0.82685838E+01, 0.73239981E+01, 0.00000000E+00/
-      DATA (GB( 6, 7,IC),IC=1,3) /
-     S 0.82685838E+01, 0.75182174E+01, 0.10000000E+01/
-      DATA (GA( 6, 8,IC),IC=1,3) /
-     S 0.73477879E+01, 0.68442532E+01, 0.00000000E+00/
-      DATA (GB( 6, 8,IC),IC=1,3) /
-     S 0.73477879E+01, 0.70408543E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 3 ----- T =  262.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 7, 7,IC),IC=1,3) /
-     S 0.79978921E+01, 0.71929934E+01, 0.00000000E+00/
-      DATA (GB( 7, 7,IC),IC=1,3) /
-     S 0.79978921E+01, 0.73878952E+01, 0.10000000E+01/
-      DATA (GA( 7, 8,IC),IC=1,3) /
-     S 0.71035818E+01, 0.66987996E+01, 0.00000000E+00/
-      DATA (GB( 7, 8,IC),IC=1,3) /
-     S 0.71035818E+01, 0.68960649E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 3 ----- T =  275.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 8, 7,IC),IC=1,3) /
-     S 0.77568055E+01, 0.70697065E+01, 0.00000000E+00/
-      DATA (GB( 8, 7,IC),IC=1,3) /
-     S 0.77568055E+01, 0.72652133E+01, 0.10000000E+01/
-      DATA (GA( 8, 8,IC),IC=1,3) /
-     S 0.68903312E+01, 0.65644820E+01, 0.00000000E+00/
-      DATA (GB( 8, 8,IC),IC=1,3) /
-     S 0.68903312E+01, 0.67623672E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 3 ----- T =  287.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 9, 7,IC),IC=1,3) /
-     S 0.75416266E+01, 0.69539626E+01, 0.00000000E+00/
-      DATA (GB( 9, 7,IC),IC=1,3) /
-     S 0.75416266E+01, 0.71500151E+01, 0.10000000E+01/
-      DATA (GA( 9, 8,IC),IC=1,3) /
-     S 0.67032875E+01, 0.64405267E+01, 0.00000000E+00/
-      DATA (GB( 9, 8,IC),IC=1,3) /
-     S 0.67032875E+01, 0.66389989E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 3 ----- T =  300.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA(10, 7,IC),IC=1,3) /
-     S 0.73491694E+01, 0.68455144E+01, 0.00000000E+00/
-      DATA (GB(10, 7,IC),IC=1,3) /
-     S 0.73491694E+01, 0.70420667E+01, 0.10000000E+01/
-      DATA (GA(10, 8,IC),IC=1,3) /
-     S 0.65386461E+01, 0.63262376E+01, 0.00000000E+00/
-      DATA (GB(10, 8,IC),IC=1,3) /
-     S 0.65386461E+01, 0.65252707E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 3 ----- T =  312.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA(11, 7,IC),IC=1,3) /
-     S 0.71767400E+01, 0.67441020E+01, 0.00000000E+00/
-      DATA (GB(11, 7,IC),IC=1,3) /
-     S 0.71767400E+01, 0.69411177E+01, 0.10000000E+01/
-      DATA (GA(11, 8,IC),IC=1,3) /
-     S 0.63934377E+01, 0.62210701E+01, 0.00000000E+00/
-      DATA (GB(11, 8,IC),IC=1,3) /
-     S 0.63934377E+01, 0.64206412E+01, 0.10000000E+01/
-C
-C
-C-- WATER VAPOR -- 970-1110 CM-1 ----------------------------------------
-C
-C-- G = 3.6E-03
-C
-C----- INTERVAL = 4 ----- T =  187.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 1, 9,IC),IC=1,3) /
-     S 0.24870635E+02, 0.10542131E+02, 0.00000000E+00/
-      DATA (GB( 1, 9,IC),IC=1,3) /
-     S 0.24870635E+02, 0.10656640E+02, 0.10000000E+01/
-      DATA (GA( 1,10,IC),IC=1,3) /
-     S 0.24586283E+02, 0.10490353E+02, 0.00000000E+00/
-      DATA (GB( 1,10,IC),IC=1,3) /
-     S 0.24586283E+02, 0.10605856E+02, 0.10000000E+01/
-C
-C----- INTERVAL = 4 ----- T =  200.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 2, 9,IC),IC=1,3) /
-     S 0.24725591E+02, 0.10515895E+02, 0.00000000E+00/
-      DATA (GB( 2, 9,IC),IC=1,3) /
-     S 0.24725591E+02, 0.10630910E+02, 0.10000000E+01/
-      DATA (GA( 2,10,IC),IC=1,3) /
-     S 0.24441465E+02, 0.10463512E+02, 0.00000000E+00/
-      DATA (GB( 2,10,IC),IC=1,3) /
-     S 0.24441465E+02, 0.10579514E+02, 0.10000000E+01/
-C
-C----- INTERVAL = 4 ----- T =  212.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 3, 9,IC),IC=1,3) /
-     S 0.24600320E+02, 0.10492949E+02, 0.00000000E+00/
-      DATA (GB( 3, 9,IC),IC=1,3) /
-     S 0.24600320E+02, 0.10608399E+02, 0.10000000E+01/
-      DATA (GA( 3,10,IC),IC=1,3) /
-     S 0.24311657E+02, 0.10439183E+02, 0.00000000E+00/
-      DATA (GB( 3,10,IC),IC=1,3) /
-     S 0.24311657E+02, 0.10555632E+02, 0.10000000E+01/
-C
-C----- INTERVAL = 4 ----- T =  225.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 4, 9,IC),IC=1,3) /
-     S 0.24487300E+02, 0.10472049E+02, 0.00000000E+00/
-      DATA (GB( 4, 9,IC),IC=1,3) /
-     S 0.24487300E+02, 0.10587891E+02, 0.10000000E+01/
-      DATA (GA( 4,10,IC),IC=1,3) /
-     S 0.24196167E+02, 0.10417324E+02, 0.00000000E+00/
-      DATA (GB( 4,10,IC),IC=1,3) /
-     S 0.24196167E+02, 0.10534169E+02, 0.10000000E+01/
-C
-C----- INTERVAL = 4 ----- T =  237.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 5, 9,IC),IC=1,3) /
-     S 0.24384935E+02, 0.10452961E+02, 0.00000000E+00/
-      DATA (GB( 5, 9,IC),IC=1,3) /
-     S 0.24384935E+02, 0.10569156E+02, 0.10000000E+01/
-      DATA (GA( 5,10,IC),IC=1,3) /
-     S 0.24093406E+02, 0.10397704E+02, 0.00000000E+00/
-      DATA (GB( 5,10,IC),IC=1,3) /
-     S 0.24093406E+02, 0.10514900E+02, 0.10000000E+01/
-C
-C----- INTERVAL = 4 ----- T =  250.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 6, 9,IC),IC=1,3) /
-     S 0.24292341E+02, 0.10435562E+02, 0.00000000E+00/
-      DATA (GB( 6, 9,IC),IC=1,3) /
-     S 0.24292341E+02, 0.10552075E+02, 0.10000000E+01/
-      DATA (GA( 6,10,IC),IC=1,3) /
-     S 0.24001597E+02, 0.10380038E+02, 0.00000000E+00/
-      DATA (GB( 6,10,IC),IC=1,3) /
-     S 0.24001597E+02, 0.10497547E+02, 0.10000000E+01/
-C
-C----- INTERVAL = 4 ----- T =  262.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 7, 9,IC),IC=1,3) /
-     S 0.24208572E+02, 0.10419710E+02, 0.00000000E+00/
-      DATA (GB( 7, 9,IC),IC=1,3) /
-     S 0.24208572E+02, 0.10536510E+02, 0.10000000E+01/
-      DATA (GA( 7,10,IC),IC=1,3) /
-     S 0.23919098E+02, 0.10364052E+02, 0.00000000E+00/
-      DATA (GB( 7,10,IC),IC=1,3) /
-     S 0.23919098E+02, 0.10481842E+02, 0.10000000E+01/
-C
-C----- INTERVAL = 4 ----- T =  275.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 8, 9,IC),IC=1,3) /
-     S 0.24132642E+02, 0.10405247E+02, 0.00000000E+00/
-      DATA (GB( 8, 9,IC),IC=1,3) /
-     S 0.24132642E+02, 0.10522307E+02, 0.10000000E+01/
-      DATA (GA( 8,10,IC),IC=1,3) /
-     S 0.23844511E+02, 0.10349509E+02, 0.00000000E+00/
-      DATA (GB( 8,10,IC),IC=1,3) /
-     S 0.23844511E+02, 0.10467553E+02, 0.10000000E+01/
-C
-C----- INTERVAL = 4 ----- T =  287.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA( 9, 9,IC),IC=1,3) /
-     S 0.24063614E+02, 0.10392022E+02, 0.00000000E+00/
-      DATA (GB( 9, 9,IC),IC=1,3) /
-     S 0.24063614E+02, 0.10509317E+02, 0.10000000E+01/
-      DATA (GA( 9,10,IC),IC=1,3) /
-     S 0.23776708E+02, 0.10336215E+02, 0.00000000E+00/
-      DATA (GB( 9,10,IC),IC=1,3) /
-     S 0.23776708E+02, 0.10454488E+02, 0.10000000E+01/
-C
-C----- INTERVAL = 4 ----- T =  300.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA(10, 9,IC),IC=1,3) /
-     S 0.24000649E+02, 0.10379892E+02, 0.00000000E+00/
-      DATA (GB(10, 9,IC),IC=1,3) /
-     S 0.24000649E+02, 0.10497402E+02, 0.10000000E+01/
-      DATA (GA(10,10,IC),IC=1,3) /
-     S 0.23714816E+02, 0.10324018E+02, 0.00000000E+00/
-      DATA (GB(10,10,IC),IC=1,3) /
-     S 0.23714816E+02, 0.10442501E+02, 0.10000000E+01/
-C
-C----- INTERVAL = 4 ----- T =  312.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
-      DATA (GA(11, 9,IC),IC=1,3) /
-     S 0.23943021E+02, 0.10368736E+02, 0.00000000E+00/
-      DATA (GB(11, 9,IC),IC=1,3) /
-     S 0.23943021E+02, 0.10486443E+02, 0.10000000E+01/
-      DATA (GA(11,10,IC),IC=1,3) /
-     S 0.23658197E+02, 0.10312808E+02, 0.00000000E+00/
-      DATA (GB(11,10,IC),IC=1,3) /
-     S 0.23658197E+02, 0.10431483E+02, 0.10000000E+01/
-C
-C
-C
-C-- H2O -- WEAKER PARTS OF THE STRONG BANDS  -- FROM ABS225 ----
-C
-C-- WATER VAPOR --- 350 - 500 CM-1
-C
-C-- G = - 0.2*SLA, 0.0 +0.5/(1+0.5U)
-C
-C----- INTERVAL = 5 ----- T =  187.5
-C
-C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
-      DATA (GA( 1, 5,IC),IC=1,3) /
-     S 0.15750172E+00,-0.22159303E-01, 0.00000000E+00/
-      DATA (GB( 1, 5,IC),IC=1,3) /
-     S 0.15750172E+00, 0.38103212E+00, 0.10000000E+01/
-      DATA (GA( 1, 6,IC),IC=1,3) /
-     S 0.17770551E+00,-0.24972399E-01, 0.00000000E+00/
-      DATA (GB( 1, 6,IC),IC=1,3) /
-     S 0.17770551E+00, 0.41646579E+00, 0.10000000E+01/
-C
-C----- INTERVAL = 5 ----- T =  200.0
-C
-C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
-      DATA (GA( 2, 5,IC),IC=1,3) /
-     S 0.16174076E+00,-0.22748917E-01, 0.00000000E+00/
-      DATA (GB( 2, 5,IC),IC=1,3) /
-     S 0.16174076E+00, 0.38913800E+00, 0.10000000E+01/
-      DATA (GA( 2, 6,IC),IC=1,3) /
-     S 0.18176757E+00,-0.25537247E-01, 0.00000000E+00/
-      DATA (GB( 2, 6,IC),IC=1,3) /
-     S 0.18176757E+00, 0.42345095E+00, 0.10000000E+01/
-C
-C----- INTERVAL = 5 ----- T =  212.5
-C
-C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
-      DATA (GA( 3, 5,IC),IC=1,3) /
-     S 0.16548628E+00,-0.23269898E-01, 0.00000000E+00/
-      DATA (GB( 3, 5,IC),IC=1,3) /
-     S 0.16548628E+00, 0.39613651E+00, 0.10000000E+01/
-      DATA (GA( 3, 6,IC),IC=1,3) /
-     S 0.18527967E+00,-0.26025624E-01, 0.00000000E+00/
-      DATA (GB( 3, 6,IC),IC=1,3) /
-     S 0.18527967E+00, 0.42937476E+00, 0.10000000E+01/
-C
-C----- INTERVAL = 5 ----- T =  225.0
-C
-C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
-      DATA (GA( 4, 5,IC),IC=1,3) /
-     S 0.16881124E+00,-0.23732392E-01, 0.00000000E+00/
-      DATA (GB( 4, 5,IC),IC=1,3) /
-     S 0.16881124E+00, 0.40222421E+00, 0.10000000E+01/
-      DATA (GA( 4, 6,IC),IC=1,3) /
-     S 0.18833348E+00,-0.26450280E-01, 0.00000000E+00/
-      DATA (GB( 4, 6,IC),IC=1,3) /
-     S 0.18833348E+00, 0.43444062E+00, 0.10000000E+01/
-C
-C----- INTERVAL = 5 ----- T =  237.5
-C
-C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
-      DATA (GA( 5, 5,IC),IC=1,3) /
-     S 0.17177839E+00,-0.24145123E-01, 0.00000000E+00/
-      DATA (GB( 5, 5,IC),IC=1,3) /
-     S 0.17177839E+00, 0.40756010E+00, 0.10000000E+01/
-      DATA (GA( 5, 6,IC),IC=1,3) /
-     S 0.19100108E+00,-0.26821236E-01, 0.00000000E+00/
-      DATA (GB( 5, 6,IC),IC=1,3) /
-     S 0.19100108E+00, 0.43880316E+00, 0.10000000E+01/
-C
-C----- INTERVAL = 5 ----- T =  250.0
-C
-C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
-      DATA (GA( 6, 5,IC),IC=1,3) /
-     S 0.17443933E+00,-0.24515269E-01, 0.00000000E+00/
-      DATA (GB( 6, 5,IC),IC=1,3) /
-     S 0.17443933E+00, 0.41226954E+00, 0.10000000E+01/
-      DATA (GA( 6, 6,IC),IC=1,3) /
-     S 0.19334122E+00,-0.27146657E-01, 0.00000000E+00/
-      DATA (GB( 6, 6,IC),IC=1,3) /
-     S 0.19334122E+00, 0.44258354E+00, 0.10000000E+01/
-C
-C----- INTERVAL = 5 ----- T =  262.5
-C
-C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
-      DATA (GA( 7, 5,IC),IC=1,3) /
-     S 0.17683622E+00,-0.24848690E-01, 0.00000000E+00/
-      DATA (GB( 7, 5,IC),IC=1,3) /
-     S 0.17683622E+00, 0.41645142E+00, 0.10000000E+01/
-      DATA (GA( 7, 6,IC),IC=1,3) /
-     S 0.19540288E+00,-0.27433354E-01, 0.00000000E+00/
-      DATA (GB( 7, 6,IC),IC=1,3) /
-     S 0.19540288E+00, 0.44587882E+00, 0.10000000E+01/
-C
-C----- INTERVAL = 5 ----- T =  275.0
-C
-C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
-      DATA (GA( 8, 5,IC),IC=1,3) /
-     S 0.17900375E+00,-0.25150210E-01, 0.00000000E+00/
-      DATA (GB( 8, 5,IC),IC=1,3) /
-     S 0.17900375E+00, 0.42018474E+00, 0.10000000E+01/
-      DATA (GA( 8, 6,IC),IC=1,3) /
-     S 0.19722732E+00,-0.27687065E-01, 0.00000000E+00/
-      DATA (GB( 8, 6,IC),IC=1,3) /
-     S 0.19722732E+00, 0.44876776E+00, 0.10000000E+01/
-C
-C----- INTERVAL = 5 ----- T =  287.5
-C
-C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
-      DATA (GA( 9, 5,IC),IC=1,3) /
-     S 0.18097099E+00,-0.25423873E-01, 0.00000000E+00/
-      DATA (GB( 9, 5,IC),IC=1,3) /
-     S 0.18097099E+00, 0.42353379E+00, 0.10000000E+01/
-      DATA (GA( 9, 6,IC),IC=1,3) /
-     S 0.19884918E+00,-0.27912608E-01, 0.00000000E+00/
-      DATA (GB( 9, 6,IC),IC=1,3) /
-     S 0.19884918E+00, 0.45131451E+00, 0.10000000E+01/
-C
-C----- INTERVAL = 5 ----- T =  300.0
-C
-C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
-      DATA (GA(10, 5,IC),IC=1,3) /
-     S 0.18276283E+00,-0.25673139E-01, 0.00000000E+00/
-      DATA (GB(10, 5,IC),IC=1,3) /
-     S 0.18276283E+00, 0.42655211E+00, 0.10000000E+01/
-      DATA (GA(10, 6,IC),IC=1,3) /
-     S 0.20029696E+00,-0.28113944E-01, 0.00000000E+00/
-      DATA (GB(10, 6,IC),IC=1,3) /
-     S 0.20029696E+00, 0.45357095E+00, 0.10000000E+01/
-C
-C----- INTERVAL = 5 ----- T =  312.5
-C
-C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
-      DATA (GA(11, 5,IC),IC=1,3) /
-     S 0.18440117E+00,-0.25901055E-01, 0.00000000E+00/
-      DATA (GB(11, 5,IC),IC=1,3) /
-     S 0.18440117E+00, 0.42928533E+00, 0.10000000E+01/
-      DATA (GA(11, 6,IC),IC=1,3) /
-     S 0.20159300E+00,-0.28294180E-01, 0.00000000E+00/
-      DATA (GB(11, 6,IC),IC=1,3) /
-     S 0.20159300E+00, 0.45557797E+00, 0.10000000E+01/
-C
-C
-C
-C
-C- WATER VAPOR - WINGS OF VIBRATION-ROTATION BAND - 1250-1450+1880-2820 -
-C--- G = 0.0
-C
-C
-C----- INTERVAL = 6 ----- T =  187.5
-C
-C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
-      DATA (GA( 1,11,IC),IC=1,3) /
-     S 0.11990218E+02,-0.12823142E+01, 0.00000000E+00/
-      DATA (GB( 1,11,IC),IC=1,3) /
-     S 0.11990218E+02, 0.26681588E+02, 0.10000000E+01/
-      DATA (GA( 1,12,IC),IC=1,3) /
-     S 0.79709806E+01,-0.74805226E+00, 0.00000000E+00/
-      DATA (GB( 1,12,IC),IC=1,3) /
-     S 0.79709806E+01, 0.18377807E+02, 0.10000000E+01/
-C
-C----- INTERVAL = 6 ----- T =  200.0
-C
-C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
-      DATA (GA( 2,11,IC),IC=1,3) /
-     S 0.10904073E+02,-0.10571588E+01, 0.00000000E+00/
-      DATA (GB( 2,11,IC),IC=1,3) /
-     S 0.10904073E+02, 0.24728346E+02, 0.10000000E+01/
-      DATA (GA( 2,12,IC),IC=1,3) /
-     S 0.75400737E+01,-0.56252739E+00, 0.00000000E+00/
-      DATA (GB( 2,12,IC),IC=1,3) /
-     S 0.75400737E+01, 0.17643148E+02, 0.10000000E+01/
-C
-C----- INTERVAL = 6 ----- T =  212.5
-C
-C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
-      DATA (GA( 3,11,IC),IC=1,3) /
-     S 0.89126838E+01,-0.74864953E+00, 0.00000000E+00/
-      DATA (GB( 3,11,IC),IC=1,3) /
-     S 0.89126838E+01, 0.20551342E+02, 0.10000000E+01/
-      DATA (GA( 3,12,IC),IC=1,3) /
-     S 0.81804377E+01,-0.46188072E+00, 0.00000000E+00/
-      DATA (GB( 3,12,IC),IC=1,3) /
-     S 0.81804377E+01, 0.19296161E+02, 0.10000000E+01/
-C
-C----- INTERVAL = 6 ----- T =  225.0
-C
-C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
-      DATA (GA( 4,11,IC),IC=1,3) /
-     S 0.85622405E+01,-0.58705980E+00, 0.00000000E+00/
-      DATA (GB( 4,11,IC),IC=1,3) /
-     S 0.85622405E+01, 0.19955244E+02, 0.10000000E+01/
-      DATA (GA( 4,12,IC),IC=1,3) /
-     S 0.10564339E+02,-0.40712065E+00, 0.00000000E+00/
-      DATA (GB( 4,12,IC),IC=1,3) /
-     S 0.10564339E+02, 0.24951120E+02, 0.10000000E+01/
-C
-C----- INTERVAL = 6 ----- T =  237.5
-C
-C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
-      DATA (GA( 5,11,IC),IC=1,3) /
-     S 0.94892164E+01,-0.49305772E+00, 0.00000000E+00/
-      DATA (GB( 5,11,IC),IC=1,3) /
-     S 0.94892164E+01, 0.22227100E+02, 0.10000000E+01/
-      DATA (GA( 5,12,IC),IC=1,3) /
-     S 0.46896789E+02,-0.15295996E+01, 0.00000000E+00/
-      DATA (GB( 5,12,IC),IC=1,3) /
-     S 0.46896789E+02, 0.10957372E+03, 0.10000000E+01/
-C
-C----- INTERVAL = 6 ----- T =  250.0
-C
-C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
-      DATA (GA( 6,11,IC),IC=1,3) /
-     S 0.13580937E+02,-0.51461431E+00, 0.00000000E+00/
-      DATA (GB( 6,11,IC),IC=1,3) /
-     S 0.13580937E+02, 0.31770288E+02, 0.10000000E+01/
-      DATA (GA( 6,12,IC),IC=1,3) /
-     S-0.30926524E+01, 0.43555255E+00, 0.00000000E+00/
-      DATA (GB( 6,12,IC),IC=1,3) /
-     S-0.30926524E+01,-0.67432659E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 6 ----- T =  262.5
-C
-C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
-      DATA (GA( 7,11,IC),IC=1,3) /
-     S-0.32050918E+03, 0.12373350E+02, 0.00000000E+00/
-      DATA (GB( 7,11,IC),IC=1,3) /
-     S-0.32050918E+03,-0.74061287E+03, 0.10000000E+01/
-      DATA (GA( 7,12,IC),IC=1,3) /
-     S 0.85742941E+00, 0.50380874E+00, 0.00000000E+00/
-      DATA (GB( 7,12,IC),IC=1,3) /
-     S 0.85742941E+00, 0.24550746E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 6 ----- T =  275.0
-C
-C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
-      DATA (GA( 8,11,IC),IC=1,3) /
-     S-0.37133165E+01, 0.44809588E+00, 0.00000000E+00/
-      DATA (GB( 8,11,IC),IC=1,3) /
-     S-0.37133165E+01,-0.81329826E+01, 0.10000000E+01/
-      DATA (GA( 8,12,IC),IC=1,3) /
-     S 0.19164038E+01, 0.68537352E+00, 0.00000000E+00/
-      DATA (GB( 8,12,IC),IC=1,3) /
-     S 0.19164038E+01, 0.49089917E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 6 ----- T =  287.5
-C
-C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
-      DATA (GA( 9,11,IC),IC=1,3) /
-     S 0.18890836E+00, 0.46548918E+00, 0.00000000E+00/
-      DATA (GB( 9,11,IC),IC=1,3) /
-     S 0.18890836E+00, 0.90279822E+00, 0.10000000E+01/
-      DATA (GA( 9,12,IC),IC=1,3) /
-     S 0.23513199E+01, 0.89437630E+00, 0.00000000E+00/
-      DATA (GB( 9,12,IC),IC=1,3) /
-     S 0.23513199E+01, 0.59008712E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 6 ----- T =  300.0
-C
-C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
-      DATA (GA(10,11,IC),IC=1,3) /
-     S 0.14209226E+01, 0.59121475E+00, 0.00000000E+00/
-      DATA (GB(10,11,IC),IC=1,3) /
-     S 0.14209226E+01, 0.37532746E+01, 0.10000000E+01/
-      DATA (GA(10,12,IC),IC=1,3) /
-     S 0.25566644E+01, 0.11127003E+01, 0.00000000E+00/
-      DATA (GB(10,12,IC),IC=1,3) /
-     S 0.25566644E+01, 0.63532616E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 6 ----- T =  312.5
-C
-C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
-      DATA (GA(11,11,IC),IC=1,3) /
-     S 0.19817679E+01, 0.74676119E+00, 0.00000000E+00/
-      DATA (GB(11,11,IC),IC=1,3) /
-     S 0.19817679E+01, 0.50437916E+01, 0.10000000E+01/
-      DATA (GA(11,12,IC),IC=1,3) /
-     S 0.26555181E+01, 0.13329782E+01, 0.00000000E+00/
-      DATA (GB(11,12,IC),IC=1,3) /
-     S 0.26555181E+01, 0.65558627E+01, 0.10000000E+01/
-C
-C
-C
-C
-C
-C-- END WATER VAPOR
-C
-C
-C-- CO2 -- INT.2 -- 500-800 CM-1 --- FROM ABS225 ----------------------
-C
-C
-C
-C-- FIU = 0.8 + MAX(0.35,(7-IU)*0.9)  , X/T,  9
-C
-C----- INTERVAL = 2 ----- T =  187.5
-C
-C-- INDICES FOR PADE APPROXIMATION   1 30 38 45
-      DATA (GA( 1,13,IC),IC=1,3) /
-     S 0.87668459E-01, 0.13845511E+01, 0.00000000E+00/
-      DATA (GB( 1,13,IC),IC=1,3) /
-     S 0.87668459E-01, 0.23203798E+01, 0.10000000E+01/
-      DATA (GA( 1,14,IC),IC=1,3) /
-     S 0.74878820E-01, 0.11718758E+01, 0.00000000E+00/
-      DATA (GB( 1,14,IC),IC=1,3) /
-     S 0.74878820E-01, 0.20206726E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 2 ----- T =  200.0
-C
-C-- INDICES FOR PADE APPROXIMATION   1 30 38 45
-      DATA (GA( 2,13,IC),IC=1,3) /
-     S 0.83754276E-01, 0.13187042E+01, 0.00000000E+00/
-      DATA (GB( 2,13,IC),IC=1,3) /
-     S 0.83754276E-01, 0.22288925E+01, 0.10000000E+01/
-      DATA (GA( 2,14,IC),IC=1,3) /
-     S 0.71650966E-01, 0.11216131E+01, 0.00000000E+00/
-      DATA (GB( 2,14,IC),IC=1,3) /
-     S 0.71650966E-01, 0.19441824E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 2 ----- T =  212.5
-C
-C-- INDICES FOR PADE APPROXIMATION   1 30 38 45
-      DATA (GA( 3,13,IC),IC=1,3) /
-     S 0.80460283E-01, 0.12644396E+01, 0.00000000E+00/
-      DATA (GB( 3,13,IC),IC=1,3) /
-     S 0.80460283E-01, 0.21515593E+01, 0.10000000E+01/
-      DATA (GA( 3,14,IC),IC=1,3) /
-     S 0.68979615E-01, 0.10809473E+01, 0.00000000E+00/
-      DATA (GB( 3,14,IC),IC=1,3) /
-     S 0.68979615E-01, 0.18807257E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 2 ----- T =  225.0
-C
-C-- INDICES FOR PADE APPROXIMATION   1 30 38 45
-      DATA (GA( 4,13,IC),IC=1,3) /
-     S 0.77659686E-01, 0.12191543E+01, 0.00000000E+00/
-      DATA (GB( 4,13,IC),IC=1,3) /
-     S 0.77659686E-01, 0.20855896E+01, 0.10000000E+01/
-      DATA (GA( 4,14,IC),IC=1,3) /
-     S 0.66745345E-01, 0.10476396E+01, 0.00000000E+00/
-      DATA (GB( 4,14,IC),IC=1,3) /
-     S 0.66745345E-01, 0.18275618E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 2 ----- T =  237.5
-C
-C-- INDICES FOR PADE APPROXIMATION   1 30 38 45
-      DATA (GA( 5,13,IC),IC=1,3) /
-     S 0.75257056E-01, 0.11809511E+01, 0.00000000E+00/
-      DATA (GB( 5,13,IC),IC=1,3) /
-     S 0.75257056E-01, 0.20288489E+01, 0.10000000E+01/
-      DATA (GA( 5,14,IC),IC=1,3) /
-     S 0.64857571E-01, 0.10200373E+01, 0.00000000E+00/
-      DATA (GB( 5,14,IC),IC=1,3) /
-     S 0.64857571E-01, 0.17825910E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 2 ----- T =  250.0
-C
-C-- INDICES FOR PADE APPROXIMATION   1 30 38 45
-      DATA (GA( 6,13,IC),IC=1,3) /
-     S 0.73179175E-01, 0.11484154E+01, 0.00000000E+00/
-      DATA (GB( 6,13,IC),IC=1,3) /
-     S 0.73179175E-01, 0.19796791E+01, 0.10000000E+01/
-      DATA (GA( 6,14,IC),IC=1,3) /
-     S 0.63248495E-01, 0.99692726E+00, 0.00000000E+00/
-      DATA (GB( 6,14,IC),IC=1,3) /
-     S 0.63248495E-01, 0.17442308E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 2 ----- T =  262.5
-C
-C-- INDICES FOR PADE APPROXIMATION   1 30 38 45
-      DATA (GA( 7,13,IC),IC=1,3) /
-     S 0.71369063E-01, 0.11204723E+01, 0.00000000E+00/
-      DATA (GB( 7,13,IC),IC=1,3) /
-     S 0.71369063E-01, 0.19367778E+01, 0.10000000E+01/
-      DATA (GA( 7,14,IC),IC=1,3) /
-     S 0.61866970E-01, 0.97740923E+00, 0.00000000E+00/
-      DATA (GB( 7,14,IC),IC=1,3) /
-     S 0.61866970E-01, 0.17112809E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 2 ----- T =  275.0
-C
-C-- INDICES FOR PADE APPROXIMATION   1 30 38 45
-      DATA (GA( 8,13,IC),IC=1,3) /
-     S 0.69781812E-01, 0.10962918E+01, 0.00000000E+00/
-      DATA (GB( 8,13,IC),IC=1,3) /
-     S 0.69781812E-01, 0.18991112E+01, 0.10000000E+01/
-      DATA (GA( 8,14,IC),IC=1,3) /
-     S 0.60673632E-01, 0.96080188E+00, 0.00000000E+00/
-      DATA (GB( 8,14,IC),IC=1,3) /
-     S 0.60673632E-01, 0.16828137E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 2 ----- T =  287.5
-C
-C-- INDICES FOR PADE APPROXIMATION   1 30 38 45
-      DATA (GA( 9,13,IC),IC=1,3) /
-     S 0.68381606E-01, 0.10752229E+01, 0.00000000E+00/
-      DATA (GB( 9,13,IC),IC=1,3) /
-     S 0.68381606E-01, 0.18658501E+01, 0.10000000E+01/
-      DATA (GA( 9,14,IC),IC=1,3) /
-     S 0.59637277E-01, 0.94657562E+00, 0.00000000E+00/
-      DATA (GB( 9,14,IC),IC=1,3) /
-     S 0.59637277E-01, 0.16580908E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 2 ----- T =  300.0
-C
-C-- INDICES FOR PADE APPROXIMATION   1 30 38 45
-      DATA (GA(10,13,IC),IC=1,3) /
-     S 0.67139539E-01, 0.10567474E+01, 0.00000000E+00/
-      DATA (GB(10,13,IC),IC=1,3) /
-     S 0.67139539E-01, 0.18363226E+01, 0.10000000E+01/
-      DATA (GA(10,14,IC),IC=1,3) /
-     S 0.58732178E-01, 0.93430511E+00, 0.00000000E+00/
-      DATA (GB(10,14,IC),IC=1,3) /
-     S 0.58732178E-01, 0.16365014E+01, 0.10000000E+01/
-C
-C----- INTERVAL = 2 ----- T =  312.5
-C
-C-- INDICES FOR PADE APPROXIMATION   1 30 38 45
-      DATA (GA(11,13,IC),IC=1,3) /
-     S 0.66032012E-01, 0.10404465E+01, 0.00000000E+00/
-      DATA (GB(11,13,IC),IC=1,3) /
-     S 0.66032012E-01, 0.18099779E+01, 0.10000000E+01/
-      DATA (GA(11,14,IC),IC=1,3) /
-     S 0.57936092E-01, 0.92363528E+00, 0.00000000E+00/
-      DATA (GB(11,14,IC),IC=1,3) /
-     S 0.57936092E-01, 0.16175164E+01, 0.10000000E+01/
-C
-C
-C
-C
-C
-C
-C
-C
-C
-C
-C-- CARBON DIOXIDE LINES IN THE WINDOW REGION (800-1250 CM-1)
-C
-C
-C-- G = 0.0
-C
-C
-C----- INTERVAL = 4 ----- T =  187.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
-      DATA (GA( 1,15,IC),IC=1,3) /
-     S 0.13230067E+02, 0.22042132E+02, 0.00000000E+00/
-      DATA (GB( 1,15,IC),IC=1,3) /
-     S 0.13230067E+02, 0.22051750E+02, 0.10000000E+01/
-      DATA (GA( 1,16,IC),IC=1,3) /
-     S 0.13183816E+02, 0.22169501E+02, 0.00000000E+00/
-      DATA (GB( 1,16,IC),IC=1,3) /
-     S 0.13183816E+02, 0.22178972E+02, 0.10000000E+01/
-C
-C----- INTERVAL = 4 ----- T =  200.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
-      DATA (GA( 2,15,IC),IC=1,3) /
-     S 0.13213564E+02, 0.22107298E+02, 0.00000000E+00/
-      DATA (GB( 2,15,IC),IC=1,3) /
-     S 0.13213564E+02, 0.22116850E+02, 0.10000000E+01/
-      DATA (GA( 2,16,IC),IC=1,3) /
-     S 0.13189991E+02, 0.22270075E+02, 0.00000000E+00/
-      DATA (GB( 2,16,IC),IC=1,3) /
-     S 0.13189991E+02, 0.22279484E+02, 0.10000000E+01/
-C
-C----- INTERVAL = 4 ----- T =  212.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
-      DATA (GA( 3,15,IC),IC=1,3) /
-     S 0.13209140E+02, 0.22180915E+02, 0.00000000E+00/
-      DATA (GB( 3,15,IC),IC=1,3) /
-     S 0.13209140E+02, 0.22190410E+02, 0.10000000E+01/
-      DATA (GA( 3,16,IC),IC=1,3) /
-     S 0.13209485E+02, 0.22379193E+02, 0.00000000E+00/
-      DATA (GB( 3,16,IC),IC=1,3) /
-     S 0.13209485E+02, 0.22388551E+02, 0.10000000E+01/
-C
-C----- INTERVAL = 4 ----- T =  225.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
-      DATA (GA( 4,15,IC),IC=1,3) /
-     S 0.13213894E+02, 0.22259478E+02, 0.00000000E+00/
-      DATA (GB( 4,15,IC),IC=1,3) /
-     S 0.13213894E+02, 0.22268925E+02, 0.10000000E+01/
-      DATA (GA( 4,16,IC),IC=1,3) /
-     S 0.13238789E+02, 0.22492992E+02, 0.00000000E+00/
-      DATA (GB( 4,16,IC),IC=1,3) /
-     S 0.13238789E+02, 0.22502309E+02, 0.10000000E+01/
-C
-C----- INTERVAL = 4 ----- T =  237.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
-      DATA (GA( 5,15,IC),IC=1,3) /
-     S 0.13225963E+02, 0.22341039E+02, 0.00000000E+00/
-      DATA (GB( 5,15,IC),IC=1,3) /
-     S 0.13225963E+02, 0.22350445E+02, 0.10000000E+01/
-      DATA (GA( 5,16,IC),IC=1,3) /
-     S 0.13275017E+02, 0.22608508E+02, 0.00000000E+00/
-      DATA (GB( 5,16,IC),IC=1,3) /
-     S 0.13275017E+02, 0.22617792E+02, 0.10000000E+01/
-C
-C----- INTERVAL = 4 ----- T =  250.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
-      DATA (GA( 6,15,IC),IC=1,3) /
-     S 0.13243806E+02, 0.22424247E+02, 0.00000000E+00/
-      DATA (GB( 6,15,IC),IC=1,3) /
-     S 0.13243806E+02, 0.22433617E+02, 0.10000000E+01/
-      DATA (GA( 6,16,IC),IC=1,3) /
-     S 0.13316096E+02, 0.22723843E+02, 0.00000000E+00/
-      DATA (GB( 6,16,IC),IC=1,3) /
-     S 0.13316096E+02, 0.22733099E+02, 0.10000000E+01/
-C
-C----- INTERVAL = 4 ----- T =  262.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
-      DATA (GA( 7,15,IC),IC=1,3) /
-     S 0.13266104E+02, 0.22508089E+02, 0.00000000E+00/
-      DATA (GB( 7,15,IC),IC=1,3) /
-     S 0.13266104E+02, 0.22517429E+02, 0.10000000E+01/
-      DATA (GA( 7,16,IC),IC=1,3) /
-     S 0.13360555E+02, 0.22837837E+02, 0.00000000E+00/
-      DATA (GB( 7,16,IC),IC=1,3) /
-     S 0.13360555E+02, 0.22847071E+02, 0.10000000E+01/
-C
-C----- INTERVAL = 4 ----- T =  275.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
-      DATA (GA( 8,15,IC),IC=1,3) /
-     S 0.13291782E+02, 0.22591771E+02, 0.00000000E+00/
-      DATA (GB( 8,15,IC),IC=1,3) /
-     S 0.13291782E+02, 0.22601086E+02, 0.10000000E+01/
-      DATA (GA( 8,16,IC),IC=1,3) /
-     S 0.13407324E+02, 0.22949751E+02, 0.00000000E+00/
-      DATA (GB( 8,16,IC),IC=1,3) /
-     S 0.13407324E+02, 0.22958967E+02, 0.10000000E+01/
-C
-C----- INTERVAL = 4 ----- T =  287.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
-      DATA (GA( 9,15,IC),IC=1,3) /
-     S 0.13319961E+02, 0.22674661E+02, 0.00000000E+00/
-      DATA (GB( 9,15,IC),IC=1,3) /
-     S 0.13319961E+02, 0.22683956E+02, 0.10000000E+01/
-      DATA (GA( 9,16,IC),IC=1,3) /
-     S 0.13455544E+02, 0.23059032E+02, 0.00000000E+00/
-      DATA (GB( 9,16,IC),IC=1,3) /
-     S 0.13455544E+02, 0.23068234E+02, 0.10000000E+01/
-C
-C----- INTERVAL = 4 ----- T =  300.0
-C
-C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
-      DATA (GA(10,15,IC),IC=1,3) /
-     S 0.13349927E+02, 0.22756246E+02, 0.00000000E+00/
-      DATA (GB(10,15,IC),IC=1,3) /
-     S 0.13349927E+02, 0.22765522E+02, 0.10000000E+01/
-      DATA (GA(10,16,IC),IC=1,3) /
-     S 0.13504450E+02, 0.23165146E+02, 0.00000000E+00/
-      DATA (GB(10,16,IC),IC=1,3) /
-     S 0.13504450E+02, 0.23174336E+02, 0.10000000E+01/
-C
-C----- INTERVAL = 4 ----- T =  312.5
-C
-C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
-      DATA (GA(11,15,IC),IC=1,3) /
-     S 0.13381108E+02, 0.22836093E+02, 0.00000000E+00/
-      DATA (GB(11,15,IC),IC=1,3) /
-     S 0.13381108E+02, 0.22845354E+02, 0.10000000E+01/
-      DATA (GA(11,16,IC),IC=1,3) /
-     S 0.13553282E+02, 0.23267456E+02, 0.00000000E+00/
-      DATA (GB(11,16,IC),IC=1,3) /
-     S 0.13553282E+02, 0.23276638E+02, 0.10000000E+01/
-
-C     ------------------------------------------------------------------
-      DATA (( XP(  J,K),J=1,6),       K=1,6) /
-     S 0.46430621E+02, 0.12928299E+03, 0.20732648E+03,
-     S 0.31398411E+03, 0.18373177E+03,-0.11412303E+03,
-     S 0.73604774E+02, 0.27887914E+03, 0.27076947E+03,
-     S-0.57322111E+02,-0.64742459E+02, 0.87238280E+02,
-     S 0.37050866E+02, 0.20498759E+03, 0.37558029E+03,
-     S 0.17401171E+03,-0.13350302E+03,-0.37651795E+02,
-     S 0.14930141E+02, 0.89161160E+02, 0.17793062E+03,
-     S 0.93433860E+02,-0.70646020E+02,-0.26373150E+02,
-     S 0.40386780E+02, 0.10855270E+03, 0.50755010E+02,
-     S-0.31496190E+02, 0.12791300E+00, 0.18017770E+01,
-     S 0.90811926E+01, 0.75073923E+02, 0.24654438E+03,
-     S 0.39332612E+03, 0.29385281E+03, 0.89107921E+02 /
-C
-C
-C*         1.0     PLANCK FUNCTIONS AND GRADIENTS
-C                  ------------------------------
-C
- 100  CONTINUE
-C
-      DO 102 JK = 1 , KFLEV+1
-      DO 101 JL = 1, KDLON
-      PBINT(JL,JK) = 0.
- 101  CONTINUE
- 102  CONTINUE
-      DO 103 JL = 1, KDLON
-      PBSUIN(JL) = 0.
- 103  CONTINUE
-C
-      DO 141 JNU=1,Ninter
-C
-C
-C*         1.1   LEVELS FROM SURFACE TO KFLEV
-C                ----------------------------
-C
- 110  CONTINUE
-C
-      DO 112 JK = 1 , KFLEV
-      DO 111 JL = 1, KDLON
-      ZTI(JL)=(PTL(JL,JK)-TSTAND)/TSTAND
-      ZRES(JL) = XP(1,JNU)+ZTI(JL)*(XP(2,JNU)+ZTI(JL)*(XP(3,JNU)
-     S       +ZTI(JL)*(XP(4,JNU)+ZTI(JL)*(XP(5,JNU)+ZTI(JL)*(XP(6,JNU)
-     S       )))))
-      PBINT(JL,JK)=PBINT(JL,JK)+ZRES(JL)
-      PB(JL,JNU,JK)= ZRES(JL)
-      ZBLEV(JL,JK) = ZRES(JL)
-      ZTI2(JL)=(PTAVE(JL,JK)-TSTAND)/TSTAND
-      ZRES2(JL)=XP(1,JNU)+ZTI2(JL)*(XP(2,JNU)+ZTI2(JL)*(XP(3,JNU)
-     S     +ZTI2(JL)*(XP(4,JNU)+ZTI2(JL)*(XP(5,JNU)+ZTI2(JL)*(XP(6,JNU)
-     S       )))))
-      ZBLAY(JL,JK) = ZRES2(JL)
- 111  CONTINUE
- 112  CONTINUE
-C
-C
-C*         1.2   TOP OF THE ATMOSPHERE AND SURFACE
-C                ---------------------------------
-C
- 120  CONTINUE
-C
-      DO 121 JL = 1, KDLON
-      ZTI(JL)=(PTL(JL,KFLEV+1)-TSTAND)/TSTAND
-      ZTI2(JL) = (PTL(JL,1) + PDT0(JL) - TSTAND) / TSTAND
-      ZRES(JL) = XP(1,JNU)+ZTI(JL)*(XP(2,JNU)+ZTI(JL)*(XP(3,JNU)
-     S    +ZTI(JL)*(XP(4,JNU)+ZTI(JL)*(XP(5,JNU)+ZTI(JL)*(XP(6,JNU)
-     S       )))))
-      ZRES2(JL) = XP(1,JNU)+ZTI2(JL)*(XP(2,JNU)+ZTI2(JL)*(XP(3,JNU)
-     S    +ZTI2(JL)*(XP(4,JNU)+ZTI2(JL)*(XP(5,JNU)+ZTI2(JL)*(XP(6,JNU)
-     S       )))))
-      PBINT(JL,KFLEV+1) = PBINT(JL,KFLEV+1)+ZRES(JL)
-      PB(JL,JNU,KFLEV+1)= ZRES(JL)
-      ZBLEV(JL,KFLEV+1) = ZRES(JL)
-      PBTOP(JL,JNU) = ZRES(JL)
-      PBSUR(JL,JNU) = ZRES2(JL)
-      PBSUIN(JL) = PBSUIN(JL) + ZRES2(JL)
- 121  CONTINUE
-C
-C
-C*         1.3   GRADIENTS IN SUB-LAYERS
-C                -----------------------
-C
- 130  CONTINUE
-C
-      DO 132 JK = 1 , KFLEV
-      JK2 = 2 * JK
-      JK1 = JK2 - 1
-      DO 131 JL = 1, KDLON
-      PDBSL(JL,JNU,JK1) = ZBLAY(JL,JK  ) - ZBLEV(JL,JK)
-      PDBSL(JL,JNU,JK2) = ZBLEV(JL,JK+1) - ZBLAY(JL,JK)
- 131  CONTINUE
- 132  CONTINUE
-C
- 141  CONTINUE
-C
-C*         2.0   CHOOSE THE RELEVANT SETS OF PADE APPROXIMANTS
-C                ---------------------------------------------
-C
- 200  CONTINUE
-C
-C
- 210  CONTINUE
-C
-      DO 211 JL=1, KDLON
-      ZDSTO1 = (PTL(JL,KFLEV+1)-TINTP(1)) / TSTP
-      IXTOX = MAX( 1, MIN( MXIXT, INT( ZDSTO1 + 1. ) ) )
-      ZDSTOX = (PTL(JL,KFLEV+1)-TINTP(IXTOX))/TSTP
-      IF (ZDSTOX.LT.0.5) THEN
-         INDTO=IXTOX
-      ELSE
-         INDTO=IXTOX+1
-      END IF
-      INDB(JL)=INDTO
-      ZDST1 = (PTL(JL,1)-TINTP(1)) / TSTP
-      IXTX = MAX( 1, MIN( MXIXT, INT( ZDST1 + 1. ) ) )
-      ZDSTX = (PTL(JL,1)-TINTP(IXTX))/TSTP
-      IF (ZDSTX.LT.0.5) THEN
-         INDT=IXTX
-      ELSE
-         INDT=IXTX+1
-      END IF
-      INDS(JL)=INDT
- 211  CONTINUE
-C
-      DO 214 JF=1,2
-      DO 213 JG=1, 8
-      DO 212 JL=1, KDLON
-      INDSU=INDS(JL)
-      PGASUR(JL,JG,JF)=GA(INDSU,2*JG-1,JF)
-      PGBSUR(JL,JG,JF)=GB(INDSU,2*JG-1,JF)
-      INDTP=INDB(JL)
-      PGATOP(JL,JG,JF)=GA(INDTP,2*JG-1,JF)
-      PGBTOP(JL,JG,JF)=GB(INDTP,2*JG-1,JF)
- 212  CONTINUE
- 213  CONTINUE
- 214  CONTINUE
-C
- 220  CONTINUE
-C
-      DO 225 JK=1,KFLEV
-      DO 221 JL=1, KDLON
-      ZDST1 = (PTAVE(JL,JK)-TINTP(1)) / TSTP
-      IXTX = MAX( 1, MIN( MXIXT, INT( ZDST1 + 1. ) ) )
-      ZDSTX = (PTAVE(JL,JK)-TINTP(IXTX))/TSTP
-      IF (ZDSTX.LT.0.5) THEN
-         INDT=IXTX
-      ELSE
-         INDT=IXTX+1
-      END IF
-      INDB(JL)=INDT
- 221  CONTINUE
-C
-      DO 224 JF=1,2
-      DO 223 JG=1, 8
-      DO 222 JL=1, KDLON
-      INDT=INDB(JL)
-      PGA(JL,JG,JF,JK)=GA(INDT,2*JG,JF)
-      PGB(JL,JG,JF,JK)=GB(INDT,2*JG,JF)
- 222  CONTINUE
- 223  CONTINUE
- 224  CONTINUE
- 225  CONTINUE
-C
-C     ------------------------------------------------------------------
-C
-      RETURN
-      END
-      SUBROUTINE LWV(KUAER,KTRAER, KLIM
-     R  , PABCU,PB,PBINT,PBSUIN,PBSUR,PBTOP,PDBSL,PEMIS,PPMB,PTAVE
-     R  , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP
-     S  , PCNTRB,PCTS,PFLUC)
-      IMPLICIT none
-#include "dimensions.h"
-#include "dimphy.h"
-#include "raddim.h"
-#include "raddimlw.h"
-#include "YOMCST.h"
-C
-C-----------------------------------------------------------------------
-C     PURPOSE.
-C     --------
-C           CARRIES OUT THE VERTICAL INTEGRATION TO GIVE LONGWAVE
-C           FLUXES OR RADIANCES
-C
-C     METHOD.
-C     -------
-C
-C          1. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING BETWEEN
-C     CONTRIBUTIONS BY -  THE NEARBY LAYERS
-C                      -  THE DISTANT LAYERS
-C                      -  THE BOUNDARY TERMS
-C          2. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES.
-C
-C     REFERENCE.
-C     ----------
-C
-C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-C
-C     AUTHOR.
-C     -------
-C        JEAN-JACQUES MORCRETTE  *ECMWF*
-C
-C     MODIFICATIONS.
-C     --------------
-C        ORIGINAL : 89-07-14
-C-----------------------------------------------------------------------
-C
-C* ARGUMENTS:
-      INTEGER KUAER,KTRAER, KLIM
-C
-      REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! EFFECTIVE ABSORBER AMOUNTS
-      REAL*8 PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
-      REAL*8 PBINT(KDLON,KFLEV+1) ! HALF-LEVEL PLANCK FUNCTIONS
-      REAL*8 PBSUR(KDLON,Ninter) ! SURFACE SPECTRAL PLANCK FUNCTION
-      REAL*8 PBSUIN(KDLON) ! SURFACE PLANCK FUNCTION
-      REAL*8 PBTOP(KDLON,Ninter) ! T.O.A. SPECTRAL PLANCK FUNCTION
-      REAL*8 PDBSL(KDLON,Ninter,KFLEV*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
-      REAL*8 PEMIS(KDLON) ! SURFACE EMISSIVITY
-      REAL*8 PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
-      REAL*8 PTAVE(KDLON,KFLEV) ! TEMPERATURE
-      REAL*8 PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
-      REAL*8 PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
-      REAL*8 PGASUR(KDLON,8,2) ! PADE APPROXIMANTS
-      REAL*8 PGBSUR(KDLON,8,2) ! PADE APPROXIMANTS
-      REAL*8 PGATOP(KDLON,8,2) ! PADE APPROXIMANTS
-      REAL*8 PGBTOP(KDLON,8,2) ! PADE APPROXIMANTS
-C
-      REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX
-      REAL*8 PCTS(KDLON,KFLEV) ! COOLING-TO-SPACE TERM
-      REAL*8 PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES
-C-----------------------------------------------------------------------
-C LOCAL VARIABLES:
-      REAL*8 ZADJD(KDLON,KFLEV+1)
-      REAL*8 ZADJU(KDLON,KFLEV+1)
-      REAL*8 ZDBDT(KDLON,Ninter,KFLEV)
-      REAL*8 ZDISD(KDLON,KFLEV+1)
-      REAL*8 ZDISU(KDLON,KFLEV+1)
-C
-      INTEGER jk, jl
-C-----------------------------------------------------------------------
-C
-      DO 112 JK=1,KFLEV+1
-      DO 111 JL=1, KDLON
-      ZADJD(JL,JK)=0.
-      ZADJU(JL,JK)=0.
-      ZDISD(JL,JK)=0.
-      ZDISU(JL,JK)=0.
- 111  CONTINUE
- 112  CONTINUE
-C
-      DO 114 JK=1,KFLEV
-      DO 113 JL=1, KDLON
-      PCTS(JL,JK)=0.
- 113  CONTINUE
- 114  CONTINUE
-C
-C* CONTRIBUTION FROM ADJACENT LAYERS
-C
-      CALL LWVN(KUAER,KTRAER
-     R  , PABCU,PDBSL,PGA,PGB
-     S  , ZADJD,ZADJU,PCNTRB,ZDBDT)
-C* CONTRIBUTION FROM DISTANT LAYERS
-C
-      CALL LWVD(KUAER,KTRAER
-     R  , PABCU,ZDBDT,PGA,PGB
-     S  , PCNTRB,ZDISD,ZDISU)
-C
-C* EXCHANGE WITH THE BOUNDARIES
-C
-      CALL LWVB(KUAER,KTRAER, KLIM
-     R  , PABCU,ZADJD,ZADJU,PB,PBINT,PBSUIN,PBSUR,PBTOP
-     R  , ZDISD,ZDISU,PEMIS,PPMB
-     R  , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP
-     S  , PCTS,PFLUC)
-C
-C
-      RETURN
-      END
-      SUBROUTINE LWVB(KUAER,KTRAER, KLIM
-     R  , PABCU,PADJD,PADJU,PB,PBINT,PBSUI,PBSUR,PBTOP
-     R  , PDISD,PDISU,PEMIS,PPMB
-     R  , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP
-     S  , PCTS,PFLUC)
-      IMPLICIT none
-#include "dimensions.h"
-#include "dimphy.h"
-#include "raddim.h"
-#include "raddimlw.h"
-#include "radopt.h"
-C
-C-----------------------------------------------------------------------
-C     PURPOSE.
-C     --------
-C           INTRODUCES THE EFFECTS OF THE BOUNDARIES IN THE VERTICAL
-C           INTEGRATION
-C
-C     METHOD.
-C     -------
-C
-C          1. COMPUTES THE ENERGY EXCHANGE WITH TOP AND SURFACE OF THE
-C     ATMOSPHERE
-C          2. COMPUTES THE COOLING-TO-SPACE AND HEATING-FROM-GROUND
-C     TERMS FOR THE APPROXIMATE COOLING RATE ABOVE 10 HPA
-C          3. ADDS UP ALL CONTRIBUTIONS TO GET THE CLEAR-SKY FLUXES
-C
-C     REFERENCE.
-C     ----------
-C
-C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-C
-C     AUTHOR.
-C     -------
-C        JEAN-JACQUES MORCRETTE  *ECMWF*
-C
-C     MODIFICATIONS.
-C     --------------
-C        ORIGINAL : 89-07-14
-C        Voigt lines (loop 2413 to 2427)  - JJM & PhD - 01/96
-C-----------------------------------------------------------------------
-C
-C*       0.1   ARGUMENTS
-C              ---------
-C
-      INTEGER KUAER,KTRAER, KLIM
-C
-      REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! ABSORBER AMOUNTS
-      REAL*8 PADJD(KDLON,KFLEV+1) ! CONTRIBUTION BY ADJACENT LAYERS
-      REAL*8 PADJU(KDLON,KFLEV+1) ! CONTRIBUTION BY ADJACENT LAYERS
-      REAL*8 PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
-      REAL*8 PBINT(KDLON,KFLEV+1) ! HALF-LEVEL PLANCK FUNCTIONS
-      REAL*8 PBSUR(KDLON,Ninter) ! SPECTRAL SURFACE PLANCK FUNCTION
-      REAL*8 PBSUI(KDLON) ! SURFACE PLANCK FUNCTION
-      REAL*8 PBTOP(KDLON,Ninter) ! SPECTRAL T.O.A. PLANCK FUNCTION
-      REAL*8 PDISD(KDLON,KFLEV+1) ! CONTRIBUTION BY DISTANT LAYERS
-      REAL*8 PDISU(KDLON,KFLEV+1) ! CONTRIBUTION BY DISTANT LAYERS
-      REAL*8 PEMIS(KDLON) ! SURFACE EMISSIVITY
-      REAL*8 PPMB(KDLON,KFLEV+1) ! PRESSURE MB
-      REAL*8 PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
-      REAL*8 PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
-      REAL*8 PGASUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS
-      REAL*8 PGBSUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS
-      REAL*8 PGATOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS
-      REAL*8 PGBTOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS
-C
-      REAL*8 PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES
-      REAL*8 PCTS(KDLON,KFLEV) ! COOLING-TO-SPACE TERM
-C
-C* LOCAL VARIABLES:
-C
-      REAL*8 ZBGND(KDLON)
-      REAL*8 ZFD(KDLON)
-      REAL*8  ZFN10(KDLON)
-      REAL*8 ZFU(KDLON)
-      REAL*8  ZTT(KDLON,NTRA)
-      REAL*8 ZTT1(KDLON,NTRA)
-      REAL*8 ZTT2(KDLON,NTRA)
-      REAL*8  ZUU(KDLON,NUA) 
-      REAL*8 ZCNSOL(KDLON)
-      REAL*8 ZCNTOP(KDLON)
-C
-      INTEGER jk, jl, ja
-      INTEGER jstra, jstru
-      INTEGER ind1, ind2, ind3, ind4, in, jlim
-      REAL*8 zctstr
-C-----------------------------------------------------------------------
-C
-C*         1.    INITIALIZATION
-C                --------------
-C
- 100  CONTINUE
-C
-C
-C*         1.2     INITIALIZE TRANSMISSION FUNCTIONS
-C                  ---------------------------------
-C
- 120  CONTINUE
-C
-      DO 122 JA=1,NTRA
-      DO 121 JL=1, KDLON
-      ZTT (JL,JA)=1.0
-      ZTT1(JL,JA)=1.0
-      ZTT2(JL,JA)=1.0
- 121  CONTINUE
- 122  CONTINUE
-C
-      DO 124 JA=1,NUA
-      DO 123 JL=1, KDLON
-      ZUU(JL,JA)=1.0
- 123  CONTINUE
- 124  CONTINUE
-C
-C     ------------------------------------------------------------------
-C
-C*         2.      VERTICAL INTEGRATION
-C                  --------------------
-C
- 200  CONTINUE
-C
-      IND1=0
-      IND3=0
-      IND4=1
-      IND2=1
-C
-C
-C*         2.3     EXCHANGE WITH TOP OF THE ATMOSPHERE
-C                  -----------------------------------
-C
- 230  CONTINUE
-C
-      DO 235 JK = 1 , KFLEV
-      IN=(JK-1)*NG1P1+1
-C
-      DO 232 JA=1,KUAER
-      DO 231 JL=1, KDLON
-      ZUU(JL,JA)=PABCU(JL,JA,IN)
- 231  CONTINUE
- 232  CONTINUE
-C
-C
-      CALL LWTT(PGATOP(1,1,1), PGBTOP(1,1,1), ZUU, ZTT)
-C
-      DO 234 JL = 1, KDLON
-      ZCNTOP(JL)=PBTOP(JL,1)*ZTT(JL,1)          *ZTT(JL,10)
-     2      +PBTOP(JL,2)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11)
-     3      +PBTOP(JL,3)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12)
-     4      +PBTOP(JL,4)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13)
-     5      +PBTOP(JL,5)*ZTT(JL,3)          *ZTT(JL,14)
-     6      +PBTOP(JL,6)*ZTT(JL,6)          *ZTT(JL,15)
-      ZFD(JL)=ZCNTOP(JL)-PBINT(JL,JK)-PDISD(JL,JK)-PADJD(JL,JK)
-      PFLUC(JL,2,JK)=ZFD(JL)
- 234  CONTINUE
-C
- 235  CONTINUE
-C
-      JK = KFLEV+1
-      IN=(JK-1)*NG1P1+1
-C
-      DO 236 JL = 1, KDLON
-      ZCNTOP(JL)= PBTOP(JL,1)
-     1   + PBTOP(JL,2)
-     2   + PBTOP(JL,3)
-     3   + PBTOP(JL,4)
-     4   + PBTOP(JL,5)
-     5   + PBTOP(JL,6)
-      ZFD(JL)=ZCNTOP(JL)-PBINT(JL,JK)-PDISD(JL,JK)-PADJD(JL,JK)
-      PFLUC(JL,2,JK)=ZFD(JL)
- 236  CONTINUE
-C
-C*         2.4     COOLING-TO-SPACE OF LAYERS ABOVE 10 HPA
-C                  ---------------------------------------
-C
- 240  CONTINUE
-C
-C
-C*         2.4.1   INITIALIZATION
-C                  --------------
-C
- 2410 CONTINUE
-C
-      JLIM = KFLEV
-C
-      IF (.NOT.LEVOIGT) THEN
-      DO 2412 JK = KFLEV,1,-1
-      IF(PPMB(1,JK).LT.10.0) THEN
-         JLIM=JK
-      ENDIF   
- 2412 CONTINUE
-      ENDIF
-      KLIM=JLIM
-C
-      IF (.NOT.LEVOIGT) THEN
-        DO 2414 JA=1,KTRAER
-        DO 2413 JL=1, KDLON
-        ZTT1(JL,JA)=1.0
- 2413   CONTINUE
- 2414   CONTINUE
-C
-C*         2.4.2   LOOP OVER LAYERS ABOVE 10 HPA
-C                  -----------------------------
-C
- 2420   CONTINUE
-C
-        DO 2427 JSTRA = KFLEV,JLIM,-1
-        JSTRU=(JSTRA-1)*NG1P1+1
-C
-        DO 2423 JA=1,KUAER
-        DO 2422 JL=1, KDLON
-        ZUU(JL,JA)=PABCU(JL,JA,JSTRU)
- 2422   CONTINUE
- 2423   CONTINUE
-C
-C
-        CALL LWTT(PGA(1,1,1,JSTRA), PGB(1,1,1,JSTRA), ZUU, ZTT)
-C
-        DO 2424 JL = 1, KDLON
-        ZCTSTR =
-     1   (PB(JL,1,JSTRA)+PB(JL,1,JSTRA+1))
-     1       *(ZTT1(JL,1)           *ZTT1(JL,10)
-     1       - ZTT (JL,1)           *ZTT (JL,10))
-     2  +(PB(JL,2,JSTRA)+PB(JL,2,JSTRA+1))
-     2       *(ZTT1(JL,2)*ZTT1(JL,7)*ZTT1(JL,11)
-     2       - ZTT (JL,2)*ZTT (JL,7)*ZTT (JL,11))
-     3  +(PB(JL,3,JSTRA)+PB(JL,3,JSTRA+1))
-     3       *(ZTT1(JL,4)*ZTT1(JL,8)*ZTT1(JL,12)
-     3       - ZTT (JL,4)*ZTT (JL,8)*ZTT (JL,12))
-     4  +(PB(JL,4,JSTRA)+PB(JL,4,JSTRA+1))
-     4       *(ZTT1(JL,5)*ZTT1(JL,9)*ZTT1(JL,13)
-     4       - ZTT (JL,5)*ZTT (JL,9)*ZTT (JL,13))
-     5  +(PB(JL,5,JSTRA)+PB(JL,5,JSTRA+1))
-     5       *(ZTT1(JL,3)           *ZTT1(JL,14)
-     5       - ZTT (JL,3)           *ZTT (JL,14))
-     6  +(PB(JL,6,JSTRA)+PB(JL,6,JSTRA+1))
-     6       *(ZTT1(JL,6)           *ZTT1(JL,15)
-     6       - ZTT (JL,6)           *ZTT (JL,15))
-        PCTS(JL,JSTRA)=ZCTSTR*0.5
- 2424   CONTINUE
-        DO 2426 JA=1,KTRAER
-        DO 2425 JL=1, KDLON
-        ZTT1(JL,JA)=ZTT(JL,JA)
- 2425   CONTINUE
- 2426   CONTINUE
- 2427   CONTINUE
-      ENDIF
-C Mise a zero de securite pour PCTS en cas de LEVOIGT
-      IF(LEVOIGT)THEN
-        DO 2429 JSTRA = 1,KFLEV
-        DO 2428 JL = 1, KDLON
-          PCTS(JL,JSTRA)=0.
- 2428   CONTINUE
- 2429   CONTINUE
-      ENDIF
-C
-C
-C*         2.5     EXCHANGE WITH LOWER LIMIT
-C                  -------------------------
-C
- 250  CONTINUE
-C
-      DO 251 JL = 1, KDLON
-      ZBGND(JL)=PBSUI(JL)*PEMIS(JL)-(1.-PEMIS(JL))
-     S               *PFLUC(JL,2,1)-PBINT(JL,1)
- 251  CONTINUE
-C
-      JK = 1
-      IN=(JK-1)*NG1P1+1
-C
-      DO 252 JL = 1, KDLON
-      ZCNSOL(JL)=PBSUR(JL,1)
-     1 +PBSUR(JL,2)
-     2 +PBSUR(JL,3)
-     3 +PBSUR(JL,4)
-     4 +PBSUR(JL,5)
-     5 +PBSUR(JL,6)
-      ZCNSOL(JL)=ZCNSOL(JL)*ZBGND(JL)/PBSUI(JL)
-      ZFU(JL)=ZCNSOL(JL)+PBINT(JL,JK)-PDISU(JL,JK)-PADJU(JL,JK)
-      PFLUC(JL,1,JK)=ZFU(JL)
- 252  CONTINUE
-C
-      DO 257 JK = 2 , KFLEV+1
-      IN=(JK-1)*NG1P1+1
-C
-C
-      DO 255 JA=1,KUAER
-      DO 254 JL=1, KDLON
-      ZUU(JL,JA)=PABCU(JL,JA,1)-PABCU(JL,JA,IN)
- 254  CONTINUE
- 255  CONTINUE
-C
-C
-      CALL LWTT(PGASUR(1,1,1), PGBSUR(1,1,1), ZUU, ZTT)
-C
-      DO 256 JL = 1, KDLON
-      ZCNSOL(JL)=PBSUR(JL,1)*ZTT(JL,1)          *ZTT(JL,10)
-     2      +PBSUR(JL,2)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11)
-     3      +PBSUR(JL,3)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12)
-     4      +PBSUR(JL,4)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13)
-     5      +PBSUR(JL,5)*ZTT(JL,3)          *ZTT(JL,14)
-     6      +PBSUR(JL,6)*ZTT(JL,6)          *ZTT(JL,15)
-      ZCNSOL(JL)=ZCNSOL(JL)*ZBGND(JL)/PBSUI(JL)
-      ZFU(JL)=ZCNSOL(JL)+PBINT(JL,JK)-PDISU(JL,JK)-PADJU(JL,JK)
-      PFLUC(JL,1,JK)=ZFU(JL)
- 256  CONTINUE
-C
-C
- 257  CONTINUE
-C
-C
-C
-C*         2.7     CLEAR-SKY FLUXES
-C                  ----------------
-C
- 270  CONTINUE
-C
-      IF (.NOT.LEVOIGT) THEN
-      DO 271 JL = 1, KDLON
-      ZFN10(JL) = PFLUC(JL,1,JLIM) + PFLUC(JL,2,JLIM)
- 271  CONTINUE
-      DO 273 JK = JLIM+1,KFLEV+1
-      DO 272 JL = 1, KDLON
-      ZFN10(JL) = ZFN10(JL) + PCTS(JL,JK-1)
-      PFLUC(JL,1,JK) = ZFN10(JL)
-      PFLUC(JL,2,JK) = 0.
- 272  CONTINUE
- 273  CONTINUE
-      ENDIF
-C
-C     ------------------------------------------------------------------
-C
-      RETURN
-      END
-      SUBROUTINE LWVD(KUAER,KTRAER
-     S  , PABCU,PDBDT
-     R  , PGA,PGB
-     S  , PCNTRB,PDISD,PDISU)
-      IMPLICIT none
-#include "dimensions.h"
-#include "dimphy.h"
-#include "raddim.h"
-#include "raddimlw.h"
-C
-C-----------------------------------------------------------------------
-C     PURPOSE.
-C     --------
-C           CARRIES OUT THE VERTICAL INTEGRATION ON THE DISTANT LAYERS
-C
-C     METHOD.
-C     -------
-C
-C          1. PERFORMS THE VERTICAL INTEGRATION CORRESPONDING TO THE
-C     CONTRIBUTIONS OF THE DISTANT LAYERS USING TRAPEZOIDAL RULE
-C
-C     REFERENCE.
-C     ----------
-C
-C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-C
-C     AUTHOR.
-C     -------
-C        JEAN-JACQUES MORCRETTE  *ECMWF*
-C
-C     MODIFICATIONS.
-C     --------------
-C        ORIGINAL : 89-07-14
-C-----------------------------------------------------------------------
-C* ARGUMENTS:
-C
-      INTEGER KUAER,KTRAER
-C
-      REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! ABSORBER AMOUNTS
-      REAL*8 PDBDT(KDLON,Ninter,KFLEV) ! LAYER PLANCK FUNCTION GRADIENT
-      REAL*8 PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
-      REAL*8 PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
-C
-      REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) ! ENERGY EXCHANGE MATRIX
-      REAL*8 PDISD(KDLON,KFLEV+1) !  CONTRIBUTION BY DISTANT LAYERS
-      REAL*8 PDISU(KDLON,KFLEV+1) !  CONTRIBUTION BY DISTANT LAYERS
-C
-C* LOCAL VARIABLES:
-C
-      REAL*8 ZGLAYD(KDLON)
-      REAL*8 ZGLAYU(KDLON)
-      REAL*8 ZTT(KDLON,NTRA)
-      REAL*8 ZTT1(KDLON,NTRA)
-      REAL*8 ZTT2(KDLON,NTRA)
-C
-      INTEGER jl, jk, ja, ikp1, ikn, ikd1, jkj, ikd2
-      INTEGER ikjp1, ikm1, ikj, jlk, iku1, ijkl, iku2
-      INTEGER ind1, ind2, ind3, ind4, itt
-      REAL*8 zww, zdzxdg, zdzxmg
-C
-C*         1.    INITIALIZATION
-C                --------------
-C
- 100  CONTINUE
-C
-C*         1.1     INITIALIZE LAYER CONTRIBUTIONS
-C                  ------------------------------
-C
- 110  CONTINUE
-C
-      DO 112 JK = 1, KFLEV+1
-      DO 111 JL = 1, KDLON
-      PDISD(JL,JK) = 0.
-      PDISU(JL,JK) = 0.
-  111 CONTINUE
-  112 CONTINUE
-C
-C*         1.2     INITIALIZE TRANSMISSION FUNCTIONS
-C                  ---------------------------------
-C
- 120  CONTINUE
-C
-C
-      DO 122 JA = 1, NTRA
-      DO 121 JL = 1, KDLON
-      ZTT (JL,JA) = 1.0
-      ZTT1(JL,JA) = 1.0
-      ZTT2(JL,JA) = 1.0
-  121 CONTINUE
-  122 CONTINUE
-C
-C     ------------------------------------------------------------------
-C
-C*         2.      VERTICAL INTEGRATION
-C                  --------------------
-C
- 200  CONTINUE
-C
-      IND1=0
-      IND3=0
-      IND4=1
-      IND2=1
-C
-C
-C*         2.2     CONTRIBUTION FROM DISTANT LAYERS
-C                  ---------------------------------
-C
- 220  CONTINUE
-C
-C
-C*         2.2.1   DISTANT AND ABOVE LAYERS
-C                  ------------------------
-C
- 2210 CONTINUE
-C
-C
-C
-C*         2.2.2   FIRST UPPER LEVEL
-C                  -----------------
-C
- 2220 CONTINUE
-C
-      DO 225 JK = 1 , KFLEV-1
-      IKP1=JK+1
-      IKN=(JK-1)*NG1P1+1
-      IKD1= JK  *NG1P1+1
-C
-      CALL LWTTM(PGA(1,1,1,JK), PGB(1,1,1,JK)
-     2          , PABCU(1,1,IKN),PABCU(1,1,IKD1),ZTT1)
-C
-C
-C
-C*         2.2.3   HIGHER UP
-C                  ---------
-C
- 2230 CONTINUE
-C
-      ITT=1
-      DO 224 JKJ=IKP1,KFLEV
-      IF(ITT.EQ.1) THEN
-         ITT=2
-      ELSE
-         ITT=1
-      ENDIF
-      IKJP1=JKJ+1
-      IKD2= JKJ  *NG1P1+1
-C
-      IF(ITT.EQ.1) THEN
-         CALL LWTTM(PGA(1,1,1,JKJ),PGB(1,1,1,JKJ)
-     2             , PABCU(1,1,IKN),PABCU(1,1,IKD2),ZTT1)
-      ELSE
-         CALL LWTTM(PGA(1,1,1,JKJ),PGB(1,1,1,JKJ)
-     2             , PABCU(1,1,IKN),PABCU(1,1,IKD2),ZTT2)
-      ENDIF
-C
-      DO 2235 JA = 1, KTRAER
-      DO 2234 JL = 1, KDLON
-      ZTT(JL,JA) = (ZTT1(JL,JA)+ZTT2(JL,JA))*0.5
- 2234 CONTINUE
- 2235 CONTINUE
-C
-      DO 2236 JL = 1, KDLON
-      ZWW=PDBDT(JL,1,JKJ)*ZTT(JL,1)          *ZTT(JL,10)
-     S   +PDBDT(JL,2,JKJ)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11)
-     S   +PDBDT(JL,3,JKJ)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12)
-     S   +PDBDT(JL,4,JKJ)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13)
-     S   +PDBDT(JL,5,JKJ)*ZTT(JL,3)          *ZTT(JL,14)
-     S   +PDBDT(JL,6,JKJ)*ZTT(JL,6)          *ZTT(JL,15)
-      ZGLAYD(JL)=ZWW
-      ZDZXDG=ZGLAYD(JL)
-      PDISD(JL,JK)=PDISD(JL,JK)+ZDZXDG
-      PCNTRB(JL,JK,IKJP1)=ZDZXDG
- 2236 CONTINUE
-C
-C
- 224  CONTINUE
- 225  CONTINUE
-C
-C
-C*         2.2.4   DISTANT AND BELOW LAYERS
-C                  ------------------------
-C
- 2240 CONTINUE
-C
-C
-C
-C*         2.2.5   FIRST LOWER LEVEL
-C                  -----------------
-C
- 2250 CONTINUE
-C
-      DO 228 JK=3,KFLEV+1
-      IKN=(JK-1)*NG1P1+1
-      IKM1=JK-1
-      IKJ=JK-2
-      IKU1= IKJ  *NG1P1+1
-C
-C
-      CALL LWTTM(PGA(1,1,1,IKJ),PGB(1,1,1,IKJ)
-     2          , PABCU(1,1,IKU1),PABCU(1,1,IKN),ZTT1)
-C
-C
-C
-C*         2.2.6   DOWN BELOW
-C                  ----------
-C
- 2260 CONTINUE
-C
-      ITT=1
-      DO 227 JLK=1,IKJ
-      IF(ITT.EQ.1) THEN
-         ITT=2
-      ELSE
-         ITT=1
-      ENDIF
-      IJKL=IKM1-JLK
-      IKU2=(IJKL-1)*NG1P1+1
-C
-C
-      IF(ITT.EQ.1) THEN
-         CALL LWTTM(PGA(1,1,1,IJKL),PGB(1,1,1,IJKL)
-     2             , PABCU(1,1,IKU2),PABCU(1,1,IKN),ZTT1)
-      ELSE
-         CALL LWTTM(PGA(1,1,1,IJKL),PGB(1,1,1,IJKL)
-     2             , PABCU(1,1,IKU2),PABCU(1,1,IKN),ZTT2)
-      ENDIF
-C
-      DO 2265 JA = 1, KTRAER
-      DO 2264 JL = 1, KDLON
-      ZTT(JL,JA) = (ZTT1(JL,JA)+ZTT2(JL,JA))*0.5
- 2264 CONTINUE
- 2265 CONTINUE
-C
-      DO 2266 JL = 1, KDLON
-      ZWW=PDBDT(JL,1,IJKL)*ZTT(JL,1)          *ZTT(JL,10)
-     S   +PDBDT(JL,2,IJKL)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11)
-     S   +PDBDT(JL,3,IJKL)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12)
-     S   +PDBDT(JL,4,IJKL)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13)
-     S   +PDBDT(JL,5,IJKL)*ZTT(JL,3)          *ZTT(JL,14)
-     S   +PDBDT(JL,6,IJKL)*ZTT(JL,6)          *ZTT(JL,15)
-      ZGLAYU(JL)=ZWW
-      ZDZXMG=ZGLAYU(JL)
-      PDISU(JL,JK)=PDISU(JL,JK)+ZDZXMG
-      PCNTRB(JL,JK,IJKL)=ZDZXMG
- 2266 CONTINUE
-C
-C
- 227  CONTINUE
- 228  CONTINUE
-C
-      RETURN
-      END
-      SUBROUTINE LWVN(KUAER,KTRAER
-     R  , PABCU,PDBSL,PGA,PGB
-     S  , PADJD,PADJU,PCNTRB,PDBDT)
-      IMPLICIT none
-#include "dimensions.h"
-#include "dimphy.h"
-#include "raddim.h"
-#include "raddimlw.h"
-C
-C-----------------------------------------------------------------------
-C     PURPOSE.
-C     --------
-C           CARRIES OUT THE VERTICAL INTEGRATION ON NEARBY LAYERS
-C           TO GIVE LONGWAVE FLUXES OR RADIANCES
-C
-C     METHOD.
-C     -------
-C
-C          1. PERFORMS THE VERTICAL INTEGRATION CORRESPONDING TO THE
-C     CONTRIBUTIONS OF THE ADJACENT LAYERS USING A GAUSSIAN QUADRATURE
-C
-C     REFERENCE.
-C     ----------
-C
-C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-C
-C     AUTHOR.
-C     -------
-C        JEAN-JACQUES MORCRETTE  *ECMWF*
-C
-C     MODIFICATIONS.
-C     --------------
-C        ORIGINAL : 89-07-14
-C-----------------------------------------------------------------------
-C
-C* ARGUMENTS:
-C
-      INTEGER KUAER,KTRAER
-C
-      REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! ABSORBER AMOUNTS
-      REAL*8 PDBSL(KDLON,Ninter,KFLEV*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
-      REAL*8 PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
-      REAL*8 PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
-C
-      REAL*8 PADJD(KDLON,KFLEV+1) ! CONTRIBUTION OF ADJACENT LAYERS
-      REAL*8 PADJU(KDLON,KFLEV+1) ! CONTRIBUTION OF ADJACENT LAYERS
-      REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX
-      REAL*8 PDBDT(KDLON,Ninter,KFLEV) !  LAYER PLANCK FUNCTION GRADIENT
-C
-C* LOCAL ARRAYS:
-C
-      REAL*8 ZGLAYD(KDLON)
-      REAL*8 ZGLAYU(KDLON)
-      REAL*8 ZTT(KDLON,NTRA)
-      REAL*8 ZTT1(KDLON,NTRA)
-      REAL*8 ZTT2(KDLON,NTRA)
-      REAL*8 ZUU(KDLON,NUA)
-C
-      INTEGER jk, jl, ja, im12, ind, inu, ixu, jg
-      INTEGER ixd, ibs, idd, imu, jk1, jk2, jnu
-      REAL*8 zwtr
-c
-C* Data Block:
-c
-      REAL*8 WG1(2)
-      SAVE WG1
-      DATA (WG1(jk),jk=1,2) /1.0, 1.0/
-C-----------------------------------------------------------------------
-C
-C*         1.    INITIALIZATION
-C                --------------
-C
- 100  CONTINUE
-C
-C*         1.1     INITIALIZE LAYER CONTRIBUTIONS
-C                  ------------------------------
-C
- 110  CONTINUE
-C
-      DO 112 JK = 1 , KFLEV+1
-      DO 111 JL = 1, KDLON
-      PADJD(JL,JK) = 0.
-      PADJU(JL,JK) = 0.
- 111  CONTINUE
- 112  CONTINUE
-C
-C*         1.2     INITIALIZE TRANSMISSION FUNCTIONS
-C                  ---------------------------------
-C
- 120  CONTINUE
-C
-      DO 122 JA = 1 , NTRA
-      DO 121 JL = 1, KDLON
-      ZTT (JL,JA) = 1.0
-      ZTT1(JL,JA) = 1.0
-      ZTT2(JL,JA) = 1.0
- 121  CONTINUE
- 122  CONTINUE
-C
-      DO 124 JA = 1 , NUA
-      DO 123 JL = 1, KDLON
-      ZUU(JL,JA) = 0.
- 123  CONTINUE
- 124  CONTINUE
-C
-C     ------------------------------------------------------------------
-C
-C*         2.      VERTICAL INTEGRATION
-C                  --------------------
-C
- 200  CONTINUE
-C
-C
-C*         2.1     CONTRIBUTION FROM ADJACENT LAYERS
-C                  ---------------------------------
-C
- 210  CONTINUE
-C
-      DO 215 JK = 1 , KFLEV
-C
-C*         2.1.1   DOWNWARD LAYERS
-C                  ---------------
-C
- 2110 CONTINUE
-C
-      IM12 = 2 * (JK - 1)
-      IND = (JK - 1) * NG1P1 + 1
-      IXD = IND
-      INU = JK * NG1P1 + 1
-      IXU = IND
-C
-      DO 2111 JL = 1, KDLON
-      ZGLAYD(JL) = 0.
-      ZGLAYU(JL) = 0.
- 2111 CONTINUE
-C
-      DO 213 JG = 1 , NG1
-      IBS = IM12 + JG
-      IDD = IXD + JG
-      DO 2113 JA = 1 , KUAER
-      DO 2112 JL = 1, KDLON
-      ZUU(JL,JA) = PABCU(JL,JA,IND) - PABCU(JL,JA,IDD)
- 2112 CONTINUE
- 2113 CONTINUE
-C
-C
-      CALL LWTT(PGA(1,1,1,JK), PGB(1,1,1,JK), ZUU, ZTT)
-C
-      DO 2114 JL = 1, KDLON
-      ZWTR=PDBSL(JL,1,IBS)*ZTT(JL,1)          *ZTT(JL,10)
-     S    +PDBSL(JL,2,IBS)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11)
-     S    +PDBSL(JL,3,IBS)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12)
-     S    +PDBSL(JL,4,IBS)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13)
-     S    +PDBSL(JL,5,IBS)*ZTT(JL,3)          *ZTT(JL,14)
-     S    +PDBSL(JL,6,IBS)*ZTT(JL,6)          *ZTT(JL,15)
-      ZGLAYD(JL)=ZGLAYD(JL)+ZWTR*WG1(JG)
- 2114 CONTINUE
-C
-C*         2.1.2   DOWNWARD LAYERS
-C                  ---------------
-C
- 2120 CONTINUE
-C
-      IMU = IXU + JG
-      DO 2122 JA = 1 , KUAER
-      DO 2121 JL = 1, KDLON
-      ZUU(JL,JA) = PABCU(JL,JA,IMU) - PABCU(JL,JA,INU)
- 2121 CONTINUE
- 2122 CONTINUE
-C
-C
-      CALL LWTT(PGA(1,1,1,JK), PGB(1,1,1,JK), ZUU, ZTT)
-C
-      DO 2123 JL = 1, KDLON
-      ZWTR=PDBSL(JL,1,IBS)*ZTT(JL,1)          *ZTT(JL,10)
-     S    +PDBSL(JL,2,IBS)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11)
-     S    +PDBSL(JL,3,IBS)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12)
-     S    +PDBSL(JL,4,IBS)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13)
-     S    +PDBSL(JL,5,IBS)*ZTT(JL,3)          *ZTT(JL,14)
-     S    +PDBSL(JL,6,IBS)*ZTT(JL,6)          *ZTT(JL,15)
-      ZGLAYU(JL)=ZGLAYU(JL)+ZWTR*WG1(JG)
- 2123 CONTINUE
-C
- 213  CONTINUE
-C
-      DO 214 JL = 1, KDLON
-      PADJD(JL,JK) = ZGLAYD(JL)
-      PCNTRB(JL,JK,JK+1) = ZGLAYD(JL)
-      PADJU(JL,JK+1) = ZGLAYU(JL)
-      PCNTRB(JL,JK+1,JK) = ZGLAYU(JL)
-      PCNTRB(JL,JK  ,JK) = 0.0
- 214  CONTINUE
-C
- 215  CONTINUE
-C
-      DO 218 JK = 1 , KFLEV
-      JK2 = 2 * JK
-      JK1 = JK2 - 1
-      DO 217 JNU = 1 , Ninter
-      DO 216 JL = 1, KDLON
-      PDBDT(JL,JNU,JK) = PDBSL(JL,JNU,JK1) + PDBSL(JL,JNU,JK2)
- 216  CONTINUE
- 217  CONTINUE
- 218  CONTINUE
-C
-      RETURN
-C
-      END
-      SUBROUTINE LWTT(PGA,PGB,PUU, PTT)
-      IMPLICIT none
-#include "dimensions.h"
-#include "dimphy.h"
-#include "raddim.h"
-#include "raddimlw.h"
-C
-C-----------------------------------------------------------------------
-C     PURPOSE.
-C     --------
-C           THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
-C     ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN ALL SIX SPECTRAL
-C     INTERVALS.
-C
-C     METHOD.
-C     -------
-C
-C          1. TRANSMISSION FUNCTION BY H2O AND UNIFORMLY MIXED GASES ARE
-C     COMPUTED USING PADE APPROXIMANTS AND HORNER'S ALGORITHM.
-C          2. TRANSMISSION BY O3 IS EVALUATED WITH MALKMUS'S BAND MODEL.
-C          3. TRANSMISSION BY H2O CONTINUUM AND AEROSOLS FOLLOW AN
-C     A SIMPLE EXPONENTIAL DECREASE WITH ABSORBER AMOUNT.
-C
-C     REFERENCE.
-C     ----------
-C
-C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-C
-C     AUTHOR.
-C     -------
-C        JEAN-JACQUES MORCRETTE  *ECMWF*
-C
-C     MODIFICATIONS.
-C     --------------
-C        ORIGINAL : 88-12-15
-C
-C-----------------------------------------------------------------------
-      REAL*8 O1H, O2H
-      PARAMETER (O1H=2230.)
-      PARAMETER (O2H=100.)
-      REAL*8 RPIALF0
-      PARAMETER (RPIALF0=2.0)
-C
-C* ARGUMENTS:
-C
-      REAL*8 PUU(KDLON,NUA)
-      REAL*8 PTT(KDLON,NTRA)
-      REAL*8 PGA(KDLON,8,2)
-      REAL*8 PGB(KDLON,8,2)
-C
-C* LOCAL VARIABLES:
-C
-      REAL*8 zz, zxd, zxn
-      REAL*8 zpu, zpu10, zpu11, zpu12, zpu13
-      REAL*8 zeu, zeu10, zeu11, zeu12, zeu13
-      REAL*8 zx, zy, zsq1, zsq2, zvxy, zuxy
-      REAL*8 zaercn, zto1, zto2, zxch4, zych4, zxn2o, zyn2o
-      REAL*8 zsqn21, zodn21, zsqh42, zodh42
-      REAL*8 zsqh41, zodh41, zsqn22, zodn22, zttf11, zttf12
-      REAL*8 zuu11, zuu12, za11, za12
-      INTEGER jl, ja
-C     ------------------------------------------------------------------
-C
-C*         1.     HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION
-C                 -----------------------------------------------
-C
- 100  CONTINUE
-C
-C
-      DO 130 JA = 1 , 8
-      DO 120 JL = 1, KDLON
-      ZZ      =SQRT(PUU(JL,JA))
-c     ZXD(JL,1)=PGB( JL, 1,1) + ZZ(JL, 1)*(PGB( JL, 1,2) + ZZ(JL, 1))
-c     ZXN(JL,1)=PGA( JL, 1,1) + ZZ(JL, 1)*(PGA( JL, 1,2) )
-c     PTT(JL,1)=ZXN(JL,1)/ZXD(JL,1)
-      ZXD      =PGB( JL,JA,1) + ZZ       *(PGB( JL,JA,2) + ZZ       )
-      ZXN      =PGA( JL,JA,1) + ZZ       *(PGA( JL,JA,2) )
-      PTT(JL,JA)=ZXN      /ZXD
-  120 CONTINUE
-  130 CONTINUE
-C
-C     ------------------------------------------------------------------
-C
-C*         2.     CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS
-C                 ---------------------------------------------------
-C
- 200  CONTINUE
-C
-      DO 201 JL = 1, KDLON
-      PTT(JL, 9) = PTT(JL, 8)
-C
-C-  CONTINUUM ABSORPTION: E- AND P-TYPE
-C
-      ZPU   = 0.002 * PUU(JL,10)
-      ZPU10 = 112. * ZPU
-      ZPU11 = 6.25 * ZPU
-      ZPU12 = 5.00 * ZPU
-      ZPU13 = 80.0 * ZPU
-      ZEU   =  PUU(JL,11)
-      ZEU10 =  12. * ZEU
-      ZEU11 = 6.25 * ZEU
-      ZEU12 = 5.00 * ZEU
-      ZEU13 = 80.0 * ZEU
-C
-C-  OZONE ABSORPTION
-C
-      ZX = PUU(JL,12)
-      ZY = PUU(JL,13)
-      ZUXY = 4. * ZX * ZX / (RPIALF0 * ZY)
-      ZSQ1 = SQRT(1. + O1H * ZUXY ) - 1.
-      ZSQ2 = SQRT(1. + O2H * ZUXY ) - 1.
-      ZVXY = RPIALF0 * ZY / (2. * ZX)
-      ZAERCN = PUU(JL,17) + ZEU12 + ZPU12
-      ZTO1 = EXP( - ZVXY * ZSQ1 - ZAERCN )
-      ZTO2 = EXP( - ZVXY * ZSQ2 - ZAERCN )
-C
-C-- TRACE GASES (CH4, N2O, CFC-11, CFC-12)
-C
-C* CH4 IN INTERVAL 800-970 + 1110-1250 CM-1
-C
-c     NEXOTIC=1
-c     IF (NEXOTIC.EQ.1) THEN
-      ZXCH4 = PUU(JL,19)
-      ZYCH4 = PUU(JL,20)
-      ZUXY = 4. * ZXCH4*ZXCH4/(0.103*ZYCH4)
-      ZSQH41 = SQRT(1. + 33.7 * ZUXY) - 1.
-      ZVXY = 0.103 * ZYCH4 / (2. * ZXCH4)
-      ZODH41 = ZVXY * ZSQH41
-C
-C* N2O IN INTERVAL 800-970 + 1110-1250 CM-1
-C
-      ZXN2O = PUU(JL,21)
-      ZYN2O = PUU(JL,22)
-      ZUXY = 4. * ZXN2O*ZXN2O/(0.416*ZYN2O)
-      ZSQN21 = SQRT(1. + 21.3 * ZUXY) - 1.
-      ZVXY = 0.416 * ZYN2O / (2. * ZXN2O)
-      ZODN21 = ZVXY * ZSQN21
-C
-C* CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1
-C
-      ZUXY = 4. * ZXCH4*ZXCH4/(0.113*ZYCH4)
-      ZSQH42 = SQRT(1. + 400. * ZUXY) - 1.
-      ZVXY = 0.113 * ZYCH4 / (2. * ZXCH4)
-      ZODH42 = ZVXY * ZSQH42
-C
-C* N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1
-C
-      ZUXY = 4. * ZXN2O*ZXN2O/(0.197*ZYN2O)
-      ZSQN22 = SQRT(1. + 2000. * ZUXY) - 1.
-      ZVXY = 0.197 * ZYN2O / (2. * ZXN2O)
-      ZODN22 = ZVXY * ZSQN22
-C
-C* CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1
-C
-      ZA11 = 2. * PUU(JL,23) * 4.404E+05
-      ZTTF11 = 1. - ZA11 * 0.003225
-C
-C* CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1
-C
-      ZA12 = 2. * PUU(JL,24) * 6.7435E+05
-      ZTTF12 = 1. - ZA12 * 0.003225
-C
-      ZUU11 = - PUU(JL,15) - ZEU10 - ZPU10
-      ZUU12 = - PUU(JL,16) - ZEU11 - ZPU11 - ZODH41 - ZODN21
-      PTT(JL,10) = EXP( - PUU(JL,14) )
-      PTT(JL,11) = EXP( ZUU11 )
-      PTT(JL,12) = EXP( ZUU12 ) * ZTTF11 * ZTTF12
-      PTT(JL,13) = 0.7554 * ZTO1 + 0.2446 * ZTO2
-      PTT(JL,14) = PTT(JL,10) * EXP( - ZEU13 - ZPU13 )
-      PTT(JL,15) = EXP ( - PUU(JL,14) - ZODH42 - ZODN22 )
- 201  CONTINUE
-C
-      RETURN
-      END
-      SUBROUTINE LWTTM(PGA,PGB,PUU1,PUU2, PTT)
-      IMPLICIT none
-#include "dimensions.h"
-#include "dimphy.h"
-#include "raddim.h"
-#include "raddimlw.h"
-C
-C     ------------------------------------------------------------------
-C     PURPOSE.
-C     --------
-C           THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
-C     ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN ALL SIX SPECTRAL
-C     INTERVALS.
-C
-C     METHOD.
-C     -------
-C
-C          1. TRANSMISSION FUNCTION BY H2O AND UNIFORMLY MIXED GASES ARE
-C     COMPUTED USING PADE APPROXIMANTS AND HORNER'S ALGORITHM.
-C          2. TRANSMISSION BY O3 IS EVALUATED WITH MALKMUS'S BAND MODEL.
-C          3. TRANSMISSION BY H2O CONTINUUM AND AEROSOLS FOLLOW AN
-C     A SIMPLE EXPONENTIAL DECREASE WITH ABSORBER AMOUNT.
-C
-C     REFERENCE.
-C     ----------
-C
-C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
-C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
-C
-C     AUTHOR.
-C     -------
-C        JEAN-JACQUES MORCRETTE  *ECMWF*
-C
-C     MODIFICATIONS.
-C     --------------
-C        ORIGINAL : 88-12-15
-C
-C-----------------------------------------------------------------------
-      REAL*8 O1H, O2H
-      PARAMETER (O1H=2230.)
-      PARAMETER (O2H=100.)
-      REAL*8 RPIALF0
-      PARAMETER (RPIALF0=2.0)
-C
-C* ARGUMENTS:
-C
-      REAL*8 PGA(KDLON,8,2) ! PADE APPROXIMANTS
-      REAL*8 PGB(KDLON,8,2) ! PADE APPROXIMANTS
-      REAL*8 PUU1(KDLON,NUA) ! ABSORBER AMOUNTS FROM TOP TO LEVEL 1
-      REAL*8 PUU2(KDLON,NUA) ! ABSORBER AMOUNTS FROM TOP TO LEVEL 2
-      REAL*8 PTT(KDLON,NTRA) ! TRANSMISSION FUNCTIONS
-C
-C* LOCAL VARIABLES:
-C
-      INTEGER ja, jl
-      REAL*8 zz, zxd, zxn
-      REAL*8 zpu, zpu10, zpu11, zpu12, zpu13
-      REAL*8 zeu, zeu10, zeu11, zeu12, zeu13
-      REAL*8 zx, zy, zuxy, zsq1, zsq2, zvxy, zaercn, zto1, zto2
-      REAL*8 zxch4, zych4, zsqh41, zodh41
-      REAL*8 zxn2o, zyn2o, zsqn21, zodn21, zsqh42, zodh42
-      REAL*8 zsqn22, zodn22, za11, zttf11, za12, zttf12
-      REAL*8 zuu11, zuu12
-C     ------------------------------------------------------------------
-C
-C*         1.     HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION
-C                 -----------------------------------------------
-C
- 100  CONTINUE
-C
-C
-      DO 130 JA = 1 , 8
-      DO 120 JL = 1, KDLON
-      ZZ      =SQRT(PUU1(JL,JA) - PUU2(JL,JA))
-      ZXD      =PGB( JL,JA,1) + ZZ       *(PGB( JL,JA,2) + ZZ       )
-      ZXN      =PGA( JL,JA,1) + ZZ       *(PGA( JL,JA,2) )
-      PTT(JL,JA)=ZXN      /ZXD
-  120 CONTINUE
-  130 CONTINUE
-C
-C     ------------------------------------------------------------------
-C
-C*         2.     CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS
-C                 ---------------------------------------------------
-C
- 200  CONTINUE
-C
-      DO 201 JL = 1, KDLON
-      PTT(JL, 9) = PTT(JL, 8)
-C
-C-  CONTINUUM ABSORPTION: E- AND P-TYPE
-C
-      ZPU   = 0.002 * (PUU1(JL,10) - PUU2(JL,10))
-      ZPU10 = 112. * ZPU
-      ZPU11 = 6.25 * ZPU
-      ZPU12 = 5.00 * ZPU
-      ZPU13 = 80.0 * ZPU
-      ZEU   = (PUU1(JL,11) - PUU2(JL,11))
-      ZEU10 =  12. * ZEU
-      ZEU11 = 6.25 * ZEU
-      ZEU12 = 5.00 * ZEU
-      ZEU13 = 80.0 * ZEU
-C
-C-  OZONE ABSORPTION
-C
-      ZX = (PUU1(JL,12) - PUU2(JL,12))
-      ZY = (PUU1(JL,13) - PUU2(JL,13))
-      ZUXY = 4. * ZX * ZX / (RPIALF0 * ZY)
-      ZSQ1 = SQRT(1. + O1H * ZUXY ) - 1.
-      ZSQ2 = SQRT(1. + O2H * ZUXY ) - 1.
-      ZVXY = RPIALF0 * ZY / (2. * ZX)
-      ZAERCN = (PUU1(JL,17) -PUU2(JL,17)) + ZEU12 + ZPU12
-      ZTO1 = EXP( - ZVXY * ZSQ1 - ZAERCN )
-      ZTO2 = EXP( - ZVXY * ZSQ2 - ZAERCN )
-C
-C-- TRACE GASES (CH4, N2O, CFC-11, CFC-12)
-C
-C* CH4 IN INTERVAL 800-970 + 1110-1250 CM-1
-C
-      ZXCH4 = (PUU1(JL,19) - PUU2(JL,19))
-      ZYCH4 = (PUU1(JL,20) - PUU2(JL,20))
-      ZUXY = 4. * ZXCH4*ZXCH4/(0.103*ZYCH4)
-      ZSQH41 = SQRT(1. + 33.7 * ZUXY) - 1.
-      ZVXY = 0.103 * ZYCH4 / (2. * ZXCH4)
-      ZODH41 = ZVXY * ZSQH41
-C
-C* N2O IN INTERVAL 800-970 + 1110-1250 CM-1
-C
-      ZXN2O = (PUU1(JL,21) - PUU2(JL,21))
-      ZYN2O = (PUU1(JL,22) - PUU2(JL,22))
-      ZUXY = 4. * ZXN2O*ZXN2O/(0.416*ZYN2O)
-      ZSQN21 = SQRT(1. + 21.3 * ZUXY) - 1.
-      ZVXY = 0.416 * ZYN2O / (2. * ZXN2O)
-      ZODN21 = ZVXY * ZSQN21
-C
-C* CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1
-C
-      ZUXY = 4. * ZXCH4*ZXCH4/(0.113*ZYCH4)
-      ZSQH42 = SQRT(1. + 400. * ZUXY) - 1.
-      ZVXY = 0.113 * ZYCH4 / (2. * ZXCH4)
-      ZODH42 = ZVXY * ZSQH42
-C
-C* N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1
-C
-      ZUXY = 4. * ZXN2O*ZXN2O/(0.197*ZYN2O)
-      ZSQN22 = SQRT(1. + 2000. * ZUXY) - 1.
-      ZVXY = 0.197 * ZYN2O / (2. * ZXN2O)
-      ZODN22 = ZVXY * ZSQN22
-C
-C* CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1
-C
-      ZA11 = (PUU1(JL,23) - PUU2(JL,23)) * 4.404E+05
-      ZTTF11 = 1. - ZA11 * 0.003225
-C
-C* CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1
-C
-      ZA12 = (PUU1(JL,24) - PUU2(JL,24)) * 6.7435E+05
-      ZTTF12 = 1. - ZA12 * 0.003225
-C
-      ZUU11 = - (PUU1(JL,15) - PUU2(JL,15)) - ZEU10 - ZPU10
-      ZUU12 = - (PUU1(JL,16) - PUU2(JL,16)) - ZEU11 - ZPU11 -
-     S         ZODH41 - ZODN21
-      PTT(JL,10) = EXP( - (PUU1(JL,14)- PUU2(JL,14)) )
-      PTT(JL,11) = EXP( ZUU11 )
-      PTT(JL,12) = EXP( ZUU12 ) * ZTTF11 * ZTTF12
-      PTT(JL,13) = 0.7554 * ZTO1 + 0.2446 * ZTO2
-      PTT(JL,14) = PTT(JL,10) * EXP( - ZEU13 - ZPU13 )
-      PTT(JL,15) = EXP ( - (PUU1(JL,14) - PUU2(JL,14)) - ZODH42-ZODN22 )
- 201  CONTINUE
-C
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/radopt.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/radopt.h	(revision 416)
+++ 	(revision )
@@ -1,6 +1,0 @@
-      LOGICAL LEVOIGT
-      PARAMETER (LEVOIGT=.FALSE.)
-      INTEGER NOVLP
-      PARAMETER (NOVLP=1)
-      INTEGER KAER
-      PARAMETER (KAER=0)
Index: LMDZ.3.3/branches/rel-/libf/phylmd/read_pstoke.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/read_pstoke.F	(revision 416)
+++ 	(revision )
@@ -1,525 +1,0 @@
-c
-c $Header$
-c
-	subroutine read_pstoke(irec,
-     .   zrec,zklono,zklevo,airefi,phisfi,
-     .   t,mfu,mfd,en_u,de_u,en_d,de_d,coefh,
-     .   frac_impa,frac_nucl,pyu1,pyv1,ftsol,psrf)
-
-
-       IMPLICIT NONE
-
-#include "netcdf.inc"
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comgeom.h"
-#include "temps.h"
-#include "ener.h"
-#include "logic.h"
-#include "description.h"
-#include "serre.h"
-#include "indicesol.h"
-#include "control.h"
-#include "dimphy.h"
-	
-	  integer*4 klono,klevo,imo,jmo
-	  parameter (imo=iim/2,jmo=(jjm+1)/2)
-	  parameter(klono=(jmo-1)*imo+2,klevo=llm)
-	  REAL*4 phisfi(klono)
-          REAL*4 phisfi2(imo,jmo+1),airefi2(imo,jmo+1)
-
-          REAL*4 mfu(klono,klevo), mfd(klono,klevo)
-          REAL*4 en_u(klono,klevo), de_u(klono,klevo)
-          REAL*4 en_d(klono,klevo), de_d(klono,klevo)
-          REAL*4 coefh(klono,klevo)
-
-          REAL*4 mfu2(imo,jmo+1,klevo), mfd2(imo,jmo+1,klevo)
-          REAL*4 en_u2(imo,jmo+1,klevo), de_u2(imo,jmo+1,klevo)
-          REAL*4 en_d2(imo,jmo+1,klevo), de_d2(imo,jmo+1,klevo)
-          REAL*4 coefh2(imo,jmo+1,klevo)
-
-          REAL*4 pl(klevo)
-          integer irec
-          integer*4 xid,yid,zid,tid
-          real zrec,zklono,zklevo,zim,zjm
-          integer*4 ncrec,ncklono,ncklevo,ncim,ncjm
-
-          real*4 airefi(klono)
-          character namedim
-
-c  !! attention !!
-c attention il y a aussi le pb de def klono
-c dim de phis??
-	  
-	 
-          REAL*4 frac_impa(klono,klevo), frac_nucl(klono,klevo)
-          REAL*4 frac_impa2(imo,jmo+1,klevo), 
-     .     frac_nucl2(imo,jmo+1,klevo)
-          REAL*4 pyu1(klono), pyv1(klono)
-          REAL*4 pyu12(imo,jmo+1), pyv12(imo,jmo+1)
-          REAL*4 ftsol(klono,nbsrf)
-          REAL*4 psrf(klono,nbsrf) 
-	  REAL*4 ftsol1(klono),ftsol2(klono),ftsol3(klono),ftsol4(klono)
-          REAL*4 psrf1(klono),psrf2(klono),psrf3(klono),psrf4(klono)
-          REAL*4 ftsol12(imo,jmo+1),ftsol22(imo,jmo+1),
-     .     ftsol32(imo,jmo+1),
-     .     ftsol42(imo,jmo+1)
-          REAL*4 psrf12(imo,jmo+1),psrf22(imo,jmo+1),psrf32(imo,jmo+1),
-     .     psrf42(imo,jmo+1)
-		REAL*4 t(klono,klevo)
-		REAL*4 t2(imo,jmo+1)	
-	  integer ncidp
-          save ncidp
-		integer varidt
-          integer varidmfu, varidmfd, varidps, varidenu, variddeu	
-          integer varidend,varidded,varidch,varidfi,varidfn
-          integer varidyu1,varidyv1,varidpl,varidai,varididvt
-          integer varidfts1,varidfts2,varidfts3,varidfts4
-          integer varidpsr1,varidpsr2,varidpsr3,varidpsr4
-          save varidmfu, varidmfd, varidps, varidenu, variddeu
-          save varidend,varidded,varidch,varidfi,varidfn
-          save varidyu1,varidyv1,varidpl,varidai,varididvt
-          save varidfts1,varidfts2,varidfts3,varidfts4
-          save varidpsr1,varidpsr2,varidpsr3,varidpsr4
-		save varidt
-
-          integer l, i
-          integer start(4),count(4),status
-          real rcode
-          logical first
-          save first
-          data first/.true./
-
-
-
-c ---------------------------------------------
-c   Initialisation de la lecture des fichiers
-c ---------------------------------------------
-
-      if (irec .eq. 0) then
-
-            ncidp=NCOPN('phystoke.nc',NCNOWRIT,rcode)
-
-            varidps=NCVID(ncidp,'phis',rcode)
-            print*,'ncidp,varidps',ncidp,varidps
-
-            varidpl=NCVID(ncidp,'sig_s',rcode)
-            print*,'ncidp,varidpl',ncidp,varidpl
-
-            varidai=NCVID(ncidp,'aire',rcode)
-            print*,'ncidp,varidai',ncidp,varidai
-
-	        varidt=NCVID(ncidp,'t',rcode)
-                print*,'ncidp,varidt',ncidp,varidt
-            varidmfu=NCVID(ncidp,'mfu',rcode)
-            print*,'ncidp,varidmfu',ncidp,varidmfu
-
-            varidmfd=NCVID(ncidp,'mfd',rcode)
-            print*,'ncidp,varidmfd',ncidp,varidmfd
-
-            varidenu=NCVID(ncidp,'en_u',rcode)
-            print*,'ncidp,varidenu',ncidp,varidenu
-
-            variddeu=NCVID(ncidp,'de_u',rcode)
-            print*,'ncidp,variddeu',ncidp,variddeu
-
-            varidend=NCVID(ncidp,'en_d',rcode)
-            print*,'ncidp,varidend',ncidp,varidend
-	
-            varidded=NCVID(ncidp,'de_d',rcode)
-            print*,'ncidp,varidded',ncidp,varidded
-	
-            varidch=NCVID(ncidp,'coefh',rcode)
-            print*,'ncidp,varidch',ncidp,varidch
-	
-	    varidfi=NCVID(ncidp,'frac_impa',rcode)
-            print*,'ncidp,varidfi',ncidp,varidfi
-	
-	    varidfn=NCVID(ncidp,'frac_nucl',rcode)
-            print*,'ncidp,varidfn',ncidp,varidfn
-	
-            varidyu1=NCVID(ncidp,'pyu1',rcode)
-            print*,'ncidp,varidyu1',ncidp,varidyu1
-	
-            varidyv1=NCVID(ncidp,'pyv1',rcode)
-            print*,'ncidp,varidyv1',ncidp,varidyv1
-	
-            varidfts1=NCVID(ncidp,'ftsol1',rcode)
-            print*,'ncidp,varidfts1',ncidp,varidfts1
-	
-            varidfts2=NCVID(ncidp,'ftsol2',rcode)
-            print*,'ncidp,varidfts2',ncidp,varidfts2
-         
-            varidfts3=NCVID(ncidp,'ftsol3',rcode)
-            print*,'ncidp,varidfts3',ncidp,varidfts3
-  
-            varidfts4=NCVID(ncidp,'ftsol4',rcode)
-            print*,'ncidp,varidfts4',ncidp,varidfts4
-	
-            varidpsr1=NCVID(ncidp,'psrf1',rcode)
-            print*,'ncidp,varidpsr1',ncidp,varidpsr1
-	
-            varidpsr2=NCVID(ncidp,'psrf2',rcode)
-            print*,'ncidp,varidpsr2',ncidp,varidpsr2
-	
-	    varidpsr3=NCVID(ncidp,'psrf3',rcode)
-            print*,'ncidp,varidpsr3',ncidp,varidpsr3
-
-            varidpsr4=NCVID(ncidp,'psrf4',rcode)
-            print*,'ncidp,varidpsr4',ncidp,varidpsr4
-	
-c ID pour les dimensions
-
-            status = nf_inq_dimid(ncidp,'y',yid)
-            status = nf_inq_dimid(ncidp,'x',xid)
-            status = nf_inq_dimid(ncidp,'sig_s',zid)
-            status = nf_inq_dimid(ncidp,'time_counter',tid)
-
-c lecture des dimensions
-
-            status = nf_inq_dim(ncidp,yid,namedim,ncjm)
-            status = nf_inq_dim(ncidp,xid,namedim,ncim)
-            status = nf_inq_dim(ncidp,zid,namedim,ncklevo)
-            status = nf_inq_dim(ncidp,tid,namedim,ncrec)
-	
-            zrec=ncrec
-            zklevo=ncklevo
-            zim=ncim
-            zjm=ncjm
-	
-	    zklono=zim*(zjm-2)+2
-	
-	    write(*,*) 'read_pstoke : zrec = ', zrec
-            write(*,*) 'read_pstoke : zklevo = ', zklevo
-            write(*,*) 'read_pstoke : zim = ', zim 
-            write(*,*) 'read_pstoke : zjm = ', zjm
-            write(*,*) 'read_pstoke : zklono = ', zklono
-
-c niveaux de pression
-
-#ifdef NC_DOUBLE
-            status=NF_GET_VARA_DOUBLE(ncidp,varidpl,1,zklevo,pl)
-#else
-            status=NF_GET_VARA_REAL(ncidp,varidpl,1,zklevo,pl)
-#endif
-
-
-c lecture de aire et phis
-	
-      start(1)=1
-      start(2)=1
-      start(3)=1
-      start(4)=0
-
-      count(1)=zim
-      count(2)=zjm
-      count(3)=1
-      count(4)=0
-
-c phis
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidps,start,count,phisfi2)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidps,start,count,phisfi2)
-#endif
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*1,phisfi2)
-c      call dump2d(iip1-1,jjp1,phisfi2,'PHISNC')
-      call gr_ecrit_fi(1,klono,imo,jmo+1,phisfi2,phisfi)
-
-c aire
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidai,start,count,airefi2)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidai,start,count,airefi2)
-#endif
-
-c      call correctbid(iim,jjp1*1,airefi2)
-c       call dump2d(iip1-1,jjp1,airefi2,'AIRENC')
-       call gr_ecrit_fi(1,klono,imo,jmo+1,airefi2,airefi)
-      else
-
-      print*,'ok1'
-
-c ---------------------
-c   lecture des champs
-c ---------------------
-	
-	print*,'WARNING!!! Il n y a pas de test de coherence'
-        print*,'sur le nombre de niveaux verticaux dans le fichier nc'
-
-      start(1)=1
-      start(2)=1
-      start(3)=1
-      start(4)=irec
-
-      count(1)=zim
-      count(2)=zjm
-      count(3)=zklevo
-      count(4)=1
-
-c frac_impa 
-
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidfi,start,count,frac_impa2)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidfi,start,count,frac_impa2)
-#endif
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*klevo,frac_impa2)
-c      call dump2d(iip1-1,jjp1,frac_impa2,'FINC COUCHE 1')
-      call gr_ecrit_fi(klevo,klono,imo,jmo+1,frac_impa2,frac_impa)
-
-c frac_nucl 
-
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidfn,start,count,frac_nucl2)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidfn,start,count,frac_nucl2)
-#endif
-
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*klevo,frac_nucl2)
-c      call dump2d(iip1-1,jjp1,frac_nucl2,'FINC COUCHE 1')
-      call gr_ecrit_fi(klevo,klono,imo,jmo+1,frac_nucl2,frac_nucl)
-
-c abder t
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidt,start,count,t2)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidt,start,count,t2)
-#endif
-      call gr_ecrit_fi(klevo,klono,imo,jmo+1,t2,t)
-
-c mfu
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidmfu,start,count,mfu2)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidmfu,start,count,mfu2)
-#endif
-
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*klevo,mfu2)
-c      call dump2d(iip1-1,jjp1,mfu2,'MFUNC COUCHE 1')
-      call gr_ecrit_fi(klevo,klono,imo,jmo+1,mfu2,mfu)
-
-c mfd
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidmfd,start,count,mfd2)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidmfd,start,count,mfd2)
-#endif
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*klevo,mfd2)
-c      call dump2d(iip1-1,jjp1,mfd2,'MFDNC COUCHE 1')
-      call gr_ecrit_fi(klevo,klono,imo,jmo+1,mfd2,mfd)
-
-c en_u 
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidenu,start,count,en_u2)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidenu,start,count,en_u2)
-#endif
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*klevo,en_u2)
-c      call dump2d(iip1-1,jjp1,en_u2,'ENUNC COUCHE 1')
-      call gr_ecrit_fi(klevo,klono,imo,jmo+1,en_u2,en_u)
-
-c de_u 
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,variddeu,start,count,de_u2)
-#else
-      status=NF_GET_VARA_REAL(ncidp,variddeu,start,count,de_u2)
-#endif
-
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*klevo,de_u2)
-c      call dump2d(iip1-1,jjp1,de_u2,'DEUNC COUCHE 1')
-      call gr_ecrit_fi(klevo,klono,imo,jmo+1,de_u2,de_u)
-
-c en_d 
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidend,start,count,en_d2)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidend,start,count,en_d2)
-#endif
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*klevo,en_d2)
-c      call dump2d(iip1-1,jjp1,en_d2,'ENDNC COUCHE 1')
-      call gr_ecrit_fi(klevo,klono,imo,jmo+1,en_d2,en_d)
-
-c de_d 
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidded,start,count,de_d2)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidded,start,count,de_d2)
-#endif
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*klevo,de_d2)
-c      call dump2d(iip1-1,jjp1,de_d2,'DEDNC COUCHE 1')
-      call gr_ecrit_fi(klevo,klono,imo,jmo+1,de_d2,de_d)
-
-c coefh 
-        print*,'LECTURE de coefh a irec =',irec
-#ifdef NC_DOUBLE
-       status=NF_GET_VARA_DOUBLE(ncidp,varidch,start,count,coefh2)
-#else
-       status=NF_GET_VARA_REAL(ncidp,varidch,start,count,coefh2)
-#endif
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*klevo,coefh2)
-c      call dump2d(iip1-1,jjp1,coefh2,'CHNC COUCHE 1')
-       call gr_ecrit_fi(klevo,klono,imo,jmo+1,coefh2,coefh)
-
-      start(3)=irec
-      start(4)=0
-      count(3)=1
-      count(4)=0
-
-c pyu1
-      status=NF_GET_VARA_REAL(ncidp,varidyu1,start,count,pyu12)
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*1,pyu12)
-c      call dump2d(iip1-1,jjp1,pyu12,'PYU1NC')
-      call gr_ecrit_fi(1,klono,imo,jmo+1,pyu12,pyu1)
-
-c pyv1
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidyv1,start,count,pyv12)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidyv1,start,count,pyv12)
-#endif
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*1,pyv12)
-c      call dump2d(iip1-1,jjp1,pyv12,'PYV1NC')
-      call gr_ecrit_fi(1,klono,imo,jmo+1,pyv12,pyv1)
-
-c ftsol1
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidfts1,start,count,ftsol12)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidfts1,start,count,ftsol12)
-#endif
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*1,ftsol12)
-c      call dump2d(iip1-1,jjp1,ftsol12,'FTS1NC')
-       call gr_ecrit_fi(1,klono,imo,jmo+1,ftsol12,ftsol1)
-
-c ftsol2
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidfts2,start,count,ftsol22)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidfts2,start,count,ftsol22)
-#endif
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*1,ftsol22)
-c      call dump2d(iip1-1,jjp1,ftsol22,'FTS2NC')
-      call gr_ecrit_fi(1,klono,imo,jmo+1,ftsol22,ftsol2)
-
-c ftsol3
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidfts3,start,count,ftsol32)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidfts3,start,count,ftsol32)
-#endif
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*1,ftsol32)
-c      call dump2d(iip1-1,jjp1,ftsol32,'FTS3NC')
-      call gr_ecrit_fi(1,klono,imo,jmo+1,ftsol32,ftsol3)
-
-c ftsol4
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidfts4,start,count,ftsol42)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidfts4,start,count,ftsol42)
-#endif
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*1,ftsol42)
-c      call dump2d(iip1-1,jjp1,ftsol42,'FTS4NC')
-      call gr_ecrit_fi(1,klono,imo,jmo+1,ftsol42,ftsol4)
-
-c psrf1 
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr2,start,count,psrf22)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidpsr2,start,count,psrf22)
-#endif
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*1,psrf12)
-c      call dump2d(iip1-1,jjp1,psrf12,'PSRF1NC')
-      call gr_ecrit_fi(1,klono,imo,jmo+1,psrf12,psrf1)
-
-c psrf2 
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr2,start,count,psrf22)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidpsr2,start,count,psrf22)
-#endif
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*1,psrf22)
-c      call dump2d(iip1-1,jjp1,psrf22,'PSRF2NC')
-      call gr_ecrit_fi(1,klono,imo,jmo+1,psrf22,psrf2)
-
-c psrf3 
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr3,start,count,psrf32)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidpsr3,start,count,psrf32)
-#endif
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*1,psrf32)
-c      call dump2d(iip1-1,jjp1,psrf32,'PSRF3NC')
-      call gr_ecrit_fi(1,klono,imo,jmo+1,psrf32,psrf3)
-
-c psrf4 
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr4,start,count,psrf42)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidpsr4,start,count,psrf42)
-#endif
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*1,psrf42)
-c      call dump2d(iip1-1,jjp1,psrf42,'PSRF4NC')
-      call gr_ecrit_fi(1,klono,imo,jmo+1,psrf42,psrf4)
-	
-          do i = 1,klono
-	
-	psrf(i,1) = psrf1(i)
-        psrf(i,2) = psrf2(i)
-        psrf(i,3) = psrf3(i)
-        psrf(i,4) = psrf4(i)
-  
-        ftsol(i,1) = ftsol1(i)
-        ftsol(i,2) = ftsol2(i)
-        ftsol(i,3) = ftsol3(i)
-        ftsol(i,4) = ftsol4(i)
-	
-          enddo
-	
-	endif
-	
-	return
-	
-	end
-
Index: LMDZ.3.3/branches/rel-/libf/phylmd/read_pstoke0.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/read_pstoke0.F	(revision 416)
+++ 	(revision )
@@ -1,456 +1,0 @@
-	subroutine read_pstoke0(irec,
-     .   zrec,zkon,zkev,airefi,phisfi,
-     .   t,mfu,mfd,en_u,de_u,en_d,de_d,coefh,
-     .   frac_impa,frac_nucl,pyu1,pyv1,ftsol,psrf)
-
-
-       IMPLICIT NONE
-
-#include "netcdf.inc"
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comgeom.h"
-#include "temps.h"
-#include "ener.h"
-#include "logic.h"
-#include "description.h"
-#include "serre.h"
-#include "indicesol.h"
-#include "control.h"
-#include "dimphy.h"
-	  
-	  integer*4 kon,kev,zkon,zkev
-	  parameter(kon=iim*(jjm-1)+2,kev=llm)
-	  REAL*4 phisfi(kon)
-          REAL*4 phisfi2(iim,jjm+1),airefi2(iim,jjm+1)
-
-          REAL*4 mfu(kon,kev), mfd(kon,kev)
-          REAL*4 en_u(kon,kev), de_u(kon,kev)
-          REAL*4 en_d(kon,kev), de_d(kon,kev)
-          REAL*4 coefh(kon,kev)
-		REAL*4 t(kon,kev)
-
-          REAL*4 mfu2(iim,jjm+1,kev), mfd2(iim,jjm+1,kev)
-          REAL*4 en_u2(iim,jjm+1,kev), de_u2(iim,jjm+1,kev)
-          REAL*4 en_d2(iim,jjm+1,kev), de_d2(iim,jjm+1,kev)
-          REAL*4 coefh2(iim,jjm+1,kev)
-		REAL*4 t2(iim,jjm+1,kev)
-
-          REAL*4 pl(kev)
-          integer irec
-          integer*4 xid,yid,zid,tid
-          integer*4 zrec,zim,zjm
-          integer*4 ncrec,nckon,nckev,ncim,ncjm
-
-          real*4 airefi(kon)
-          character namedim
-
-c  !! attention !!
-c attention il y a aussi le pb de def kon
-c dim de phis??
-
-          REAL*4 frac_impa(kon,kev), frac_nucl(kon,kev)
-          REAL*4 frac_impa2(iim,jjm+1,kev), 
-     .     frac_nucl2(iim,jjm+1,kev)
-          REAL*4 pyu1(kon), pyv1(kon)
-          REAL*4 pyu12(iim,jjm+1), pyv12(iim,jjm+1)
-          REAL*4 ftsol(kon,nbsrf)
-          REAL*4 psrf(kon,nbsrf) 
-	  REAL*4 ftsol1(kon),ftsol2(kon),ftsol3(kon),ftsol4(kon)
-          REAL*4 psrf1(kon),psrf2(kon),psrf3(kon),psrf4(kon)
-          REAL*4 ftsol12(iim,jjm+1),ftsol22(iim,jjm+1),
-     .     ftsol32(iim,jjm+1),
-     .     ftsol42(iim,jjm+1)
-          REAL*4 psrf12(iim,jjm+1),psrf22(iim,jjm+1),psrf32(iim,jjm+1),
-     .     psrf42(iim,jjm+1)
-	
-	  integer ncidp
-          save ncidp
-          integer varidmfu, varidmfd, varidps, varidenu, variddeu	
-		integer varidt
-          integer varidend,varidded,varidch,varidfi,varidfn
-          integer varidyu1,varidyv1,varidpl,varidai,varididvt
-          integer varidfts1,varidfts2,varidfts3,varidfts4
-          integer varidpsr1,varidpsr2,varidpsr3,varidpsr4
-          save varidmfu, varidmfd, varidps, varidenu, variddeu
-		save varidt
-          save varidend,varidded,varidch,varidfi,varidfn
-          save varidyu1,varidyv1,varidpl,varidai,varididvt
-          save varidfts1,varidfts2,varidfts3,varidfts4
-          save varidpsr1,varidpsr2,varidpsr3,varidpsr4
-
-          integer l, i
-          integer start(4),count(4),status
-          real rcode
-          logical first
-          save first
-          data first/.true./
-
-
-
-c ---------------------------------------------
-c   Initialisation de la lecture des fichiers
-c ---------------------------------------------
-
-      if (irec .eq. 0) then
-
-            ncidp=NCOPN('phystoke.nc',NCNOWRIT,rcode)
-
-            varidps=NCVID(ncidp,'phis',rcode)
-            print*,'ncidp,varidps',ncidp,varidps
-
-            varidpl=NCVID(ncidp,'sig_s',rcode)
-            print*,'ncidp,varidpl',ncidp,varidpl
-
-            varidai=NCVID(ncidp,'aire',rcode)
-            print*,'ncidp,varidai',ncidp,varidai
-
-            varidmfu=NCVID(ncidp,'mfu',rcode)
-            print*,'ncidp,varidmfu',ncidp,varidmfu
-
-		varidt=NCVID(ncidp,'t',rcode)
-                print*,'ncidp,varidt',ncidp,varidt
-
-            varidmfd=NCVID(ncidp,'mfd',rcode)
-            print*,'ncidp,varidmfd',ncidp,varidmfd
-
-            varidenu=NCVID(ncidp,'en_u',rcode)
-            print*,'ncidp,varidenu',ncidp,varidenu
-
-            variddeu=NCVID(ncidp,'de_u',rcode)
-            print*,'ncidp,variddeu',ncidp,variddeu
-
-            varidend=NCVID(ncidp,'en_d',rcode)
-            print*,'ncidp,varidend',ncidp,varidend
-	
-            varidded=NCVID(ncidp,'de_d',rcode)
-            print*,'ncidp,varidded',ncidp,varidded
-	
-            varidch=NCVID(ncidp,'coefh',rcode)
-            print*,'ncidp,varidch',ncidp,varidch
-	
-	    varidfi=NCVID(ncidp,'frac_impa',rcode)
-            print*,'ncidp,varidfi',ncidp,varidfi
-	
-	    varidfn=NCVID(ncidp,'frac_nucl',rcode)
-            print*,'ncidp,varidfn',ncidp,varidfn
-	
-            varidyu1=NCVID(ncidp,'pyu1',rcode)
-            print*,'ncidp,varidyu1',ncidp,varidyu1
-	
-            varidyv1=NCVID(ncidp,'pyv1',rcode)
-            print*,'ncidp,varidyv1',ncidp,varidyv1
-	
-            varidfts1=NCVID(ncidp,'ftsol1',rcode)
-            print*,'ncidp,varidfts1',ncidp,varidfts1
-	
-            varidfts2=NCVID(ncidp,'ftsol2',rcode)
-            print*,'ncidp,varidfts2',ncidp,varidfts2
-         
-            varidfts3=NCVID(ncidp,'ftsol3',rcode)
-            print*,'ncidp,varidfts3',ncidp,varidfts3
-  
-            varidfts4=NCVID(ncidp,'ftsol4',rcode)
-            print*,'ncidp,varidfts4',ncidp,varidfts4
-	
-            varidpsr1=NCVID(ncidp,'psrf1',rcode)
-            print*,'ncidp,varidpsr1',ncidp,varidpsr1
-	
-            varidpsr2=NCVID(ncidp,'psrf2',rcode)
-            print*,'ncidp,varidpsr2',ncidp,varidpsr2
-	
-	    varidpsr3=NCVID(ncidp,'psrf3',rcode)
-            print*,'ncidp,varidpsr3',ncidp,varidpsr3
-
-            varidpsr4=NCVID(ncidp,'psrf4',rcode)
-            print*,'ncidp,varidpsr4',ncidp,varidpsr4
-	
-c ID pour les dimensions
-
-            status = nf_inq_dimid(ncidp,'y',yid)
-            status = nf_inq_dimid(ncidp,'x',xid)
-            status = nf_inq_dimid(ncidp,'sig_s',zid)
-            status = nf_inq_dimid(ncidp,'time_counter',tid)
-
-c lecture des dimensions
-
-            status = nf_inq_dim(ncidp,yid,namedim,ncjm)
-            status = nf_inq_dim(ncidp,xid,namedim,ncim)
-            status = nf_inq_dim(ncidp,zid,namedim,nckev)
-            status = nf_inq_dim(ncidp,tid,namedim,ncrec)
-	
-            zrec=ncrec
-            zkev=nckev
-            zim=ncim
-            zjm=ncjm
-	
-	    zkon=zim*(zjm-2)+2
-	
-	    write(*,*) 'read_pstoke : zrec = ', zrec
-            write(*,*) 'read_pstoke : kev = ', zkev
-            write(*,*) 'read_pstoke : zim = ', zim 
-            write(*,*) 'read_pstoke : zjm = ', zjm
-            write(*,*) 'read_pstoke : kon = ', zkon
-
-c niveaux de pression
-
-#ifdef NC_DOUBLE
-            status=NF_GET_VARA_DOUBLE(ncidp,varidpl,1,kev,pl)
-#else
-            status=NF_GET_VARA_REAL(ncidp,varidpl,1,kev,pl)
-#endif
-
-c lecture de aire et phis
-	
-      start(1)=1
-      start(2)=1
-      start(3)=1
-      start(4)=0
-
-      count(1)=zim
-      count(2)=zjm
-      count(3)=1
-      count(4)=0
-
-c 
-c phis
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidps,start,count,phisfi2)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidps,start,count,phisfi2)
-#endif
-
-
-      call gr_ecrit_fi(1,kon,iim,jjm+1,phisfi2,phisfi)
-
-c aire
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidai,start,count,airefi2)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidai,start,count,airefi2)
-#endif
-
-      call gr_ecrit_fi(1,kon,iim,jjm+1,airefi2,airefi)
-      else
-
-      print*,'ok1'
-
-c ---------------------
-c   lecture des champs
-c ---------------------
-	
-	print*,'WARNING!!! Il n y a pas de test de coherence'
-        print*,'sur le nombre de niveaux verticaux dans le fichier nc'
-
-      start(1)=1
-      start(2)=1
-      start(3)=1
-      start(4)=irec
-
-      count(1)=zim
-      count(2)=zjm
-      count(3)=kev
-      count(4)=1
-
-c frac_impa 
-
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidfi,start,count,frac_impa2)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidfi,start,count,frac_impa2)
-#endif
-      call gr_ecrit_fi(kev,kon,iim,jjm+1,frac_impa2,frac_impa)
-
-c frac_nucl 
-
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidfn,start,count,frac_nucl2)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidfn,start,count,frac_nucl2)
-#endif
-      call gr_ecrit_fi(kev,kon,iim,jjm+1,frac_nucl2,frac_nucl)
-
-c abder t
-
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidt,start,count,t2)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidt,start,count,t2)
-#endif
-
-      call gr_ecrit_fi(kev,kon,iim,jjm+1,t2,t)
-
-c mfu
-
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidmfu,start,count,mfu2)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidmfu,start,count,mfu2)
-#endif
-
-      call gr_ecrit_fi(kev,kon,iim,jjm+1,mfu2,mfu)
-
-c mfd
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidmfd,start,count,mfd2)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidmfd,start,count,mfd2)
-#endif
-      call gr_ecrit_fi(kev,kon,iim,jjm+1,mfd2,mfd)
-
-c en_u 
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidenu,start,count,en_u2)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidenu,start,count,en_u2)
-#endif
-      call gr_ecrit_fi(kev,kon,iim,jjm+1,en_u2,en_u)
-
-c de_u 
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,variddeu,start,count,de_u2)
-#else
-      status=NF_GET_VARA_REAL(ncidp,variddeu,start,count,de_u2)
-#endif
-      call gr_ecrit_fi(kev,kon,iim,jjm+1,de_u2,de_u)
-
-c en_d 
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidend,start,count,en_d2)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidend,start,count,en_d2)
-#endif
-      call gr_ecrit_fi(kev,kon,iim,jjm+1,en_d2,en_d)
-
-c de_d 
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidded,start,count,de_d2)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidded,start,count,de_d2)
-#endif
-      call gr_ecrit_fi(kev,kon,iim,jjm+1,de_d2,de_d)
-
-c coefh 
-	print*,'LECTURE de coefh a irec =',irec
-#ifdef NC_DOUBLE
-       status=NF_GET_VARA_DOUBLE(ncidp,varidch,start,count,coefh2)
-#else
-       status=NF_GET_VARA_REAL(ncidp,varidch,start,count,coefh2)
-#endif
-
-       call gr_ecrit_fi(kev,kon,iim,jjm+1,coefh2,coefh)
-
-      start(3)=irec
-      start(4)=0
-      count(3)=1
-      count(4)=0
-
-c pyu1
-	print*,'LECTURE de yu1 a irec =',irec
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidyu1,start,count,pyu12)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidyu1,start,count,pyu12)
-#endif
-
-      call gr_ecrit_fi(1,kon,iim,jjm+1,pyu12,pyu1)
-
-c pyv1
-        print*,'LECTURE de yv1 a irec =',irec
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidyv1,start,count,pyv12)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidyv1,start,count,pyv12)
-#endif
-      call gr_ecrit_fi(1,kon,iim,jjm+1,pyv12,pyv1)
-
-c ftsol1
-        print*,'LECTURE de ftsol1 a irec =',irec
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidfts1,start,count,ftsol12)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidfts1,start,count,ftsol12)
-#endif
-       call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol12,ftsol1)
-
-c ftsol2
-        print*,'LECTURE de ftsol2 a irec =',irec
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidfts2,start,count,ftsol22)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidfts2,start,count,ftsol22)
-#endif
-      call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol22,ftsol2)
-
-c ftsol3
-	 print*,'LECTURE de ftsol3 a irec =',irec
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidfts3,start,count,ftsol32)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidfts3,start,count,ftsol32)
-#endif
-      call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol32,ftsol3)
-
-c ftsol4
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidfts4,start,count,ftsol42)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidfts4,start,count,ftsol42)
-#endif
-      call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol42,ftsol4)
-
-c psrf1 
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr1,start,count,psrf12)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidpsr1,start,count,psrf12)
-#endif
-c      call dump2d(iip1-1,jjm+1,psrf12,'PSRF1NC')
-      call gr_ecrit_fi(1,kon,iim,jjm+1,psrf12,psrf1)
-
-c psrf2 
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr2,start,count,psrf22)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidpsr2,start,count,psrf22)
-#endif
-c      call dump2d(iip1-1,jjm+1,psrf22,'PSRF2NC')
-      call gr_ecrit_fi(1,kon,iim,jjm+1,psrf22,psrf2)
-
-c psrf3 
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr3,start,count,psrf32)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidpsr3,start,count,psrf32)
-#endif
-      call gr_ecrit_fi(1,kon,iim,jjm+1,psrf32,psrf3)
-
-c psrf4 
-#ifdef NC_DOUBLE
-      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr4,start,count,psrf42)
-#else
-      status=NF_GET_VARA_REAL(ncidp,varidpsr4,start,count,psrf42)
-#endif
-      call gr_ecrit_fi(1,kon,iim,jjm+1,psrf42,psrf4)
-	
-          do i = 1,kon
-	
-	psrf(i,1) = psrf1(i)
-        psrf(i,2) = psrf2(i)
-        psrf(i,3) = psrf3(i)
-        psrf(i,4) = psrf4(i)
-  
-        ftsol(i,1) = ftsol1(i)
-        ftsol(i,2) = ftsol2(i)
-        ftsol(i,3) = ftsol3(i)
-        ftsol(i,4) = ftsol4(i)
-	
-          enddo
-	
-	endif
-	
-	return
-	
-	end
-
Index: LMDZ.3.3/branches/rel-/libf/phylmd/regdim.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/regdim.h	(revision 416)
+++ 	(revision )
@@ -1,13 +1,0 @@
-      INTEGER i1_deb, i1_fin
-      INTEGER i2_deb, i2_fin
-ccc      PARAMETER (i1_deb=21, i1_fin=40)
-ccc      PARAMETER (i2_deb=41, i2_fin=44)
-cccc      PARAMETER (i1_deb=47, i1_fin=77)
-cccc      PARAMETER (i2_deb=78, i2_fin=79)
-      PARAMETER (i1_deb=16, i1_fin=30)
-      PARAMETER (i2_deb=31, i2_fin=33)
-c
-      INTEGER j_deb, j_fin
-ccc      PARAMETER (j_deb=29, j_fin=61)
-cccc      PARAMETER (j_deb=21, j_fin=51)
-      PARAMETER (j_deb=18, j_fin=39)
Index: LMDZ.3.3/branches/rel-/libf/phylmd/screenp.F90
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/screenp.F90	(revision 416)
+++ 	(revision )
@@ -1,105 +1,0 @@
-      SUBROUTINE screenp(klon, knon, nsrf, &
-     &                   speed, tair, qair, &
-     &                   ts, qsurf, rugos, lmon, &
-     &                   ustar, testar, qstar, zref, &
-     &                   delu, delte, delq) 
-      IMPLICIT none
-!-------------------------------------------------------------------------
-!
-! Objet : calcul "predicteur" des anomalies du vent, de la temperature 
-!         potentielle et de l'humidite relative au niveau de reference zref et 
-!         par rapport au 1er niveau (pour u) ou a la surface (pour theta et q) 
-!         a partir des relations de Dyer-Businger.
-!
-! Reference : Hess, Colman et McAvaney (1995)
-!
-! I. Musat, 01.07.2002
-!-------------------------------------------------------------------------
-!
-! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
-! knon----input-I- nombre de points pour un type de surface
-! nsrf----input-I- indice pour le type de surface; voir indicesol.inc
-! speed---input-R- module du vent au 1er niveau du modele
-! tair----input-R- temperature de l'air au 1er niveau du modele
-! qair----input-R- humidite relative au 1er niveau du modele
-! ts------input-R- temperature de l'air a la surface
-! qsurf---input-R- humidite relative a la surface
-! rugos---input-R- rugosite
-! lmon----input-R- longueur de Monin-Obukov
-! ustar---input-R- facteur d'echelle pour le vent
-! testar--input-R- facteur d'echelle pour la temperature potentielle
-! qstar---input-R- facteur d'echelle pour l'humidite relative
-! zref----input-R- altitude de reference
-!
-! delu----input-R- anomalie du vent par rapport au 1er niveau
-! delte---input-R- anomalie de la temperature potentielle par rapport a la surface
-! delq----input-R- anomalie de l'humidite relative par rapport a la surface
-!
-      INTEGER, intent(in) :: klon, knon, nsrf
-      REAL, dimension(klon), intent(in) :: speed, tair, qair
-      REAL, dimension(klon), intent(in) :: ts, qsurf, rugos
-      DOUBLE PRECISION, dimension(klon), intent(in) :: lmon
-      REAL, dimension(klon), intent(in) :: ustar, testar, qstar
-      REAL, intent(in) :: zref
-!
-      REAL, dimension(klon), intent(out) :: delu, delte, delq
-!
-!-------------------------------------------------------------------------
-! Variables locales et constantes :
-      REAL, PARAMETER :: RKAR=0.40
-      INTEGER :: i
-      REAL :: xtmp, xtmp0
-!-------------------------------------------------------------------------
-      DO i = 1, knon
-!
-        IF (lmon(i).GE.0.) THEN
-!
-! STABLE CASE
-!
-          IF (speed(i).GT.1.5.AND.lmon(i).LE.1.0) THEN
-            delu(i) = (ustar(i)/RKAR)* &
-                      (log(zref/(rugos(i))+1.) + &
-                      min(5.0, 5.0 *(zref - rugos(i))/lmon(i)))
-            delte(i) = (testar(i)/RKAR)* &
-                       (log(zref/(rugos(i))+1.) + &
-                       min(5.0, 5.0 * (zref - rugos(i))/lmon(i)))
-            delq(i) = (qstar(i)/RKAR)* &
-                      (log(zref/(rugos(i))+1.) + &
-                      min(5.0, 5.0 * (zref - rugos(i))/lmon(i)))
-          ELSE
-            delu(i)  = 0.1 * speed(i)
-            delte(i) = 0.1 * (tair(i) - ts(i) )
-            delq(i)  = 0.1 * (max(qair(i),0.0) - max(qsurf(i),0.0))
-          ENDIF
-        ELSE  
-!
-! UNSTABLE CASE
-!
-          IF (speed(i).GT.5.0.AND.abs(lmon(i)).LE.50.0) THEN
-            xtmp = (1. - 16. * (zref/lmon(i)))**(1./4.)
-            xtmp0 = (1. - 16. * (rugos(i)/lmon(i)))**(1./4.)
-            delu(i) = (ustar(i)/RKAR)* &
-                      (log(zref/(rugos(i))+1.) & 
-                      - 2.*log(0.5*(1. + xtmp)) &
-                      + 2.*log(0.5*(1. + xtmp0)) &
-                      - log(0.5*(1. + xtmp*xtmp)) &
-                      + log(0.5*(1. + xtmp0*xtmp0)) &
-                      + 2.*atan(xtmp) - 2.*atan(xtmp0))
-            delte(i) = (testar(i)/RKAR)* &
-                       (log(zref/(rugos(i))+1.) &
-                       - 2.0 * log(0.5*(1. + xtmp*xtmp)) & 
-                       + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))
-            delq(i)  = (qstar(i)/RKAR)* &
-                       (log(zref/(rugos(i))+1.) &
-                       - 2.0 * log(0.5*(1. + xtmp*xtmp)) & 
-                       + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))
-          ELSE
-            delu(i)  = 0.5 * speed(i)
-            delte(i) = 0.5 * (tair(i) - ts(i) )
-            delq(i)  = 0.5 * (max(qair(i),0.0) - max(qsurf(i),0.0))
-          ENDIF
-        ENDIF
-!
-      ENDDO
-      RETURN
-      END SUBROUTINE screenp
Index: LMDZ.3.3/branches/rel-/libf/phylmd/soil.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/soil.F	(revision 416)
+++ 	(revision )
@@ -1,231 +1,0 @@
-      SUBROUTINE soil(ptimestep, indice, snow, ptsrf, ptsoil,
-     s          pcapcal, pfluxgrd)
-      IMPLICIT NONE
-
-c=======================================================================
-c
-c   Auteur:  Frederic Hourdin     30/01/92
-c   -------
-c
-c   objet:  computation of : the soil temperature evolution
-c   ------                   the surfacic heat capacity "Capcal"
-c                            the surface conduction flux pcapcal
-c
-c
-c   Method: implicit time integration
-c   -------
-c   Consecutive ground temperatures are related by:
-c           T(k+1) = C(k) + D(k)*T(k)  (1)
-c   the coefficients C and D are computed at the t-dt time-step.
-c   Routine structure:
-c   1)new temperatures are computed  using (1)
-c   2)C and D coefficients are computed from the new temperature
-c     profile for the t+dt time-step
-c   3)the coefficients A and B are computed where the diffusive
-c     fluxes at the t+dt time-step is given by
-c            Fdiff = A + B Ts(t+dt)
-c     or     Fdiff = F0 + Capcal (Ts(t+dt)-Ts(t))/dt
-c            with F0 = A + B (Ts(t))
-c                 Capcal = B*dt
-c           
-c   Interface:
-c   ----------
-c
-c   Arguments:
-c   ----------
-c   ptimestep            physical timestep (s)
-c   indice               sub-surface index
-c   snow(klon,nbsrf)     snow
-c   ptsrf(klon)          surface temperature at time-step t (K)
-c   ptsoil(klon,nsoilmx) temperature inside the ground (K)
-c   pcapcal(klon)        surfacic specific heat (W*m-2*s*K-1)
-c   pfluxgrd(klon)       surface diffusive flux from ground (Wm-2)
-c   
-c=======================================================================
-c   declarations:
-c   -------------
-
-#include "dimensions.h"
-#include "dimphy.h"
-#include "dimsoil.h"
-#include "indicesol.h"
-
-c-----------------------------------------------------------------------
-c  arguments
-c  ---------
-
-      REAL ptimestep
-      INTEGER indice
-      REAL ptsrf(klon),ptsoil(klon,nsoilmx),snow(klon)
-      REAL pcapcal(klon),pfluxgrd(klon)
-
-c-----------------------------------------------------------------------
-c  local arrays
-c  ------------
-
-      INTEGER ig,jk
-      REAL zdz2(nsoilmx),z1(klon)
-      REAL min_period,dalph_soil
-      REAL ztherm_i(klon)
-
-c   local saved variables:
-c   ----------------------
-      REAL dz1(nsoilmx),dz2(nsoilmx)
-      REAL zc(klon,nsoilmx),zd(klon,nsoilmx)
-      REAL lambda
-      SAVE dz1,dz2,zc,zd,lambda
-      LOGICAL firstcall
-      SAVE firstcall
-      REAL isol,isno,iice
-      SAVE isol,isno,iice
-
-      DATA firstcall/.true./
-
-      DATA isol,isno,iice/2000.,2000.,2000./
-
-c-----------------------------------------------------------------------
-c   Depthts:
-c   --------
-
-      REAL fz,rk,fz1,rk1,rk2
-      fz(rk)=fz1*(dalph_soil**rk-1.)/(dalph_soil-1.)
-
-c   calcul de l'inertie thermique a partir de la variable rnat.
-c   on initialise a iice meme au-dessus d'un point de mer au cas 
-c   ou le point de mer devienne point de glace au pas suivant
-c   on corrige si on a un point de terre avec ou sans glace
-c
-      IF (indice.EQ.is_sic) THEN
-         DO ig = 1, klon
-            ztherm_i(ig)   = iice
-            IF (snow(ig).GT.0.0) ztherm_i(ig)   = isno
-         ENDDO
-      ELSE IF (indice.EQ.is_lic) THEN
-         DO ig = 1, klon
-            ztherm_i(ig)   = iice
-            IF (snow(ig).GT.0.0) ztherm_i(ig)   = isno
-         ENDDO
-      ELSE IF (indice.EQ.is_ter) THEN
-         DO ig = 1, klon
-            ztherm_i(ig)   = isol
-            IF (snow(ig).GT.0.0) ztherm_i(ig)   = isno
-         ENDDO
-      ELSE IF (indice.EQ.is_oce) THEN
-         DO ig = 1, klon
-            ztherm_i(ig)   = iice
-         ENDDO
-      ELSE
-         PRINT*, "valeur d indice non prevue", indice
-         CALL abort
-      ENDIF
-
-
-      IF (firstcall) THEN
-
-c-----------------------------------------------------------------------
-c   ground levels 
-c   grnd=z/l where l is the skin depth of the diurnal cycle:
-c   --------------------------------------------------------
-
-         min_period=1800. ! en secondes
-         dalph_soil=2.    ! rapport entre les epaisseurs de 2 couches succ.
-
-         OPEN(99,file='soil.def',status='old',form='formatted',err=9999)
-         READ(99,*) min_period
-         READ(99,*) dalph_soil
-         PRINT*,'Discretization for the soil model'
-         PRINT*,'First level e-folding depth',min_period,
-     s   '   dalph',dalph_soil
-         CLOSE(99)
-9999     CONTINUE
-
-c   la premiere couche represente un dixieme de cycle diurne
-         fz1=sqrt(min_period/3.14)
-
-         DO jk=1,nsoilmx
-            rk1=jk
-            rk2=jk-1
-            dz2(jk)=fz(rk1)-fz(rk2)
-         ENDDO
-         DO jk=1,nsoilmx-1
-            rk1=jk+.5
-            rk2=jk-.5
-            dz1(jk)=1./(fz(rk1)-fz(rk2))
-         ENDDO
-         lambda=fz(.5)*dz1(1)
-         PRINT*,'full layers, intermediate layers (seconds)'
-         DO jk=1,nsoilmx
-            rk=jk
-            rk1=jk+.5
-            rk2=jk-.5
-            PRINT *,'fz=',
-     .               fz(rk1)*fz(rk2)*3.14,fz(rk)*fz(rk)*3.14
-         ENDDO
-
-         firstcall =.false.
-
-c   Initialisations:
-c   ----------------
-
-      ELSE   !--not firstcall
-c-----------------------------------------------------------------------
-c   Computation of the soil temperatures using the Cgrd and Dgrd
-c  coefficient computed at the previous time-step:
-c  -----------------------------------------------
-
-c    surface temperature
-         DO ig=1,klon
-            ptsoil(ig,1)=(lambda*zc(ig,1)+ptsrf(ig))/
-     s      (lambda*(1.-zd(ig,1))+1.)
-         ENDDO
-
-c   other temperatures
-         DO jk=1,nsoilmx-1
-            DO ig=1,klon
-               ptsoil(ig,jk+1)=zc(ig,jk)+zd(ig,jk)*ptsoil(ig,jk)
-            ENDDO
-         ENDDO
-
-      ENDIF !--not firstcall
-c-----------------------------------------------------------------------
-c   Computation of the Cgrd and Dgrd coefficient for the next step:
-c   ---------------------------------------------------------------
-
-      DO jk=1,nsoilmx
-         zdz2(jk)=dz2(jk)/ptimestep
-      ENDDO
-
-      DO ig=1,klon
-         z1(ig)=zdz2(nsoilmx)+dz1(nsoilmx-1)
-         zc(ig,nsoilmx-1)=zdz2(nsoilmx)*ptsoil(ig,nsoilmx)/z1(ig)
-         zd(ig,nsoilmx-1)=dz1(nsoilmx-1)/z1(ig)
-      ENDDO
-
-      DO jk=nsoilmx-1,2,-1
-         DO ig=1,klon
-            z1(ig)=1./(zdz2(jk)+dz1(jk-1)+dz1(jk)*(1.-zd(ig,jk)))
-            zc(ig,jk-1)=
-     s      (ptsoil(ig,jk)*zdz2(jk)+dz1(jk)*zc(ig,jk))*z1(ig)
-            zd(ig,jk-1)=dz1(jk-1)*z1(ig)
-         ENDDO
-      ENDDO
-
-c-----------------------------------------------------------------------
-c   computation of the surface diffusive flux from ground and
-c   calorific capacity of the ground:
-c   ---------------------------------
-
-      DO ig=1,klon
-         pfluxgrd(ig)=ztherm_i(ig)*dz1(1)*
-     s   (zc(ig,1)+(zd(ig,1)-1.)*ptsoil(ig,1))
-         pcapcal(ig)=ztherm_i(ig)*
-     s   (dz2(1)+ptimestep*(1.-zd(ig,1))*dz1(1))
-         z1(ig)=lambda*(1.-zd(ig,1))+1.
-         pcapcal(ig)=pcapcal(ig)/z1(ig)
-         pfluxgrd(ig)=pfluxgrd(ig)
-     s   +pcapcal(ig)*(ptsoil(ig,1)*z1(ig)-lambda*zc(ig,1)-ptsrf(ig))
-     s   /ptimestep
-      ENDDO
-
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/stdlevvar.F90
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/stdlevvar.F90	(revision 416)
+++ 	(revision )
@@ -1,239 +1,0 @@
-      SUBROUTINE stdlevvar(klon, knon, nsrf, zxli, &
-                           u1, v1, t1, q1, z1, &
-                           ts1, qsurf, rugos, psol, pat1, &
-                           t_2m, q_2m, u_10m) 
-      USE coefcdrag_int
-      USE screenpc_int
-      IMPLICIT NONE
-!-------------------------------------------------------------------------
-!
-! Objet : calcul de la temperature et l'humidite relative a 2m et du 
-!         module du vent a 10m a partir des relations de Dyer-Businger et
-!         des equations de Louis.
-!
-! Reference : Hess, Colman et McAvaney (1995)        
-!
-! I. Musat, 01.07.2002
-!-------------------------------------------------------------------------
-!
-! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
-! knon----input-I- nombre de points pour un type de surface
-! nsrf----input-I- indice pour le type de surface; voir indicesol.inc
-! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
-! u1------input-R- vent zonal au 1er niveau du modele
-! v1------input-R- vent meridien au 1er niveau du modele
-! t1------input-R- temperature de l'air au 1er niveau du modele
-! q1------input-R- humidite relative au 1er niveau du modele
-! z1------input-R- geopotentiel au 1er niveau du modele
-! ts1-----input-R- temperature de l'air a la surface
-! qsurf---input-R- humidite relative a la surface
-! rugos---input-R- rugosite
-! psol----input-R- pression au sol
-! pat1----input-R- pression au 1er niveau du modele
-!
-! t_2m---output-R- temperature de l'air a 2m
-! q_2m---output-R- humidite relative a 2m
-! u_10m--output-R- vitesse du vent a 10m
-!
-      INTEGER, intent(in) :: klon, knon, nsrf
-      LOGICAL, intent(in) :: zxli
-      REAL, dimension(klon), intent(in) :: u1, v1, t1, q1, z1, ts1
-      REAL, dimension(klon), intent(in) :: qsurf, rugos
-      REAL, dimension(klon), intent(in) :: psol, pat1
-!
-      REAL, dimension(klon), intent(out) :: t_2m, q_2m, u_10m
-!-------------------------------------------------------------------------
-#include "YOMCST.inc"
-!IM PLUS
-#include "YOETHF.inc"
-!
-! Quelques constantes et options:
-!
-! RKAR : constante de von Karman
-      REAL, PARAMETER :: RKAR=0.40
-! niter : nombre iterations calcul "corrector"
-      INTEGER, parameter :: niter=6, ncon=niter-1
-!
-! Variables locales
-      INTEGER :: i, n
-      REAL :: zref
-      REAL, dimension(klon) :: speed
-! tpot : temperature potentielle
-      REAL, dimension(klon) :: tpot
-      REAL, dimension(klon) :: zri1, cdran
-      REAL, dimension(klon) :: cdram, cdrah
-! ri1 : nb. de Richardson entre la surface --> la 1ere couche
-      REAL, dimension(klon) :: ri1 
-      REAL, dimension(klon) :: ustar, testar, qstar
-      REAL, dimension(klon) :: zdte, zdq   
-! lmon : longueur de Monin-Obukhov selon Hess, Colman and McAvaney 
-      DOUBLE PRECISION, dimension(klon) :: lmon
-      DOUBLE PRECISION, parameter :: eps=1.0D-20
-      REAL, dimension(klon) :: delu, delte, delq
-      REAL, dimension(klon) :: u_zref, te_zref, q_zref  
-      REAL, dimension(klon) :: temp, pref
-      LOGICAL :: okri
-      REAL, dimension(klon) :: u_zref_p, te_zref_p, temp_p, q_zref_p
-      REAL, dimension(klon) :: u_zref_c, te_zref_c, temp_c, q_zref_c
-      REAL, dimension(klon) :: ok_pred, ok_corr
-      REAL, dimension(klon) :: conv_te, conv_q
-!------------------------------------------------------------------------- 
-      DO i=1, knon
-       speed(i)=SQRT(u1(i)**2+v1(i)**2)
-       ri1(i) = 0.0
-      ENDDO
-!
-      okri=.FALSE.
-      CALL coefcdrag(klon, knon, nsrf, zxli, &
-                     speed, t1, q1, z1, psol, &
-                     ts1, qsurf, rugos, okri, ri1,  &         
-                     cdram, cdrah, cdran, zri1, pref)            
-!
-!---------Star variables----------------------------------------------------
-!
-      DO i = 1, knon
-        ri1(i) = zri1(i)
-        tpot(i) = t1(i)* (psol(i)/pat1(i))**RKAPPA
-        ustar(i) = sqrt(cdram(i) * speed(i) * speed(i))
-        zdte(i) = tpot(i) - ts1(i)
-        zdq(i) = max(q1(i),0.0) - max(qsurf(i),0.0)
-!
-        testar(i) = (cdrah(i) * zdte(i) * speed(i))/ustar(i)
-        qstar(i) = (cdrah(i) * zdq(i) * speed(i))/ustar(i)
-        lmon(i) = (ustar(i) * ustar(i) * tpot(i))/ &
-                  (RKAR * RG * testar(i))
-      ENDDO
-!
-!----------First aproximation of variables at zref --------------------------
-      zref = 2.0
-      CALL screenp(klon, knon, nsrf, speed, tpot, q1, &
-                   ts1, qsurf, rugos, lmon, &
-                   ustar, testar, qstar, zref, &
-                   delu, delte, delq)
-!
-      DO i = 1, knon
-        u_zref(i) = delu(i)
-        q_zref(i) = max(qsurf(i),0.0) + delq(i)
-        te_zref(i) = ts1(i) + delte(i)
-        temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
-!       q_zref_p(i) = q_zref(i)
-!       te_zref_p(i) = te_zref(i)
-        temp_p(i) = temp(i)
-      ENDDO
-!
-! Iteration of the variables at the reference level zref : corrector calculation ; see Hess & McAvaney, 1995 
-!
-      DO n = 1, niter
-!
-        okri=.TRUE.
-        CALL screenc(klon, knon, nsrf, zxli, &
-                     u_zref, temp, q_zref, zref, &
-                     ts1, qsurf, rugos, psol, &           
-                     ustar, testar, qstar, okri, ri1, &
-                     pref, delu, delte, delq) 
-!
-        DO i = 1, knon
-          u_zref(i) = delu(i)
-          q_zref(i) = delq(i) + max(qsurf(i),0.0)
-          te_zref(i) = delte(i) + ts1(i) 
-!
-! return to normal temperature
-!
-          temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
-!         temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
-!                 (1 + RVTMP2 * max(q_zref(i),0.0))
-!
-          IF(temp(i).GT.350.) THEN
-            WRITE(*,*) 'temp(i) GT 350 K !!',i,nsrf,temp(i)
-          ENDIF
-!
-        IF(n.EQ.ncon) THEN
-          te_zref_p(i) = te_zref(i)
-          q_zref_p(i) = q_zref(i)
-        ENDIF 
-!
-        ENDDO 
-!
-      ENDDO 
-!
-! verifier le critere de convergence : 0.25% pour te_zref et 5% pour qe_zref
-!
-        DO i = 1, knon
-          conv_te(i) = (te_zref(i) - te_zref_p(i))/te_zref_p(i)
-          conv_q(i) = (q_zref(i) - q_zref_p(i))/q_zref_p(i)
-          IF(abs(conv_te(i)).GE.0.0025.AND.abs(conv_q(i)).GE.0.05) THEN
-            PRINT*,'DIV','i=',i,te_zref_p(i),te_zref(i),conv_te(i), &
-            q_zref_p(i),q_zref(i),conv_q(i)
-          ENDIF
-        ENDDO
-!
-      DO i = 1, knon
-        q_zref_c(i) = q_zref(i)
-        temp_c(i) = temp(i)
-!
-        IF(zri1(i).LT.0.) THEN
-          IF(nsrf.EQ.1) THEN
-            ok_pred(i)=1.
-            ok_corr(i)=0.
-          ELSE
-            ok_pred(i)=0.
-            ok_corr(i)=1.
-          ENDIF
-        ELSE
-          ok_pred(i)=0.
-          ok_corr(i)=1.
-        ENDIF
-!
-        t_2m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
-        q_2m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
-      ENDDO
-!
-!
-!----------First aproximation of variables at zref --------------------------
-!
-      zref = 10.0
-      CALL screenp(klon, knon, nsrf, speed, tpot, q1, &
-                   ts1, qsurf, rugos, lmon, &
-                   ustar, testar, qstar, zref, &
-                   delu, delte, delq)
-!
-      DO i = 1, knon
-        u_zref(i) = delu(i)
-        q_zref(i) = max(qsurf(i),0.0) + delq(i)
-        te_zref(i) = ts1(i) + delte(i)
-        temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
-!       temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
-!                 (1 + RVTMP2 * max(q_zref(i),0.0))
-        u_zref_p(i) = u_zref(i)
-      ENDDO
-!
-! Iteration of the variables at the reference level zref : corrector ; see Hess & McAvaney, 1995 
-!
-      DO n = 1, niter
-!
-        okri=.TRUE.
-        CALL screenc(klon, knon, nsrf, zxli, &
-                     u_zref, temp, q_zref, zref, &
-                     ts1, qsurf, rugos, psol, &
-                     ustar, testar, qstar, okri, ri1, &
-                     pref, delu, delte, delq)
-!
-        DO i = 1, knon
-          u_zref(i) = delu(i)
-          q_zref(i) = delq(i) + max(qsurf(i),0.0)
-          te_zref(i) = delte(i) + ts1(i)
-          temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
-!         temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
-!                   (1 + RVTMP2 * max(q_zref(i),0.0))
-        ENDDO 
-!
-      ENDDO
-!
-      DO i = 1, knon
-        u_zref_c(i) = u_zref(i)
-!
-        u_10m(i) = u_zref_p(i) * ok_pred(i) + u_zref_c(i) * ok_corr(i)
-      ENDDO
-! 
-      RETURN
-      END subroutine stdlevvar
Index: LMDZ.3.3/branches/rel-/libf/phylmd/suphec.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/suphec.F	(revision 416)
+++ 	(revision )
@@ -1,187 +1,0 @@
-      SUBROUTINE suphec
-C
-#include "YOMCST.h"
-#include "YOETHF.h"
-C      -----------------------------------------------------------------
-C
-C*       1.    DEFINE FUNDAMENTAL CONSTANTS.
-C              -----------------------------
-C
-      WRITE(UNIT=6,FMT='(''0*** Constants of the ICM   ***'')')
-      RPI=2.*ASIN(1.)
-      RCLUM=299792458.
-      RHPLA=6.6260755E-34
-      RKBOL=1.380658E-23
-      RNAVO=6.0221367E+23
-      WRITE(UNIT=6,FMT='('' *** Fundamental constants ***'')')
-      WRITE(UNIT=6,FMT='(''           PI = '',E13.7,'' -'')')RPI
-      WRITE(UNIT=6,FMT='(''            c = '',E13.7,''m s-1'')')
-     S RCLUM
-      WRITE(UNIT=6,FMT='(''            h = '',E13.7,''J s'')')
-     S RHPLA
-      WRITE(UNIT=6,FMT='(''            K = '',E13.7,''J K-1'')')
-     S RKBOL
-      WRITE(UNIT=6,FMT='(''            N = '',E13.7,''mol-1'')')
-     S RNAVO
-C
-C     ----------------------------------------------------------------
-C
-C*       2.    DEFINE ASTRONOMICAL CONSTANTS.
-C              ------------------------------
-C
-      RDAY=86400.
-      REA=149597870000.
-      REPSM=0.409093
-C
-      RSIYEA=365.25*RDAY*2.*RPI/6.283076
-      RSIDAY=RDAY/(1.+RDAY/RSIYEA)
-      ROMEGA=2.*RPI/RSIDAY
-c
-c exp1      R_ecc = 0.05
-c exp1      R_peri = 102.04
-c exp1      R_incl = 22.5
-c exp1      print*, 'Parametres orbitaux modifies'
-c ref      R_ecc = 0.016724
-c ref      R_peri = 102.04
-c ref      R_incl = 23.5
-      R_ecc = 0.016724
-      R_peri = 102.04
-      R_incl = 23.5
-c
-      WRITE(UNIT=6,FMT='('' *** Astronomical constants ***'')')
-      WRITE(UNIT=6,FMT='(''          day = '',E13.7,'' s'')')RDAY
-      WRITE(UNIT=6,FMT='('' half g. axis = '',E13.7,'' m'')')REA
-      WRITE(UNIT=6,FMT='('' mean anomaly = '',E13.7,'' -'')')REPSM
-      WRITE(UNIT=6,FMT='('' sideral year = '',E13.7,'' s'')')RSIYEA
-      WRITE(UNIT=6,FMT='(''  sideral day = '',E13.7,'' s'')')RSIDAY
-      WRITE(UNIT=6,FMT='(''        omega = '',E13.7,'' s-1'')')
-     S                  ROMEGA
-      write(unit=6,fmt='('' excentricite = '',e13.7,''-'')')R_ecc
-      write(unit=6,fmt='(''     equinoxe = '',e13.7,''-'')')R_peri
-      write(unit=6,fmt='(''  inclinaison = '',e13.7,''-'')')R_incl
-C
-C     ------------------------------------------------------------------
-C
-C*       3.    DEFINE GEOIDE.
-C              --------------
-C
-      RG=9.80665
-      RA=6371229.
-      R1SA=SNGL(1.D0/DBLE(RA))
-      WRITE(UNIT=6,FMT='('' ***         Geoide         ***'')')
-      WRITE(UNIT=6,FMT='(''      Gravity = '',E13.7,'' m s-2'')')
-     S      RG
-      WRITE(UNIT=6,FMT='('' Earth radius = '',E13.7,'' m'')')RA
-      WRITE(UNIT=6,FMT='('' Inverse E.R. = '',E13.7,'' m'')')R1SA
-C
-C     -----------------------------------------------------------------
-C
-C*       4.    DEFINE RADIATION CONSTANTS.
-C              ---------------------------
-C
-c z.x.li      RSIGMA=2. * RPI**5 * RKBOL**4 /(15.* RCLUM**2 * RHPLA**3)
-      rsigma = 2.*rpi**5 * (rkbol/rhpla)**3 * rkbol/rclum/rclum/15.
-      RI0=1370.
-      WRITE(UNIT=6,FMT='('' ***        Radiation       ***'')')
-      WRITE(UNIT=6,FMT='('' Stefan-Bol.  = '',E13.7,'' W m-2 K-4''
-     S )')  RSIGMA
-      WRITE(UNIT=6,FMT='('' Solar const. = '',E13.7,'' W m-2'')')
-     S      RI0
-C
-C     -----------------------------------------------------------------
-C
-C*       5.    DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.
-C              ------------------------------------------
-C
-      R=RNAVO*RKBOL
-      RMD=28.9644
-      RMV=18.0153
-      RD=1000.*R/RMD
-      RV=1000.*R/RMV
-      RCPD=3.5*RD
-      RCVD=RCPD-RD
-      RCPV=4. *RV
-      RCVV=RCPV-RV
-      RKAPPA=RD/RCPD
-      RETV=RV/RD-1.
-      WRITE(UNIT=6,FMT='('' *** Thermodynamic, gas     ***'')')
-      WRITE(UNIT=6,FMT='('' Perfect gas  = '',e13.7)') R
-      WRITE(UNIT=6,FMT='('' Dry air mass = '',e13.7)') RMD
-      WRITE(UNIT=6,FMT='('' Vapour  mass = '',e13.7)') RMV
-      WRITE(UNIT=6,FMT='('' Dry air cst. = '',e13.7)') RD
-      WRITE(UNIT=6,FMT='('' Vapour  cst. = '',e13.7)') RV
-      WRITE(UNIT=6,FMT='(''         Cpd  = '',e13.7)') RCPD
-      WRITE(UNIT=6,FMT='(''         Cvd  = '',e13.7)') RCVD
-      WRITE(UNIT=6,FMT='(''         Cpv  = '',e13.7)') RCPV
-      WRITE(UNIT=6,FMT='(''         Cvv  = '',e13.7)') RCVV
-      WRITE(UNIT=6,FMT='(''      Rd/Cpd  = '',e13.7)') RKAPPA
-      WRITE(UNIT=6,FMT='(''     Rv/Rd-1  = '',e13.7)') RETV
-C
-C     ----------------------------------------------------------------
-C
-C*       6.    DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE.
-C              ---------------------------------------------
-C
-      RCW=4218.
-      WRITE(UNIT=6,FMT='('' *** Thermodynamic, liquid  ***'')')
-      WRITE(UNIT=6,FMT='(''         Cw   = '',E13.7)') RCW
-C
-C     ----------------------------------------------------------------
-C
-C*       7.    DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE.
-C              --------------------------------------------
-C
-      RCS=2106.
-      WRITE(UNIT=6,FMT='('' *** thermodynamic, solid   ***'')')
-      WRITE(UNIT=6,FMT='(''         Cs   = '',E13.7)') RCS
-C
-C     ----------------------------------------------------------------
-C
-C*       8.    DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE.
-C              ----------------------------------------------------
-C
-      RTT=273.16
-      RLVTT=2.5008E+6
-      RLSTT=2.8345E+6
-      RLMLT=RLSTT-RLVTT
-      RATM=100000.
-      WRITE(UNIT=6,FMT='('' *** Thermodynamic, trans.  ***'')')
-      WRITE(UNIT=6,FMT='('' Fusion point  = '',E13.7)') RTT
-      WRITE(UNIT=6,FMT='(''        RLvTt  = '',E13.7)') RLVTT
-      WRITE(UNIT=6,FMT='(''        RLsTt  = '',E13.7)') RLSTT
-      WRITE(UNIT=6,FMT='(''        RLMlt  = '',E13.7)') RLMLT
-      WRITE(UNIT=6,FMT='('' Normal press. = '',E13.7)') RATM
-      WRITE(UNIT=6,FMT='('' Latent heat :  '')')
-C
-C     ----------------------------------------------------------------
-C
-C*       9.    SATURATED VAPOUR PRESSURE.
-C              --------------------------
-C
-      RESTT=611.14
-      RGAMW=(RCW-RCPV)/RV
-      RBETW=RLVTT/RV+RGAMW*RTT
-      RALPW=LOG(RESTT)+RBETW/RTT+RGAMW*LOG(RTT)
-      RGAMS=(RCS-RCPV)/RV
-      RBETS=RLSTT/RV+RGAMS*RTT
-      RALPS=LOG(RESTT)+RBETS/RTT+RGAMS*LOG(RTT)
-      RGAMD=RGAMS-RGAMW
-      RBETD=RBETS-RBETW
-      RALPD=RALPS-RALPW
-C
-C     ------------------------------------------------------------------
-c
-c calculer les constantes pour les fonctions thermodynamiques
-c
-      RVTMP2=RCPV/RCPD-1.
-      RHOH2O=RATM/100.
-      R2ES=RESTT*RD/RV
-      R3LES=17.269
-      R3IES=21.875
-      R4LES=35.86
-      R4IES=7.66
-      R5LES=R3LES*(RTT-R4LES)
-      R5IES=R3IES*(RTT-R4IES)
-C
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/testphys1d.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/testphys1d.F	(revision 416)
+++ 	(revision )
@@ -1,673 +1,0 @@
-      PROGRAM gcm1d
-      IMPLICIT NONE
-
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-#include "comg1d.h"
-#include "clesphys.h"
-#include "control.h"
-
-c    Arguments :
-c    -----------
-
-      integer ngrid,nlayer,longcles,nqmax
-      parameter (longcles=20,nqmax=3)
-cfleur on  ne se sert pas de nqmax mais de nqmx defini dnas dimensions.h depend de la 
-c      compilation
-      integer radpas
-      integer nday,it,iflag_con,unit,i,itap,n_cooling
-      integer iphys_ver,iadv_tvl,i_cvg,i_hum
-
-      real fnday
-      real h,kappa,z1,z2,sbid,sigbid
-      real plev(klev+1),play(klev), psol
-      real temp(klev),u(klev),v(klev),tsurf,q(klev,nqmx),w(klev+1)
-      real ug(klev),vg(klev)
-      real du(klev),dv(klev),dt(klev),dpsrf,dq(klev,nqmx)
-      real du_dyn(klev),dv_dyn(klev)
-     :    ,dt_dyn(klev),dq_dyn(klev,nqmax)
-      real phis,presnivs(klev),clesphy0(longcles)
-      real time,timestep,ecritphy,day,tho
-      real co2_ppm,solaire
-      real rlat,rlon,tsol,radsol,psol_f,tsol_f,qsol_f,qsol
-      real rugmer,rugsrel,snow,agesno,deltat,zmea,zstd,zsig,sn
-      real zgam,zthe,zpic,zval
-      real ema_sig(klev),ema_w(klev),ncst_cbmf,ema_cbmfz,ema_pcb
-     : ,zz_f(klev),vu_f(klev),vv_f(klev),t_f(klev),q_f(klev,nqmax)
-
-      real temp0(klev),q0(klev,3)
-
-      real dt_cooling(klev),dq_cooling(klev)
-      real d_t_cool(klev),d_q_cool(klev)
-      real d_t_adv(klev),d_q_adv(klev,nqmax)
-      real d_t_cvg(klev),d_q_cvg(klev)
-      real ht(100),hq(100),hw(100)
-
-      real phy_nat(360)
-      real phy_alb(360)
-      real phy_sst(360)
-      real phy_bil(360)
-      real phy_rug(360)
-      real phy_ice(360)
-
-      logical cycle_diurne,soil_model,new_oliq,ok_orodr
-     :       ,ok_orolf,ok_limitvrai
-
-      logical firstcall,lastcall,flag_cool
-      logical itsourcecont
-c      itsourcecont permet de choisir entre les sources pour plus de 5 traceurs
-      character*80 ans,file_forctl, file_fordat, file_start,file
-      character*2 cnbl
-
-c-----------------------------------------------------------------------
-
-      COMMON/comvert/
-     * s(llm),sig(llm+1),ds(llm),dsig(llm),dsig1(llm),sdsig(llm)
-     . ,sig_s(llm)
-
-      REAL s,sig,ds,dsig,dsig1,sdsig,sig_s
-
-c-----------------------------------------------------------------------
-c INCLUDE 'temps.h':
-
-      COMMON/temps/itaufin,dtd,
-     s  day_ini,day_end,anne_ini
-
-      INTEGER  itaufin
-      INTEGER*4 day_ini,day_end,anne_ini
-      REAL     dtd
-
-c-----------------------------------------------------------------------
-c   dynamical tendencies
-
-      INTEGER l,ierr,aslun,nlevel,iq,ll
-
-      REAL longitude,latitude
-      REAL zlay(klev),phi(klev)
-      REAL paire 
-
-      DATA latitude,longitude/0.,0./
-
-c-----------------------------------------------------------------------
-c    Initialisations  des constantes
-c    -------------------------------
-
-c constantes
-c ----------
-
-      time=0.
-      tho=3600. 
-      it=0
-
-      call suphec
-
-c parametres lus dans execution_1D:
-c ---------------------------------
-
-      read(*,*) fnday
-      print*, 'fnday',fnday
-      read(*,*) ecritphy
-      print*, 'ecritphy',ecritphy
-      read(*,*) timestep
-      print*, 'timestep',timestep
-      read(*,*) iflag_con 
-      print*, 'iflag_con',iflag_con
-      read(*,*) flag_cool 
-      print*, 'flag_cool',flag_cool
-      read(*,'(a)') cnbl
-      print*, 'cnbl',cnbl
-      read(*,*) radpas   
-      print*, 'radpas',radpas
-      read(*,*) anne_ini ! sans importance mais il faut qqchose
-      print*, 'anne_ini',anne_ini
-      
-c si ecritphy=0: on ecrit la physique a chaque pas de temps:
-
-      if (ecritphy.eq.0.) then
-       ecritphy = timestep/rday
-      endif
-      write(*,*) 'ECRITPHY = ',ecritphy
-
-      firstcall=.true.
-      lastcall=.false.
-      day=1.
-      itsourcecont=.true.
-
-      open(78,file='transil.dat',form='unformatted',
-     s    access='direct',recl=4*llm*llm)
-
-      ngrid=1
-      IF (ngrid.NE.klon) THEN
-         PRINT*,'STOP in inifis'
-         PRINT*,'Probleme de dimenesions :'
-         PRINT*,'ngrid     = ',ngrid
-         PRINT*,'klon   = ',klon
-         STOP
-      ENDIF
-      nlayer=klev
-      nlevel=nlayer+1
-
-c   -------------------------------------------------------------------
-c   Initialisation de la discretisation verticale
-c   ---------------------------------------------
-c sb      CALL disvert(llm,rkappa,sig,dsig,s,ds,dsig1,sdsig)
-
-c   -------------------------------------------------------------------
-c   Profils initiaux.
-c   -----------------
-
-      unit = 80
-      open(unit,file='start'//cnbl//'.data',form='formatted')
-      read(unit,*) 
-      read(unit,*) 
-      read(unit,*) (play(l),l=1,nlayer)
-      read(unit,*) (plev(l),l=1,nlevel)
-      read(unit,*) (temp(l),l=1,nlayer)
-      read(unit,*) (q(l,1),l=1,nlayer)
-      read(unit,*) (q(l,2),l=1,nlayer)
-      read(unit,*) (ema_sig(l),l=1,nlayer)
-      read(unit,*) (ema_w(l),l=1,nlayer) ! reinitialise + loin???
-      read(unit,*) ncst_cbmf, ema_cbmfz, ema_pcb
-      read(unit,*) (zz_f(l),l=1,nlayer)
-      read(unit,*) (vu_f(l),l=1,nlayer)
-      read(unit,*) (vv_f(l),l=1,nlayer)
-      close(unit)
-      write(*,*) 'Lecture fichier start.data ok'
-
-      DO l = 1, nlayer
-         u(l) = vu_f(l)
-         v(l) = vv_f(l)
-c##################
-cfleur ATTENTION q(3) ce nest plus la glace mais le radon si on active phytrac
-c##################3
-         q(l,3) = 0. ! on initialise la glace a zero
-         PRINT*,plev(l),play(l)
-c on recopie le profil initial dans les champs de forcing:
-         t_f(l) = temp(l)
-         q_f(l,1) = q(l,1)
-         q_f(l,2) = q(l,2)
-         q_f(l,3) = q(l,3)
-      ENDDO
-
-
-c Lecture/creation des conditions aux limites:
-c --------------------------------------------
-
-      unit = 81
-      open(unit,file='startphy.data',form='formatted')
-      read(unit,*)
-      read(unit,*) co2_ppm
-      read(unit,*) solaire
-      read(unit,*) rlat
-      read(unit,*) tsol
-      read(unit,*) radsol
-      close(unit)
-      write(*,*) 'Lecture fichier startphy.data ok'
-
-      unit = 82
-      open(unit,file='condsurf.data',form='formatted')
-      read(unit,*) psol_f
-      read(unit,*) tsol_f
-      read(unit,*) qsol_f
-      close(unit)
-      write(*,*) 'Lecture fichier condsurf.data ok'
-
-      if (play(1).lt.10000.) then
-        do l = 1, nlayer
-         play(l) = play(l)*100.
-        enddo
-      endif
-      if (plev(1).lt.10000.) then
-        do l = 1, nlevel
-         plev(l) = plev(l)*100.
-        enddo
-      endif
-
-      if (abs(psol_f-plev(1)) .gt. 1.) then
-         print *,' Incompatibilite entre psol et profil'
-     :   ,' de pression'
-         print *,' psol = ',psol_f,' plev(1) = ',plev(1)
-         stop
-      endif
-
-      tsol    = tsol_f ! temp au sol prise dans condsurf.data
-      psol    = psol_f ! pression au sol prise dans condsurf.data
-      qsol    = qsol_f
-      rugmer  = 0.0001 ! valeur de cchlim.data
-      rugsrel = 0.0    ! (rugsrel = rugoro)
-      snow    = 0.0
-      sn=0.
-      agesno  = 50.0
-      rlon    = 0.0
-      deltat  = 0.0    ! ne sert que pour les slab_ocean
-      phis = 0.
-      zmea = 0.
-      zstd = 0.
-      zsig = 0.
-      zgam = 0.
-      zthe = 0.
-      zpic = 0.
-      zval = 0.
-
-      do i=1,360
-      phy_sst(i) = tsol
-      phy_nat(i) = 0.0  ! 0=ocean libre, 1=land, 2=glacier, 3=banquise
-      phy_alb(i) = 0.15 ! albedo land only (old value condsurf_jyg=0.3)
-      phy_bil(i) = 1.0  ! ne sert que pour les slab_ocean
-      phy_rug(i) = 0.1  ! longueur rugosite utilisee sur land only 
-      phy_ice(i) = 0.0  ! fraction de glace (?)
-      enddo
-
-      call writelim
-     s   (phy_nat,phy_alb,phy_sst,phy_bil,phy_rug,phy_ice)
-
-
-
-c controles du run (en 3D: lus dans run.def) :
-
-      cycle_diurne = .FALSE.
-      soil_model   = .FALSE.
-      new_oliq     = .FALSE.
-      ok_orodr     = .FALSE.
-      ok_orolf     = .FALSE.
-      ok_limitvrai = .FALSE.
-
-      do i = 1, longcles
-       clesphy0(i) = 0.
-      enddo
-
-      nbapp_rad = NINT(86400./radpas/timestep)
-
-      clesphy0(1) = FLOAT( iflag_con )
-      clesphy0(2) = FLOAT( nbapp_rad )
-      if (cycle_diurne ) clesphy0(3) = 1.
-      if (  soil_model ) clesphy0(4) = 1.
-      if (    new_oliq ) clesphy0(5) = 1.
-      if (    ok_orodr ) clesphy0(6) = 1.
-      if (    ok_orolf ) clesphy0(7) = 1.
-      if ( ok_limitvrai) clesphy0(8) = 1.
-
-
-c -------------------------------------------------------------------
-c Discretisation verticale:
-c -------------------------
-
-c calcul sig,dsig,s,ds,dsig1,sdsig a partir des play, plev lus:
-
-      do l = 1, nlevel
-       sig(l)= plev(l)/plev(1)
-      enddo
-
-      do l = 1, nlayer
-       s(l)= sig(l)**RKAPPA
-      enddo
-
-      do l = 2, nlayer
-       ds(l) = s(l-1) - s(l)
-      enddo
-      ds(1)  = 1. - s(1)
-
-      do l = 1, nlayer
-       dsig(l)  = sig(l)-sig(l+1)
-       sdsig(l) = s(l) * dsig(l)
-       dsig1(l) = 1./dsig(l)
-       presnivs(l) = play(l)/100./100.
-      enddo
-
-      print*,'Diagnostique de la discretisation verticale'
-
-      print*
-      h=7.
-      kappa = RKAPPA
-      print*,'comparaison de sig(l) et (s(l)+s(l+1))/2)**(1/K)'
-      do 14 l=1,llm-1
-         sigbid=(0.5*(s(l)+s(l+1)))**(1./kappa)
-         print*,'sig(',l+1,')  = ',sig(l+1),
-     :           '    valeur approchee :',sigbid,'   ',dsig(l)
-14    continue
-      print*
-      print*,'comparaison de s(l) et (sig(l)+sig(l+1))/2)**K'
-      do 15 l=1,llm
-         sbid=(0.5*(sig(l+1)+sig(l)))**kappa
-         print*,'  s(',l,')  = ',s(l),
-     :           '    valeur approchee :',sbid
-15    continue
-
-      print*,'Altitude approchee z,dz'
-      print*
-      z1=0.
-      print*,'   l       Z      DZ      Ztop   dsig'
-      DO 18 l=1,llm-1
-         z2=-h*log(sig(l+1))
-         write(*,'(i5,3x,4f8.4)') l,-h*log(s(l))/kappa,z2-z1,z2
-     :    ,dsig(l)
-         write(14,'(3x,i5,1f10.4)') l,-h*log(s(l))/kappa
-         z1=z2
-18    CONTINUE
-      write(*,'(i5,3x,3f8.4)') l,-h*log(s(llm))/kappa
-      write(14,'(3x,i5,1f10.4)') l,-h*log(s(llm))/kappa
-
-c      print*,'Correspondance approx pression-altitude:'
-c      z1 = 0.
-c      do l = 1, llm
-c       z1 = z1 + 287.*temp(l)/9.81/play(l)*(plev(l)-plev(l+1))
-c       write(*,*) l,play(l),z1
-c      enddo
-
-c -------------------------------------------------------------------
-c Ecriture de l'etat initial:
-c ---------------------------
-
-c     call ini_fis(timestep,radpas,iflag_con,anne_ini
-c    :            ,co2_ppm,solaire,rlat,rlon,tsol,deltat
-c    :            ,qsol,snow,radsol,rugmer,agesno,zmea,zstd,zsig,zgam
-c    :            ,zthe,zpic,zval,rugsrel
-c    :            ,phy_sst,phy_nat,phy_alb,phy_bil,phy_rug,phy_ice)
-
-      call physdem(rlon, rlat, timestep,radpas,co2_ppm,
-     .                   solaire,tsol, qsol,
-     .                   sn, radsol, deltat, rugmer,
-     .                   agesno, zmea, zstd, zsig,
-     .                   zgam, zthe, zpic, zval,
-     .                   rugsrel)
-
-
-
-c -------------------------------------------------------------------
-c Options de la simulation:
-c -------------------------
-
-      unit = 83
-      open(unit,file='version.data',form='formatted')
-      read(unit,*) iphys_ver,iadv_tvl,i_cvg,i_hum
-      close(unit)
-      write(*,*) 'Lecture fichier version.data ok'
-
-      write(*,*) 'physiq # ',iphys_ver,' (0=std; 1=forced glob cis;
-     : 2=forced loc cis)'
-      write(*,*) 'advection switch : ',iadv_tvl,' (0=no adv ;
-     : 1=forced adv)'
-      write(*,*) 'convergence switch : ',i_cvg,' (0=no conv;
-     : 1=forced conv)'
-
-
-
-c Eventuellement, preparation de la "bulle froide":
-c -------------------------------------------------
-
-      IF (flag_cool) THEN
-      unit = 84
-      open(unit,file='cool_buble.data',form='formatted')
-      read(unit,*) n_cooling
-      do l = 1, nlayer
-      read(unit,*) dt_cooling(l),dq_cooling(l)
-      enddo
-      close(unit)
-      write(*,*) 'Lecture fichier cool_buble.data ok'
-      ENDIF
-
-
-c Eventuellement, preparation du forcage par la convergence:
-c ----------------------------------------------------------
-
-      IF (i_cvg .EQ. 1) THEN
-      file_forctl = 'forcing.ctl'
-      file_fordat = 'forcing.dat'
-      file_start  = 'start'//cnbl//'.data'
-
-      call copie(klev,play,psol,file_forctl)
-      call get_uvd2(itap,file_forctl,file_fordat,file_start
-     :             ,ht,hq,hw)
-      ENDIF
-
-
-c-----------------------------------------------------------------------
-c  initialisation pour GRADS-1D
-c  ----------------------------
-
-      g1d_nlayer=nlayer
-      g1d_nomfich='grads1d.dat'
-      g1d_unitfich=30
-      g1d_nomctl='grads1d.ctl'
-      g1d_unitctl=31
-      g1d_premier=.true.
-
-      file='sort'
-      call inigrads(1,1
-     s  ,0.,1.,-2.,2.,1,0.,-2.,2.,1.
-     s  ,llm,presnivs,1000.
-     s  ,1800.,file,'Diagconvect')
-      print*,'Fin de Initialisation de wrgras'
-
-
-c=======================================================================
-c   DEBUT DE L'INTEGRATION TEMPORELLE:
-c   ==================================
-
-      itap = 1
-
-1     continue
-
-c  calcul du geopotentiel:
-c  -----------------------
-
-      phi(1)=RD*temp(1)*
-     :(plev(1)-play(1))/(.5*(plev(1)+play(1)))
-      do l = 1, nlayer-1
-         phi(l+1)=phi(l)+RD*(temp(l)+temp(l+1))*
-     :   (play(l)-play(l+1))/(play(l)+play(l+1))
-      enddo
-
-c        PRINT*,'altitude km  et T (K)'
-c        WRITE(6,'(2f10.2)') (.001*phi(l)/g,temp(l),l=1,nlayer)
-
-
-c pour etre coherent avec LMDZ.3, on passe 2 arguments 
-c en plus a physiq: phis et aire (pas utilises en 1D):
-      paire = 1. ! aire de la maille
-
-
-c  eventuellement, induction de la convection par chauffage du
-c  bas et refroidissement du haut de la couche limite:
-c  ------------------------------------------------------------
-
-      IF (flag_cool) THEN
-
-      call cool_pool(itap
-     e           ,n_cooling,dt_cooling,dq_cooling
-     s           ,d_t_cool,d_q_cool)
-
-      do l = 1, nlayer
-       temp(l) = temp(l) + d_t_cool(l)
-       q(l,1)  = q(l,1)  + d_q_cool(l)
-      enddo
-
-      ELSE
-
-      do l = 1, nlayer 
-       d_t_cool(l) = 0.
-       d_q_cool(l) = 0.
-      enddo
-
-      ENDIF
-
-
-c  eventuellement, ajouter une tendance relative a une
-c  translation du domaine (ex: pour suivre une ligne de grains):
-c  -------------------------------------------------------------
-
-      IF (iadv_tvl .EQ. 1) THEN
-
-      call advect_tvl(timestep,temp,q,vu_f,vv_f,t_f,q_f
-     :               ,d_t_adv,d_q_adv)
-
-      do l = 1, nlayer
-       temp(l) = temp(l) + d_t_adv(l)
-       q(l,1)  = q(l,1)  + d_q_adv(l,1)
-       q(l,2)  = q(l,2)  + d_q_adv(l,2)
-       q(l,3)  = q(l,3)  + d_q_adv(l,3)
-      enddo
-
-      ELSE
-
-      do l = 1, nlayer 
-       d_t_adv(l) = 0.
-       d_q_adv(l,1) = 0.
-       d_q_adv(l,2) = 0.
-       d_q_adv(l,3) = 0.
-      enddo
-
-      ENDIF
-
-
-c  eventuellement, ajouter une tendance relative a la
-c  convergence de grande echelle:
-c  -------------------------------------------------------------
-
-      IF (i_cvg .EQ. 1) THEN
-
-      call get_uvd(itap,timestep,tsol,qsol,file_fordat,ht,hq,hw)
-
-      do l = 1, nlayer
-
-       temp0(l) = temp(l) ! memoire de "l'avant dynamique"
-       q0(l,1) = q(l,1)
-       q0(l,2) = q(l,2)
-       q0(l,3) = q(l,3)
-
-       d_t_cvg(l) = ht(l) * timestep
-       d_q_cvg(l) = hq(l) * timestep
-       temp(l) = temp(l) + d_t_cvg(l)
-       q(l,1)  = q(l,1)  + d_q_cvg(l)
-c       write(*,*)'d_t_cvg,d_q_cvg:',d_t_cvg(l),d_q_cvg(l) 
-       if (q(l,1).lt.0.) then ! sb
-       print*,'OVAP negative dans main!'
-       print*,'itap,l,q,d_q_cvg:',itap,l,q(l,1),d_q_cvg(l),hq(l)
-       q(l,1)  = MAX(q(l,1),1.e-10) ! evite les humidites negatives
-       endif
-      enddo
-
-      if (itap.ge.30) then
-        print*,'hq(l),ht(l),dq,dt,q:'
-     :  ,hq(16),ht(16),d_q_cvg(16),d_t_cvg(16),q(16,1)
-      endif
-
-      ELSE
-
-      do l = 1, nlayer
-       d_t_cvg(l) = 0.
-       d_q_cvg(l) = 0.
-      enddo
-
-      ENDIF
-
-      do l = 1, nlayer
-       dt_dyn(l) = d_t_cvg(l) / timestep
-       dq_dyn(l,1) = d_q_cvg(l) / timestep
-       dq_dyn(l,2) = 0.0
-       dq_dyn(l,3) = 0.0
-      enddo
-
-
-c   calcul des tendances physiques:
-c   -------------------------------
-
-      if (itsourcecont) then
-        do iq=5,nqmx
-          ll=min(iq-4,18)
-          if(firstcall) then 
-c          q(ll,iq)=5/((plev(ll)-plev(ll+1))/rg)
-c           q(ll,iq)=5 
-c          q(ll,iq)=5*play(ll)/((plev(ll)-plev(ll+1))/rg)/(RD*temp(ll))
-            q(ll,iq)=5*play(ll)/(RD*temp(ll))
-          endif
-        print*,'q ll iq',q(ll,iq),ll,iq
-        enddo
-      else
-        do iq=5,nqmx
-          ll=min(iq-4,18)
-          q(ll,iq)=q(ll,iq)+1
-             do l=1,llm
-               q(l,iq)=q(l,iq)*(1-timestep/tho)
-        print*,'q ll iq',q(ll,iq),ll,iq
-             enddo   
-        enddo
- 
-      endif
-
-c      CALL physiq(ecritphy,ngrid,nlayer,nqmx,
-c     :            firstcall,lastcall,
-c     :            day,day,time,timestep,
-c     :            plev,play,phi,phis,paire,
-c     :            u,v,temp,q,
-c     :            du_dyn, dv_dyn,  dt_dyn, dq_dyn,
-c     :            w,
-c     :            du,dv,dt,dq,dpsrf)
-
-c     CALL physiq (ecritphy,ngrid,nlayer,nqmx,firstcall,lastcall,
-c    ,   day,day,time,timestep,plev,play,phi,phis,paire,
-c     ,             presnivs,clesphy0,u,v,temp,q,  
-c pour calculer proprement la tendance de cape liee a la
-c dynamique, il faut entrer aussi temp0 et q0:
-c    ,             presnivs,clesphy0,u,v,temp,q,temp0,q0,  
-c    ,             du_dyn,dv_dyn,dt_dyn,dq_dyn,w,
-c - sorties
-c    s             du,dv,dt,dq,dpsrf)
-
-      print*,'PAS DE TEMPS ',timestep
-      print*,'ATTENTION!!! Il faudra passer temp0 et q0'
-      CALL physiq(ngrid,nlayer,nqmx,
-     :            firstcall,lastcall,
-     :            day,day,time,timestep,
-     :            plev,play,phi,phis,paire,presnivs,clesphy0,
-     :            u,v,temp,q,
-     :            w,
-     :            du,dv,dt,dq,dpsrf)
-
-
-
-
-      firstcall=.false.
-
-
-c   Ajout des tendances
-c   -------------------
-      DO l=1,nlayer
-         u(l)=u(l)+timestep*du(l)
-         v(l)=v(l)+timestep*dv(l)
-
-         temp(l)=temp(l)+timestep*dt(l)
-      ENDDO
-
-      do iq=1,nqmx
-         do l=1,nlayer
-            q(l,iq)=q(l,iq)+timestep*dq(l,iq)
-         enddo
-      enddo
-c      write(78,rec=itap) ((q(l,iq),l=1,llm),iq=5,22)
-      write(78,rec=itap) ((q(l,iq),iq=5,22),l=1,llm)
-      itap = itap + 1
-
-
-         time=time+timestep/rday
-         it=it+1
-         if(mod(it,2000).eq.0) print*,'TIME=',time
-         if(time.gt.fnday) then
-            CALL endg1d(1,nlayer,play,int(time/ecritphy),timestep)
-            stop
-         endif
-
-         GOTO 1
-
-      END
-
-c=======================================================================
-c=======================================================================
-c    FIN DU PROGRAMMES
-c    CI-DESSOUS, QUELQUES SOUS-PROGRAMMES UTILS
-c=======================================================================
-c=======================================================================
-
-#include "1DUTILS.h"
-#include "1Dconv.h"
Index: LMDZ.3.3/branches/rel-/libf/phylmd/tilft43.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/tilft43.F	(revision 416)
+++ 	(revision )
@@ -1,93 +1,0 @@
-c $Header$
-        SUBROUTINE TLIFT43(P,T,Q,QS,GZ,ICB,NK,TVP,TPK,CLW,ND,NL,KK)
-        REAL GZ(ND),TPK(ND),CLW(ND),P(ND)
-        REAL T(ND),Q(ND),QS(ND),TVP(ND),LV0
-C
-C   ***   ASSIGN VALUES OF THERMODYNAMIC CONSTANTS     ***
-C
-c -- sb:
-c!      CPD=1005.7
-c!      CPV=1870.0
-c!      CL=4190.0
-c!      RV=461.5
-c!      RD=287.04
-c!      LV0=2.501E6
-c!      G=9.8
-c!      ROWL=1000.0
-c ajouts:
-#include "YOMCST.h"
-        CPD = RCPD
-        CPV = RCPV
-        CL = RCW
-        LV0 = RLVTT
-        G = RG
-        ROWL= RATM/100.
-        GRAVITY = RG !sb: Pr que gravite ne devienne pas humidite!
-C sb --
-C
-        CPVMCL=CL-CPV
-        EPS=RD/RV
-        EPSI=1./EPS
-C
-C   ***  CALCULATE CERTAIN PARCEL QUANTITIES, INCLUDING STATIC ENERGY   ***
-C
-        AH0=(CPD*(1.-Q(NK))+CL*Q(NK))*T(NK)+Q(NK)*(LV0-CPVMCL*(
-     1   T(NK)-273.15))+GZ(NK)
-        CPP=CPD*(1.-Q(NK))+Q(NK)*CPV
-        CPINV=1./CPP
-C
-        IF(KK.EQ.1)THEN
-C
-C   ***   CALCULATE LIFTED PARCEL QUANTITIES BELOW CLOUD BASE   ***
-C
-        DO 50 I=1,ICB-1
-         CLW(I)=0.0
-   50   CONTINUE
-        DO 100 I=NK,ICB-1
-         TPK(I)=T(NK)-(GZ(I)-GZ(NK))*CPINV
-         TVP(I)=TPK(I)*(1.+Q(NK)*EPSI)
-  100   CONTINUE
-        END IF
-C
-C    ***  FIND LIFTED PARCEL QUANTITIES ABOVE CLOUD BASE    ***
-C
-        NST=ICB
-        NSB=ICB
-        IF(KK.EQ.2)THEN  
-         NST=NL
-         NSB=ICB+1
-        END IF
-        DO 300 I=NSB,NST
-         TG=T(I)
-         QG=QS(I)
-         ALV=LV0-CPVMCL*(T(I)-273.15)
-         DO 200 J=1,2
-          S=CPD+ALV*ALV*QG/(RV*T(I)*T(I))
-          S=1./S
-          AHG=CPD*TG+(CL-CPD)*Q(NK)*T(I)+ALV*QG+GZ(I)
-          TG=TG+S*(AH0-AHG)
-          TG=MAX(TG,35.0)
-          TC=TG-273.15
-          DENOM=243.5+TC
-          IF(TC.GE.0.0)THEN  
-           ES=6.112*EXP(17.67*TC/DENOM)
-          ELSE  
-           ES=EXP(23.33086-6111.72784/TG+0.15215*LOG(TG))
-          END IF  
-          QG=EPS*ES/(P(I)-ES*(1.-EPS))
-  200    CONTINUE
-         ALV=LV0-CPVMCL*(T(I)-273.15)
-         TPK(I)=(AH0-(CL-CPD)*Q(NK)*T(I)-GZ(I)-ALV*QG)/CPD
-         CLW(I)=Q(NK)-QG
-         CLW(I)=MAX(0.0,CLW(I))
-         RG=QG/(1.-Q(NK))
-         TVP(I)=TPK(I)*(1.+RG*EPSI)
-  300   CONTINUE
-
-c -- sb:
-        RG = GRAVITY  ! RG redevient la gravite de YOMCST (sb)
-c sb --
-
-        RETURN
-        END
-
Index: LMDZ.3.3/branches/rel-/libf/phylmd/tlift.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/tlift.F	(revision 416)
+++ 	(revision )
@@ -1,243 +1,0 @@
-c $Header$
-        SUBROUTINE TLIFT(P,T,RR,RS,GZ,PLCL,ICB,NK,
-     .                  TVP,TPK,CLW,ND,NL,
-     .                  DTVPDT1,DTVPDQ1)
-C
-C     Argument NK ajoute (jyg) = Niveau de depart de la
-C     convection
-C
-        PARAMETER (NA=60)
-        REAL GZ(ND),TPK(ND),CLW(ND)
-        REAL T(ND),RR(ND),RS(ND),TVP(ND),P(ND)
-        REAL DTVPDT1(ND),DTVPDQ1(ND)   ! Derivatives of parcel virtual
-C                                   temperature wrt T1 and Q1
-C
-        REAL CLW_NEW(NA),QI(NA)
-        REAL DTPDT1(NA),DTPDQ1(NA)      ! Derivatives of parcel temperature
-C                                   wrt T1 and Q1
- 
-C
-        LOGICAL ICE_CONV
-C
-C   ***   ASSIGN VALUES OF THERMODYNAMIC CONSTANTS     ***
-C
-c sb        CPD=1005.7
-c sb      CPV=1870.0
-c sb        CL=4190.0
-c sb        CPVMCL=2320.0
-c sb        RV=461.5
-c sb        RD=287.04
-c sb        EPS=RD/RV
-c sb        ALV0=2.501E6
-ccccccccccccccccccccccc
-c constantes coherentes avec le modele du Centre Europeen
-c sb      RD = 1000.0 * 1.380658E-23 * 6.0221367E+23 / 28.9644
-c sb      RV = 1000.0 * 1.380658E-23 * 6.0221367E+23 / 18.0153
-c sb      CPD = 3.5 * RD
-c sb      CPV = 4.0 * RV
-c sb      CL = 4218.0
-c sb      CI=2090.0
-c sb      CPVMCL=CL-CPV
-c sb      CLMCI=CL-CI
-c sb      EPS=RD/RV
-c sb      ALV0=2.5008E+06
-c sb      ALF0=3.34E+05
- 
-cccccccccccc
-c on utilise les constantes thermo du Centre Europeen: (SB)
-c
-#include "YOMCST.h"
-       GRAVITY = RG !sb: Pr que gravite ne devienne pas humidite!
-c
-       CPD = RCPD
-       CPV = RCPV
-       CL = RCW
-       CI = RCS
-       CPVMCL = CL-CPV
-       CLMCI = CL-CI
-       EPS = RD/RV
-       ALV0 = RLVTT
-       ALF0 = RLMLT ! (ALF0 = RLSTT-RLVTT)
-c 
-cccccccccccccccccccccc
-C
-C   ***  CALCULATE CERTAIN PARCEL QUANTITIES, INCLUDING STATIC ENERGY   ***
-C
-        ICB1=MAX(ICB,2)
-        ICB1=MIN(ICB,NL)
-C
-Cjyg1
-CC      CPP=CPD*(1.-RR(1))+RR(1)*CPV
-      CPP=CPD*(1.-RR(NK))+RR(NK)*CPV
-Cjyg2
-      CPINV=1./CPP
-Cjyg1
-C         ICB may be below condensation level
-CCC        DO 100 I=1,ICB1-1
-CCC         TPK(I)=T(1)-GZ(I)*CPINV
-CCC         TVP(I)=TPK(I)*(1.+RR(1)/EPS)
-        DO 50 I=1,ICB1
-         CLW(I)=0.0
-50      CONTINUE
-C
-        DO 100 I=NK,ICB1
-         TPK(I)=T(NK)-(GZ(I) - GZ(NK))*CPINV
-Cjyg1
-CCC         TVP(I)=TPK(I)*(1.+RR(NK)/EPS)
-         TVP(I)=TPK(I)*(1.+RR(NK)/EPS-RR(NK))
-Cjyg2
-         DTVPDT1(I) = 1.+RR(NK)/EPS-RR(NK)
-         DTVPDQ1(I) = TPK(I)*(1./EPS-1.)
-C
-Cjyg2
- 
-  100   CONTINUE
- 
-C
-C    ***  FIND LIFTED PARCEL TEMPERATURE AND MIXING RATIO    ***
-C
-Cjyg1
-CC        AH0=(CPD*(1.-RR(1))+CL*RR(1))*T(1)
-CC     $     +RR(1)*(ALV0-CPVMCL*(T(1)-273.15))
-        AH0=(CPD*(1.-RR(NK))+CL*RR(NK))*T(NK)
-     $     +RR(NK)*(ALV0-CPVMCL*(T(NK)-273.15)) + GZ(NK)
-Cjyg2
-C
-Cjyg1
-        IMIN = ICB1
-C         If ICB is below LCL, start loop at ICB+1
-        IF (PLCL .LT. P(ICB1)) IMIN = MIN(IMIN+1,NL)
-C
-CCC        DO 300 I=ICB1,NL
-        DO 300 I=IMIN,NL
-Cjyg2
-         ALV=ALV0-CPVMCL*(T(I)-273.15)
-         ALF=ALF0+CLMCI*(T(I)-273.15)
- 
-        RG=RS(I)
-        TG=T(I)
-C       S=CPD+ALV*ALV*RG/(RV*T(I)*T(I))
-Cjyg1
-CC        S=CPD*(1.-RR(1))+CL*RR(1)+ALV*ALV*RG/(RV*T(I)*T(I))
-        S=CPD*(1.-RR(NK))+CL*RR(NK)+ALV*ALV*RG/(RV*T(I)*T(I))
-Cjyg2
-        S=1./S
- 
-        DO 200 J=1,2
-Cjyg1
-CC         AHG=CPD*TG+(CL-CPD)*RR(1)*TG+ALV*RG+GZ(I)
-         AHG=CPD*TG+(CL-CPD)*RR(NK)*TG+ALV*RG+GZ(I)
-Cjyg2
-        TG=TG+S*(AH0-AHG)
-        TC=TG-273.15
-        DENOM=243.5+TC
-        DENOM=MAX(DENOM,1.0)
-C
-C       FORMULE DE BOLTON POUR PSAT
-C
-        ES=6.112*EXP(17.67*TC/DENOM)
-        RG=EPS*ES/(P(I)-ES*(1.-EPS))
- 
- 
-  200   CONTINUE
- 
-Cjyg1
-CC        TPK(I)=(AH0-GZ(I)-ALV*RG)/(CPD+(CL-CPD)*RR(1))
-        TPK(I)=(AH0-GZ(I)-ALV*RG)/(CPD+(CL-CPD)*RR(NK))
-Cjyg2
-C       TPK(I)=(AH0-GZ(I)-ALV*RG-(CL-CPD)*T(I)*RR(1))/CPD
- 
-Cjyg1
-CC        CLW(I)=RR(1)-RG
-        CLW(I)=RR(NK)-RG
-Cjyg2
-        CLW(I)=MAX(0.0,CLW(I))
-Cjyg1
-CCC        TVP(I)=TPK(I)*(1.+RG/EPS)
-        TVP(I)=TPK(I)*(1.+RG/EPS-RR(NK))
-Cjyg2
-C
-Cjyg1       Derivatives
-C
-        DTPDT1(I) = CPD*S
-        DTPDQ1(I) = ALV*S
-C
-         DTVPDT1(I) = DTPDT1(I)*(1. + RG/EPS -
-     .           RR(NK) + ALV*RG/(RD*TPK(I)) )
-        DTVPDQ1(I) = DTPDQ1(I)*(1. + RG/EPS -
-     .           RR(NK) + ALV*RG/(RD*TPK(I)) ) - TPK(I)
-C
-Cjyg2
- 
-  300   CONTINUE
-C
-      ICE_CONV = .FALSE.
-
-      IF (ICE_CONV) THEN
-C
-CJAM
-C       RAJOUT DE LA PROCEDURE ICEFRAC
-C
-c sb        CALL ICEFRAC(T,CLW,CLW_NEW,QI,ND,NL)
- 
-        DO 400 I=ICB1,NL
-        IF (T(I).LT.263.15) THEN
-        TG=TPK(I)
-        TC=TPK(I)-273.15
-        DENOM=243.5+TC
-        ES=6.112*EXP(17.67*TC/DENOM)
-        ALV=ALV0-CPVMCL*(T(I)-273.15)
-        ALF=ALF0+CLMCI*(T(I)-273.15)
- 
-        DO J=1,4
-        ESI=EXP(23.33086-(6111.72784/TPK(I))+0.15215*LOG(TPK(I)))
-        QSAT_NEW=EPS*ESI/(P(I)-ESI*(1.-EPS))
-CCC        SNEW= CPD*(1.-RR(1))+CL*RR(1)+ALV*ALV*QSAT_NEW/(RV*TPK(I)*TPK(I))
-        SNEW= CPD*(1.-RR(NK))+CL*RR(NK)
-     .        +ALV*ALV*QSAT_NEW/(RV*TPK(I)*TPK(I))
-C
-        SNEW=1./SNEW
-        TPK(I)=TG+(ALF*QI(I)+ALV*RG*(1.-(ESI/ES)))*SNEW
-c$$$        PRINT*,'################################'
-c$$$        PRINT*,TPK(I)
-c$$$        PRINT*,(ALF*QI(I)+ALV*RG*(1.-(ESI/ES)))*SNEW
-        ENDDO
-CCC        CLW(I)=RR(1)-QSAT_NEW
-        CLW(I)=RR(NK)-QSAT_NEW
-        CLW(I)=MAX(0.0,CLW(I))
-Cjyg1
-CCC        TVP(I)=TPK(I)*(1.+QSAT_NEW/EPS)
-        TVP(I)=TPK(I)*(1.+QSAT_NEW/EPS-RR(NK))
-Cjyg2
-        ELSE
-        CONTINUE
-        ENDIF
- 
-  400   CONTINUE
-C
-      ENDIF
-C
- 
-******************************************************
-** BK :  RAJOUT DE LA TEMPERATURE DES ASCENDANCES
-**   NON DILUES AU  NIVEAU KLEV = ND
-**   POSONS LE ENVIRON EGAL A CELUI DE KLEV-1
-********************************************************
- 
-      TPK(NL+1)=TPK(NL)
- 
-*******************************************************
-
-      RG = GRAVITY  ! RG redevient la gravite de YOMCST (sb)
- 
- 
-        RETURN
-        END
- 
- 
- 
- 
- 
- 
- 
- 
Index: LMDZ.3.3/branches/rel-/libf/phylmd/transp.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/transp.F	(revision 416)
+++ 	(revision )
@@ -1,44 +1,0 @@
-      SUBROUTINE transp (paprs,tsol,
-     e                   t, q, u, v, geom,
-     s                   vtran_e, vtran_q, utran_e, utran_q)
-c
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X.Li (LMD/CNRS)
-c Date: le 25 avril 1994
-c Objet: Calculer le transport de l'energie et de la vapeur d'eau
-c======================================================================
-c
-#include "dimensions.h"
-#include "dimphy.h"
-#include "YOMCST.h"
-c
-      REAL paprs(klon,klev+1), tsol(klon)
-      REAL t(klon,klev), q(klon,klev), u(klon,klev), v(klon,klev)
-      REAL utran_e(klon), utran_q(klon), vtran_e(klon), vtran_q(klon)
-c
-      INTEGER i, l
-c     ------------------------------------------------------------------
-      REAL geom(klon,klev), e
-c     ------------------------------------------------------------------
-      DO i = 1, klon
-         utran_e(i) = 0.0
-         utran_q(i) = 0.0
-         vtran_e(i) = 0.0
-         vtran_q(i) = 0.0
-      ENDDO
-c
-      DO l = 1, klev
-      DO i = 1, klon
-         e = RCPD*t(i,l) + RLVTT*q(i,l) + geom(i,l)
-         utran_e(i)=utran_e(i)+ u(i,l)*e*(paprs(i,l)-paprs(i,l+1))/RG
-         utran_q(i)=utran_q(i)+ u(i,l)*q(i,l)
-     .                         *(paprs(i,l)-paprs(i,l+1))/RG
-         vtran_e(i)=vtran_e(i)+ v(i,l)*e*(paprs(i,l)-paprs(i,l+1))/RG
-         vtran_q(i)=vtran_q(i)+ v(i,l)*q(i,l)
-     .                         *(paprs(i,l)-paprs(i,l+1))/RG
-      ENDDO
-      ENDDO
-c
-      RETURN
-      END
Index: LMDZ.3.3/branches/rel-/libf/phylmd/wrgradsfi.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/wrgradsfi.F	(revision 416)
+++ 	(revision )
@@ -1,29 +1,0 @@
-      subroutine wrgradsfi(if,nl,fieldfi,name,titlevar)
-      implicit none
-
-c   Declarations
-
-#include "dimensions.h"
-#include "dimphy.h"
-
-c   arguments
-      integer if,nl
-      real fieldfi(klon,nl)
-      real fielddyn((iim+1)*(jjm+1),llm)
-      character*10 name
-      character*10 titlevar
-
-c   local
-
-      integer lm,l,lnblnk
-
-
-
-c     print*,'Transformation pour ',name
-      call gr_fi_dyn(nl,klon,iim+1,jjm+1,fieldfi,fielddyn)
-c     print*,'Transformation OK '
-      call wrgrads(if,nl,fielddyn,name,titlevar)
-c     print*,'Ecriture ok'
-
-      return
-      end
Index: LMDZ.3.3/branches/rel-/libf/phylmd/write_histday.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/write_histday.h	(revision 416)
+++ 	(revision )
@@ -1,406 +1,0 @@
-      IF (ok_journe) THEN
-c
-      ndex2d = 0
-      ndex3d = 0
-c
-c Champs 2D:
-c
-         zsto = dtime
-         zout = dtime * FLOAT(ecrit_day)
-         itau_w = itau_phy + itap
-
-         i = NINT(zout/zsto)
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
-       CALL histwrite(nid_day,"phis",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-         varname = 'phis'
-         vartitle= 'Surface geop. height'
-         varunits= '-'
-c        call writephy(fid_day,prof2d_on,varname,pphis,vartitle,
-c    .                                                    varunits)
-c
-         i = NINT(zout/zsto)
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
-       CALL histwrite(nid_day,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-         varname = 'aire'
-         vartitle= 'Grid area'
-         varunits= '-'
-c        call writephy(fid_day,prof2d_on,varname,paire,vartitle,
-c    .                                                    varunits)
-C
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
-      CALL histwrite(nid_day,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c     call writephy(fid_day,prof2d_av,'tsol',zxtsol,
-c    .              'Surface Temperature','K')
-c
-C
-      zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_ter)
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d ,zx_tmp_2d)
-      CALL histwrite(nid_day,"tter",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c     call writephy(fid_day,prof2d_av,'tter',ftsol(1 : klon, is_ter),
-c    .              'Surface Temperature','K')
-C
-      zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_lic)
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day,"tlic",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c     call writephy(fid_day,prof2d_av,'tlic',ftsol(1 : klon, is_lic),
-c    .              'Surface Temperature','K')
-C
-      zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_oce)
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day,"toce",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c     call writephy(fid_day,prof2d_av,'toce',ftsol(1 : klon, is_oce),
-c    .              'Surface Temperature','K')
-C
-      zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_sic)
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day,"tsic",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c     call writephy(fid_day,prof2d_av,'tsic',ftsol(1 : klon, is_sic),
-c    .              'Surface Temperature','K')
-C
-cccIM
-      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zt2m,zx_tmp_2d)
-      CALL histwrite(nid_day,"t2m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zt2m,zx_tmp_2d)
-      CALL histwrite(nid_day,"t2m_min",itau_w,zx_tmp_2d,
-     .               iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zt2m,zx_tmp_2d)
-      CALL histwrite(nid_day,"t2m_max",itau_w,zx_tmp_2d,
-     .               iim*jjmp1,ndex2d)
-c
-      zx_tmp_fi2d(1 : klon) = t2m(1 : klon, is_ter)
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
-      CALL histwrite(nid_day,"t2mter",itau_w,zx_tmp_2d,iim*jjmp1,
-     .               ndex2d)
-c
-      zx_tmp_fi2d(1 : klon) = t2m(1 : klon, is_ter)
-      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day,"t2mter_min",itau_w,zx_tmp_2d,
-     .               iim*jjmp1,ndex2d)
-c
-      zx_tmp_fi2d(1 : klon) = t2m(1 : klon, is_ter)
-      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day,"t2mter_max",itau_w,zx_tmp_2d,
-     .               iim*jjmp1,ndex2d)
-c
-      zx_tmp_fi2d(1 : klon) = t2m(1 : klon, is_lic)
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
-      CALL histwrite(nid_day,"t2mlic",itau_w,zx_tmp_2d,iim*jjmp1,
-     .               ndex2d)
-c
-      zx_tmp_fi2d(1 : klon) = t2m(1 : klon, is_oce)
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
-      CALL histwrite(nid_day,"t2moce",itau_w,zx_tmp_2d,iim*jjmp1,
-     .               ndex2d)
-c
-      zx_tmp_fi2d(1 : klon) = t2m(1 : klon, is_sic)
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
-      CALL histwrite(nid_day,"t2msic",itau_w,zx_tmp_2d,iim*jjmp1,
-     .               ndex2d)
-c
-      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zq2m,zx_tmp_2d)
-      CALL histwrite(nid_day,"q2m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zu10m,zx_tmp_2d)
-      CALL histwrite(nid_day,"u10m",itau_w,zx_tmp_2d,iim*jjmp1,
-     .               ndex2d)
-c
-      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zv10m,zx_tmp_2d)
-      CALL histwrite(nid_day,"v10m",itau_w,zx_tmp_2d,iim*jjmp1,
-     .               ndex2d)
-c
-      zx_tmp_fi2d(1 : klon) = u10m(1 : klon, is_ter)
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
-      CALL histwrite(nid_day,"u10mter",itau_w,zx_tmp_2d,iim*jjmp1,
-     .               ndex2d)
-c
-      zx_tmp_fi2d(1 : klon) = v10m(1 : klon, is_ter)
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
-      CALL histwrite(nid_day,"v10mter",itau_w,zx_tmp_2d,iim*jjmp1,
-     .               ndex2d)
-c
-      zx_tmp_fi2d(1 : klon) = u10m(1 : klon, is_lic)
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
-      CALL histwrite(nid_day,"u10mlic",itau_w,zx_tmp_2d,iim*jjmp1,
-     .               ndex2d)
-c
-      zx_tmp_fi2d(1 : klon) = v10m(1 : klon, is_lic)
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
-      CALL histwrite(nid_day,"v10mlic",itau_w,zx_tmp_2d,iim*jjmp1,
-     .               ndex2d)
-c
-      zx_tmp_fi2d(1 : klon) = u10m(1 : klon, is_oce)
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
-      CALL histwrite(nid_day,"u10moce",itau_w,zx_tmp_2d,iim*jjmp1,
-     .               ndex2d)
-c
-      zx_tmp_fi2d(1 : klon) = v10m(1 : klon, is_oce)
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
-      CALL histwrite(nid_day,"v10moce",itau_w,zx_tmp_2d,iim*jjmp1,
-     .               ndex2d)
-c
-      zx_tmp_fi2d(1 : klon) = u10m(1 : klon, is_sic)
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
-      CALL histwrite(nid_day,"u10msic",itau_w,zx_tmp_2d,iim*jjmp1,
-     .               ndex2d)
-C
-      zx_tmp_fi2d(1 : klon) = v10m(1 : klon, is_sic)
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
-      CALL histwrite(nid_day,"v10msic",itau_w,zx_tmp_2d,iim*jjmp1,
-     .               ndex2d)
-C
-      DO i = 1, klon
-         zx_tmp_fi2d(i) = paprs(i,1)
-      ENDDO
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c Essai writephys
-      varname = 'psol'
-      vartitle= 'pression au sol'
-      varunits= 'hPa'
-c     call writephy(fid_day,prof2d_av,varname,zx_tmp_fi2d,vartitle,
-c    .                                                    varunits)
-c
-      DO i = 1, klon
-         zx_tmp_fi2d(i) = (rain_fall(i) + snow_fall(i))
-      ENDDO
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day,"precip",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c     call writephy(fid_day,prof2d_av,'rain',zx_tmp_fi2d,
-c    .              'Precipitation','mm/day')
-
-
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
-      CALL histwrite(nid_day,"snow",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c     call writephy(fid_day,prof2d_av,'snow',snow_fall,
-c    .              'Snow','mm/day')
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d)
-      CALL histwrite(nid_day,"snow_mass",itau_w,zx_tmp_2d,iim*jjmp1,
-     .               ndex2d)
-c     call writephy(fid_day,prof2d_av,'snow_mass',zxsnow,
-c    .              'Snow cover','mm')
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
-      CALL histwrite(nid_day,"evap",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c     call writephy(fid_day,prof2d_av,'evap',evap,
-c    .              'Evaporation','mm/day')
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
-      CALL histwrite(nid_day,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c     call writephy(fid_day,prof2d_av,'tops',topsw,
-c    .              'Solar rad. at TOA','W/m2')
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
-      CALL histwrite(nid_day,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c     call writephy(fid_day,prof2d_av,'topl',toplw,
-c    .              'IR rad. at TOA','W/m2')
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
-      CALL histwrite(nid_day,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c     call writephy(fid_day,prof2d_av,'sols',solsw,
-c    .              'Solar rad. at surf.','W/m2')
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
-      CALL histwrite(nid_day,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c     call writephy(fid_day,prof2d_av,'soll',sollw,
-c    .              'IR rad. at surface','W/m2')
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
-      CALL histwrite(nid_day,"solldown",itau_w,zx_tmp_2d,iim*jjmp1,
-     .               ndex2d)
-c     call writephy(fid_day,prof2d_av,'solldown',sollwdown,
-c    .              'Down. IR rad. at surface','W/m2')
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
-      CALL histwrite(nid_day,"bils",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c     call writephy(fid_day,prof2d_av,'bils',bils,
-c    .              'Surf. total heat flux','W/m2')
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
-      CALL histwrite(nid_day,"sens",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c     call writephy(fid_day,prof2d_av,'sens',sens,
-c    .              'Sensible heat flux','W/m2')
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
-      CALL histwrite(nid_day,"fder",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c     call writephy(fid_day,prof2d_av,'fder',fder,
-c    .              'Heat flux derivation','W/m2')
-c
-c
-      DO nsrf = 1, nbsrf
-CXXX
-        zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
-        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
-        CALL histwrite(nid_day,"pourc_"//clnsurf(nsrf),itau_w,
-     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
-c       call writephy(fid_day,prof2d_av,'pourc_'//clnsurf(nsrf),
-c    .                pctsrf( 1 : klon, nsrf),
-c    .                'Fraction'//clnsurf(nsrf),'-')
-C
-        zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
-        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
-        CALL histwrite(nid_day,"tsol_"//clnsurf(nsrf),itau_w,
-     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
-c       call writephy(fid_day,prof2d_av,'tsol_'//clnsurf(nsrf),
-c    .                ftsol( 1 : klon, nsrf),
-c    .                'Surf. Temp'//clnsurf(nsrf),'K')
-C 
-        zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
-        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
-        CALL histwrite(nid_day,"sens_"//clnsurf(nsrf),itau_w,
-     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
-c       call writephy(fid_day,prof2d_av,'sens_'//clnsurf(nsrf),
-c    .                fluxt( 1 : klon, 1, nsrf),
-c    .                'Sensible heat flux '//clnsurf(nsrf),'W/m2')
-C  
-        zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
-        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
-        CALL histwrite(nid_day,"lat_"//clnsurf(nsrf),itau_w,
-     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
-c       call writephy(fid_day,prof2d_av,'lat_'//clnsurf(nsrf),
-c    .                fluxlat( 1 : klon, nsrf),
-c    .                'Latent heat flux '//clnsurf(nsrf),'W/m2')
-C
-        zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
-        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
-        CALL histwrite(nid_day,"taux_"//clnsurf(nsrf),itau_w,
-     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
-c       call writephy(fid_day,prof2d_av,'taux_'//clnsurf(nsrf),
-c    .                fluxu( 1 : klon, 1, nsrf),
-c    .                'Zonal wind stress '//clnsurf(nsrf),'Pa')
-C      
-        zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
-        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
-        CALL histwrite(nid_day,"tauy_"//clnsurf(nsrf),itau_w,
-     $      zx_tmp_2d,iim*jjmp1,ndex2d)
-c       call writephy(fid_day,prof2d_av,'tauy_'//clnsurf(nsrf),
-c    .                fluxv( 1 : klon, 1, nsrf),
-c    .                'Meridional wind stress '//clnsurf(nsrf),'Pa')
-C
-        zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
-        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
-        CALL histwrite(nid_day,"albe_"//clnsurf(nsrf),itau_w,
-     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
-c       call writephy(fid_day,prof2d_av,'albe_'//clnsurf(nsrf),
-c    .                falbe( 1 : klon, nsrf),
-c    .                'Albedo surf. SW'//clnsurf(nsrf),'-')
-c       call writephy(fid_day,prof2d_av,'alblw_'//clnsurf(nsrf),
-c    .                falblw( 1 : klon, nsrf),
-c    .                'Albedo surf. LW'//clnsurf(nsrf),'-')
-C
-        zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
-        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
-        CALL histwrite(nid_day,"rugs_"//clnsurf(nsrf),itau_w,
-     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
-c       call writephy(fid_day,prof2d_av,'rugs_'//clnsurf(nsrf),
-c    .                frugs( 1 : klon, nsrf),
-c    .                'Rugosity '//clnsurf(nsrf),' - ')
-C 
-      END DO  
-C
-cXXX      DO i = 1, klon
-cXXX         zx_tmp_fi2d(i) = pctsrf(i,is_sic)
-cXXX      ENDDO
-cXXX      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-cXXX      CALL histwrite(nid_day,"sicf",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldl,zx_tmp_2d)
-      CALL histwrite(nid_day,"cldl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c     call writephy(fid_day,prof2d_av,'cldl',cldl,
-c    .              'Low-level cloudiness','-')
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldm,zx_tmp_2d)
-      CALL histwrite(nid_day,"cldm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c     call writephy(fid_day,prof2d_av,'cldm',cldm,
-c    .              'Mid-level cloudiness','-')
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldh,zx_tmp_2d)
-      CALL histwrite(nid_day,"cldh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c     call writephy(fid_day,prof2d_av,'cldh',cldh,
-c    .              'High-level cloudiness','-')
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
-      CALL histwrite(nid_day,"cldt",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c     call writephy(fid_day,prof2d_av,'cldt',cldt,
-c    .              'Total cloudiness','-')
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldq,zx_tmp_2d)
-      CALL histwrite(nid_day,"cldq",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c     call writephy(fid_day,prof2d_av,'cldq',cldq,
-c    .              'Cloud liquid water path','-')
-c
-c Champs 3D:
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
-      CALL histwrite(nid_day,"temp",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c Essai writephys
-      varname = 'temp'
-      vartitle= 'temperature 3D'
-      varunits= 'K'
-c     call writephy(fid_day,prof3d_av,varname,t_seri,vartitle,varunits)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,ivap), zx_tmp_3d)
-      CALL histwrite(nid_day,"ovap",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c     call writephy(fid_day,prof3d_av,'ovap',qx(1,1,ivap),
-c    .              'Specific humidity','Kg/Kg')
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
-      CALL histwrite(nid_day,"geop",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c     call writephy(fid_day,prof3d_av,'geop',zphi,
-c    .              'Geopotential height','m')
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
-      CALL histwrite(nid_day,"vitu",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c     call writephy(fid_day,prof3d_av,'vitu',u_seri,
-c    .              'Zonal wind','m/s')
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
-      CALL histwrite(nid_day,"vitv",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c     call writephy(fid_day,prof3d_av,'vitv',v_seri,
-c    .              'Meridional wind','m/s')
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
-      CALL histwrite(nid_day,"vitw",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c     call writephy(fid_day,prof3d_av,'vitw',omega,
-c    .              'Vertical wind','m/s')
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
-      CALL histwrite(nid_day,"pres",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c     call writephy(fid_day,prof3d_av,'pres',pplay,
-c    .              'Air pressure','Pa')
-cccIM
-      zx_tmp_fi2d(1 : klon) = ZFSUP( 1 : klon, klevp1)
-      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day, "SWupTOA",itau_w,zx_tmp_2d,
-     .                               iim*jjmp1,ndex2d)
-c
-      zx_tmp_fi2d(1 : klon) = ZFSUP( 1 : klon, 1)
-      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day, "SWupSFC",itau_w,zx_tmp_2d,
-     .                               iim*jjmp1,ndex2d)
-c
-      zx_tmp_fi2d(1 : klon) = ZFSDN( 1 : klon, klevp1)
-      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day, "SWdnTOA",itau_w,zx_tmp_2d,
-     .                               iim*jjmp1,ndex2d)
-c
-      zx_tmp_fi2d(1 : klon) = ZFSDN( 1 : klon, 1)
-      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day, "SWdnSFC",itau_w,zx_tmp_2d,
-     .                               iim*jjmp1,ndex2d)
-c
-      if (ok_sync) then
-c       call writephy_sync(fid_day)
-        call histsync(nid_day)
-      endif
-      ENDIF
Index: LMDZ.3.3/branches/rel-/libf/phylmd/write_histhf.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/write_histhf.h	(revision 416)
+++ 	(revision )
@@ -1,58 +1,0 @@
-      if (ok_hf) then
-
-c   Comprendre comment marche el i=nint(zout/zsto)
-c
-      print*,'ACRITURE HF !!! ACRITURE HF !!! ACRITURE HF !!! '
-      ndex2d = 0
-      ndex3d = 0
-c
-c
-c     i = NINT(zout/zsto)
-c     CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
-c     CALL histwrite(nid_hf,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-c     i = NINT(zout/zsto)
-c     CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
-c     CALL histwrite(nid_hf,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
-C
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
-      CALL histwrite(nid_hf,"tsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      DO i = 1, klon
-         zx_tmp_fi2d(i) = paprs(i,1)
-      ENDDO
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_hf,"psol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      DO i = 1, klon
-         zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
-      ENDDO
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_hf,"rain",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, u850,zx_tmp_2d)
-      CALL histwrite(nid_hf,"u850",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, v850,zx_tmp_2d)
-      CALL histwrite(nid_hf,"v850",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, u500,zx_tmp_2d)
-      CALL histwrite(nid_hf,"u500",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, v500,zx_tmp_2d)
-      CALL histwrite(nid_hf,"v500",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, u200,zx_tmp_2d)
-      CALL histwrite(nid_hf,"u200",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, v200,zx_tmp_2d)
-      CALL histwrite(nid_hf,"v200",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, phi500,zx_tmp_2d)
-      CALL histwrite(nid_hf,"phi500",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
-
-      if (ok_sync) then
-        call histsync(nid_hf)
-      endif
-
-      endif
Index: LMDZ.3.3/branches/rel-/libf/phylmd/write_histmth.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/write_histmth.h	(revision 416)
+++ 	(revision )
@@ -1,450 +1,0 @@
-      IF (ok_mensuel) THEN
-c
-      ndex2d = 0
-      ndex3d = 0
-c
-c Champs 2D:
-c
-         zsto = dtime
-         zout = dtime * ecrit_mth
-         itau_w = itau_phy + itap
-
-      i = NINT(zout/zsto)
-      CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
-      CALL histwrite(nid_mth,"phis",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-C
-      i = NINT(zout/zsto)
-      CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
-      CALL histwrite(nid_mth,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
-      CALL histwrite(nid_mth,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-cccIM
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zt2m,zx_tmp_2d)
-      CALL histwrite(nid_mth,"t2m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zq2m,zx_tmp_2d)
-      CALL histwrite(nid_mth,"q2m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zu10m,zx_tmp_2d)
-      CALL histwrite(nid_mth,"u10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-C
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zv10m,zx_tmp_2d)
-      CALL histwrite(nid_mth,"v10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-C
-      DO i = 1, klon
-         zx_tmp_fi2d(i) = paprs(i,1)
-      ENDDO
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_mth,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxqsol,zx_tmp_2d)
-      CALL histwrite(nid_mth,"qsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      DO i = 1, klon
-         zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
-      ENDDO
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_mth,"precip",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      DO i = 1, klon
-         zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
-      ENDDO
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_mth,"plul",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      DO i = 1, klon
-         zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
-      ENDDO
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_mth,"pluc",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
-      CALL histwrite(nid_mth,"snow",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d)
-      CALL histwrite(nid_mth,"snow_mass",itau_w,zx_tmp_2d,iim*jjmp1,
-     .               ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
-      CALL histwrite(nid_mth,"evap",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
-      CALL histwrite(nid_mth,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
-      CALL histwrite(nid_mth,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
-      CALL histwrite(nid_mth,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
-      CALL histwrite(nid_mth,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
-      CALL histwrite(nid_mth,"solldown",itau_w,zx_tmp_2d,iim*jjmp1,
-     .               ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw0,zx_tmp_2d)
-      CALL histwrite(nid_mth,"tops0",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw0,zx_tmp_2d)
-      CALL histwrite(nid_mth,"topl0",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw0,zx_tmp_2d)
-      CALL histwrite(nid_mth,"sols0",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw0,zx_tmp_2d)
-      CALL histwrite(nid_mth,"soll0",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
-      CALL histwrite(nid_mth,"bils",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
-      CALL histwrite(nid_mth,"sens",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
-      CALL histwrite(nid_mth,"fder",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-c
-c      DO i = 1, klon
-c         zx_tmp_fi2d(i) = fluxu(i,1)
-c      ENDDO
-c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-c      CALL histwrite(nid_mth,"frtu",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-c      DO i = 1, klon
-c         zx_tmp_fi2d(i) = fluxv(i,1)
-c      ENDDO
-c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-c      CALL histwrite(nid_mth,"frtv",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      DO nsrf = 1, nbsrf
-CYYY
-        zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
-        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
-        CALL histwrite(nid_mth,"pourc_"//clnsurf(nsrf),itau_w,
-     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
-C 
-        zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
-        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
-        CALL histwrite(nid_mth,"tsol_"//clnsurf(nsrf),itau_w,
-     $      zx_tmp_2d,iim*jjmp1,ndex2d)
-C
-        zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
-        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
-        CALL histwrite(nid_mth,"sens_"//clnsurf(nsrf),itau_w,
-     $      zx_tmp_2d,iim*jjmp1,ndex2d)
-C
-        zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
-        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
-        CALL histwrite(nid_mth,"lat_"//clnsurf(nsrf),itau_w,
-     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
-C
-        zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
-        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
-        CALL histwrite(nid_mth,"taux_"//clnsurf(nsrf),itau_w,
-     $      zx_tmp_2d,iim*jjmp1,ndex2d) 
-C      
-        zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
-        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
-        CALL histwrite(nid_mth,"tauy_"//clnsurf(nsrf),itau_w,
-     $      zx_tmp_2d,iim*jjmp1,ndex2d)
-C 
-        zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
-        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
-        CALL histwrite(nid_mth,"albe_"//clnsurf(nsrf),itau_w,
-     $      zx_tmp_2d,iim*jjmp1,ndex2d)
-C
-        zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
-        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
-        CALL histwrite(nid_mth,"rugs_"//clnsurf(nsrf),itau_w,
-     $      zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      zx_tmp_fi2d(1 : klon) = agesno( 1 : klon, nsrf)
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, agesno,zx_tmp_2d)
-      CALL histwrite(nid_mth,"ages_"//clnsurf(nsrf),itau_w
-     $    ,zx_tmp_2d,iim*jjmp1,ndex2d)
-
-      END DO  
-cXXX      DO i = 1, klon
-cXXX         zx_tmp_fi2d(i) = pctsrf(i,is_sic)
-cXXX      ENDDO
-cXXX      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-cXXX      CALL histwrite(nid_mth,"sicf",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol,zx_tmp_2d)
-      CALL histwrite(nid_mth,"albs",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsollw,zx_tmp_2d)
-      CALL histwrite(nid_mth,"albslw",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
-      CALL histwrite(nid_mth,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
-      CALL histwrite(nid_mth,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldl,zx_tmp_2d)
-      CALL histwrite(nid_mth,"cldl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldm,zx_tmp_2d)
-      CALL histwrite(nid_mth,"cldm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldh,zx_tmp_2d)
-      CALL histwrite(nid_mth,"cldh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
-      CALL histwrite(nid_mth,"cldt",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldq,zx_tmp_2d)
-      CALL histwrite(nid_mth,"cldq",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
-      CALL histwrite(nid_mth,"ue",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
-      CALL histwrite(nid_mth,"ve",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, uq,zx_tmp_2d)
-      CALL histwrite(nid_mth,"uq",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, vq,zx_tmp_2d)
-      CALL histwrite(nid_mth,"vq",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-cKE43
-      IF (iflag_con .GE. 3) THEN ! sb
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cape,zx_tmp_2d)
-      CALL histwrite(nid_mth,"cape",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1,pbase,zx_tmp_2d)
-      CALL histwrite(nid_mth,"pbase",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1,ema_pct,zx_tmp_2d)
-      CALL histwrite(nid_mth,"ptop",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1,ema_cbmf,zx_tmp_2d)
-      CALL histwrite(nid_mth,"fbase",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-c
-      ENDIF
-c34EK
-c
-c Champs 3D:
-C
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
-      CALL histwrite(nid_mth,"temp",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,ivap), zx_tmp_3d)
-      CALL histwrite(nid_mth,"ovap",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
-      CALL histwrite(nid_mth,"geop",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
-      CALL histwrite(nid_mth,"vitu",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
-      CALL histwrite(nid_mth,"vitv",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
-      CALL histwrite(nid_mth,"vitw",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
-      CALL histwrite(nid_mth,"pres",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cldfra, zx_tmp_3d)
-      CALL histwrite(nid_mth,"rneb",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zx_rh, zx_tmp_3d)
-      CALL histwrite(nid_mth,"rhum",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cldliq, zx_tmp_3d)
-      CALL histwrite(nid_mth,"oliq",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, clwcon0, zx_tmp_3d)
-      CALL histwrite(nid_mth,"clwcon",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtdyn",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_dyn, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dqdyn",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_con, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtcon",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_con, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dqcon",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_lsc, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtlsc",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_lsc, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dqlsc",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_vdf, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtvdf",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_vdf, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dqvdf",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_eva, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dteva",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_eva, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dqeva",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      zpt_conv = 0.
-      where (ptconv) zpt_conv = 1.
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zpt_conv, zx_tmp_3d)
-      CALL histwrite(nid_mth,"ptconv",itau_w,zx_tmp_3d,
-     .                                   iim*(jjmp1)*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, ratqs, zx_tmp_3d)
-      CALL histwrite(nid_mth,"ratqs",itau_w,zx_tmp_3d,
-     .                                   iim*(jjmp1)*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_ajs, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtajs",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_ajs, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dqajs",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtswr",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat0, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtsw0",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtlwr",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool0, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtlw0",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_ec, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtec",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
-      CALL histwrite(nid_mth,"duvdf",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dvvdf",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      IF (ok_orodr) THEN
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_oro, zx_tmp_3d)
-      CALL histwrite(nid_mth,"duoro",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_oro, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dvoro",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      ENDIF
-C
-      IF (ok_orolf) THEN
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_lif, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dulif",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_lif, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dvlif",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-      ENDIF
-C
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, wo, zx_tmp_3d)
-      CALL histwrite(nid_mth,"ozone",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      IF (nqmax.GE.3) THEN
-      DO iq=1,nqmax-2
-      IF (iq.LE.99) THEN
-         CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,iq+2), zx_tmp_3d)
-         WRITE(str2,'(i2.2)') iq
-         CALL histwrite(nid_mth,"trac"//str2,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-      ELSE
-         PRINT*, "Trop de traceurs"
-         CALL abort
-      ENDIF
-      ENDDO
-      ENDIF
-cKE43
-      IF (iflag_con.GE.3) THEN ! (sb)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, upwd, zx_tmp_3d)
-      CALL histwrite(nid_mth,"upwd",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, dnwd, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dnwd",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, dnwd0, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dnwd0",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, Ma, zx_tmp_3d)
-      CALL histwrite(nid_mth,"Ma",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-cccIM
-      zx_tmp_fi2d(1 : klon) = ZFSUP( 1 : klon, klevp1)
-      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_mth, "SWupTOA",itau_w,zx_tmp_2d,
-     .                               iim*jjmp1,ndex2d)
-c
-      zx_tmp_fi2d(1 : klon) = ZFSUP( 1 : klon, 1)
-      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_mth, "SWupSFC",itau_w,zx_tmp_2d,
-     .                               iim*jjmp1,ndex2d)
-c
-      zx_tmp_fi2d(1 : klon) = ZFSDN( 1 : klon, klevp1)
-      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_mth, "SWdnTOA",itau_w,zx_tmp_2d,
-     .                               iim*jjmp1,ndex2d)
-c
-      zx_tmp_fi2d(1 : klon) = ZFSDN( 1 : klon, 1)
-      CALL gr_fi_ecrit(1,klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_mth, "SWdnSFC",itau_w,zx_tmp_2d,
-     .                               iim*jjmp1,ndex2d)
-c
-      
-      ENDIF
-
-      if (ok_sync) then
-        call histsync(nid_mth)
-      endif
-      ENDIF
-
Index: LMDZ.3.3/branches/rel-/libf/phylmd/zilch.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/zilch.F	(revision 416)
+++ 	(revision )
@@ -1,13 +1,0 @@
-      subroutine zilch(x,m)
-c
-c Zero the real array x dimensioned m.
-c
-      implicit none
-c
-      integer m,i
-      real x(m)
-      do 1 i=1,m
-      x(i)= 0.0  
-    1 continue
-      return
-      end
