c GETPHY, a modification of RESPHY to simply examine and retrieve c label.PHY data. All queries and writes removed. c c Michael Shaffer, University of Oregon, April 1991 c c c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc C C Reading the label.phy file and doing some printing C c input argument c c LEG : dimension parameter c c output arguments c a : atomic weight c aint : absolute primary intensity c aj : mean ionization potential c ajst : mean ionization potential (compound standard) c air : compound standard to pure intensity ratio c ast : atomic weight (compound standard) c bkst : backscattering factor (compound standard) c c : weight fraction c cst : weight fraction (compound standard) c eo : acceleration voltage (for each experimental condition) c eoi : acceleration voltage (for each element) c esp : fluorescence enhancement parameter c sym : atom symbol c syst : atom symbol (compound standard) c idx : application {l1,..,l(nb)} -> {1,..,nb} c according to D-H-Z sorting c itab : compound standard number c nv : valence c lna : xray line ascii code c nec : number of companions in the coumpound standard c nz : atomic number c nzst : (compound standard) c oxcpd : chemical formula c std : standard name c exci : excitation voltage c csc : cosecant of the take off angle c irf : number of records c isw : integer analysis mode c isws : integer submode of st and ge c if isws>0 -> extra anion c ndd : pointer to a record c nel : total number of elements in the unknown c na : number of measured elements c na1 : number of measured elements under condition no.1 c ncs : number of elements compared to a compound standard c ntab : number of different compound standards c preint : test for full computation c igr : species (geo) group number c nbox : number of oxygen (geo) c nbh2o : number of H2O c nex : if nex=1 : one extra element is inserted c nb : number of computed elements (oxygen excluded) c subroutine GETPHY(a,aint,aj,ajst,air,ast,bkst,c,cst,eo,eoi,esp &,sym,syst,idx,itab,nv,lna,nec,nz,nzst,oxcpd,std,exci,csc,irf,isw &,isws,LEG,ndd,nel,na,na1,ncs,ntab,preint,igr,nbox,nbh2o,nex,nb) character*2 sym(LEG),syst(LEG,LEG),lna(LEG) character*9 std(LEG) character*10 oxcpd(LEG) character*1 rq logical*1 list dimension aint(LEG),eoi(LEG),nec(LEG),ajst(LEG,LEG),ast(LEG,LEG) &,bkst(LEG,LEG),cst(LEG,LEG),nzst(LEG,LEG),exci(LEG) dimension a(LEG),aj(LEG),air(LEG),c(LEG),idx(LEG),itab(LEG) &,nv(LEG),nz(LEG),eo(2),esp(2) common/lui/lu5,lu6,lu7,lu2 c list=.false. 20 ir2=1 read(unit=lu2,rec=ir2) na,nel,ncs,csc,ndd,isw,na1,ntab &,(eo(i),i=1,2),(esp(i),i=1,2),preint,irf,igr,nbox,nbh2o,nex,isws c d write(lu7,7000) nbh2o d7000 format(/' nbh2o-->',i2) 21 do 1 i=1,na ir2=2*i read(unit=lu2,rec=ir2) nz(i),a(i),aj(i),air(i),sym(i),lna(i) &,nd,nec(i),cst(1,i),itab(i),std(i) ir2=2*i+1 read(unit=lu2,rec=ir2) exci(i),aint(i),eoi(i) if(nec(i).ne.0) go to 4 go to 1 4 continue 22 ne=nec(i) do 3 j=1,ne ir2=nd+j-1 read(unit=lu2,rec=ir2) nzst(j+1,i),ast(j+1,i),cst(j+1,i) &,ajst(j+1,i),bkst(j+1,i),syst(j+1,i) 3 continue 1 continue if(nel-na.le.0) go to 5 do 8 i=na+1,nel ir2=2*na+1+i-na read(unit=lu2,rec=ir2) nz(i),a(i),aj(i),sym(i),c(i) 8 continue if(isw.ne.4.and.isw.ne.2.and.isw.ne.7) go to 12 ir2=2*na+2+nel-na read(unit=lu2,rec=ir2) (nv(i),i=1,nel) C C Process oxides C nap=nel-1 if(isw.ne.7) go to 18 if(nbh2o.gt.0) go to 18 if(igr.lt.2.or.igr.gt.7) go to 18 sym(nap)='Fe' nv(nap)=3 18 call oxoto(sym,nv,LEG,oxcpd,nap,nel) d write(lu7,7002) (i,oxcpd(i),i=1,nap) d write(lu6,7002) (i,oxcpd(i),i=1,nap) d7002 format(5x,'oxcpd(',i2,') -> "',a10,'"') if(isw.ne.7) go to 12 nb=nel-1 if(sym(nap).eq.'H') nb=nel-2 call srodhz(nv,nz,idx,LEG,nb) d write(lu7,7001) (i,idx(i),oxcpd(idx(i)),i=1,nel) d write(lu6,7001) (i,idx(i),oxcpd(idx(i)),i=1,nel) d7001 format(' idx(',i2,')=',i2,' oxcpd -> "',a10,'"') 5 CONTINUE 12 return end