source: trunk/libf/dyn3dpar/ce0l.F90 @ 98

Last change on this file since 98 was 97, checked in by slebonnois, 14 years ago

Serie de modifs SL pour homogeneisation des phytitan et phyvenus
Ca touche aussi aux liens phy/dyn (surtout a propos de clesphy0),
a verifier avec les autres, donc...

File size: 3.7 KB
Line 
1!
2! $Id: ce0l.F90 1482 2011-02-09 15:03:09Z jghattas $
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
21  USE mod_phys_lmdz_para
22  USE mod_const_mpi
23  USE infotrac
24  USE parallel, ONLY: finalize_parallel
25
26#ifdef CPP_IOIPSL
27  USE ioipsl, ONLY: ioconf_calendar
28#endif
29
30#endif
31  IMPLICIT NONE
32#ifndef CPP_EARTH
33  WRITE(lunout,*)'limit_netcdf: Earth-specific routine, needs Earth physics'
34#else
35!-------------------------------------------------------------------------------
36! Local variables:
37  LOGICAL, PARAMETER :: interbar=.TRUE., extrap=.FALSE., oldice=.FALSE.
38#include "dimensions.h"
39#include "paramet.h"
40#include "indicesol.h"
41#include "iniprint.h"
42#include "temps.h"
43#include "logic.h"
44  REAL,    DIMENSION(iip1,jjp1) :: masque
45  CHARACTER(LEN=15)             :: calnd
46!-------------------------------------------------------------------------------
47  CALL conf_gcm( 99, .TRUE. )
48
49  CALL init_mpi
50
51  CALL Init_Phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
52  WRITE(lunout,*)'---> klon=',klon
53  IF (mpi_size>1 .OR. omp_size>1) THEN
54       CALL abort_gcm('ce0l','In parallel mode,                         &
55 &                 ce0l must be called only                             &
56 &                 for 1 process and 1 task',1)
57  ENDIF
58
59  CALL InitComgeomphy
60
61#ifdef CPP_IOIPSL
62  SELECT CASE(calend)
63    CASE('earth_360d');CALL ioconf_calendar('360d');      calnd='a 360 jours/an'
64    CASE('earth_365d');CALL ioconf_calendar('noleap');    calnd='a 365 jours/an'
65    CASE('earth_366d');CALL ioconf_calendar('366d');      calnd='bissextile'
66    CASE('gregorian'); CALL ioconf_calendar('gregorian'); calnd='gregorien'
67    CASE('standard');  CALL ioconf_calendar('gregorian'); calnd='gregorien'
68    CASE('julian');    CALL ioconf_calendar('julian');    calnd='julien'
69    CASE('proleptic_gregorian'); CALL ioconf_calendar('gregorian')
70  !--- DC Bof...  => IOIPSL a mettre a jour: proleptic_gregorian /= gregorian
71    CASE DEFAULT
72      CALL abort_gcm('ce0l','Mauvais choix de calendrier',1)
73  END SELECT
74  WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre '//TRIM(calnd)
75#endif
76
77  IF (config_inca /= 'none') THEN
78#ifdef INCA
79    CALL init_const_lmdz(nbtr,anneeref,dayref,iphysiq,day_step,nday)
80    CALL init_inca_para(iim,jjm+1,klon,1,klon_mpi_para_nb,0)
81    WRITE(lunout,*)'nbtr =' , nbtr
82#endif
83  END IF
84
85  WRITE(lunout,'(//)')
86  WRITE(lunout,*) '  *********************  '
87  WRITE(lunout,*) '  ***  etat0_netcdf ***  '
88  WRITE(lunout,*) '  *********************  '
89  WRITE(lunout,'(//)')
90  WRITE(lunout,*) ' interbar = ',interbar
91  CALL etat0_netcdf(interbar,masque,ok_etat0)
92
93  IF(ok_limit) THEN
94  WRITE(lunout,'(//)')
95  WRITE(lunout,*) '  *********************  '
96  WRITE(lunout,*) '  ***  Limit_netcdf ***  '
97  WRITE(lunout,*) '  *********************  '
98  WRITE(lunout,'(//)')
99  CALL limit_netcdf(interbar,extrap,oldice,masque)
100  END IF
101
102!$OMP MASTER
103  CALL finalize_parallel
104!$OMP END MASTER
105
106#endif
107! of #ifndef CPP_EARTH #else
108
109END PROGRAM ce0l
110!
111!-------------------------------------------------------------------------------
Note: See TracBrowser for help on using the repository browser.