Context Navigation

phyetat0.F @ 2372

Last change on this file since 2372 was 45, checked in by lmdz, 25 years ago
Sauvegarde des tendances dynamiques dans l'etat initial L.Li LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 20.7 KB

Rev	Line
[2]	1	SUBROUTINE phyetat0 (fichnom,dtime,co2_ppm,solaire,
	2	. rlat,rlon,tsol,tsoil,deltat,qsol,snow,
	3	. radsol,rugmer,agesno,clesphy0,
[45]	4	. zmea,zstd,zsig,zgam,zthe,zpic,zval,rugsrel,tabcntr0,
	5	. t_ancien,q_ancien,ancien_ok)
[2]	6	IMPLICIT none
	7	c======================================================================
	8	c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
	9	c Objet: Lecture de l'etat initial pour la physique
	10	c======================================================================
	11	#include "dimensions.h"
	12	#include "dimphy.h"
	13	#include "netcdf.inc"
	14	#include "indicesol.h"
	15	#include "dimsoil.h"
	16	#include "clesphys.h"
	17	c======================================================================
	18	CHARACTER() fichnom
	19	REAL dtime
	20	INTEGER radpas
	21	REAL rlat(klon), rlon(klon)
	22	REAL co2_ppm
	23	REAL solaire
	24	REAL tsol(klon,nbsrf)
	25	REAL tsoil(klon,nsoilmx,nbsrf)
	26	REAL deltat(klon)
	27	REAL qsol(klon,nbsrf)
	28	REAL snow(klon,nbsrf)
	29	REAL radsol(klon)
	30	REAL rugmer(klon)
	31	REAL agesno(klon)
	32	REAL zmea(klon)
	33	REAL zstd(klon)
	34	REAL zsig(klon)
	35	REAL zgam(klon)
	36	REAL zthe(klon)
	37	REAL zpic(klon)
	38	REAL zval(klon)
	39	REAL rugsrel(klon)
	40
[45]	41	REAL t_ancien(klon,klev), q_ancien(klon,klev)
	42	LOGICAL ancien_ok
	43
[2]	44	INTEGER longcles
	45	PARAMETER ( longcles = 20 )
	46	REAL clesphy0( longcles )
	47	c
	48	REAL xmin, xmax
	49	c
	50	INTEGER nid, nvarid
	51	INTEGER ierr, i, nsrf, isoil
	52	INTEGER length
	53	PARAMETER (length=100)
	54	REAL tab_cntrl(length), tabcntr0(length)
	55	CHARACTER*7 str7
	56	CHARACTER*2 str2
	57	c
	58	c Ouvrir le fichier contenant l'etat initial:
	59	c
	60	ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
	61	IF (ierr.NE.NF_NOERR) THEN
	62	write(6,*)' Pb d''ouverture du fichier '//fichnom
	63	write(6,*)' ierr = ', ierr
	64	CALL ABORT
	65	ENDIF
	66	c
	67	c Lecture des parametres de controle:
	68	c
	69	ierr = NF_INQ_VARID (nid, "controle", nvarid)
	70	IF (ierr.NE.NF_NOERR) THEN
	71	PRINT*, 'phyetat0: Le champ <controle> est absent'
	72	CALL abort
	73	ENDIF
	74	#ifdef NC_DOUBLE
	75	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
	76	#else
	77	ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
	78	#endif
	79	IF (ierr.NE.NF_NOERR) THEN
	80	PRINT*, 'phyetat0: Lecture echouee pour <controle>'
	81	CALL abort
	82	ELSE
	83	c
	84	DO i = 1, length
	85	tabcntr0( i ) = tab_cntrl( i )
	86	ENDDO
	87	c
	88	cycle_diurne = .FALSE.
	89	soil_model = .FALSE.
	90	new_oliq = .FALSE.
	91	ok_orodr = .FALSE.
	92	ok_orolf = .FALSE.
	93	ok_limitvrai = .FALSE.
	94
	95
	96	IF( clesphy0(1).NE.tab_cntrl( 5 ) ) THEN
	97	tab_cntrl( 5 ) = clesphy0(1)
	98	ENDIF
	99
	100	IF( clesphy0(2).NE.tab_cntrl( 6 ) ) THEN
	101	tab_cntrl( 6 ) = clesphy0(2)
	102	ENDIF
	103
	104	IF( clesphy0(3).NE.tab_cntrl( 7 ) ) THEN
	105	tab_cntrl( 7 ) = clesphy0(3)
	106	ENDIF
	107
	108	IF( clesphy0(4).NE.tab_cntrl( 8 ) ) THEN
	109	tab_cntrl( 8 ) = clesphy0(4)
	110	ENDIF
	111
	112	IF( clesphy0(5).NE.tab_cntrl( 9 ) ) THEN
	113	tab_cntrl( 9 ) = clesphy0( 5 )
	114	ENDIF
	115
	116	IF( clesphy0(6).NE.tab_cntrl( 10 ) ) THEN
	117	tab_cntrl( 10 ) = clesphy0( 6 )
	118	ENDIF
	119
	120	IF( clesphy0(7).NE.tab_cntrl( 11 ) ) THEN
	121	tab_cntrl( 11 ) = clesphy0( 7 )
	122	ENDIF
	123
	124	IF( clesphy0(8).NE.tab_cntrl( 12 ) ) THEN
	125	tab_cntrl( 12 ) = clesphy0( 8 )
	126	ENDIF
	127
	128
	129	dtime = tab_cntrl(1)
	130	radpas = tab_cntrl(2)
	131	co2_ppm = tab_cntrl(3)
	132	solaire = tab_cntrl(4)
	133	iflag_con = tab_cntrl(5)
	134	nbapp_rad = tab_cntrl(6)
	135
	136
	137	cycle_diurne = .FALSE.
	138	soil_model = .FALSE.
	139	new_oliq = .FALSE.
	140	ok_orodr = .FALSE.
	141	ok_orolf = .FALSE.
	142	ok_limitvrai = .FALSE.
	143
	144	IF( tab_cntrl( 7) .EQ. 1. ) cycle_diurne = .TRUE.
	145	IF( tab_cntrl( 8) .EQ. 1. ) soil_model = .TRUE.
	146	IF( tab_cntrl( 9) .EQ. 1. ) new_oliq = .TRUE.
	147	IF( tab_cntrl(10) .EQ. 1. ) ok_orodr = .TRUE.
	148	IF( tab_cntrl(11) .EQ. 1. ) ok_orolf = .TRUE.
	149	IF( tab_cntrl(12) .EQ. 1. ) ok_limitvrai = .TRUE.
	150
	151	ENDIF
	152	c
	153	c Lecture des latitudes (coordonnees):
	154	c
	155	ierr = NF_INQ_VARID (nid, "latitude", nvarid)
	156	IF (ierr.NE.NF_NOERR) THEN
	157	PRINT*, 'phyetat0: Le champ <latitude> est absent'
	158	CALL abort
	159	ENDIF
	160	#ifdef NC_DOUBLE
	161	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlat)
	162	#else
	163	ierr = NF_GET_VAR_REAL(nid, nvarid, rlat)
	164	#endif
	165	IF (ierr.NE.NF_NOERR) THEN
	166	PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
	167	CALL abort
	168	ENDIF
	169	c
	170	c Lecture des longitudes (coordonnees):
	171	c
	172	ierr = NF_INQ_VARID (nid, "longitude", nvarid)
	173	IF (ierr.NE.NF_NOERR) THEN
	174	PRINT*, 'phyetat0: Le champ <longitude> est absent'
	175	CALL abort
	176	ENDIF
	177	#ifdef NC_DOUBLE
	178	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlon)
	179	#else
	180	ierr = NF_GET_VAR_REAL(nid, nvarid, rlon)
	181	#endif
	182	IF (ierr.NE.NF_NOERR) THEN
	183	PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
	184	CALL abort
	185	ENDIF
	186	c
	187	c Lecture des temperatures du sol:
	188	c
	189	ierr = NF_INQ_VARID (nid, "TS", nvarid)
	190	IF (ierr.NE.NF_NOERR) THEN
	191	PRINT*, 'phyetat0: Le champ <TS> est absent'
	192	PRINT, ' Mais je vais essayer de lire TS*'
	193	DO nsrf = 1, nbsrf
	194	IF (nsrf.GT.99) THEN
	195	PRINT*, "Trop de sous-mailles"
	196	CALL abort
	197	ENDIF
	198	WRITE(str2,'(i2.2)') nsrf
	199	ierr = NF_INQ_VARID (nid, "TS"//str2, nvarid)
	200	IF (ierr.NE.NF_NOERR) THEN
	201	PRINT*, "phyetat0: Le champ <TS"//str2//"> est absent"
	202	CALL abort
	203	ENDIF
	204	#ifdef NC_DOUBLE
	205	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1,nsrf))
	206	#else
	207	ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1,nsrf))
	208	#endif
	209	IF (ierr.NE.NF_NOERR) THEN
	210	PRINT*, "phyetat0: Lecture echouee pour <TS"//str2//">"
	211	CALL abort
	212	ENDIF
	213	xmin = 1.0E+20
	214	xmax = -1.0E+20
	215	DO i = 1, klon
	216	xmin = MIN(tsol(i,nsrf),xmin)
	217	xmax = MAX(tsol(i,nsrf),xmax)
	218	ENDDO
	219	PRINT,'Temperature du sol TS*:', nsrf, xmin, xmax
	220	ENDDO
	221	ELSE
	222	PRINT*, 'phyetat0: Le champ <TS> est present'
	223	PRINT, ' J ignore donc les autres temperatures TS*'
	224	#ifdef NC_DOUBLE
	225	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1,1))
	226	#else
	227	ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1,1))
	228	#endif
	229	IF (ierr.NE.NF_NOERR) THEN
	230	PRINT*, "phyetat0: Lecture echouee pour <TS>"
	231	CALL abort
	232	ENDIF
	233	xmin = 1.0E+20
	234	xmax = -1.0E+20
	235	DO i = 1, klon
	236	xmin = MIN(tsol(i,1),xmin)
	237	xmax = MAX(tsol(i,1),xmax)
	238	ENDDO
	239	PRINT*,'Temperature du sol <TS>', xmin, xmax
	240	DO nsrf = 2, nbsrf
	241	DO i = 1, klon
	242	tsol(i,nsrf) = tsol(i,1)
	243	ENDDO
	244	ENDDO
	245	ENDIF
	246	c
	247	c Lecture des temperatures du sol profond:
	248	c
	249	DO nsrf = 1, nbsrf
	250	DO isoil=1, nsoilmx
	251	IF (isoil.GT.99 .AND. nsrf.GT.99) THEN
	252	PRINT*, "Trop de couches ou sous-mailles"
	253	CALL abort
	254	ENDIF
	255	WRITE(str7,'(i2.2,"srf",i2.2)') isoil, nsrf
	256	ierr = NF_INQ_VARID (nid, 'Tsoil'//str7, nvarid)
	257	IF (ierr.NE.NF_NOERR) THEN
	258	PRINT*, "phyetat0: Le champ <Tsoil"//str7//"> est absent"
	259	PRINT*, " Il prend donc la valeur de surface"
	260	DO i=1, klon
	261	tsoil(i,isoil,nsrf)=tsol(i,nsrf)
	262	ENDDO
	263	ELSE
	264	#ifdef NC_DOUBLE
	265	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,isoil,nsrf))
	266	#else
	267	ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil,nsrf))
	268	#endif
	269	IF (ierr.NE.NF_NOERR) THEN
	270	PRINT*, "Lecture echouee pour <Tsoil"//str7//">"
	271	CALL abort
	272	ENDIF
	273	ENDIF
	274	ENDDO
	275	ENDDO
	276	c
	277	c Lecture de deltat (pour slab ocean seulement):
	278	c
	279	ierr = NF_INQ_VARID (nid, "DELTAT", nvarid)
	280	IF (ierr.NE.NF_NOERR) THEN
	281	PRINT*, "phyetat0: Le champ <DELTAT> est absent"
	282	CALL abort
	283	ENDIF
	284	#ifdef NC_DOUBLE
	285	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, deltat)
	286	#else
	287	ierr = NF_GET_VAR_REAL(nid, nvarid, deltat)
	288	#endif
	289	IF (ierr.NE.NF_NOERR) THEN
	290	PRINT*, "phyetat0: Lecture echouee pour <DELTAT>"
	291	CALL abort
	292	ENDIF
	293	xmin = 1.0E+20
	294	xmax = -1.0E+20
	295	DO i = 1, klon
	296	xmin = MIN(deltat(i),xmin)
	297	xmax = MAX(deltat(i),xmax)
	298	ENDDO
	299	PRINT*,'Ecart de la SST deltat:', xmin, xmax
	300	c
	301	c Lecture de l'humidite du sol:
	302	c
	303	ierr = NF_INQ_VARID (nid, "QS", nvarid)
	304	IF (ierr.NE.NF_NOERR) THEN
	305	PRINT*, 'phyetat0: Le champ <QS> est absent'
	306	PRINT, ' Mais je vais essayer de lire QS*'
	307	DO nsrf = 1, nbsrf
	308	IF (nsrf.GT.99) THEN
	309	PRINT*, "Trop de sous-mailles"
	310	CALL abort
	311	ENDIF
	312	WRITE(str2,'(i2.2)') nsrf
	313	ierr = NF_INQ_VARID (nid, "QS"//str2, nvarid)
	314	IF (ierr.NE.NF_NOERR) THEN
	315	PRINT*, "phyetat0: Le champ <QS"//str2//"> est absent"
	316	CALL abort
	317	ENDIF
	318	#ifdef NC_DOUBLE
	319	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, qsol(1,nsrf))
	320	#else
	321	ierr = NF_GET_VAR_REAL(nid, nvarid, qsol(1,nsrf))
	322	#endif
	323	IF (ierr.NE.NF_NOERR) THEN
	324	PRINT*, "phyetat0: Lecture echouee pour <QS"//str2//">"
	325	CALL abort
	326	ENDIF
	327	xmin = 1.0E+20
	328	xmax = -1.0E+20
	329	DO i = 1, klon
	330	xmin = MIN(qsol(i,nsrf),xmin)
	331	xmax = MAX(qsol(i,nsrf),xmax)
	332	ENDDO
	333	PRINT,'Humidite du sol QS*:', nsrf, xmin, xmax
	334	ENDDO
	335	ELSE
	336	PRINT*, 'phyetat0: Le champ <QS> est present'
	337	PRINT, ' J ignore donc les autres humidites QS*'
	338	#ifdef NC_DOUBLE
	339	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, qsol(1,1))
	340	#else
	341	ierr = NF_GET_VAR_REAL(nid, nvarid, qsol(1,1))
	342	#endif
	343	IF (ierr.NE.NF_NOERR) THEN
	344	PRINT*, "phyetat0: Lecture echouee pour <QS>"
	345	CALL abort
	346	ENDIF
	347	xmin = 1.0E+20
	348	xmax = -1.0E+20
	349	DO i = 1, klon
	350	xmin = MIN(qsol(i,1),xmin)
	351	xmax = MAX(qsol(i,1),xmax)
	352	ENDDO
	353	PRINT*,'Humidite du sol <QS>', xmin, xmax
	354	DO nsrf = 2, nbsrf
	355	DO i = 1, klon
	356	qsol(i,nsrf) = qsol(i,1)
	357	ENDDO
	358	ENDDO
	359	ENDIF
	360	c
	361	c Lecture de neige au sol:
	362	c
	363	ierr = NF_INQ_VARID (nid, "SNOW", nvarid)
	364	IF (ierr.NE.NF_NOERR) THEN
	365	PRINT*, 'phyetat0: Le champ <SNOW> est absent'
	366	PRINT, ' Mais je vais essayer de lire SNOW*'
	367	DO nsrf = 1, nbsrf
	368	IF (nsrf.GT.99) THEN
	369	PRINT*, "Trop de sous-mailles"
	370	CALL abort
	371	ENDIF
	372	WRITE(str2,'(i2.2)') nsrf
	373	ierr = NF_INQ_VARID (nid, "SNOW"//str2, nvarid)
	374	IF (ierr.NE.NF_NOERR) THEN
	375	PRINT*, "phyetat0: Le champ <SNOW"//str2//"> est absent"
	376	CALL abort
	377	ENDIF
	378	#ifdef NC_DOUBLE
	379	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, snow(1,nsrf))
	380	#else
	381	ierr = NF_GET_VAR_REAL(nid, nvarid, snow(1,nsrf))
	382	#endif
	383	IF (ierr.NE.NF_NOERR) THEN
	384	PRINT*, "phyetat0: Lecture echouee pour <SNOW"//str2//">"
	385	CALL abort
	386	ENDIF
	387	xmin = 1.0E+20
	388	xmax = -1.0E+20
	389	DO i = 1, klon
	390	xmin = MIN(snow(i,nsrf),xmin)
	391	xmax = MAX(snow(i,nsrf),xmax)
	392	ENDDO
	393	PRINT,'Neige du sol SNOW*:', nsrf, xmin, xmax
	394	ENDDO
	395	ELSE
	396	PRINT*, 'phyetat0: Le champ <SNOW> est present'
	397	PRINT, ' J ignore donc les autres neiges SNOW*'
	398	#ifdef NC_DOUBLE
	399	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, snow(1,1))
	400	#else
	401	ierr = NF_GET_VAR_REAL(nid, nvarid, snow(1,1))
	402	#endif
	403	IF (ierr.NE.NF_NOERR) THEN
	404	PRINT*, "phyetat0: Lecture echouee pour <SNOW>"
	405	CALL abort
	406	ENDIF
	407	xmin = 1.0E+20
	408	xmax = -1.0E+20
	409	DO i = 1, klon
	410	xmin = MIN(snow(i,1),xmin)
	411	xmax = MAX(snow(i,1),xmax)
	412	ENDDO
	413	PRINT*,'Neige du sol <SNOW>', xmin, xmax
	414	DO nsrf = 2, nbsrf
	415	DO i = 1, klon
	416	snow(i,nsrf) = snow(i,1)
	417	ENDDO
	418	ENDDO
	419	ENDIF
	420	c
	421	c Lecture du rayonnement net au sol:
	422	c
	423	ierr = NF_INQ_VARID (nid, "RADS", nvarid)
	424	IF (ierr.NE.NF_NOERR) THEN
	425	PRINT*, 'phyetat0: Le champ <RADS> est absent'
	426	CALL abort
	427	ENDIF
	428	#ifdef NC_DOUBLE
	429	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, radsol)
	430	#else
	431	ierr = NF_GET_VAR_REAL(nid, nvarid, radsol)
	432	#endif
	433	IF (ierr.NE.NF_NOERR) THEN
	434	PRINT*, 'phyetat0: Lecture echouee pour <RADS>'
	435	CALL abort
	436	ENDIF
	437	xmin = 1.0E+20
	438	xmax = -1.0E+20
	439	DO i = 1, klon
	440	xmin = MIN(radsol(i),xmin)
	441	xmax = MAX(radsol(i),xmax)
	442	ENDDO
	443	PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
	444	c
	445	c Lecture de la longueur de rugosite en mer:
	446	c
	447	ierr = NF_INQ_VARID (nid, "RUGMER", nvarid)
	448	IF (ierr.NE.NF_NOERR) THEN
	449	PRINT*, 'phyetat0: Le champ <RUGMER> est absent'
	450	CALL abort
	451	ENDIF
	452	#ifdef NC_DOUBLE
	453	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rugmer)
	454	#else
	455	ierr = NF_GET_VAR_REAL(nid, nvarid, rugmer)
	456	#endif
	457	IF (ierr.NE.NF_NOERR) THEN
	458	PRINT*, 'phyetat0: Lecture echouee pour <RUGMER>'
	459	CALL abort
	460	ENDIF
	461	xmin = 1.0E+20
	462	xmax = -1.0E+20
	463	DO i = 1, klon
	464	xmin = MIN(rugmer(i),xmin)
	465	xmax = MAX(rugmer(i),xmax)
	466	ENDDO
	467	PRINT*,'Rugosite sur la mer rugmer:', xmin, xmax
	468	c
	469	c Lecture de l'age de la neige:
	470	c
	471	ierr = NF_INQ_VARID (nid, "AGESNO", nvarid)
	472	IF (ierr.NE.NF_NOERR) THEN
	473	PRINT*, 'phyetat0: Le champ <AGESNO> est absent'
	474	PRINT*, " Valeur par default: 50"
	475	DO i = 1, klon
	476	agesno(i) = 50.0
	477	ENDDO
	478	ELSE
	479	#ifdef NC_DOUBLE
	480	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, agesno)
	481	#else
	482	ierr = NF_GET_VAR_REAL(nid, nvarid, agesno)
	483	#endif
	484	IF (ierr.NE.NF_NOERR) THEN
	485	PRINT*, 'phyetat0: Lecture echouee pour <AGESNO>'
	486	CALL abort
	487	ENDIF
	488	xmin = 1.0E+20
	489	xmax = -1.0E+20
	490	DO i = 1, klon
	491	xmin = MIN(agesno(i),xmin)
	492	xmax = MAX(agesno(i),xmax)
	493	ENDDO
	494	PRINT*,'Age de la neige agesno:', xmin, xmax
	495	ENDIF
	496	c
	497	c
	498	ierr = NF_INQ_VARID (nid, "ZMEA", nvarid)
	499	IF (ierr.NE.NF_NOERR) THEN
	500	PRINT*, 'phyetat0: Le champ <ZMEA> est absent'
	501	CALL abort
	502	ENDIF
	503	#ifdef NC_DOUBLE
	504	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmea)
	505	#else
	506	ierr = NF_GET_VAR_REAL(nid, nvarid, zmea)
	507	#endif
	508	IF (ierr.NE.NF_NOERR) THEN
	509	PRINT*, 'phyetat0: Lecture echouee pour <ZMEA>'
	510	CALL abort
	511	ENDIF
	512	xmin = 1.0E+20
	513	xmax = -1.0E+20
	514	DO i = 1, klon
	515	xmin = MIN(zmea(i),xmin)
	516	xmax = MAX(zmea(i),xmax)
	517	ENDDO
	518	PRINT*,'OROGRAPHIE SOUS-MAILLE zmea:', xmin, xmax
	519	c
	520	c
	521	ierr = NF_INQ_VARID (nid, "ZSTD", nvarid)
	522	IF (ierr.NE.NF_NOERR) THEN
	523	PRINT*, 'phyetat0: Le champ <ZSTD> est absent'
	524	CALL abort
	525	ENDIF
	526	#ifdef NC_DOUBLE
	527	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zstd)
	528	#else
	529	ierr = NF_GET_VAR_REAL(nid, nvarid, zstd)
	530	#endif
	531	IF (ierr.NE.NF_NOERR) THEN
	532	PRINT*, 'phyetat0: Lecture echouee pour <ZSTD>'
	533	CALL abort
	534	ENDIF
	535	xmin = 1.0E+20
	536	xmax = -1.0E+20
	537	DO i = 1, klon
	538	xmin = MIN(zstd(i),xmin)
	539	xmax = MAX(zstd(i),xmax)
	540	ENDDO
	541	PRINT*,'OROGRAPHIE SOUS-MAILLE zstd:', xmin, xmax
	542	c
	543	c
	544	ierr = NF_INQ_VARID (nid, "ZSIG", nvarid)
	545	IF (ierr.NE.NF_NOERR) THEN
	546	PRINT*, 'phyetat0: Le champ <ZSIG> est absent'
	547	CALL abort
	548	ENDIF
	549	#ifdef NC_DOUBLE
	550	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zsig)
	551	#else
	552	ierr = NF_GET_VAR_REAL(nid, nvarid, zsig)
	553	#endif
	554	IF (ierr.NE.NF_NOERR) THEN
	555	PRINT*, 'phyetat0: Lecture echouee pour <ZSIG>'
	556	CALL abort
	557	ENDIF
	558	xmin = 1.0E+20
	559	xmax = -1.0E+20
	560	DO i = 1, klon
	561	xmin = MIN(zsig(i),xmin)
	562	xmax = MAX(zsig(i),xmax)
	563	ENDDO
	564	PRINT*,'OROGRAPHIE SOUS-MAILLE zsig:', xmin, xmax
	565	c
	566	c
	567	ierr = NF_INQ_VARID (nid, "ZGAM", nvarid)
	568	IF (ierr.NE.NF_NOERR) THEN
	569	PRINT*, 'phyetat0: Le champ <ZGAM> est absent'
	570	CALL abort
	571	ENDIF
	572	#ifdef NC_DOUBLE
	573	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zgam)
	574	#else
	575	ierr = NF_GET_VAR_REAL(nid, nvarid, zgam)
	576	#endif
	577	IF (ierr.NE.NF_NOERR) THEN
	578	PRINT*, 'phyetat0: Lecture echouee pour <ZGAM>'
	579	CALL abort
	580	ENDIF
	581	xmin = 1.0E+20
	582	xmax = -1.0E+20
	583	DO i = 1, klon
	584	xmin = MIN(zgam(i),xmin)
	585	xmax = MAX(zgam(i),xmax)
	586	ENDDO
	587	PRINT*,'OROGRAPHIE SOUS-MAILLE zgam:', xmin, xmax
	588	c
	589	c
	590	ierr = NF_INQ_VARID (nid, "ZTHE", nvarid)
	591	IF (ierr.NE.NF_NOERR) THEN
	592	PRINT*, 'phyetat0: Le champ <ZTHE> est absent'
	593	CALL abort
	594	ENDIF
	595	#ifdef NC_DOUBLE
	596	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zthe)
	597	#else
	598	ierr = NF_GET_VAR_REAL(nid, nvarid, zthe)
	599	#endif
	600	IF (ierr.NE.NF_NOERR) THEN
	601	PRINT*, 'phyetat0: Lecture echouee pour <ZTHE>'
	602	CALL abort
	603	ENDIF
	604	xmin = 1.0E+20
	605	xmax = -1.0E+20
	606	DO i = 1, klon
	607	xmin = MIN(zthe(i),xmin)
	608	xmax = MAX(zthe(i),xmax)
	609	ENDDO
	610	PRINT*,'OROGRAPHIE SOUS-MAILLE zthe:', xmin, xmax
	611	c
	612	c
	613	ierr = NF_INQ_VARID (nid, "ZPIC", nvarid)
	614	IF (ierr.NE.NF_NOERR) THEN
	615	PRINT*, 'phyetat0: Le champ <ZPIC> est absent'
	616	CALL abort
	617	ENDIF
	618	#ifdef NC_DOUBLE
	619	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zpic)
	620	#else
	621	ierr = NF_GET_VAR_REAL(nid, nvarid, zpic)
	622	#endif
	623	IF (ierr.NE.NF_NOERR) THEN
	624	PRINT*, 'phyetat0: Lecture echouee pour <ZPIC>'
	625	CALL abort
	626	ENDIF
	627	xmin = 1.0E+20
	628	xmax = -1.0E+20
	629	DO i = 1, klon
	630	xmin = MIN(zpic(i),xmin)
	631	xmax = MAX(zpic(i),xmax)
	632	ENDDO
	633	PRINT*,'OROGRAPHIE SOUS-MAILLE zpic:', xmin, xmax
	634	c
	635	ierr = NF_INQ_VARID (nid, "ZVAL", nvarid)
	636	IF (ierr.NE.NF_NOERR) THEN
	637	PRINT*, 'phyetat0: Le champ <ZVAL> est absent'
	638	CALL abort
	639	ENDIF
	640	#ifdef NC_DOUBLE
	641	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zval)
	642	#else
	643	ierr = NF_GET_VAR_REAL(nid, nvarid, zval)
	644	#endif
	645	IF (ierr.NE.NF_NOERR) THEN
	646	PRINT*, 'phyetat0: Lecture echouee pour <ZVAL>'
	647	CALL abort
	648	ENDIF
	649	xmin = 1.0E+20
	650	xmax = -1.0E+20
	651	DO i = 1, klon
	652	xmin = MIN(zval(i),xmin)
	653	xmax = MAX(zval(i),xmax)
	654	ENDDO
	655	PRINT*,'OROGRAPHIE SOUS-MAILLE zval:', xmin, xmax
	656	c
	657	c
	658	ierr = NF_INQ_VARID (nid, "RUGSREL", nvarid)
	659	IF (ierr.NE.NF_NOERR) THEN
	660	PRINT*, 'phyetat0: Le champ <RUGSREL> est absent'
	661	CALL abort
	662	ENDIF
	663	#ifdef NC_DOUBLE
	664	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rugsrel)
	665	#else
	666	ierr = NF_GET_VAR_REAL(nid, nvarid, rugsrel)
	667	#endif
	668	IF (ierr.NE.NF_NOERR) THEN
	669	PRINT*, 'phyetat0: Lecture echouee pour <RUGSREL>'
	670	CALL abort
	671	ENDIF
	672	xmin = 1.0E+20
	673	xmax = -1.0E+20
	674	DO i = 1, klon
	675	xmin = MIN(rugsrel(i),xmin)
	676	xmax = MAX(rugsrel(i),xmax)
	677	ENDDO
	678	PRINT*,'Rugosite relief (ecart-type) rugsrel:', xmin, xmax
	679	c
[45]	680	c
	681	ancien_ok = .TRUE.
	682	c
	683	ierr = NF_INQ_VARID (nid, "TANCIEN", nvarid)
	684	IF (ierr.NE.NF_NOERR) THEN
	685	PRINT*, "phyetat0: Le champ <TANCIEN> est absent"
	686	PRINT*, "Depart legerement fausse. Mais je continue"
	687	ancien_ok = .FALSE.
	688	ELSE
	689	#ifdef NC_DOUBLE
	690	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, t_ancien)
	691	#else
	692	ierr = NF_GET_VAR_REAL(nid, nvarid, t_ancien)
	693	#endif
	694	IF (ierr.NE.NF_NOERR) THEN
	695	PRINT*, "phyetat0: Lecture echouee pour <TANCIEN>"
	696	CALL abort
	697	ENDIF
	698	ENDIF
	699	c
	700	ierr = NF_INQ_VARID (nid, "QANCIEN", nvarid)
	701	IF (ierr.NE.NF_NOERR) THEN
	702	PRINT*, "phyetat0: Le champ <QANCIEN> est absent"
	703	PRINT*, "Depart legerement fausse. Mais je continue"
	704	ancien_ok = .FALSE.
	705	ELSE
	706	#ifdef NC_DOUBLE
	707	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q_ancien)
	708	#else
	709	ierr = NF_GET_VAR_REAL(nid, nvarid, q_ancien)
	710	#endif
	711	IF (ierr.NE.NF_NOERR) THEN
	712	PRINT*, "phyetat0: Lecture echouee pour <QANCIEN>"
	713	CALL abort
	714	ENDIF
	715	ENDIF
	716	c
[2]	717	c Fermer le fichier:
	718	c
	719	ierr = NF_CLOSE(nid)
	720	c
	721	RETURN
	722	END

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

Download in other formats:

Original Format