*=*=*=*= disvert.html =*=*=*=*
SUBROUTINE disvert

SUBROUTINE disvert


      SUBROUTINE disvert(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 SSUM,z1,z2
      EXTERNAL SSUM
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'
         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


c DEBUT Sortie speciale MOMO
      PRINT*,'********************************'
      PRINT*,'      sig     Z      dZ'
      z1=0.
      l=1
      write(*,'(i2,2f12.8)') l,sig(l),z1
      do 19 l=1,llm-1
         z2=-h*log(sig(l+1))
         write(*,'(i2,3f12.8)') l+1,sig(l+1),z2,z2-z1
         z1=z2
19    continue
      PRINT*,'********************************'
c FIN Sortie speciale MOMO
c-----------------------------------------------------------------------
      RETURN
      END