*=*=*=*= inimars.html =*=*=*=*
PROGRAM inimars

PROGRAM inimars


      PROGRAM inimars
      IMPLICIT NONE

c=======================================================================
c
c   creation d'un etat initial pour le GCM martien
c     (fichiers DRS start et startfi)
c
c=======================================================================
c
c-----------------------------------------------------------------------
c   declarations:
c   -------------

#include "dimensions.h"
#include "paramet.h"
#include "comconst.h"
#include "comvert.h"
#include "comgeom2.h"
#include "control.h"
#include "logic.h"
#include "drsdef.h"
#include "description.h"
#include "ener.h"
c----------------------------
#include "../phymars/dimphys.h"
c-----------------------------

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)
      REAL w(iip1,jjp1,llm+1)

      REAL q(iip1,jjp1,llm,nqmx)               ! champs advectes
      INTEGER iq
      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)


      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
      REAL dh(ip1jmp1,llm),dp(ip1jmp1)

      REAL z_reel(iip1,jjp1)
      REAL phisfi(ngridmx),rnaturfi(ngridmx)
      REAL alb(iip1,jjp1),albfi(ngridmx)
      REAL ith(iip1,jjp1),ithfi(ngridmx)
      REAL latfi(ngridmx),lonfi(ngridmx),airefi(ngridmx)



      REAL tsurf(ngridmx),tsoil(ngridmx,nsoilmx),co2ice(ngridmx)
c
      INTEGER i,j,l,ig,idum
      INTEGER*4 day0
      INTEGER unit
      REAL p(iip1,jjp1),zz,xx
      REAL t(iip1,jjp1,llm)
      REAL phi(iip1,jjp1,llm)
      REAL pressrf
      REAL year_day,periheli,aphelie,peri_day
      REAL obliquit,z0,emin_turb,lmixmin
      REAL emissiv,emisice(2),albedice(2),tauvis,tauir,scatalb,asfact


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

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

      LOGICAL startdrs
      CHARACTER*80 file, datapath


c
c *********************************************************************
c   Valeurs des variables parametre du GCM martien
c *********************************************************************


c Pression de reference sur la planete
c ------------------------------------
      pressrf = 651.245         !  Pression de reference (Pa) ~650


c Info sur la Planete Mars pour la dynamique et la physique
c ---------------------------------------------------------

      rad=3397200.              ! rayon de mars (m)  ~3397200 m
      daysec=88775.             ! duree du sol (s)  ~88775 s
      omeg=4.*asin(1.)/(daysec) ! vitesse de rotation (rad.s-1)
      g=3.72                    ! gravite (m.s-2) ~3.72
      mugaz=43.49               ! Masse molaire de l'atm (g.mol-1) ~43.49
      kappa=.256793             ! = r/cp  ~0.256793

c Info sur la Planete Mars pour la physique uniquement
c ----------------------------------------------------
      year_day = 668.6          ! duree de l'annee (sols) ~668.6
      periheli = 206.66         ! dist.min. soleil-mars (Mkm) ~206.66
      aphelie = 249.22          ! dist.llm. soleil-mars (Mkm) ~249.22
      peri_day =  485.          ! date du perihelie (sols depuis printemps)
      obliquit = 23.98          ! Obliquite de la planete (deg) ~23.98

c Couche limite et Turbulence
c ---------------------------
      z0 =  1.e-2               ! surface roughness (m) ~0.01
      emin_turb = 1.e-6          ! energie minimale ~1.e-8
      lmixmin = 30              ! longueur de melange ~100

c propriete optiques des calottes et emissivite du sol
c ----------------------------------------------------

      emissiv=.95                ! Emissivite du sol martien ~.95
      emisice(1)=0.53            ! Emissivite calotte nord
      emisice(2)=0.66            ! Emissivite calotte sud
      albedice(1)=0.58           ! Albedo calotte nord
      albedice(2)=0.41           ! Albedo calotte sud

c Proprietes des poussiere aerosol
c --------------------------------

      tauvis= 0.2           ! profondeur optique visible moyenne
      tauir=0.2              !ratio (mean IR opt.depth)/visible
      scatalb=.86            ! scaterring albedo visible (~.86)
      asfact=.79             ! assymetrie factor visible   (~.79)


c Chemin pour trouver les donnees de surface (albedo, relief, th.inertia...)
c -------------------------------------------------------------------------
      datapath = '/dw/chourdin/MARS/data_mars'


c *********************************************************************
c   Main program
c *********************************************************************

c Initialisations diverses
c ------------------------

      day_step=180
      startdrs=.true.

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

      CALL defrun_new( .FALSE. )

      CALL iniconst
      CALL inigeom
c     write (*,*) 'ds main 1, cu=', cu   ! INFO
c     write (*,*) 'ds main 1, aire =', aire ! INFO

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


c Initialition coordonnees /aires
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 de la topographie
c   ----------------------------------

c   creation du fichier des altitudes.
      file=datapath(1:lnblnk(datapath))//'/relief.lmd'
      CALL initial0(ip1jmp1,z_reel)
      CALL dataread(file,z_reel)
c     CALL uniplot(iip1,jjp1,z_reel)
      DO j=1,jjp1
         DO i=1,iip1
            z_reel(i,j)=1000.*z_reel(i,j)
         ENDDO
         WRITE(6,'(64i1)') (NINT(10.*z_reel(i,j)),i=1,iip1)
      ENDDO
C     CALL uniplot(iip1,jjp1,z_reel)
      CALL dump2d(iip1,jjp1,z_reel,'Altitude en m')
      CALL multscal(ip1jmp1,z_reel,g,phis)
      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)

c   lecture de l'albedo
c   -------------------
      file=datapath(1:lnblnk(datapath))//'/albedo.lmd'
      CALL dataread(file,alb)
      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)

c   lecture de l'inertie thermique
c   ------------------------------
      file=datapath(1:lnblnk(datapath))//'/thermal.lmd'
      CALL dataread(file,ith)
      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ith,ithfi)

c   Temperature de surface, Glace CO2
c   ---------------------------------

      DO ig=1,ngridmx
         tsurf(ig)=200.
         co2ice(ig)=0.
      ENDDo

c   Temperature du sous-sol
c --------------------------
      DO l=1,nsoilmx
         DO ig=1,ngridmx
            tsoil(ig,l)=tsurf(ig)
         ENDDO
      ENDDO



c    Initialisation de la physique / ecriture de startfi :
c    ---------------------------------------------------

      CALL ini_fi(ngridmx,llm,startdrs,
     $           0.,0.,daysec, 0,0.,
     $           latfi,lonfi,airefi,phisfi,rnaturfi,
     $           albfi,ithfi,
     $           rad,g,r,cpp,mugaz,omeg,tsurf,tsoil,co2ice,
     $           year_day,periheli,aphelie,peri_day,
     $           obliquit,z0,emin_turb,lmixmin,
     $           emissiv,emisice,albedice,
     $           tauvis,tauir,scatalb,asfact)

c

c    Initialisation temperatures atmospheriques
c    ------------------------------------------

      DO l=1,llm

         DO  j=1,jjp1
            DO  i=1,iim
               t(i,j,l)=200.
            END DO
         END DO

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 j=1,jjp1
            t(iip1,j,l)=t(1,j,l)
         END DO

      END DO
c
c CALCUL DE L'EQUILIBRE HYDROSTATIQUE GLOBAL (initialisation pext)
c -----------------------------------------------------------------
c   on commence par calculer le champ de pression pour une pression
c   au sol arbitraire 1mb

      ijmin=ISMIN(ip1jmp1,phis,1)
      jmin=(ijmin-1)/iip1+1
      imin=ijmin-(jmin-1)*iip1
      DO l=1,llm
         href(l)=t(imin,jmin,l)*cpp/s(l)
         pref(l)=s(l)**(1./kappa)
      ENDDO
      pksref=1.
      CALL geopot(1,href,pksref,phis(imin,jmin),phiref)

      DO j=1,jjp1
         DO i=1,iim
            CALL interpol(phiref,pref,llm,phis(i,j),p(i,j),1)
         ENDDO
      ENDDO
c     p(imin,jmin)=1.

      DO j=1,jjp1
         DO i=1,iim
            pext(i,j)=p(i,j)*aire(i,j)
         ENDDO
      ENDDO

      airtot=0.
      ptot=0.
      DO j=1,jjp1
         DO i=1,iim
            airtot=airtot+aire(i,j)
            ptot=ptot+pext(i,j)
         ENDDO
      ENDDO

      pfact=pressrf*airtot/ptot

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


c-----------------------------------------------------------------------
c   Initialisation  h,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   Initialisation    des champ de traceur:
c   ---------------------------
      DO iq =1, nqmx
       DO l=1,llm
          DO j=1,jjp1
             DO i=1,iim
               q(i,j,l,iq)=0.
             ENDDO
          ENDDO
       ENDDO
      ENDDO


c-----------------------------------------------------------------------
c   ecriture du fichier de demarage: start
c   --------------------------------------
c
      CALL inifilr
      CALL exner(ip1jmp1,pext,aire,pks,pksf)
      CALL geopot  (ip1jmp1, h     , pks   , phis    , phi          )
      CALL caldyn
     $ (0,ucov,vcov,h,pext,pks,pksf,phis,
     $  phi,.true.,du,dv,dh,dp,w, pbaru,pbarv,0.)


      PRINT*,'ptot,rmsdpdt,etot,ztot,stot,rmsv,ang'
      PRINT *, ptot,rmsdpdt,etot,ztot,stot,rmsv,ang

c-----------------------------------------------------------------------
      unit=12
      IF(startdrs) THEN
         ierr = aslun(unit,'start.dic',
     .             unit+1,'start.dat',IDRS_CREATE)
      ELSE
         OPEN(unit,file='start',form='unformatted',status='new',
     .   iostat=ierr)
      ENDIF
      if (ierr.ne.0) then
        write(6,*)' Pb de creation du fichier start. Existe deja ?'
        write(6,*)' ierr = ', ierr
        call exit(1)
      endif
      day0=0
      CALL iniwrite(unit,startdrs,day0,phis)
      zz=0.
      call WRITEDEM(unit,nqmx,startdrs,zz,vcov,ucov,h,q,pext,
     .                        phis,nbetat)
      ierr = cllun(unit)
      end