source: LMDZ5/branches/testing/libf/dyn3dmem/ce0l.F90 @ 1856

Last change on this file since 1856 was 1795, checked in by Ehouarn Millour, 11 years ago

Version testing basee sur la r1794


Testing release based on r1794

File size: 4.3 KB
RevLine 
[1658]1!
[1707]2! $Id$
[1658]3!
4!-------------------------------------------------------------------------------
5!
6PROGRAM ce0l
7!-------------------------------------------------------------------------------
8! Purpose: Calls etat0, creates initial states and limit_netcdf
9!
10!     interbar=.T. for barycentric interpolation inter_barxy
11!     extrap  =.T. for data extrapolation, like for the SSTs when file does not
12!                  contain ocean points only.
13!     oldice  =.T. for old-style ice, obtained using grille_m (grid_atob).
14!     masque is created in etat0, passed to limit to ensure consistancy.
15!-------------------------------------------------------------------------------
16  USE control_mod
17#ifdef CPP_EARTH
18! This prog. is designed to work for Earth
19  USE dimphy
20  USE comgeomphy
[1707]21  USE mod_phys_lmdz_para, mpi_root_xx=>mpi_root
[1658]22  USE mod_const_mpi
23  USE infotrac
[1707]24  USE parallel, ONLY: finalize_parallel
[1795]25  USE indice_sol_mod
[1658]26
27#ifdef CPP_IOIPSL
28  USE ioipsl, ONLY: ioconf_calendar
29#endif
30
31#endif
32  IMPLICIT NONE
33#ifndef CPP_EARTH
[1707]34#include "iniprint.h"
[1658]35  WRITE(lunout,*)'limit_netcdf: Earth-specific routine, needs Earth physics'
36#else
37!-------------------------------------------------------------------------------
38! Local variables:
39  LOGICAL, PARAMETER :: interbar=.TRUE., extrap=.FALSE., oldice=.FALSE.
40#include "dimensions.h"
41#include "paramet.h"
[1795]42!#include "indicesol.h"
[1658]43#include "iniprint.h"
44#include "temps.h"
45#include "logic.h"
[1707]46#ifdef CPP_MPI
47      include 'mpif.h'
48#endif
49
[1658]50  INTEGER, PARAMETER            :: longcles=20
[1707]51  INTEGER                       :: ierr
[1658]52  REAL,    DIMENSION(longcles)  :: clesphy0
53  REAL,    DIMENSION(iip1,jjp1) :: masque
54  CHARACTER(LEN=15)             :: calnd
[1707]55  REAL,    DIMENSION(iip1,jjp1) :: phis ! geopotentiel au sol
[1658]56!-------------------------------------------------------------------------------
57  CALL conf_gcm( 99, .TRUE. , clesphy0 )
58
[1707]59#ifdef CPP_MPI
[1658]60  CALL init_mpi
[1707]61#endif
[1658]62
63  CALL Init_Phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
64  WRITE(lunout,*)'---> klon=',klon
65  IF (mpi_size>1 .OR. omp_size>1) THEN
66       CALL abort_gcm('ce0l','In parallel mode,                         &
67 &                 ce0l must be called only                             &
[1707]68 &                 for 1 process and 1 task',1)
[1658]69  ENDIF
70
71  CALL InitComgeomphy
72
73#ifdef CPP_IOIPSL
74  SELECT CASE(calend)
75    CASE('earth_360d');CALL ioconf_calendar('360d');      calnd='a 360 jours/an'
76    CASE('earth_365d');CALL ioconf_calendar('noleap');    calnd='a 365 jours/an'
77    CASE('earth_366d');CALL ioconf_calendar('366d');      calnd='bissextile'
78    CASE('gregorian'); CALL ioconf_calendar('gregorian'); calnd='gregorien'
79    CASE('standard');  CALL ioconf_calendar('gregorian'); calnd='gregorien'
80    CASE('julian');    CALL ioconf_calendar('julian');    calnd='julien'
81    CASE('proleptic_gregorian'); CALL ioconf_calendar('gregorian')
82  !--- DC Bof...  => IOIPSL a mettre a jour: proleptic_gregorian /= gregorian
83    CASE DEFAULT
84      CALL abort_gcm('ce0l','Mauvais choix de calendrier',1)
85  END SELECT
86  WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre '//TRIM(calnd)
87#endif
88
[1707]89  IF (type_trac == 'inca') THEN
[1658]90#ifdef INCA
[1707]91      CALL init_const_lmdz( &
92         nbtr,anneeref,dayref,&
93         iphysiq,day_step,nday,&
94         nbsrf, is_oce,is_sic,&
95         is_ter,is_lic)
96     
[1658]97#endif
98  END IF
99
100  WRITE(lunout,'(//)')
101  WRITE(lunout,*) '  *********************  '
102  WRITE(lunout,*) '  ***  etat0_netcdf ***  '
103  WRITE(lunout,*) '  *********************  '
104  WRITE(lunout,'(//)')
105  WRITE(lunout,*) ' interbar = ',interbar
[1707]106  CALL etat0_netcdf(interbar,masque,phis,ok_etat0)
[1658]107
108  IF(ok_limit) THEN
109  WRITE(lunout,'(//)')
110  WRITE(lunout,*) '  *********************  '
111  WRITE(lunout,*) '  ***  Limit_netcdf ***  '
112  WRITE(lunout,*) '  *********************  '
113  WRITE(lunout,'(//)')
114  CALL limit_netcdf(interbar,extrap,oldice,masque)
115  END IF
116
[1707]117  IF (grilles_gcm_netcdf) THEN
118     WRITE(lunout,'(//)')
119     WRITE(lunout,*) '  ***************************  '
120     WRITE(lunout,*) '  ***  grilles_gcm_netcdf ***  '
121     WRITE(lunout,*) '  ***************************  '
122     WRITE(lunout,'(//)')
123     CALL grilles_gcm_netcdf_sub(masque,phis)
124  END IF
125 
126#ifdef CPP_MPI
127!$OMP MASTER
128  CALL MPI_FINALIZE(ierr)
129  IF (ierr /= 0) CALL abort_gcm('ce0l','Error in MPI_FINALIZE',1)
130!$OMP END MASTER
[1658]131#endif
[1707]132
133#endif
[1658]134! of #ifndef CPP_EARTH #else
135
136END PROGRAM ce0l
137!
138!-------------------------------------------------------------------------------
Note: See TracBrowser for help on using the repository browser.