source: LMDZ6/trunk/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90 @ 3440

Last change on this file since 3440 was 3435, checked in by Laurent Fairhead, 6 years ago

"Historic" :-) commit merging the physics branch used for DYNAMICO with the LMDZ trunk.
The same physics branch can now be used seamlessly with the traditional lon-lat LMDZ
dynamical core and DYNAMICO.
Testing consisted in running a lon-lat LMDZ bucket simulation with the NPv6.1 physics package
with the original trunk sources and the merged sources. Tests were succesful in the sense that
numeric continuity was preserved in the restart files from both simulation. Further tests
included running both versions of the physics codes for one year in a LMDZOR setting in which
the restart files also came out identical.

Caution:

  • as the physics package now manages unstructured grids, grid information needs to be transmitted

to the surface scheme ORCHIDEE. This means that the interface defined in surf_land_orchidee_mod.F90
is only compatible with ORCHIDEE version orchidee2.1 and later versions. If previous versions of
ORCHIDEE need to be used, the CPP key ORCHIDEE_NOUNSTRUCT needs to be set at compilation time.
This is done automatically if makelmdz/makelmdz_fcm are called with the veget orchidee2.0 switch

  • due to a limitation in XIOS, the time at which limit conditions will be read in by DYNAMICO will be

delayed by one physic timestep with respect to the time it is read in by the lon-lat model. This is caused
by the line

IF (MOD(itime-1, lmt_pas) == 0 .OR. (jour_lu /= jour .AND. grid_type /= unstructured)) THEN ! time to read

in limit_read_mod.F90

Work still needed on COSP integration and XML files for DYNAMICO

EM, YM, LF

File size: 21.6 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  USE dimphy,             ONLY: klon
39  USE conf_dat_m,         ONLY: conf_dat2d
40  USE phys_state_var_mod, ONLY: zmea, zstd, zsig, zgam, zthe, zpic, zval, z0m, &
41          solsw, radsol, t_ancien, wake_deltat, wake_s,  rain_fall, qsol, z0h, &
42          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, ql_ancien, qs_ancien, prlw_ancien, prsw_ancien, &
46    prw_ancien, sollwdown
47  USE comconst_mod, ONLY: pi, dtvr
48
49  PRIVATE
50  PUBLIC :: etat0phys_netcdf
51
52  include "iniprint.h"
53  include "dimensions.h"
54  include "paramet.h"
55  include "comgeom2.h"
56  include "dimsoil.h"
57  include "clesphys.h"
58  REAL, SAVE :: deg2rad
59  REAL, SAVE, ALLOCATABLE :: tsol(:)
60  INTEGER,            SAVE      :: iml_phys, jml_phys, llm_phys, ttm_phys, fid_phys
61  REAL, ALLOCATABLE,  SAVE      :: lon_phys(:,:), lat_phys(:,:), levphys_ini(:)
62  CHARACTER(LEN=256), PARAMETER :: oroparam="oro_params.nc"
63  CHARACTER(LEN=256), PARAMETER :: orofname="Relief.nc", orogvar="RELIEF"
64  CHARACTER(LEN=256), PARAMETER :: phyfname="ECPHY.nc",  psrfvar="SP"
65  CHARACTER(LEN=256), PARAMETER :: qsolvar="CDSW",       tsrfvar="ST"
66
67
68CONTAINS
69
70
71!-------------------------------------------------------------------------------
72!
73SUBROUTINE etat0phys_netcdf(masque, phis)
74!
75!-------------------------------------------------------------------------------
76! Purpose: Creates initial states
77!-------------------------------------------------------------------------------
78! Notes:  1) This routine is designed to work for Earth
79!         2) If masque(:,:)/=-99999., masque and phis are already known.
80!         Otherwise: compute it.
81!-------------------------------------------------------------------------------
82  USE control_mod
83  USE fonte_neige_mod
84  USE pbl_surface_mod
85  USE regr_horiz_time_climoz_m, ONLY: regr_horiz_time_climoz
86  USE indice_sol_mod
87  USE conf_phys_m, ONLY: conf_phys
88  USE init_ssrf_m, ONLY: start_init_subsurf
89  !use ioipsl_getincom
90  IMPLICIT NONE
91!-------------------------------------------------------------------------------
92! Arguments:
93  REAL,    INTENT(INOUT) :: masque(:,:) !--- Land mask           dim(iip1,jjp1)
94  REAL,    INTENT(INOUT) :: phis  (:,:) !--- Ground geopotential dim(iip1,jjp1)
95!-------------------------------------------------------------------------------
96! Local variables:
97  CHARACTER(LEN=256) :: modname="etat0phys_netcdf", fmt
98  INTEGER            :: i, j, l, ji, iml, jml
99  LOGICAL            :: read_mask
100  REAL               :: phystep, dummy
101  REAL, DIMENSION(SIZE(masque,1),SIZE(masque,2)) :: masque_tmp,phiso
102  REAL, DIMENSION(klon)               :: sn, rugmer, run_off_lic_0, fder
103  REAL, DIMENSION(klon,nbsrf)         :: qsolsrf, snsrf
104  REAL, DIMENSION(klon,nsoilmx,nbsrf) :: tsoil
105
106!--- Arguments for conf_phys
107  LOGICAL :: ok_journe, ok_mensuel, ok_instan, ok_hf, ok_LES, callstats
108  REAL    :: solarlong0, seuil_inversion, fact_cldcon, facttemps
109  LOGICAL :: ok_newmicro
110  INTEGER :: iflag_radia, iflag_cldcon, iflag_ratqs
111  REAL    :: ratqsbas, ratqshaut, tau_ratqs
112  LOGICAL :: ok_ade, ok_aie, ok_alw, ok_cdnc, aerosol_couple, chemistry_couple
113  INTEGER :: flag_aerosol
114  INTEGER :: flag_aerosol_strat
115  LOGICAL :: flag_aer_feedback
116  LOGICAL :: flag_bc_internal_mixture
117  LOGICAL :: new_aod
118  REAL    :: bl95_b0, bl95_b1
119  INTEGER :: read_climoz                        !--- Read ozone climatology
120  REAL    :: alp_offset
121  LOGICAL :: filtre_oro=.false.
122
123  deg2rad= pi/180.0
124  iml=assert_eq(SIZE(masque,1),SIZE(phis,1),TRIM(modname)//" iml")
125  jml=assert_eq(SIZE(masque,2),SIZE(phis,2),TRIM(modname)//" jml")
126
127! Physics configuration
128!*******************************************************************************
129  CALL conf_phys(  ok_journe, ok_mensuel, ok_instan, ok_hf, ok_LES,     &
130                   callstats,                                           &
131                   solarlong0,seuil_inversion,                          &
132                   fact_cldcon, facttemps,ok_newmicro,iflag_radia,      &
133                   iflag_cldcon,                                        &
134                   iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs,            &
135                   ok_ade, ok_aie, ok_alw, ok_cdnc, aerosol_couple,     &
136                   chemistry_couple, flag_aerosol, flag_aerosol_strat,  &
137                   flag_aer_feedback,                                   &
138                   new_aod, flag_bc_internal_mixture, bl95_b0, bl95_b1, &
139                   read_climoz, alp_offset)
140  CALL phys_state_var_init(read_climoz)
141
142!--- Initial atmospheric CO2 conc. from .def file
143  co2_ppm0 = co2_ppm
144
145! Compute ground geopotential, sub-cells quantities and possibly the mask.
146!*******************************************************************************
147  read_mask=ANY(masque/=-99999.); masque_tmp=masque
148  CALL start_init_orog(rlonv, rlatu, phis, masque_tmp)
149
150  CALL getin('filtre_oro',filtre_oro)
151  IF (filtre_oro) CALL filtreoro(size(phis,1),size(phis,2),phis,masque_tmp,rlatu)
152
153  WRITE(fmt,"(i4,'i1)')")iml ; fmt='('//ADJUSTL(fmt)
154  IF(.NOT.read_mask) THEN                       !--- Keep mask form orography
155    masque=masque_tmp
156    IF(prt_level>=1) THEN
157      WRITE(lunout,*)'BUILT MASK :'
158      WRITE(lunout,fmt) NINT(masque)
159    END IF
160    WHERE(   masque(:,:)<EPSFRA) masque(:,:)=0.
161    WHERE(1.-masque(:,:)<EPSFRA) masque(:,:)=1.
162  END IF
163  CALL gr_dyn_fi(1,iml,jml,klon,masque,zmasq) !--- Land mask to physical grid
164
165! Compute tsol and qsol on physical grid, knowing phis on 2D grid.
166!*******************************************************************************
167  CALL start_init_phys(rlonu, rlatv, phis)
168
169! Some initializations.
170!*******************************************************************************
171  sn    (:) = 0.0                               !--- Snow
172  radsol(:) = 0.0                               !--- Net radiation at ground
173  rugmer(:) = 0.001                             !--- Ocean rugosity
174  !--- Ozone (zonal or 3D) interpolation in space and time (if 2nd arg is TRUE)
175  IF(read_climoz>=1) CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz)
176
177! Sub-surfaces initialization.
178!*******************************************************************************
179  CALL start_init_subsurf(read_mask)
180
181! Write physical initial state
182!*******************************************************************************
183  WRITE(lunout,*)'phystep ',dtvr,iphysiq,nbapp_rad
184  phystep = dtvr * FLOAT(iphysiq)
185  radpas  = NINT (86400./phystep/ FLOAT(nbapp_rad) )
186  WRITE(lunout,*)'phystep =', phystep, radpas
187
188! Init: ftsol, snsrf, qsolsrf, tsoil, rain_fall, snow_fall, solsw, sollw, z0
189!*******************************************************************************
190  DO i=1,nbsrf; ftsol(:,i) = tsol; END DO
191  DO i=1,nbsrf; snsrf(:,i) = sn;   END DO
192  falb_dir(:, :, is_ter) = 0.08
193  falb_dir(:, :, is_lic) = 0.6
194  falb_dir(:, :, is_oce) = 0.5
195  falb_dir(:, :, is_sic) = 0.6
196  fevap(:,:) = 0.
197  DO i=1,nbsrf; qsolsrf(:,i)=150.; END DO
198  DO i=1,nbsrf; DO j=1,nsoilmx; tsoil(:,j,i) = tsol; END DO; END DO
199  rain_fall  = 0.
200  snow_fall  = 0.
201  solsw      = 165.
202  sollw      = -53.
203!ym warning missing init for sollwdown => set to 0
204  sollwdown  = 0.
205  t_ancien   = 273.15
206  q_ancien   = 0.
207  ql_ancien = 0.
208  qs_ancien = 0.
209  prlw_ancien = 0.
210  prsw_ancien = 0.
211  prw_ancien = 0.
212  agesno     = 0.
213
214  z0m(:,is_oce) = rugmer(:)
215  z0m(:,is_ter) = MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
216  z0m(:,is_lic) = MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
217  z0m(:,is_sic) = 0.001
218  z0h(:,:)=z0m(:,:)
219
220  fder    = 0.0
221  clwcon  = 0.0
222  rnebcon = 0.0
223  ratqs   = 0.0
224  run_off_lic_0 = 0.0
225  rugoro  = 0.0
226
227! Before phyredem calling, surface modules and values to be saved in startphy.nc
228! are initialized
229!*******************************************************************************
230  dummy            = 1.0
231  pbl_tke(:,:,:)   = 1.e-8
232  zmax0(:)         = 40.
233  f0(:)            = 1.e-5
234  sig1(:,:)        = 0.
235  w01(:,:)         = 0.
236  wake_deltat(:,:) = 0.
237  wake_deltaq(:,:) = 0.
238  wake_s(:)        = 0.
239  wake_cstar(:)    = 0.
240  wake_fip(:)      = 0.
241  wake_pe          = 0.
242  fm_therm         = 0.
243  entr_therm       = 0.
244  detr_therm       = 0.
245
246  CALL fonte_neige_init(run_off_lic_0)
247  CALL pbl_surface_init( fder, snsrf, qsolsrf, tsoil )
248  CALL phyredem( "startphy.nc" )
249
250!  WRITE(lunout,*)'CCCCCCCCCCCCCCCCCC REACTIVER SORTIE VISU DANS ETAT0'
251!  WRITE(lunout,*)'entree histclo'
252  CALL histclo()
253
254END SUBROUTINE etat0phys_netcdf
255!
256!-------------------------------------------------------------------------------
257
258
259!-------------------------------------------------------------------------------
260!
261SUBROUTINE start_init_orog(lon_in,lat_in,phis,masque)
262!
263!===============================================================================
264! Comment:
265!   This routine launch grid_noro, which computes parameters for SSO scheme as
266!   described in LOTT & MILLER (1997) and LOTT(1999).
267!   In case the file oroparam is present and the key read_orop is activated,
268!   grid_noro is bypassed and sub-cell parameters are read from the file.
269!===============================================================================
270  USE grid_noro_m, ONLY: grid_noro, read_noro
271  USE logic_mod,   ONLY: read_orop
272  IMPLICIT NONE
273!-------------------------------------------------------------------------------
274! Arguments:
275  REAL,    INTENT(IN)    :: lon_in(:), lat_in(:)   ! dim (iml) (jml)
276  REAL,    INTENT(INOUT) :: phis(:,:), masque(:,:) ! dim (iml,jml)
277!-------------------------------------------------------------------------------
278! Local variables:
279  CHARACTER(LEN=256) :: modname
280  INTEGER            :: fid, llm_tmp,ttm_tmp, iml,jml, iml_rel,jml_rel, itau(1)
281  INTEGER            :: ierr
282  REAL               :: lev(1), date, dt
283  REAL, ALLOCATABLE  :: lon_rad(:), lon_ini(:), lon_rel(:,:), relief_hi(:,:)
284  REAL, ALLOCATABLE  :: lat_rad(:), lat_ini(:), lat_rel(:,:), tmp_var  (:,:)
285  REAL, ALLOCATABLE  :: zmea0(:,:), zstd0(:,:), zsig0(:,:)
286  REAL, ALLOCATABLE  :: zgam0(:,:), zthe0(:,:), zpic0(:,:), zval0(:,:)
287!-------------------------------------------------------------------------------
288  modname="start_init_orog"
289  iml=assert_eq(SIZE(lon_in),SIZE(phis,1),SIZE(masque,1),TRIM(modname)//" iml")
290  jml=assert_eq(SIZE(lat_in),SIZE(phis,2),SIZE(masque,2),TRIM(modname)//" jml")
291
292!--- HIGH RESOLUTION OROGRAPHY
293  CALL flininfo(orofname, iml_rel, jml_rel, llm_tmp, ttm_tmp, fid)
294
295  ALLOCATE(lat_rel(iml_rel,jml_rel),lon_rel(iml_rel,jml_rel))
296  CALL flinopen(orofname, .FALSE., iml_rel, jml_rel, llm_tmp, lon_rel, lat_rel,&
297                lev, ttm_tmp, itau, date, dt, fid)
298  ALLOCATE(relief_hi(iml_rel,jml_rel))
299  CALL flinget(fid, orogvar, iml_rel, jml_rel, llm_tmp, ttm_tmp, 1,1, relief_hi)
300  CALL flinclo(fid)
301
302!--- IF ANGLES ARE IN DEGREES, THEY ARE CONVERTED INTO RADIANS
303  ALLOCATE(lon_ini(iml_rel),lat_ini(jml_rel))
304  lon_ini(:)=lon_rel(:,1); IF(MAXVAL(lon_rel)>pi) lon_ini=lon_ini*deg2rad
305  lat_ini(:)=lat_rel(1,:); IF(MAXVAL(lat_rel)>pi) lat_ini=lat_ini*deg2rad
306
307!--- FIELDS ARE PROCESSED TO BE ON STANDARD ANGULAR DOMAINS
308  ALLOCATE(lon_rad(iml_rel),lat_rad(jml_rel))
309  CALL conf_dat2d(orogvar, lon_ini, lat_ini, lon_rad, lat_rad, relief_hi,.FALSE.)
310  DEALLOCATE(lon_ini,lat_ini)
311
312!--- COMPUTING THE REQUIRED FIELDS USING ROUTINE grid_noro
313  WRITE(lunout,*)
314  WRITE(lunout,*)'*** Compute parameters needed for gravity wave drag code ***'
315
316!--- ALLOCATIONS OF SUB-CELL SCALES QUANTITIES
317  ALLOCATE(zmea0(iml,jml),zstd0(iml,jml)) !--- Mean orography and std deviation
318  ALLOCATE(zsig0(iml,jml),zgam0(iml,jml)) !--- Slope and nisotropy
319  zsig0(:,:)=0   !ym uninitialized variable
320  zgam0(:,:)=0   !ym uninitialized variable
321  ALLOCATE(zthe0(iml,jml))                !--- Highest slope orientation
322  zthe0(:,:)=0   !ym uninitialized variable
323  ALLOCATE(zpic0(iml,jml),zval0(iml,jml)) !--- Peaks and valley heights
324
325!--- READ SUB-CELL SCALES PARAMETERS FROM A FILE (AT RIGHT RESOLUTION)
326  OPEN(UNIT=66,FILE=oroparam,STATUS='OLD',IOSTAT=ierr)
327  IF(ierr==0.AND.read_orop) THEN
328    CLOSE(UNIT=66)
329    CALL read_noro(lon_in,lat_in,oroparam,                                     &
330                   phis,zmea0,zstd0,zsig0,zgam0,zthe0,zpic0,zval0,masque)
331  ELSE
332!--- CALL OROGRAPHY MODULE TO COMPUTE FIELDS
333    CALL grid_noro(lon_rad,lat_rad,relief_hi,lon_in,lat_in,                    &
334                   phis,zmea0,zstd0,zsig0,zgam0,zthe0,zpic0,zval0,masque)
335  END IF
336  phis = phis * 9.81
337  phis(iml,:) = phis(1,:)
338  DEALLOCATE(relief_hi,lon_rad,lat_rad)
339
340!--- PUT QUANTITIES TO PHYSICAL GRID
341  CALL gr_dyn_fi(1,iml,jml,klon,zmea0,zmea); DEALLOCATE(zmea0)
342  CALL gr_dyn_fi(1,iml,jml,klon,zstd0,zstd); DEALLOCATE(zstd0)
343  CALL gr_dyn_fi(1,iml,jml,klon,zsig0,zsig); DEALLOCATE(zsig0)
344  CALL gr_dyn_fi(1,iml,jml,klon,zgam0,zgam); DEALLOCATE(zgam0)
345  CALL gr_dyn_fi(1,iml,jml,klon,zthe0,zthe); DEALLOCATE(zthe0)
346  CALL gr_dyn_fi(1,iml,jml,klon,zpic0,zpic); DEALLOCATE(zpic0)
347  CALL gr_dyn_fi(1,iml,jml,klon,zval0,zval); DEALLOCATE(zval0)
348
349
350END SUBROUTINE start_init_orog
351!
352!-------------------------------------------------------------------------------
353
354
355!-------------------------------------------------------------------------------
356!
357SUBROUTINE start_init_phys(lon_in,lat_in,phis)
358!
359!===============================================================================
360! Purpose:   Compute tsol and qsol, knowing phis.
361!===============================================================================
362  IMPLICIT NONE
363!-------------------------------------------------------------------------------
364! Arguments:
365  REAL,    INTENT(IN) :: lon_in(:),  lat_in(:)       ! dim (iml) (jml2)
366  REAL,    INTENT(IN) :: phis(:,:)                   ! dim (iml,jml)
367!-------------------------------------------------------------------------------
368! Local variables:
369  CHARACTER(LEN=256) :: modname
370  REAL               :: date, dt
371  INTEGER            :: iml, jml, jml2, itau(1)
372  REAL, ALLOCATABLE  :: lon_rad(:), lon_ini(:), var_ana(:,:)
373  REAL, ALLOCATABLE  :: lat_rad(:), lat_ini(:)
374  REAL, ALLOCATABLE  :: ts(:,:), qs(:,:)
375!-------------------------------------------------------------------------------
376  modname="start_init_phys"
377  iml=assert_eq(SIZE(lon_in),SIZE(phis,1),TRIM(modname)//" iml")
378  jml=SIZE(phis,2); jml2=SIZE(lat_in)
379
380  WRITE(lunout,*)'Opening the surface analysis'
381  CALL flininfo(phyfname, iml_phys, jml_phys, llm_phys, ttm_phys, fid_phys)
382  WRITE(lunout,*) 'Values read: ',  iml_phys, jml_phys, llm_phys, ttm_phys
383
384  ALLOCATE(lat_phys(iml_phys,jml_phys),lon_phys(iml_phys,jml_phys))
385  ALLOCATE(levphys_ini(llm_phys))
386  CALL flinopen(phyfname, .FALSE., iml_phys, jml_phys, llm_phys,              &
387                lon_phys,lat_phys,levphys_ini,ttm_phys,itau,date,dt,fid_phys)
388
389!--- IF ANGLES ARE IN DEGREES, THEY ARE CONVERTED INTO RADIANS
390  ALLOCATE(lon_ini(iml_phys),lat_ini(jml_phys))
391  lon_ini(:)=lon_phys(:,1); IF(MAXVAL(lon_phys)>pi) lon_ini=lon_ini*deg2rad
392  lat_ini(:)=lat_phys(1,:); IF(MAXVAL(lat_phys)>pi) lat_ini=lat_ini*deg2rad
393
394  ALLOCATE(var_ana(iml_phys,jml_phys),lon_rad(iml_phys),lat_rad(jml_phys))
395  CALL get_var_phys(tsrfvar,ts)                   !--- SURFACE TEMPERATURE
396  CALL get_var_phys(qsolvar,qs)                   !--- SOIL MOISTURE
397  CALL flinclo(fid_phys)
398  DEALLOCATE(var_ana,lon_rad,lat_rad,lon_ini,lat_ini)
399
400!--- TSOL AND QSOL ON PHYSICAL GRID
401  ALLOCATE(tsol(klon))
402  CALL gr_dyn_fi(1,iml,jml,klon,ts,tsol)
403  CALL gr_dyn_fi(1,iml,jml,klon,qs,qsol)
404  DEALLOCATE(ts,qs)
405
406CONTAINS
407
408!-------------------------------------------------------------------------------
409!
410SUBROUTINE get_var_phys(title,field)
411!
412!-------------------------------------------------------------------------------
413  IMPLICIT NONE
414!-------------------------------------------------------------------------------
415! Arguments:
416  CHARACTER(LEN=*),  INTENT(IN)    :: title
417  REAL, ALLOCATABLE, INTENT(INOUT) :: field(:,:)
418!-------------------------------------------------------------------------------
419! Local variables:
420  INTEGER :: tllm
421!-------------------------------------------------------------------------------
422  SELECT CASE(title)
423    CASE(psrfvar);         tllm=0
424    CASE(tsrfvar,qsolvar); tllm=llm_phys
425  END SELECT
426  IF(ALLOCATED(field)) RETURN
427  ALLOCATE(field(iml,jml)); field(:,:)=0.
428  CALL flinget(fid_phys,title,iml_phys,jml_phys,tllm,ttm_phys,1,1,var_ana)
429  CALL conf_dat2d(title, lon_ini, lat_ini, lon_rad, lat_rad, var_ana, .TRUE.)
430  CALL interp_startvar(title, .TRUE., lon_rad, lat_rad, var_ana,               &
431                                      lon_in,  lat_in,  field)
432
433END SUBROUTINE get_var_phys
434!
435!-------------------------------------------------------------------------------
436!
437END SUBROUTINE start_init_phys
438!
439!-------------------------------------------------------------------------------
440
441
442!-------------------------------------------------------------------------------
443!
444SUBROUTINE interp_startvar(nam,ibeg,lon,lat,vari,lon2,lat2,varo)
445!
446!-------------------------------------------------------------------------------
447  USE inter_barxy_m, ONLY: inter_barxy
448  IMPLICIT NONE
449!-------------------------------------------------------------------------------
450! Arguments:
451  CHARACTER(LEN=*), INTENT(IN)  :: nam
452  LOGICAL,          INTENT(IN)  :: ibeg
453  REAL,             INTENT(IN)  :: lon(:), lat(:)   ! dim (ii) (jj)
454  REAL,             INTENT(IN)  :: vari(:,:)        ! dim (ii,jj)
455  REAL,             INTENT(IN)  :: lon2(:), lat2(:) ! dim (i1) (j2)
456  REAL,             INTENT(OUT) :: varo(:,:)        ! dim (i1) (j1)
457!-------------------------------------------------------------------------------
458! Local variables:
459  CHARACTER(LEN=256) :: modname
460  INTEGER            :: ii, jj, i1, j1, j2
461  REAL, ALLOCATABLE  :: vtmp(:,:)
462!-------------------------------------------------------------------------------
463  modname="interp_startvar"
464  ii=assert_eq(SIZE(lon), SIZE(vari,1),TRIM(modname)//" ii")
465  jj=assert_eq(SIZE(lat), SIZE(vari,2),TRIM(modname)//" jj")
466  i1=assert_eq(SIZE(lon2),SIZE(varo,1),TRIM(modname)//" i1")
467  j1=SIZE(varo,2); j2=SIZE(lat2)
468  ALLOCATE(vtmp(i1-1,j1))
469  IF(ibeg.AND.prt_level>1) THEN
470    WRITE(lunout,*)"--------------------------------------------------------"
471    WRITE(lunout,*)"$$$ Interpolation barycentrique pour "//TRIM(nam)//" $$$"
472    WRITE(lunout,*)"--------------------------------------------------------"
473  END IF
474  CALL inter_barxy(lon, lat(:jj-1), vari, lon2(:i1-1), lat2, vtmp)
475  CALL gr_int_dyn(vtmp, varo, i1-1, j1)
476
477END SUBROUTINE interp_startvar
478!
479!-------------------------------------------------------------------------------
480!
481!*******************************************************************************
482
483SUBROUTINE filtreoro(imp1,jmp1,phis,masque,rlatu)
484
485IMPLICIT NONE
486
487  INTEGER imp1,jmp1
488  REAL, DIMENSION(imp1,jmp1) :: phis,masque
489  REAL, DIMENSION(jmp1) :: rlatu
490  REAL, DIMENSION(imp1) :: wwf
491  REAL, DIMENSION(imp1,jmp1) :: phiso
492  INTEGER :: ifiltre,ifi,ii,i,j
493  REAL :: coslat0,ssz
494
495  coslat0=0.5
496  phiso=phis
497  do j=2,jmp1-1
498     print*,'avant if ',cos(rlatu(j)),coslat0
499     if (cos(rlatu(j))<coslat0) then
500         ! nb de pts affectes par le filtrage de part et d'autre du pt
501         ifiltre=(coslat0/cos(rlatu(j))-1.)/2.
502         wwf=0.
503         do i=1,ifiltre
504            wwf(i)=1.
505         enddo
506         wwf(ifiltre+1)=(coslat0/cos(rlatu(j))-1.)/2.-ifiltre
507         do i=1,imp1-1
508            if (masque(i,j)>0.9) then
509               ssz=phis(i,j)
510               do ifi=1,ifiltre+1
511                  ii=i+ifi
512                  if (ii>imp1-1) ii=ii-imp1+1
513                  ssz=ssz+wwf(ifi)*phis(ii,j)
514                  ii=i-ifi
515                  if (ii<1) ii=ii+imp1-1
516                  ssz=ssz+wwf(ifi)*phis(ii,j)
517               enddo
518               phis(i,j)=ssz*cos(rlatu(j))/coslat0
519            endif
520         enddo
521         print*,'j=',j,coslat0/cos(rlatu(j)), (1.+2.*sum(wwf))*cos(rlatu(j))/coslat0
522     endif
523  enddo
524  call dump2d(imp1,jmp1,phis,'phis ')
525  call dump2d(imp1,jmp1,masque,'masque ')
526  call dump2d(imp1,jmp1,phis-phiso,'dphis ')
527
528END SUBROUTINE filtreoro
529
530
531END MODULE etat0phys
Note: See TracBrowser for help on using the repository browser.