1 | C LE PROGRAMME TRS MODIFIE LA BANQUE DE LA FACON SUIVANTE POUR |
---|
2 | C STOCKER LA LISTE DES TRANSITIONS : |
---|
3 | C EN RECORD 1 AJOUTER APRES IFIN LA VALEUR LL1 |
---|
4 | C A PARTIR DU RECORD IFIN INCLUS ECRIRE LL1 RECORDS OU EST STOCKE |
---|
5 | C LE TABLEAU P DU PROGRAMME TRS |
---|
6 | C |
---|
7 | C MODE=-1 APPEL NORMAL DE TRS POUR LISTER LES TRANSITIONS |
---|
8 | C ENTRE NU1 ET NU2 |
---|
9 | C MODE=0 MODIFICATION DE LA BANQUE (VOIR PRECEDEMMENT) DANS CE CAS |
---|
10 | C MODIF='OUI' |
---|
11 | C MODE=1 LISTE DES TRANSITIONS DE LA BANQUE PAR MOLECULE SANS |
---|
12 | C LECTURE DU FICHIER(OPTION PROVENANT DE PGM='INF') |
---|
13 | C |
---|
14 | C CE PROGRAMME LISTE LE NOMBRE DE TRANSITIONS VIBRATIONNELLES |
---|
15 | C PRESENTES DANS LA BANQUE DANS UN DOMAINE SPECTRAL DONNE, |
---|
16 | C POUR UNE OU PLUSIEURS MOLECULES. |
---|
17 | C SONT AUSSI INDIQUES LA PREMIERE ET LA DERNIERE RAIE AINSI QUE |
---|
18 | C LES VALEURS DES INTENSITES ET L'INTENSITE MAXIMALE. |
---|
19 | C |
---|
20 | C NBI(I)=NB MAX DE TRANSITIONS # PREVUS POUR LA MOLECULE I DANS P |
---|
21 | C NBT(I)=NOMBRE D'OCTETS DEFINISSANT LA TRANSITION DE LA MOLECULE I |
---|
22 | C LE TABLEAU NBI EST A METTRE A JOUR CHAQUE FOIS QUE LA BANQUE |
---|
23 | C EST MODIFIEE SOMME(NBT/4 + 1 + 7)*NBI=80000 (A CETTE DATE) |
---|
24 | C PREVOIR DIMENSION P=KP>=80000 |
---|
25 | C PLACE OCCUPEE DANS P PAR UNE TRANSITION DONNEE : |
---|
26 | C (NBT+3)/4 MOTS + 7 MOTS DEFINIS PLUS LOIN |
---|
27 | C |
---|
28 | C P,PP,Q NOMS # D'UNE MEME REGION EN MEMOIRE CENTRALE |
---|
29 | C P TABLEAU D'ENTIERS |
---|
30 | C Q TABLEAU DE REELS |
---|
31 | C PP TABLEAU D'OCTETS |
---|
32 | C JDEB(I)=ADRESSE DANS NN DU NB D'ISOTOPES DE LA MOLECULE I |
---|
33 | C NN(JDEB(I))=NB D'ISOTOPES DE LA MOLECULE I |
---|
34 | C IDEB(I)=ADRESSE DANS P=Q DU DEBUT DE STOCKAGE DES RENSEIGNEMENTS |
---|
35 | C CONCERNANT LA MOLECULE I |
---|
36 | C |
---|
37 | C DANS P=Q SONT STOCKES LES RENSEIGNEMENTS SUIVANTS : |
---|
38 | C DE L'ADRESSE IDEB(I)+1 A L'ADRESSE IDEB(I)+(NBT(I)/4+8)*NBI(I) |
---|
39 | C TRANSITIONS DE TOUS LES ISOTOPES DE LA MOLECULE I(POUR UNE |
---|
40 | C MOLECULE DONNEE NBI(I) TRANSITIONS DIFFERENTES SONT POSSIBLES) |
---|
41 | C POUR LA MOLECULE I |
---|
42 | C SI IN=IDEB(I) ET NTR=NBT(I) |
---|
43 | C (PP(IN*4+J),J=1,NTR)= NTR OCTETS DEFINISSANT LA TRANSITION DE I |
---|
44 | C NTN=(NTR+3)/4 |
---|
45 | C P(IN+NTN+1)=CODE ISOTOPE |
---|
46 | C P(IN+NTN+2)=FREQUENCE D'UNE TRANSITION DONNEE |
---|
47 | C Q(IN+NTN+3)=PREMIERE RAIE |
---|
48 | C Q(IN+NTN+4)=DERNIERE RAIE |
---|
49 | C Q(IN+NTN+5)=MIN INTENSITE ENTRE Q(3) ET Q(4) |
---|
50 | C Q(IN+NTN+6)=MAX INTENSITE ENTRE Q(3) ET Q(4) |
---|
51 | C Q(IN+NTN+7)=SOMME DES INTENSITES DE CETTE TRANSITION |
---|
52 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * |
---|
53 | C |
---|
54 | C MODIF : 07.05.1991 PASSAGE DE 40 A 75 MOLECULES DANS LES COMMON |
---|
55 | C LAST MODIF : 11.03.1997 PASSAGE DE v(2) en double precision par cor |
---|
56 | C |
---|
57 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * |
---|
58 | subroutine trsi(p,pp,q,qq,*) |
---|
59 | C |
---|
60 | character*44 fmt |
---|
61 | character*9 trs1,trs2 |
---|
62 | character*7 form,bin,unite |
---|
63 | character*4 mole,ctlg,code,blanc |
---|
64 | character*3 iopt,pgm,ianl,iext,itrs,ilst,icop,info,icre, |
---|
65 | & liste,modif,iinf,oui,non,ncoef,trans |
---|
66 | character*2 icod,ikod,slas |
---|
67 | character*1 moins,slash,bl,bc,cs,sla(2),ch5,ch6,ia(36),pp(1) |
---|
68 | logical*1 qq(1) |
---|
69 | integer ib(10),p(1),ideb(75),vers |
---|
70 | C |
---|
71 | C GEISA90 : 16 -> 29 |
---|
72 | C |
---|
73 | real q(1),nu1,nu2,v(29) |
---|
74 | real*8 cor,aa2,qq7,qq3,qq4,qq5 |
---|
75 | C |
---|
76 | common/p1/ nu1,nu2,dnu,nbclas,khist,kanal,vers,mode,liste |
---|
77 | common/p2/ mole(75),isot(100),nbi(75),nbt(75),iopt,ctlg,trans, |
---|
78 | & trs1,trs2 |
---|
79 | common/p3/ imole,iran,ival,pgm,ianl,iext,itrs,ilst,icop,info,icre |
---|
80 | common/p4/ nmol,knmol,ksot,kksot,ntab,nhist,kp,lre,form,bin,modif |
---|
81 | common/p5/ code(75),nn(150),nq(150),ikod(18),icod(18),jdeb(75) |
---|
82 | common/entsor/iuni,juni,kuni,ient,isor,iper,nresv,maxx,blanc,oui |
---|
83 | C |
---|
84 | equivalence (izot,v(15)),(imol,v(16)) |
---|
85 | equivalence (a,v(1)),(ai,v(2)),(a3,v(3)),(a4,v(4)),(ia(1),v(5)) |
---|
86 | equivalence (sla(1),slas) |
---|
87 | C |
---|
88 | data moins,slash/'-','/'/,bl/' '/,cs/'s'/,iinf/'inf'/,sla/' ','/'/ |
---|
89 | data fmt/'(44x,i2,2h) ,a4,a2,2h /, (i3,a1))'/ |
---|
90 | data coeff/2.479426e19/,non/'not'/,cor/1.d50/ |
---|
91 | C DATA FMT/'(4','8X',',A','4,','A1',', ',' ','(I','3,','A1','))'/ |
---|
92 | C |
---|
93 | C LPQ=NOMBRE DE MOTS RESERVES POUR UNE TRANSITION |
---|
94 | C |
---|
95 | lpq=7 |
---|
96 | C ICI ******************************* |
---|
97 | if(mode.eq.-1) go to 5 |
---|
98 | call pgeisa(0.,99999.,9999) |
---|
99 | 9999 read (iuni,rec=1) |
---|
100 | &nu1,nu2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4 |
---|
101 | c print *,' lecture rec=1 ' |
---|
102 | c print *,nu1,nu2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4 |
---|
103 | if(mode.eq.0.or.ll1.ne.0) go to 66 |
---|
104 | write(isor,2000) |
---|
105 | 2000 format(///' *inf* this option is only available for spectroscopi |
---|
106 | &c '/9x,'data bank *** geisa ***'///) |
---|
107 | write(*,*) mode,ll1 |
---|
108 | go to 900 |
---|
109 | 5 continue |
---|
110 | C IMPRESSION DE L'ENTETE AVEC LES MOLECULES ET ISOTOPES DEMANDES |
---|
111 | call pgeisa(nu1,nu2,*900) |
---|
112 | 66 continue |
---|
113 | if(mode.eq.1) pgm=iinf |
---|
114 | write(isor,3000) vers,pgm,pgm,nu1,nu2 |
---|
115 | 3000 format(1x,17('*'),98x,17('*')/1x,'* geisa geisa *', |
---|
116 | &31x,'available transitions in geisa',i2.2,35x, |
---|
117 | &'* geisa geisa *'/' *',6x,a3,6x,'*',98x,'*',6x,a3,6x,'*'/ |
---|
118 | &' * geisa geisa *',20x,'spectral interval (cm-1) ', |
---|
119 | &' nu1=',f10.3,3x,'nu2=',f10.3, |
---|
120 | &20x ,'* geisa geisa *'/1x,17('*'),98x,17('*')) |
---|
121 | write(isor,3500) |
---|
122 | 3500 format( 44x,' extraction of the following ', |
---|
123 | &'molecules and isotopes '/) |
---|
124 | C RECHERCHE DES MOLECULES ET ISOTOPES DEMANDES POUR LES IMPRIMER |
---|
125 | c print *,nmol,(qq(i),i=1,nmol) |
---|
126 | do 35 i=1,nmol |
---|
127 | if(.not.qq(i)) go to 35 |
---|
128 | kk=jdeb(i) |
---|
129 | ki=kk+1 |
---|
130 | kf=kk+nn(kk) |
---|
131 | c PRINT *,' KK,KI,KF',KK,KI,KF |
---|
132 | jj=0 |
---|
133 | do 33 j=ki,kf |
---|
134 | if(pp(nn(j)).eq.'1')go to 33 |
---|
135 | jj=jj+1 |
---|
136 | ib(jj)=nn(j) |
---|
137 | 33 continue |
---|
138 | j1=jj-1 |
---|
139 | fmt(26:27)=icod(jj) |
---|
140 | sla(1)=bl |
---|
141 | sla(2)=bl |
---|
142 | C IF(I.EQ.19) PRINT *,' CLO CLO' |
---|
143 | if(i.eq.34) sla(1)='l' |
---|
144 | if(i.eq.37) sla(1)='h' |
---|
145 | if(i.eq.42) sla(1)='o' |
---|
146 | if(i.eq.42) sla(2)='2' |
---|
147 | if(jj.ne.1) |
---|
148 | &write(isor,fmt)i,code(i),slas ,(ib(j),moins,j=1,j1),ib(jj),slash |
---|
149 | if(jj.eq.1) write(isor,fmt) i,code(i),slas ,ib(jj),slash |
---|
150 | 35 continue |
---|
151 | do 40 i=1,kp |
---|
152 | 40 p(i)=0 |
---|
153 | C IF(MODE.EQ.1) GO TO 46 |
---|
154 | k=0 |
---|
155 | C TEST POUR SAVOIR SI LA DIMENSION DE P EST SUFFISANTE |
---|
156 | do 45 i=1,nmol |
---|
157 | if(.not.qq(i)) go to 45 |
---|
158 | kbit=((nbt(i)+3)/4 + lpq)*nbi(i) |
---|
159 | k=k+kbit |
---|
160 | 45 continue |
---|
161 | C PRINT *,' K,KP=',K,KP |
---|
162 | if(k.le.kp) go to 46 |
---|
163 | write(isor,460) k,kp |
---|
164 | 460 format(///' *trs* faites votre liste en deux fois'/ |
---|
165 | &9x,'k=',i6,' kp=',i6//) |
---|
166 | go to 900 |
---|
167 | 46 continue |
---|
168 | k=0 |
---|
169 | C CALCUL DU TABLEAU IDEB |
---|
170 | ideb(1)=0 |
---|
171 | do 109 i=2,nmol |
---|
172 | i1=i-1 |
---|
173 | C ICI ******************************* |
---|
174 | C IF(.NOT.QQ(I).AND.MODE.EQ.-1) GO TO 109 |
---|
175 | ideb(i)=ideb(i1)+((nbt(i1)+3)/4 + lpq)*nbi(i1) |
---|
176 | 109 continue |
---|
177 | if(mode.eq.1) go to 200 |
---|
178 | 100 continue |
---|
179 | C LECTURE D'UNE RAIE ET STOCKAGE DANS P |
---|
180 | call lgeisa(v,*200) |
---|
181 | if(.not.qq(imol)) go to 100 |
---|
182 | do 205 j=1,kksot |
---|
183 | if(izot.eq.isot(j)) go to 210 |
---|
184 | 205 continue |
---|
185 | go to 100 |
---|
186 | 210 continue |
---|
187 | nis=nbi(imol) |
---|
188 | ntr=nbt(imol) |
---|
189 | ntn=(ntr+3)/4 |
---|
190 | C PRINT *,' NTR1=',NTR |
---|
191 | incr=ntn+lpq |
---|
192 | nsot=incr*nis |
---|
193 | in=-incr+ideb(imol) |
---|
194 | C PRINT *,' IMOL=',IMOL |
---|
195 | C |
---|
196 | C H2O CO2 O3 N2O CO CH4 O2 NO SO2 NO2 NH3 PH3 |
---|
197 | go to (275, 265, 275, 352, 255, 254, 277, 254, 275, 275, 265, 265, |
---|
198 | C HNO3 OH HF HCL HBR HI CLO OCS H2CO C2H6 CH3D C2H2 |
---|
199 | & 254, 254, 255, 255, 255, 255, 254, 352, 260, 254, 254, 254, |
---|
200 | C C2H4 GEH4 HCN C3H8 C2N2 C4H2 HC3N HOCL N2 CH3CL H2O2 H2S |
---|
201 | & 254, 254, 352, 260, 361, 260, 260, 275, 255, 254, 260, 275, |
---|
202 | C HCOOH COF2 SF6 C3H4 HO2 ClONO2 |
---|
203 | & 260, 260, 254, 260, 275, 254 ) imol |
---|
204 | C |
---|
205 | write(isor,3600) pgm,imol,izot |
---|
206 | 3600 format(///' *',a3,'* erreur sur le code molecule'/// |
---|
207 | &9x,'le code molecule ',i4, '/',i3,' n''existe pas dans le catalogu |
---|
208 | &e'///) |
---|
209 | go to 100 |
---|
210 | C |
---|
211 | C H2O - O3 - SO2 - NO2 - HOCL - H2S - HO2 |
---|
212 | C |
---|
213 | 275 continue |
---|
214 | i=0 |
---|
215 | do 276 jj=7,9 |
---|
216 | i=i+1 |
---|
217 | ia(i)=ia(jj) |
---|
218 | ia(i+3)=ia(jj+9) |
---|
219 | 276 continue |
---|
220 | go to 400 |
---|
221 | C |
---|
222 | C O2 |
---|
223 | C |
---|
224 | 277 continue |
---|
225 | i=0 |
---|
226 | do 278 jj=8,9 |
---|
227 | i=i+1 |
---|
228 | ia(i)=ia(jj) |
---|
229 | ia(i+2)=ia(jj+9) |
---|
230 | 278 continue |
---|
231 | C PRINT 999,'IA=',IA |
---|
232 | go to 400 |
---|
233 | C |
---|
234 | C N2O - OCS - HCN |
---|
235 | C |
---|
236 | 352 continue |
---|
237 | i=0 |
---|
238 | do 371 jj=6,9 |
---|
239 | i=i+1 |
---|
240 | ia(i)=ia(jj) |
---|
241 | ia(i+4)=ia(jj+9) |
---|
242 | 371 continue |
---|
243 | C PRINT 999,'IA=',IA |
---|
244 | go to 400 |
---|
245 | C |
---|
246 | C C2H2 - CH4 - CH3D - CH3CL - C2H6 - HNO3 - SF6 - NO - OH - HCN |
---|
247 | C ClONO2 |
---|
248 | C |
---|
249 | 254 continue |
---|
250 | do 291 jj=2,9 |
---|
251 | ia(jj-1)=ia(jj) |
---|
252 | 291 continue |
---|
253 | do 292 jj=11,18 |
---|
254 | ia(jj-2)=ia(jj) |
---|
255 | 292 continue |
---|
256 | go to 400 |
---|
257 | C |
---|
258 | C CO - N2 - HF - HCL - HBR - HI |
---|
259 | C |
---|
260 | 255 continue |
---|
261 | ia(1)=ia(9) |
---|
262 | ia(2)=ia(18) |
---|
263 | go to 400 |
---|
264 | C |
---|
265 | C H2CO - HC3N - H2O2 - C3H8 - COF2 - C3H4 - HCOOH -C4H2 |
---|
266 | C |
---|
267 | 260 continue |
---|
268 | i=0 |
---|
269 | do 293 jj=4,9 |
---|
270 | i=i+1 |
---|
271 | 293 ia(i)=ia(jj) |
---|
272 | do 294 jj=13,18 |
---|
273 | i=i+1 |
---|
274 | ia(i)=ia(jj) |
---|
275 | 294 continue |
---|
276 | go to 400 |
---|
277 | C |
---|
278 | C C2N2 |
---|
279 | C |
---|
280 | 361 continue |
---|
281 | i=0 |
---|
282 | do 324 jj=3,9 |
---|
283 | i=i+1 |
---|
284 | ia(i)=ia(jj) |
---|
285 | 324 continue |
---|
286 | do 325 jj=12,18 |
---|
287 | i=i+1 |
---|
288 | ia(i)=ia(jj) |
---|
289 | 325 continue |
---|
290 | go to 400 |
---|
291 | C |
---|
292 | C CO2 - NH3 - PH3 |
---|
293 | C |
---|
294 | 265 continue |
---|
295 | i=0 |
---|
296 | do 297 jj=5,9 |
---|
297 | i=i+1 |
---|
298 | 297 ia(i)=ia(jj) |
---|
299 | do 298 jj=14,18 |
---|
300 | i=i+1 |
---|
301 | ia(i)=ia(jj) |
---|
302 | 298 continue |
---|
303 | C PRINT 999,'IA=',IA |
---|
304 | 999 format(1x,a,36a1) |
---|
305 | go to 400 |
---|
306 | C SUITE POUR D'AUTRES MOLECULES |
---|
307 | 400 continue |
---|
308 | do 402 i=1,nsot |
---|
309 | in=in+incr |
---|
310 | in4=in*4 |
---|
311 | k=p(in+ntn+1) |
---|
312 | C IF(IMOL.EQ.11) PRINT *,' K=',K,NSOT |
---|
313 | if(k.eq.0) go to 410 |
---|
314 | if(k.ne.izot) goto 402 |
---|
315 | do 401 j=1,ntr |
---|
316 | if(ia(j).ne.pp(in4 +j)) goto 402 |
---|
317 | 401 continue |
---|
318 | if(imol.ne.7) go to 468 |
---|
319 | if(q(in+ntn+3).le.1000..and.a.gt.1000.) goto 402 |
---|
320 | 468 continue |
---|
321 | p(in+ntn+2)=p(in+ntn+2)+1 |
---|
322 | q(in+ntn+4)=a |
---|
323 | q(in+ntn+5)=amin1(q(in+ntn+5),ai) |
---|
324 | q(in+ntn+6)=amax1(q(in+ntn+6),ai) |
---|
325 | q(in+ntn+7)=q(in+ntn+7)+ai |
---|
326 | go to 100 |
---|
327 | 402 continue |
---|
328 | go to 700 |
---|
329 | 410 continue |
---|
330 | C IF(IMOL.EQ.11) |
---|
331 | C &PRINT *,' NB ',PP(IN+NTN+2),' PP=',(PP(IN4+J-1+KL),KL=1,NTR) |
---|
332 | do 415 j =1,ntr |
---|
333 | pp(in4 +j)=ia(j) |
---|
334 | C IF(IMOL.EQ.11) PRINT *,' IA2',IA(J),' PP=',PP(IN4+J) |
---|
335 | 415 continue |
---|
336 | 1 format(1x,a,i10,a,10a1) |
---|
337 | p(in+ntn+1)=izot |
---|
338 | p(in+ntn+2)=1 |
---|
339 | q(in+ntn+3)=a |
---|
340 | q(in+ntn+4)=a |
---|
341 | q(in+ntn+5)=ai |
---|
342 | q(in+ntn+6)=ai |
---|
343 | q(in+ntn+7)=ai |
---|
344 | go to 100 |
---|
345 | 200 continue |
---|
346 | C ICI ************************************************************** |
---|
347 | if(mode.ne.0.or.modif.ne.oui) go to 420 |
---|
348 | read (iuni,rec=1) |
---|
349 | &nu1,nu2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4 |
---|
350 | c print *, |
---|
351 | c &nu1,nu2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4 |
---|
352 | c modif 03.04.97 calcul ll1 (nb pistes) obsolete |
---|
353 | ll1=kp/lre + 1 |
---|
354 | c ll1=0 |
---|
355 | c print *, ll1,kp,lre |
---|
356 | c print *,nu1,nu2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4 |
---|
357 | write(iuni,rec=1) |
---|
358 | &nu1,nu2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4 |
---|
359 | ll1=kp/lre + 1 |
---|
360 | ki=1 |
---|
361 | kf=lre |
---|
362 | do 416 i=1,ll1 |
---|
363 | if(i.eq.ll1) kf=kp |
---|
364 | c print *,ifin,ki,kf,(p(j),j=ki,kf) |
---|
365 | write(iuni,rec=ifin) ki,kf,(p(j),j=ki,kf) |
---|
366 | ki=ki+lre |
---|
367 | kf=kf+lre |
---|
368 | ifin=ifin+1 |
---|
369 | 416 continue |
---|
370 | 420 continue |
---|
371 | if(mode.ne.1) go to 430 |
---|
372 | do 425 i=1,ll1 |
---|
373 | read (iuni,rec=ifin) ki,kf,(p(j),j=ki,kf) |
---|
374 | ifin=ifin+1 |
---|
375 | 425 continue |
---|
376 | 430 continue |
---|
377 | C |
---|
378 | C IMPRESSION DES RESULTATS PAR MOLECULE |
---|
379 | C |
---|
380 | kk=1 |
---|
381 | do 620 ii=1,nmol |
---|
382 | ch5=bl |
---|
383 | ch6=bl |
---|
384 | if(ii.eq.34) ch5='l' |
---|
385 | if(ii.eq.37) ch5='h' |
---|
386 | if(ii.eq.42) ch5='o' |
---|
387 | if(ii.eq.42) ch6='2' |
---|
388 | lid=0 |
---|
389 | kn=nq(kk) |
---|
390 | kk=kk+kn+1 |
---|
391 | if(.not.qq(ii)) go to 620 |
---|
392 | ki=kk-kn |
---|
393 | kf=kk-1 |
---|
394 | bc=cs |
---|
395 | if(kn.eq.1) bc=bl |
---|
396 | nis=nbi(ii) |
---|
397 | ntr=nbt(ii) |
---|
398 | ntn=(ntr+3)/4 |
---|
399 | incr=ntn+lpq |
---|
400 | nsot=incr*nis |
---|
401 | in=-incr+ideb(ii) |
---|
402 | C PRINT*,' NTR2=',NTR,' NBI(II)=',NBI(II),' NBT(II)=',NBT(II) |
---|
403 | C PRINT*,' LPQ=',LPQ,' NSOT=',NSOT,' IN=',IN,' IDEB(II=',IDEB(II) |
---|
404 | kis=0 |
---|
405 | iii=0 |
---|
406 | do 618 i=1,nsot |
---|
407 | in=in+incr |
---|
408 | k=p(in+ntn+1) |
---|
409 | idim=in+ntn+1 |
---|
410 | C PRINT *,IDIM |
---|
411 | if(k.eq.0) go to 619 |
---|
412 | if(iii.ne.0) go to 3995 |
---|
413 | ncoef=blanc |
---|
414 | C IF(II.LE.7.OR.II.EQ.11.OR.II.EQ.23.OR.II.EQ.24) NCOEF=BLANC |
---|
415 | if(code(ii).eq.'h2o ') write(isor,4033) |
---|
416 | 4033 format(////) |
---|
417 | write(isor,4000) ii,code(ii),ch5,ch6,bc,(nq(j),j=ki,kf) |
---|
418 | 4000 format(////1x,i2.2,') molecule : ',a4,a1,a1, |
---|
419 | C &2X,'4<N> ',A3,' AVAILABLE )', |
---|
420 | &2x,'quantum number',a1, ' : ',10a4) |
---|
421 | write(isor,3990) |
---|
422 | 3990 format(5x,8('*'),11x,15('*')/) |
---|
423 | 3995 continue |
---|
424 | lid=lid+1 |
---|
425 | CBB passage des energies en double precision |
---|
426 | qq3=q(in+ntn+5)*(1./cor) |
---|
427 | qq4=q(in+ntn+6)*(1./cor) |
---|
428 | qq5=q(in+ntn+7)*(1./cor) |
---|
429 | c qq7=q(in+ntn+7)*coeff*(1./cor) |
---|
430 | qq7=dble(q(in+ntn+7))*dble(coeff)*(1./dble(cor)) |
---|
431 | CBB fin |
---|
432 | C |
---|
433 | go to (620, 2,620, 4,620, 6,620, 8, 9, 10,620, 12,620, 14, |
---|
434 | & 620, 16, 17, 18,620,620,620,620,620,620,620,620),ntr |
---|
435 | C |
---|
436 | C NTR=2 CO HF HCL HBR HI N2 |
---|
437 | C |
---|
438 | 2 continue |
---|
439 | if(iii.eq.0) write(isor,4001) |
---|
440 | 4001 format(6x,' ident ',3x,'nb.lines',4x,2he',2x,3he'',3x, |
---|
441 | &3x,'nu.min',7x,'nu.max',8x,'min.i',8x,'max.i',12x,'sum.i'/ |
---|
442 | &92x,10('-'),5x,10('-')/92x,'cm molec-1 cm-2 atm-1'/) |
---|
443 | write(isor,5001) lid, |
---|
444 | &code(ii),ch5,ch6,k,p(in+ntn+2),(pp(in*4+j),j=1,ntr), |
---|
445 | &(q(in+ntn+2+j),j=1,2),qq3,qq4,qq5,qq7 |
---|
446 | 5001 format(1x,i4,')',a4,a1,a1,'/',i3,2x,i6,6x,a1,3x,a1,1x, |
---|
447 | &f12.3,1x,f12.3,1x,1pd12.3,1x,1pd12.3,1x,1pd12.3,2x,1pd12.3) |
---|
448 | go to 615 |
---|
449 | C |
---|
450 | C NTR=4 O2 |
---|
451 | C |
---|
452 | 4 continue |
---|
453 | if(iii.eq.0) write(isor,4002) |
---|
454 | 4002 format(6x,' ident ',3x,'nb.lines',3x,1x,2he',2x,3he'',3x, |
---|
455 | &3x,'nu.min',7x,'nu.max',8x,'min.i',8x,'max.i',12x,'sum.i'/ |
---|
456 | &1x,091x,10('-'),5x,10('-')/1x,091x,'cm molec-1 cm-2 atm-1'/) |
---|
457 | write(isor,5002) lid, |
---|
458 | &code(ii),ch5,ch6,k,p(in+ntn+2),(pp(in*4+j),j=1,ntr), |
---|
459 | &(q(in+ntn+2+j),j=1,2),qq3,qq4,qq5,qq7 |
---|
460 | C |
---|
461 | C OLD VERSION PRESENTATION DES TRANS EN A1 ET A3 AU LIEU DE A2 A2 |
---|
462 | C |
---|
463 | C5002 FORMAT(1X,I4,')',A4,A1,'/',I3,2X,I6,6X,1X,A1,2X,3A1,1X, |
---|
464 | C |
---|
465 | 5002 format(1x,i4,')',a4,a1,a1,'/',i3,2x,i6,6x,2a1,3x,2a1,1x, |
---|
466 | &f12.3,1x,f12.3,1x,1pd12.3,1x,1pd12.3,1x,1pd12.3,2x,1pd12.3) |
---|
467 | go to 615 |
---|
468 | C |
---|
469 | C NTR=6 H2O O3 SO2 NO2 HOCL H2S HO2 |
---|
470 | C |
---|
471 | 6 continue |
---|
472 | if(iii.eq.0) write(isor,4003) |
---|
473 | 4003 format(6x,' ident ',3x,'nb.lines',3x,3x,2he',5x,3he'',5x, |
---|
474 | &3x,'nu.min',7x,'nu.max',8x,'min.i',8x,'max.i',12x,'sum.i'/ |
---|
475 | &1x,098x,10('-'),5x,10('-')/1x,098x,'cm molec-1 cm-2 atm-1'/) |
---|
476 | write(isor,5003) lid, |
---|
477 | &code(ii),ch5,ch6,k,p(in+ntn+2),(pp(in*4+j),j=1,ntr), |
---|
478 | &(q(in+ntn+2+j),j=1,2),qq3,qq4,qq5,qq7 |
---|
479 | 5003 format(1x,i4,')',a4,a1,a1,'/',i3,2x,i6,6x,2x,3a1,1x,3x,1x,3a1,2x, |
---|
480 | &f12.3,1x,f12.3,1x,1pd12.3,1x,1pd12.3,1x,1pd12.3,2x,1pd12.3) |
---|
481 | go to 615 |
---|
482 | C |
---|
483 | C NTR=8 N2O OCS HCN |
---|
484 | C |
---|
485 | 8 continue |
---|
486 | if(iii.eq.0) write(isor,4004) |
---|
487 | 4004 format(6x,' ident ',3x,'nb.lines',3x,3x,2he',9x,3he'',2x,3x, |
---|
488 | &3x,'nu.min',7x,'nu.max',8x,'min.i',8x,'max.i',12x,'sum.i'/ |
---|
489 | &1x,102x,10('-'),5x,10('-')/1x,102x,'cm molec-1 cm-2 atm-1'/) |
---|
490 | write(isor,5004) lid, |
---|
491 | &code(ii),ch5,ch6,k,p(in+ntn+2),(pp(in*4+j),j=1,ntr), |
---|
492 | &(q(in+ntn+2+j),j=1,2),qq3,qq4,qq5,qq7 |
---|
493 | 5004 format(1x,i4,')',a4,a1,a1,'/',i3,2x,i6,6x,2x,4a1,2x,3x,2x,4a1,2x, |
---|
494 | &f12.3,1x,f12.3,1x,1pd12.3,1x,1pd12.3,1x,1pd12.3,2x,1pd12.3) |
---|
495 | go to 615 |
---|
496 | C |
---|
497 | C NTR=9 |
---|
498 | C |
---|
499 | 9 continue |
---|
500 | if(iii.eq.0) write(isor,4005) |
---|
501 | 4005 format(6x,' ident ',3x,'nb.lines',3x,1x,2he',5x,3he'',1x,3x, |
---|
502 | &3x,'nu.min',7x,'nu.max',8x,'min.i',8x,'max.i',12x,'sum.i'/ |
---|
503 | &1x,095x,10('-'),5x,10('-')/1x,095x,'cm molec-1 cm-2 atm-1'/) |
---|
504 | write(isor,5005) lid, |
---|
505 | &code(ii),ch5,ch6,k,p(in+ntn+2),(pp(in*4+j),j=1,ntr), |
---|
506 | &(q(in+ntn+2+j),j=1,2),qq3,qq4,qq5,qq7 |
---|
507 | 5005 format(1x,i4,')',a4,a1,a1,'/',i3,2x,i6,6x,4a1,3x,4a1,a1, |
---|
508 | &f12.3,1x,f12.3,1x,1pd12.3,1x,1pd12.3,1x,1pd12.3,2x,1pd12.3) |
---|
509 | go to 615 |
---|
510 | C |
---|
511 | C NTR=10 CO2 NH3 PH3 |
---|
512 | C |
---|
513 | 10 continue |
---|
514 | if(iii.eq.0) write(isor,4006) |
---|
515 | 4006 format(6x,' ident ',3x,'nb.lines',3x,5x,2he',9x,3he'',4x,3x, |
---|
516 | &3x,'nu.min',7x,'nu.max',8x,'min.i',8x,'max.i',12x,'sum.i'/ |
---|
517 | &1x,106x,10('-'),5x,10('-')/1x,106x,'cm molec-1 cm-2 atm-1'/) |
---|
518 | write(isor,5006) lid, |
---|
519 | &code(ii),ch5,ch6,k,p(in+ntn+2),(pp(in*4+j),j=1,ntr), |
---|
520 | &(q(in+ntn+2+j),j=1,2),qq3,qq4,qq5,qq7 |
---|
521 | 5006 format(1x,i4,')',a4,a1,a1,'/',i3,2x,i6,6x,3x,5a1,2x,3x,2x,5a1,3x, |
---|
522 | &f12.3,1x,f12.3,1x,1pd12.3,1x,1pd12.3,1x,1pd12.3,2x,1pd12.3) |
---|
523 | go to 615 |
---|
524 | C |
---|
525 | C NTR=12 H2CO HC3N H2O2 C3H8 COF2 C3H4 HCOOH C4H2 |
---|
526 | C |
---|
527 | 12 continue |
---|
528 | if(iii.eq.0) write(isor,4007) |
---|
529 | 4007 format(6x,' ident ',3x,'nb.lines',4x,3x,2he',9x,3he'',2x,3x, |
---|
530 | &3x,'nu.min',7x,'nu.max',8x,'min.i',8x,'max.i',12x,'sum.i'/ |
---|
531 | &1x,102x,10('-'),5x,10('-')/1x,102x,'cm molec-1 cm-2 atm-1'/) |
---|
532 | write(isor,5007) lid, |
---|
533 | &code(ii),ch5,ch6,k,p(in+ntn+2),(pp(in*4+j),j=1,ntr), |
---|
534 | &(q(in+ntn+2+j),j=1,2),qq3,qq4,qq5,qq7 |
---|
535 | 5007 format(1x,i4,')',a4,a1,a1,'/',i3,2x,i6,7x,6a1,5x,6a1,1x, |
---|
536 | &f12.3,1x,f12.3,1x,1pd12.3,1x,1pd12.3,1x,1pd12.3,2x,1pd12.3) |
---|
537 | go to 615 |
---|
538 | C |
---|
539 | C NTR=14 C2N2 |
---|
540 | C |
---|
541 | 14 continue |
---|
542 | if(iii.eq.0) write(isor,4007) |
---|
543 | write(isor,5008) lid, |
---|
544 | &code(ii),ch5,ch6,k,p(in+ntn+2),(pp(in*4+j),j=1,ntr), |
---|
545 | &(q(in+ntn+2+j),j=1,2),qq3,qq4,qq5,qq7 |
---|
546 | 5008 format(1x,i4,')',a4,a1,a1,'/',i3,2x,i6,7x,7a1,4x,7a1, |
---|
547 | &f12.3,1x,f12.3,1x,1pd12.3,1x,1pd12.3,1x,1pd12.3,2x,1pd12.3) |
---|
548 | go to 615 |
---|
549 | C |
---|
550 | C NTR=16 |
---|
551 | C CH4 NO HNO3 OH CLO C2H6 CH3D C2H2 C2H4 GEH4 CH3CL SF6 ClONO2 |
---|
552 | C |
---|
553 | 16 continue |
---|
554 | if(iii.eq.0) write(isor,4007) |
---|
555 | write(isor,5009) lid, |
---|
556 | &code(ii),ch5,ch6,k,p(in+ntn+2),(pp(in*4+j),j=1,ntr), |
---|
557 | &(q(in+ntn+2+j),j=1,2),qq3,qq4,qq5,qq7 |
---|
558 | 5009 format(1x,i4,')',a4,a1,a1,'/',i3,2x,i6,6x,8a1,3x,8a1, |
---|
559 | &f12.3,1x,f12.3,1x,1pd12.3,1x,1pd12.3,1x,1pd12.3,2x,1pd12.3) |
---|
560 | go to 615 |
---|
561 | C NTR=17 C2H2 |
---|
562 | 17 continue |
---|
563 | if(iii.eq.0) write(isor,4007) |
---|
564 | write(isor,5010) lid, |
---|
565 | &code(ii),ch5,ch6,k,p(in+ntn+2),(pp(in*4+j),j=1,ntr), |
---|
566 | &(q(in+ntn+2+j),j=1,2),qq3,qq4,qq5,qq7 |
---|
567 | 5010 format(1x,i4,')',a4,a1,a1,'/',i3,2x,i6,5x,9a1,3x,8a1, |
---|
568 | &f12.3,1x,f12.3,1x,1pd12.3,1x,1pd12.3,1x,1pd12.3,2x,1pd12.3) |
---|
569 | go to 615 |
---|
570 | C NTR=18 CLO |
---|
571 | 18 continue |
---|
572 | if(iii.eq.0) write(isor,4007) |
---|
573 | write(isor,5012) lid, |
---|
574 | &code(ii),ch5,ch6,k,p(in+ntn+2),(pp(in*4+j),j=1,ntr), |
---|
575 | &(q(in+ntn+2+j),j=1,2),qq3,qq4,qq5,qq7 |
---|
576 | 5012 format(1x,i4,')',a4,a1,a1,'/',i3,2x,i6,5x,9a1,3x,9a1, |
---|
577 | &f12.3,1x,f12.3,1x,1pd12.3,1x,1pd12.3,1x,1pd12.3,2x,1pd12.3) |
---|
578 | go to 615 |
---|
579 | C |
---|
580 | C SUITE ............ |
---|
581 | 615 continue |
---|
582 | iii=1 |
---|
583 | kis=kis+p(in+ntn+2) |
---|
584 | 618 continue |
---|
585 | 619 continue |
---|
586 | if(kis.ne.0) write(isor,699) kis |
---|
587 | 699 format(1x,17x,6('-')/1x,3x,'total : ',6x,i6) |
---|
588 | 620 continue |
---|
589 | go to 900 |
---|
590 | 700 continue |
---|
591 | write(isor,777) code(imol),izot,ia,v(1) |
---|
592 | 777 format(///' *trs* erreur transition vibrationnelle'/ |
---|
593 | &9x,a4,'/',i3,5x,36a1///' les calculs sont arretes a la transi |
---|
594 | &tion : ',f15.6//) |
---|
595 | go to 200 |
---|
596 | 900 continue |
---|
597 | return 1 |
---|
598 | end |
---|