C SORTIE DE CERTAINS RENSEIGNEMENTS SUR LA C SPECTROSCOPIC DATA BANK C C SANS AUCUN PARAMETRE SORTIE DES FREQUENCES MOLECULES ET DU CODAGE C DE LA VERSION LA PLUS RECENTE C LISTE='CTLG' IMPRESSION DU CATALOGUE DE LA BANQUE(ENTRE NU1-NU2) C SI NU1 ET NU2 OMIS TOUT LE CATALOGUE C LISTE='OPT' LISTE DES OPTIONS DISPONIBLES C C ANAL='OUI' SORTIE DES FREQUENCES MOLECULES-ISOTOPES (SANS LECTURE C DE LA BANQUE) C C TRANS='OUI' SORTIE DES TRANSITIONS (SANS LECTURE DE LA BANQUE) C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * C C LAST MODIF : 06.05.1991 PASSAGE DE 40 MOLECULES A 75 DANS LES COMMON C LAST MODIF : 04.12.1996 PASSAGE DE 42 MOLECULES A 75 DANS LES COMMON C C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * subroutine infor(pp,ia) C logical*1 pp(1) character*44 fmt character*9 trs1,trs2 character*7 form,bin character*4 code,ctlg,mole,blanc,coli6 character*3 pgm,ianl,iext,itrs,ilst,icop,info,icre, & oui,iopt,liste,iasr,remp,supp,ajou,modif,trans character*2 icod,ikod character*1 moins,slash,bl,ch5,ch6 integer ia(1),vers,nbtr(75) real nu1,nu2,vnu(4) C common/p1/ nu1,nu2,dnu,nbclas,khist,kanal,vers,mode,liste common/p2/ mole(75),isot(100),nbi(75),nbt(75),iopt,ctlg,trans, & trs1,trs2 common/p3/ imole,iran,ival,pgm,ianl,iext,itrs,ilst,icop,info,icre common/p4/ nmol,knmol,ksot,kksot,ntab,nhist,kp,lre,form,bin,modif common/p5/ code(75),nn(150),nq(150),ikod(18),icod(18),jdeb(75) common/p6/ iasr,remp,supp,ajou,imp8,imp9,in40,in41,in42,in43,n97 common/entsor/iuni,juni,kuni,ient,isor,iper,nresv,maxx,blanc,oui C data vnu/0. ,0. ,0. ,0. / data moins,slash,bl/'-','/',' '/ C DATA NBTR91 C & / 49296, 60948,168881, 24125, 13205, 40514, 2254, 7385, 23659, C & 55468, 6784, 4635,143021, 8676, 107, 371, 398, 237, C & 6020, 4171, 2702, 8944, 6457, 1258, 203, 824, 2575, C & 9019, 2577, 1405, 2027, 15565, 117, 6687, 5444, 4058, C & 3388, 18242, 11520, 3390, 35*0/ data nbtr /75*0/ c & / 50217, 62816,281607, 26771, 13515, 66883, 6292, 94738, 38853, c & 100680, 11152, 4635,171504, 41786, 107, 533, 576, 237, c & 7230, 24922, 2702, 14981, 11524, 1668, 12978, 824, 2575, c & 9019, 2577, 1405, 2027, 15565, 117, 9355,100781, 20788, c & 3388, 54866, 11520, 3390, 26963, 32199, 33*0/ data fmt/'(27x,a4,a1,a1,i10,7x,a1, (i3,a1), x,i6)'/ include 'geisafile.h' c ivers=(vers-97)*40 c jvers=(vers-97)*2 ivers=0 jvers=0 len=ltrim(filename_bin) open(111,file=filename_bin(1:len)//'.info') do ijk=1,15 read(111,*) enddo read(111,'(31x,f09.3,6x,f10.3,14x,i7)') & vnu(1),vnu(2),nblinestot do i=1,nmol read(111,*) read(111,*) read(111,1003) rmoyi,rmaxi,alphamoy,nbtr(i) enddo 1003 format(2x,1pd9.3,1x,1pd9.3,1x,1pe9.3,1x,i7) close(111) if(liste.eq.iopt) go to 50 if(liste.eq.ctlg) go to 40 C C IMPRESSIONS DES FREQUENCES MOLECULES DE LA BANQUE VERSION VERS C write(isor,3000) vers,pgm,pgm 3000 format(1x,17('*'),98x,17('*')/1x,'* geisa geisa *', &36x,'spectroscopic data bank GEISA',i2.2,31x, &'* geisa geisa *'/' *',6x,a3,6x,'*',98x,'*',6x,a3,6x,'*'/ &' * geisa geisa *',98x,'* geisa geisa *'/, &1x,17('*'),98x,17('*')) liste=iopt write(isor,3010) 3010 format (/27x,'molecules code ',7x,'isotopes', &25x,'number of transitions'/ &27x,'--------- ---- ',7x,8('-'),25x,'------ -- -----------'/) kt=0 do 35 i=1,nmol nbtri=nbtr(ivers+i) kt=kt+nbtri kk=jdeb(i) ki=kk+1 kf=kk+nn(kk) jj=0 do 33 j=ki,kf if(.not.pp(nn(j)))go to 33 jj=jj+1 ia(jj)=nn(j) 33 continue j1=jj-1 fmt(26:27)=icod(jj) icoli6=42-4*jj+1 write(coli6,'(i4.4)')icoli6 fmt(37:38)=coli6(3:4) C C AJOUT DU 5EME et (6eme) CARACTERE DES MOLECULES CH3CL,HCOOH, CLONO2 ch5=bl ch6=bl if(i.eq.34) ch5='l' if(i.eq.37) ch5='h' if(i.eq.42) ch5='o' if(i.eq.42) ch6='2' C************RAJOUT DE ,nbtri A LA FIN DE CHAQUE TEST************ if(jj.ne.1) &write(isor,fmt)code(i),ch5,ch6,i,slash,(ia(j),moins,j=1,j1), &ia(jj),slash,nbtri if(jj.eq.1) write(isor,fmt) code(i),ch5,ch6,i,slash,ia(jj),slash &,nbtri 35 continue write(isor,3030) kt,kt,vnu(jvers+1),vnu(jvers+2) 3030 format(94x,'------'/86x,'total=',i8//27x,'the bank contains ', &i8,' lines in the spectral range', &2x,'nu1=',f10.4,' and nu2=',f10.4) if(liste.eq.oui) write(isor,4000) 4000 format(//40x,'(a) wavenumber (cm-1)'/ &40x,'(b) intensity (cm molec-1 at 296 k)'/ &40x,'(c) collision halfwidth (cm-1 atm-1)'/ &40x,'(d) energy of the lower level of the transition (cm-1)'/ &40x,'(e) identification of the transition'/ &40x,'(f) coefficient for temperature dependence of halfwidth'/ &40x,'(g) identification of the isotope'/ &40x,'(h) identification of the molecule'/ &40x,'(i) geisa internal code for data identification'/) go to 100 40 continue C C LISTE CATALOGUE call pgeisa(0.,99999.) read (iuni,rec=1) &aa1,aa2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4 vers=ll3 write(isor,3000) vers,pgm,pgm ipp=ifin-1 if(nu1.eq.-1.) nu1=aa1 if(nu2.eq.-1.) nu2=aa2 write(isor,4100) nbraie,aa1,aa2,ipp,anu,n203,vers,nu1,nu2 4100 format(//1x,'the bank contains',i8,' raies comprises entre nu1 &=',f12.3,' et nu2=',f10.3//' le nombre de records reellement occup &ees est de : ',i4,' records'// ' les transitions figurent dans la & banque par groupes de ',f4.0,' cm-1 dans un format chaine' &//' chaque record comprend au maximum ',i4,' raies'// &/1x, 'liste du catalogue d &e GEISA',i2.2,3x,'pour les blocks tels que : ',f10.3,' < nu < ', &f10.3/1x,29('*')//1x,23x,'block lu',22x,5x,3x,'block precedent', & 3x,5x,4x,'block suivant',4x/24x,8('*'),30x,15('*'),12x,13('*') &//' numero nombre de raies premiere raie derniere raie nume &ro derniere raie numero premiere raie ligne total/grou &pe'/1x, '------ & ------ -- ----- -------- ---- -------- ---- ------ ------ &-- ---- ------ -------- ---- ----- ------------') write(isor,4101) nbmol 4101 format(' cette banque contient : ',i2,' molecules'/) kk=0 kkk=0 iecr1=int(aa2/anu) + 2 - int(aa1/anu) i=0 iadr=int(nu1/anu) + 2 - int(aa1/anu) 45 continue i=i+1 ilec=iadr read (iuni,rec=ilec) iadr,jadr,k,a1,a2,a3,v1 C C GEISA90 : 16 -> 29 C k=k/29 write(isor,4200) ilec,k,v1,a3,jadr,a2,iadr,a1,i 4200 format(1x,i5,8x,i3,8x,f12.6,3x,f12.6,6x,i5,3x,f12.6,6x,i5,3x,f12.6 &,6x,i4) kk=kk+k kkk=kkk+k if(iadr.gt.iecr1) go to 49 write(isor,4201) kk 4201 format(116x,3x,i9) kk=0 49 continue if(nu2.gt.a1) go to 45 write(isor,4201) kk write(isor,4202) kkk 4202 format(1x,115x,6x,'------'/1x,113x,'total : ',i6) return 50 continue C C LISTE DES OPTIONS write(isor,3000) vers,pgm,pgm write(isor,5000) 5000 format(//51x,'list of available options in GEISA software ', &//26x,82('*')) write(isor,5005) 5005 format(26x,'* &geisa pgm=''anl'',nu1,nu2,dnu,mole,anal / ' &,34x,'*'/ &26x,'* &geisa pgm=''anl'',nu1,nu2,dnu,mole,isot,histo,nbclas / & ',18x,'*'/26x,'*',80x,'*') write(isor,5010) 5010 format(26x,'* &geisa pgm=''cop'',nu1,nu2 /',53x,'*' &/26x,'*',80x,'*') write(isor,5015) 5015 format(26x,'* &geisa pgm=''cre'',format,juni /',49x, &'*'/26x,'*',80x,'*') write(isor,5020) 5020 format(26x,'* &geisa pgm=''ext'',nu1,nu2,mole,isot,liste,format,ju &ni / ',21x,'*'/26x,'*',80x,'*') write(isor,5025) 5025 format(26x,'* &geisa pgm=''inf'' /',61x,'*') write(isor,5026) 5026 format(26x,'* &geisa pgm=''inf'',liste=''opt'' / ',44x,'*') write(isor,5030) 5030 format(26x,'* &geisa pgm=''lst'',nu1,nu2,mole,isot,liste,format,ju &ni,iuni / ',15x,'*'/26x,'*',80x,'*') write(isor,5035) 5035 format(26x,'* &geisa pgm=''trs'',nu1,nu2,mole,iuni /',43x,'*') write(isor,5050) 5050 format(26x,82('*')) liste=' ' 100 continue return end