Context Navigation

limit_read_mod.F90 @ 5355

Last change on this file since 5355 was 5217, checked in by Ehouarn Millour, 3 months ago
Replace "abort_gcm" in physics with "abort_physic" to ensure clean dynamics-physics separation. EM
File size: 22.1 KB

Rev	Line
[3927]	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
[4619]	42	USE lmdz_xios
[3927]	43	IMPLICIT NONE
	44	INTEGER, INTENT(IN) :: first_day
	45
	46
	47	IF ( type_ocean /= 'couple') THEN
	48	IF (grid_type==unstructured) THEN
[4619]	49	IF (is_omp_master) CALL xios_set_file_attr("limit_read",enabled=.TRUE.,record_offset=first_day)
[3927]	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
[5084]	276	USE netcdf
[3927]	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
[4619]	286	USE lmdz_XIOS, ONLY: xios_recv_field
[3927]	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)
[5217]	519	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <TUOCE> est absent',1)
[3927]	520
	521	ierr = NF90_GET_VAR(nid,nvarid,tuoce_glo,start,epais)
[5217]	522	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <TUOCE>',1)
[3927]	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