Context Navigation

etat0phys_netcdf.F90 @ 2302

Last change on this file since 2302 was 2302, checked in by Ehouarn Millour, 9 years ago
Move etat0phys_netcdf.F90 to "dynlonlat_phylonlat/phylmd" as it relies on "phylmd" routines. Some cleanup to remove obsolete and unecessary CPP_EARTH preprocessing condition. EM
File size: 22.6 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format