Context Navigation

dynetat0.F @ 536

Last change on this file since 536 was 253, checked in by emillour, 13 years ago

Generic GCM

Massive update to version 0.7

EM+RW

File size: 12.4 KB

Rev	Line
[135]	1	SUBROUTINE dynetat0(fichnom,nq,vcov,ucov,
	2	. teta,q,masse,ps,phis,time)
	3	IMPLICIT NONE
	4
	5	c=======================================================================
	6	c
	7	c Auteur: P. Le Van / L.Fairhead
	8	c -------
	9	c
	10	c objet:
	11	c ------
	12	c
	13	c Lecture de l'etat initial
	14	c
	15	c Modifs: Oct.2008 read in tracers by name. Ehouarn Millour
	16	c
	17	c=======================================================================
	18	c-----------------------------------------------------------------------
	19	c Declarations:
	20	c -------------
	21
	22	#include "dimensions.h"
	23	#include "paramet.h"
	24	#include "temps.h"
	25	#include "comconst.h"
	26	#include "comvert.h"
	27	#include "comgeom.h"
	28	#include "ener.h"
	29	#include "netcdf.inc"
	30	#include "description.h"
	31	#include "serre.h"
	32	#include "logic.h"
	33	#include"advtrac.h"
	34
	35	c Arguments:
	36	c ----------
	37
	38	CHARACTER() fichnom
	39	INTEGER nq
	40	REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
	41	REAL q(iip1,jjp1,llm,nq),masse(ip1jmp1,llm)
	42	REAL ps(ip1jmp1),phis(ip1jmp1)
	43
	44	REAL time
	45
	46	c Variables
	47	c
	48	INTEGER length,iq,i,j,l
	49	PARAMETER (length = 100)
	50	REAL tab_cntrl(length) ! tableau des parametres du run
	51	INTEGER ierr, nid, nvarid, nqold
	52	CHARACTER str33,yes1
	53
[253]	54
	55	! added by RW for test
	56	real pmean,airetot
	57	integer ij
	58
[135]	59	c-----------------------------------------------------------------------
	60
	61	c Ouverture NetCDF du fichier etat initial
	62
	63	ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
	64	IF (ierr.NE.NF_NOERR) THEN
	65	write(6,*)' Pb d''ouverture du fichier ',fichnom
	66	CALL ABORT
	67	ENDIF
	68
	69	c
	70	ierr = NF_INQ_VARID (nid, "controle", nvarid)
	71	IF (ierr .NE. NF_NOERR) THEN
	72	PRINT*, "dynetat0: Le champ <controle> est absent"
	73	CALL abort
	74	ENDIF
	75	#ifdef NC_DOUBLE
	76	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
	77	#else
	78	ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
	79	#endif
	80	IF (ierr .NE. NF_NOERR) THEN
	81	PRINT*, "dynetat0: Lecture echoue pour <controle>"
	82	CALL abort
	83	ENDIF
	84
	85	im = tab_cntrl(1)
	86	jm = tab_cntrl(2)
	87	lllm = tab_cntrl(3)
	88	day_ini = tab_cntrl(4)
	89	rad = tab_cntrl(5)
	90	omeg = tab_cntrl(6)
	91	g = tab_cntrl(7)
	92	cpp = tab_cntrl(8)
	93	kappa = tab_cntrl(9)
	94	daysec = tab_cntrl(10)
	95	dtvr = tab_cntrl(11)
	96	etot0 = tab_cntrl(12)
	97	ptot0 = tab_cntrl(13)
	98	ztot0 = tab_cntrl(14)
	99	stot0 = tab_cntrl(15)
	100	ang0 = tab_cntrl(16)
	101	pa = tab_cntrl(17)
	102	preff = tab_cntrl(18)
	103	c
	104	clon = tab_cntrl(19)
	105	clat = tab_cntrl(20)
	106	grossismx = tab_cntrl(21)
	107	grossismy = tab_cntrl(22)
	108	c
	109	IF ( tab_cntrl(23).EQ.1. ) THEN
	110	fxyhypb = . TRUE .
	111	dzoomx = tab_cntrl(24)
	112	dzoomy = tab_cntrl(25)
	113	taux = tab_cntrl(27)
	114	tauy = tab_cntrl(28)
	115	ELSE
	116	fxyhypb = . FALSE .
	117	ysinus = . FALSE .
	118	IF( tab_cntrl(26).EQ.1. ) ysinus = . TRUE.
	119	ENDIF
	120	c .................................................................
	121	c
	122	c
	123	PRINT*,'dynetat0: rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
	124
	125	IF( im.ne.iim ) THEN
	126	PRINT 1,im,iim
	127	STOP
	128	ELSE IF( jm.ne.jjm ) THEN
	129	PRINT 2,jm,jjm
	130	STOP
	131	ELSE IF( lllm.ne.llm ) THEN
	132	PRINT 3,lllm,llm
	133	STOP
	134	ENDIF
	135
	136	ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
	137	IF (ierr .NE. NF_NOERR) THEN
	138	PRINT*, "dynetat0: Le champ <rlonu> est absent"
	139	CALL abort
	140	ENDIF
	141	#ifdef NC_DOUBLE
	142	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu)
	143	#else
	144	ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu)
	145	#endif
	146	IF (ierr .NE. NF_NOERR) THEN
	147	PRINT*, "dynetat0: Lecture echouee pour <rlonu>"
	148	CALL abort
	149	ENDIF
	150
	151	ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
	152	IF (ierr .NE. NF_NOERR) THEN
	153	PRINT*, "dynetat0: Le champ <rlatu> est absent"
	154	CALL abort
	155	ENDIF
	156	#ifdef NC_DOUBLE
	157	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatu)
	158	#else
	159	ierr = NF_GET_VAR_REAL(nid, nvarid, rlatu)
	160	#endif
	161	IF (ierr .NE. NF_NOERR) THEN
	162	PRINT*, "dynetat0: Lecture echouee pour <rlatu>"
	163	CALL abort
	164	ENDIF
	165
	166	ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
	167	IF (ierr .NE. NF_NOERR) THEN
	168	PRINT*, "dynetat0: Le champ <rlonv> est absent"
	169	CALL abort
	170	ENDIF
	171	#ifdef NC_DOUBLE
	172	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonv)
	173	#else
	174	ierr = NF_GET_VAR_REAL(nid, nvarid, rlonv)
	175	#endif
	176	IF (ierr .NE. NF_NOERR) THEN
	177	PRINT*, "dynetat0: Lecture echouee pour <rlonv>"
	178	CALL abort
	179	ENDIF
	180
	181	ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
	182	IF (ierr .NE. NF_NOERR) THEN
	183	PRINT*, "dynetat0: Le champ <rlatv> est absent"
	184	CALL abort
	185	ENDIF
	186	#ifdef NC_DOUBLE
	187	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv)
	188	#else
	189	ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv)
	190	#endif
	191	IF (ierr .NE. NF_NOERR) THEN
	192	PRINT*, "dynetat0: Lecture echouee pour rlatv"
	193	CALL abort
	194	ENDIF
	195
	196	ierr = NF_INQ_VARID (nid, "cu", nvarid)
	197	IF (ierr .NE. NF_NOERR) THEN
	198	PRINT*, "dynetat0: Le champ <cu> est absent"
	199	CALL abort
	200	ENDIF
	201	#ifdef NC_DOUBLE
	202	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cu)
	203	#else
	204	ierr = NF_GET_VAR_REAL(nid, nvarid, cu)
	205	#endif
	206	IF (ierr .NE. NF_NOERR) THEN
	207	PRINT*, "dynetat0: Lecture echouee pour <cu>"
	208	CALL abort
	209	ENDIF
	210
	211	ierr = NF_INQ_VARID (nid, "cv", nvarid)
	212	IF (ierr .NE. NF_NOERR) THEN
	213	PRINT*, "dynetat0: Le champ <cv> est absent"
	214	CALL abort
	215	ENDIF
	216	#ifdef NC_DOUBLE
	217	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cv)
	218	#else
	219	ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
	220	#endif
	221	IF (ierr .NE. NF_NOERR) THEN
	222	PRINT*, "dynetat0: Lecture echouee pour <cv>"
	223	CALL abort
	224	ENDIF
	225
	226	ierr = NF_INQ_VARID (nid, "aire", nvarid)
	227	IF (ierr .NE. NF_NOERR) THEN
	228	PRINT*, "dynetat0: Le champ <aire> est absent"
	229	CALL abort
	230	ENDIF
	231	#ifdef NC_DOUBLE
	232	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire)
	233	#else
	234	ierr = NF_GET_VAR_REAL(nid, nvarid, aire)
	235	#endif
	236	IF (ierr .NE. NF_NOERR) THEN
	237	PRINT*, "dynetat0: Lecture echouee pour <aire>"
	238	CALL abort
	239	ENDIF
	240
	241	ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
	242	IF (ierr .NE. NF_NOERR) THEN
	243	PRINT*, "dynetat0: Le champ <phisinit> est absent"
	244	CALL abort
	245	ENDIF
	246	#ifdef NC_DOUBLE
	247	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis)
	248	#else
	249	ierr = NF_GET_VAR_REAL(nid, nvarid, phis)
	250	#endif
	251	IF (ierr .NE. NF_NOERR) THEN
	252	PRINT*, "dynetat0: Lecture echouee pour <phisinit>"
	253	CALL abort
	254	ENDIF
	255
	256	ierr = NF_INQ_VARID (nid, "Time", nvarid)
	257	IF (ierr .NE. NF_NOERR) THEN
	258	ierr = NF_INQ_VARID (nid, "temps", nvarid)
	259	IF (ierr .NE. NF_NOERR) THEN
	260	PRINT*, "dynetat0: <Time> or <temps> absent"
	261	CALL abort
	262	ENDIF
	263	ENDIF
	264	#ifdef NC_DOUBLE
	265	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time)
	266	#else
	267	ierr = NF_GET_VAR_REAL(nid, nvarid, time)
	268	#endif
	269	IF (ierr .NE. NF_NOERR) THEN
	270	PRINT*, "dynetat0: Lecture echouee <Time>/<temps>"
	271	CALL abort
	272	ENDIF
	273
	274	ierr = NF_INQ_VARID (nid, "ucov", nvarid)
	275	IF (ierr .NE. NF_NOERR) THEN
	276	PRINT*, "dynetat0: Le champ <ucov> est absent"
	277	CALL abort
	278	ENDIF
	279	#ifdef NC_DOUBLE
	280	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ucov)
	281	#else
	282	ierr = NF_GET_VAR_REAL(nid, nvarid, ucov)
	283	#endif
	284	IF (ierr .NE. NF_NOERR) THEN
	285	PRINT*, "dynetat0: Lecture echouee pour <ucov>"
	286	CALL abort
	287	ENDIF
	288
	289	ierr = NF_INQ_VARID (nid, "vcov", nvarid)
	290	IF (ierr .NE. NF_NOERR) THEN
	291	PRINT*, "dynetat0: Le champ <vcov> est absent"
	292	CALL abort
	293	ENDIF
	294	#ifdef NC_DOUBLE
	295	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, vcov)
	296	#else
	297	ierr = NF_GET_VAR_REAL(nid, nvarid, vcov)
	298	#endif
	299	IF (ierr .NE. NF_NOERR) THEN
	300	PRINT*, "dynetat0: Lecture echouee pour <vcov>"
	301	CALL abort
	302	ENDIF
	303
	304	ierr = NF_INQ_VARID (nid, "teta", nvarid)
	305	IF (ierr .NE. NF_NOERR) THEN
	306	PRINT*, "dynetat0: Le champ <teta> est absent"
	307	CALL abort
	308	ENDIF
	309	#ifdef NC_DOUBLE
	310	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, teta)
	311	#else
	312	ierr = NF_GET_VAR_REAL(nid, nvarid, teta)
	313	#endif
	314	IF (ierr .NE. NF_NOERR) THEN
	315	PRINT*, "dynetat0: Lecture echouee pour <teta>"
	316	CALL abort
	317	ENDIF
	318
	319
	320	IF(nq.GE.1) THEN
	321	write(,) 'dynetat0: loading tracers'
	322	IF(nq.GT.99) THEN
	323	PRINT*, "Trop de traceurs"
	324	CALL abort
	325	ENDIF
	326	nqold=nq
	327	DO iq=1,nq
	328	! str3(1:1)='q'
	329	! WRITE(str3(2:3),'(i2.2)') iq
	330	! ierr = NF_INQ_VARID (nid, str3, nvarid)
	331	! NB: tracers are now read in using their name ('tnom' from advtrac.h)
	332	! write(,) " loading tracer:",trim(tnom(iq))
	333	ierr=NF_INQ_VARID(nid,tnom(iq),nvarid)
	334	IF (ierr .NE. NF_NOERR) THEN
	335	! PRINT*, "dynetat0: Le champ <"//str3//"> est absent"
	336	PRINT*, "dynetat0: Le champ <"//trim(tnom(iq))//
	337	& "> est absent"
	338	PRINT*, " Il est donc initialise a zero"
	339	CALL initial0(ijp1llm,q(1,1,1,iq))
	340	nqold=min(iq-1,nqold)
	341	ELSE
	342	#ifdef NC_DOUBLE
	343	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q(1,1,1,iq))
	344	#else
	345	ierr = NF_GET_VAR_REAL(nid, nvarid, q(1,1,1,iq))
	346	#endif
	347	IF (ierr .NE. NF_NOERR) THEN
	348	! PRINT*, "dynetat0: Lecture echouee pour "//str3
	349	PRINT*, "dynetat0: Lecture echouee pour "//trim(tnom(iq))
	350	CALL abort
	351	ENDIF
	352	ENDIF
	353	ENDDO
	354	if ((nqold.lt.nq).and.(nqold.ge.1)) then
	355	c case when new tracer are added in addition to old ones
	356	write(,)'tracers 1 to ', nqold,'were already present'
	357	write(,)'tracers ', nqold+1,' to ', nqmx,'are new'
	358	write(,)' and initialized to zero'
	359	q(:,:,:,nqold+1:nqmx)=0.0
	360	! yes=' '
	361	! do while ((yes.ne.'y').and.(yes.ne.'n'))
	362	! write(,) 'Would you like to reindex tracer # 1 ->',nqold
	363	! write(,) 'to #',nqmx-nqold+1,'->', nqmx,' (y or n) ?'
	364	! read(*,fmt='(a)') yes
	365	! end do
	366	! if (yes.eq.'y') then
	367	! write(,) 'OK, let s reindex the tracers'
	368	! do l=1,llm
	369	! do j=1,jjp1
	370	! do i=1,iip1
	371	! do iq=nqmx,nqmx-nqold+1,-1
	372	! q(i,j,l,iq)=q(i,j,l,iq-nqmx+nqold)
	373	! end do
	374	! do iq=nqmx-nqold,1,-1
	375	! q(i,j,l,iq)= 0.
	376	! end do
	377	! end do
	378	! end do
	379	! end do
	380	! end if
	381	end if ! of if ((nqold.lt.nq).and.(nqold.ge.1))
	382	ENDIF ! of IF(nq.GE.1)
	383
	384	ierr = NF_INQ_VARID (nid, "masse", nvarid)
	385	IF (ierr .NE. NF_NOERR) THEN
	386	PRINT*, "dynetat0: Le champ <masse> est absent"
	387	CALL abort
	388	ENDIF
	389	#ifdef NC_DOUBLE
	390	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, masse)
	391	#else
	392	ierr = NF_GET_VAR_REAL(nid, nvarid, masse)
	393	#endif
	394	IF (ierr .NE. NF_NOERR) THEN
	395	PRINT*, "dynetat0: Lecture echouee pour <masse>"
	396	CALL abort
	397	ENDIF
	398
	399	ierr = NF_INQ_VARID (nid, "ps", nvarid)
	400	IF (ierr .NE. NF_NOERR) THEN
	401	PRINT*, "dynetat0: Le champ <ps> est absent"
	402	CALL abort
	403	ENDIF
	404	#ifdef NC_DOUBLE
	405	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ps)
	406	#else
	407	ierr = NF_GET_VAR_REAL(nid, nvarid, ps)
	408	#endif
	409	IF (ierr .NE. NF_NOERR) THEN
	410	PRINT*, "dynetat0: Lecture echouee pour <ps>"
	411	CALL abort
	412	ENDIF
	413
	414	ierr = NF_CLOSE(nid)
	415
	416	day_ini=day_ini+INT(time)
	417	time=time-INT(time)
	418
	419	1 FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
	420	*arrage est differente de la valeur parametree iim =',i4//)
	421	2 FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
	422	*arrage est differente de la valeur parametree jjm =',i4//)
	423	3 FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
	424	*rrage est differente de la valeur parametree llm =',i4//)
	425	4 FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
	426	*rrage est differente de la valeur dtinteg =',i4//)
	427
[253]	428
	429
	430
	431
	432
[135]	433	RETURN
	434	END

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

Download in other formats:

Original Format