Context Navigation

limit_read_mod.F90 @ 5756

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

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

Download in other formats:

Original Format