Context Navigation

analy.f_test @ 356

Last change on this file since 356 was 1, checked in by cbipsl, 18 years ago
Geisa inital import
File size: 11.3 KB

Line
1	C CETTE OPTION DOIT VENIR APRES LA MODIFICATION PAR
2	C &GEISA PGM='TRS',UNITE='BINAIRE',MODIF='OUI' &END
3	C LE PROGRAMME ANL MODIFIE LA BANQUE DE LA FACON SUIVANTE POUR
4	C STOCKER LES FREQUENCES DES ISOTOPES DES MOLECULES :
5	C EN RECORD 1 AJOUTER APRES LL1 LA VALEUR DE LL2=1
6	C A PARTIR DU RECORD IFIN+LL1 ECRIRE LES VALEURS SUIVANTES :
7	C NTAB,(TAB(J),J=1,NTAB),(YMOY(J),J=1,20),(YMAX(J),J=1,20),
8	C (ALF(J),J=1,20)
9	C MODE=-1 APPEL NORMAL DE ANL POUR LISTER LES FREQUENCES MOLECULES
10	C ENTRE NU1 ET NU2
11	C MODE=0 MODIFICATION DE LA BANQUE (VOIR PRECEDEMMENT) DANS CE CAS
12	C MODIF='OUI'
13	C MODE=1 LISTE DES FREQUENCES DE LA BANQUE PAR MOLECULE SANS
14	C LECTURE DU FICHIER(OPTION PROVENANT DE PGM='INF')
15	C
16	C ANALYSE PAR MOLECULE ET PAR VARIETE ISOTOPIQUE DU CONTENU
17	C DE LA BANQUE DANS UN DOMAINE SPECTRAL DONNE
18	C HISTOGRAMME DES FREQUENCES DES RAIES POUR UNE CLASSE
19	C D'INTENSITE (K=1) OU DE NIVEAU DE BASE (K=2)
20	C
21	C NU1,NU2 LIMITES INF ET SUP DU DOMAINE SPECTRAL ETUDIE
22	C DNU PAS D'ETUDE(JUSQU'A 500 PAS SONT PREVUS)
23	C PAR DEFAUT TOUT LE FICHIER AVEC 1 PAS D'ETUDE
24	C XMIN(K),XMAX(K),PAS(K) RESPECTIVEMENT MINIMUM,MAXIMUM,LARGEUR
25	C DE LA CLASSE POUR LES VARIABLES INTENSITE OU NIVEAU DE BASE
26	C TAB(I) TABLEAU INDICE PAR LA VALEUR DES ISOTOPES ET CONTENANT LES
27	C FREQUENCES DES ISOTOPES
28	C CODE(I) TABLEAU CONTENANT LES CODES MOLECULES
29	C NN TABLEAU CONTENANT LE NOMBRE D'ISOTOPES PAR MOLECULE
30	C SUIVI DES CODES ISOTOPES
31	C ALF(I) MOYENNE DES 1/2 LARGEUR A MI-HAUTEUR PAR MOLECULE
32	C HIST(I,J) TABLEAU CONTENANT L'HISTOGRAMME A REPRESENTER
33	C I=NUMERO DE LA CLASSE
34	C J=1 HISTOGRAMME DES INTENSITES
35	C J=3 HAUTEUR DES CLASSES POUR LES INTENSITES
36	C J=2 HISTOGRAMME DES NIVEAUX DE BASE
37	C J=4 HAUTEUR DES CLASSES POUR LES NIVEAUX DE BASE
38	C ICAR HAUTEUR MAX D'UNE CLASSE(45 CARACTERES)
39	C IVAL=0 ANALYSE POUR TOUTES MOLECULES ET TOUS ISOTOPES(OPTION PAR D
40	C IVAL#0 ANALYSE POUR UNE MOLECULE OU UN ISOTOPE
41	C IVAL=NUMERO DE LA MOLECULE OU DE L'ISOTOPE
42	C IRAN=1 POUR MOLECULE
43	C IRAN=2 POUR ISOTOPE
44	C MOLE=MOLECULE DEMANDEE EXEMPLE MOLE='H2O' OU 'CO2' ...
45	C ISOT=ISOTOPE DEMANDE EXEMPLE ISOT=161 OU 162 ...
46	C ANAL='OUI' ANALYSE PAR MOLECULE
47	C ANAL=AUTRE PAS D'ANALYSE
48	C HISTO='INTE' HISTOGRAMME INTENSITE (KHIST=1)
49	C HISTO='BASE' HISTOGRAMME NIVEAU DE BASE (KHIST=2)
50	C HISTO='DEUX' HISTOGRAMME INTENSITE ET NIVEAU DE BASE (KHIST=-1)
51	C HISTO=AUTRE PAS D'HISTOGRAMME (OPTION PAR DEFAUT)
52	C NBCLAS NOMBRE DE CLASSES DE L'HISTOGRAMME (PAR DEFAUT 10)
53	C NHIST NOMBRE MAXIMUM DE CLASSES(50)
54	C KANAL=0 HISTO
55	C KANAL=1 ANAL
56	C IUNI UNITE LOGIQUE CORRESPONDANT AU FICHIER SPECTRAL
57	C
58	C --> SUBROUTINES APPELEES : IMPANL
59	C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *
60	C LAST MODIF: 06.05.91 PASSAGE A 75 MOLECULES DANS LES COMMON
61	C
62	C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *
63	subroutine analy(tab,hist,xmin,xmax,ymoy,ymax,alf,qq,*)
64	C
65	logical*1 qq(1)
66	character*9 trs1,trs2
67	character*7 form,bin
68	character*4 code,ctlg,mole,blanc,base,deux
69	character*3 pgm,ianl,iext,itrs,ilst,icop,info,icre,
70	& oui,liste,iopt,modif,trans
71	character*2 ikod,icod
72	character*1 bl
73	dimension pas(2),kode(2),alf(40)
74	C NOUVEAU TABLEAU V DE LECTURE ON PASSE DE 16 -> 29 OCTETS
75	real*8 ymoyd(40),ymaxd(40),cor,a2
76	real v(29),ymoy(40),ymax(40),xmin(40),xmax(40)
77	real nu1,nu2
78	integer hist(1),tab(1),vers
79	C
80	common/p1/ nu1,nu2,dnu,nbclas,khist,kanal,vers,mode,liste
81	common/p2/ mole(75),isot(100),nbi(75),nbt(75),iopt,ctlg,trans,
82	& trs1,trs2
83	common/p3/ imole,iran,ival,pgm,ianl,iext,itrs,ilst,icop,info,icre
84	common/p4/ nmol,knmol,ksot,kksot,ntab,nhist,kp,lre,form,bin,modif
85	common/p5/ code(75),nn(150),nq(150),ikod(18),icod(18),jdeb(75)
86	common/inteh/ incr,pas1,pmax
87	common/entsor/iuni,juni,kuni,ient,isor,iper,nresv,maxx,blanc,oui
88	C
89	equivalence (kode(1),izot),(kode(2),imol)
90	equivalence (a,v(1)),(izot,v(15)),(imol,v(16))
91	C
92	data nbklas/500/,ibase/950/,cor/1.d50/
93	C
94	C INITIALISATION DES TABLEAUX
95	C
96	c print *,' entree dans ANL'
97	impr=0
98	c print *,' mode=',mode
99	if(mode.eq.-1) go to 6
100	c print *,' appel PGEISA'
101	call pgeisa(0.,99999.,999)
102	c print *,' retour PGEISA'
103	999 read (iuni,rec=1)
104	&nu1,nu2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4
105	if(mode.eq.0) go to 7
106	if(mode.eq.1.and.ll2.ne.0) go to 5
107	write(isor,2000)
108	2000 format(///' inf cette option est uniquement valable pour la ba
109	&nque'/9x,'des donnees spectroscopiques'///)
110	go to 900
111	5 continue
112	ifin=ifin+ll1
113	read (iuni,rec=ifin)
114	&ntab,(tab(j),j=1,ntab),nmol,(ymoy(j),j=1,nmol),
115	&(ymax(j),j=1,nmol),(alf(j),j=1,nmol)
116	do 12 j=1,nmol
117	ymoyd(j)=ymoy(j)*(1./cor)
118	ymaxd(j)=ymax(j)*(1./cor)
119	12 continue
120	call impanl(tab,nu1,nu2,impr,ymoyd,ymaxd,alf,qq,ibase)
121	go to 900
122	6 continue
123	call pgeisa(nu1,nu2,*900)
124	7 continue
125	do 1 j=1,nmol
126	ymoy(j)=0.
127	ymax(j)=0.
128	ymoyd(j)=0.
129	ymaxd(j)=0.
130	1 alf(j)=0.
131	nbc2=nbclas*2
132	npas=nbklas
133	do 10 j=1,npas
134	xmin(j)=1.e20
135	xmax(j)=0.
136	10 continue
137	lk=ntab+nbc2
138	do 11 j=1,lk
139	11 tab(j)=0
140	C
141	C CALCUL DES FREQUENCES PAR MOLECULE ET PAR ISOTOPE ET DES
142	C MOYENNES ALFMOY
143	C
144	PRINT *,'analy1-nu2=',nu2,'im= ',im,' nbklas=',nbklas
145	if(dnu.ne.0.) im=(nu2-nu1)/dnu
146	if(im.gt.nbklas) nu2=nu1+float(nbklas)*dnu
147	PRINT *,'analy2-nu2=',nu2,'im= ',im,' nbklas=',nbklas
148	im=0
149	anu1=nu1
150	anu2=nu1+dnu
151	if(dnu.eq.0.) anu2=nu2
152	100 continue
153	PRINT *,'analy3-nu2=',nu2,'im= ',im,' nbklas=',nbklas
154	call lgeisa(v,*200)
155	PRINT *,'analy4-nu2=',nu2,'im= ',im,' nbklas=',nbklas
156	C
157	C TRAITEMENT PARTICULIER DES MOLECULES AYANT DES ISOTOPES DUPLIQUES
158	C MOLE= 9 10 17 18 19 25 26 28 30 31 36 42
159	C
160	C DANS LE TABLEAU TAB LES INDICES 951 A 992 SONT RESERVES POUR
161	C LES ISOTOPES DUPLIQUES (IBASE=950)
162	C BB 06.05.97 cas c2h4 ( 2 isotopes dupliques le 2emendice=ibase=950
163	C
164	C H2O CO2 O3 N2O CO CH4 O2 NO SO2 NO2 NH3 PH3
165	go to (541, 541,541, 541, 541, 541, 541, 541, 509, 510, 541, 541,
166	C HNO3 OH HF HCL HBR HI CLO OCS H2CO C2H6 CH3D C2H2
167	& 541, 541, 541, 541, 517, 518, 519, 541, 541, 541, 541, 541,
168	C C2H4 GEH4 HCN C3H8 C2N2 C4H2 HC3N HOCL N2 CH3CLH2O2 H2S
169	& 525, 526, 541, 528, 541, 530, 531, 541, 541, 541, 541, 536,
170	C HCOOH COF2 SF6 C3H4 HO2 CLONO2
171	& 541, 541, 541, 541, 537, 541 ),imol
172	C
173	C SO2
174	509 continue
175	if(izot.eq.626) izot=ibase+imol
176	go to 541
177	C
178	C NO2
179	510 continue
180	if(izot.eq.646) izot=ibase+imol
181	go to 541
182	C
183	C HBR
184	517 continue
185	if(izot.eq. 19) izot=ibase+imol
186	go to 541
187	C
188	C HI
189	518 continue
190	if(izot.eq. 17) izot=ibase+imol
191	go to 541
192	C
193	C CLO
194	519 continue
195	if(izot.eq. 56) izot=ibase+imol
196	go to 541
197	C
198	C C2H4
199	525 continue
200	if(izot.eq.211) izot=ibase+imol
201	if(izot.eq.311) izot=ibase
202	go to 541
203	C
204	C GEH4
205	526 continue
206	if(izot.eq.411) izot=ibase+imol
207	go to 541
208	C
209	C C3H8
210	528 continue
211	if(izot.eq.221) izot=ibase+imol
212	go to 541
213	C
214	C C4H2
215	530 continue
216	if(izot.eq.211) izot=ibase+imol
217	go to 541
218	C
219	C HC3N
220	531 continue
221	if(izot.eq.124) izot=ibase+imol
222	go to 541
223	C
224	C H2S
225	536 continue
226	if(izot.eq.131) izot=ibase+imol
227	C GO TO 541
228	C
229	C HO2
230	537 continue
231	if(izot.eq.166) izot=ibase+imol
232	C GO TO 541
233	C
234	541 continue
235	PRINT *,'analy5-nu2=',nu2,'im= ',im,' nbklas=',nbklas
236	if(a.le.anu2) go to 19
237	PRINT *,'analy6-nu2=',nu2,'im= ',im,' nbklas=',nbklas
238	if(kanal.eq.1) go to 16
239	im=im+1
240	anu1=anu2
241	anu2=amin1(nu2,anu2+dnu)
242	go to 20
243	16 continue
244	call impanl(tab,anu1,anu2,impr,ymoyd,ymaxd,alf,qq,ibase)
245	anu1=anu2
246	anu2=amin1(nu2,anu2+dnu)
247	do 17 j=1,lk
248	17 tab(j)=0
249	do 18 j=1,nmol
250	ymoy(j)=0.
251	ymax(j)=0.
252	ymoyd(j)=0.
253	ymaxd(j)=0.
254	18 alf(j)=0.
255	im=im+1
256	19 continue
257	if(.not.qq(imol)) go to 100
258	if(kanal.eq.0) go to 20
259	tab(izot)=tab(izot)+1
260	alf(imol)=alf(imol)+v(3)
261	a2=v(2)*(1./cor)
262	ymoyd(imol)=ymoyd(imol)+a2
263	Camax1 -> dmax1 ( real 8) BB 19/11/96
264	ymaxd(imol)=dmax1(ymaxd(imol),a2)
265	C ymax(imol)=amax1(ymax(imol),v(2))
266	C
267	C CALCUL DES MIN ET DES MAX DES CLASSES POUR LES INTENSITES ET LES
268	C NIVEAUX DE BASE
269	C
270	if(khist.eq.0.or.khist.eq.1) go to 100
271	20 continue
272	if(ival.ne.0.and.kode(iran).ne.ival) go to 100
273	xmax(im+1)=amax1(xmax(im+1),v(4))
274	xmin(im+1)=amin1(xmin(im+1),v(4))
275	go to 100
276	200 continue
277	PRINT *,'analy7-nu2=',nu2,'im= ',im,' nbklas=',nbklas
278	if(kanal.eq.0) go to 24
279	call impanl(tab,anu1,anu2,impr,ymoyd,ymaxd,alf,qq,ibase)
280	if(mode.ne.0.or.modif.ne.oui) go to 900
281	c print *,' avant read rec=1 '
282	read (iuni,rec=1)
283	&nu1,nu2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4
284	c print *,' apres read rec=1 '
285	c print *,
286	c &nu1,nu2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4
287	ll2=1
288	c print *,' avant write rec=1 '
289	c print *, ifin,ll1
290	write(iuni,rec=1)
291	&nu1,nu2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4
292	c print *,' apres write rec=1 '
293	c print *,
294	c &nu1,nu2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4
295	c print *, ifin,ll1
296	ifin=ifin+ll1
297	do 22 j=1,nmol
298	ymoy(j)=ymoyd(j)*cor
299	22 ymax(j)=ymaxd(j)*cor
300	c print *, ifin
301	c write(iuni,rec=ifin)
302	c & ntab,(tab(j),j=1,ntab),nmol,(ymoy(j),j=1,nmol),
303	c &(ymax(j),j=1,nmol),(alf(j),j=1,nmol)
304	c print *,
305	c & ntab,(tab(j),j=1,ntab),nmol,(ymoy(j),j=1,nmol),
306	c &(ymax(j),j=1,nmol),(alf(j),j=1,nmol)
307	go to 900
308	24 continue
309	impr=0
310	im=0
311	anu1=nu1
312	anu2=nu1+dnu
313	if(dnu.eq.0.) anu2=nu2
314	pas( 2)=(xmax(im+1)-xmin(im+1))/nbclas
315	if(pas(2).eq.0.) pas(2)=1.e+20
316	call pgeisa(nu1,nu2,*900)
317	300 continue
318	call lgeisa(v,*400)
319	C
320	C CALCUL DES FREQUENCES DES CLASSES DE HIST
321	C
322	if(a.le.anu2) go to 319
323	call imph (hist,xmin(im+1),xmax(im+1),pas,anu1,anu2,impr)
324	im=im+1
325	anu1=anu2
326	anu2=amin1(nu2,anu2+dnu)
327	pas(2)=(xmax(im+1)-xmin(im+1))/nbclas
328	if(pas(2).eq.0.) pas(2)=1.e+20
329	do 26 i=1,nbc2
330	hist(i)=0
331	26 continue
332	319 continue
333	if(ival.ne.0.and.kode(iran).ne.ival) go to 300
334	C alog -> dlog (real 8) BB 19/11/96
335	a2=v(2)*(1./cor)
336	kt=incr+dlog10(a2)
337	C kt=incr+alog10(v(2))
338	hist(kt)=hist(kt)+1
339	if(khist.eq.1) go to 300
340	kt=(v(4)-xmin(im+1) )/pas(2) + 1.
341	kt=min0(kt,nbclas)
342	ktk=kt+nbclas
343	hist(ktk)=hist(ktk)+1
344	go to 300
345	400 continue
346	if(khist.ne.0) call imph(hist,xmin(im+1),xmax(im+1),pas
347	&,anu1,anu2,impr)
348	900 continue
349	return 1
350	end

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

Download in other formats:

Original Format