| 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 |
|---|
