Context Navigation

limit_read_mod.F90 @ 3871

Last change on this file since 3871 was 3871, checked in by ymipsl, 9 years ago

Avoid circular dependency with module

File size: 15.5 KB

Line
1	!
2	! $Header$
3	!
4	MODULE limit_read_mod
5	!
6	! This module reads the fichier "limit.nc" containing fields for surface forcing.
7	!
8	! Module subroutines :
9	! limit_read_frac : call limit_read_tot and return the fractions
10	! limit_read_rug_alb : return rugosity and albedo, if coupled ocean call limit_read_tot first
11	! limit_read_sst : return sea ice temperature
12	! limit_read_tot : read limit.nc and store the fields in local modules variables
13	!
14	IMPLICIT NONE
15
16	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE, PRIVATE :: pctsrf
17	!$OMP THREADPRIVATE(pctsrf)
18	REAL, ALLOCATABLE, DIMENSION(:), SAVE, PRIVATE :: rugos
19	!$OMP THREADPRIVATE(rugos)
20	REAL, ALLOCATABLE, DIMENSION(:), SAVE, PRIVATE :: albedo
21	!$OMP THREADPRIVATE(albedo)
22	REAL, ALLOCATABLE, DIMENSION(:), SAVE, PRIVATE :: sst
23	!$OMP THREADPRIVATE(sst)
24	LOGICAL,SAVE :: read_continents=.FALSE.
25	!$OMP THREADPRIVATE(read_continents)
26
27	CONTAINS
28	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
29	!!
30	!! Public subroutines :
31	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
32
33
34	SUBROUTINE init_limit_read(first_day)
35	USE mod_grid_phy_lmdz
36	USE surface_data
37	USE XIOS
38	IMPLICIT NONE
39	INTEGER, INTENT(IN) :: first_day
40
41
42	IF ( type_ocean /= 'couple') THEN
43	IF (grid_type==unstructured) THEN
44	CALL xios_set_file_attr("limit_read",enabled=.TRUE.,record_offset=first_day)
45	ENDIF
46	ENDIF
47
48	END SUBROUTINE init_limit_read
49
50	SUBROUTINE limit_read_frac(itime, dtime, jour, pctsrf_new, is_modified)
51	!
52	! This subroutine is called from "change_srf_frac" for case of
53	! ocean=force or from ocean_slab_frac for ocean=slab.
54	! The fraction for all sub-surfaces at actual time step is returned.
55
56	USE dimphy
57	USE indice_sol_mod
58
59	! Input arguments
60	!****************************************************************************************
61	INTEGER, INTENT(IN) :: itime ! time step
62	INTEGER, INTENT(IN) :: jour ! current day
63	REAL , INTENT(IN) :: dtime ! length of time step
64
65	! Output arguments
66	!****************************************************************************************
67	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: pctsrf_new ! sub surface fractions
68	LOGICAL, INTENT(OUT) :: is_modified ! true if pctsrf is modified at this time step
69
70	! End declaration
71	!****************************************************************************************
72
73	! 1) Read file limit.nc
74	CALL limit_read_tot(itime, dtime, jour, is_modified)
75
76	! 2) Return the fraction read in limit_read_tot
77	pctsrf_new(:,:) = pctsrf(:,:)
78
79	END SUBROUTINE limit_read_frac
80
81	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
82
83	SUBROUTINE limit_read_rug_alb(itime, dtime, jour, &
84	knon, knindex, &
85	rugos_out, alb_out)
86	!
87	! This subroutine is called from surf_land_bucket.
88	! The flag "ok_veget" must can not be true. If coupled run, "ocean=couple"
89	! then this routine will call limit_read_tot.
90	!
91	USE dimphy
92	USE surface_data
93
94	! Input arguments
95	!****************************************************************************************
96	INTEGER, INTENT(IN) :: itime ! numero du pas de temps courant
97	INTEGER, INTENT(IN) :: jour ! jour a lire dans l'annee
98	REAL , INTENT(IN) :: dtime ! pas de temps de la physique (en s)
99	INTEGER, INTENT(IN) :: knon ! nomber of points on compressed grid
100	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex ! grid point number for compressed grid
101	! Output arguments
102	!****************************************************************************************
103	REAL, DIMENSION(klon), INTENT(OUT) :: rugos_out
104	REAL, DIMENSION(klon), INTENT(OUT) :: alb_out
105
106	! Local variables
107	!****************************************************************************************
108	INTEGER :: i
109	LOGICAL :: is_modified
110	!****************************************************************************************
111
112	IF (type_ocean == 'couple'.OR. &
113	(type_ocean == 'slab' .AND. version_ocean == 'sicINT')) THEN
114	! limit.nc has not yet been read. Do it now!
115	CALL limit_read_tot(itime, dtime, jour, is_modified)
116	END IF
117
118	DO i=1,knon
119	rugos_out(i) = rugos(knindex(i))
120	alb_out(i) = albedo(knindex(i))
121	END DO
122
123	END SUBROUTINE limit_read_rug_alb
124
125	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
126
127	SUBROUTINE limit_read_sst(knon, knindex, sst_out)
128	!
129	! This subroutine returns the sea surface temperature already read from limit.nc.
130	!
131	USE dimphy, ONLY : klon
132
133	INTEGER, INTENT(IN) :: knon ! nomber of points on compressed grid
134	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex ! grid point number for compressed grid
135	REAL, DIMENSION(klon), INTENT(OUT) :: sst_out
136
137	INTEGER :: i
138
139	DO i = 1, knon
140	sst_out(i) = sst(knindex(i))
141	END DO
142
143	END SUBROUTINE limit_read_sst
144
145	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
146	!!
147	!! Private subroutine :
148	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
149
150	SUBROUTINE limit_read_tot(itime, dtime, jour, is_modified)
151	!
152	! Read everything needed from limit.nc
153	!
154	! 0) Initialize
155	! 1) Open the file limit.nc, if it is time
156	! 2) Read fraction, if not type_ocean=couple
157	! 3) Read sea surface temperature, if not type_ocean=couple
158	! 4) Read albedo and rugosity for land surface, only in case of no vegetation model
159	! 5) Close file and distribuate variables to all processus
160
161	USE dimphy
162	USE mod_grid_phy_lmdz
163	USE mod_phys_lmdz_para
164	USE surface_data, ONLY : type_ocean, ok_veget
165	USE netcdf
166	USE indice_sol_mod
167	USE XIOS
168
169	IMPLICIT NONE
170
171	! In- and ouput arguments
172	!****************************************************************************************
173	INTEGER, INTENT(IN) :: itime ! numero du pas de temps courant
174	INTEGER, INTENT(IN) :: jour ! jour a lire dans l'annee
175	REAL , INTENT(IN) :: dtime ! pas de temps de la physique (en s)
176
177	LOGICAL, INTENT(OUT) :: is_modified ! true if pctsrf is modified at this time step
178
179	! Locals variables with attribute SAVE
180	!****************************************************************************************
181	! frequence de lecture des conditions limites (en pas de physique)
182	INTEGER,SAVE :: lmt_pas
183	!$OMP THREADPRIVATE(lmt_pas)
184	LOGICAL, SAVE :: first_call=.TRUE.
185	!$OMP THREADPRIVATE(first_call)
186	INTEGER, SAVE :: jour_lu = -1
187	!$OMP THREADPRIVATE(jour_lu)
188	! Locals variables
189	!****************************************************************************************
190	INTEGER :: nid, nvarid
191	INTEGER :: ii, ierr
192	INTEGER, DIMENSION(2) :: start, epais
193	REAL, DIMENSION(klon_glo,nbsrf) :: pct_glo ! fraction at global grid
194	REAL, DIMENSION(klon_glo) :: sst_glo ! sea-surface temperature at global grid
195	REAL, DIMENSION(klon_glo) :: rug_glo ! rugosity at global grid
196	REAL, DIMENSION(klon_glo) :: alb_glo ! albedo at global grid
197
198	REAL, DIMENSION(klon_mpi,nbsrf) :: pct_mpi ! fraction at global grid
199	REAL, DIMENSION(klon_mpi) :: sst_mpi ! sea-surface temperature at global grid
200	REAL, DIMENSION(klon_mpi) :: rug_mpi ! rugosity at global grid
201	REAL, DIMENSION(klon_mpi) :: alb_mpi ! albedo at global grid
202
203	CHARACTER(len=20) :: modname='limit_read_mod'
204
205	! End declaration
206	!****************************************************************************************
207
208	!****************************************************************************************
209	! 0) Initialization
210	!
211	!****************************************************************************************
212	IF (first_call) THEN
213	! calculate number of time steps for one day
214	lmt_pas = NINT(86400./dtime * 1.0)
215
216	! Allocate module save variables
217	IF ( type_ocean /= 'couple' ) THEN
218	ALLOCATE(pctsrf(klon,nbsrf), sst(klon), stat=ierr)
219	IF (ierr /= 0) CALL abort_physic(modname, 'PB in allocating pctsrf and sst',1)
220	END IF
221
222	IF ( .NOT. ok_veget ) THEN
223	ALLOCATE(rugos(klon), albedo(klon), stat=ierr)
224	IF (ierr /= 0) CALL abort_physic(modname, 'PB in allocating rugos and albedo',1)
225	END IF
226
227	first_call=.FALSE.
228	ENDIF
229
230	!****************************************************************************************
231	! 1) Open the file limit.nc if it is the right moment to read, once a day.
232	! The file is read only by the master thread of the master mpi process(is_mpi_root)
233	!
234	!****************************************************************************************
235
236	is_modified = .FALSE.
237	!ym IF (MOD(itime-1, lmt_pas) == 0 .OR. jour_lu /= jour ) THEN ! time to read
238	! not REALLY PERIODIC
239	IF (MOD(itime-1, lmt_pas) == 0) THEN ! time to read
240	jour_lu = jour
241	is_modified = .TRUE.
242
243	IF (grid_type==unstructured) THEN
244
245	!$OMP MASTER ! Only master thread
246
247
248	IF ( type_ocean /= 'couple') THEN
249
250	CALL xios_recv_field("foce_limin",pct_mpi(:,is_oce))
251	CALL xios_recv_field("fsic_limin",pct_mpi(:,is_sic))
252	! IF (read_continents .OR. itime == 1) THEN
253	CALL xios_recv_field("fter_limin",pct_mpi(:,is_ter))
254	CALL xios_recv_field("flic_limin",pct_mpi(:,is_lic))
255	! ENDIF
256	ENDIF! type_ocean /= couple
257
258	IF ( type_ocean /= 'couple') THEN
259	CALL xios_recv_field("sst_limin",sst_mpi)
260	ENDIF
261
262	IF (.NOT. ok_veget) THEN
263	CALL xios_recv_field("alb_limin",alb_mpi)
264	CALL xios_recv_field("rug_limin",rug_mpi)
265	ENDIF
266
267	IF ( type_ocean /= 'couple') THEN
268	CALL Scatter_omp(sst_mpi,sst)
269	CALL Scatter_omp(pct_mpi(:,is_oce),pctsrf(:,is_oce))
270	CALL Scatter_omp(pct_mpi(:,is_sic),pctsrf(:,is_sic))
271	! IF (read_continents .OR. itime == 1) THEN
272	CALL Scatter_omp(pct_mpi(:,is_ter),pctsrf(:,is_ter))
273	CALL Scatter_omp(pct_mpi(:,is_lic),pctsrf(:,is_lic))
274	! END IF
275	END IF
276
277	IF (.NOT. ok_veget) THEN
278	CALL Scatter_omp(alb_mpi, albedo)
279	CALL Scatter_omp(rug_mpi, rugos)
280	END IF
281
282	!$OMP END MASTER
283
284
285	ELSE ! grid_type==regular
286
287	!$OMP MASTER ! Only master thread
288
289	IF (is_mpi_root) THEN ! Only master processus!
290
291	ierr = NF90_OPEN ('limit.nc', NF90_NOWRITE, nid)
292	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,&
293	'Pb d''ouverture du fichier de conditions aux limites',1)
294
295	! La tranche de donnees a lire:
296	start(1) = 1
297	start(2) = jour
298	epais(1) = klon_glo
299	epais(2) = 1
300
301
302	!****************************************************************************************
303	! 2) Read fraction if not type_ocean=couple
304	!
305	!****************************************************************************************
306
307	IF ( type_ocean /= 'couple') THEN
308	!
309	! Ocean fraction
310	ierr = NF90_INQ_VARID(nid, 'FOCE', nvarid)
311	IF (ierr /= NF90_NOERR) CALL abort_physic(modname, 'Le champ <FOCE> est absent',1)
312
313	ierr = NF90_GET_VAR(nid,nvarid,pct_glo(:,is_oce),start,epais)
314	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <FOCE>' ,1)
315	!
316	! Sea-ice fraction
317	ierr = NF90_INQ_VARID(nid, 'FSIC', nvarid)
318	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <FSIC> est absent',1)
319
320	ierr = NF90_GET_VAR(nid,nvarid,pct_glo(:,is_sic),start,epais)
321	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <FSIC>' ,1)
322
323
324	! Read land and continentals fraction only if asked for
325	IF (read_continents .OR. itime == 1) THEN
326	!
327	! Land fraction
328	ierr = NF90_INQ_VARID(nid, 'FTER', nvarid)
329	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <FTER> est absent',1)
330
331	ierr = NF90_GET_VAR(nid,nvarid,pct_glo(:,is_ter),start,epais)
332	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <FTER>',1)
333	!
334	! Continentale ice fraction
335	ierr = NF90_INQ_VARID(nid, 'FLIC', nvarid)
336	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <FLIC> est absent',1)
337
338	ierr = NF90_GET_VAR(nid,nvarid,pct_glo(:,is_lic),start,epais)
339	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <FLIC>',1)
340	END IF
341
342
343	END IF ! type_ocean /= couple
344
345	!****************************************************************************************
346	! 3) Read sea-surface temperature, if not coupled ocean
347	!
348	!****************************************************************************************
349	IF ( type_ocean /= 'couple') THEN
350
351	ierr = NF90_INQ_VARID(nid, 'SST', nvarid)
352	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <SST> est absent',1)
353
354	ierr = NF90_GET_VAR(nid,nvarid,sst_glo,start,epais)
355	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <SST>',1)
356
357	END IF
358
359	!****************************************************************************************
360	! 4) Read albedo and rugosity for land surface, only in case of no vegetation model
361	!
362	!****************************************************************************************
363
364	IF (.NOT. ok_veget) THEN
365	!
366	! Read albedo
367	ierr = NF90_INQ_VARID(nid, 'ALB', nvarid)
368	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <ALB> est absent',1)
369
370	ierr = NF90_GET_VAR(nid,nvarid,alb_glo,start,epais)
371	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <ALB>',1)
372	!
373	! Read rugosity
374	ierr = NF90_INQ_VARID(nid, 'RUG', nvarid)
375	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <RUG> est absent',1)
376
377	ierr = NF90_GET_VAR(nid,nvarid,rug_glo,start,epais)
378	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <RUG>',1)
379
380	END IF
381
382	!****************************************************************************************
383	! 5) Close file and distribuate variables to all processus
384	!
385	!****************************************************************************************
386	ierr = NF90_CLOSE(nid)
387	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Pb when closing file', 1)
388	ENDIF ! is_mpi_root
389
390
391	!$OMP END MASTER
392	!$OMP BARRIER
393
394	IF ( type_ocean /= 'couple') THEN
395	CALL Scatter(sst_glo,sst)
396	CALL Scatter(pct_glo(:,is_oce),pctsrf(:,is_oce))
397	CALL Scatter(pct_glo(:,is_sic),pctsrf(:,is_sic))
398	IF (read_continents .OR. itime == 1) THEN
399	CALL Scatter(pct_glo(:,is_ter),pctsrf(:,is_ter))
400	CALL Scatter(pct_glo(:,is_lic),pctsrf(:,is_lic))
401	END IF
402	END IF
403
404	IF (.NOT. ok_veget) THEN
405	CALL Scatter(alb_glo, albedo)
406	CALL Scatter(rug_glo, rugos)
407	END IF
408
409	ENDIF ! grid_type
410
411	ENDIF ! time to read
412
413	END SUBROUTINE limit_read_tot
414
415
416	END MODULE limit_read_mod

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

Download in other formats:

Original Format