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

*
* $Id: axposition.age,v 1.2 2001/12/14 18:15:07 nevski Exp $
*
* $Name:  $
*
* ------------------------------------------------------
#include <commons/config.h>
**********************************************************************
*                                                                    *
                 Subroutine   A x P O S I T I O N
*                                                                    *
*  Description:  make GSPOS or GSPOSP                                *
*  Modifications:                                     28.07.95 - PLN *
*  - Start with the mother volume checking to allow fake positioning *
*    divisions.   No checks are done yet for an errenious            *
*    normal volume positioning at the same level as divisions ...    *
*  - 14.11.96 PN+SB: Ncopy can be passed throu AGECOM in both ways   *
**********************************************************************
#include "commons/typing.inc"
#include "commons/agecom.inc"
#include "geant321/gcbank.inc"
#include "geant321/gcunit.inc"
#include "geant321/gcnum.inc"
#include "geant321/gcflag.inc"
#include "geant321/gcvolu.inc"
  Character*4 Daughter,Daught;
  Integer  LENOCC,Idaught,Ivd,Jvd,Ivo,Jvo,Ign,Jvm,Ivm,
           Npo,Npa,Jmo,in,nin,Ncopy,Id,Jd,Jg,IDH,IDM,igsame

* search for the mother, if it is explicitely defined, and check it.
  If %Ivolume<=0 | %Mother!=%Volume
  {  %Cnick=%Mother;  Call GLOOK(%Mother,IQ(JVOLUM+1),Nvolum,%Ivolume);
     If %Ivolume<=0
     {  If %Level>0  {%error('mother volume does not exist')};
        <w> %Mother; (' Warning: Volume ',a4,' does not exist'); Return;
     }
     Jvm=LQ(JVOLUM-%Ivolume); Ivm=IQ(Jvm-5); IDM=IQ(Jvm-4);
     IF IDM==IQ(JVOLUM+%Ivolume) & 1<=Ivm&Ivm<=Nvolum
     { %Ivolume=Ivm; call UHTOC(IQ(JVOLUM+Ivm),4,%Cnick,4); }
  }
  Jmo=LQ(JVOLUM-%Ivolume); Ivm=IQ(Jmo-5); nin=Q(Jmo+3);
  If nin<0         " should check names to give the diagnostic !"
  { "%error('volume ',%Cnick,' has both divisions and content')"; return; }

  If Q(Jmo+1)==-99 & %Level>1 & %Ncopy==0
  { prin1 %mother,%cnick,Ivm;
    (' mother ',2a5,' copy ',i6,' was already positioned, skip filling ')
    return
  }

* get Active volume number from the generic bank IDN word;
  Daughter=%Title;  Call GLOOK (Daughter,IQ(JVOLUM+1),Nvolum,Ivd);
  If Ivd<=0   {%error('daughter ',Daughter,' does not exist ')};
  " generic daughter "  IDH=IQ(JVOLUM+Ivd); Jvd=LQ(JVOLUM-Ivd);
  Ivo=IQ(Jvd-5);  If Ivo<=0 {%error('Actual daughter does not exist ')};
  " its nickname "  Idaught=IQ(JVOLUM+Ivo); Jvo=LQ(JVOLUM-Ivo);
  " and number   "  Ign=0;    If (Ivd#Ivo)  Ign=IQ(Jvo-5);

* get actual rotation and may be shape parameters
  %Ishape=Q(Jvo+2);  Npo=Q(Jvo+5);  Npa=0;
  Call AgSROTM " - it may cause bank relocation, links should be reaccessed !"
  If Npo=0
  {  Call AgSHAPE;      Npa=%Npar;
     If %Npar=0  {%error('Can not position undefined Volume ',Daughter)}
  }

* set copy number(generic) and avoid content (actual name!) dublication

  Ncopy=max(1,%Ncopy);  Jmo=LQ(JVOLUM-%Ivolume);
  do in=nin,1,-1
  {  Jd=LQ(Jmo-in); "its content" Id=Q(Jd+2); "and address" Jg=LQ(JVOLUM-Id);
     "count copies of generic name" Check IDH=IQ(Jg-4);

     If Idaught=IQ(JVOLUM+Id) & %Irot=Q(jd+4) & Igsame(%x,Q(Jd+5),3)>0
     {  " dont position same volumes at the same place and angle "
        if (Npo>0 | Igsame(%Par,Q(jd+10),Npa)>0) goto :done:
     }
     If Q(jd+3)==%Ncopy
     {  prin0 Idaught,IQ(JVOLUM+id),%Ncopy
        (' Warning: volumes ',a4,' and ',a4,' both have copy number',i6)
     }
     if(%Ncopy<=0) Ncopy+=1;
  }

  Call UHTOC(Idaught,4,Daught,4);   Call CLTOU (%KONLY);
  If Npo>0 { Call GSPOS (Daught,Ncopy,%CNick,%X,%Y,%Z,%Irot,%KONLY); }
  else     { Call GSPOSP(Daught,Ncopy,%CNick,%X,%Y,%Z,%Irot,%KONLY,
                                                         %PAR, %NPAR);  }
  prin1 Daught,Daughter,%CNick,%Volume,%x,%y,%z,
        %Level,Ncopy,Npa,%IROT,Ivd,Ivo,nin;
  (' POSITION',2(1x,A4),'  into',2(1x,A4),' at x,y,z=',3f9.3/_
  10x,'level',i3,'  Ncopy',i4,' with Npar,Irot=',2i4,' Ivdau,Ivact=',3I5);
  Q(LQ(JVOLUM-Ivo)+1)=-99;

:done: %Ncopy=Ncopy;
  " keep GCVOLUM updated  - still does not work"
  Nlevel=%Level+1;  Names(Nlevel)=Idaught;  Number(Nlevel)=%Ncopy;
   END

   function Igsame(x,y,n)
   real     x(n),y(n)
   Igsame = 0
   do i=1,n { if (x(i)!=y(i)) return; }
   Igsame = 1
   end