subroutine ugeom
c
c  define experimental setup.  write for cebaf HALL a fpp.
c  august 17, 1994 - e.j. brash, rutgers.
c
        implicit none
c
        include 'fpp_local.h'
        include 'geant_local.h'
c
c        include 'parameter.h'
c        include 'espace_type.h'
c        include 'detector.h'
c        include 'transport.h'
c        include 'experiment.h'
c        include 'option.h'
c
        integer nHALL,iv_HALL,irot,irotnull,irotx,irotu,irotv,iv_targ
	integer nair,ncarbon,naira,nairb,nairc,naird
        integer nsci1,nsci2
        integer nsci,nluc
c
        character*4 chnmsv(1),chnamh(6)
c
c  variables used in calls to gstmed (which defines tracking material
c  parameters)

        integer nt_air,nt_carbon, ic, irot1, nt_analyz, nanalyz, nt_ch
        integer nt_sci,nt_luc,ndim,nvac,ncarb2
        integer isvol,ifield,nwbuf,nch
        real fieldm,tmaxfd,dmaxms,deemax,epsil,stmin,ubuf(10)
        real zcarb,zanaly
        real zsci1,zsci2
        real zsci, rotch1(6)
        real zaira, zairb, zairc, zaird
        real zdet
c
        common / gugeompar / irot, irotnull
c
        parameter (ndim=3)
        parameter (nair=15)
        parameter (nvac=15)	
        parameter (nHALL=100)
	parameter (ncarbon=6)
	parameter (naira=602)
	parameter (nairb=603)
	parameter (nairc=604)
	parameter (naird=605)
	parameter (ncarb2=610)
	parameter (nsci1=616)
	parameter (nsci2=617)
	parameter (nluc=625)
	parameter (nsci=626)
        parameter (nch=622)

        real HALL_size(3)
	real carbon_size(3)
	real aira_size(3),airb_size(3),airc_size(3),aird_size(3)
        real sci1_size(3),sci2_size(3),carb2_size(3),analyz_size(3)
        real detect_size(3)
        real nul_rot(6)
        real rotx(6)
        real rotu(6)
        real rotv(6)
        real theta(3),phi(3),rowmat(3)
        real sinth,costh,sinph,cosph
        real rotmat1, rtod
        logical rotate
c
        common/geomstep/rotmat1(3,3) 
c
c --- plastic (lucite) for spacers (c5h8o2) ---
        real ap(3) /12.01,1.01,16./
        real zp(3) /6.,1.,8./
        real wp(3) /5.,8.,2./
        real dp /1.1800/
c --- scintillator NE-102A  ---
        real ane(2) /12.01,1.01/
        real zne(2) /6.,1./
        real wne(2) /1.,1.105/
        real dne /1.0320/
c --- (CH2)2  ---
        real achh(2) /12.01,1.01/
        real zchh(2) /6.,1./
        real wchh(2) /1.,2./
        real dchh /0.9350/
c
c
        integer ihset,ihdet,iset,idet,idtype,nvname,numbv
        common/gcsets/ihset,ihdet,iset,idet,idtype,nvname,numbv(20)
        integer nbitsv(1) /13/
        integer nbitsh(6) /5,6,16,16,18,18/
        real orig(6) /0.,0.,0.,0.,200.,0./
        real fact(6) /1.,1.,1.,100000.,500.,500./
c
        data chnmsv /'strw'/
        data chnamh /'ipla','nhip','strn','dist','ysva','zsva'/
c
c
        data HALL_size / 600., 600., 1000. /
        data nul_rot/ 90.0, 0.0, 90.0, 90.0, 0.0, 0.0 /  !null rotation
        data rotx/ 180.0, 0.0, 90.0, 180.0, 90.0, 90.0 / !95 deg. rot for x-straws
        data rotv/ 180.0, 0.0, 90.0, 135.0, 90.0, 45.0 / !-45 deg. rot for v-straws
        data rotu/ 180.0, 0.0, 90.0, -135.0, 90.0, 135.0 / !45 deg. rot for u-straws
c
        data rotch1/ 90.0, 0.0, 90.0, 90.0, 0.0, 0.0 / !ch1 rotation
c
        data analyz_size/150.0,150.0,10.0/
	data carb2_size/104.50,30.0,0.0/
	data sci1_size/104.50,30.0,0.5/
	data sci2_size/104.50,30.0,0.5/
	data aira_size/104.50,30.0,10.0/
	data airb_size/104.50,30.0,10.0/
	data airc_size/146.05,66.548,10.0/
	data aird_size/146.05,66.548,10.0/
        data detect_size/130.0,130.0,10.0/

        zaira=0.0
        zsci1=zaira+aira_size(3)+sci1_size(3)
        zairb=zsci1+sci1_size(3)+airb_size(3)
        zanaly=zairb+airb_size(3)+analyz_size(3)
        zairc=zanaly+analyz_size(3)+airc_size(3)
        zsci2=zairc+airc_size(3)+sci2_size(3)
        zaird=zsci2+sci2_size(3)+aird_size(3)
        zdet=zaird+aird_size(3)+detect_size(3)
        rtod=180.0/3.14159265
c
        rotmat1(1,1)=cos(psoff1)*cos(thoff1)+sin(psoff1)*sin(thoff1)
     $       *sin(phoff1)
        rotmat1(1,2)=cos(psoff1)*sin(thoff1)-sin(psoff1)*cos(thoff1)
     $       *sin(phoff1)
        rotmat1(1,3)=sin(psoff1)*cos(phoff1)
        rotmat1(2,1)=-cos(phoff1)*sin(thoff1)
        rotmat1(2,2)=cos(phoff1)*cos(thoff1)
        rotmat1(2,3)=sin(phoff1)
        rotmat1(3,1)=-sin(psoff1)*cos(thoff1)+cos(psoff1)*sin(thoff1)
     $       *sin(phoff1)
        rotmat1(3,2)=-sin(psoff1)*sin(thoff1)-cos(psoff1)*cos(thoff1)
     $       *sin(phoff1)
        rotmat1(3,3)=cos(psoff1)*cos(phoff1)
        do ic=1,3
           write(*,*)rotmat1(ic,1),rotmat1(ic,2),rotmat1(ic,3)
        enddo
c
        do ic=1,3
           rowmat(1)=real(rotmat1(ic,1))
           rowmat(2)=real(rotmat1(ic,2))
           rowmat(3)=real(rotmat1(ic,3))
           call gfang(rowmat,costh,sinth,cosph,sinph,rotate)
	   write(*,*)costh,sinth,cosph,sinph
           if(rotate) then
              if(costh.ne.0) then
		theta(ic)=atan(sinth/costh)*rtod
	      else
		if(sinth.gt.0) then
		  theta(ic)=90.0
		else if(sinth.lt.0) then
		  theta(ic)=-90.0
		else
		  theta(ic)=0.0
		endif
	      endif
              if(cosph.ne.0) then
		phi(ic)=atan(sinph/cosph)*rtod
	      else
		if(sinph.gt.0) then
		  phi(ic)=90.0
		else if(sinph.lt.0) then
		  phi(ic)=-90.0
		else
		  phi(ic)=0.0
		endif
	      endif
           else
              theta(ic)=0.0
              phi(ic)=0.0
           endif
           write(6,*)'fpp rotation 1 =',ic,theta(ic),phi(ic)
        enddo
        irot1=5
        call gsrotm(irot1,theta(1),phi(1),theta(2),
     &                        phi(2),theta(3),phi(3))
c     
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c --- define the various mixtures for geant ---
c
      write(6,*)'defining mixtures now'
      call gsmixt(nluc,'lucite$',ap,zp,dp,-3,wp)
      call gsmixt(nsci,'scint$',ane,zne,dne,-2,wne)
c      uncomment next line for density of hydrogen in (CH2)2
c      call gsmate(nhy,'hydr$',     1.01, 1.0, 0.135,  865., 790.,0,0)
c      uncomment next line for normal density of carbon 
c      call gsmate(ncarbo,'carbo$',12.01,6.0, 2.265, 18.8, 80.,0,0)
c      uncomment next line for density of carbon in (CH2)2
c      call gsmate(ncarbo,'carbo$', 12.01,6.0, 0.800, 18.8, 80.,0,0)
c
	write(*,*)'Finished defining these materials'
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c  define the tracking medium parameters
c
      nwbuf=10
c
c *** definition of tracking medium for air:
c
      write(6,*)'defining air medium now'
      nt_air = nvac  ! tracking medium # same as material #
      isvol  = 0     ! not sensitive
      ifield = 0     ! no magnetic field
      fieldm = 0.0   ! max field
      tmaxfd = 0.3   ! maximum angle due to field (one step) in degrees
      dmaxms = 0.5   ! max disp. due to mulsct. in one step (cm)
      deemax = 0.2   ! max fractional energy loss in one step
      epsil  = 0.01  ! tracking precision (cm)
      stmin  = 0.01  ! min step due to e loss or mulsct. (cm)
      ubuf(1)= 0.    ! tracking stop switch
      write(6,*)'calling gstmed'
      call gstmed(nt_air,'HALL$',nvac,isvol,ifield,fieldm,tmaxfd,
     1            dmaxms,deemax,epsil,stmin,ubuf,nwbuf)
      write(6,*)'back from gstmed'
c
c *** definition of tracking medium for carbon:
c     
      write(6,*)'defining carbon medium now'
      nt_carbon = ncarbon  ! tracking medium # same as material #
      isvol  = 0     ! not sensitive
      ifield = 0     ! no magnetic field
      fieldm = 0.0   ! max field
      tmaxfd = 0.3   ! maximum angle due to field (one step) in degrees
      dmaxms = 0.5   ! max disp. due to mulsct. in one step (cm)
      deemax = 0.2   ! max fractional energy loss in one step
      epsil  = 0.01  ! tracking precision (cm)
      stmin  = 0.01  ! min step due to e loss or mulsct. (cm)
      ubuf(1)= 0.    ! tracking stop switch
      write(6,*)'calling gstmed'
      call gstmed(nt_carbon,'HALL$',ncarbon,isvol,ifield,fieldm,tmaxfd,
     1            dmaxms,deemax,epsil,stmin,ubuf,nwbuf)
      write(6,*)'back from gstmed'
c
c *** definition of tracking medium for magnet:
c          
c      nt_mag = nmag  ! tracking medium # same as material number
c      isvol  = 0     ! not sensitive
c      ifield = 2     ! magnetic field defined in gufld.for - helix tracking
c      fieldm = 20.0   ! max field
c      tmaxfd = 0.3   ! maximum angle due to field (one step) in degrees
c      dmaxms = 0.5   ! max disp. due to mulsct. in one step (cm)
c      deemax = 0.2   ! max fractional energy loss in one step
c      epsil  = 0.01  ! tracking precision (cm)
c      stmin  = 0.01  ! min step due to e loss or mulsct. (cm)
c      ubuf(1)= 0.    ! tracking stop switch
c      call gstmed(nt_mag,'magnet$',nvac,isvol,ifield,fieldm,tmaxfd,
c     1            dmaxms,deemax,epsil,stmin,ubuf,nwbuf)
c
c *** definition of tracking medium for pb shielding:
c
c      nt_pb  = npb   ! tracking medium # same as material #
c      isvol  = 1     ! sensitive
c      ifield = 0     ! no magnetic field
c      fieldm = 0.0   ! max field
c      tmaxfd = 0.3   ! maximum angle due to field (one step) in degrees
c      dmaxms = 0.5   ! max disp. due to mulsct. in one step (cm)
c      deemax = 0.2   ! max fractional energy loss in one step
c      epsil  = 0.01  ! tracking precision (cm)
c      stmin  = 0.01  ! min step due to e loss or mulsct. (cm)
c      ubuf(1)= 0.    ! tracking stop switch
c      call gstmed(nt_pb,'HALL$',npb,isvol,ifield,fieldm,tmaxfd,
c     1            dmaxms,deemax,epsil,stmin,ubuf,nwbuf)
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c *** definition of tracking medium for analyzer:
c
      nt_analyz = 630 ! Choose Arbitrary Tracking Medium Number for Analyzer 
      isvol  = 1     ! sensitive
      ifield = 0     ! no magnetic field
      fieldm = 0.0   ! max field
      tmaxfd = 0.3   ! maximum angle due to field (one step) in degrees
      dmaxms = 1.0   ! max disp. due to mulsct. in one step (cm)
      deemax = 0.1   ! max fractional energy loss in one step
      epsil  = 0.01  ! tracking precision (cm)
      stmin  = 0.05  ! min step due to e loss or mulsct. (cm)
      ubuf(1)= 0.    ! tracking stop switch
c
      nanalyz=ncarbon
      call gstmed(nt_analyz,'HALL$',nanalyz,isvol,ifield,fieldm,tmaxfd,
     1            dmaxms,deemax,epsil,stmin,ubuf,nwbuf)
c
      nt_ch = nch   ! tracking medium # same as material #
      nt_luc = nluc ! tracking medium # same as material #
      nt_sci = nsci ! tracking medium # same as material #
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c  print the tracking media parameters
c
       write(6,*)'printing tracking media params now'
       call gptmed ( 0 )
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c  the mother volume will be the HALL volume, it is filled with air
c
      write(6,*)'defining volumes now'
      write(6,*)'defining HALL now'
      call gsvolu ( 'HALL', 'BOX ', nair, HALL_size, ndim, iv_HALL )
c
      if ( iv_HALL.le.0 ) then
          write ( 6,* ) ' ugeom: error, iv_HALL=',iv_HALL
          write ( 6,* ) '        HALL geometry setup failed'
          stop
      end if
c
c  we do not see the HALL volume in the pictures
c
      call gsatt ( 'HALL', 'SEEN', 0 )
c
c  define the null rotation
c
      write(6,*)'defining null rot now'
      irot = 1
      call gsrotm(irot,nul_rot(1),nul_rot(2),nul_rot(3),
     x                 nul_rot(4),nul_rot(5),nul_rot(6) )
      irotnull = irot
c
c  define the rotation necessary to position the x-straws
c
      write(6,*)'defining rotx now'
      irotx = 2
      call gsrotm(irotx,rotx(1),rotx(2),rotx(3),
     x                 rotx(4),rotx(5),rotx(6) )
c
c
c  define the rotation necessary to position the u-straws
c
      write(6,*)'defining rotu now'
      irotu = 3
      call gsrotm(irotu,rotu(1),rotu(2),rotu(3),
     x                 rotu(4),rotu(5),rotu(6) )
c
c
c  define the rotation necessary to position the v-straws
c
      write(6,*)'defining rotv now'
      irotv = 4
      call gsrotm(irotv,rotv(1),rotv(2),rotv(3),
     x                 rotv(4),rotv(5),rotv(6) )
c
c
      write(6,*)'defining aira volume now'
      call gsvolu ( 'aira', 'BOX ', nt_air, 
     x                   aira_size, ndim, iv_targ )
c
      if ( iv_targ.le.0 ) then
          write ( 6,* ) ' ugeom: error, iv_targ=',iv_targ
          write ( 6,* ) '        aira geometry setup failed'
          stop
      end if
c
c
      write(6,*)'defining airb volume now'
      call gsvolu ( 'airb', 'BOX ', nt_air, 
     x                   airb_size, ndim, iv_targ )
c
      if ( iv_targ.le.0 ) then
          write ( 6,* ) ' ugeom: error, iv_targ=',iv_targ
          write ( 6,* ) '        airb geometry setup failed'
          stop
      end if
c
c
      write(6,*)'defining airc volume now'
      call gsvolu ( 'airc', 'BOX ', nt_air, 
     x                   airc_size, ndim, iv_targ )
c
      if ( iv_targ.le.0 ) then
          write ( 6,* ) ' ugeom: error, iv_targ=',iv_targ
          write ( 6,* ) '        airc geometry setup failed'
          stop
      end if
c
c
      write(6,*)'defining aird volume now'
      call gsvolu ( 'aird', 'BOX ', nt_air, 
     x                   aird_size, ndim, iv_targ )
c
      if ( iv_targ.le.0 ) then
          write ( 6,* ) ' ugeom: error, iv_targ=',iv_targ
          write ( 6,* ) '        aird geometry setup failed'
          stop
      end if
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
      write(6,*)'DEFINING THE ANALYZER NOW!'
      call gsvolu ( 'alyz', 'BOX ', nt_analyz, 
     x                   analyz_size, ndim, iv_targ )
c
      write(6,*)nt_analyz,analyz_size,iv_targ
c
      if ( iv_targ.le.0 ) then
          write ( 6,* ) ' ugeom: error, iv_targ=',iv_targ
          write ( 6,* ) '        analyzer geometry setup failed'
          stop
      end if
c
c
        write(*,*)'analyzer thickness =       ',analyz_size(3)*2.0
        write(*,*)'nt_carbon =          ',nt_carbon
        write(*,*)'nt_ch =              ',nt_ch
        write(*,*)'nt_luc =             ',nt_luc
        write(*,*)'nt_sci =             ',nt_sci
        write(*,*)'nt_analyz =          ',nt_analyz
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c
c
      write(6,*)'defining scints/aerogel now'
      call gsvolu ( 'sci1', 'BOX ', nt_carbon, 
     x                   sci1_size, ndim, iv_targ )
c
      write(6,*)iv_targ
      if ( iv_targ.le.0 ) then
          write ( 6,* ) ' ugeom: error, iv_targ=',iv_targ
          write ( 6,* ) '        scints geometry setup failed'
          stop
      end if
c
      write(6,*)'defining scints/aerogel now'
      call gsvolu ( 'sci2', 'BOX ', nt_carbon, 
     x                   sci2_size, ndim, iv_targ )
c
      if ( iv_targ.le.0 ) then
          write ( 6,* ) ' ugeom: error, iv_targ=',iv_targ
          write ( 6,* ) '        scints2 geometry setup failed'
          stop
      end if

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
      write(6,*)'defining the detector now'
      write(6,*)nair,' ',detect_size,' ', ndim
      call gsvolu('detc', 'BOX', nair, detect_size, ndim, iv_targ )

      if ( iv_targ.le.0 ) then
          write ( 6,* ) ' ugeom: error, iv_targ=',iv_targ
          write ( 6,* ) '        detector geometry setup failed'
c          stop
      end if

c
c
c  make the target "SEEN" in the pictures and give it COLOr number 3
c  (probably green) and then position it inside the mother volume
c
      call gsatt ( 'aira', 'SEEN', 1 )
      call gsatt ( 'aira', 'COLO', 1 )
      call gspos ( 'aira', 1, 'HALL', 0.,0.,real(zaira),irot,'only' )
      call gsatt ( 'airb', 'SEEN', 1 )
      call gsatt ( 'airb', 'COLO', 1 )
      call gspos ( 'airb', 1, 'HALL', 0.,0.,real(zairb),irot,'only' )
      call gsatt ( 'airc', 'SEEN', 1 )
      call gsatt ( 'airc', 'COLO', 1 )
      call gspos ( 'airc', 1, 'HALL', 0.,0.,real(zairc),irot,'only' )
      call gsatt ( 'aird', 'SEEN', 1 )
      call gsatt ( 'aird', 'COLO', 1 )
      call gspos ( 'aird', 1, 'HALL', 0.,0.,real(zaird),irot,'only' )
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
      call gsatt ( 'alyz', 'SEEN', 1 )
      call gsatt ( 'alyz', 'COLO', 4 )
      call gspos ( 'alyz', 1, 'HALL', 0.,0.,real(zanaly),irot,'only' )
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
      call gsatt ( 'sci1', 'SEEN', 1 )
      call gsatt ( 'sci1', 'COLO', 4 )
      call gspos ( 'sci1', 1, 'HALL', 0.,0.,real(zsci1),irot,'only' )
      call gsatt ( 'sci2', 'SEEN', 1 )
      call gsatt ( 'sci2', 'COLO', 4 )
      call gspos ( 'sci2', 1, 'HALL', 0.,0.,real(zsci2),irot,'only' )
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
      call gsatt ( 'detc', 'SEEN', 1 )
      call gsatt ( 'detc', 'COLO', 3 )
      call gspos ( 'detc', 1, 'HALL', 0., 0., 200.,irot,'only' )
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      write(6,*) 'everything is positioned'
      return
      end