*=*=*=*= initestdyn.html =*=*=*=*
PROGRAM initestdyn

PROGRAM initestdyn


      PROGRAM initestdyn
      IMPLICIT NONE

c=======================================================================
c
c   creation d'un etat initial
c
c=======================================================================
c
c-----------------------------------------------------------------------
c   declarations:
c   -------------

#include "dimensions.h"
      INTEGER  ngridmx
      PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm )

c-----------------------------------------------------------------------
#include "paramet.h"
#include "comconst.h"
#include "comvert.h"
#include "comgeom2.h"
#include "control.h"
#include "logic.h"
#include "drsdef.h"
c
      REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm)
      REAL h(iip1,jjp1,llm),pext(iip1,jjp1)
      REAL pks(iip1,jjp1),pksf(iip1,jjp1)
      REAL phis(iip1,jjp1),q

      REAL z_reel(iip1,jjp1),rnatur(iip1,jjp1)
      REAL phisfi(ngridmx),rnaturfi(ngridmx)

      REAL latfi(ngridmx),lonfi(ngridmx),airefi(ngridmx)
c
      INTEGER i,j,l,itau,ig,idum
      INTEGER*4 day0
      INTEGER unit
      REAL p(iip1,jjp1),phis0,zz
      REAL t(iip1,jjp1,llm)
      REAL phi(iip1,jjp1,llm)
      REAL etot0,ptot0,ztot0,stot0,ang0,xx
      REAL daydeb,pressrf

      REAL href(llm),pref(llm),phiref(llm),pksref,pfact
      REAL pmer,airmer
      INTEGER ijmin,imin,jmin

      EXTERNAL RAN1
      REAL RAN1
      EXTERNAL iniconst,geopot,inigeom
      INTEGER aslun, cllun
      INTEGER ierr, nbetat
      INTEGER ISMIN
      external ISMIN

      CHARACTER*80 file
c
c-----------------------------------------------------------------------
c   initialisations:
c   ----------------
c

      rad=6400000.
      omeg=4.*asin(1.)/(24.*3600.)
      g=9.8
      mugaz=28.
      kappa=.2857
      day_step=180
      daysec=86400.

c-----------------------------------------------------------------------

      OPEN(99,file='run.def',status='old',form='formatted')
      CALL defrun(99)
      CLOSE (99)

      CALL iniconst
      CALL inigeom
      PRINT*,'dtvr ',dtvr
      idum=-1
      xx=RAN1(idum)
      idum=0

c-----------------------------------------------------------------------

      latfi(1)=rlatu(1)
      lonfi(1)=0.
      DO j=2,jjm
         DO i=1,iim
            latfi((j-2)*iim+1+i)=rlatu(j)
            lonfi((j-2)*iim+1+i)=rlonv(i)
         ENDDO
      ENDDO
      latfi(ngridmx)=rlatu(jjp1)
      lonfi(ngridmx)=0.
      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)

c-----------------------------------------------------------------------
c   lecture d'un fichier d'altitudes terrestre:
c   -------------------------------------------

      DO j=1,jjp1
         DO i=1,iip1
            rnatur(i,j)=0.
            phis(i,j)=0.
         ENDDO
      ENDDO

      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,rnatur,rnaturfi)
      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)

      CALL ini_fi(ngridmx,llm,
     $           0.,0.,
     $           daysec,
     $           0,0.,
     $           latfi,lonfi,airefi,phisfi,rnaturfi,
     $           rad,g,r,cpp,285.)
c
      DO 103 l=1,llm

         DO 104 j=1,jjp1
            DO 105 i=1,iim
               t(i,j,l)=285.
105         CONTINUE
104      CONTINUE

c        DO j=2,jjm
c           DO i=1,iim
c              t(i,j,l)=t(i,j,l)+COS(rlatu(j))*(RAN1(idum)-0.5)
c           ENDDO
c        ENDDO

         DO 108 j=1,jjp1
            t(iip1,j,l)=t(1,j,l)
108      CONTINUE

103   CONTINUE
c
c CALCUL DE L'EQUILIBRE HYDROSTATIQUE GLOBAL
c
      DO j=1,jjp1
         DO i=1,iim
            pext(i,j)=1013.*aire(i,j)
         ENDDO
      ENDDO

      CALL SCOPY(jjp1,pext,iip1,pext(iip1,1),iip1)
      CALL multipl(ip1jmp1,pext,unsaire,p)
      CALL uniplot(iip1,jjp1,p)
      CALL dump2d(iip1,jjp1,p,'pression naturelle au sol')
      PRINT*,imin,jmin


c-----------------------------------------------------------------------
c   On calcul h,ts,pks,pksf,pext:
c   -----------------------------
c
      DO l=1,llm
         DO j=1,jjp1
            DO i=1,iip1
               h(i,j,l) = t(i,j,l)*cpp/(s(l)*p(i,j)**kappa)
            ENDDO
         ENDDO
      ENDDO
c
      DO j=1,jjp1
         DO i=1,iip1
            pks(i,j) =p(i,j)**kappa
            pksf(i,j)=pks(i,j)
         ENDDO
      ENDDO
c
c-----------------------------------------------------------------------
c   calcul des champ de vent:
c   -------------------------
c
      DO l=1,llm
         DO i=1,iip1
            ucov(i,1,l)=0.
            ucov(i,jjp1,l)=0.
         ENDDO
         DO j=2,jjm
            DO i=1,iim
               ucov(i,j,l) =  0.
            ENDDO
            ucov(iip1,j,l)=ucov(1,j,l)
         ENDDO
      ENDDO
c
      DO l=1,llm
         DO j=1,jjm
            DO i=1,iim
               vcov(i,j,l) =  0.
            ENDDO
            vcov(iip1,j,l)=vcov(1,j,l)
         ENDDO
      ENDDO

c-----------------------------------------------------------------------
c   ecriture du fichier de demarage:
c   --------------------------------
c
      etot0=0.
      ptot0=0.
      stot0=0.
      ztot0=0.
      ang0=0.

      daysec=86400.
      unit=12
      ierr = aslun(unit,'start.dic',
     .             unit+1,'start.dat',IDRS_CREATE)
      if (ierr.ne.0) then
        write(6,*)' Pb d''ouverture du fichier restart'
        write(6,*)' ierr = ', ierr
        call exit(1)
      endif
      day0=0
      CALL iniwrite(unit,day0,phis)
      zz=0.
      call writedem(unit,nqmx,zz,vcov,ucov,h,q,pext,
     .                        phis,nbetat)
      ierr = cllun(unit)
      end