source: LMDZ6/branches/IPSLCM6.0.15/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90 @ 3607

Last change on this file since 3607 was 3607, checked in by jghattas, 5 years ago

Revert commit [3604]. This is only done temporary because we need to make a correction for Jean-Zay and to have a revision without these changes to go into IPSLCM6.1.10.

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