*=*=*=*= inidissip.html =*=*=*=*
SUBROUTINE inidissip

SUBROUTINE inidissip


      SUBROUTINE inidissip ( lstardis,nitergdiv,nitergrot,niterh  ,
     *                       tetagdiv,tetagrot,tetatemp             )
c=======================================================================
c   initialisation de la dissipation horizontale
c=======================================================================
c-----------------------------------------------------------------------
c   declarations:
c   -------------

      IMPLICIT NONE
#include "dimensions.h"
#include "paramet.h"
#include "comdissipn.h"
#include "comconst.h"
#include "comvert.h"

      LOGICAL lstardis
      INTEGER nitergdiv,nitergrot,niterh
      REAL    tetagdiv,tetagrot,tetatemp
      REAL fact,zvert(llm),zz
      REAL zh(ip1jmp1),zu(ip1jmp1),zv(ip1jm)
      REAL ullm,vllm
      REAL zllm,zmaxm1,z1llm

      INTEGER l,ij,idum,ii

      EXTERNAL ran1
      REAL ran1
      EXTERNAL ISMIN,ISMAX,ISAMAX
      INTEGER ISMIN,ISMAX,ISAMAX


c-----------------------------------------------------------------------
c
c   calcul des valeurs propres des operateurs par methode iterrative:
c   -----------------------------------------------------------------

      crot     = -1.
      cdivu    = -1.
      cdivh    = -1.

c   calcul de la valeur propre de divgrad:
c   --------------------------------------

      idum  = -1
      zh(1) = RAN1(idum)-.5
      idum  = 0
      DO ij = 2, ip1jmp1
        zh(ij) = RAN1(idum) -.5
      ENDDO
      CALL filtreg (zh,jjp1,1,2,1,.TRUE.,1)

      IF ( zh(ISMIN(ip1jmp1,zh,1)).GE.
     *      zh(ISMAX(ip1jmp1,zh,1)) )  THEN

         PRINT*,'llm',zh(ISMAX(ip1jmp1,zh,1))
         PRINT*,'min',zh(ISMIN(ip1jmp1,zh,1))
         STOP'probleme generateur alleatoire dans inidissip'
      ENDIF

      zllm = ABS( zh(ISAMAX(ip1jmp1,zh,1)) )
      DO l = 1,50
         IF(lstardis) THEN
            CALL divgrad2(1,zh,niterh,zh)
         ELSE
            CALL divgrad (1,zh,niterh,zh)
         ENDIF
         zllm  = ABS( zh(ISAMAX(ip1jmp1,zh,1)) )
         z1llm = 1./zllm
         DO ij = 1,ip1jmp1
            zh(ij) = zh(ij)* z1llm
         ENDDO
      ENDDO

      IF(lstardis) THEN
         cdivh = 1./ zllm
      ELSE
         cdivh = zllm ** ( -1./niterh )
      ENDIF

c   calcul des valeurs propres de gradiv (ii =1) et  nxgrarot(ii=2)
c   -----------------------------------------------------------------

      DO  20  ii = 1, 2
c
         DO ij = 1, ip1jmp1
           zu(ij)  = RAN1(idum) -.5
         ENDDO
         CALL filtreg (zu,jjp1,1,2,1,.TRUE.,1)
         DO ij = 1, ip1jm
            zv(ij) = RAN1(idum) -.5
         ENDDO
         CALL filtreg (zv,jjm,1,2,1,.FALSE.,1)
         ullm = ABS ( zu(ISAMAX(ip1jmp1,zu,1)) )
         vllm = ABS ( zv(ISAMAX(ip1jm,zv,1)) )
         DO  5  l = 1, 50
            IF(ii.EQ.1) THEN
               CALL covcont( 1,zu,zv,zu,zv )
               IF(lstardis) THEN
                  CALL gradiv2( 1,zu,zv,nitergdiv,zu,zv )
               ELSE
                  CALL gradiv ( 1,zu,zv,nitergdiv,zu,zv )
               ENDIF
            ELSE
               IF(lstardis) THEN
                  CALL nxgraro2( 1,zu,zv,nitergrot,zu,zv )
               ELSE
                  CALL nxgrarot( 1,zu,zv,nitergrot,zu,zv )
               ENDIF
            ENDIF
            ullm = ABS  ( zu(ISAMAX(ip1jmp1,zu,1)) )
            vllm = ABS  ( zv(ISAMAX(ip1jm,zv,1)) )
            zllm = AMAX1( ullm,vllm )
            z1llm = 1./ zllm
            DO ij = 1, ip1jmp1
              zu(ij) = zu(ij)* z1llm
            ENDDO
            DO ij = 1, ip1jm
               zv(ij) = zv(ij)* z1llm
            ENDDO
 5       CONTINUE

         IF ( ii.EQ.1 ) THEN
            IF(lstardis) THEN
               cdivu  = 1./zllm
            ELSE
               cdivu  = zllm **( -1./nitergdiv )
            ENDIF
         ELSE
            IF(lstardis) THEN
               crot   = 1./ zllm
            ELSE
               crot   = zllm **( -1./nitergrot )
            ENDIF
         ENDIF

 20   CONTINUE

c   petit test pour les operateurs non star:
c   ----------------------------------------

c     IF(.NOT.lstardis) THEN
         fact    = rad*24./float(jjm)
         fact    = fact*fact
         PRINT*,'coef u ', fact/cdivu, 1./cdivu
         PRINT*,'coef r ', fact/crot , 1./crot
         PRINT*,'coef h ', fact/cdivh, 1./cdivh
c     ENDIF

c-----------------------------------------------------------------------
c   variation verticale du coefficient de dissipation:
c   --------------------------------------------------

      DO l=1,llm
         zvert(l)=1.
      ENDDO

      fact=2.
c      OPEN(99,file='dissip.def',status='old',form='formatted',ERR=9999)
c      READ(99,*) fact
c9999  CONTINUE
c      CLOSE(99)
c
      DO l = 1, llm
         zz      = 1. -2./ ( sig(l)+sig(l+1) )
         zvert(l)= fact -( fact-1.)/( 1.+zz*zz )
      ENDDO

      PRINT*,'Constantes de temps de la diffusion horizontale'
      DO l=1,llm
         tetaudiv(l)   = zvert(l)/tetagdiv
         tetaurot(l)   = zvert(l)/tetagrot
         tetah(l)      = zvert(l)/tetatemp
         PRINT*,zvert(l),dtdiss*tetaudiv(l),dtdiss*tetaurot(l),
     *                   dtdiss*tetah(l)
      ENDDO
      PRINT*,'dtdiss',dtdiss
c
      RETURN
      END