Context Navigation

limit_read_mod.F90 @ 5128

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

Line
1	!
2	! $Id: limit_read_mod.F90 3435 2019-01-22 15:21:59Z fairhead $
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	#ifdef ISO
25	REAL, ALLOCATABLE, DIMENSION(:), SAVE, PRIVATE :: tuoce
26	!$OMP THREADPRIVATE(tuoce)
27	#endif
28	LOGICAL,SAVE :: read_continents=.FALSE.
29	!$OMP THREADPRIVATE(read_continents)
30
31	CONTAINS
32	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
33	!!
34	!! Public subroutines :
35	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
36
37
38	SUBROUTINE init_limit_read(first_day)
39	USE mod_grid_phy_lmdz
40	USE surface_data
41	USE mod_phys_lmdz_para
42	USE lmdz_xios
43	IMPLICIT NONE
44	INTEGER, INTENT(IN) :: first_day
45
46
47	IF ( type_ocean /= 'couple') THEN
48	IF (grid_type==unstructured) THEN
49	IF (is_omp_master) CALL xios_set_file_attr("limit_read",enabled=.TRUE.,record_offset=first_day)
50	ENDIF
51	ENDIF
52
53	END SUBROUTINE init_limit_read
54
55	SUBROUTINE limit_read_frac(itime, dtime, jour, pctsrf_new, is_modified)
56	!
57	! This subroutine is called from "change_srf_frac" for case of
58	! ocean=force or from ocean_slab_frac for ocean=slab.
59	! The fraction for all sub-surfaces at actual time step is returned.
60
61	USE dimphy
62	USE indice_sol_mod
63
64	! Input arguments
65	!****************************************************************************************
66	INTEGER, INTENT(IN) :: itime ! time step
67	INTEGER, INTENT(IN) :: jour ! current day
68	REAL , INTENT(IN) :: dtime ! length of time step
69
70	! Output arguments
71	!****************************************************************************************
72	REAL, DIMENSION(klon,nbsrf), INTENT(OUT) :: pctsrf_new ! sub surface fractions
73	LOGICAL, INTENT(OUT) :: is_modified ! true if pctsrf is modified at this time step
74
75	! End declaration
76	!****************************************************************************************
77
78	! 1) Read file limit.nc
79	CALL limit_read_tot(itime, dtime, jour, is_modified)
80
81	! 2) Return the fraction read in limit_read_tot
82	pctsrf_new(:,:) = pctsrf(:,:)
83
84	END SUBROUTINE limit_read_frac
85
86	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
87
88	SUBROUTINE limit_read_rug_alb(itime, dtime, jour, &
89	knon, knindex, &
90	rugos_out, alb_out)
91	!
92	! This subroutine is called from surf_land_bucket.
93	! The flag "ok_veget" must can not be true. If coupled run, "ocean=couple"
94	! then this routine will call limit_read_tot.
95	!
96	USE dimphy
97	USE surface_data
98	#ifdef ISO
99	USE isotopes_mod, ONLY: P_veg
100	#endif
101
102	! Input arguments
103	!****************************************************************************************
104	INTEGER, INTENT(IN) :: itime ! numero du pas de temps courant
105	INTEGER, INTENT(IN) :: jour ! jour a lire dans l'annee
106	REAL , INTENT(IN) :: dtime ! pas de temps de la physique (en s)
107	INTEGER, INTENT(IN) :: knon ! nomber of points on compressed grid
108	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex ! grid point number for compressed grid
109	! Output arguments
110	!****************************************************************************************
111	REAL, DIMENSION(klon), INTENT(OUT) :: rugos_out
112	REAL, DIMENSION(klon), INTENT(OUT) :: alb_out
113
114	! Local variables
115	!****************************************************************************************
116	INTEGER :: i
117	LOGICAL :: is_modified
118
119	!****************************************************************************************
120
121	IF (type_ocean == 'couple'.OR. &
122	(type_ocean == 'slab' .AND. version_ocean == 'sicINT')) THEN
123	! limit.nc has not yet been read. Do it now!
124	CALL limit_read_tot(itime, dtime, jour, is_modified)
125	END IF
126
127	DO i=1,knon
128	rugos_out(i) = rugos(knindex(i))
129	alb_out(i) = albedo(knindex(i))
130	END DO
131
132	END SUBROUTINE limit_read_rug_alb
133
134	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
135
136	SUBROUTINE limit_read_sst(knon, knindex, sst_out &
137	#ifdef ISO
138	& ,Roce,rlat &
139	#endif
140	)
141	!
142	! This subroutine returns the sea surface temperature already read from limit.nc.
143	!
144	USE dimphy, ONLY : klon
145	#ifdef ISO
146	USE infotrac_phy, ONLY: niso
147	USE isotopes_mod, ONLY: tcorr,toce,modif_sst, &
148	& deltaTtest,sstlatcrit,deltaTtestpoles,dsstlatcrit, &
149	& iso_HTO,ok_prod_nucl_tritium
150	#ifdef ISOVERIF
151	USE isotopes_verif_mod, ONLY: iso_verif_egalite_vect2D,iso_verif_positif, &
152	iso_verif_positif_nostop
153	#endif
154	#endif
155
156	INTEGER, INTENT(IN) :: knon ! nomber of points on compressed grid
157	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex ! grid point number for compressed grid
158	REAL, DIMENSION(klon), INTENT(OUT) :: sst_out
159	#ifdef ISO
160	REAL, DIMENSION(klon) :: tuoce_out ! sortie tritium surface ocean
161	#endif
162
163	INTEGER :: i
164	#ifdef ISO
165	real, intent(out), dimension(niso,klon) :: Roce
166	integer :: ixt
167	real, intent(in),dimension(klon) :: rlat
168	real lat_locale
169	#endif
170	!#ifdef ISOVERIF
171	! integer iso_verif_positif_nostop
172	!#endif
173
174	DO i = 1, knon
175	sst_out(i) = sst(knindex(i))
176	END DO
177
178
179	#ifdef ISO
180	if (iso_HTO.gt.0) then
181	if (ok_prod_nucl_tritium) then ! si on active la production nucleaire de tritium
182	DO i = 1, knon
183	tuoce_out(i)=tuoce(knindex(i))
184	END DO
185	endif
186	endif
187	#endif
188
189	#ifdef ISO
190	if (modif_sst.ge.1) then
191	do i = 1, knon
192	lat_locale=rlat(knindex(i))
193	! test: modification uniforme de la sst
194	if (modif_sst.eq.1) then
195	sst_out(i)= sst_out(i)+deltaTtest
196	elseif (modif_sst.eq.2) then !if (modif_sst.eq.1) then
197	! pattern parabolique en dehors des tropiques (sstlatcrit)
198	if (abs(lat_locale).gt.sstlatcrit) then
199	sst_out(i)= sst_out(i)+deltaTtestpoles &
200	& (lat_locale2-sstlatcrit*2) &
201	& /(90.02-sstlatcrit2)
202	endif !if (abs(lat_locale).gt.abs(sstlatcrit)) then
203
204	else if (modif_sst.eq.3) then
205
206	if (abs(lat_locale).gt.abs(sstlatcrit)) then
207	if (abs(lat_locale).gt.sstlatcrit+dsstlatcrit) then
208	sst_out(i)= sst_out(i)+deltaTtestpoles
209	else
210	sst_out(i)= sst_out(i)+deltaTtestpoles &
211	& *(abs(lat_locale)-sstlatcrit)/dsstlatcrit
212	endif
213	endif
214	endif !if (modif_sst.eq.1) then
215	enddo !do i = 1, knon
216	endif !if (modif_sst.ge.1) then
217	#endif
218	#ifdef ISOVERIF
219	do i=1,knon,20
220	call iso_verif_positif(sst_out(i)-100.0,'limit_read 4323')
221	enddo
222	#endif
223
224
225	#ifdef ISO
226	!* lecture de Roce
227	! 1) première possibilité: valeur fixe à SMOW
228	DO i = 1, knon
229	do ixt=1,niso
230	Roce(ixt,i)=tcorr(ixt)*toce(ixt)
231	enddo !do ixt=1,niso
232	enddo !DO i = 1, knon
233	! 2) deuxième possibilité: lecture de la carte
234	! A FAIRE
235
236	! lecture pour le tritium
237	if ((iso_HTO.gt.0).and.(ok_prod_nucl_tritium)) then
238	! lecture de la carte tritium ocean surface
239	Roce(iso_HTO,i)=tcorr(iso_HTO)tuoce_out(i)1.E-18*2.
240	endif
241	#endif
242
243	#ifdef ISOVERIF
244	do i=1,knon
245	if (iso_verif_positif_nostop(370.0-sst_out(i), &
246	'limit_read 368').eq.1) then
247	write(,) 'i,knindex,sst_out=',i,knindex,sst_out(i)
248	stop
249	endif
250	enddo
251	#endif
252
253
254	END SUBROUTINE limit_read_sst
255
256	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
257	!!
258	!! Private subroutine :
259	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
260
261	SUBROUTINE limit_read_tot(itime, dtime, jour, is_modified)
262	!
263	! Read everything needed from limit.nc
264	!
265	! 0) Initialize
266	! 1) Open the file limit.nc, if it is time
267	! 2) Read fraction, if not type_ocean=couple
268	! 3) Read sea surface temperature, if not type_ocean=couple
269	! 4) Read albedo and rugosity for land surface, only in case of no vegetation model
270	! 5) Close file and distribuate variables to all processus
271
272	USE dimphy
273	USE mod_grid_phy_lmdz
274	USE mod_phys_lmdz_para
275	USE surface_data, ONLY : type_ocean, ok_veget
276	USE netcdf
277	USE indice_sol_mod
278	#ifdef ISO
279	USE isotopes_mod, ONLY : iso_HTO,ok_prod_nucl_tritium
280	#ifdef ISOVERIF
281	USE isotopes_verif_mod, ONLY : iso_verif_positif_nostop
282	#endif
283	#endif
284	USE phys_cal_mod, ONLY : calend, year_len
285	USE print_control_mod, ONLY: lunout, prt_level
286	USE lmdz_XIOS, ONLY: xios_recv_field
287
288	IMPLICIT NONE
289
290	! In- and ouput arguments
291	!****************************************************************************************
292	INTEGER, INTENT(IN) :: itime ! numero du pas de temps courant
293	INTEGER, INTENT(IN) :: jour ! jour a lire dans l'annee
294	REAL , INTENT(IN) :: dtime ! pas de temps de la physique (en s)
295
296	LOGICAL, INTENT(OUT) :: is_modified ! true if pctsrf is modified at this time step
297
298	! Locals variables with attribute SAVE
299	!****************************************************************************************
300	! frequence de lecture des conditions limites (en pas de physique)
301	INTEGER,SAVE :: lmt_pas
302	!$OMP THREADPRIVATE(lmt_pas)
303	LOGICAL, SAVE :: first_call=.TRUE.
304	!$OMP THREADPRIVATE(first_call)
305	INTEGER, SAVE :: jour_lu = -1
306	!$OMP THREADPRIVATE(jour_lu)
307	! Locals variables
308	!****************************************************************************************
309	INTEGER :: nid, nvarid, ndimid, nn
310	INTEGER :: ii, ierr
311	INTEGER, DIMENSION(2) :: start, epais
312	REAL, DIMENSION(klon_glo,nbsrf) :: pct_glo ! fraction at global grid
313	REAL, DIMENSION(klon_glo) :: sst_glo ! sea-surface temperature at global grid
314	REAL, DIMENSION(klon_glo) :: rug_glo ! rugosity at global grid
315	REAL, DIMENSION(klon_glo) :: alb_glo ! albedo at global grid
316
317	REAL, DIMENSION(klon_mpi,nbsrf) :: pct_mpi ! fraction at global grid
318	REAL, DIMENSION(klon_mpi) :: sst_mpi ! sea-surface temperature at global grid
319	REAL, DIMENSION(klon_mpi) :: rug_mpi ! rugosity at global grid
320	REAL, DIMENSION(klon_mpi) :: alb_mpi ! albedo at global grid
321
322	CHARACTER(len=20) :: modname='limit_read_mod'
323	CHARACTER(LEN=99) :: abort_message, calendar, str
324	#ifdef ISO
325	REAL, DIMENSION(klon_glo) :: tuoce_glo ! sea-surface tritium et global grid
326	#endif
327
328	! End declaration
329	!****************************************************************************************
330
331	!****************************************************************************************
332	! 0) Initialization
333	!
334	!****************************************************************************************
335	IF (first_call) THEN
336	first_call=.FALSE.
337	! calculate number of time steps for one day
338	lmt_pas = NINT(86400./dtime * 1.0)
339
340	! Allocate module save variables
341	IF ( type_ocean /= 'couple' ) THEN
342	ALLOCATE(pctsrf(klon,nbsrf), sst(klon), stat=ierr)
343	IF (ierr /= 0) CALL abort_physic(modname, 'PB in allocating pctsrf and sst',1)
344	END IF
345
346	IF ( .NOT. ok_veget ) THEN
347	ALLOCATE(rugos(klon), albedo(klon), stat=ierr)
348	IF (ierr /= 0) CALL abort_physic(modname, 'PB in allocating rugos and albedo',1)
349	END IF
350
351	!$OMP MASTER ! Only master thread
352	IF (is_mpi_root) THEN ! Only master processus
353	ierr = NF90_OPEN ('limit.nc', NF90_NOWRITE, nid)
354	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,&
355	'Pb d''ouverture du fichier de conditions aux limites',1)
356
357	!--- WARNING IF CALENDAR IS KNOWN AND DOES NOT MATCH THE ONE OF LMDZ
358	ierr=NF90_INQ_VARID(nid, 'TEMPS', nvarid)
359	ierr=NF90_GET_ATT(nid, nvarid, 'calendar', calendar)
360	IF(ierr==NF90_NOERR.AND.calendar/=calend.AND.prt_level>=1) THEN
361	WRITE(lunout,*)'BEWARE: gcm and limit.nc calendars differ: '
362	WRITE(lunout,*)' '//TRIM(calend)//' for gcm'
363	WRITE(lunout,*)' '//TRIM(calendar)//' for limit.nc file'
364	END IF
365
366	!--- ERROR IF FILE RECORDS NUMBER IS NOT EQUAL TO EXPECTED NUMBER OF DAYS
367	IF (grid_type==unstructured) THEN
368	ierr=NF90_INQ_DIMID(nid,"time_year",ndimid)
369	ELSE
370	ierr=NF90_INQUIRE(nid, UnlimitedDimID=ndimid)
371	ENDIF
372	ierr=NF90_INQUIRE_DIMENSION(nid, ndimid, len=nn)
373	WRITE(abort_message,'(a,2(i0,a))')'limit.nc records number (',nn,') does no'//&
374	't match year length (',year_len,')'
375	IF(nn/=year_len) CALL abort_physic(modname,abort_message,1)
376
377	!--- ERROR IF FILES AND LMDZ HORIZONTAL RESOLUTIONS DO NOT MATCH
378	IF (grid_type==unstructured) THEN
379	ierr=NF90_INQ_DIMID(nid, 'cell', ndimid)
380	ELSE
381	ierr=NF90_INQ_DIMID(nid, 'points_physiques', ndimid)
382	ENDIF
383	ierr=NF90_INQUIRE_DIMENSION(nid, ndimid, len=nn)
384	WRITE(abort_message,'(a,2(i0,a))')'limit.nc horizontal number of cells (',nn, &
385	') does not match LMDZ klon_glo (',klon_glo,')'
386	IF(nn/=klon_glo) CALL abort_physic(modname,abort_message,1)
387
388	ierr = NF90_CLOSE(nid)
389	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Pb when closing file', 1)
390	END IF ! is_mpi_root
391	!$OMP END MASTER
392	!$OMP BARRIER
393	END IF
394
395	!****************************************************************************************
396	! 1) Open the file limit.nc if it is the right moment to read, once a day.
397	! The file is read only by the master thread of the master mpi process(is_mpi_root)
398	! Check by the way if the number of records is correct.
399	!
400	!****************************************************************************************
401
402	is_modified = .FALSE.
403	!ym IF (MOD(itime-1, lmt_pas) == 0 .OR. jour_lu /= jour ) THEN ! time to read
404	! not REALLY PERIODIC
405	IF (MOD(itime-1, lmt_pas) == 0 .OR. (jour_lu /= jour .AND. grid_type /= unstructured)) THEN ! time to read
406	! IF (MOD(itime-1, lmt_pas) == 0) THEN ! time to read
407	jour_lu = jour
408	is_modified = .TRUE.
409
410	IF (grid_type==unstructured) THEN
411
412	IF ( type_ocean /= 'couple') THEN
413
414	IF (is_omp_master) CALL xios_recv_field("foce_limin",pct_mpi(:,is_oce))
415	IF (is_omp_master) CALL xios_recv_field("fsic_limin",pct_mpi(:,is_sic))
416	! IF (read_continents .OR. itime == 1) THEN
417	IF (is_omp_master) CALL xios_recv_field("fter_limin",pct_mpi(:,is_ter))
418	IF (is_omp_master) CALL xios_recv_field("flic_limin",pct_mpi(:,is_lic))
419	! ENDIF
420	ENDIF! type_ocean /= couple
421
422	IF ( type_ocean /= 'couple') THEN
423	IF (is_omp_master) CALL xios_recv_field("sst_limin",sst_mpi)
424	ENDIF
425
426	IF (.NOT. ok_veget) THEN
427	IF (is_omp_master) CALL xios_recv_field("alb_limin",alb_mpi)
428	IF (is_omp_master) CALL xios_recv_field("rug_limin",rug_mpi)
429	ENDIF
430
431	IF ( type_ocean /= 'couple') THEN
432	CALL Scatter_omp(sst_mpi,sst)
433	CALL Scatter_omp(pct_mpi(:,is_oce),pctsrf(:,is_oce))
434	CALL Scatter_omp(pct_mpi(:,is_sic),pctsrf(:,is_sic))
435	! IF (read_continents .OR. itime == 1) THEN
436	CALL Scatter_omp(pct_mpi(:,is_ter),pctsrf(:,is_ter))
437	CALL Scatter_omp(pct_mpi(:,is_lic),pctsrf(:,is_lic))
438	! END IF
439	END IF
440
441	IF (.NOT. ok_veget) THEN
442	CALL Scatter_omp(alb_mpi, albedo)
443	CALL Scatter_omp(rug_mpi, rugos)
444	END IF
445
446	ELSE ! grid_type==regular
447
448	!$OMP MASTER ! Only master thread
449	IF (is_mpi_root) THEN ! Only master processus!
450
451	ierr = NF90_OPEN ('limit.nc', NF90_NOWRITE, nid)
452	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,&
453	'Pb d''ouverture du fichier de conditions aux limites',1)
454
455	! La tranche de donnees a lire:
456	start(1) = 1
457	start(2) = jour
458	epais(1) = klon_glo
459	epais(2) = 1
460
461
462	!****************************************************************************************
463	! 2) Read fraction if not type_ocean=couple
464	!
465	!****************************************************************************************
466
467	IF ( type_ocean /= 'couple') THEN
468	!
469	! Ocean fraction
470	ierr = NF90_INQ_VARID(nid, 'FOCE', nvarid)
471	IF (ierr /= NF90_NOERR) CALL abort_physic(modname, 'Le champ <FOCE> est absent',1)
472
473	ierr = NF90_GET_VAR(nid,nvarid,pct_glo(:,is_oce),start,epais)
474	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <FOCE>' ,1)
475	!
476	! Sea-ice fraction
477	ierr = NF90_INQ_VARID(nid, 'FSIC', nvarid)
478	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <FSIC> est absent',1)
479
480	ierr = NF90_GET_VAR(nid,nvarid,pct_glo(:,is_sic),start,epais)
481	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <FSIC>' ,1)
482
483
484	! Read land and continentals fraction only if asked for
485	IF (read_continents .OR. itime == 1) THEN
486	!
487	! Land fraction
488	ierr = NF90_INQ_VARID(nid, 'FTER', nvarid)
489	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <FTER> est absent',1)
490
491	ierr = NF90_GET_VAR(nid,nvarid,pct_glo(:,is_ter),start,epais)
492	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <FTER>',1)
493	!
494	! Continentale ice fraction
495	ierr = NF90_INQ_VARID(nid, 'FLIC', nvarid)
496	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <FLIC> est absent',1)
497
498	ierr = NF90_GET_VAR(nid,nvarid,pct_glo(:,is_lic),start,epais)
499	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <FLIC>',1)
500	END IF
501
502	END IF ! type_ocean /= couple
503
504	!****************************************************************************************
505	! 3) Read sea-surface temperature, if not coupled ocean
506	!
507	!****************************************************************************************
508	IF ( type_ocean /= 'couple') THEN
509
510	ierr = NF90_INQ_VARID(nid, 'SST', nvarid)
511	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <SST> est absent',1)
512
513	ierr = NF90_GET_VAR(nid,nvarid,sst_glo,start,epais)
514	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <SST>',1)
515
516	#ifdef ISO
517	IF ((iso_HTO.gt.0).and.(ok_prod_nucl_tritium)) THEN
518	ierr = NF90_INQ_VARID(nid, 'TUOCE', nvarid)
519	IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Le champ <TUOCE> est absent',1)
520
521	ierr = NF90_GET_VAR(nid,nvarid,tuoce_glo,start,epais)
522	IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Lecture echouee pour <TUOCE>',1)
523	END IF
524	#ifdef ISOVERIF
525	do ii=1,klon_glo
526	if (iso_verif_positif_nostop(370.0-sst_glo(ii), &
527	'limit_read 384').eq.1) then
528	write(,) 'ii,sst_glo=',ii,sst_glo(ii)
529	write(,) 'jour,start,epais=',jour,start,epais
530	stop
531	endif
532	enddo
533	#endif
534	#endif
535
536	END IF
537
538	!****************************************************************************************
539	! 4) Read albedo and rugosity for land surface, only in case of no vegetation model
540	!
541	!****************************************************************************************
542
543	IF (.NOT. ok_veget) THEN
544	!
545	! Read albedo
546	ierr = NF90_INQ_VARID(nid, 'ALB', nvarid)
547	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <ALB> est absent',1)
548
549	ierr = NF90_GET_VAR(nid,nvarid,alb_glo,start,epais)
550	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <ALB>',1)
551	!
552	! Read rugosity
553	ierr = NF90_INQ_VARID(nid, 'RUG', nvarid)
554	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <RUG> est absent',1)
555
556	ierr = NF90_GET_VAR(nid,nvarid,rug_glo,start,epais)
557	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <RUG>',1)
558
559	END IF
560
561	!****************************************************************************************
562	! 5) Close file and distribuate variables to all processus
563	!
564	!****************************************************************************************
565	ierr = NF90_CLOSE(nid)
566	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Pb when closing file', 1)
567	ENDIF ! is_mpi_root
568
569	!$OMP END MASTER
570	!$OMP BARRIER
571
572	IF ( type_ocean /= 'couple') THEN
573	CALL Scatter(sst_glo,sst)
574	CALL Scatter(pct_glo(:,is_oce),pctsrf(:,is_oce))
575	CALL Scatter(pct_glo(:,is_sic),pctsrf(:,is_sic))
576	IF (read_continents .OR. itime == 1) THEN
577	CALL Scatter(pct_glo(:,is_ter),pctsrf(:,is_ter))
578	CALL Scatter(pct_glo(:,is_lic),pctsrf(:,is_lic))
579	END IF
580	#ifdef ISO
581	IF ((iso_HTO.gt.0).and.(ok_prod_nucl_tritium)) THEN
582	CALL Scatter(tuoce_glo,tuoce)
583	END IF
584	#endif
585	END IF
586
587	IF (.NOT. ok_veget) THEN
588	CALL Scatter(alb_glo, albedo)
589	CALL Scatter(rug_glo, rugos)
590	END IF
591
592	ENDIF ! Grid type
593
594	ENDIF ! time to read
595
596	END SUBROUTINE limit_read_tot
597
598	END MODULE limit_read_mod

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

Download in other formats:

Original Format