Page MenuHomeHEPForge
Files F9501489

y_axis.f
No OneTemporary
Actions

y_axis.f
View Options

SUBROUTINE EXEC(IINPUT,ILOG,IAUDIT,IPRINT,IDUMP)
character*320 ctemp,ctemp2
c
jtab =ident(8HTABLE ,5)
jlo =ident(12HLOOP-OVER ,9)
jnv =ident(4HN ,1)
jv =ident(4HV ,1)
jy =ident(4HY ,1)
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)
call tabcon(intab,nlo,iyn,multx,nnlast,ny,mult2,nsimple)
c== ready to go
c== we have:
c== irec : record number
c== ntab : table number
c== nlo : number of loop-overs
c== iyn : loop-over number of YN
c== multx : multiplicity of 'Ys'
c== nnlast: multiplivity of last loop-over (effectly the X multiplcity)
c== ny : number of Y points
c== mult2 : multilpicity of an individuial loop-over???
c== nsimple: 1 --> multx = 1 & nnlast = 1
c== nsimple: 2 --> multx > 1 & nnlast = 1
c== nsimple: 3 --> multx = 1 & nnlast > 1
c== nsimple: 4 --> multx > 1 & nnlast > 1
c== nsimple: 5 --> multiple tables
c== optionally choose selected sets of records with nsimple
if(nsimple.lt.5) then
c if(nsimple.eq.4) then
cc if(iyn.eq.nlo) then
c== go through all the loop-over (except the last)
do klo=1,nlo-1
c== omit the YN loop-over
cc if(klo.ne.iyn) then
c== count the N and V multiplicites of the loop-over (ioccn , ioccv
ioccn=0
do while(in(jnv,ioccn+1,in(jlo,klo,intab)).gt.0)
ioccn=ioccn+1
enddo
ioccv=0
do while(in(jv,ioccv+1,in(jlo,klo,intab)).gt.0)
ioccv=ioccv+1
enddo
c== if ioccn = ioccv (then either 1 or N.s etc)
if(ioccn.eq.ioccv) then
iocc=0
do while(in(jnv,iocc+1,in(jlo,klo,intab)).gt.0)
iocc=iocc+1
call getch(jnv,iocc,in(jlo,klo,intab),ctemp,len,ierr)
call getch(jv,iocc,in(jlo,klo,intab),ctemp2,len2,ierr)
iycol = 0
c print *,irec,ntab,iycol,' '
c + ,ctemp(1:len),' ',ctemp2(1:len2)
if(iycol.gt.0) then
if(klo.ne.iyn) then
write(6,1000)irec,ntab,iycol,';',' ',';'
+ ,(ctemp(j:j),j=1,len),';',(ctemp2(j:j),j=1,len2),';'
1000 format(1x,i6,';',i3,';',i3,320a1)
else
write(6,1000)irec,ntab,iycol,';'
+ ,(ctemp2(j:j),j=1,len2),';',' ',';',' ',';'
endif
endif
enddo
c== or else if ioccn = 1
else if(ioccn.eq.1) then
call getch(jnv,ioccn,in(jlo,klo,intab),ctemp,len,ierr)
ioccv=0
do while(in(jv,ioccv+1,in(jlo,klo,intab)).gt.0)
ioccv=ioccv+1
call getch(jv,ioccv,in(jlo,klo,intab),ctemp2,len2,ierr)
c print *,irec,ntab,ioccv,' '
c + ,ctemp(1:len),' ',ctemp2(1:len2)
if(ioccv.gt.0) then
if(klo.ne.iyn) then
write(6,1000)irec,ntab,ioccv,';',' ',';'
+ ,(ctemp(j:j),j=1,len),';',(ctemp2(j:j),j=1,len2),';'
else
write(6,1000)irec,ntab,ioccv,';'
+ ,(ctemp2(j:j),j=1,len2),';',' ',';',' ',';'
endif
endif
enddo
c== or else
else
nv = ioccv/ioccn
joccn=0
do while(in(jnv,joccn+1,in(jlo,klo,intab)).gt.0)
joccn=joccn+1
call getch(jnv,joccn,in(jlo,klo,intab),ctemp,len,ierr)
do jj = 1,nv
joccv = (jj-1)*ioccn+joccn
call getch(jv,joccv,in(jlo,klo,intab),ctemp2,len2,ierr)
c print *,irec,ntab,jj,' '
c + ,ctemp(1:len),' ',ctemp2(1:len2)
if(jj.gt.0) then
if(klo.ne.iyn) then
write(6,1000)irec,ntab,jj,';',' ',';'
+ ,(ctemp(j:j),j=1,len),';',(ctemp2(j:j),j=1,len2)
else
write(6,1000)irec,ntab,jj,';'
+ ,(ctemp2(j:j),j=1,len2),';',' ',';',' ',';'
endif
endif
enddo
enddo
endif
c== end of YN ommission loop
cc endif
c== end of go round loop-over loop
enddo
cc endif
endif
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
Sun, Feb 23, 2:30 PM (22 h, 4 m)
Storage Engine
blob
Storage Format
Raw Data
Storage Handle
4482568
Default Alt Text
y_axis.f (4 KB)

Event Timeline