Context Navigation

limit_read_mod.F90 @ 5099

Last change on this file since 5099 was 5099, checked in by abarral, 8 weeks ago
Replace most uses of CPP_DUST by the corresponding logical defined in lmdz_cppkeys_wrapper.F90 Convert several files from .F to .f90 to allow Dust to compile w/o rrtm/ecrad Create lmdz_yoerad.f90 (lint) Remove "!" on otherwise empty line
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 18.0 KB

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

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

Download in other formats:

Original Format