| 1 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * |
|---|
| 2 | C SUBROUTINE QUI RECHERCHE LES MOLECULES ET ISOTOPES A CHOISIR |
|---|
| 3 | C (QQ(J),J=1,NMOL) QQ(J)=.TRUE. MOLECULE J A RETENIR |
|---|
| 4 | C =.FALSE. MOLECULE NON CHOISIE |
|---|
| 5 | C (P(J),J=1,1000) P(J)=.TRUE. ISOTOPE J A RETENIR |
|---|
| 6 | C =.FALSE. ISOTOPE J NON CHOISI |
|---|
| 7 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * |
|---|
| 8 | C |
|---|
| 9 | C LAST MODIF : 07.05.1991 PASSAGE DE 40 MOLECULES A 75 DANS LES COMMON |
|---|
| 10 | C |
|---|
| 11 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * |
|---|
| 12 | C |
|---|
| 13 | subroutine molis(p,qq,*) |
|---|
| 14 | C |
|---|
| 15 | character*9 trs1,trs2 |
|---|
| 16 | character*7 form,bin |
|---|
| 17 | character*4 mole,ctlg,code,blanc |
|---|
| 18 | character*3 iopt,pgm,ianl,iext,itrs,ilst,icop,info,icre, |
|---|
| 19 | & modif,oui,liste,trans |
|---|
| 20 | character*2 ikod,icod |
|---|
| 21 | real nu1,nu2 |
|---|
| 22 | integer vers |
|---|
| 23 | logical*1 p (1),qq(1) |
|---|
| 24 | C |
|---|
| 25 | common/p1/ nu1,nu2,dnu,nbclas,khist,kanal,vers,mode,liste |
|---|
| 26 | common/p2/ mole(75),isot(100),nbi(75),nbt(75),iopt,ctlg,trans, |
|---|
| 27 | & trs1,trs2 |
|---|
| 28 | common/p3/ imole,iran,ival,pgm,ianl,iext,itrs,ilst,icop,info,icre |
|---|
| 29 | common/p4/ nmol,knmol,ksot,kksot,ntab,nhist,kp,lre,form,bin,modif |
|---|
| 30 | common/p5/ code(75),nn(150),nq(150),ikod(18),icod(18),jdeb(75) |
|---|
| 31 | common/entsor/iuni,juni,kuni,ient,isor,iper,nresv,maxx,blanc,oui |
|---|
| 32 | C |
|---|
| 33 | C KAN=0 ANL-HISTO 1 MOLECULE ET 1 ISOTOPE |
|---|
| 34 | C KAN=1 ANL-HISTO 1 MOLECULE |
|---|
| 35 | iarr=0 |
|---|
| 36 | C POUR CRE NE PAS FAIRE DE TESTS SUR MOLE ET ISOT |
|---|
| 37 | C POUR COP INCLURE TOUTES LES MOLECULES |
|---|
| 38 | if(liste.eq.ctlg) go to 100 |
|---|
| 39 | if(liste.eq.iopt) go to 150 |
|---|
| 40 | if(pgm.eq.icre) go to 100 |
|---|
| 41 | nzot=0 |
|---|
| 42 | kan=0 |
|---|
| 43 | iran=2 |
|---|
| 44 | do 5 i=1,nmol |
|---|
| 45 | qq(i)=.false. |
|---|
| 46 | 5 continue |
|---|
| 47 | do 6 i=1,ntab |
|---|
| 48 | 6 p(i)=.false. |
|---|
| 49 | c print *,' knmol=',knmol |
|---|
| 50 | if(knmol.ne.0) go to 20 |
|---|
| 51 | if(kksot.eq.0) go to 10 |
|---|
| 52 | iarr=1 |
|---|
| 53 | write(isor,1000) pgm |
|---|
| 54 | 1000 format(///' *',a3,'* mole parameter must be specified'///) |
|---|
| 55 | go to 100 |
|---|
| 56 | 10 continue |
|---|
| 57 | C CAS DE TOUTES LES MOLECULES ET TOUS LES ISOTOPES |
|---|
| 58 | do 15 i=1,nmol |
|---|
| 59 | qq(i)=.true. |
|---|
| 60 | kk=jdeb(i) |
|---|
| 61 | ki=kk+1 |
|---|
| 62 | kf=kk+nn(kk) |
|---|
| 63 | do 15 j=ki,kf |
|---|
| 64 | nzot=nzot+1 |
|---|
| 65 | isot(nzot)=nn(j) |
|---|
| 66 | p(nn(j))=.true. |
|---|
| 67 | 15 continue |
|---|
| 68 | if(pgm.eq.info) return |
|---|
| 69 | go to 40 |
|---|
| 70 | 20 continue |
|---|
| 71 | C CAS MOLE#0 |
|---|
| 72 | do 22 i=1,knmol |
|---|
| 73 | do 21 k=1,nmol |
|---|
| 74 | if(mole(i).eq.code(k)) qq(k)=.true. |
|---|
| 75 | 21 continue |
|---|
| 76 | 22 continue |
|---|
| 77 | c print *,'qq=',(qq(kkk),kkk=1,nmol) |
|---|
| 78 | if(kksot.ne.0) go to 25 |
|---|
| 79 | C CAS DE MOLE#0 ET ISOT=0 |
|---|
| 80 | kan=1 |
|---|
| 81 | do 24 i=1,nmol |
|---|
| 82 | if(.not.qq(i)) go to 24 |
|---|
| 83 | kk=jdeb(i) |
|---|
| 84 | ki=kk+1 |
|---|
| 85 | kf=kk+nn(kk) |
|---|
| 86 | do 23 j=ki,kf |
|---|
| 87 | nzot=nzot+1 |
|---|
| 88 | isot(nzot)=nn(j) |
|---|
| 89 | p(nn(j))=.true. |
|---|
| 90 | 23 continue |
|---|
| 91 | 24 continue |
|---|
| 92 | go to 40 |
|---|
| 93 | 25 continue |
|---|
| 94 | C CAS DE MOLE#0 ET ISOT#0 |
|---|
| 95 | do 29 i=1,nmol |
|---|
| 96 | if(.not.qq(i)) go to 29 |
|---|
| 97 | kk=jdeb(i) |
|---|
| 98 | ki=kk+1 |
|---|
| 99 | kf=kk+nn(kk) |
|---|
| 100 | n1=0 |
|---|
| 101 | do 27 k=1,kksot |
|---|
| 102 | do 26 j=ki,kf |
|---|
| 103 | if(nn(j).ne.isot(k)) go to 26 |
|---|
| 104 | n1=n1+1 |
|---|
| 105 | p (nn(j))=.true. |
|---|
| 106 | 26 continue |
|---|
| 107 | 27 continue |
|---|
| 108 | if(n1.ne.0) go to 29 |
|---|
| 109 | do 28 j=ki,kf |
|---|
| 110 | p (nn(j))=.true. |
|---|
| 111 | 28 continue |
|---|
| 112 | 29 continue |
|---|
| 113 | C MISE DES ISOTOPES AU DEBUT DU TABLEAU ISOT |
|---|
| 114 | do 30 j=1,ksot |
|---|
| 115 | isot(j)=0 |
|---|
| 116 | 30 continue |
|---|
| 117 | do 35 j=1,ntab |
|---|
| 118 | if(.not.p (j)) go to 35 |
|---|
| 119 | nzot=nzot+1 |
|---|
| 120 | isot(nzot)=j |
|---|
| 121 | 35 continue |
|---|
| 122 | 40 continue |
|---|
| 123 | kksot=nzot |
|---|
| 124 | knmol=0 |
|---|
| 125 | do 45 i=1,nmol |
|---|
| 126 | if(.not.qq(i)) go to 45 |
|---|
| 127 | knmol=knmol+1 |
|---|
| 128 | 45 continue |
|---|
| 129 | C POUR EXT ,TRS ET KANAL=1(ANAL='OUI') KNMOL>=1 |
|---|
| 130 | C POUR INF AVEC ANAL='OUI' OU TRANS='OUI' |
|---|
| 131 | if(pgm.eq.ianl.and.knmol.eq.1.or.pgm.eq.ilst) go to 50 |
|---|
| 132 | if(pgm.eq.iext.or.pgm.eq.itrs.or.pgm.eq.icop.or.kanal.eq.1 |
|---|
| 133 | &.or.mode.eq.1) go to 100 |
|---|
| 134 | C POUR ANL ET HISTO UNE SEULE MOLECULE |
|---|
| 135 | iarr=1 |
|---|
| 136 | write(isor,2000) pgm |
|---|
| 137 | 2000 format(///' *',a3,'* choosen a molecule'///) |
|---|
| 138 | go to 100 |
|---|
| 139 | 50 continue |
|---|
| 140 | if(pgm.eq.ianl.and.kan.eq.1) go to 55 |
|---|
| 141 | if(pgm.eq.ianl.and.kksot.eq.1) go to 55 |
|---|
| 142 | if(pgm.eq.ilst.and.knmol*kksot.eq.1) go to 55 |
|---|
| 143 | iarr=1 |
|---|
| 144 | write(isor,3000) pgm |
|---|
| 145 | 3000 format(///' *',a3,'* choosen a molecule and an isotope'///) |
|---|
| 146 | go to 100 |
|---|
| 147 | 55 continue |
|---|
| 148 | do 57 i=1,nmol |
|---|
| 149 | if(qq(i)) go to 58 |
|---|
| 150 | 57 continue |
|---|
| 151 | 58 continue |
|---|
| 152 | ival=i |
|---|
| 153 | imole=i |
|---|
| 154 | if(kan.eq.1) go to 100 |
|---|
| 155 | iran=1 |
|---|
| 156 | ival=isot(1) |
|---|
| 157 | 100 continue |
|---|
| 158 | 150 continue |
|---|
| 159 | return |
|---|
| 160 | end |
|---|
