source: LMDZ5/trunk/libf/dynlonlat_phylonlat/phylmd/ce0l.F90 @ 2315

Last change on this file since 2315 was 2293, checked in by dcugnet, 10 years ago

Initial states creation routines have been reorganized and simplified.
As far as possible, dynamics and physics related routines have been
separated.
Some routines have been converted to fortran 90 and repeated codes sections
have been "factorized".
Array/vector arguments have become implicit in some routines to avoid usage
of "dimensions.h" ; possible for routines with explicit interfaces and if
iim and jjm can be deduced from arguments sizes.

  • dynlonlat_phylonlat/ce0l.F90 calls now phylmd/etat0phys_netcdf.F90 and dyn3d/etat0dyn_netcdf.F90 that replace phylmd/etat0_netcdf.F90. start.nc and startphy.nc creations are now independant.
  • startvar.F90 has been suppressed ; corresponding operations have been simplified and embedded in etat0*_netcdf.F90 routines as internal procedures.
  • Routines converted to fortran 90 and "factorized":
    • dyn3d_common/conf_dat_m.F90 (replaces dyn3d_common/conf_dat2d.F

and dyn3d_common/conf_dat3d.F)

  • dyn3d/dynredem.F90 (replaces dyn3d/dynredem.F)
  • dyn3d/dynetat0.F90 (replaces dyn3d/dynetat0.F)
  • phylmd/grid_noro_m.F90 (replaces dyn3d_common/grid_noro.F)
  • dynlonlat_phylonlat/grid_atob_m.F90 (replaces dyn3d_common/grid_atob.F)
  • dyn3d_common/caldyn0.F90 (replaces dyn3d_common/caldyn0.F)
  • dyn3d_common/covcont.F90 (replaces dyn3d_common/covcont.F)
  • dyn3d_common/pression.F90 (replaces dyn3d_common/pression.F)
  • phylmd/phyredem.F90 and phylmd/limit_netcdf.F90 have been slightly factorized.

TO DO:

  • little fix needed in grid_noro_m.F90 ; untouched yet to ensure results are exactly the same as before. Unsmoothed orography is used to compute "zphi", but smoothed (should be unsmoothed) one is used at poles.
  • add the dyn3dmem versions of dynredem.F90 and dynetat0.F90 (dynredem_loc.F90 and dynetat0_loc.F90, untested yet).
  • test compilation in parallel mode for a single processor.
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 7.3 KB
Line 
1PROGRAM ce0l
2!
3!-------------------------------------------------------------------------------
4! Purpose: Calls etat0, creates initial states and limit_netcdf
5!
6!     interbar=.T. for barycentric interpolation inter_barxy
7!     extrap  =.T. for data extrapolation, like for the SSTs when file does not
8!                  contain ocean points only.
9!     oldice  =.T. for old-style ice, obtained using grille_m (grid_atob).
10!     masque is created in etat0, passed to limit to ensure consistancy.
11!-------------------------------------------------------------------------------
12  USE control_mod
13
14!#ifdef CPP_EARTH
15!! This prog. is designed to work for Earth
16  USE etat0dyn
17  USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, NF90_CLOSE, NF90_NOERR
18  USE ioipsl, ONLY: ioconf_calendar, getin, flininfo, flinopen, flinget, flinclo
19
20#ifdef CPP_PHYS
21  USE etat0phys
22  USE dimphy
23  USE comgeomphy
24  USE infotrac
25  USE indice_sol_mod
26  USE test_disvert_m, ONLY: test_disvert
27#endif
28! of #ifdef CPP_PHYS
29
30!#endif
31!! of #ifdef CPP_EARTH
32
33  IMPLICIT NONE
34
35!-------------------------------------------------------------------------------
36! Local variables:
37!#ifndef CPP_EARTH
38!  include "iniprint.h"
39!!-------------------------------------------------------------------------------
40!  WRITE(lunout,*)'ce0l: Earth-specific routine, needs Earth physics'
41!#else
42  include "dimensions.h"
43  include "paramet.h"
44  include "comconst.h"
45  include "comvert.h"
46  include "iniprint.h"
47  include "temps.h"
48  include "logic.h"
49  REAL               :: masque(iip1,jjp1)             !--- CONTINENTAL MASK
50  REAL               :: phis  (iip1,jjp1)             !--- GROUND GEOPOTENTIAL
51  CHARACTER(LEN=256) :: modname, fmt, calnd           !--- CALENDAR TYPE
52  LOGICAL            :: use_filtre_fft
53  LOGICAL, PARAMETER :: interbar=.TRUE., extrap=.FALSE., oldice=.FALSE.
54
55!--- Local variables for ocean mask reading:
56  INTEGER            :: nid_o2a, iml_omask, jml_omask, j
57  INTEGER            :: fid, iret, llm_tmp, ttm_tmp, itaul(1)
58  REAL, ALLOCATABLE  :: lon_omask(:,:), dlon_omask(:), ocemask(:,:)
59  REAL, ALLOCATABLE  :: lat_omask(:,:), dlat_omask(:), ocetmp (:,:)
60  REAL               :: date, lev(1)
61!-------------------------------------------------------------------------------
62  modname="ce0l"
63
64!--- Constants
65  pi     = 4. * ATAN(1.)
66  rad    = 6371229.
67  daysec = 86400.
68  omeg   = 2.*pi/daysec
69  g      = 9.8
70  kappa  = 0.2857143
71  cpp    = 1004.70885
72  jmp1   = jjm + 1
73  preff   = 101325.
74  pa      = 50000.
75
76  CALL conf_gcm( 99, .TRUE. )
77
78  dtvr = daysec/FLOAT(day_step)
79  WRITE(lunout,*)'dtvr',dtvr
80
81  CALL iniconst()
82#ifdef CPP_PHYS
83  IF(pressure_exner) CALL test_disvert
84#endif
85  CALL inigeom()
86
87#ifdef CPP_IOIPSL
88  calnd='gregorian'
89  SELECT CASE(calend)
90    CASE('earth_360d');CALL ioconf_calendar('360d');   calnd='with 360 days/year'
91    CASE('earth_365d');CALL ioconf_calendar('noleap'); calnd='with no leap year'
92    CASE('earth_366d');CALL ioconf_calendar('366d');   calnd='with leap years only'
93    CASE('gregorian'); CALL ioconf_calendar('gregorian')
94    CASE('standard');  CALL ioconf_calendar('gregorian')
95    CASE('julian');    CALL ioconf_calendar('julian'); calnd='julian'
96    CASE('proleptic_gregorian'); CALL ioconf_calendar('gregorian')
97  !--- DC Bof...  => IOIPSL a mettre a jour: proleptic_gregorian /= gregorian
98    CASE DEFAULT
99      CALL abort_gcm('ce0l','Bad choice for calendar',1)
100  END SELECT
101  WRITE(lunout,*)'CHOSEN CALENDAR: Earth '//TRIM(calnd)
102#endif
103
104  use_filtre_fft=.FALSE.
105  CALL getin('use_filtre_fft',use_filtre_fft)
106  IF(use_filtre_fft) THEN
107     WRITE(lunout,*)"FFT filter not available for sequential dynamics."
108     WRITE(lunout,*)"Your setting of variable use_filtre_fft is not used."
109  ENDIF
110
111!--- LAND MASK. TWO CASES:
112!   1) read from ocean model    file "o2a.nc"    (coupled runs)
113!   2) computed from topography file "Relief.nc" (masque(:,:)=-99999.)
114! Coupled simulations (case 1) use the ocean model mask to compute the
115! weights to ensure ocean fractions are the same for atmosphere and ocean.
116!*******************************************************************************
117  IF(NF90_OPEN("o2a.nc", NF90_NOWRITE, nid_o2a)/=NF90_NOERR) THEN
118    WRITE(lunout,*)'BEWARE !! No ocean mask "o2a.nc" file found'
119    WRITE(lunout,*)'Forced run.'
120    masque(:,:)=-99999.
121  ELSE
122    iret=NF90_CLOSE(nid_o2a)
123    WRITE(lunout,*)'BEWARE !! Ocean mask "o2a.nc" file found'
124    WRITE(lunout,*)'Coupled run.'
125    CALL flininfo("o2a.nc", iml_omask, jml_omask, llm_tmp, ttm_tmp, nid_o2a)
126    IF(iml_omask/=iim .OR.jml_omask/=jjp1) THEN
127      WRITE(lunout,*)'Mismatching dimensions for ocean mask'
128      WRITE(lunout,*)'iim  = ',iim ,' iml_omask = ',iml_omask
129      WRITE(lunout,*)'jjp1 = ',jjp1,' jml_omask = ',jml_omask
130      CALL abort_gcm(modname,'',1)
131    END IF
132    ALLOCATE(ocemask(iim,jjp1),lon_omask(iim,jjp1),dlon_omask(iim ))
133    ALLOCATE(ocetmp (iim,jjp1),lat_omask(iim,jjp1),dlat_omask(jjp1))
134    CALL flinopen("o2a.nc", .FALSE.,iim,jjp1,llm_tmp,lon_omask,lat_omask,lev,  &
135     &                                       ttm_tmp,itaul,date,dt,fid)
136    CALL flinget(fid, "OceMask",    iim,jjp1,llm_tmp,ttm_tmp,1,1,ocetmp)
137    CALL flinclo(fid)
138    dlon_omask(1:iim ) = lon_omask(1:iim,1)
139    dlat_omask(1:jjp1) = lat_omask(1,1:jjp1)
140    ocemask = ocetmp
141    IF(dlat_omask(1)<dlat_omask(jml_omask)) THEN
142      DO j=1,jjp1; ocemask(:,j) = ocetmp(:,jjp1-j+1); END DO
143    END IF
144    DEALLOCATE(ocetmp,lon_omask,lat_omask,dlon_omask,dlat_omask)
145    IF(prt_level>=1) THEN
146      WRITE(fmt,"(i4,'i1)')")iim ; fmt='('//ADJUSTL(fmt)
147      WRITE(lunout,*)'OCEAN MASK :'
148      WRITE(lunout,fmt) NINT(ocemask)
149    END IF
150    masque(1:iim,:)=1.-ocemask(:,:)
151    masque(iip1 ,:)=masque(1,:)
152    DEALLOCATE(ocemask)
153  END IF
154  phis(:,:)=-99999.
155
156#ifdef CPP_PHYS
157  CALL Init_Phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
158  WRITE(lunout,*)'---> klon=',klon
159  CALL InitComgeomphy
160
161  IF (type_trac == 'inca') THEN
162#ifdef INCA
163    CALL init_const_lmdz(nbtr,anneeref,dayref,iphysiq,day_step,nday)
164    CALL init_inca_para(iim,jjm+1,klon,1,klon_mpi_para_nb,0)
165    WRITE(lunout,*)'nbtr =' , nbtr
166#endif
167! of #ifdef INCA
168  END IF
169  IF(ok_etat0) THEN
170    WRITE(lunout,'(//)')
171    WRITE(lunout,*) '  ************************  '
172    WRITE(lunout,*) '  ***  etat0phy_netcdf ***  '
173    WRITE(lunout,*) '  ************************  '
174    WRITE(lunout,'(//)')
175    WRITE(lunout,*) ' interbar = ',interbar
176    CALL etat0phys_netcdf(interbar,masque,phis)
177  END IF
178#endif
179! of #ifdef CPP_PHYS
180
181  IF(ok_etat0) THEN
182    WRITE(lunout,'(//)')
183    WRITE(lunout,*) '  ************************  '
184    WRITE(lunout,*) '  ***  etat0dyn_netcdf ***  '
185    WRITE(lunout,*) '  ************************  '
186    WRITE(lunout,'(//)')
187    WRITE(lunout,*) ' interbar = ',interbar
188    CALL etat0dyn_netcdf(interbar,masque,phis)
189  END IF
190
191#ifdef CPP_PHYS
192  IF(ok_limit) THEN
193    WRITE(lunout,'(//)')
194    WRITE(lunout,*) '  *********************  '
195    WRITE(lunout,*) '  ***  Limit_netcdf ***  '
196    WRITE(lunout,*) '  *********************  '
197    WRITE(lunout,'(//)')
198    CALL limit_netcdf(interbar,extrap,oldice,masque)
199  END IF
200#endif
201
202  WRITE(lunout,'(//)')
203  WRITE(lunout,*) '  ***************************  '
204  WRITE(lunout,*) '  ***  grilles_gcm_netcdf ***  '
205  WRITE(lunout,*) '  ***************************  '
206  WRITE(lunout,'(//)')
207  CALL grilles_gcm_netcdf_sub(masque,phis)
208
209!#endif
210! of #ifndef CPP_EARTH #else
211
212END PROGRAM ce0l
213!
214!-------------------------------------------------------------------------------
Note: See TracBrowser for help on using the repository browser.