ce0l.F90

Go to the documentation of this file.

!
! $Id: ce0l.F90 1615 2012-02-10 15:42:26Z emillour $
!
!-------------------------------------------------------------------------------
!
PROGRAM ce0l
!-------------------------------------------------------------------------------
! Purpose: Calls etat0, creates initial states and limit_netcdf
!
!     interbar=.T. for barycentric interpolation inter_barxy
!     extrap  =.T. for data extrapolation, like for the SSTs when file does not
!                  contain ocean points only.
!     oldice  =.T. for old-style ice, obtained using grille_m (grid_atob).
!     masque is created in etat0, passed to limit to ensure consistancy.
!-------------------------------------------------------------------------------
  USE control_mod
#ifdef CPP_EARTH
! This prog. is designed to work for Earth
  USE dimphy
  USE comgeomphy
  USE mod_phys_lmdz_para, mpi_root_xx=>mpi_root
  USE mod_const_mpi
  USE infotrac
  USE parallel, ONLY: finalize_parallel

#ifdef CPP_IOIPSL
  USE ioipsl, ONLY: ioconf_calendar
#endif

#endif
  IMPLICIT NONE
#ifndef CPP_EARTH
#include "iniprint.h"
  WRITE(lunout,*)'limit_netcdf: Earth-specific routine, needs Earth physics'
#else
!-------------------------------------------------------------------------------
! Local variables:
  LOGICAL, PARAMETER :: interbar=.true., extrap=.false., oldice=.false.
#include "dimensions.h"
#include "paramet.h"
#include "indicesol.h"
#include "iniprint.h"
#include "temps.h"
#include "logic.h"
#ifdef CPP_MPI
      include 'mpif.h'
#endif

  INTEGER, PARAMETER            :: longcles=20
  INTEGER                       :: ierr
  REAL,    DIMENSION(longcles)  :: clesphy0
  REAL,    DIMENSION(iip1,jjp1) :: masque
  CHARACTER(LEN=15)             :: calnd
  REAL,    DIMENSION(iip1,jjp1) :: phis ! geopotentiel au sol
!-------------------------------------------------------------------------------
  CALL conf_gcm( 99, .true. , clesphy0 )

#ifdef CPP_MPI
  CALL init_mpi
#endif

  CALL init_phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
  WRITE(lunout,*)'---> klon=',klon
  IF (mpi_size>1 .OR. omp_size>1) THEN
       CALL abort_gcm('ce0l',

'In parallel mode,                         & &                 ce0l must be called only                             & &                 for 1 process and 1 task',1)
  ENDIF

  CALL initcomgeomphy

#ifdef CPP_IOIPSL
  SELECT CASE(calend)
    CASE('earth_360d');CALL ioconf_calendar('360d');      calnd='a 360 jours/an'
    CASE('earth_365d');CALL ioconf_calendar('noleap');    calnd='a 365 jours/an'
    CASE('earth_366d');CALL ioconf_calendar('366d');      calnd='bissextile'
    CASE('gregorian'); CALL ioconf_calendar('gregorian'); calnd='gregorien'
    CASE('standard');  CALL ioconf_calendar('gregorian'); calnd='gregorien'
    CASE('julian');    CALL ioconf_calendar('julian');    calnd='julien'
    CASE('proleptic_gregorian'); CALL ioconf_calendar('gregorian')
  !--- DC Bof...  => IOIPSL a mettre a jour: proleptic_gregorian /= gregorian
    CASE default
      CALL abort_gcm('ce0l','Mauvais choix de calendrier',1)
  END SELECT
  WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre '//trim(calnd)
#endif

  IF (type_trac == 'inca') THEN
#ifdef INCA
      CALL init_const_lmdz( &
         nbtr,anneeref,dayref,&
         iphysiq,day_step,nday,& 
         nbsrf, is_oce,is_sic,&
         is_ter,is_lic)
      
#endif
  END IF

  WRITE(lunout,'(//)')
  WRITE(lunout,*) '  *********************  '
  WRITE(lunout,*) '  ***  etat0_netcdf ***  '
  WRITE(lunout,*) '  *********************  '
  WRITE(lunout,'(//)')
  WRITE(lunout,*) ' interbar = ',interbar
  CALL etat0_netcdf(interbar,masque,phis,ok_etat0)

  IF(ok_limit) THEN
  WRITE(lunout,'(//)')
  WRITE(lunout,*) '  *********************  '
  WRITE(lunout,*) '  ***  Limit_netcdf ***  '
  WRITE(lunout,*) '  *********************  '
  WRITE(lunout,'(//)')
  CALL limit_netcdf(interbar,extrap,oldice,masque)
  END IF

  IF (grilles_gcm_netcdf) THEN
     WRITE(lunout,'(//)')
     WRITE(lunout,*) '  ***************************  '
     WRITE(lunout,*) '  ***  grilles_gcm_netcdf ***  '
     WRITE(lunout,*) '  ***************************  '
     WRITE(lunout,'(//)')
     CALL grilles_gcm_netcdf_sub(masque,phis)
  END IF
  
#ifdef CPP_MPI
!$OMP MASTER
  CALL mpi_finalize(ierr)
  IF (ierr /= 0) CALL abort_gcm('ce0l','Error in MPI_FINALIZE',1)
!$OMP END MASTER
#endif

#endif
! of #ifndef CPP_EARTH #else

END PROGRAM ce0l
!
!-------------------------------------------------------------------------------