Context Navigation

limit_read_mod.F90 @ 2694

Last change on this file since 2694 was 2667, checked in by fhourdin, 8 years ago
Suite de la correction precedente
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: 15.6 KB

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

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

Download in other formats:

Original Format