Context Navigation

defrun_new.F @ 5306

Last change on this file since 5306 was 207, checked in by lmdz, 24 years ago
petit detail LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 14.2 KB

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

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

Download in other formats:

Original Format