source: LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/replay1d.F90

PROGRAM rejouer

USE mod_const_mpi, ONLY: comm_lmdz
USE inigeomphy_mod, ONLY: inigeomphy
USE comvert_mod, ONLY: presnivs
USE comvert_mod, only :  preff, pa
USE ioipsl, only: getin




      implicit none
#include "dimensions.h"

real :: airefi
real :: zcufi    = 1.
real :: zcvfi    = 1.
real :: rlat_rad(1),rlon_rad(1)

integer ntime
integer jour0,mois0,an0,day_step,anneeref,dayref
integer klev,klon
CHARACTER (len=10) :: calend
CHARACTER(len=20) :: calendrier


!---------------------------------------------------------------------
! L'appel a inigeomphy n'est utile que pour avoir getin_p dans 
! les initialisations
!---------------------------------------------------------------------
  zcufi=1.
  zcvfi=1.
  rlat_rad(1)=0.
  rlon_rad(1)=0.

preff=101325.
!preff=100000.
pa=50000.
  CALL disvert()
  CALL inigeomphy(1,1,llm, &
               1, comm_lmdz, &
           (/rlat_rad(1),0./),(/0./), &
           (/0.,0./),(/rlon_rad(1),0./),  &
           (/ (/airefi,0./),(/0.,0./) /), &
           (/zcufi,0.,0.,0./), &
           (/zcvfi,0./))

CALL suphel
!ntime=4320
ntime=10000000
dayref=1
anneeref=2000
call getin('dayref',dayref)
call getin('anneeref',anneeref)
call getin('calend',calend)
call getin('day_step',day_step)
calendrier=calend
if ( calendrier == "earth_360d" ) calendrier="360_day"


jour0=dayref
mois0=(jour0-1)/30+1
jour0=jour0-30*((jour0-1)/30)
an0=anneeref

!print*,"REPLAY1D jour0,mois0,an0",jour0,mois0,an0


klon=1
klev=llm
call iotd_ini('phys.nc',1,1,klev,0.,0.,presnivs,jour0,mois0,an0,0.,86400./day_step,calendrier)
! Consistent with ... CALL iophys_ini(600.)

!---------------------------------------------------------------------
! Initialisation de la parametrisation
!---------------------------------------------------------------------
call get_ini_module

!---------------------------------------------------------------------
! Boucle en temps sur l'appel à la parametrisation
!---------------------------------------------------------------------
call call_param_replay(klon,klev)

end

!---------------------------------------------------------------------
!/////////////////////////////////////////////////////////////////////
!/////////////////////////////////////////////////////////////////////
!     routine additionnelles utiles, prises dans 1DUTILS.h
!/////////////////////////////////////////////////////////////////////
!/////////////////////////////////////////////////////////////////////
!---------------------------------------------------------------------

!=======================================================================
      SUBROUTINE abort_gcm(modname, message, ierr)
      USE IOIPSL
! Stops the simulation cleanly, closing files and printing various
! comments
!=======================================================================
!
!  Input: modname = name of calling program
!         message = stuff to print
!         ierr    = severity of situation ( = 0 normal )
 
      character(len=*) modname
      integer ierr
      character(len=*) message
 
      write(*,*) 'in abort_gcm'
      call histclo
      write(*,*) 'out of histclo'
      write(*,*) 'Stopping in ', modname
      write(*,*) 'Reason = ',message
      call getin_dump
!
      if (ierr .eq. 0) then
        write(*,*) 'Everything is cool'
      else
        write(*,*) 'Houston, we have a problem ', ierr
      endif
      STOP
      END

!=======================================================================
      SUBROUTINE gr_dyn_fi(nfield,im,jm,ngrid,pdyn,pfi)
      IMPLICIT NONE
!   passage d'un champ de la grille scalaire a la grille physique
!=======================================================================
 
!-----------------------------------------------------------------------
!   declarations:
!   -------------
 
      INTEGER im,jm,ngrid,nfield
      REAL pdyn(im,jm,nfield)
      REAL pfi(ngrid,nfield)
 
      INTEGER j,ifield,ig
 
!-----------------------------------------------------------------------
!   calcul:
!   -------
 
      IF(ngrid.NE.2+(jm-2)*(im-1).AND.ngrid.NE.1)                          &
     &    STOP 'probleme de dim'
!   traitement des poles
      CALL SCOPY(nfield,pdyn,im*jm,pfi,ngrid)
      CALL SCOPY(nfield,pdyn(1,jm,1),im*jm,pfi(ngrid,1),ngrid)
 
!   traitement des point normaux
      DO ifield=1,nfield
         DO j=2,jm-1
            ig=2+(j-2)*(im-1)
            CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1)
         ENDDO
      ENDDO
 
      RETURN
      END