Page MenuHomeHEPForge
Files F11221841

get_obs.f
No OneTemporary
Actions

get_obs.f
View Options

SUBROUTINE EXEC(IINPUT,ILOG,IAUDIT,IPRINT,IDUMP)
character*320 ctemp,ctemp2
c
jtab =ident(8HTABLE ,5)
jtky =ident(12HTABLE-KEYS ,10)
jobs =ident(4HOBS ,3)
jdb =ident(8HDBNAME ,6)
irec=0
10 irec=irec+1
call fetch(irec,ierr)
if(ierr.eq.0) then
call getch(jdb,1,0,ctemp,len,ierr)
if(ierr.eq.0.and.index(ctemp(1:2),'DB').eq.0) then
ntab = 0
c == loop through all tables
do while(in(jtab,ntab+1,0).gt.0)
ntab=ntab+1
intab=in(jtab,ntab,0)
kocc=0
do while(in(jtky,kocc+1,intab).gt.0)
kocc=kocc+1
iocc=0
do while(in(jobs,iocc+1,in(jtky,kocc,intab)).gt.0)
iocc=iocc+1
call getch(jobs,iocc,in(jtky,kocc,intab),ctemp2,len2,ierr)
len1=0
len=0
do while (len1.lt.len2)
len1=len1+1
if(ctemp2(len1:len1).ne.'(' .and.
+ ctemp2(len1:len1).ne.')') then
len=len+1
ctemp(len:len)=ctemp2(len1:len1)
endif
enddo
i = index(ctemp(1:len),'POLN')
if(i.gt.0) len = i+2
i = index(ctemp(1:len),'FACTORN')
if(i.gt.0) len = i+2
i = index(ctemp(1:len),'FACTOR/')
if(i.gt.0) len = i+2
if(ctemp(1:6).eq.'1/SIG*') then
ctemp2(1:len-6)=ctemp(7:len)
len=len-6
ctemp(1:len)=ctemp2(1:len)
endif
if(ctemp(1:4).eq.'1/N*') then
ctemp2(1:len-4)=ctemp(5:len)
len=len-4
ctemp(1:len)=ctemp2(1:len)
endif
if(ctemp(1:3).eq.'1./') then
ctemp2(1:len-3)=ctemp(4:len)
len=len-3
ctemp(1:len)=ctemp2(1:len)
endif
if(ctemp(1:2).eq.'1/') then
ctemp2(1:len-2)=ctemp(3:len)
len=len-2
ctemp(1:len)=ctemp2(1:len)
endif
if(ctemp(1:5).eq.'WIDTH') len=5
if(ctemp(1:6).eq.'ALPHAS') len=6
if(ctemp(1:11).eq.'C-PARAMETER') len=7
if(ctemp(1:3).eq.'AMP') len=3
if(ctemp(1:3).eq.'CKM') len=3
if(ctemp(1:2).eq.'F2') len=2
if(ctemp(1:2).eq.'F3') len=2
if(ctemp(1:4).eq.'ASYM') len=4
if(ctemp(1:4).eq.'<PT>') then
len=8
ctemp(1:len)='MEANN=PT'
endif
if(ctemp(1:9).eq.'MEANNAME=') then
ctemp2(1:6)='MEANN='
ctemp2(6:len-3)=ctemp(10:len)
len=len-3
ctemp(1:len)=ctemp2(1:len)
endif
if(ctemp(1:5).eq.'MEANN'.and.ctemp(6:6).ne.'=') then
ctemp2(1:6)='MEANN='
ctemp2(7:len+1)=ctemp(6:len)
len=len+1
ctemp(1:len)=ctemp2(1:len)
endif
if(ctemp(1:7).eq.'AVERAGE') then
if(ctemp(8:8).eq.'N') then
ctemp2(1:4)='MEAN'
ctemp2(5:len-3)=ctemp(8:len)
len=len-3
ctemp(1:len)=ctemp2(1:len)
else if(ctemp(8:8).eq.' ') then
ctemp2(1:6)='MEANN='
ctemp2(7:len-2)=ctemp(9:len)
len=len-2
ctemp(1:len)=ctemp2(1:len)
else
ctemp2(1:6)='MEANN='
ctemp2(7:len-1)=ctemp(8:len)
len=len-1
ctemp(1:len)=ctemp2(1:len)
endif
endif
if(ctemp(1:10).eq.'CONSTNAME=') then
ctemp2(1:7)='CONSTN='
ctemp2(8:len-3)=ctemp(11:len)
len=len-3
ctemp(1:len)=ctemp2(1:len)
endif
if(ctemp(len:len).eq.' ') len=len-1
write(6,'(i6,i4,150a1)')irec,ntab,' ',(ctemp(j:j),j=1,len)
c write(6,'(150a1)')(ctemp(j:j),j=1,len)
enddo
enddo
enddo
endif
else if(ierr.eq.3) then
c print *,irec,'error 3'
else if(ierr.eq.2) then
go to 999
endif
go to 10
999 continue
stop
end

File Metadata

Mime Type
text/x-fortran
Expires
Wed, May 14, 10:58 AM (23 h, 18 m)
Storage Engine
blob
Storage Format
Raw Data
Storage Handle
5048656
Default Alt Text
get_obs.f (3 KB)

Event Timeline