| 1 | C SORTIE DE CERTAINS RENSEIGNEMENTS SUR LA |
|---|
| 2 | C SPECTROSCOPIC DATA BANK |
|---|
| 3 | C |
|---|
| 4 | C SANS AUCUN PARAMETRE SORTIE DES FREQUENCES MOLECULES ET DU CODAGE |
|---|
| 5 | C DE LA VERSION LA PLUS RECENTE |
|---|
| 6 | C LISTE='CTLG' IMPRESSION DU CATALOGUE DE LA BANQUE(ENTRE NU1-NU2) |
|---|
| 7 | C SI NU1 ET NU2 OMIS TOUT LE CATALOGUE |
|---|
| 8 | C LISTE='OPT' LISTE DES OPTIONS DISPONIBLES |
|---|
| 9 | C |
|---|
| 10 | C ANAL='OUI' SORTIE DES FREQUENCES MOLECULES-ISOTOPES (SANS LECTURE |
|---|
| 11 | C DE LA BANQUE) |
|---|
| 12 | C |
|---|
| 13 | C TRANS='OUI' SORTIE DES TRANSITIONS (SANS LECTURE DE LA BANQUE) |
|---|
| 14 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * |
|---|
| 15 | C |
|---|
| 16 | C LAST MODIF : 06.05.1991 PASSAGE DE 40 MOLECULES A 75 DANS LES COMMON |
|---|
| 17 | C LAST MODIF : 04.12.1996 PASSAGE DE 42 MOLECULES A 75 DANS LES COMMON |
|---|
| 18 | C |
|---|
| 19 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * |
|---|
| 20 | subroutine infor(pp,ia) |
|---|
| 21 | C |
|---|
| 22 | logical*1 pp(1) |
|---|
| 23 | character*44 fmt |
|---|
| 24 | character*9 trs1,trs2 |
|---|
| 25 | character*7 form,bin |
|---|
| 26 | character*4 code,ctlg,mole,blanc,coli6 |
|---|
| 27 | character*3 pgm,ianl,iext,itrs,ilst,icop,info,icre, |
|---|
| 28 | & oui,iopt,liste,iasr,remp,supp,ajou,modif,trans |
|---|
| 29 | character*2 icod,ikod |
|---|
| 30 | character*1 moins,slash,bl,ch5,ch6 |
|---|
| 31 | integer ia(1),vers,nbtr(75) |
|---|
| 32 | real nu1,nu2,vnu(4) |
|---|
| 33 | C |
|---|
| 34 | common/p1/ nu1,nu2,dnu,nbclas,khist,kanal,vers,mode,liste |
|---|
| 35 | common/p2/ mole(75),isot(100),nbi(75),nbt(75),iopt,ctlg,trans, |
|---|
| 36 | & trs1,trs2 |
|---|
| 37 | common/p3/ imole,iran,ival,pgm,ianl,iext,itrs,ilst,icop,info,icre |
|---|
| 38 | common/p4/ nmol,knmol,ksot,kksot,ntab,nhist,kp,lre,form,bin,modif |
|---|
| 39 | common/p5/ code(75),nn(150),nq(150),ikod(18),icod(18),jdeb(75) |
|---|
| 40 | common/p6/ iasr,remp,supp,ajou,imp8,imp9,in40,in41,in42,in43,n97 |
|---|
| 41 | common/entsor/iuni,juni,kuni,ient,isor,iper,nresv,maxx,blanc,oui |
|---|
| 42 | C |
|---|
| 43 | data vnu/0. ,0. ,0. ,0. / |
|---|
| 44 | data moins,slash,bl/'-','/',' '/ |
|---|
| 45 | C DATA NBTR91 |
|---|
| 46 | C & / 49296, 60948,168881, 24125, 13205, 40514, 2254, 7385, 23659, |
|---|
| 47 | C & 55468, 6784, 4635,143021, 8676, 107, 371, 398, 237, |
|---|
| 48 | C & 6020, 4171, 2702, 8944, 6457, 1258, 203, 824, 2575, |
|---|
| 49 | C & 9019, 2577, 1405, 2027, 15565, 117, 6687, 5444, 4058, |
|---|
| 50 | C & 3388, 18242, 11520, 3390, 35*0/ |
|---|
| 51 | data nbtr /75*0/ |
|---|
| 52 | c & / 50217, 62816,281607, 26771, 13515, 66883, 6292, 94738, 38853, |
|---|
| 53 | c & 100680, 11152, 4635,171504, 41786, 107, 533, 576, 237, |
|---|
| 54 | c & 7230, 24922, 2702, 14981, 11524, 1668, 12978, 824, 2575, |
|---|
| 55 | c & 9019, 2577, 1405, 2027, 15565, 117, 9355,100781, 20788, |
|---|
| 56 | c & 3388, 54866, 11520, 3390, 26963, 32199, 33*0/ |
|---|
| 57 | data fmt/'(27x,a4,a1,a1,i10,7x,a1, (i3,a1), x,i6)'/ |
|---|
| 58 | include 'database_name.h' |
|---|
| 59 | c ivers=(vers-97)*40 |
|---|
| 60 | c jvers=(vers-97)*2 |
|---|
| 61 | ivers=0 |
|---|
| 62 | jvers=0 |
|---|
| 63 | len=ltrim(filename_bin) |
|---|
| 64 | open(111,file=filename_bin(1:len)//'.info') |
|---|
| 65 | do ijk=1,15 |
|---|
| 66 | read(111,*) |
|---|
| 67 | enddo |
|---|
| 68 | read(111,'(31x,f09.3,6x,f10.3,14x,i7)') vnu(1),vnu(2),nblinestot |
|---|
| 69 | do i=1,nmol |
|---|
| 70 | read(111,*) |
|---|
| 71 | read(111,*) |
|---|
| 72 | read(111,*) rmoyi,rmaxi,alphamoy,nbtr(i) |
|---|
| 73 | write(*,*) nbtr(i) |
|---|
| 74 | enddo |
|---|
| 75 | 1003 format(2x,1pd9.3,1x,1pd9.3,1x,1pe9.3,1x,i7) |
|---|
| 76 | if(liste.eq.iopt) go to 50 |
|---|
| 77 | if(liste.eq.ctlg) go to 40 |
|---|
| 78 | C |
|---|
| 79 | C IMPRESSIONS DES FREQUENCES MOLECULES DE LA BANQUE VERSION VERS |
|---|
| 80 | C |
|---|
| 81 | write(isor,3000) vers,pgm,pgm |
|---|
| 82 | 3000 format(1x,17('*'),98x,17('*')/1x,'* geisa geisa *', |
|---|
| 83 | &36x,'spectroscopic data bank GEISA',i2.2,31x, |
|---|
| 84 | &'* geisa geisa *'/' *',6x,a3,6x,'*',98x,'*',6x,a3,6x,'*'/ |
|---|
| 85 | &' * geisa geisa *',98x,'* geisa geisa *'/, |
|---|
| 86 | &1x,17('*'),98x,17('*')) |
|---|
| 87 | liste=iopt |
|---|
| 88 | write(isor,3010) |
|---|
| 89 | 3010 format (/27x,'molecules code ',7x,'isotopes', |
|---|
| 90 | &25x,'number of transitions'/ |
|---|
| 91 | &27x,'--------- ---- ',7x,8('-'),25x,'------ -- -----------'/) |
|---|
| 92 | kt=0 |
|---|
| 93 | do 35 i=1,nmol |
|---|
| 94 | nbtri=nbtr(ivers+i) |
|---|
| 95 | kt=kt+nbtri |
|---|
| 96 | kk=jdeb(i) |
|---|
| 97 | ki=kk+1 |
|---|
| 98 | kf=kk+nn(kk) |
|---|
| 99 | jj=0 |
|---|
| 100 | do 33 j=ki,kf |
|---|
| 101 | if(.not.pp(nn(j)))go to 33 |
|---|
| 102 | jj=jj+1 |
|---|
| 103 | ia(jj)=nn(j) |
|---|
| 104 | 33 continue |
|---|
| 105 | j1=jj-1 |
|---|
| 106 | fmt(26:27)=icod(jj) |
|---|
| 107 | icoli6=42-4*jj+1 |
|---|
| 108 | write(coli6,'(i4.4)')icoli6 |
|---|
| 109 | fmt(37:38)=coli6(3:4) |
|---|
| 110 | C |
|---|
| 111 | C AJOUT DU 5EME et (6eme) CARACTERE DES MOLECULES CH3CL,HCOOH, CLONO2 |
|---|
| 112 | ch5=bl |
|---|
| 113 | ch6=bl |
|---|
| 114 | if(i.eq.34) ch5='l' |
|---|
| 115 | if(i.eq.37) ch5='h' |
|---|
| 116 | if(i.eq.42) ch5='o' |
|---|
| 117 | if(i.eq.42) ch6='2' |
|---|
| 118 | C************RAJOUT DE ,nbtri A LA FIN DE CHAQUE TEST************ |
|---|
| 119 | if(jj.ne.1) |
|---|
| 120 | &write(isor,fmt)code(i),ch5,ch6,i,slash,(ia(j),moins,j=1,j1), |
|---|
| 121 | &ia(jj),slash,nbtri |
|---|
| 122 | if(jj.eq.1) write(isor,fmt) code(i),ch5,ch6,i,slash,ia(jj),slash |
|---|
| 123 | &,nbtri |
|---|
| 124 | 35 continue |
|---|
| 125 | write(isor,3030) kt,kt,vnu(jvers+1),vnu(jvers+2) |
|---|
| 126 | 3030 format(94x,'------'/86x,'total=',i8//27x,'the bank contains ', |
|---|
| 127 | &i8,' lines in the spectral range', |
|---|
| 128 | &2x,'nu1=',f10.4,' and nu2=',f10.4) |
|---|
| 129 | if(liste.eq.oui) write(isor,4000) |
|---|
| 130 | 4000 format(//40x,'(a) wavenumber (cm-1)'/ |
|---|
| 131 | &40x,'(b) intensity (cm molec-1 at 296 k)'/ |
|---|
| 132 | &40x,'(c) collision halfwidth (cm-1 atm-1)'/ |
|---|
| 133 | &40x,'(d) energy of the lower level of the transition (cm-1)'/ |
|---|
| 134 | &40x,'(e) identification of the transition'/ |
|---|
| 135 | &40x,'(f) coefficient for temperature dependence of halfwidth'/ |
|---|
| 136 | &40x,'(g) identification of the isotope'/ |
|---|
| 137 | &40x,'(h) identification of the molecule'/ |
|---|
| 138 | &40x,'(i) geisa internal code for data identification'/) |
|---|
| 139 | go to 100 |
|---|
| 140 | 40 continue |
|---|
| 141 | C |
|---|
| 142 | C LISTE CATALOGUE |
|---|
| 143 | call pgeisa(0.,99999.) |
|---|
| 144 | read (iuni,rec=1) |
|---|
| 145 | &aa1,aa2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4 |
|---|
| 146 | vers=ll3 |
|---|
| 147 | write(isor,3000) vers,pgm,pgm |
|---|
| 148 | ipp=ifin-1 |
|---|
| 149 | if(nu1.eq.-1.) nu1=aa1 |
|---|
| 150 | if(nu2.eq.-1.) nu2=aa2 |
|---|
| 151 | write(isor,4100) nbraie,aa1,aa2,ipp,anu,n203,vers,nu1,nu2 |
|---|
| 152 | 4100 format(//1x,'the bank contains',i8,' raies comprises entre nu1 |
|---|
| 153 | &=',f12.3,' et nu2=',f10.3//' le nombre de records reellement occup |
|---|
| 154 | &ees est de : ',i4,' records'// ' les transitions figurent dans la |
|---|
| 155 | & banque par groupes de ',f4.0,' cm-1 dans un format chaine' |
|---|
| 156 | &//' chaque record comprend au maximum ',i4,' raies'// |
|---|
| 157 | &/1x, 'liste du catalogue d |
|---|
| 158 | &e GEISA',i2,3x,'pour les blocks tels que : ',f10.3,' < nu < ', |
|---|
| 159 | &f10.3/1x,29('*')//1x,23x,'block lu',22x,5x,3x,'block precedent', |
|---|
| 160 | & 3x,5x,4x,'block suivant',4x/24x,8('*'),30x,15('*'),12x,13('*') |
|---|
| 161 | &//' numero nombre de raies premiere raie derniere raie nume |
|---|
| 162 | &ro derniere raie numero premiere raie ligne total/grou |
|---|
| 163 | &pe'/1x, '------ |
|---|
| 164 | & ------ -- ----- -------- ---- -------- ---- ------ ------ |
|---|
| 165 | &-- ---- ------ -------- ---- ----- ------------') |
|---|
| 166 | write(isor,4101) nbmol |
|---|
| 167 | 4101 format(' cette banque contient : ',i2,' molecules'/) |
|---|
| 168 | kk=0 |
|---|
| 169 | kkk=0 |
|---|
| 170 | iecr1=int(aa2/anu) + 2 - int(aa1/anu) |
|---|
| 171 | i=0 |
|---|
| 172 | iadr=int(nu1/anu) + 2 - int(aa1/anu) |
|---|
| 173 | 45 continue |
|---|
| 174 | i=i+1 |
|---|
| 175 | ilec=iadr |
|---|
| 176 | read (iuni,rec=ilec) iadr,jadr,k,a1,a2,a3,v1 |
|---|
| 177 | C |
|---|
| 178 | C GEISA90 : 16 -> 29 |
|---|
| 179 | C |
|---|
| 180 | k=k/29 |
|---|
| 181 | write(isor,4200) ilec,k,v1,a3,jadr,a2,iadr,a1,i |
|---|
| 182 | 4200 format(1x,i5,8x,i3,8x,f12.6,3x,f12.6,6x,i5,3x,f12.6,6x,i5,3x,f12.6 |
|---|
| 183 | &,6x,i4) |
|---|
| 184 | kk=kk+k |
|---|
| 185 | kkk=kkk+k |
|---|
| 186 | if(iadr.gt.iecr1) go to 49 |
|---|
| 187 | write(isor,4201) kk |
|---|
| 188 | 4201 format(116x,3x,i9) |
|---|
| 189 | kk=0 |
|---|
| 190 | 49 continue |
|---|
| 191 | if(nu2.gt.a1) go to 45 |
|---|
| 192 | write(isor,4201) kk |
|---|
| 193 | write(isor,4202) kkk |
|---|
| 194 | 4202 format(1x,115x,6x,'------'/1x,113x,'total : ',i6) |
|---|
| 195 | return |
|---|
| 196 | 50 continue |
|---|
| 197 | C |
|---|
| 198 | C LISTE DES OPTIONS |
|---|
| 199 | write(isor,3000) vers,pgm,pgm |
|---|
| 200 | write(isor,5000) |
|---|
| 201 | 5000 format(//51x,'list of available options in GEISA software ', |
|---|
| 202 | &//26x,82('*')) |
|---|
| 203 | write(isor,5005) |
|---|
| 204 | 5005 format(26x,'* &geisa pgm=''anl'',nu1,nu2,dnu,mole,anal / ' |
|---|
| 205 | &,34x,'*'/ |
|---|
| 206 | &26x,'* &geisa pgm=''anl'',nu1,nu2,dnu,mole,isot,histo,nbclas / |
|---|
| 207 | & ',18x,'*'/26x,'*',80x,'*') |
|---|
| 208 | write(isor,5010) |
|---|
| 209 | 5010 format(26x,'* &geisa pgm=''cop'',nu1,nu2 /',53x,'*' |
|---|
| 210 | &/26x,'*',80x,'*') |
|---|
| 211 | write(isor,5015) |
|---|
| 212 | 5015 format(26x,'* &geisa pgm=''cre'',format,juni /',49x, |
|---|
| 213 | &'*'/26x,'*',80x,'*') |
|---|
| 214 | write(isor,5020) |
|---|
| 215 | 5020 format(26x,'* &geisa pgm=''ext'',nu1,nu2,mole,isot,liste,format,ju |
|---|
| 216 | &ni / ',21x,'*'/26x,'*',80x,'*') |
|---|
| 217 | write(isor,5025) |
|---|
| 218 | 5025 format(26x,'* &geisa pgm=''inf'' /',61x,'*') |
|---|
| 219 | write(isor,5026) |
|---|
| 220 | 5026 format(26x,'* &geisa pgm=''inf'',liste=''opt'' / ',44x,'*') |
|---|
| 221 | write(isor,5030) |
|---|
| 222 | 5030 format(26x,'* &geisa pgm=''lst'',nu1,nu2,mole,isot,liste,format,ju |
|---|
| 223 | &ni,iuni / ',15x,'*'/26x,'*',80x,'*') |
|---|
| 224 | write(isor,5035) |
|---|
| 225 | 5035 format(26x,'* &geisa pgm=''trs'',nu1,nu2,mole,iuni /',43x,'*') |
|---|
| 226 | write(isor,5050) |
|---|
| 227 | 5050 format(26x,82('*')) |
|---|
| 228 | liste=' ' |
|---|
| 229 | 100 continue |
|---|
| 230 | return |
|---|
| 231 | end |
|---|
