Context Navigation

limit_read_mod.F90 @ 5225

Last change on this file since 5225 was 2839, checked in by Laurent Fairhead, 8 years ago
Merged trunk changes r2785:2838 into testing branch
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.1 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
[1795]	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
[2220]	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
[1795]	149	USE indice_sol_mod
[2720]	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.
[1665]	169	!$OMP THREADPRIVATE(first_call)
	170	INTEGER, SAVE :: jour_lu = -1
	171	!$OMP THREADPRIVATE(jour_lu)
[996]	172	! Locals variables
	173	!****************************************************************************************
[2720]	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'
[2720]	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
[2787]	192	first_call=.FALSE.
[996]	193	! calculate number of time steps for one day
	194	lmt_pas = NINT(86400./dtime * 1.0)
	195
	196	! Allocate module save variables
	197	IF ( type_ocean /= 'couple' ) THEN
	198	ALLOCATE(pctsrf(klon,nbsrf), sst(klon), stat=ierr)
[2408]	199	IF (ierr /= 0) CALL abort_physic(modname, 'PB in allocating pctsrf and sst',1)
[996]	200	END IF
	201
	202	IF ( .NOT. ok_veget ) THEN
	203	ALLOCATE(rugos(klon), albedo(klon), stat=ierr)
[2408]	204	IF (ierr /= 0) CALL abort_physic(modname, 'PB in allocating rugos and albedo',1)
[996]	205	END IF
	206
	207	!$OMP MASTER ! Only master thread
	208	IF (is_mpi_root) THEN ! Only master processus
	209	ierr = NF90_OPEN ('limit.nc', NF90_NOWRITE, nid)
[2408]	210	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,&
[996]	211	'Pb d''ouverture du fichier de conditions aux limites',1)
[2720]	212
	213	!--- WARNING IF CALENDAR IS KNOWN AND DOES NOT MATCH THE ONE OF LMDZ
	214	ierr=NF90_INQ_VARID(nid, 'TEMPS', nvarid)
	215	ierr=NF90_GET_ATT(nid, nvarid, 'calendar', calendar)
	216	IF(ierr==NF90_NOERR.AND.calendar/=calend.AND.prt_level>=1) THEN
	217	WRITE(lunout,*)'BEWARE: gcm and limit.nc calendars differ: '
	218	WRITE(lunout,*)' '//TRIM(calend)//' for gcm'
	219	WRITE(lunout,*)' '//TRIM(calendar)//' for limit.nc file'
	220	END IF
	221
	222	!--- ERROR IF FILE RECORDS NUMBER IS NOT EQUAL TO EXPECTED NUMBER OF DAYS
	223	ierr=NF90_INQUIRE(nid, UnlimitedDimID=ndimid)
	224	ierr=NF90_INQUIRE_DIMENSION(nid, ndimid, len=nn)
[2839]	225	WRITE(abort_message,'(a,2(i3,a))')'limit.nc records number (',nn,') does no'//&
[2787]	226	't match year length (',year_len,')'
[2720]	227	IF(nn/=year_len) CALL abort_physic(modname,abort_message,1)
	228
	229	!--- ERROR IF FILES AND LMDZ HORIZONTAL RESOLUTIONS DO NOT MATCH
	230	ierr=NF90_INQ_DIMID(nid, 'points_physiques', ndimid)
	231	ierr=NF90_INQUIRE_DIMENSION(nid, ndimid, len=nn)
[2787]	232	WRITE(abort_message,'(a,2(i0,a))')'limit.nc horizontal number of cells (',nn, &
	233	') does not match LMDZ klon_glo (',klon_glo,')'
[2720]	234	IF(nn/=klon_glo) CALL abort_physic(modname,abort_message,1)
	235
[2787]	236	ierr = NF90_CLOSE(nid)
	237	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Pb when closing file', 1)
	238	END IF ! is_mpi_root
	239	!$OMP END MASTER
	240	!$OMP BARRIER
	241	END IF
	242
	243	!****************************************************************************************
	244	! 1) Open the file limit.nc if it is the right moment to read, once a day.
	245	! The file is read only by the master thread of the master mpi process(is_mpi_root)
	246	! Check by the way if the number of records is correct.
	247	!
	248	!****************************************************************************************
	249
	250	is_modified = .FALSE.
	251	IF (MOD(itime-1, lmt_pas) == 0 .OR. jour_lu /= jour ) THEN ! time to read
	252	jour_lu = jour
	253	is_modified = .TRUE.
	254	!$OMP MASTER ! Only master thread
	255	IF (is_mpi_root) THEN ! Only master processus
	256
	257	ierr = NF90_OPEN ('limit.nc', NF90_NOWRITE, nid)
	258	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,&
	259	'Pb d''ouverture du fichier de conditions aux limites',1)
	260
[996]	261	! La tranche de donnees a lire:
	262	start(1) = 1
	263	start(2) = jour
	264	epais(1) = klon_glo
	265	epais(2) = 1
	266
	267
	268	!****************************************************************************************
	269	! 2) Read fraction if not type_ocean=couple
	270	!
	271	!****************************************************************************************
	272
	273	IF ( type_ocean /= 'couple') THEN
	274	!
	275	! Ocean fraction
	276	ierr = NF90_INQ_VARID(nid, 'FOCE', nvarid)
[2408]	277	IF (ierr /= NF90_NOERR) CALL abort_physic(modname, 'Le champ <FOCE> est absent',1)
[996]	278
	279	ierr = NF90_GET_VAR(nid,nvarid,pct_glo(:,is_oce),start,epais)
[2408]	280	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <FOCE>' ,1)
[996]	281	!
	282	! Sea-ice fraction
	283	ierr = NF90_INQ_VARID(nid, 'FSIC', nvarid)
[2408]	284	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <FSIC> est absent',1)
[996]	285
	286	ierr = NF90_GET_VAR(nid,nvarid,pct_glo(:,is_sic),start,epais)
[2408]	287	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <FSIC>' ,1)
[996]	288
	289
	290	! Read land and continentals fraction only if asked for
	291	IF (read_continents .OR. itime == 1) THEN
	292	!
	293	! Land fraction
	294	ierr = NF90_INQ_VARID(nid, 'FTER', nvarid)
[2408]	295	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <FTER> est absent',1)
[996]	296
	297	ierr = NF90_GET_VAR(nid,nvarid,pct_glo(:,is_ter),start,epais)
[2408]	298	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <FTER>',1)
[996]	299	!
	300	! Continentale ice fraction
	301	ierr = NF90_INQ_VARID(nid, 'FLIC', nvarid)
[2408]	302	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <FLIC> est absent',1)
[996]	303
	304	ierr = NF90_GET_VAR(nid,nvarid,pct_glo(:,is_lic),start,epais)
[2408]	305	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <FLIC>',1)
[996]	306	END IF
	307
	308	END IF ! type_ocean /= couple
	309
	310	!****************************************************************************************
	311	! 3) Read sea-surface temperature, if not coupled ocean
	312	!
	313	!****************************************************************************************
	314	IF ( type_ocean /= 'couple') THEN
	315
	316	ierr = NF90_INQ_VARID(nid, 'SST', nvarid)
[2408]	317	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <SST> est absent',1)
[996]	318
	319	ierr = NF90_GET_VAR(nid,nvarid,sst_glo,start,epais)
[2408]	320	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <SST>',1)
[996]	321
	322	END IF
	323
	324	!****************************************************************************************
	325	! 4) Read albedo and rugosity for land surface, only in case of no vegetation model
	326	!
	327	!****************************************************************************************
	328
	329	IF (.NOT. ok_veget) THEN
	330	!
	331	! Read albedo
	332	ierr = NF90_INQ_VARID(nid, 'ALB', nvarid)
[2408]	333	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <ALB> est absent',1)
[996]	334
	335	ierr = NF90_GET_VAR(nid,nvarid,alb_glo,start,epais)
[2408]	336	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <ALB>',1)
[996]	337	!
	338	! Read rugosity
	339	ierr = NF90_INQ_VARID(nid, 'RUG', nvarid)
[2408]	340	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <RUG> est absent',1)
[996]	341
	342	ierr = NF90_GET_VAR(nid,nvarid,rug_glo,start,epais)
[2408]	343	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <RUG>',1)
[996]	344
	345	END IF
	346
	347	!****************************************************************************************
	348	! 5) Close file and distribuate variables to all processus
	349	!
	350	!****************************************************************************************
	351	ierr = NF90_CLOSE(nid)
[2408]	352	IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Pb when closing file', 1)
[996]	353	ENDIF ! is_mpi_root
	354
	355	!$OMP END MASTER
	356	!$OMP BARRIER
	357
	358	IF ( type_ocean /= 'couple') THEN
	359	CALL Scatter(sst_glo,sst)
	360	CALL Scatter(pct_glo(:,is_oce),pctsrf(:,is_oce))
	361	CALL Scatter(pct_glo(:,is_sic),pctsrf(:,is_sic))
	362	IF (read_continents .OR. itime == 1) THEN
	363	CALL Scatter(pct_glo(:,is_ter),pctsrf(:,is_ter))
	364	CALL Scatter(pct_glo(:,is_lic),pctsrf(:,is_lic))
	365	END IF
	366	END IF
	367
	368	IF (.NOT. ok_veget) THEN
	369	CALL Scatter(alb_glo, albedo)
	370	CALL Scatter(rug_glo, rugos)
	371	END IF
	372
	373	ENDIF ! time to read
	374
	375	END SUBROUTINE limit_read_tot
	376
	377	END MODULE limit_read_mod

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

Download in other formats:

Original Format