source: LMDZ6/trunk/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.f90 @ 5435

Last change on this file since 5435 was 5296, checked in by abarral, 2 months ago

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