View of /offline/atlsim/atgeant/agvoluma.age

* $Id: agvoluma.age,v 1.2 2001/12/17 16:33:41 nevski Exp $
* $Name:  $
* $Log: agvoluma.age,v $
* Revision 1.2  2001/12/17 16:33:41  nevski
* add commons/config where needed
*
* Revision 1.1  2001/12/17 15:51:22  nevski
* service routines
*
#include "commons/config.h"
***********************************************************************
 function agvoluma(node,vol,pos,mot,who,copy,lpar,npar,name,nick)
*
* Description: Navigate geant volume tree and extract volume parameters
*
* Input:         node - iterator handler, starting from 0
*                       if negative, starting volume number(in GVOLU bank)
* Output (c-implied):
*  Int who            - volume number (in GVOLU bank)
*  Int name           - actual volume name
*  Int nick           - generic volume name
*  Int copy           - position copy number
*  Pointer (vol,volu) - Volu bank
*  Pointer (mot,moth) - mother molu bank
*  Pointer (pos,posu) - position bank
*  Pointer (lpar,par) - actual volume parameters
*  Int Npar           - number of actual parameters
*
************************************************************************
#include "commons/typing.inc"
#include "geant321/gcbank.inc"
#include "geant321/gcvolu.inc"
#include "geant321/gcunit.inc"

 Integer AGVOLUMA,LOCB,node,vol,pos,mot,who,copy,npar,np,ish
 Integer k,n,mother,daughter,where,found,ier,nvol
 Integer item(20),count(20),list(20),nodes(0:20),
         Lnam(20),Lnum(20),Lvol(20),birth(64000)
 Integer name,nick,lpar
 real    par(100)
 save    k,mother,daughter,where,found,birth,par
 save    item,count,list,nodes,Lnam,Lnum,Lvol

 agvoluma=0; check JVOLUM>0
 If node<=0
 {
   "first generation" found=0; call vzero(birth,64000)
   { k, where, who, copy } =1;
   if (node<0) who=-node;
   { list(1), item(1), count(1), nodes(0) } =0;
   nvol=0; if (JVOLUM>0) nvol=IQ(JVOLUM-1);
   if (Nvol<=0)   { print *,'no geometry loaded'; return }
   if (Nvol>64000)  print *,'agvoluma error: too manu volumes in geometry'
   write (*,'(3a,i7)') ' converting ',IQ(JVOLUM+1),' NV=',nvol
 }
 else
 { *** print *,' next generation '
   nodes(k)=node;
   n=Q(daughter+3); if (n<0) n=-Q(3+LQ(daughter-1));
   if n!=0 { k+=1; count(k)=n; item(k)=0; list(k)=daughter; }
   :next:;  item(k)+=1;  mother=list(k);
   if item(k)>abs(count(k))
   { k-=1; birth(Lvol(k))+=1; if (k>1) go to :next:; node=nodes(1); return }
   if count(k)>0 { where=LQ(mother-item(k)); copy=Q(where+3); }
   else          { where=LQ(mother-1);       copy=item(k);    }
   who=Q(where+2);
 }
   daughter=LQ(JVOLUM-who); found+=1;
   vol=LOCB(Q(daughter+1)); np=Q(daughter+5); ish=Q(daughter+2);
   pos=LOCB(Q(where+1));
   mot=0; if k>1 { mot=LOCB(Q(mother+1)) }
   node=nodes(k-1); agvoluma=1;
   Lnam(k)=IQ(JVOLUM+who); Lnum(k)=copy; Lvol(k)=who;
   Call GLVOLU(k,Lnam, Lnum, ier)

* have to check JGPAR later
   if np==0  { npar=Q(where+9); call UCOPY (Q(where+10),par,npar)  }
   else      { npar=np; call UCOPY (Q(LQ(JGPAR-Nlevel)+1),par,np)  }

   IF      ISH==4       " trap "
   {  NPAR=11
      call AgXY2RF(PAR(2),PAR(3));  call AgT2A(PAR(7));  call AgT2A(PAR(11))
   }
   ELSE IF ISH==10      " par "
   {  call AgXY2RF(PAR(5),PAR(6));  call AgT2A(PAR(4)) }
   ELSE IF ISH==28
   {  NPAR=12  }

* set complete description into parameters
   lpar=LOCB(par)                 " actual parameters address  "
   name=Lnam(k)                   " actual volume name (4 let) "
   nick=IQ(daughter-4)            " generic volume name(4 let) "

   if (k>1 & birth(Lvol(k-1))>0) node=0;
*   if (k<1) print *,' found objects =',found;
end