Context Navigation

limit_read_mod.F90 @ 5186

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

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

Download in other formats:

Original Format