source: LMDZ5/branches/LMDZ5V2.0-dev/libf/dyn3dpar/ce0l.F90 @ 5040

Last change on this file since 5040 was 1488, checked in by jghattas, 14 years ago

Added subroutine grilles_gcm_netcdf_sub containing the first part of program create_fausse_var in file grilles_gcm_netcdf.F . The new subroutine is called in ce0l if parameter grilles_gcm_netcdf=T (default =F). The subroutine creates the file grilles_gcm.nc .


  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 4.0 KB
RevLine 
[1000]1!
[1279]2! $Id: ce0l.F90 1488 2011-02-17 15:23:03Z evignon $
[1000]3!
[1319]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!-------------------------------------------------------------------------------
[1403]16  USE control_mod
[1279]17#ifdef CPP_EARTH
18! This prog. is designed to work for Earth
[1319]19  USE dimphy
20  USE comgeomphy
21  USE mod_phys_lmdz_para
22  USE mod_const_mpi
23  USE infotrac
[1482]24  USE parallel, ONLY: finalize_parallel
[1319]25
[1279]26#ifdef CPP_IOIPSL
[1319]27  USE ioipsl, ONLY: ioconf_calendar
[1279]28#endif
[1000]29
[1319]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.
[1000]38#include "dimensions.h"
39#include "paramet.h"
40#include "indicesol.h"
[1319]41#include "iniprint.h"
42#include "temps.h"
43#include "logic.h"
44  INTEGER, PARAMETER            :: longcles=20
45  REAL,    DIMENSION(longcles)  :: clesphy0
46  REAL,    DIMENSION(iip1,jjp1) :: masque
47  CHARACTER(LEN=15)             :: calnd
48!-------------------------------------------------------------------------------
49  CALL conf_gcm( 99, .TRUE. , clesphy0 )
[1000]50
[1319]51  CALL init_mpi
[1000]52
[1319]53  CALL Init_Phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
54  WRITE(lunout,*)'---> klon=',klon
55  IF (mpi_size>1 .OR. omp_size>1) THEN
56       CALL abort_gcm('ce0l','In parallel mode,                         &
57 &                 ce0l must be called only                             &
[1482]58 &                 for 1 process and 1 task',1)
[1319]59  ENDIF
[1000]60
[1319]61  CALL InitComgeomphy
[1000]62
[1279]63#ifdef CPP_IOIPSL
[1319]64  SELECT CASE(calend)
65    CASE('earth_360d');CALL ioconf_calendar('360d');      calnd='a 360 jours/an'
66    CASE('earth_365d');CALL ioconf_calendar('noleap');    calnd='a 365 jours/an'
67    CASE('earth_366d');CALL ioconf_calendar('366d');      calnd='bissextile'
68    CASE('gregorian'); CALL ioconf_calendar('gregorian'); calnd='gregorien'
69    CASE('standard');  CALL ioconf_calendar('gregorian'); calnd='gregorien'
70    CASE('julian');    CALL ioconf_calendar('julian');    calnd='julien'
71    CASE('proleptic_gregorian'); CALL ioconf_calendar('gregorian')
72  !--- DC Bof...  => IOIPSL a mettre a jour: proleptic_gregorian /= gregorian
73    CASE DEFAULT
74      CALL abort_gcm('ce0l','Mauvais choix de calendrier',1)
75  END SELECT
76  WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre '//TRIM(calnd)
[1279]77#endif
78
[1319]79  IF (config_inca /= 'none') THEN
80#ifdef INCA
81    CALL init_const_lmdz(nbtr,anneeref,dayref,iphysiq,day_step,nday)
82    CALL init_inca_para(iim,jjm+1,klon,1,klon_mpi_para_nb,0)
83    WRITE(lunout,*)'nbtr =' , nbtr
84#endif
85  END IF
[1000]86
[1319]87  WRITE(lunout,'(//)')
88  WRITE(lunout,*) '  *********************  '
89  WRITE(lunout,*) '  ***  etat0_netcdf ***  '
90  WRITE(lunout,*) '  *********************  '
91  WRITE(lunout,'(//)')
92  WRITE(lunout,*) ' interbar = ',interbar
93  CALL etat0_netcdf(interbar,masque,ok_etat0)
[1000]94
[1319]95  IF(ok_limit) THEN
96  WRITE(lunout,'(//)')
97  WRITE(lunout,*) '  *********************  '
98  WRITE(lunout,*) '  ***  Limit_netcdf ***  '
99  WRITE(lunout,*) '  *********************  '
100  WRITE(lunout,'(//)')
101  CALL limit_netcdf(interbar,extrap,oldice,masque)
102  END IF
103
[1488]104  IF (grilles_gcm_netcdf) THEN
105     WRITE(lunout,'(//)')
106     WRITE(lunout,*) '  ***************************  '
107     WRITE(lunout,*) '  ***  grilles_gcm_netcdf ***  '
108     WRITE(lunout,*) '  ***************************  '
109     WRITE(lunout,'(//)')
110     CALL grilles_gcm_netcdf_sub()
111  END IF
112 
[1482]113!$OMP MASTER
114  CALL finalize_parallel
115!$OMP END MASTER
116
[1279]117#endif
[1319]118! of #ifndef CPP_EARTH #else
119
120END PROGRAM ce0l
121!
122!-------------------------------------------------------------------------------
Note: See TracBrowser for help on using the repository browser.