[1] | 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 |
---|