source: LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/ce0l.F90 @ 5152

Last change on this file since 5152 was 5136, checked in by abarral, 4 months ago

Put comgeom.h, comgeom2.h into modules
  • 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: 9.6 KB
Line 
1PROGRAM ce0l
2
3  !-------------------------------------------------------------------------------
4  ! Purpose: Initial states and boundary conditions files creation:
5  !     * start.nc    for dynamics    (using etat0dyn     routine)
6  !     * startphy.nc for physics     (using etat0phys    routine)
7  !     * limit.nc    for forced runs (using limit_netcdf routine)
8  !-------------------------------------------------------------------------------
9  ! Notes:
10  !     * extrap=.T. (default) for data extrapolation, like for the SSTs when file
11  !                   does contain ocean points only.
12  !     * "masque" can be:
13  !       - read from file "o2a.nc"          (for coupled runs).
14  !       - read from file "startphy0.nc"    (from a previous run).
15  !       - created in etat0phys or etat0dyn (for forced  runs).
16  !     It is then passed to limit_netcdf to ensure consistancy.
17  !-------------------------------------------------------------------------------
18  USE ioipsl, ONLY: ioconf_calendar, getin, flininfo, flinopen, flinget, flinclo
19  USE control_mod, ONLY: day_step, dayref, nsplit_phys
20  USE etat0dyn, ONLY: etat0dyn_netcdf
21  USE etat0phys, ONLY: etat0phys_netcdf
22  USE limit, ONLY: limit_netcdf
23  USE netcdf, ONLY: nf90_open, nf90_nowrite, nf90_close, nf90_noerr, &
24          nf90_inquire_dimension, nf90_inq_dimid, nf90_inq_varid, nf90_get_var
25  USE infotrac, ONLY: init_infotrac
26  USE dimphy, ONLY: klon
27  USE test_disvert_m, ONLY: test_disvert
28  USE lmdz_filtreg, ONLY: inifilr
29  USE iniphysiq_mod, ONLY: iniphysiq
30  USE mod_const_mpi, ONLY: comm_lmdz
31
32#ifdef CPP_PARA
33  USE mod_const_mpi,  ONLY: init_const_mpi
34  USE parallel_lmdz,  ONLY: init_parallel, mpi_rank, omp_rank, using_mpi
35  USE bands,          ONLY: read_distrib, distrib_phys
36  USE mod_hallo,      ONLY: init_mod_hallo
37  USE mod_interface_dyn_phys, ONLY: init_interface_dyn_phys
38  USE lmdz_xios, ONLY: using_xios, xios_finalize
39#endif
40
41  USE comconst_mod, ONLY: cpp, daysec, dtphys, dtvr, g, kappa, omeg, r, rad, &
42          pi, jmp1
43  USE logic_mod, ONLY: iflag_phys, ok_etat0, ok_limit
44  USE comvert_mod, ONLY: pa, preff, pressure_exner
45  USE temps_mod, ONLY: calend, day_ini, dt
46  USE lmdz_mpi
47  USE lmdz_iniprint, ONLY: lunout, prt_level
48  USE lmdz_comgeom2
49
50  IMPLICIT NONE
51
52  !-------------------------------------------------------------------------------
53  ! Local variables:
54  INCLUDE "dimensions.h"
55  INCLUDE "paramet.h"
56
57  REAL :: masque(iip1, jjp1)             !--- CONTINENTAL MASK
58  REAL :: phis  (iip1, jjp1)             !--- GROUND GEOPOTENTIAL
59  CHARACTER(LEN = 256) :: modname, fmt, calnd           !--- CALENDAR TYPE
60  LOGICAL :: use_filtre_fft
61  LOGICAL, PARAMETER :: extrap = .FALSE.
62
63  !--- Local variables for ocean mask reading:
64  INTEGER :: nid_o2a, iml_omask, jml_omask, j
65  INTEGER :: fid, iret, llm_tmp, ttm_tmp, itaul(1)
66  REAL, ALLOCATABLE :: lon_omask(:, :), dlon_omask(:), ocemask(:, :)
67  REAL, ALLOCATABLE :: lat_omask(:, :), dlat_omask(:), ocetmp (:, :)
68  REAL :: date, lev(1)
69
70  !--- Local variables for land mask from startphy0 file reading
71  INTEGER :: nid_sta, nid_nph, nid_msk, nphys
72  REAL, ALLOCATABLE :: masktmp(:)
73
74#ifdef CPP_PARA
75  INTEGER ierr
76#else
77  ! for iniphysiq in serial mode
78  INTEGER, PARAMETER :: mpi_rank = 0
79  INTEGER :: distrib_phys(mpi_rank:mpi_rank) = (jjm - 1) * iim + 2
80#endif
81  !-------------------------------------------------------------------------------
82  modname = "ce0l"
83
84  !--- Constants
85  pi = 4. * ATAN(1.)
86  rad = 6371229.
87  daysec = 86400.
88  omeg = 2. * pi / daysec
89  g = 9.8
90  kappa = 0.2857143
91  cpp = 1004.70885
92  jmp1 = jjm + 1
93  preff = 101325.
94  pa = 50000.
95
96  CALL conf_gcm(99, .TRUE.)
97  dtvr = daysec / REAL(day_step)
98  WRITE(lunout, *)'dtvr', dtvr
99  CALL iniconst()
100  CALL inigeom()
101
102  !--- Calendar choice
103  calnd = 'gregorian'
104  SELECT CASE(calend)
105  CASE('earth_360d');CALL ioconf_calendar('360_day');   calnd = 'with 360 days/year'
106  CASE('earth_365d');CALL ioconf_calendar('noleap'); calnd = 'with no leap year'
107  CASE('earth_366d');CALL ioconf_calendar('366d');   calnd = 'with leap years only'
108  CASE('gregorian'); CALL ioconf_calendar('gregorian')
109  CASE('standard');  CALL ioconf_calendar('gregorian')
110  CASE('julian');    CALL ioconf_calendar('julian'); calnd = 'julian'
111  CASE('proleptic_gregorian'); CALL ioconf_calendar('gregorian')
112  !--- DC Bof...  => IOIPSL a mettre a jour: proleptic_gregorian /= gregorian
113  CASE DEFAULT
114    CALL abort_gcm('ce0l', 'Bad choice for calendar', 1)
115  END SELECT
116  WRITE(lunout, *)'CHOSEN CALENDAR: Earth ' // TRIM(calnd)
117
118#ifdef CPP_PARA
119!--- Physical grid + parallel initializations
120  CALL init_const_mpi()
121  CALL init_parallel()
122  CALL read_distrib()
123  CALL init_mod_hallo()
124#endif
125  WRITE(lunout, *)'---> klon=', klon
126
127  !--- Tracers initializations
128  CALL init_infotrac()
129
130  CALL inifilr()
131  CALL iniphysiq(iim, jjm, llm, &
132          distrib_phys(mpi_rank), comm_lmdz, &
133          daysec, day_ini, dtphys / nsplit_phys, &
134          rlatu, rlatv, rlonu, rlonv, aire, cu, cv, rad, g, r, cpp, iflag_phys)
135  IF(pressure_exner) CALL test_disvert
136
137#ifdef CPP_PARA
138  IF (mpi_rank==0.AND.omp_rank==0) THEN
139#endif
140  use_filtre_fft = .FALSE.
141  CALL getin('use_filtre_fft', use_filtre_fft)
142  IF(use_filtre_fft) THEN
143    WRITE(lunout, *)"FFT filter not available for sequential dynamics."
144    WRITE(lunout, *)"Your setting of variable use_filtre_fft is not used."
145  ENDIF
146
147  !--- LAND MASK. THREE CASES:
148  !   1) read from ocean model    file "o2a.nc"    (coupled runs)
149  !   2) read from previous run   file="startphy0.nc"
150  !   3) computed from topography file "Relief.nc" (masque(:,:)=-99999.)
151  ! In the first case, the mask from the ocean model is used compute the
152  ! weights to ensure ocean fractions are the same for atmosphere and ocean.
153  !*******************************************************************************
154  IF(nf90_open("o2a.nc", nf90_nowrite, nid_o2a)==nf90_noerr) THEN
155    iret = nf90_close(nid_o2a)
156    WRITE(lunout, *)'BEWARE !! Ocean mask "o2a.nc" file found'
157    WRITE(lunout, *)'Coupled run.'
158    CALL flininfo("o2a.nc", iml_omask, jml_omask, llm_tmp, ttm_tmp, nid_o2a)
159    IF(iml_omask/=iim .OR.jml_omask/=jjp1) THEN
160      WRITE(lunout, *)'Mismatching dimensions for ocean mask'
161      WRITE(lunout, *)'iim  = ', iim, ' iml_omask = ', iml_omask
162      WRITE(lunout, *)'jjp1 = ', jjp1, ' jml_omask = ', jml_omask
163      CALL abort_gcm(modname, '', 1)
164    END IF
165    ALLOCATE(ocemask(iim, jjp1), lon_omask(iim, jjp1), dlon_omask(iim))
166    ALLOCATE(ocetmp (iim, jjp1), lat_omask(iim, jjp1), dlat_omask(jjp1))
167    CALL flinopen("o2a.nc", .FALSE., iml_omask, jml_omask, llm_tmp, &
168            lon_omask, lat_omask, lev, ttm_tmp, itaul, date, dt, fid)
169    CALL flinget(fid, "OceMask", iim, jjp1, llm_tmp, ttm_tmp, 1, 1, ocetmp)
170    CALL flinclo(fid)
171    dlon_omask(1:iim) = lon_omask(1:iim, 1)
172    dlat_omask(1:jjp1) = lat_omask(1, 1:jjp1)
173    ocemask = ocetmp
174    IF(dlat_omask(1)<dlat_omask(jml_omask)) THEN
175      DO j = 1, jjp1
176        ocemask(:, j) = ocetmp(:, jjp1 - j + 1)
177      END DO
178    END IF
179    DEALLOCATE(ocetmp, lon_omask, lat_omask, dlon_omask, dlat_omask)
180    IF(prt_level>=1) THEN
181      WRITE(fmt, "(i4,'i1)')")iim ; fmt = '(' // ADJUSTL(fmt)
182      WRITE(lunout, *)'OCEAN MASK :'
183      WRITE(lunout, fmt) NINT(ocemask)
184    END IF
185    masque(1:iim, :) = 1. - ocemask(:, :)
186    masque(iip1, :) = masque(1, :)
187    DEALLOCATE(ocemask)
188  ELSE IF(nf90_open("startphy0.nc", nf90_nowrite, nid_sta)==nf90_noerr) THEN
189    WRITE(lunout, *)'BEWARE !! File "startphy0.nc" found.'
190    WRITE(lunout, *)'Getting the land mask from a previous run.'
191    iret = nf90_inq_dimid(nid_sta, 'points_physiques', nid_nph)
192    iret = nf90_inquire_dimension(nid_sta, nid_nph, len = nphys)
193    IF(nphys/=klon) THEN
194      WRITE(lunout, *)'Mismatching dimensions for land mask'
195      WRITE(lunout, *)'nphys  = ', nphys, ' klon = ', klon
196      iret = nf90_close(nid_sta)
197      CALL abort_gcm(modname, '', 1)
198    END IF
199    ALLOCATE(masktmp(klon))
200    iret = nf90_inq_varid(nid_sta, 'masque', nid_msk)
201    iret = nf90_get_var(nid_sta, nid_msk, masktmp)
202    iret = nf90_close(nid_sta)
203    CALL gr_fi_dyn(1, klon, iip1, jjp1, masktmp, masque)
204    IF(prt_level>=1) THEN
205      WRITE(fmt, "(i4,'i1)')")iip1 ; fmt = '(' // ADJUSTL(fmt)
206      WRITE(lunout, *)'LAND MASK :'
207      WRITE(lunout, fmt) NINT(masque)
208    END IF
209    DEALLOCATE(masktmp)
210  ELSE
211    WRITE(lunout, *)'BEWARE !! No ocean mask "o2a.nc" file or "startphy0.nc" file found'
212    WRITE(lunout, *)'Land mask will be built from the topography file.'
213    masque(:, :) = -99999.
214  END IF
215  phis(:, :) = -99999.
216
217  IF(ok_etat0) THEN
218    WRITE(lunout, '(//)')
219    WRITE(lunout, *) '  ************************  '
220    WRITE(lunout, *) '  ***  etat0phy_netcdf ***  '
221    WRITE(lunout, *) '  ************************  '
222    CALL etat0phys_netcdf(masque, phis)
223    WRITE(lunout, '(//)')
224    WRITE(lunout, *) '  ************************  '
225    WRITE(lunout, *) '  ***  etat0dyn_netcdf ***  '
226    WRITE(lunout, *) '  ************************  '
227    CALL etat0dyn_netcdf(masque, phis)
228  END IF
229
230  IF(ok_limit) THEN
231    WRITE(lunout, '(//)')
232    WRITE(lunout, *) '  *********************  '
233    WRITE(lunout, *) '  ***  Limit_netcdf ***  '
234    WRITE(lunout, *) '  *********************  '
235    WRITE(lunout, '(//)')
236    CALL limit_netcdf(masque, phis, extrap)
237  END IF
238
239  WRITE(lunout, '(//)')
240  WRITE(lunout, *) '  ***************************  '
241  WRITE(lunout, *) '  ***  grilles_gcm_netcdf ***  '
242  WRITE(lunout, *) '  ***************************  '
243  WRITE(lunout, '(//)')
244  CALL grilles_gcm_netcdf_sub(masque, phis)
245
246#ifdef CPP_PARA
247  END IF
248  IF (using_xios) CALL xios_finalize
249  IF (using_mpi) CALL MPI_FINALIZE(ierr)
250#endif
251
252END PROGRAM ce0l
253
254!-------------------------------------------------------------------------------
Note: See TracBrowser for help on using the repository browser.