*=*=*=*= gcm.html =*=*=*=*
PROGRAM gcm

PROGRAM gcm


      PROGRAM gcm
      IMPLICIT NONE

c=======================================================================
c
c   Auteur:  P. Le Van
c   -------
c
c   Objet:
c   ------
c
c   GCM LMD nouvelle grille
c
c=======================================================================
c-----------------------------------------------------------------------
c   Declarations:
c   -------------

#include "dimensions.h"
#include "paramet.h"
      INTEGER nqmx
      PARAMETER(nqmx=1)
#include "comconst.h"
#include "comdissip.h"
#include "comvert.h"
#include "comgeom.h"
#include "logic.h"
#include "temps.h"
#include "control.h"
#include "ener.h"
#include "drsdef.h"
#include "description.h"

      INTEGER*4  iday ! jour julien
      REAL       time ! Heure de la journee en fraction d'1 jour
      REAL zdtvr
      INTEGER nbetatmoy, nbetatdem,nbetat
      INTEGER ierr, aslun, cllun

c   variables dynamiques
      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
      REAL h(ip1jmp1,llm)                    ! temperature potentielle
      REAL q(ip1jmp1,llm,nqmx)               ! champs advectes
      REAL pext(ip1jmp1)                     ! pression extensive
      REAL pks(ip1jmp1),pksf(ip1jmp1)        ! exner (f pour filtre)
      REAL phis(ip1jmp1)                     ! geopotentiel au sol
      REAL phi(ip1jmp1,llm)                  ! geopotentiel
      REAL w(ip1jmp1,llm)                    ! vitesse verticale

c   variables dynamiques au pas -1
      REAL vcovm1(ip1jm,llm),ucovm1(ip1jmp1,llm)
      REAL hm1(ip1jmp1,llm),pextm1(ip1jmp1)
c z.x.li      REAL qm1(ip1jmp1,llm,nqmx)

c   tendances dynamiques
      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
      REAL dh(ip1jmp1,llm),dq(ip1jmp1,llm,nqmx),dp(ip1jmp1)

c   tendances de la dissipation
      REAL dvdis(ip1jm,llm),dudis(ip1jmp1,llm)
      REAL dhdis(ip1jmp1,llm)

c   tendances physiques
      REAL dvfi(ip1jm,llm),dufi(ip1jmp1,llm)
      REAL dhfi(ip1jmp1,llm),dqfi(ip1jmp1,llm,nqmx),dpfi(ip1jmp1)

c   variables pour le fichier histoire
      REAL dtav      ! intervalle de temps elementaire

      INTEGER taphistd,taprstar,taphmoy,tapphys

      INTEGER itau,itaufinp1,iav

      EXTERNAL caldyn
      EXTERNAL dissip,geopot,iniconst,inifilr,ecriba
      EXTERNAL integrd,lectba,SCOPY
      EXTERNAL iniav,writeav
      EXTERNAL inigeom
      EXTERNAL exner,addit

      REAL time_0

      LOGICAL startdrs

c-----------------------------------------------------------------------
c   Initialisations:
c   ----------------

c quelques constantes pour la dissipation
      tetavel=30000.
      tetatemp=30000.
      niterdis=2
      lstardis=.false.
      grireg=.true.
      startdrs=.true.
      descript='Test DRS sur testdyn'

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

      CALL lectba(startdrs,nqmx,vcov,ucov,h,q,pext,phis,time_0)
      CALL defrun(5)

c  on recalcule eventuellement le pas de temps
      IF(MOD(day_step,iperiod).NE.0)
     sSTOP'Il faut choisir un nb de pas par jour multiple de iperiod'
      zdtvr    = daysec/float(day_step)
      IF(dtvr.NE.zdtvr) THEN
         PRINT*,'WARNING!!! changement de pas de temps',dtvr,'>',zdtvr
      ENDIF

c  nombre d'etats dans les fichiers demarrage et histoire
      nbetatdem = nday / iecri
      nbetatmoy = nday / periodav + 1

      dtvr=zdtvr
      CALL iniconst
      CALL inigeom

      IF(grireg) CALL inifilr
      CALL inidissip(lstardis,niterdis,tetavel,tetatemp)

      CALL exner(ip1jmp1,pext,aire,pks,pksf)

c  numero de stockage pour les fichiers de redemarrage:
      taphistd=10
      tapphys=12
      taprstar=15
      taphmoy=20

c  ouverture DRS des fichiers de stockage
      IF(startdrs) THEN
         ierr = aslun(taphistd,'histoire.dic',
     .             taphistd+1,'histoire.dat',IDRS_CREATE)
      ELSE
         PRINT*,'Ouverture binaire',taphistd
         OPEN(taphistd,file='histoire',form='unformatted',
     .   status='new',iostat=ierr)
      ENDIF
      if (ierr.ne.0) then
        write(6,*)' Pb d''ouverture du fichier histoire (rdem)'
        write(6,*)' ierr = ', ierr
        call exit(1)
      endif
      IF(startdrs) THEN
         ierr = aslun(taprstar,'restart.dic',
     .             taprstar+1,'restart.dat',IDRS_CREATE)
      ELSE
         OPEN(taprstar,file='restart',form='unformatted',
     .   status='new',iostat=ierr)
      ENDIF
      if (ierr.ne.0) then
        write(6,*)' Pb d''ouverture du fichier restart'
        write(6,*)' ierr = ', ierr
        call exit(1)
      endif
      ierr = aslun(taphmoy,'histmoy.dic',
     .             taphmoy+1,'histmoy.dat',IDRS_CREATE)
      if (ierr.ne.0) then
        write(6,*)' Pb d''ouverture du fichier restart'
        write(6,*)' ierr = ', ierr
        call exit(1)
      endif

      ierr = aslun(tapphys,'histphy.dic',
     .             tapphys+1,'histphy.dat',IDRS_CREATE)
      if (ierr.ne.0) then
        write(6,*)' Pb d''ouverture du fichier physique'
        write(6,*)' ierr = ', ierr
        call exit(1)
      endif

c-----------------------------------------------------------------------
c   temps de depart et de fin:
c   --------------------------

      itau=0
      iday=day_ini+itau/day_step
      time=FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
      IF(time.GT.1.) THEN
         time=time-1.
         iday=iday+1
      ENDIF
      itaufin   = nday*day_step
      itaufinp1 = itaufin +1

      day_end=day_ini+nday
      PRINT 300, itau,itaufin,day_ini,day_end

      CALL iniwrite(taphistd,startdrs,day_ini,phis)
      CALL iniwrite(tapphys,startdrs,day_ini,phis)
      CALL iniwrite(taprstar,startdrs,day_end,phis)

      ecripar = .true.

      dtav=iperiod*dtvr/daysec
      CALL iniav(taphmoy,day_ini,0.,periodav,phis)

c-----------------------------------------------------------------------
c   Debut de l'integration temporelle:
c   ----------------------------------

   1  CONTINUE
      CALL SCOPY( ijmllm,vcov,1,vcovm1,1 )
      CALL SCOPY( ijp1llm,ucov,1,ucovm1,1 )
      CALL SCOPY( ijp1llm,h,1,hm1,1 )
c z.x.li      CALL SCOPY( ijp1llm*nqmx,q,1,qm1,1 )
      CALL SCOPY( ip1jmp1,pext,1,pextm1,1 )
      forward = .true.
      leapf   = .false.
      dt      = dtvr

   2  CONTINUE

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

c   date:
c   -----


c   gestion des appels de la physique et des dissipations:
c   ------------------------------------------------------

      apphys = .false.
      statcl = .false.
      conser = .false.
      apdiss = .false.
      IF( purmats ) THEN
         IF( MOD(itau,iconser) .eq.0.AND.  forward    ) conser = .true.
         IF( MOD(itau,idissip ).eq.0.AND..NOT.forward ) apdiss = .true.
         IF( MOD(itau,iphysiq ).eq.0.AND.  forward
     $                             .AND.    physic    ) apphys = .true.
      ELSE
         IF( MOD(itau   ,iconser) .eq. 0             ) conser = .true.
         IF( MOD(itau+1,idissip) .eq. 0             ) apdiss = .true.
         IF( MOD(itau,iphysiq).eq.0.AND.forward
     $                             .AND.    physic    ) apphys = .true.
      END IF

c-----------------------------------------------------------------------
c   calcul des tendances dynamiques:
c   --------------------------------

      CALL geopot  (ip1jmp1, h     , pks   , phis    , phi          )
      CALL caldyn
     $ (nqmx,itau,ucov,vcov,h,q,pext,pks,pksf,phis,
     $  phi,conser,du,dv,dh,dp,dq,w,
     $  time+iday-day_ini)

c-----------------------------------------------------------------------
c   calcul des tendances physiques:
c   -------------------------------

      IF(apphys)  CALL calfis(nqmx,itau.EQ.0,itau+iphysiq.EQ.itaufin,
     $                       iday,0.,
     $                       ucov,vcov,h,q,pext,pks,phis,phi,
     $                       du,dv,dh,dq,w,
     $                       dufi,dvfi,dhfi,dqfi,dpfi)

c=======================================================================
c
c-----------------------------------------------------------------------
c   integrations dynamique:
c   -----------------------

      CALL integrd
     $ ( nqmx,vcovm1,ucovm1,hm1,pextm1,
c z.x.li     $ ( nqmx,vcovm1,ucovm1,hm1,qm1,pextm1,
     $   dv,du,dh,dq,dp,
     $   vcov,ucov,h,q,pext,phis )

c-----------------------------------------------------------------------
c   ajout des tendances physiques:
c   ------------------------------
c    Ajout des tendances  a chaque  pas d'integration  ....

      IF(physic) CALL addfi( nqmx,dt, leapf, forward,
     s           ucov, vcov, h , q   ,pext,
     s           dufi, dvfi, dhfi , dqfi ,dpfi)

      CALL exner(ip1jmp1,pext,aire,pks,pksf)

c-----------------------------------------------------------------------
c   dissipation horizontal et verticales des petites echelles:
c   ----------------------------------------------------------

      IF(apdiss) THEN
         CALL dissip(vcov,ucov,h,dvdis,dudis,dhdis)
         CALL addit(ijp1llm,ucov,dudis,ucov)
         CALL addit(ijmllm,vcov,dvdis,vcov)
         CALL addit(ijp1llm,h,dhdis,h)
      END IF


c   ********************************************************************
c   ********************************************************************
c   .... fin de l'integration dynamique  et physique pour le pas itau ..
c   ********************************************************************
c   ********************************************************************

c   preparation du pas d'integration suivant  ......

      IF ( .not.purmats ) THEN
c       ........................................................
c       ..............  schema matsuno + leapfrog  ..............
c       ........................................................

            IF(forward. OR. leapf) THEN
               itau= itau + 1
               iday=day_ini+itau/day_step
               time=FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
               IF(time.GT.1.) THEN
                  time=time-1.
                  iday=iday+1
               ENDIF
            ENDIF


            IF( itau. eq. itaufinp1 )    STOP

c-----------------------------------------------------------------------
c   ecriture du fichier histoire moyenne:
c   -------------------------------------

            IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
               IF(itau.EQ.itaufin) THEN
                  iav=1
               ELSE
                  iav=0
               ENDIF
               CALL writeav(nqmx,dtav,time+iday-day_ini
     .         ,ucov,vcov,h,q,pext,iav)
            ENDIF

c-----------------------------------------------------------------------
c   ecriture de la bande histoire:
c   ------------------------------

            IF( MOD(itau,iecri*day_step).eq.0) THEN
               nbetat = nbetatdem
               call writedem(taphistd,nqmx,startdrs,time+iday-day_ini,
     .                        vcov,ucov,h,q,pext,
     .                        phis,nbetat)
            ENDIF
            IF(itau.EQ.itaufin) THEN
               call writedem(taprstar,nqmx,startdrs,0.,vcov,ucov,h,q,
     .         pext,phis, 1)
               CLOSE(99)
               OPEN(99,file='champ_fin',form='unformatted',status='new')
               WRITE(99) ucov,vcov,h,pext,phis
               CLOSE(99)
            ENDIF

c-----------------------------------------------------------------------
c   gestion de l'integration temporelle:
c   ------------------------------------

            IF( MOD(itau,iperiod).eq.0 )    THEN
                  GO TO 1
            ELSE IF ( MOD(itau-1,iperiod). eq. 0 ) THEN

                   IF( forward )  THEN
c      fin du pas forward et debut du pas backward

                      forward = .false.
                        leapf = .false.
                         GO TO 2

                   ELSE
c      fin du pas backward et debut du premier pas leapfrog

                        leapf =  .true.
                        dt  =  2.*dtvr
                        GO TO 2
                   END IF
            ELSE

c      ......   pas leapfrog  .....

                 leapf = .true.
                 dt  = 2.*dtvr
                 GO TO 2
            END IF

      ELSE

c       ........................................................
c       ..............       schema  matsuno        ...............
c       ........................................................
            IF( forward )  THEN
               itau=  itau + 1
               iday=day_ini+itau/day_step
               time=FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
               IF(time.GT.1.) THEN
                  time=time-1.
                  iday=iday+1
               ENDIF
               forward =  .false.
               IF( itau. eq. itaufinp1 )    STOP
               GO TO 2
            ELSE
               IF(MOD(itau,iecri*day_step).EQ.0) THEN
                  nbetat = nbetatdem
                  call writedem(taphistd,nqmx,startdrs,
     .            time+iday-day_ini,
     .                           vcov,ucov,h,q,pext,
     .                           phis,nbetat)

               ENDIF
               IF(itau.EQ.itaufin)
     .         call writedem(taprstar,nqmx,startdrs,0.,vcov,ucov,h,q
     .         ,pext,phis,1)
               forward = .true.
               GO TO  1
            ENDIF

      END IF
      ierr = cllun(taphistd)
      ierr = cllun(taprstar)
      ierr = cllun(taphmoy)


 300  FORMAT('1'/15x'run du pas'i7,2x,'au pas'i7,2x,  'c"est a dire du
     * jour'f5.0,3x'au jour'f5.0//)
          STOP
          END