Context Navigation

gcm.F @ 228

Last change on this file since 228 was 228, checked in by lmdzadmin, 24 years ago
detail dans l'initialisation 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.0 KB

Rev	Line
[2]	1
	2	PROGRAM gcm
	3
[57]	4	USE IOIPSL
	5
[2]	6	IMPLICIT NONE
	7
	8	c ...... Version du 10/01/98 ..........
	9
	10	c avec coordonnees verticales hybrides
	11	c avec nouveaux operat. dissipation * ( gradiv2,divgrad2,nxgraro2 )
	12
	13	c=======================================================================
	14	c
	15	c Auteur: P. Le Van /L. Fairhead/F.Hourdin
	16	c -------
	17	c
	18	c Objet:
	19	c ------
	20	c
	21	c GCM LMD nouvelle grille
	22	c
	23	c=======================================================================
	24
	25	c ... Dans inigeom , nouveaux calculs pour les elongations cu , cv
	26	c et possibilite d'appeler une fonction f(y) a derivee tangente
	27	c hyperbolique a la place de la fonction a derivee sinusoidale.
	28
	29	c ... Possibilite de choisir le shema de Van-leer pour l'advection de
	30	c q , en faisant iadv = 3 dans traceur (29/04/97) .
	31	c
	32	c-----------------------------------------------------------------------
	33	c Declarations:
	34	c -------------
	35
	36	#include "dimensions.h"
	37	#include "paramet.h"
	38	#include "comconst.h"
	39	#include "comdissnew.h"
	40	#include "comvert.h"
	41	#include "comgeom.h"
	42	#include "logic.h"
	43	#include "temps.h"
	44	#include "control.h"
	45	#include "ener.h"
	46	#include "netcdf.inc"
	47	#include "description.h"
	48	#include "serre.h"
	49	#include "tracstoke.h"
	50
	51
	52	INTEGER longcles
	53	PARAMETER ( longcles = 20 )
	54	REAL clesphy0( longcles )
	55	SAVE clesphy0
	56
	57	INTEGER*4 iday ! jour julien
	58	REAL time ! Heure de la journee en fraction d'1 jour
	59	REAL zdtvr
	60	INTEGER nbetatmoy, nbetatdem,nbetat
	61
	62	c variables dynamiques
	63	REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
	64	REAL teta(ip1jmp1,llm) ! temperature potentielle
	65	REAL q(ip1jmp1,llm,nqmx) ! champs advectes
	66	REAL ps(ip1jmp1) ! pression au sol
	67	REAL p (ip1jmp1,llmp1 ) ! pression aux interfac.des couches
	68	REAL pks(ip1jmp1) ! exner au sol
	69	REAL pk(ip1jmp1,llm) ! exner au milieu des couches
	70	REAL pkf(ip1jmp1,llm) ! exner filt.au milieu des couches
	71	REAL masse(ip1jmp1,llm) ! masse d'air
	72	REAL phis(ip1jmp1) ! geopotentiel au sol
	73	REAL phi(ip1jmp1,llm) ! geopotentiel
	74	REAL w(ip1jmp1,llm) ! vitesse verticale
	75
	76	c variables dynamiques intermediaire pour le transport
	77	REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm) !flux de masse
	78
	79	c variables dynamiques au pas -1
	80	REAL vcovm1(ip1jm,llm),ucovm1(ip1jmp1,llm)
	81	REAL tetam1(ip1jmp1,llm),psm1(ip1jmp1)
	82	REAL massem1(ip1jmp1,llm)
	83
	84	c tendances dynamiques
	85	REAL dv(ip1jm,llm),du(ip1jmp1,llm)
	86	REAL dteta(ip1jmp1,llm),dq(ip1jmp1,llm,nqmx),dp(ip1jmp1)
	87
	88	c tendances de la dissipation
	89	REAL dvdis(ip1jm,llm),dudis(ip1jmp1,llm)
	90	REAL dhdis(ip1jmp1,llm)
	91
	92	c tendances physiques
	93	REAL dvfi(ip1jm,llm),dufi(ip1jmp1,llm)
	94	REAL dhfi(ip1jmp1,llm),dqfi(ip1jmp1,llm,nqmx),dpfi(ip1jmp1)
	95
	96	c variables pour le fichier histoire
	97	REAL dtav ! intervalle de temps elementaire
	98
	99	REAL tppn(iim),tpps(iim),tpn,tps
	100	c
	101	INTEGER iadv(nqmx) ! indice schema de transport pour le traceur iq
	102
	103	INTEGER itau,itaufinp1,iav
	104
	105	EXTERNAL caldyn, traceur
	106	EXTERNAL dissip,geopot,iniconst,inifilr
	107	EXTERNAL integrd,SCOPY
	108	EXTERNAL iniav,writeav,writehist
	109	EXTERNAL inigeom
	110	EXTERNAL exner_hyb,addit
	111	EXTERNAL defrun_new, test_period
	112	REAL SSUM
	113	REAL time_0 , finvmaold(ip1jmp1,llm)
	114
	115	LOGICAL lafin
	116	INTEGER ij,iq,l,numvanle,iapp_tracvl
	117
	118
[57]	119	INTEGER fluxid, fluxvid,fluxdid
[2]	120	integer histid, histvid, histaveid
	121	real time_step, t_wrt, t_ops
	122
	123	REAL rdayvrai,rdaym_ini,rday_ecri
	124	LOGICAL first
	125	REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm)
	126
	127	LOGICAL offline ! Controle du stockage ds "fluxmass"
[99]	128	PARAMETER (offline=.false.)
[2]	129
	130	character*80 dynhist_file, dynhistave_file
	131	character*20 modname
	132	character*80 abort_message
	133
[57]	134	C Calendrier
	135	LOGICAL true_calendar
	136	PARAMETER (true_calendar = .false.)
	137
[2]	138	c-----------------------------------------------------------------------
	139	c Initialisations:
	140	c ----------------
	141
[99]	142	abort_message = 'last timestep reached'
[2]	143	modname = 'gcm'
	144	descript = 'Run GCM LMDZ'
	145	lafin = .FALSE.
	146	dynhist_file = 'dyn_hist.nc'
	147	dynhistave_file = 'dyn_hist_ave.nc'
[57]	148
	149	if (true_calendar) then
	150	call ioconf_calendar('gregorian')
	151	else
	152	call ioconf_calendar('360d')
	153	endif
[2]	154	c-----------------------------------------------------------------------
	155	c
	156	c .... Choix des shemas d'advection pour l'eau et les traceurs ...
	157	c ...................................................................
	158	c
	159	c iadv = 1 shema transport type "humidite specifique LMD"
	160	c iadv = 2 shema amont
	161	c iadv = 3 shema Van-leer
	162	c
	163	c dans le tableau q(ij,l,iq) , iq = 1 pour l'eau vapeur
	164	c , iq = 2 pour l'eau liquide
	165	c et eventuellement , iq = 3, nqmx pour les autres traceurs
	166	c
	167	c iadv(1): choix pour l'eau vap. et iadv(2) : choix pour l'eau liq.
	168	c
	169	DO iq = 1, nqmx
	170	iadv( iq ) = 3
	171	ENDDO
	172	c
	173	DO iq = 1, nqmx
	174	IF( iadv(iq).EQ.1 ) PRINT *,' Choix du shema humidite specifique'
	175	* ,' pour le traceur no ', iq
	176	IF( iadv(iq).EQ.2 ) PRINT *,' Choix du shema amont',' pour le'
	177	* ,' traceur no ', iq
	178	IF( iadv(iq).EQ.3 ) PRINT *,' Choix du shema Van-Leer ',' pour'
	179	* ,'le traceur no ', iq
	180	IF( iadv(iq).LE.0.OR.iadv(iq).GT.3 ) THEN
	181	PRINT *,' Erreur dans le choix de iadv . Corriger et repasser
	182	* . '
	183	STOP
	184	ENDIF
	185	ENDDO
	186	c
	187	first = .TRUE.
	188	numvanle = nqmx + 1
	189	DO iq = 1, nqmx
	190	IF( iadv(iq).EQ.3.AND.first ) THEN
	191	numvanle = iq
	192	first = .FALSE.
	193	ENDIF
	194	ENDDO
	195	c
	196	DO iq = 1, nqmx
	197	IF( iadv(iq).NE.3.AND.iq.GT.numvanle ) THEN
	198	PRINT *,' Il y a discontinuite dans le choix du shema de ',
	199	* 'Van-leer pour les traceurs . Corriger et repasser . '
	200	STOP
	201	ENDIF
	202	IF( iadv(iq).LT.1.OR.iadv(iq).GT.3 ) THEN
	203	PRINT *,' Le choix de iadv est errone pour le traceur ',
	204	* iq
	205	STOP
	206	ENDIF
	207	ENDDO
	208	c
	209
	210	CALL dynetat0("start.nc",nqmx,vcov,ucov,
	211	. teta,q,masse,ps,phis, time_0)
	212
	213
	214	c OPEN( 99,file ='run.def',status='old',form='formatted')
[228]	215	c CALL defrun_new( 99, .TRUE. , clesphy0 )
	216	CALL conf_gcm( 99, .TRUE. , clesphy0 )
[2]	217	c CLOSE(99)
	218
	219	c on recalcule eventuellement le pas de temps
	220
	221	IF(MOD(day_step,iperiod).NE.0)
	222	* STOP'Il faut choisir un nb de pas par jour multiple de iperiod'
	223
	224	IF(MOD(day_step,iphysiq).NE.0)
	225	* STOP'Il faut choisir un nb de pas par jour multiple de iphysiq'
	226
	227	zdtvr = daysec/FLOAT(day_step)
	228	IF(dtvr.NE.zdtvr) THEN
	229	PRINT*,'WARNING!!! changement de pas de temps',dtvr,'>',zdtvr
	230	ENDIF
	231
	232	c nombre d'etats dans les fichiers demarrage et histoire
	233	nbetatdem = nday / iecri
	234	nbetatmoy = nday / periodav + 1
	235
	236	dtvr = zdtvr
	237	CALL iniconst
	238	CALL inigeom
	239
	240	CALL inifilr
	241	c
	242	c ...... P.Le Van ( modif le 29/04/97 ) .........
	243	c
	244	CALL inidissip( lstardis, nitergdiv, nitergrot, niterh ,
	245	* tetagdiv, tetagrot , tetatemp )
	246	c
	247
	248	CALL pression ( ip1jmp1, ap, bp, ps, p )
	249	CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
	250	c
	251
	252	c numero de stockage pour les fichiers de redemarrage:
	253
	254	c-----------------------------------------------------------------------
	255	c temps de depart et de fin:
	256	c --------------------------
	257
	258	itau = 0
	259	iday = day_ini+itau/day_step
	260	time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
	261	IF(time.GT.1.) THEN
	262	time = time-1.
	263	iday = iday+1
	264	ENDIF
	265	itaufin = nday*day_step
	266	itaufinp1 = itaufin +1
	267
	268	day_end = day_ini + nday
	269	PRINT 300, itau,itaufin,day_ini,day_end
	270
	271	CALL dynredem0("restart.nc",day_end,anne_ini,phis,nqmx)
	272
	273	ecripar = .TRUE.
	274
	275	time_step = zdtvr
	276	t_ops = iecri * daysec
	277	t_wrt = iecri * daysec
	278	CALL inithist(dynhist_file,day_ini,anne_ini,time_step,
	279	. t_ops, t_wrt, nqmx, histid, histvid)
	280
	281	t_ops = iperiod * time_step
	282	t_wrt = periodav * daysec
	283	CALL initdynav(dynhistave_file,day_ini,anne_ini,time_step,
	284	. t_ops, t_wrt, nqmx, histaveid)
	285
	286	dtav = iperiod*dtvr/daysec
	287
	288
	289	c Quelques initialisations pour les traceurs
	290	call initial0(ijp1llm*nqmx,dq)
	291	istdyn=day_step/4 ! stockage toutes les 6h=1jour/4
	292	istphy=istdyn/iphysiq
	293
	294	c-----------------------------------------------------------------------
	295	c Debut de l'integration temporelle:
	296	c ----------------------------------
	297
	298	1 CONTINUE
	299	c call nudge(itau,ucov,vcov,teta,masse,ps)
	300	c
	301	c IF( MOD( itau, 10* day_step ).EQ.0 ) THEN
	302	CALL test_period ( ucov,vcov,teta,q,p,phis )
	303	PRINT *,' ---- Test_period apres continue OK ! -----', itau
	304	c ENDIF
	305	c
	306	CALL SCOPY( ijmllm ,vcov , 1, vcovm1 , 1 )
	307	CALL SCOPY( ijp1llm,ucov , 1, ucovm1 , 1 )
	308	CALL SCOPY( ijp1llm,teta , 1, tetam1 , 1 )
	309	CALL SCOPY( ijp1llm,masse, 1, massem1, 1 )
	310	CALL SCOPY( ip1jmp1, ps , 1, psm1 , 1 )
	311
	312	forward = .TRUE.
	313	leapf = .FALSE.
	314	dt = dtvr
	315
	316	c ... P.Le Van .26/04/94 ....
	317
	318	CALL SCOPY ( ijp1llm, masse, 1, finvmaold, 1 )
	319	CALL filtreg ( finvmaold ,jjp1, llm, -2,2, .TRUE., 1 )
	320
	321
	322	2 CONTINUE
	323
	324	c-----------------------------------------------------------------------
	325
	326	c date:
	327	c -----
	328
	329
	330	c gestion des appels de la physique et des dissipations:
	331	c ------------------------------------------------------
	332	c
	333	c ... P.Le Van ( 6/02/95 ) ....
	334
	335	apphys = .FALSE.
	336	statcl = .FALSE.
	337	conser = .FALSE.
	338	apdiss = .FALSE.
	339
	340	IF( purmats ) THEN
	341	IF( MOD(itau,iconser) .EQ.0.AND. forward ) conser = .TRUE.
	342	IF( MOD(itau,idissip ).EQ.0.AND..NOT.forward ) apdiss = .TRUE.
	343	IF( MOD(itau,iphysiq ).EQ.0.AND..NOT.forward
	344	$ .AND. physic ) apphys = .TRUE.
	345	ELSE
	346	IF( MOD(itau ,iconser) .EQ. 0 ) conser = .TRUE.
	347	IF( MOD(itau+1,idissip) .EQ. 0 ) apdiss = .TRUE.
	348	IF( MOD(itau+1,iphysiq).EQ.0. AND. physic ) apphys = .TRUE.
	349	END IF
	350
	351	c-----------------------------------------------------------------------
	352	c calcul des tendances dynamiques:
	353	c --------------------------------
	354
	355	CALL geopot ( ip1jmp1, teta , pk , pks, phis , phi )
	356	c
	357	c
	358	CALL caldyn
	359	$ ( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
	360	$ phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, time+iday-day_ini )
	361
	362	c-----------------------------------------------------------------------
	363	c calcul des tendances advection des traceurs (dont l'humidite)
	364	c -------------------------------------------------------------
	365
	366	IF( forward. OR . leapf ) THEN
	367	c
	368	DO 15 iq = 1, nqmx
	369	c
	370	IF( iadv(iq).EQ.1.OR.iadv(iq).EQ.2 ) THEN
	371	CALL traceur( iq,iadv,q,teta,pk,w, pbaru, pbarv, dq )
	372
	373	ELSE IF( iq.EQ. nqmx ) THEN
	374	c
	375	iapp_tracvl = 5
	376	c
	377	cccc iapp_tracvl est la frequence en pas du groupement des flux
	378	cccc de masse pour Van-Leer dans la routine tracvl .
	379	c
	380	CALL vanleer(numvanle,iapp_tracvl,nqmx,q,pbaru,pbarv,
	381	* p, masse, dq )
	382	c
	383	ENDIF
	384	c
	385	15 CONTINUE
	386	C
	387	IF (offline) THEN
	388	Cmaf stokage du flux de masse pour traceurs OFF-LINE
[57]	389
	390	CALL fluxstokenc(pbaru,pbarv,masse,teta,phi,phis,
	391	. time_step, itau,fluxid, fluxvid,fluxdid )
	392
[2]	393	ENDIF
	394	c
	395	ENDIF
	396
	397
	398	c-----------------------------------------------------------------------
	399	c integrations dynamique et traceurs:
	400	c ----------------------------------
	401
	402
	403	CALL integrd ( iadv, 2,vcovm1,ucovm1,tetam1,psm1,massem1 ,
	404	$ dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis ,
	405	$ finvmaold )
	406
	407	c .P.Le Van (26/04/94 ajout de finvpold dans l'appel d'integrd)
	408	c
	409	c-----------------------------------------------------------------------
	410	c calcul des tendances physiques:
	411	c -------------------------------
	412	c ######## P.Le Van ( Modif le 6/02/95 ) ###########
	413	c
	414	IF( purmats ) THEN
	415	IF( itau.EQ.itaufin.AND..NOT.forward ) lafin = .TRUE.
	416	ELSE
	417	IF( itau+1. EQ. itaufin ) lafin = .TRUE.
	418	ENDIF
	419	c
	420	c
	421	IF( apphys ) THEN
	422	c
	423	c ....... Ajout P.Le Van ( 17/04/96 ) ...........
	424	c
	425
	426	CALL pression ( ip1jmp1, ap, bp, ps, p )
	427	CALL exner_hyb( ip1jmp1, ps, p,alpha,beta,pks, pk, pkf )
	428
	429	rdaym_ini = itau * dtvr / daysec
	430	rdayvrai = rdaym_ini + day_ini
	431
	432	IF ( ecritphy.LT.1. ) THEN
	433	rday_ecri = rdaym_ini
	434	ELSE
	435	rday_ecri = NINT( rdayvrai )
	436	ENDIF
	437	c
[99]	438
	439	c rajout debug
[113]	440	c lafin = .true.
[99]	441
[2]	442	CALL calfis( nqmx, lafin ,rdayvrai,rday_ecri,time ,
	443	$ ucov,vcov,teta,q,masse,ps,p,pk,phis,phi ,
	444	$ du,dv,dteta,dq,w,clesphy0, dufi,dvfi,dhfi,dqfi,dpfi )
	445
	446	c ajout des tendances physiques:
	447	c ------------------------------
	448	CALL addfi( nqmx, dtphys, leapf, forward ,
	449	$ ucov, vcov, teta , q ,ps ,
	450	$ dufi, dvfi, dhfi , dqfi ,dpfi )
	451	c
	452	ENDIF
	453
	454	CALL pression ( ip1jmp1, ap, bp, ps, p )
	455	CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
	456
	457	c-----------------------------------------------------------------------
	458	c
	459	c
	460	c dissipation horizontale et verticale des petites echelles:
	461	c ----------------------------------------------------------
	462
	463	IF(apdiss) THEN
	464
	465	CALL dissip(vcov,ucov,teta,p,dvdis,dudis,dhdis)
	466
	467	CALL addit( ijp1llm,ucov ,dudis,ucov )
	468	CALL addit( ijmllm ,vcov ,dvdis,vcov )
	469	CALL addit( ijp1llm,teta ,dhdis,teta )
	470
	471
	472	c ....... P. Le Van ( ajout le 17/04/96 ) ...........
	473	c ... Calcul de la valeur moyenne, unique de h aux poles .....
	474	c
	475
	476	DO l = 1, llm
	477	DO ij = 1,iim
	478	tppn(ij) = aire( ij ) * teta( ij ,l)
	479	tpps(ij) = aire(ij+ip1jm) * teta(ij+ip1jm,l)
	480	ENDDO
	481	tpn = SSUM(iim,tppn,1)/apoln
	482	tps = SSUM(iim,tpps,1)/apols
	483
	484	DO ij = 1, iip1
	485	teta( ij ,l) = tpn
	486	teta(ij+ip1jm,l) = tps
	487	ENDDO
	488	ENDDO
	489
[49]	490	DO ij = 1,iim
	491	tppn(ij) = aire( ij ) * ps ( ij )
	492	tpps(ij) = aire(ij+ip1jm) * ps (ij+ip1jm)
	493	ENDDO
	494	tpn = SSUM(iim,tppn,1)/apoln
	495	tps = SSUM(iim,tpps,1)/apols
[2]	496
[49]	497	DO ij = 1, iip1
	498	ps( ij ) = tpn
	499	ps(ij+ip1jm) = tps
	500	ENDDO
	501
	502
[2]	503	END IF
[99]	504
	505	c ajout debug
[113]	506	c IF( lafin ) then
	507	c abort_message = 'Simulation finished'
	508	c call abort_gcm(modname,abort_message,0)
	509	c ENDIF
[2]	510
	511	c ********************************************************************
	512	c ********************************************************************
	513	c .... fin de l'integration dynamique et physique pour le pas itau ..
	514	c ********************************************************************
	515	c ********************************************************************
	516
	517	c preparation du pas d'integration suivant ......
	518
	519	IF ( .NOT.purmats ) THEN
	520	c ........................................................
	521	c .............. schema matsuno + leapfrog ..............
	522	c ........................................................
	523
	524	IF(forward. OR. leapf) THEN
	525	itau= itau + 1
	526	iday= day_ini+itau/day_step
	527	time= FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
	528	IF(time.GT.1.) THEN
	529	time = time-1.
	530	iday = iday+1
	531	ENDIF
	532	ENDIF
	533
	534
	535	IF( itau. EQ. itaufinp1 ) then
	536	abort_message = 'Simulation finished'
	537	call abort_gcm(modname,abort_message,0)
	538	ENDIF
	539	c-----------------------------------------------------------------------
	540	c ecriture du fichier histoire moyenne:
	541	c -------------------------------------
	542
	543	IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
	544	IF(itau.EQ.itaufin) THEN
	545	iav=1
	546	ELSE
	547	iav=0
	548	ENDIF
	549	CALL writedynav(histaveid, nqmx, itau,vcov ,
	550	, ucov,teta,pk,phi,q,masse,ps,phis)
	551	ENDIF
	552
	553	c-----------------------------------------------------------------------
	554	c ecriture de la bande histoire:
	555	c ------------------------------
	556
	557	IF( MOD(itau,iecri*day_step).EQ.0) THEN
	558
	559	nbetat = nbetatdem
	560	CALL geopot ( ip1jmp1, teta , pk , pks, phis , phi )
	561	CALL writehist( histid, histvid, nqmx, itau,vcov ,
	562	, ucov,teta,phi,q,masse,ps,phis)
	563
	564
	565	ENDIF
	566
	567	IF(itau.EQ.itaufin) THEN
	568
	569
	570	PRINT *,' Appel test_period avant redem ', itau
	571	CALL test_period ( ucov,vcov,teta,q,p,phis )
	572	CALL dynredem1("restart.nc",0.0,
	573	. vcov,ucov,teta,q,nqmx,masse,ps)
	574
	575	CLOSE(99)
	576	ENDIF
	577
	578	c-----------------------------------------------------------------------
	579	c gestion de l'integration temporelle:
	580	c ------------------------------------
	581
	582	IF( MOD(itau,iperiod).EQ.0 ) THEN
	583	GO TO 1
	584	ELSE IF ( MOD(itau-1,iperiod). EQ. 0 ) THEN
	585
	586	IF( forward ) THEN
	587	c fin du pas forward et debut du pas backward
	588
	589	forward = .FALSE.
	590	leapf = .FALSE.
	591	GO TO 2
	592
	593	ELSE
	594	c fin du pas backward et debut du premier pas leapfrog
	595
	596	leapf = .TRUE.
	597	dt = 2.*dtvr
	598	GO TO 2
	599	END IF
	600	ELSE
	601
	602	c ...... pas leapfrog .....
	603
	604	leapf = .TRUE.
	605	dt = 2.*dtvr
	606	GO TO 2
	607	END IF
	608
	609	ELSE
	610
	611	c ........................................................
	612	c .............. schema matsuno ...............
	613	c ........................................................
	614	IF( forward ) THEN
	615
	616	itau = itau + 1
	617	iday = day_ini+itau/day_step
	618	time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
	619
	620	IF(time.GT.1.) THEN
	621	time = time-1.
	622	iday = iday+1
	623	ENDIF
	624
	625	forward = .FALSE.
	626	IF( itau. EQ. itaufinp1 ) then
	627	abort_message = 'Simulation finished'
	628	call abort_gcm(modname,abort_message,0)
	629	ENDIF
	630	GO TO 2
	631
	632	ELSE
	633
	634	IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
	635	IF(itau.EQ.itaufin) THEN
	636	iav=1
	637	ELSE
	638	iav=0
	639	ENDIF
	640	CALL writedynav(histaveid, nqmx, itau,vcov ,
	641	, ucov,teta,pk,phi,q,masse,ps,phis)
	642
	643	ENDIF
	644
	645	IF(MOD(itau,iecri*day_step).EQ.0) THEN
	646	nbetat = nbetatdem
	647	CALL geopot ( ip1jmp1, teta , pk , pks, phis , phi )
	648	CALL writehist( histid, histvid, nqmx, itau,vcov ,
	649	, ucov,teta,phi,q,masse,ps,phis)
	650	ENDIF
	651
	652	IF(itau.EQ.itaufin)
	653	. CALL dynredem1("restart.nc",0.0,
	654	. vcov,ucov,teta,q,nqmx,masse,ps)
	655
	656	forward = .TRUE.
	657	GO TO 1
	658
	659	ENDIF
	660
	661	END IF
	662
	663	300 FORMAT('1'/,15x,'run du pas',i7,2x,'au pas',i7,2x,
	664	. 'c''est a dire du jour',i7,3x,'au jour',i7//)
	665
	666	STOP
	667	END

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

Download in other formats:

Original Format