source: LMDZ5/trunk/libf/phylmd/etat0phys_netcdf.F90 @ 2299

Last change on this file since 2299 was 2299, checked in by dcugnet, 9 years ago

In dyn3d/:
etat0dyn_netcdf.F90: "startget_dyn3d" syntax slightly simplified.
dynredem.F90: Shortcut routines (put_var*, cre_var,
dynredem_write_*, dynredem_read_u)

modified to match dyn3dmem version and put in

module dyredem_mod.F90.
dynetat0.F90 -> *.f90: Few simplifications (no usage of NC_DOUBLE
needed => no precompilation)

Add tracers initialization in the isotope case

suppressed by accident.
dynredem_mod.F90: Created to mimic dyn3dmem equivalent.

In dyn3dmem/:
dynetat0_loc.F -> *.f90: Converted into fortran 90 to match the dyn3d
version.
dynredem_loc.F -> *.F90: Converted into fortran 90.
dynredem_mod.F90: Add some shortcut routines to match the dyn3d
version.

In phylmd/:
phyredem.F90: Bug fix: nsw instead of nsoilmx was used as
Tsoil second maximum index.

Bug fix: fevap instead of snow was saved for

"SNOW".
etat0phys_netcdf.F90: "filtreg_mod" module usage suppressed.

Local variable rugo computation removed (not

used).

In dynlonlat_phylonlat/:
grid_atob_m.F90 -> *.f90 DOUBLE PRECISION variables usage removed.

Precompilation o longer needed => .F90 extension.

File size: 22.8 KB
Line 
1MODULE etat0phys
2!
3!*******************************************************************************
4! Purpose: Create physical initial state using atmospheric fields from a
5!          database of atmospheric to initialize the model.
6!-------------------------------------------------------------------------------
7! Comments:
8!
9!    *  This module is designed to work for Earth (and with ioipsl)
10!
11!    *  etat0phys_netcdf routine can access to NetCDF data through subroutines:
12!         "start_init_phys" for variables contained in file "ECPHY.nc":
13!            'ST'     : Surface temperature
14!            'CDSW'   : Soil moisture
15!         "start_init_orog" for variables contained in file "Relief.nc":
16!            'RELIEF' : High resolution orography
17!
18!    * The land mask and corresponding weights can be:
19!      1) computed using the ocean mask from the ocean model (to ensure ocean
20!         fractions are the same for atmosphere and ocean) for coupled runs.
21!         File name: "o2a.nc"  ;  variable name: "OceMask"
22!      2) computed from topography file "Relief.nc" for forced runs.
23!
24!    * Allowed values for read_climoz flag are 0, 1 and 2:
25!      0: do not read an ozone climatology
26!      1: read a single ozone climatology that will be used day and night
27!      2: read two ozone climatologies, the average day and night climatology
28!         and the daylight climatology
29!-------------------------------------------------------------------------------
30!    * There is a big mess with the longitude size. Should it be iml or iml+1 ?
31!  I have chosen to use the iml+1 as an argument to this routine and we declare
32!  internaly smaller fields when needed. This needs to be cleared once and for
33!  all in LMDZ. A convention is required.
34!-------------------------------------------------------------------------------
35
36  USE ioipsl,             ONLY: flininfo, flinopen, flinget, flinclo
37  USE assert_eq_m,        ONLY: assert_eq
38#ifdef CPP_EARTH
39  USE dimphy
40  USE phys_state_var_mod, ONLY: zmea, zstd, zsig, zgam, zthe, zpic, zval, z0m, &
41    rlon, solsw, radsol, t_ancien, wake_deltat, wake_s,  rain_fall, qsol, z0h, &
42    rlat, sollw, rugoro, q_ancien, wake_deltaq, wake_pe, snow_fall, ratqs,w01, &
43    sig1, ftsol, clwcon, fm_therm, wake_Cstar,  pctsrf,  entr_therm,radpas, f0,&
44    zmax0,fevap, rnebcon,falb_dir, wake_fip,    agesno,  detr_therm, pbl_tke,  &
45    phys_state_var_init
46#endif
47
48  PRIVATE
49  PUBLIC :: etat0phys_netcdf
50
51  include "iniprint.h"
52  include "dimensions.h"
53  include "paramet.h"
54  include "comgeom2.h"
55  include "comvert.h"
56  include "comconst.h"
57  include "dimsoil.h"
58  include "temps.h"
59  include "comdissnew.h"
60  include "serre.h"
61  include "clesphys.h"
62  REAL, SAVE :: deg2rad
63  REAL, SAVE, ALLOCATABLE :: tsol(:)
64!  REAL, SAVE, ALLOCATABLE :: rugo(:,:)  ! ??? COMPUTED BUT NOT USED ???
65  INTEGER,            SAVE      :: iml_phys, jml_phys, llm_phys, ttm_phys, fid_phys
66  REAL, ALLOCATABLE,  SAVE      :: lon_phys(:,:), lat_phys(:,:), levphys_ini(:)
67  CHARACTER(LEN=256), PARAMETER :: orofname="Relief.nc"
68  CHARACTER(LEN=256), PARAMETER :: title="RELIEF"
69
70
71CONTAINS
72
73
74!-------------------------------------------------------------------------------
75!
76SUBROUTINE etat0phys_netcdf(ib, masque, phis)
77!
78!-------------------------------------------------------------------------------
79! Purpose: Creates initial states
80!-------------------------------------------------------------------------------
81! Note: This routine is designed to work for Earth
82!-------------------------------------------------------------------------------
83  USE control_mod
84#ifdef CPP_EARTH
85  USE infotrac
86  USE fonte_neige_mod
87  USE pbl_surface_mod
88  USE regr_lat_time_climoz_m, ONLY: regr_lat_time_climoz
89  USE indice_sol_mod
90  USE conf_phys_m,    ONLY: conf_phys
91  USE exner_hyb_m,    ONLY: exner_hyb
92  USE exner_milieu_m, ONLY: exner_milieu
93  USE test_disvert_m, ONLY: test_disvert
94  USE grid_atob_m,    ONLY: grille_m
95#endif
96  IMPLICIT NONE
97!-------------------------------------------------------------------------------
98! Arguments:
99  LOGICAL, INTENT(IN)    :: ib          !--- Barycentric interpolation
100  REAL,    INTENT(INOUT) :: masque(:,:) !--- Land mask           dim(iip1,jjp1)
101  REAL,    INTENT(INOUT) :: phis  (:,:) !--- Ground geopotential dim(iip1,jjp1)
102#ifndef CPP_EARTH
103  WRITE(lunout,*)'etat0phys_netcdf: Earth-specific routine, needs Earth physics'
104#else
105!-------------------------------------------------------------------------------
106! Local variables:
107  CHARACTER(LEN=256) :: modname="etat0phys_netcdf", fmt
108  INTEGER            :: i, j, l, ji, iml, jml
109  REAL               :: phystep
110  REAL, DIMENSION(SIZE(masque,1),SIZE(masque,2)) :: masque_tmp
111  REAL, DIMENSION(klon)               :: sn, rugmer, run_off_lic_0, fder
112  REAL, DIMENSION(klon,nbsrf)         :: qsolsrf, snsrf
113  REAL, DIMENSION(klon,nsoilmx,nbsrf) :: tsoil
114
115!--- Local variables for sea-ice reading:
116  LOGICAL           :: read_mask
117  INTEGER           :: iml_lic, jml_lic, isst(klon-2)
118  INTEGER           :: fid, llm_tmp, ttm_tmp, itaul(1)
119  REAL, ALLOCATABLE :: dlon_lic(:), lon_lic(:,:), fraclic(:,:)
120  REAL, ALLOCATABLE :: dlat_lic(:), lat_lic(:,:)
121  REAL              :: date, lev(1), dummy
122  REAL              :: flic_tmp(SIZE(masque,1),SIZE(masque,2))
123
124!--- Arguments for conf_phys
125  LOGICAL :: ok_journe, ok_mensuel, ok_instan, ok_hf, ok_LES, callstats
126  REAL    :: solarlong0, seuil_inversion, fact_cldcon, facttemps
127  LOGICAL :: ok_newmicro
128  INTEGER :: iflag_radia, iflag_cldcon, iflag_ratqs
129  REAL    :: ratqsbas, ratqshaut, tau_ratqs
130  LOGICAL :: ok_ade, ok_aie, ok_cdnc, aerosol_couple
131  INTEGER :: flag_aerosol
132  LOGICAL :: flag_aerosol_strat
133  LOGICAL :: new_aod
134  REAL    :: bl95_b0, bl95_b1
135  INTEGER :: read_climoz                        !--- Read ozone climatology
136  REAL    :: alp_offset
137
138  deg2rad= pi/180.0
139  iml=assert_eq(SIZE(masque,1),SIZE(phis,1),TRIM(modname)//" iml")
140  jml=assert_eq(SIZE(masque,2),SIZE(phis,2),TRIM(modname)//" jml")
141
142! Grid construction and miscellanous initializations.
143!*******************************************************************************
144  CALL conf_phys(  ok_journe, ok_mensuel, ok_instan, ok_hf, ok_LES,     &
145                   callstats,                                           &
146                   solarlong0,seuil_inversion,                          &
147                   fact_cldcon, facttemps,ok_newmicro,iflag_radia,      &
148                   iflag_cldcon,                                        &
149                   iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs,            &
150                   ok_ade, ok_aie, ok_cdnc, aerosol_couple,             &
151                   flag_aerosol, flag_aerosol_strat, new_aod,           &
152                   bl95_b0, bl95_b1,                                    &
153                   read_climoz,                                         &
154                   alp_offset)
155
156  CALL phys_state_var_init(read_climoz)
157
158  co2_ppm0 = co2_ppm  !--- Initial atmospheric CO2 conc. from .def file
159
160  rlat(1) = pi/2.
161  DO j=2,jjm; rlat((j-2)*iim+2:(j-1)*iim+1)=rlatu(j);     END DO
162  rlat(klon) = - pi/2.
163  rlat(:)=rlat(:)*(180.0/pi)
164
165  rlon(1) = 0.0
166  DO j=2,jjm; rlon((j-2)*iim+2:(j-1)*iim+1)=rlonv(1:iim); END DO
167  rlon(klon) = 0.0
168  rlon(:)=rlon(:)*(180.0/pi)
169
170! Compute ground geopotential, sub-cells quantities and possibly the mask.
171!*******************************************************************************
172  read_mask=ANY(masque/=-99999.); masque_tmp=masque
173  CALL start_init_orog(rlonv, rlatu, phis, masque_tmp)
174  WRITE(fmt,"(i4,'i1)')")iml ; fmt='('//ADJUSTL(fmt)
175  IF(.NOT.read_mask) THEN                       !--- Keep mask form orography
176    masque=masque_tmp
177    IF(prt_level>=1) THEN
178      WRITE(lunout,*)'BUILT MASK :'
179      WRITE(lunout,fmt) NINT(masque)
180    END IF
181    WHERE(   masque(:,:)<EPSFRA) masque(:,:)=0.
182    WHERE(1.-masque(:,:)<EPSFRA) masque(:,:)=1.
183  END IF
184 CALL gr_dyn_fi(1,iml,jml,klon,masque,zmasq) !--- Land mask to physical grid
185
186! Compute tsol and qsol on physical grid, knowing phis on 2D grid.
187!*******************************************************************************
188  CALL start_init_phys(rlonv, rlatu, rlonu, rlatv, ib, phis)
189
190! Some initializations.
191!*******************************************************************************
192  sn    (:) = 0.0                               !--- Snow
193  radsol(:) = 0.0                               !--- Net radiation at ground
194  rugmer(:) = 0.001                             !--- Ocean rugosity
195  IF(read_climoz>=1) &                          !--- Ozone climatology
196    CALL regr_lat_time_climoz(read_climoz)
197
198! Sub-surfaces initialization
199!*******************************************************************************
200!--- Read and interpolate on model T-grid soil fraction and soil ice fraction.
201  CALL flininfo("landiceref.nc", iml_lic, jml_lic, llm_tmp, ttm_tmp, fid)
202  ALLOCATE( lat_lic(iml_lic,jml_lic),lon_lic(iml_lic, jml_lic))
203  ALLOCATE(dlat_lic(jml_lic),       dlon_lic(iml_lic))
204  ALLOCATE( fraclic(iml_lic,jml_lic))
205  CALL flinopen("landiceref.nc", .FALSE., iml_lic, jml_lic, llm_tmp,  &
206 &               lon_lic, lat_lic, lev, ttm_tmp, itaul, date, dt, fid)
207  CALL flinget(fid, 'landice', iml_lic, jml_lic, llm_tmp, ttm_tmp, 1,1, fraclic)
208  CALL flinclo(fid)
209  WRITE(lunout,*)'landice dimensions: iml_lic, jml_lic : ',iml_lic,jml_lic
210  IF(MAXVAL(lon_lic)>pi) lon_lic=lon_lic*pi/180. !--- Conversion to degrees
211  IF(MAXVAL(lat_lic)>pi) lat_lic=lat_lic*pi/180.
212  dlon_lic(:)=lon_lic(:,1)
213  dlat_lic(:)=lat_lic(1,:)
214  CALL grille_m(dlon_lic, dlat_lic, fraclic, rlonv(1:iim), rlatu, flic_tmp(1:iim,:) )
215  flic_tmp(iml,:)=flic_tmp(1,:)
216
217!--- To the physical grid
218  pctsrf(:,:) = 0.
219  CALL gr_dyn_fi(1, iml, jml, klon, flic_tmp, pctsrf(:,is_lic))
220
221!--- Adequation with soil/sea mask
222  WHERE(pctsrf(:,is_lic)<EPSFRA) pctsrf(:,is_lic)=0.
223  WHERE(zmasq(:)<EPSFRA)         pctsrf(:,is_lic)=0.
224  pctsrf(:,is_ter)=zmasq(:)
225  DO ji=1,klon
226    IF(zmasq(ji)>EPSFRA) THEN
227      IF(pctsrf(ji,is_lic)>=zmasq(ji)) THEN
228        pctsrf(ji,is_lic)=zmasq(ji)
229        pctsrf(ji,is_ter)=0.
230      ELSE
231        pctsrf(ji,is_ter)=zmasq(ji)-pctsrf(ji,is_lic)
232        IF(pctsrf(ji,is_ter)<EPSFRA) THEN
233          pctsrf(ji,is_ter)=0.
234          pctsrf(ji,is_lic)=zmasq(ji)
235        END IF
236      END IF
237    END IF
238  END DO
239
240!--- Sub-surface ocean and sea ice (sea ice set to zero for start).
241  pctsrf(:,is_oce)=(1.-zmasq(:))
242  WHERE(pctsrf(:,is_oce)<EPSFRA) pctsrf(:,is_oce)=0.
243  IF(read_mask) pctsrf(:,is_oce)=1-zmasq(:)
244  isst=0
245  WHERE(pctsrf(2:klon-1,is_oce)>0.) isst=1
246
247!--- It is checked that the sub-surfaces sum is equal to 1.
248  ji=COUNT((ABS(SUM(pctsrf(:,:),dim=2))-1.0)>EPSFRA)
249  IF(ji/=0) WRITE(lunout,*) 'Sub-cell distribution problem for ',ji,' points'
250
251! Write physical initial state
252!*******************************************************************************
253  WRITE(lunout,*)'phystep ',dtvr,iphysiq,nbapp_rad
254  phystep = dtvr * FLOAT(iphysiq)
255  radpas  = NINT (86400./phystep/ FLOAT(nbapp_rad) )
256  WRITE(lunout,*)'phystep =', phystep, radpas
257
258! Init: ftsol, snsrf, qsolsrf, tsoil, rain_fall, snow_fall, solsw, sollw, z0
259!*******************************************************************************
260  DO i=1,nbsrf; ftsol(:,i) = tsol; END DO
261  DO i=1,nbsrf; snsrf(:,i) = sn;   END DO
262  falb_dir(:,is_ter,:) = 0.08
263  falb_dir(:,is_lic,:) = 0.6
264  falb_dir(:,is_oce,:) = 0.5
265  falb_dir(:,is_sic,:) = 0.6
266  fevap(:,:) = 0.
267  DO i=1,nbsrf; qsolsrf(:,i)=150.; END DO
268  DO i=1,nbsrf; DO j=1,nsoilmx; tsoil(:,j,i) = tsol; END DO; END DO
269  rain_fall  = 0.
270  snow_fall  = 0.
271  solsw      = 165.
272  sollw      = -53.
273  t_ancien   = 273.15
274  q_ancien   = 0.
275  agesno     = 0.
276
277  z0m(:,is_oce) = rugmer(:)
278  z0m(:,is_ter) = MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
279  z0m(:,is_lic) = MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
280  z0m(:,is_sic) = 0.001
281  z0h(:,:)=z0m(:,:)
282
283  fder    = 0.0
284  clwcon  = 0.0
285  rnebcon = 0.0
286  ratqs   = 0.0
287  run_off_lic_0 = 0.0
288  rugoro  = 0.0
289
290! Before phyredem calling, surface modules and values to be saved in startphy.nc
291! are initialized
292!*******************************************************************************
293  dummy            = 1.0
294  pbl_tke(:,:,:)   = 1.e-8
295  zmax0(:)         = 40.
296  f0(:)            = 1.e-5
297  sig1(:,:)        = 0.
298  w01(:,:)         = 0.
299  wake_deltat(:,:) = 0.
300  wake_deltaq(:,:) = 0.
301  wake_s(:)        = 0.
302  wake_cstar(:)    = 0.
303  wake_fip(:)      = 0.
304  wake_pe          = 0.
305  fm_therm         = 0.
306  entr_therm       = 0.
307  detr_therm       = 0.
308
309  CALL fonte_neige_init(run_off_lic_0)
310  CALL pbl_surface_init( fder, snsrf, qsolsrf, tsoil )
311  CALL phyredem( "startphy.nc" )
312
313!  WRITE(lunout,*)'CCCCCCCCCCCCCCCCCC REACTIVER SORTIE VISU DANS ETAT0'
314!  WRITE(lunout,*)'entree histclo'
315  CALL histclo()
316
317#endif
318!#endif of #ifdef CPP_EARTH
319
320END SUBROUTINE etat0phys_netcdf
321!
322!-------------------------------------------------------------------------------
323
324
325#ifdef CPP_EARTH
326!-------------------------------------------------------------------------------
327!
328SUBROUTINE start_init_orog(lon_in,lat_in,phis,masque)
329!
330!===============================================================================
331! Comment:
332!   This routine launch grid_noro, which computes parameters for SSO scheme as
333!   described in LOTT & MILLER (1997) and LOTT(1999).
334!===============================================================================
335  USE conf_dat_m,  ONLY: conf_dat2d
336!  USE grid_atob_m, ONLY: rugsoro
337  USE grid_noro_m, ONLY: grid_noro
338  IMPLICIT NONE
339!-------------------------------------------------------------------------------
340! Arguments:
341  REAL,    INTENT(IN)    :: lon_in(:), lat_in(:)   ! dim (iml) (jml)
342  REAL,    INTENT(INOUT) :: phis(:,:), masque(:,:) ! dim (iml,jml)
343!-------------------------------------------------------------------------------
344! Local variables:
345  CHARACTER(LEN=256) :: modname="start_init_orog"
346  CHARACTER(LEN=256) :: title="RELIEF"
347  INTEGER            :: fid, llm_tmp,ttm_tmp, iml,jml, iml_rel,jml_rel, itau(1)
348  REAL               :: lev(1), date, dt
349  REAL, ALLOCATABLE  :: lon_rad(:), lon_ini(:), lon_rel(:,:), relief_hi(:,:)
350  REAL, ALLOCATABLE  :: lat_rad(:), lat_ini(:), lat_rel(:,:), tmp_var  (:,:)
351  REAL, ALLOCATABLE  :: zmea0(:,:), zstd0(:,:), zsig0(:,:)
352  REAL, ALLOCATABLE  :: zgam0(:,:), zthe0(:,:), zpic0(:,:), zval0(:,:)
353!-------------------------------------------------------------------------------
354  iml=assert_eq(SIZE(lon_in),SIZE(phis,1),SIZE(masque,1),TRIM(modname)//" iml")
355  jml=assert_eq(SIZE(lat_in),SIZE(phis,2),SIZE(masque,2),TRIM(modname)//" jml")
356
357!--- HIGH RESOLUTION OROGRAPHY
358  CALL flininfo(orofname, iml_rel, jml_rel, llm_tmp, ttm_tmp, fid)
359
360  ALLOCATE(lat_rel(iml_rel,jml_rel),lon_rel(iml_rel,jml_rel))
361  CALL flinopen(orofname, .FALSE., iml_rel, jml_rel, llm_tmp, lon_rel, lat_rel,&
362                lev, ttm_tmp, itau, date, dt, fid)
363  ALLOCATE(relief_hi(iml_rel,jml_rel))
364  CALL flinget(fid, title, iml_rel, jml_rel, llm_tmp, ttm_tmp, 1, 1, relief_hi)
365  CALL flinclo(fid)
366
367!--- IF ANGLES ARE IN DEGREES, THEY ARE CONVERTED INTO RADIANS
368  ALLOCATE(lon_ini(iml_rel),lat_ini(jml_rel))
369  lon_ini(:)=lon_rel(:,1); IF(MAXVAL(lon_rel)>pi) lon_ini=lon_ini*deg2rad
370  lat_ini(:)=lat_rel(1,:); IF(MAXVAL(lat_rel)>pi) lat_ini=lat_ini*deg2rad
371
372!--- FIELDS ARE PROCESSED TO BE ON STANDARD ANGULAR DOMAINS
373  ALLOCATE(lon_rad(iml_rel),lat_rad(jml_rel))
374  CALL conf_dat2d(title, lon_ini, lat_ini, lon_rad, lat_rad, relief_hi, .FALSE.)
375  DEALLOCATE(lon_ini,lat_ini)
376
377!--- COMPUTING THE REQUIRED FIELDS USING ROUTINE grid_noro
378  WRITE(lunout,*)
379  WRITE(lunout,*)'*** Compute parameters needed for gravity wave drag code ***'
380
381!--- ALLOCATIONS OF SUB-CELL SCALES QUANTITIES
382  ALLOCATE(zmea0(iml,jml),zstd0(iml,jml)) !--- Mean orography and std deviation
383  ALLOCATE(zsig0(iml,jml),zgam0(iml,jml)) !--- Slope and nisotropy
384  ALLOCATE(zthe0(iml,jml))                !--- Highest slope orientation
385  ALLOCATE(zpic0(iml,jml),zval0(iml,jml)) !--- Peaks and valley heights
386
387!--- CALL OROGRAPHY MODULE TO COMPUTE FIELDS
388  CALL grid_noro(lon_rad,lat_rad,relief_hi,lon_in,lat_in,phis,zmea0,zstd0,     &
389                                      zsig0,zgam0,zthe0,zpic0,zval0,masque)
390  phis = phis * 9.81
391  phis(iml,:) = phis(1,:)
392
393!--- COMPUTE SURFACE ROUGHNESS
394!  WRITE(lunout,*)
395!  WRITE(lunout,*)'*** Compute surface roughness induced by the orography ***'
396!  ALLOCATE(tmp_var(iml-1,jml))
397!  CALL rugsoro(lon_rad, lat_rad, relief_hi, lon_in(1:iml-1), lat_in, tmp_var)
398!  ALLOCATE(rugo(iml,jml)); rugo(1:iml-1,:)=tmp_var; rugo(iml,:)=tmp_var(1,:)
399!  DEALLOCATE(tmp_var)
400  DEALLOCATE(relief_hi,lon_rad,lat_rad)
401
402!--- PUT QUANTITIES TO PHYSICAL GRID
403  CALL gr_dyn_fi(1,iml,jml,klon,zmea0,zmea); DEALLOCATE(zmea0)
404  CALL gr_dyn_fi(1,iml,jml,klon,zstd0,zstd); DEALLOCATE(zstd0)
405  CALL gr_dyn_fi(1,iml,jml,klon,zsig0,zsig); DEALLOCATE(zsig0)
406  CALL gr_dyn_fi(1,iml,jml,klon,zgam0,zgam); DEALLOCATE(zgam0)
407  CALL gr_dyn_fi(1,iml,jml,klon,zthe0,zthe); DEALLOCATE(zthe0)
408  CALL gr_dyn_fi(1,iml,jml,klon,zpic0,zpic); DEALLOCATE(zpic0)
409  CALL gr_dyn_fi(1,iml,jml,klon,zval0,zval); DEALLOCATE(zval0)
410
411
412END SUBROUTINE start_init_orog
413!
414!-------------------------------------------------------------------------------
415
416
417!-------------------------------------------------------------------------------
418!
419SUBROUTINE start_init_phys(lon_in,lat_in,lon_in2,lat_in2,ibar,phis)
420!
421!===============================================================================
422! Purpose:   Compute tsol and qsol, knowing phis.
423!===============================================================================
424  IMPLICIT NONE
425!-------------------------------------------------------------------------------
426! Arguments:
427  REAL,    INTENT(IN) :: lon_in (:),  lat_in (:)     ! dim (iml) (jml)
428  REAL,    INTENT(IN) :: lon_in2(:),  lat_in2(:)     ! dim (iml) (jml2)
429  LOGICAL, INTENT(IN) :: ibar
430  REAL,    INTENT(IN) :: phis(:,:)                   ! dim (iml,jml)
431!-------------------------------------------------------------------------------
432! Local variables:
433  CHARACTER(LEN=256) :: modname="start_init_phys", physfname="ECPHY.nc"
434  REAL               :: date, dt
435  INTEGER            :: iml, jml, jml2, itau(1)
436  REAL, ALLOCATABLE  :: lon_rad(:), lon_ini(:), var_ana(:,:)
437  REAL, ALLOCATABLE  :: lat_rad(:), lat_ini(:)
438  REAL, ALLOCATABLE  :: ts(:,:), qs(:,:)
439!-------------------------------------------------------------------------------
440  iml=assert_eq(SIZE(lon_in),SIZE(phis,1),SIZE(lon_in2),TRIM(modname)//" iml")
441  jml=assert_eq(SIZE(lat_in),SIZE(phis,2),              TRIM(modname)//" jml")
442  jml2=SIZE(lat_in2)
443
444  WRITE(lunout,*)'Opening the surface analysis'
445  CALL flininfo(physfname, iml_phys, jml_phys, llm_phys, ttm_phys, fid_phys)
446  WRITE(lunout,*) 'Values read: ',   iml_phys, jml_phys, llm_phys, ttm_phys
447
448  ALLOCATE(lat_phys(iml_phys,jml_phys),lon_phys(iml_phys,jml_phys))
449  ALLOCATE(levphys_ini(llm_phys))
450  CALL flinopen(physfname, .FALSE., iml_phys, jml_phys, llm_phys,              &
451                lon_phys,lat_phys,levphys_ini,ttm_phys,itau,date,dt,fid_phys)
452
453!--- IF ANGLES ARE IN DEGREES, THEY ARE CONVERTED INTO RADIANS
454  ALLOCATE(lon_ini(iml_phys),lat_ini(jml_phys))
455  lon_ini(:)=lon_phys(:,1); IF(MAXVAL(lon_phys)>pi) lon_ini=lon_ini*deg2rad
456  lat_ini(:)=lat_phys(1,:); IF(MAXVAL(lat_phys)>pi) lat_ini=lat_ini*deg2rad
457
458  ALLOCATE(var_ana(iml_phys,jml_phys),lon_rad(iml_phys),lat_rad(jml_phys))
459  CALL get_var_phys('ST'  ,ts)                   !--- SURFACE TEMPERATURE
460  CALL get_var_phys('CDSW',qs)                   !--- SOIL MOISTURE
461  CALL flinclo(fid_phys)
462  DEALLOCATE(var_ana,lon_rad,lat_rad,lon_ini,lat_ini)
463
464!--- TSOL AND QSOL ON PHYSICAL GRID
465  ALLOCATE(tsol(klon))
466  CALL gr_dyn_fi(1,iml,jml,klon,ts,tsol)
467  CALL gr_dyn_fi(1,iml,jml,klon,qs,qsol)
468  DEALLOCATE(ts,qs)
469
470CONTAINS
471
472!-------------------------------------------------------------------------------
473!
474SUBROUTINE get_var_phys(title,field)
475!
476!-------------------------------------------------------------------------------
477  USE conf_dat_m, ONLY: conf_dat2d
478  IMPLICIT NONE
479!-------------------------------------------------------------------------------
480! Arguments:
481  CHARACTER(LEN=*),  INTENT(IN)    :: title
482  REAL, ALLOCATABLE, INTENT(INOUT) :: field(:,:)
483!-------------------------------------------------------------------------------
484! Local variables:
485  INTEGER :: tllm
486!-------------------------------------------------------------------------------
487  SELECT CASE(title)
488    CASE('SP');        tllm=0
489    CASE('ST','CDSW'); tllm=llm_phys
490  END SELECT
491  IF(ALLOCATED(field)) RETURN
492  ALLOCATE(field(iml,jml)); field(:,:)=0.
493  CALL flinget(fid_phys,title,iml_phys,jml_phys,tllm,ttm_phys,1,1,var_ana)
494  CALL conf_dat2d(title, lon_ini, lat_ini,  lon_rad, lat_rad, var_ana, ibar)
495  CALL interp_startvar(title, ibar, .TRUE., lon_rad, lat_rad, var_ana,         &
496                            lon_in, lat_in, lon_in2, lat_in2, field)
497
498END SUBROUTINE get_var_phys
499!
500!-------------------------------------------------------------------------------
501!
502END SUBROUTINE start_init_phys
503!
504!-------------------------------------------------------------------------------
505
506
507!-------------------------------------------------------------------------------
508!
509SUBROUTINE interp_startvar(nam,ibar,ibeg,lon,lat,vari,lon1,lat1,lon2,lat2,varo)
510!
511!-------------------------------------------------------------------------------
512  USE inter_barxy_m, ONLY: inter_barxy
513  USE grid_atob_m,   ONLY: grille_m
514  IMPLICIT NONE
515!-------------------------------------------------------------------------------
516! Arguments:
517  CHARACTER(LEN=*), INTENT(IN)  :: nam
518  LOGICAL,          INTENT(IN)  :: ibar, ibeg
519  REAL,             INTENT(IN)  :: lon(:), lat(:)   ! dim (ii) (jj)
520  REAL,             INTENT(IN)  :: vari(:,:)        ! dim (ii,jj)
521  REAL,             INTENT(IN)  :: lon1(:), lat1(:) ! dim (i1) (j1)
522  REAL,             INTENT(IN)  :: lon2(:), lat2(:) ! dim (i1) (j2)
523  REAL,             INTENT(OUT) :: varo(:,:)        ! dim (i1) (j1)
524!-------------------------------------------------------------------------------
525! Local variables:
526  CHARACTER(LEN=256) :: modname="interp_startvar"
527  INTEGER            :: ii, jj, i1, j1, j2
528  REAL, ALLOCATABLE  :: vtmp(:,:)
529!-------------------------------------------------------------------------------
530  ii=assert_eq(SIZE(lon),            SIZE(vari,1),TRIM(modname)//" ii")
531  jj=assert_eq(SIZE(lat),            SIZE(vari,2),TRIM(modname)//" jj")
532  i1=assert_eq(SIZE(lon1),SIZE(lon2),SIZE(varo,1),TRIM(modname)//" i1")
533  j1=assert_eq(SIZE(lat1),           SIZE(varo,2),TRIM(modname)//" j1")
534  j2=SIZE(lat2)
535  ALLOCATE(vtmp(i1-1,j1))
536  IF(ibar) THEN
537    IF(ibeg.AND.prt_level>1) THEN
538      WRITE(lunout,*)"--------------------------------------------------------"
539      WRITE(lunout,*)"$$$ Interpolation barycentrique pour "//TRIM(nam)//" $$$"
540      WRITE(lunout,*)"--------------------------------------------------------"
541    END IF
542    CALL inter_barxy(lon, lat(:jj-1), vari, lon2(:i1-1), lat2, vtmp)
543  ELSE
544    CALL grille_m   (lon, lat,        vari, lon1,        lat1, vtmp)
545  END IF
546  CALL gr_int_dyn(vtmp, varo, i1-1, j1)
547
548END SUBROUTINE interp_startvar
549!
550!-------------------------------------------------------------------------------
551
552#endif
553!#endif of #ifdef CPP_EARTH
554
555END MODULE etat0phys
556!
557!*******************************************************************************
558
Note: See TracBrowser for help on using the repository browser.