My Project
 All Classes Files Functions Variables Macros
ce0l.F90
Go to the documentation of this file.
1 !
2 ! $Id$
3 !
4 !-------------------------------------------------------------------------------
5 !
6 PROGRAM 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, mpi_root_xx=>mpi_root
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 #include "iniprint.h"
34  WRITE(lunout,*)'limit_netcdf: Earth-specific routine, needs Earth physics'
35 #else
36 !-------------------------------------------------------------------------------
37 ! Local variables:
38  LOGICAL, PARAMETER :: interbar=.true., extrap=.false., oldice=.false.
39 #include "dimensions.h"
40 #include "paramet.h"
41 #include "indicesol.h"
42 #include "iniprint.h"
43 #include "temps.h"
44 #include "logic.h"
45 #ifdef CPP_MPI
46  include 'mpif.h'
47 #endif
48 
49  INTEGER, PARAMETER :: longcles=20
50  INTEGER :: ierr
51  REAL, DIMENSION(longcles) :: clesphy0
52  REAL, DIMENSION(iip1,jjp1) :: masque
53  CHARACTER(LEN=15) :: calnd
54  REAL, DIMENSION(iip1,jjp1) :: phis ! geopotentiel au sol
55 !-------------------------------------------------------------------------------
56  CALL conf_gcm( 99, .true. , clesphy0 )
57 
58 #ifdef CPP_MPI
59  CALL init_mpi
60 #endif
61 
62  CALL init_phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
63  WRITE(lunout,*)'---> klon=',klon
64  IF (mpi_size>1 .OR. omp_size>1) THEN
65  CALL abort_gcm('ce0l',
66 
67 'In parallel mode, & & ce0l must be called only & & for 1 process and 1 task',1)
68  ENDIF
69 
70  CALL initcomgeomphy
71 
72 #ifdef CPP_IOIPSL
73  SELECT CASE(calend)
74  CASE('earth_360d');CALL ioconf_calendar('360d'); calnd='a 360 jours/an'
75  CASE('earth_365d');CALL ioconf_calendar('noleap'); calnd='a 365 jours/an'
76  CASE('earth_366d');CALL ioconf_calendar('366d'); calnd='bissextile'
77  CASE('gregorian'); CALL ioconf_calendar('gregorian'); calnd='gregorien'
78  CASE('standard'); CALL ioconf_calendar('gregorian'); calnd='gregorien'
79  CASE('julian'); CALL ioconf_calendar('julian'); calnd='julien'
80  CASE('proleptic_gregorian'); CALL ioconf_calendar('gregorian')
81  !--- DC Bof... => IOIPSL a mettre a jour: proleptic_gregorian /= gregorian
82  CASE default
83  CALL abort_gcm('ce0l','Mauvais choix de calendrier',1)
84  END SELECT
85  WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre '//trim(calnd)
86 #endif
87 
88  IF (type_trac == 'inca') THEN
89 #ifdef INCA
90  CALL init_const_lmdz( &
91  nbtr,anneeref,dayref,&
92  iphysiq,day_step,nday,&
93  nbsrf, is_oce,is_sic,&
94  is_ter,is_lic)
95 
96 #endif
97  END IF
98 
99  WRITE(lunout,'(//)')
100  WRITE(lunout,*) ' ********************* '
101  WRITE(lunout,*) ' *** etat0_netcdf *** '
102  WRITE(lunout,*) ' ********************* '
103  WRITE(lunout,'(//)')
104  WRITE(lunout,*) ' interbar = ',interbar
105  CALL etat0_netcdf(interbar,masque,phis,ok_etat0)
106 
107  IF(ok_limit) THEN
108  WRITE(lunout,'(//)')
109  WRITE(lunout,*) ' ********************* '
110  WRITE(lunout,*) ' *** Limit_netcdf *** '
111  WRITE(lunout,*) ' ********************* '
112  WRITE(lunout,'(//)')
113  CALL limit_netcdf(interbar,extrap,oldice,masque)
114  END IF
115 
116  IF (grilles_gcm_netcdf) THEN
117  WRITE(lunout,'(//)')
118  WRITE(lunout,*) ' *************************** '
119  WRITE(lunout,*) ' *** grilles_gcm_netcdf *** '
120  WRITE(lunout,*) ' *************************** '
121  WRITE(lunout,'(//)')
122  CALL grilles_gcm_netcdf_sub(masque,phis)
123  END IF
124 
125 #ifdef CPP_MPI
126 !$OMP MASTER
127  CALL mpi_finalize(ierr)
128  IF (ierr /= 0) CALL abort_gcm('ce0l','Error in MPI_FINALIZE',1)
129 !$OMP END MASTER
130 #endif
131 
132 #endif
133 ! of #ifndef CPP_EARTH #else
134 
135 END PROGRAM ce0l
136 !
137 !-------------------------------------------------------------------------------