1 | C |
---|
2 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * |
---|
3 | C IMPRESSIONS DES RESULTATS DU PROGRAMME ** ANL ** |
---|
4 | C SUBROUTINES APPELEES : HISTOG |
---|
5 | C |
---|
6 | C |
---|
7 | C IMPRESSIONS DES TABLEAUX DES FREQUENCES |
---|
8 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * |
---|
9 | C |
---|
10 | subroutine impanl(tab,anu1,anu2,impr,ymoyd,ymaxd,alf,qq,ibase) |
---|
11 | C |
---|
12 | logical*1 jdh(75),qq(1) |
---|
13 | integer tab(1),hist(nbclas,1),msot(20),nsot(20),vers |
---|
14 | real nu1,nu2,pas(2),alf(1 ) |
---|
15 | CBB passage en double precision |
---|
16 | real*8 ymoyd(1 ),ymaxd(1 ),yymoyd |
---|
17 | real ymoy(1 ),ymax(1 ),xmin,xmax |
---|
18 | character*9 trs1,trs2 |
---|
19 | character*7 form,bin |
---|
20 | character*4 tir,code,ctlg,mole,blanc |
---|
21 | character*3 pgm,ianl,iext,itrs,ilst,icop,info,icre, |
---|
22 | & iinf,oui,liste,iopt,modif,trans |
---|
23 | character*2 ikod,icod |
---|
24 | character*1 ba,bl,ast,ch5,ch6 |
---|
25 | C |
---|
26 | common/p1/ nu1,nu2,dnu,nbclas,khist,kanal,vers,mode,liste |
---|
27 | common/p2/ mole(75),isot(100),nbi(75),nbt(75),iopt,ctlg,trans, |
---|
28 | & trs1,trs2 |
---|
29 | common/p3/ imole,iran,ival,pgm,ianl,iext,itrs,ilst,icop,info,icre |
---|
30 | common/p4/ nmol,knmol,ksot,kksot,ntab,nhist,kp,lre,form,bin,modif |
---|
31 | common/p5/ code(75),nn(150),nq(150),ikod(18),icod(18),jdeb(75) |
---|
32 | common/inteh/ incr,pas1,pmax |
---|
33 | common/entsor/iuni,juni,kuni,ient,isor,iper,nresv,maxx,blanc,oui |
---|
34 | C |
---|
35 | equivalence (jdh(1),msot(1)) |
---|
36 | C |
---|
37 | data bl,ast,tir /' ','*','----'/,icar/45/,iinf/'inf'/ |
---|
38 | C |
---|
39 | if(mode.eq.1) pgm=iinf |
---|
40 | if(impr.eq.0) write(isor,902) vers,pgm,pgm |
---|
41 | 902 format(1x,17('*'),98x,17('*')/1x,'* geisa geisa *',34x, |
---|
42 | &' geisa',i2.2,' contents ',35x,'* geisa geisa *'/1x, |
---|
43 | &'*',6x,a3,6x,'*',98x,'*',6x,a3,6x,'*'/1x, |
---|
44 | &'* geisa geisa *',38x,'analysis per molecule',39x, |
---|
45 | &'* geisa geisa *'/1x,17('*'),98x,17('*')/) |
---|
46 | if(impr.eq.0.and.dnu.gt.0.) write(isor,903) nu1,nu2,dnu |
---|
47 | 903 format(37x,'nu1=',f10.3,' at nu2=',f10.3,' by step of dnu=' |
---|
48 | &,f12.6/) |
---|
49 | molj=0 |
---|
50 | do 12 j=1,ntab |
---|
51 | molj=molj+tab(j) |
---|
52 | 12 continue |
---|
53 | write(isor,1000) anu1,anu2,molj |
---|
54 | 1000 format(/' spectral interval (cm-1) nu1=', f09.3,2x,'nu2=',f10.3, |
---|
55 | &' transitions=',i7) |
---|
56 | impr=impr+1 |
---|
57 | kk=1 |
---|
58 | knn=0 |
---|
59 | do 24 j=1,nmol |
---|
60 | if(.not.qq(j)) go to 22 |
---|
61 | C |
---|
62 | C AJOUT DU 5EME CARACTERE DES MOLES CH3CL ET HCOOH L(CODE 211) |
---|
63 | C H(CODE 200) |
---|
64 | ch5=bl |
---|
65 | ch6=bl |
---|
66 | if(j.eq.34) ch5='l' |
---|
67 | if(j.eq.37) ch5='h' |
---|
68 | if(j.eq.42) ch5='o' |
---|
69 | if(j.eq.42) ch6='2' |
---|
70 | kn=nn(kk) |
---|
71 | ki=kk+1 |
---|
72 | kf=kk+kn |
---|
73 | kx=0 |
---|
74 | C |
---|
75 | C ELIMINATION DES ISOTOPES DE FREQUENCE NULLE |
---|
76 | C MSOT ET NSOT TABLEAUX CONTENANT POUR UNE MOLECULE DONNEE |
---|
77 | C LES CODES ISOTOPES ET LES FREQUENCES DES ISOTOPES |
---|
78 | C ORDONNES ET A VALEURS NON NULLES |
---|
79 | C |
---|
80 | molj=0 |
---|
81 | do 202 jk=ki,kf |
---|
82 | nnt=tab(nn(jk)) |
---|
83 | nnsot=nn(jk) |
---|
84 | C |
---|
85 | C |
---|
86 | C DANS LE TABLEAU TAB LES INDICES 951 A 990 SONT RESERVES POUR |
---|
87 | C LES ISOTOPES DUPLIQUES |
---|
88 | C |
---|
89 | C BB 06.05.97 cas de C2H4 2 isotopes dupliques, le 2eme indice=ibase=950 |
---|
90 | C |
---|
91 | C H2O CO2 O3 N2O CO CH4 O2 NO SO2 NO2 NH3 PH3 |
---|
92 | go to (541, 541,541, 541, 541, 541, 541, 541, 509, 510, 541, 541, |
---|
93 | C HNO3 OH HF HCL HBR HI CLO OCS H2CO C2H6 CH3D C2H2 |
---|
94 | & 541, 541, 541, 541, 517, 518, 519, 541, 541, 541, 541, 541, |
---|
95 | C C2H4 GEH4 HCN C3H8 C2N2 C4H2 HC3N HOCL N2 CH3CL H2O2 H2S |
---|
96 | & 525, 526, 541, 528, 541, 530, 531, 541, 541, 541, 541, 536, |
---|
97 | C HCOOH COF2 SF6 C3H4 HO2 CLONO2 |
---|
98 | & 541, 541, 541, 541, 537, 541 ),j |
---|
99 | C |
---|
100 | C SO2 |
---|
101 | 509 continue |
---|
102 | if(nnsot.eq.626) nnt=tab(ibase+j) |
---|
103 | go to 541 |
---|
104 | C |
---|
105 | C NO2 |
---|
106 | 510 continue |
---|
107 | if(nnsot.eq.646) nnt=tab(ibase+j) |
---|
108 | go to 541 |
---|
109 | C |
---|
110 | C HBR |
---|
111 | 517 continue |
---|
112 | if(nnsot.eq. 19) nnt=tab(ibase+j) |
---|
113 | go to 541 |
---|
114 | C |
---|
115 | C HI |
---|
116 | 518 continue |
---|
117 | if(nnsot.eq. 17) nnt=tab(ibase+j) |
---|
118 | go to 541 |
---|
119 | C |
---|
120 | C CLO |
---|
121 | 519 continue |
---|
122 | if(nnsot.eq. 56) nnt=tab(ibase+j) |
---|
123 | go to 541 |
---|
124 | C |
---|
125 | C C2H4 |
---|
126 | 525 continue |
---|
127 | if(nnsot.eq.211) nnt=tab(ibase+j) |
---|
128 | if(nnsot.eq.311) nnt=tab(ibase) |
---|
129 | go to 541 |
---|
130 | C |
---|
131 | C GEH4 |
---|
132 | 526 continue |
---|
133 | if(nnsot.eq.411) nnt=tab(ibase+j) |
---|
134 | go to 541 |
---|
135 | C |
---|
136 | C C3H8 |
---|
137 | 528 continue |
---|
138 | if(nnsot.eq.221) nnt=tab(ibase+j) |
---|
139 | go to 541 |
---|
140 | C |
---|
141 | C C4H2 |
---|
142 | 530 continue |
---|
143 | if(nnsot.eq.211) nnt=tab(ibase+j) |
---|
144 | go to 541 |
---|
145 | C |
---|
146 | C HC3N |
---|
147 | 531 continue |
---|
148 | if(nnsot.eq.124) nnt=tab(ibase+j) |
---|
149 | go to 541 |
---|
150 | C |
---|
151 | C H2S |
---|
152 | 536 continue |
---|
153 | if(nnsot.eq.131) nnt=tab(ibase+j) |
---|
154 | go to 541 |
---|
155 | C |
---|
156 | C HO2 |
---|
157 | 537 continue |
---|
158 | if(nnsot.eq.166) nnt=tab(ibase+j) |
---|
159 | go to 541 |
---|
160 | C |
---|
161 | 541 continue |
---|
162 | if(nnt.eq.0) go to 202 |
---|
163 | kx=kx+1 |
---|
164 | msot(kx)=nn(jk) |
---|
165 | nsot(kx)=nnt |
---|
166 | molj=molj+nnt |
---|
167 | 202 continue |
---|
168 | if(molj.eq.0) go to 22 |
---|
169 | alfmoy=alf(j)/molj |
---|
170 | CBB yymoy=ymoy(j)/molj |
---|
171 | yymoyd=ymoyd(j)/molj |
---|
172 | kn=min0(11,kx) |
---|
173 | kkn=max0(kn,knn) |
---|
174 | write(isor,1001)(tir,jj=1,kkn) |
---|
175 | 1001 format(1x,55(1h-),11(a4,3h---)) |
---|
176 | write(isor,1002) code(j),ch5,ch6,j,(msot(jj),jj=1,kn) |
---|
177 | 1002 format(' | moy.i | max.i |alpha.moy| ',a4,a1,a1,'|(',i2,') iso |
---|
178 | &topes |',11(i5,' |')) |
---|
179 | write(isor,1003) yymoyd,ymaxd(j),alfmoy,molj,(nsot(jj),jj=1,kn) |
---|
180 | 1003 format(' |',1pd9.3,'|',1pd9.3,'|',1pe9.3,'|',i7,'|number of lines| |
---|
181 | &',11(i6,'|')) |
---|
182 | if(kx.le.11) go to 70 |
---|
183 | C |
---|
184 | C AJOUTER LES IMPRESSIONS SUIVANTES DANS LE CAS OU KX>11 |
---|
185 | C |
---|
186 | kn=kn+1 |
---|
187 | write(isor,1005)(nsot(jj),jj=kn,kx) |
---|
188 | 1005 format(31x,'|',5(i6,1h|)) |
---|
189 | go to 75 |
---|
190 | 70 continue |
---|
191 | 75 continue |
---|
192 | knn=kn |
---|
193 | 22 kk=kk+nn(kk)+1 |
---|
194 | 24 continue |
---|
195 | write(isor,1001)(tir,jj=1,knn) |
---|
196 | return |
---|
197 | C |
---|
198 | C |
---|
199 | C IMPRESSIONS DES HISTOGRAMMES |
---|
200 | C |
---|
201 | entry imph(hist,xmin,xmax,pas,anu1,anu2,impr) |
---|
202 | C |
---|
203 | ch5=bl |
---|
204 | ch6=bl |
---|
205 | if(imole.eq.34) ch5='l' |
---|
206 | if(imole.eq.37) ch5='h' |
---|
207 | if(imole.eq.42) ch6='o' |
---|
208 | if(imole.eq.42) ch6='2' |
---|
209 | pas(1)=pas1 |
---|
210 | lk=nbclas |
---|
211 | if(impr.ne.0) go to 31 |
---|
212 | C IF(IVAL.EQ.IMOLE) WRITE(ISOR,904) VERS,CODE(IMOLE) |
---|
213 | C &'* GEISA *',98X,'* GEISA *'/1X, |
---|
214 | if(ival.eq.imole) |
---|
215 | &write(isor,904) vers,pgm,pgm,code(imole),ch5,ch6 |
---|
216 | 904 format(1x,17('*'),98x,17('*')/1x,'* geisa geisa *',34x, |
---|
217 | &'geisa',i2.2,' cumulative frequencies ',32x,'* geisa geisa *'/ |
---|
218 | &1x,'*',6x,a3,6x,'*',98x,'*',6x,a3,6x,'*'/1x, |
---|
219 | &'* geisa geisa *',41x,'molecule /',a4,a1,a1,'/',40x, |
---|
220 | &'* geisa geisa *'/1x,17('*'),98x,17('*')/) |
---|
221 | C IF(IVAL.NE.IMOLE) WRITE(ISOR,905) VERS,CODE(IMOLE),IVAL |
---|
222 | C &'* GEISA *',98X,'* GEISA *'/1X, |
---|
223 | if(ival.ne.imole) |
---|
224 | &write(isor,905) vers,pgm,pgm,code(imole),ch5,ch6,ival |
---|
225 | 905 format(1x,17('*'),98x,17('*')/1x,'* geisa geisa *',34x, |
---|
226 | &'geisa',i2.2,' cumulative frequencies ',32x,'* geisa geisa *'/ |
---|
227 | &1x,'*',6x,a3,6x,'*',98x,'*',6x,a3,6x,'*'/1x, |
---|
228 | &'* geisa geisa *',34x,'molecule /',a4,a1,a1,'/ isotope /', |
---|
229 | &i3,'/',33x,'* geisa geisa *'/1x,17('*'),98x,17('*')/) |
---|
230 | if(dnu.gt.0.) write(isor,903) nu1,nu2,dnu |
---|
231 | 31 continue |
---|
232 | ki=1 |
---|
233 | kf=2 |
---|
234 | if(khist.eq.1) kf=1 |
---|
235 | if(khist.eq.2) ki=2 |
---|
236 | do 35 k=ki,kf |
---|
237 | mm=0 |
---|
238 | do 26 j=1,lk |
---|
239 | ijk=hist(j,k) |
---|
240 | mm=max0(mm,ijk) |
---|
241 | 26 continue |
---|
242 | if(mm.ne.0) go to 27 |
---|
243 | impr=impr+1 |
---|
244 | if(imole.eq.ival) |
---|
245 | & write(isor,900) anu1,anu2,code(imole),ch5,ch6 |
---|
246 | if(imole.ne.ival) |
---|
247 | & write(isor,901) anu1,anu2,ival,code(imole),ch5,ch6 |
---|
248 | 900 format(///' *anl* in the spectral interval ',f10.3,'< nu <', |
---|
249 | &f10.3,' the molecule ',a4,a1,a1,' does not exist'///) |
---|
250 | 901 format(///' *anl* in the spectral interval ',f10.3,'< nu <', |
---|
251 | &f10.3,' the isotope ',i4,' of ',a4,a1,a1,' does not exist'///) |
---|
252 | return |
---|
253 | 27 continue |
---|
254 | ech=mm/float(icar) |
---|
255 | C |
---|
256 | C CALCUL DES HAUTEURS DES CLASSES DE HIST |
---|
257 | C |
---|
258 | do 30 j=1,lk |
---|
259 | i=hist(j ,k)/ech |
---|
260 | hist(j,k+2)=min0(i,icar) |
---|
261 | 30 continue |
---|
262 | 35 continue |
---|
263 | lk1=lk+1 |
---|
264 | impr=impr+1 |
---|
265 | if(khist.eq.-1) go to 50 |
---|
266 | k=khist |
---|
267 | v=xmax |
---|
268 | if(k.eq.1) v=pmax |
---|
269 | if(k.eq.1.and.ival.eq.imole) write(isor,906) anu1,anu2,code(imole) |
---|
270 | &,ch5,ch6 |
---|
271 | 906 format(/' spectral interval (cm-1) nu1=',f10.3,5x,'nu2=',f10.3/ |
---|
272 | &1x,' classes effectives intensity - ',a4,a1,a1/) |
---|
273 | if(k.eq.2.and.ival.eq.imole) write(isor,907) anu1,anu2,code(imole) |
---|
274 | &,ch5,ch6 |
---|
275 | 907 format(/' spectral interval (cm-1) nu1=',f10.3,5x,'nu2=',f10.3/ |
---|
276 | &1x,' classes effectives ground level - ',a4,a1,a1/) |
---|
277 | if(k.eq.1.and.ival.ne.imole) |
---|
278 | &write(isor,9061) anu1,anu2,code(imole),ch5,ch6,ival |
---|
279 | 9061 format(/' spectral intarval (cm-1) nu1=',f10.3,5x,'nu2=',f10.3/ |
---|
280 | &1x,' classes effectives intensity - ',a4,a1,a1,'/',i3/) |
---|
281 | if(k.eq.2.and.ival.ne.imole) |
---|
282 | &write(isor,9071) anu1,anu2,code(imole),ch5,ch6,ival |
---|
283 | 9071 format(/' spectral interval l(cm-1) nu1=',f10.3,5x,'nu2=',f10.3/ |
---|
284 | &1x,' classes effectives ground level - ',a4,a1,a1,'/',i3/) |
---|
285 | if(k.eq.1) lk1=lk |
---|
286 | do 40 j=1,lk1 |
---|
287 | call histog(hist,pas(k),xmin,k,lk,j,ih,ihh,v,vv,ba,bl,ast) |
---|
288 | write(isor,2000) vv,ihh,(ba,jj=1,ih) |
---|
289 | 2000 format(1h , 1pd10.4,i7,3h|*|,45a1) |
---|
290 | 40 continue |
---|
291 | return |
---|
292 | 50 continue |
---|
293 | if(ival.eq.imole) write(isor,908) |
---|
294 | &anu1,anu2,anu1,anu2,code(imole),ch5,ch6,code(imole),ch5,ch6 |
---|
295 | 908 format(/' intervalle spectral(cm-1) nu1=',f10.3,5x,'nu2=',f10.3, |
---|
296 | &6x,'spectral interval (cm-1) nu1=',f10.3,5x,'nu2=',f10.3/ |
---|
297 | &1x,' classes effectives intensity - ',a4,a1,a1,24x ,' classes |
---|
298 | & effectives ground level - ',a4,a1,a1/) |
---|
299 | if(ival.ne.imole) write(isor,909) |
---|
300 | &anu1,anu2,anu1,anu2,code(imole),ch5,ch6,ival,code(imole),ch5,ch6, |
---|
301 | &ival |
---|
302 | 909 format(/' intervalle spectral(cm-1) nu1=',f10.3,5x,'nu2=',f10.3, |
---|
303 | &6x,'spectral interval (cm-1) nu1=',f10.3,5x,'nu2=',f10.3/ |
---|
304 | &1x,' classes effectives intensity - ',a4,a1,a1,'/',i3,20x, |
---|
305 | &' classes effectives ground level - ',a4,a1,a1,'/',i3/) |
---|
306 | v=pmax |
---|
307 | v1=xmax |
---|
308 | do 60 j=1,lk |
---|
309 | icon=1 |
---|
310 | call histog(hist,pas(1),xmin,icon,lk,j,ih,ihh,v,vv,ba,bl,ast) |
---|
311 | write(isor,2000) vv,ihh,(ba,jj=1,ih) |
---|
312 | icon=2 |
---|
313 | call histog(hist,pas(2),xmin,icon,lk,j,ih1,ihh1,v1,vv1,ba,bl,ast) |
---|
314 | write(isor,2001) vv1,ihh1,(ba,jj=1,ih1) |
---|
315 | 2001 format(1x,67x,1pd10.4,i7,3h|*|,45a1) |
---|
316 | 60 continue |
---|
317 | call histog(hist,pas(2),xmin,2,lk,lk+1,ih1,ihh1,v1,vv1,ba,bl,ast) |
---|
318 | vv=vv*pas1 |
---|
319 | write(isor,2002) vv,vv1,ihh1,(ba,jj=1,ih1) |
---|
320 | 2002 format(1x,1pd10.4,6x,4h0|*|,47x,1pd10.4,i7,3h|*|,45a1) |
---|
321 | return |
---|
322 | end |
---|
323 | |
---|