Context Navigation

create_etat0_unstruct_mod.F90 @ 5169

Last change on this file since 5169 was 5084, checked in by Laurent Fairhead, 12 months ago
Reverting to r4065. Updating fortran standard broke too much stuff. Will do it by smaller chunks AB, LF
File size: 10.0 KB

Line
1	MODULE create_etat0_unstruct_mod
2
3	REAL, SAVE, ALLOCATABLE :: zmea_gw(:)
4	!$OMP THREADPRIVATE(zmea_gw)
5	REAL, SAVE, ALLOCATABLE :: zpic_gw(:)
6	!$OMP THREADPRIVATE(zpic_gw)
7	REAL, SAVE, ALLOCATABLE :: zval_gw(:)
8	!$OMP THREADPRIVATE(zval_gw)
9	REAL, SAVE, ALLOCATABLE :: zstd_gw(:)
10	!$OMP THREADPRIVATE(zstd_gw)
11	REAL, SAVE, ALLOCATABLE :: zsig_gw(:)
12	!$OMP THREADPRIVATE(zsig_gw)
13	REAL, SAVE, ALLOCATABLE :: zgam_gw(:)
14	!$OMP THREADPRIVATE(zgam_gw)
15	REAL, SAVE, ALLOCATABLE :: zthe_gw(:)
16	!$OMP THREADPRIVATE(zthe_gw)
17
18	PRIVATE zmea_gw, zpic_gw, zval_gw, zstd_gw, zsig_gw, zgam_gw, zthe_gw
19
20
21	CONTAINS
22
23	SUBROUTINE init_create_etat0_unstruct
24	USE lmdz_xios
25	USE netcdf
26	USE mod_phys_lmdz_para
27	IMPLICIT NONE
28	INTEGER :: file_id, iret
29
30	! for coupling activate ocean fraction reading from file "ocean_fraction.nc"
31	IF (is_omp_master) THEN
32
33	IF (NF90_OPEN("ocean_fraction.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
34	CALL xios_set_file_attr("frac_ocean",enabled=.TRUE.)
35	CALL xios_set_field_attr("mask",field_ref="frac_ocean_read")
36	iret=NF90_CLOSE(file_id)
37	ELSE IF (NF90_OPEN("land_water_0.05.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
38	CALL xios_set_file_attr("land_water",name="land_water_0.05",enabled=.TRUE.)
39	CALL xios_set_field_attr("mask",field_ref="land_water")
40	iret=NF90_CLOSE(file_id)
41	ELSE IF (NF90_OPEN("land_water_0.25.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
42	CALL xios_set_file_attr("land_water",name="land_water_0.25",enabled=.TRUE.)
43	CALL xios_set_field_attr("mask",field_ref="land_water")
44	iret=NF90_CLOSE(file_id)
45	ELSE IF (NF90_OPEN("land_water_0.50.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
46	CALL xios_set_file_attr("land_water",name="land_water_0.50",enabled=.TRUE.)
47	CALL xios_set_field_attr("mask",field_ref="land_water")
48	iret=NF90_CLOSE(file_id)
49	ENDIF
50
51	ENDIF
52
53	END SUBROUTINE init_create_etat0_unstruct
54
55
56	SUBROUTINE init_param_gw(zmea, zpic, zval, zstd, zsig, zgam, zthe)
57	USE dimphy
58	REAL, INTENT(IN) :: zmea(klon)
59	REAL, INTENT(IN) :: zpic(klon)
60	REAL, INTENT(IN) :: zval(klon)
61	REAL, INTENT(IN) :: zstd(klon)
62	REAL, INTENT(IN) :: zsig(klon)
63	REAL, INTENT(IN) :: zgam(klon)
64	REAL, INTENT(IN) :: zthe(klon)
65
66	ALLOCATE(zmea_gw(klon), zpic_gw(klon), zval_gw(klon), zstd_gw(klon), zsig_gw(klon), zgam_gw(klon), zthe_gw(klon))
67
68	zmea_gw(:)=zmea(:)
69	zpic_gw(:)=zpic(:)
70	zval_gw(:)=zval(:)
71	zstd_gw(:)=zstd(:)
72	zsig_gw(:)=zsig(:)
73	zgam_gw(:)=zgam(:)
74	zthe_gw(:)=zthe(:)
75
76	END SUBROUTINE init_param_gw
77
78
79
80
81	SUBROUTINE create_etat0_unstruct
82	USE dimphy
83	USE lmdz_xios
84	USE infotrac_phy
85	USE fonte_neige_mod
86	USE pbl_surface_mod
87	USE phys_state_var_mod
88	USE indice_sol_mod
89	USE surface_data, ONLY: landice_opt
90	USE mod_phys_lmdz_para
91	USE print_control_mod, ONLY: lunout
92	USE geometry_mod
93	USE ioipsl_getin_p_mod, ONLY: getin_p
94
95	IMPLICIT NONE
96	INCLUDE 'dimsoil.h'
97	include "clesphys.h"
98
99	LOGICAL :: no_ter_antartique ! If true, no land points are allowed at Antartic
100	REAL, DIMENSION(klon) :: tsol
101	REAL, DIMENSION(klon) :: sn
102	REAL, DIMENSION(klon) :: rugmer
103	REAL, DIMENSION(klon) :: run_off_lic_0
104	REAL, DIMENSION(klon) :: lic
105	REAL, DIMENSION(klon) :: fder
106
107	REAL, DIMENSION(klon,nbsrf) :: qsurf, snsrf
108	REAL, DIMENSION(klon,nsoilmx,nbsrf) :: tsoil
109
110	REAL, DIMENSION(klon_mpi) :: tsol_mpi, qsol_mpi, zmasq_mpi, lic_mpi
111	REAL, DIMENSION(klon_mpi) :: zmea_mpi, zstd_mpi, zsig_mpi, zgam_mpi, zthe_mpi
112	REAL, DIMENSION(klon_mpi) :: cell_area_mpi
113	REAL, DIMENSION(klon_mpi,nbsrf) :: pctsrf_mpi
114
115	INCLUDE "compbl.h"
116	INCLUDE "alpale.h"
117
118	INTEGER :: ji,j,i
119
120
121	!--- Initial atmospheric CO2 conc. from .def file
122	co2_ppm0 = co2_ppm
123
124	IF (is_omp_master) THEN
125	CALL xios_recv_field("ts",tsol_mpi)
126	CALL xios_recv_field("qs",qsol_mpi)
127	CALL xios_recv_field("mask",zmasq_mpi)
128	IF (landice_opt .LT. 2) CALL xios_recv_field("landice",lic_mpi)
129	ENDIF
130	CALL scatter_omp(tsol_mpi,tsol)
131	CALL scatter_omp(qsol_mpi,qsol)
132	CALL scatter_omp(zmasq_mpi,zmasq)
133	IF (landice_opt .LT. 2) CALL scatter_omp(lic_mpi,lic)
134
135	radsol(:) = 0.0
136	rugmer(:) = 0.001
137	sn(:) = 0
138
139	WHERE(qsol(:)<0) qsol(:)=0
140
141	WHERE( zmasq(:)<EPSFRA) zmasq(:)=0.
142	WHERE(1.-zmasq(:)<EPSFRA) zmasq(:)=1.
143
144	pctsrf(:,:) = 0
145	IF (landice_opt .LT. 2) THEN
146	pctsrf(:,is_lic)=lic
147	WHERE(pctsrf(:,is_lic)<EPSFRA) pctsrf(:,is_lic)=0.
148	WHERE(zmasq(:)<EPSFRA) pctsrf(:,is_lic)=0.
149
150	pctsrf(:,is_ter)=zmasq(:)
151
152	!--- Adequation with soil/sea mask
153	DO ji=1,klon
154	IF(zmasq(ji)>EPSFRA) THEN
155	IF(pctsrf(ji,is_lic)>=zmasq(ji)) THEN
156	pctsrf(ji,is_lic)=zmasq(ji)
157	pctsrf(ji,is_ter)=0.
158	ELSE
159	pctsrf(ji,is_ter)=zmasq(ji)-pctsrf(ji,is_lic)
160	IF(pctsrf(ji,is_ter)<EPSFRA) THEN
161	pctsrf(ji,is_ter)=0.
162	pctsrf(ji,is_lic)=zmasq(ji)
163	END IF
164	END IF
165	END IF
166	END DO
167
168	ELSE
169	! landice_opt=>2 : no land ice
170	pctsrf(:,is_lic)=0.0
171	pctsrf(:,is_ter)=zmasq(:)
172	END IF
173
174
175
176
177
178	!--- Option no_ter_antartique removes all land fractions souther than 60S.
179	!--- Land ice is set instead of the land fractions on these latitudes.
180	!--- The ocean and sea-ice fractions are not changed.
181	!--- This option is only available if landice_opt<2.
182	IF (landice_opt .LT. 2) THEN
183	no_ter_antartique=.FALSE.
184	CALL getin_p('no_ter_antartique',no_ter_antartique)
185	WRITE(lunout,*)"no_ter_antartique=",no_ter_antartique
186	IF (no_ter_antartique) THEN
187	! Remove all land fractions souther than 60S and set land-ice instead
188	WRITE(lunout,*) "Remove land fractions souther than 60deg south by increasing"
189	WRITE(lunout,*) "the continental ice fractions. No land can now be found at Antartic."
190	DO ji=1, klon
191	IF (latitude_deg(ji)<-60.0) THEN
192	pctsrf(ji,is_lic) = pctsrf(ji,is_lic) + pctsrf(ji,is_ter)
193	pctsrf(ji,is_ter) = 0
194	END IF
195	END DO
196	END IF
197	END IF
198
199	! sub-surface ocean and sea ice (sea ice set to zero for start)
200	!*******************************************************************************
201	pctsrf(:,is_oce)=(1.-zmasq(:))
202	WHERE(pctsrf(:,is_oce)<EPSFRA) pctsrf(:,is_oce)=0.
203
204	! zval(:)=max(0.,zmea-2*zstd(:))
205	! zpic(:)=zmea+2*zstd(:)
206
207	!! WARNING DON'T FORGET FOR LATER
208	!!ym IF(couple) pctsrf(:,is_oce)=ocemask_fi(:)
209	!!
210
211	! Init: tsol, qsol, sn, evap, tsoil, rain_fall, snow_fall, solsw, sollw, frugs
212	!*******************************************************************************
213	DO i=1,nbsrf
214	ftsol(:,i) = tsol
215	END DO
216
217	DO i=1,nbsrf
218	snsrf(:,i) = sn
219	END DO
220	!albedo SB >>>
221	!ym error : the sub surface dimension is the third not second
222	! falb_dir(:,is_ter,:)=0.08; falb_dir(:,is_lic,:)=0.6
223	! falb_dir(:,is_oce,:)=0.5; falb_dir(:,is_sic,:)=0.6
224	falb_dir(:,:,is_ter)=0.08; falb_dir(:,:,is_lic)=0.6
225	falb_dir(:,:,is_oce)=0.5; falb_dir(:,:,is_sic)=0.6
226
227	!ym falb_dif has been forgotten, initialize with defaukt value found in phyetat0 or 0 ?
228	!ym probably the uninitialized value was 0 for standard (regular grid) case
229	falb_dif(:,:,:)=0
230	u10m(:,:)=0
231	v10m(:,:)=0
232	treedrg(:,:,:)=0
233	!albedo SB <<<
234	fevap(:,:) = 0.
235	qsurf = 0.
236
237	DO i=1,nbsrf
238	DO j=1,nsoilmx
239	tsoil(:,j,i) = tsol
240	END DO
241	END DO
242
243	rain_fall = 0.; snow_fall = 0.
244	solsw = 165.; sollw = -53.
245	solswfdiff = 1.
246	!ym warning missing init for sollwdown => set to 0
247	sollwdown = 0.
248
249
250	t_ancien = 273.15
251	u_ancien=0
252	v_ancien=0
253	q_ancien = 0.
254	ql_ancien = 0.
255	qs_ancien = 0.
256	prlw_ancien = 0.
257	prsw_ancien = 0.
258	prw_ancien = 0.
259	agesno = 0.
260
261	wake_delta_pbl_TKE(:,:,:)=0
262	wake_dens(:)=0
263	awake_dens = 0.
264	cv_gen = 0.
265	ale_bl = 0.
266	ale_bl_trig =0.
267	alp_bl=0.
268	ale_wake=0.
269	ale_bl_stat=0.
270
271	z0m(:,:)=0 ! ym missing 5th subsurface initialization
272	z0m(:,is_oce) = rugmer(:)
273	z0m(:,is_ter) = 0.01 ! MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
274	z0m(:,is_lic) = 0.001 !MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
275	z0m(:,is_sic) = 0.001
276	z0h(:,:)=z0m(:,:)
277
278	fder = 0.0
279	clwcon = 0.0
280	rnebcon = 0.0
281	ratqs = 0.0
282	run_off_lic_0 = 0.0
283	rugoro = 0.0
284
285	! Before phyredem calling, surface modules and values to be saved in startphy.nc
286	! are initialized
287	!*******************************************************************************
288	pbl_tke(:,:,:) = 1.e-8
289	zmax0(:) = 40.
290	f0(:) = 1.e-5
291	sig1(:,:) = 0.
292	w01(:,:) = 0.
293	wake_deltat(:,:) = 0.
294	wake_deltaq(:,:) = 0.
295	wake_s(:) = 0.
296	wake_cstar(:) = 0.
297	wake_fip(:) = 0.
298	wake_pe = 0.
299	fm_therm = 0.
300	entr_therm = 0.
301	detr_therm = 0.
302	awake_s = 0.
303
304	CALL fonte_neige_init(run_off_lic_0)
305	CALL pbl_surface_init( fder, snsrf, qsurf, tsoil )
306
307	IF (iflag_pbl>1 .AND. iflag_wake>=1 .AND. iflag_pbl_split >=1) then
308	delta_tsurf = 0.
309	beta_aridity = 0.
310	END IF
311	ratqs_inter_ = 0.002
312	rneb_ancien = 0.
313
314	CALL gather_omp(cell_area,cell_area_mpi)
315	CALL gather_omp(pctsrf,pctsrf_mpi)
316	IF (is_omp_master) THEN
317	CALL xios_send_field("area_ce0l",cell_area_mpi)
318	CALL xios_send_field("fract_oce_ce0l",pctsrf_mpi(:,is_oce))
319	CALL xios_send_field("fract_sic_ce0l",pctsrf_mpi(:,is_sic))
320	ENDIF
321
322	zmea(:) = zmea_gw(:)
323	zpic(:) = zpic_gw(:)
324	zval(:) = zval_gw(:)
325	zstd(:) = zstd_gw(:)
326	zsig(:) = zsig_gw(:)
327	zgam(:) = zgam_gw(:)
328	zthe(:) = zthe_gw(:)
329	DEALLOCATE(zmea_gw, zpic_gw, zval_gw, zstd_gw, zsig_gw, zgam_gw, zthe_gw)
330
331	CALL phyredem( "startphy.nc" )
332
333	END SUBROUTINE create_etat0_unstruct
334
335
336	END MODULE create_etat0_unstruct_mod

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

Download in other formats:

Original Format