Context Navigation

defrun.F @ 1844

Last change on this file since 1844 was 1502, checked in by jghattas, 14 years ago

Modifications for variable idissip :

Changed name of variable idissip to dissip_period everywhere to be compatible with old .def files.
This variable was before read from physiq.def but the value was overwritten by a calculation in inidissip. Now, if dissip_period=0 calculation is done as before(default). Else the value from physiq.def is used directly.
leapfrog : added "AND NOT forward" at line 284 (dyn3d) and line 363(dyn3dpar) necessare if dissip_period not a multiple by iperiod.
iniconst : removed calculation of dtdiss (calculation done in inidissip)

FC, JG

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 14.2 KB

Rev	Line
[630]	1	!
[1403]	2	! $Id: defrun.F 1502 2011-03-21 16:07:54Z ymeurdesoif $
[630]	3	!
	4	c
	5	c
	6	SUBROUTINE defrun( tapedef, etatinit, clesphy0 )
	7	c
[1403]	8	USE control_mod
[630]	9	IMPLICIT NONE
	10	c-----------------------------------------------------------------------
	11	c Auteurs : L. Fairhead , P. Le Van .
	12	c
	13	c Arguments :
	14	c
	15	c tapedef :
	16	c etatinit : = TRUE , on ne compare pas les valeurs des para-
	17	c -metres du zoom avec celles lues sur le fichier start .
	18	c clesphy0 : sortie .
	19	c
	20	LOGICAL etatinit
	21	INTEGER tapedef
	22
	23	INTEGER longcles
	24	PARAMETER( longcles = 20 )
	25	REAL clesphy0( longcles )
	26	c
	27	c Declarations :
	28	c --------------
	29	#include "dimensions.h"
	30	#include "paramet.h"
	31	#include "logic.h"
	32	#include "serre.h"
	33	#include "comdissnew.h"
	34	#include "clesph0.h"
	35	c
	36	c
	37	c local:
	38	c ------
	39
	40	CHARACTER ch172,ch272,ch372,ch412
	41	INTEGER tapeout
	42	REAL clonn,clatt,grossismxx,grossismyy
	43	REAL dzoomxx,dzoomyy,tauxx,tauyy
	44	LOGICAL fxyhypbb, ysinuss
	45	INTEGER i
	46
	47	c
	48	c -------------------------------------------------------------------
	49	c
	50	c ......... Version du 29/04/97 ..........
	51	c
	52	c Nouveaux parametres nitergdiv,nitergrot,niterh,tetagdiv,tetagrot,
	53	c tetatemp ajoutes pour la dissipation .
	54	c
	55	c Autre parametre ajoute en fin de liste de tapedef : fxyhypb
	56	c
	57	c Si fxyhypb = .TRUE. , choix de la fonction a derivee tangente hyperb.
	58	c Sinon , choix de fxynew , a derivee sinusoidale ..
	59	c
	60	c ...... etatinit = . TRUE. si defrun est appele dans ETAT0_LMD ou
	61	c LIMIT_LMD pour l'initialisation de start.dat (dic) et
	62	c de limit.dat ( dic) ...........
	63	c Sinon etatinit = . FALSE .
	64	c
	65	c Donc etatinit = .F. si on veut comparer les valeurs de grossismx ,
	66	c grossismy,clon,clat, fxyhypb lues sur le fichier start avec
	67	c celles passees par run.def , au debut du gcm, apres l'appel a
	68	c lectba .
	69	c Ces parmetres definissant entre autres la grille et doivent etre
	70	c pareils et coherents , sinon il y aura divergence du gcm .
	71	c
	72	c-----------------------------------------------------------------------
	73	c initialisations:
	74	c ----------------
	75
	76	tapeout = 6
	77
	78	c-----------------------------------------------------------------------
	79	c Parametres de controle du run:
	80	c-----------------------------------------------------------------------
	81
	82	OPEN( tapedef,file ='gcm.def',status='old',form='formatted')
	83
	84
	85	READ (tapedef,9000) ch1,ch2,ch3
	86	WRITE(tapeout,9000) ch1,ch2,ch3
	87
	88	READ (tapedef,9001) ch1,ch4
	89	READ (tapedef,*) dayref
	90	WRITE(tapeout,9001) ch1,'dayref'
	91	WRITE(tapeout,*) dayref
	92
	93	READ (tapedef,9001) ch1,ch4
	94	READ (tapedef,*) anneeref
	95	WRITE(tapeout,9001) ch1,'anneeref'
	96	WRITE(tapeout,*) anneeref
	97
	98	READ (tapedef,9001) ch1,ch4
	99	READ (tapedef,*) nday
	100	WRITE(tapeout,9001) ch1,'nday'
	101	WRITE(tapeout,*) nday
	102
	103	READ (tapedef,9001) ch1,ch4
	104	READ (tapedef,*) day_step
	105	WRITE(tapeout,9001) ch1,'day_step'
	106	WRITE(tapeout,*) day_step
	107
	108	READ (tapedef,9001) ch1,ch4
	109	READ (tapedef,*) iperiod
	110	WRITE(tapeout,9001) ch1,'iperiod'
	111	WRITE(tapeout,*) iperiod
	112
	113	READ (tapedef,9001) ch1,ch4
	114	READ (tapedef,*) iapp_tracvl
	115	WRITE(tapeout,9001) ch1,'iapp_tracvl'
	116	WRITE(tapeout,*) iapp_tracvl
	117
	118	READ (tapedef,9001) ch1,ch4
	119	READ (tapedef,*) iconser
	120	WRITE(tapeout,9001) ch1,'iconser'
	121	WRITE(tapeout,*) iconser
	122
	123	READ (tapedef,9001) ch1,ch4
	124	READ (tapedef,*) iecri
	125	WRITE(tapeout,9001) ch1,'iecri'
	126	WRITE(tapeout,*) iecri
	127
	128	READ (tapedef,9001) ch1,ch4
	129	READ (tapedef,*) periodav
	130	WRITE(tapeout,9001) ch1,'periodav'
	131	WRITE(tapeout,*) periodav
	132
	133	READ (tapedef,9001) ch1,ch4
[1502]	134	READ (tapedef,*) dissip_period
	135	WRITE(tapeout,9001) ch1,'dissip_period'
	136	WRITE(tapeout,*) dissip_period
[630]	137
	138	ccc .... P. Le Van , modif le 29/04/97 .pour la dissipation ...
	139	ccc
	140	READ (tapedef,9001) ch1,ch4
	141	READ (tapedef,*) lstardis
	142	WRITE(tapeout,9001) ch1,'lstardis'
	143	WRITE(tapeout,*) lstardis
	144
	145	READ (tapedef,9001) ch1,ch4
	146	READ (tapedef,*) nitergdiv
	147	WRITE(tapeout,9001) ch1,'nitergdiv'
	148	WRITE(tapeout,*) nitergdiv
	149
	150	READ (tapedef,9001) ch1,ch4
	151	READ (tapedef,*) nitergrot
	152	WRITE(tapeout,9001) ch1,'nitergrot'
	153	WRITE(tapeout,*) nitergrot
	154
	155	READ (tapedef,9001) ch1,ch4
	156	READ (tapedef,*) niterh
	157	WRITE(tapeout,9001) ch1,'niterh'
	158	WRITE(tapeout,*) niterh
	159
	160	READ (tapedef,9001) ch1,ch4
	161	READ (tapedef,*) tetagdiv
	162	WRITE(tapeout,9001) ch1,'tetagdiv'
	163	WRITE(tapeout,*) tetagdiv
	164
	165	READ (tapedef,9001) ch1,ch4
	166	READ (tapedef,*) tetagrot
	167	WRITE(tapeout,9001) ch1,'tetagrot'
	168	WRITE(tapeout,*) tetagrot
	169
	170	READ (tapedef,9001) ch1,ch4
	171	READ (tapedef,*) tetatemp
	172	WRITE(tapeout,9001) ch1,'tetatemp'
	173	WRITE(tapeout,*) tetatemp
	174
	175	READ (tapedef,9001) ch1,ch4
	176	READ (tapedef,*) coefdis
	177	WRITE(tapeout,9001) ch1,'coefdis'
	178	WRITE(tapeout,*) coefdis
	179	c
	180	READ (tapedef,9001) ch1,ch4
	181	READ (tapedef,*) purmats
	182	WRITE(tapeout,9001) ch1,'purmats'
	183	WRITE(tapeout,*) purmats
	184
	185	c ...............................................................
	186
	187	READ (tapedef,9001) ch1,ch4
	188	READ (tapedef,*) iflag_phys
	189	WRITE(tapeout,9001) ch1,'iflag_phys'
	190	WRITE(tapeout,*) iflag_phys
	191
	192	READ (tapedef,9001) ch1,ch4
	193	READ (tapedef,*) iphysiq
	194	WRITE(tapeout,9001) ch1,'iphysiq'
	195	WRITE(tapeout,*) iphysiq
	196
	197
	198	ccc .... P.Le Van, ajout le 03/01/96 pour l'ecriture phys ...
	199	c
	200	READ (tapedef,9001) ch1,ch4
	201	READ (tapedef,*) cycle_diurne
	202	WRITE(tapeout,9001) ch1,'cycle_diurne'
	203	WRITE(tapeout,*) cycle_diurne
	204
	205	READ (tapedef,9001) ch1,ch4
	206	READ (tapedef,*) soil_model
	207	WRITE(tapeout,9001) ch1,'soil_model'
	208	WRITE(tapeout,*) soil_model
	209
	210	READ (tapedef,9001) ch1,ch4
	211	READ (tapedef,*) new_oliq
	212	WRITE(tapeout,9001) ch1,'new_oliq'
	213	WRITE(tapeout,*) new_oliq
	214
	215	READ (tapedef,9001) ch1,ch4
	216	READ (tapedef,*) ok_orodr
	217	WRITE(tapeout,9001) ch1,'ok_orodr'
	218	WRITE(tapeout,*) ok_orodr
	219
	220	READ (tapedef,9001) ch1,ch4
	221	READ (tapedef,*) ok_orolf
	222	WRITE(tapeout,9001) ch1,'ok_orolf'
	223	WRITE(tapeout,*) ok_orolf
	224
	225	READ (tapedef,9001) ch1,ch4
	226	READ (tapedef,*) ok_limitvrai
	227	WRITE(tapeout,9001) ch1,'ok_limitvrai'
	228	WRITE(tapeout,*) ok_limitvrai
	229
	230	READ (tapedef,9001) ch1,ch4
	231	READ (tapedef,*) nbapp_rad
	232	WRITE(tapeout,9001) ch1,'nbapp_rad'
	233	WRITE(tapeout,*) nbapp_rad
	234
	235	READ (tapedef,9001) ch1,ch4
	236	READ (tapedef,*) iflag_con
	237	WRITE(tapeout,9001) ch1,'iflag_con'
	238	WRITE(tapeout,*) iflag_con
	239
	240	DO i = 1, longcles
	241	clesphy0(i) = 0.
	242	ENDDO
[1403]	243	clesphy0(1) = REAL( iflag_con )
	244	clesphy0(2) = REAL( nbapp_rad )
[630]	245
	246	IF( cycle_diurne ) clesphy0(3) = 1.
	247	IF( soil_model ) clesphy0(4) = 1.
	248	IF( new_oliq ) clesphy0(5) = 1.
	249	IF( ok_orodr ) clesphy0(6) = 1.
	250	IF( ok_orolf ) clesphy0(7) = 1.
	251	IF( ok_limitvrai ) clesphy0(8) = 1.
	252
	253
	254	ccc .... P. Le Van , ajout le 7/03/95 .pour le zoom ...
	255	c ......... ( modif le 17/04/96 ) .........
	256	c
	257	IF( etatinit ) GO TO 100
	258
	259	READ (tapedef,9001) ch1,ch4
	260	READ (tapedef,*) clonn
	261	WRITE(tapeout,9001) ch1,'clon'
	262	WRITE(tapeout,*) clonn
	263	IF( ABS(clon - clonn).GE. 0.001 ) THEN
	264	WRITE(tapeout,*) ' La valeur de clon passee par run.def est diffe
	265	*rente de celle lue sur le fichier start '
	266	STOP
	267	ENDIF
	268	c
	269	READ (tapedef,9001) ch1,ch4
	270	READ (tapedef,*) clatt
	271	WRITE(tapeout,9001) ch1,'clat'
	272	WRITE(tapeout,*) clatt
	273
	274	IF( ABS(clat - clatt).GE. 0.001 ) THEN
	275	WRITE(tapeout,*) ' La valeur de clat passee par run.def est diffe
	276	*rente de celle lue sur le fichier start '
	277	STOP
	278	ENDIF
	279
	280	READ (tapedef,9001) ch1,ch4
	281	READ (tapedef,*) grossismxx
	282	WRITE(tapeout,9001) ch1,'grossismx'
	283	WRITE(tapeout,*) grossismxx
	284
	285	IF( ABS(grossismx - grossismxx).GE. 0.001 ) THEN
	286	WRITE(tapeout,*) ' La valeur de grossismx passee par run.def est
	287	, differente de celle lue sur le fichier start '
	288	STOP
	289	ENDIF
	290
	291	READ (tapedef,9001) ch1,ch4
	292	READ (tapedef,*) grossismyy
	293	WRITE(tapeout,9001) ch1,'grossismy'
	294	WRITE(tapeout,*) grossismyy
	295
	296	IF( ABS(grossismy - grossismyy).GE. 0.001 ) THEN
	297	WRITE(tapeout,*) ' La valeur de grossismy passee par run.def est
	298	, differente de celle lue sur le fichier start '
	299	STOP
	300	ENDIF
	301
	302	IF( grossismx.LT.1. ) THEN
	303	WRITE(tapeout,) ' ATTENTION !! grossismx < 1 . * '
	304	STOP
	305	ELSE
	306	alphax = 1. - 1./ grossismx
	307	ENDIF
	308
	309
	310	IF( grossismy.LT.1. ) THEN
	311	WRITE(tapeout,) ' ATTENTION !! grossismy < 1 . * '
	312	STOP
	313	ELSE
	314	alphay = 1. - 1./ grossismy
	315	ENDIF
	316
	317	c
	318	c alphax et alphay sont les anciennes formulat. des grossissements
	319	c
	320	c
	321	READ (tapedef,9001) ch1,ch4
	322	READ (tapedef,*) fxyhypbb
	323	WRITE(tapeout,9001) ch1,'fxyhypbb'
	324	WRITE(tapeout,*) fxyhypbb
	325
	326	IF( .NOT.fxyhypb ) THEN
	327	IF( fxyhypbb ) THEN
	328	WRITE(tapeout,) ' ***** PBS DANS DEFRUN ****** '
	329	WRITE(tapeout,)' ** fxyhypb lu sur le fichier start est F'
	330	, ' alors qu il est T sur run.def **'
	331	STOP
	332	ENDIF
	333	ELSE
	334	IF( .NOT.fxyhypbb ) THEN
	335	WRITE(tapeout,) ' ***** PBS DANS DEFRUN ****** '
	336	WRITE(tapeout,)' ** fxyhypb lu sur le fichier start est t'
	337	, ' alors qu il est F sur run.def **'
	338	STOP
	339	ENDIF
	340	ENDIF
	341	c
	342	READ (tapedef,9001) ch1,ch4
	343	READ (tapedef,*) dzoomxx
	344	WRITE(tapeout,9001) ch1,'dzoomx'
	345	WRITE(tapeout,*) dzoomxx
	346
	347	READ (tapedef,9001) ch1,ch4
	348	READ (tapedef,*) dzoomyy
	349	WRITE(tapeout,9001) ch1,'dzoomy'
	350	WRITE(tapeout,*) dzoomyy
	351
	352	READ (tapedef,9001) ch1,ch4
	353	READ (tapedef,*) tauxx
	354	WRITE(tapeout,9001) ch1,'taux'
	355	WRITE(tapeout,*) tauxx
	356
	357	READ (tapedef,9001) ch1,ch4
	358	READ (tapedef,*) tauyy
	359	WRITE(tapeout,9001) ch1,'tauy'
	360	WRITE(tapeout,*) tauyy
	361
	362	IF( fxyhypb ) THEN
	363
	364	IF( ABS(dzoomx - dzoomxx).GE. 0.001 ) THEN
	365	WRITE(tapeout,*)' La valeur de dzoomx passee par run.def est dif
	366	*ferente de celle lue sur le fichier start '
	367	CALL ABORT
	368	ENDIF
	369
	370	IF( ABS(dzoomy - dzoomyy).GE. 0.001 ) THEN
	371	WRITE(tapeout,*)' La valeur de dzoomy passee par run.def est dif
	372	*ferente de celle lue sur le fichier start '
	373	CALL ABORT
	374	ENDIF
	375
	376	IF( ABS(taux - tauxx).GE. 0.001 ) THEN
	377	WRITE(6,*)' La valeur de taux passee par run.def est differente
	378	* de celle lue sur le fichier start '
	379	CALL ABORT
	380	ENDIF
	381
	382	IF( ABS(tauy - tauyy).GE. 0.001 ) THEN
	383	WRITE(6,*)' La valeur de tauy passee par run.def est differente
	384	* de celle lue sur le fichier start '
	385	CALL ABORT
	386	ENDIF
	387
	388	ENDIF
	389
	390	cc
	391	IF( .NOT.fxyhypb ) THEN
	392	READ (tapedef,9001) ch1,ch4
	393	READ (tapedef,*) ysinuss
	394	WRITE(tapeout,9001) ch1,'ysinus'
	395	WRITE(tapeout,*) ysinuss
	396
	397
	398	IF( .NOT.ysinus ) THEN
	399	IF( ysinuss ) THEN
	400	WRITE(6,) ' ***** PBS DANS DEFRUN ****** '
	401	WRITE(tapeout,)'* ysinus lu sur le fichier start est F',
	402	* ' alors qu il est T sur run.def ***'
	403	STOP
	404	ENDIF
	405	ELSE
	406	IF( .NOT.ysinuss ) THEN
	407	WRITE(6,) ' ***** PBS DANS DEFRUN ****** '
	408	WRITE(tapeout,)'* ysinus lu sur le fichier start est T',
	409	* ' alors qu il est F sur run.def ***'
	410	STOP
	411	ENDIF
	412	ENDIF
	413	ENDIF
	414	c
	415	WRITE(6,*) ' alphax alphay defrun ',alphax,alphay
	416
	417	CLOSE(tapedef)
	418
	419	RETURN
	420	c ...............................................
	421	c
	422	100 CONTINUE
	423	c
	424	READ (tapedef,9001) ch1,ch4
	425	READ (tapedef,*) clon
	426	WRITE(tapeout,9001) ch1,'clon'
	427	WRITE(tapeout,*) clon
	428	c
	429	READ (tapedef,9001) ch1,ch4
	430	READ (tapedef,*) clat
	431	WRITE(tapeout,9001) ch1,'clat'
	432	WRITE(tapeout,*) clat
	433
	434	READ (tapedef,9001) ch1,ch4
	435	READ (tapedef,*) grossismx
	436	WRITE(tapeout,9001) ch1,'grossismx'
	437	WRITE(tapeout,*) grossismx
	438
	439	READ (tapedef,9001) ch1,ch4
	440	READ (tapedef,*) grossismy
	441	WRITE(tapeout,9001) ch1,'grossismy'
	442	WRITE(tapeout,*) grossismy
	443
	444	IF( grossismx.LT.1. ) THEN
	445	WRITE(tapeout,) ' ATTENTION !! grossismx < 1 . * '
	446	STOP
	447	ELSE
	448	alphax = 1. - 1./ grossismx
	449	ENDIF
	450
	451	IF( grossismy.LT.1. ) THEN
	452	WRITE(tapeout,) ' ATTENTION !! grossismy < 1 . * '
	453	STOP
	454	ELSE
	455	alphay = 1. - 1./ grossismy
	456	ENDIF
	457
	458	c
	459	READ (tapedef,9001) ch1,ch4
	460	READ (tapedef,*) fxyhypb
	461	WRITE(tapeout,9001) ch1,'fxyhypb'
	462	WRITE(tapeout,*) fxyhypb
	463
	464	READ (tapedef,9001) ch1,ch4
	465	READ (tapedef,*) dzoomx
	466	WRITE(tapeout,9001) ch1,'dzoomx'
	467	WRITE(tapeout,*) dzoomx
	468
	469	READ (tapedef,9001) ch1,ch4
	470	READ (tapedef,*) dzoomy
	471	WRITE(tapeout,9001) ch1,'dzoomy'
	472	WRITE(tapeout,*) dzoomy
	473
	474	READ (tapedef,9001) ch1,ch4
	475	READ (tapedef,*) taux
	476	WRITE(tapeout,9001) ch1,'taux'
	477	WRITE(tapeout,*) taux
	478	c
	479	READ (tapedef,9001) ch1,ch4
	480	READ (tapedef,*) tauy
	481	WRITE(tapeout,9001) ch1,'tauy'
	482	WRITE(tapeout,*) tauy
	483
	484	READ (tapedef,9001) ch1,ch4
	485	READ (tapedef,*) ysinus
	486	WRITE(tapeout,9001) ch1,'ysinus'
	487	WRITE(tapeout,*) ysinus
	488
	489	WRITE(tapeout,*) ' alphax alphay defrun ',alphax,alphay
	490	c
	491	9000 FORMAT(3(/,a72))
	492	9001 FORMAT(/,a72,/,a12)
	493	cc
	494	CLOSE(tapedef)
	495
	496	RETURN
	497	END

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

Download in other formats:

Original Format