subroutine ver_getg(idate) *---------------------------------------------------------------------- * MVD - get geometry * called by ver.f * Read the geometry data base (for now an ascii file), and store the * info in a common block. Based on NA44 software. * * The silicon configuration is defined in array ACONFIG. A lot of things * get derived from that. * The list of volumes is given in ALL_NAMES. The volumes defined in there * should be sufficient to built what is in ACONFIG. ALL_NAMES is keyed to * the date, which is an input argument (IDATE) to this routine. * * This program just reads the geometry data base file, and copies the * information to the geometry common block. This common block contains all * geometry info, completely spelled out, and can be used later to make GEANT * calls, do analysis and reconstruction, make an event display and so on. * * Some repetitive items are not spelled out in the data base file, but are * interpolated here in the code. * 30 sep 00 Hubert van Hecke LANL * Added code for sag and bow Aug 01 HvH *----------------------------------------------------------------------C implicit none include 'ver_geom.inc' integer idate ! Input argument character*80 filnam character*132 line, line2 character*4 name1, mother1, shape1, c_cage_name character*7 nametmp character*600 aconfig integer i1, i144, iy, iz, jcopy, ieast_west, ivol, i, j, k, l, & jmcm, jdum, jmed, jrot, nmcm, icage1, icage24, & kcopy(7), irib1, irib24, irib_type, lcopy(5), ntypes, & ivsi4, ilast, lnblnk, ishift, isili1, isithis, luntty, & jlun, ii, krots, irot1, & imcm(12,6,2) ! z, IB->OT, E>-W real dely, delz, posx, posy, posz, zcage1, zcage24, & sag, z12, rsag, pi, alpha, p1, p2, bow, rbow, beta data luntty, jlun, nvols, krots, nrots / 6, 20, 0, 0, 0 / data name /mvols*' '/ ! IN VER_GEOM.INC data mother /mvols*' '/ ! 'blank' is not 'null' data sag /-5.0 / ! sag in y data pi / 3.14159 / C----------------------------------------------------------------------C if (name(1).ne.' ') then ! don't double the work write (luntty,*)' ver_getg:: geometry common already filled..' return endif ! first time, so here we go... ! load up the all_names array all_names = ' ' ! First all blanks, not nulls if ( idate.ge.2000 09 29 ) then ! year-1 configuration. write (6,*)' Doing year-1 configuration' aconfig = ! aconfig gets translated * ! to imcm(1->12,IB->OT,E->W) * <-----SOUTH----> <-----NORTH----> ! * pads 1 2 3 4 5 6 7 8 9 10 11 12 pads ! * ------+--------------------------------------+------- ! &' 0 | 0 0 0 0 0 0 1 1 1 0 0 0 | 1 '// ! IT &' 0 | 0 0 0 0 0 0 1 1 1 0 0 0 | 1 '// ! IM &' 0 | 0 0 0 0 0 0 1 1 1 1 1 0 | 1 '// ! IB &' 0 | 0 0 0 0 0 0 1 1 1 1 1 0 | 1 '// ! OB EAST &' 0 | 0 0 0 0 0 0 0 0 0 0 0 0 | 1 '// ! OM &' 0 | 0 0 0 0 0 0 0 0 0 0 0 0 | 1 '// ! OT *-----------+--------------------------------------+------------!------------- &' 0 | 0 0 0 0 0 0 1 1 0 0 0 0 | 1 '// ! IT &' 0 | 0 0 0 0 0 0 1 1 1 0 0 0 | 1 '// ! IM &' 0 | 0 0 0 0 0 0 1 1 1 1 1 0 | 1 '// ! IB WEST &' 0 | 0 0 0 0 0 0 1 1 1 1 1 0 | 1 '// ! OB &' 0 | 0 0 0 0 0 0 0 0 0 0 0 0 | 1 '// ! OM &' 0 | 0 0 0 0 0 0 0 0 0 0 0 0 | 1 ' ! OT ! These are the volumes ! we are looking for in ! the data base file: all_names(001:210)= 'HALL 1'//'CMAG 1'//'VERT 1' & //'VCAI 1'//'VCAI 2'//'VCAI 3'//'VCAI 4'//'VCAI 5' & //'VCAI 6'//'VCAI 7'//'VCAI 8'//'VCAI 9'//'VCAI 10' & //'VCAI 11'//'VCAI 12'//'VCAI 13'//'VCAI 14'//'VCAI 15' & //'VCAI 16'//'VPLE 1'//'VPLW 1'//'VXWL 1'//'VXWL 2' & //'VXWL 3'//'VXWL 4'//'VYWL 1'//'VYWL 2'//'VYWL 3' & //'VYWL 4'//'VMCM 1' ! leave 144 spaces from all_names(211:1204) = ' ' ! VMCM->VDUM inclusive. all_names(1205:1533) = 'VDUM144' ! Interpolation in code & //'VPCO 1'//'VPCO 2'//'VPCO 3'//'VPCO 4'//'VPCO 5' & //'VPCO 6'//'VPCO 7'//'VPCO 8'//'VMPL 1'//'VMPL 2' & //'VEN1 1'//'VEN2 1'//'VEN3 1'//'VEN4 1'//'VEN5 1' & //'VEN6 1'//'VSTR 1'//'VSTR 2'//'VSTR 3'//'VSTR 4' & //'VENP 1'//'VENP 2'//'VCG0 1'//'VCG0 2'//'VCG0 3' & //'VCG0 4'//'VCG0 5'//'VCG0 6'//'VCG0 7'//'VCG0 8' & //'VCG0 9'//'VCG0 10'//'VCG0 11'//'VCG0 12'//'VCG0 13' & //'VCG0 14'//'VCG0 15'//'VCG0 16'//'VCG0 17'//'VCG0 18' & //'VCG0 19'//'VCG0 20'//'VCG0 21'//'VCG0 22'//'VCG0 23' & //'VCG0 24' all_names(1534:1848) = 'VR01 1'//'VR01 2' ! Interpolation in code & //'VR02 1'//'VR02 2'//'VR03 1'//'VR03 2'//'VR03 3' & //'VR03 4'//'VR04 1'//'VR04 2'//'VR04 3'//'VR04 4' & //'VR05 1'//'VR05 2'//'VR05 3'//'VR05 4'//'VR05 5' & //'VR05 6'//'VR05 7'//'VR05 8'//'VR05 9'//'VR05 10' & //'VR05 11'//'VR05 12' & //'VSI4 1'//'VSI4 2'//'VSI4 3'//'VAI4 1'//'VSO4 1' & //'VAO4 1' & //'VSI3 1'//'VSI3 2'//'VAI3 1'//'VSO3 1'//'VAO3 1' & //'VSI2 1'//'VAI2 1'//'VSO2 1'//'VAO2 1' & //'VPMB 1'//'VPMB 2'//'VPAD 1' end if ! End of year-1 config nvols = lnblnk(all_names) ! total # of volumes ii = 0 ! ACONFIG is just a convenient way to write do k=1,2 ! east->west 1,2 down the current do j=1,6 ! IB->OT 1,6 configuration. ii = ii+5 ! skip south pads Translate to integer do i=1,12 ! mcm 1->12 array IMCM for later, ii = ii+3 ! 3 spaces per easier use. read(aconfig(ii:ii),'(i1)') imcm(i,j,k) if (i.eq.6) ii = ii+2 ! south-north gap enddo ! mcm 1-12 ii = ii+7 ! skip north pads enddo ! IB->OT enddo ! East->West ----------- end ACONFIG -> IMCM do ieast_west = 1,2 ! The number of different c-cage types do iz = 1,12 ! depends on the Si that's installed. nmcm = 0 ! Find out how many mcm's on each cage. do jmcm = 1,6 ! 6 faces on a cage nmcm = nmcm + imcm(iz,jmcm,ieast_west) ! add up mcm's enddo ! a '0','2','3' or '4' kcopy(nmcm+1) = kcopy(nmcm+1) + 1 ! ... enddo ! ... enddo ! ... do i=1,7 ! Now count them up if (kcopy(i).ne.0) ntypes = ntypes+1 ! (type 0 to type 6) kcopy(i) = 0 ! kcopy is used later enddo ! Now we can bump up ! the rest of the ivsi4 = index(all_names,'VSI4 1') ! names to above the ilast = lnblnk(all_names) ! space needed for this ishift = (ntypes-1)*24*7 ! number of cage types. all_names(ivsi4+ishift:ilast+ishift) = ! & all_names(ivsi4 :ilast) ! all_names(ivsi4 :ilast) = ' ' ! clear old places. nvols = lnblnk(all_names)/7 ! Now we're ready: write (6,'(/,'' Reading the geometry file:'',/, & '' ivol name # comment '',/, & '' ----------------------------------'')') filnam = 'ver_geom.dat' open(unit=jlun, file='ver_geom.dat', status='old') do while (.true.) ! Read the whole file. read(jlun,'(a132)',end=30,err=30) line ! Read a line, if (line(1:1) .ne. '*' .and. ! skip comments, & line(2:5) .ne. ' ' .and. ! and spaces, & lnblnk(line).gt.0 ) then ! and blanks. if (index(line(1:10),'GSROTM').eq.0) then ! not a rotation matrix read(jlun,'(a132)',end=30,err=30)line2 ! Read second line if (nvols.le.mvols) then ! check for space call ver_parse_rec(line, line2, nvols) ! parse the record else ! out of space write(luntty,*)' ** ERROR ** Increase mvols in ver_geom.inc' endif ! end geant volume ! elseif(index(line(1:10),'GSROTM').ne.0)then ! rotation matrix if (nrots.le.mrots) then ! check for space call ver_parse_rot(line, krots) ! parse the record nrots = krots ! copy to common else ! out of space write(luntty,*)' ** ERROR ** Increase mrots in ver_geom.inc' endif ! check for space endif ! is/not rot matrix endif ! not comment or blank enddo ! end read loop ! eof reached: 30 write (luntty,10) idate, nvols, nrots write (8 ,10) idate, nvols, nrots 10 format(/,' ver_getg:: geometry common filled for date',I9.8,'.', & /, i3,' volumes and ',i3,' rotations.',/) *----- interpolate the mcm's and the dummies in the plenum: ----------* write (6,*)' Starting interpolation for MCMs and dummies:' write (6,*)' Starting interpolation for MCMs and dummies:' i1 = (index(all_names,'VMCM 1')+6)/7 ! First and last are i144 = (index(all_names,'VDUM144')+6)/7 ! in the data base. dely = (position(2,i144)-position(2,i1))/5.0 delz = (position(3,i144)-position(3,i1))/11.0 ! ivol = i1 ! start of 1st interp. record jmcm = 0 ! mcm count jdum = 0 ! dummy count ! name1 = name(i1) ! safeguard some variables mother1 = mother(i1) ! which will be overwritten shape1 = shape(i1) ! posx = position(1,i1) ! posy = position(2,i1) posz = position(3,i1) jmed = nmed(i1) jrot = irota(i1) ! now fill the records: do ieast_west = 1,2 ! east and west do iz = 1,12 ! 12 cages do iy = 1,6 ! 6 mcm's per cage position(1,ivol) = posx ! x-pos constant mother(ivol) = mother(i144) if (ieast_west.eq.2) mother(ivol) = mother1 position(3,ivol) = posz + (iz-1)*delz position(2,ivol) = posy + (iy-1)*dely if (ieast_west.eq.2) ! west & position(2,ivol) = -position(2,ivol) par(1,ivol) = par(1,i1) ! same for all par(2,ivol) = par(2,i1) par(3,ivol) = par(3,i1) shape(ivol) = shape(11) irota(ivol) = irota(i1) iseen(ivol) = iseen(i1) icol (ivol) = icol (i1) if (imcm(iz,iy,ieast_west).eq.1) then ! MCM name(ivol) = name1 ! jmcm = jmcm + 1 icopy(ivol) = jmcm nmed(ivol) = jmed nametmp = name1 ! load name into write (nametmp(5:7),'(i3)') jmcm ! all_names: all_names(ivol*7-6:ivol*7) = nametmp else ! dummy name(ivol) = name(i144) ! jdum = jdum + 1 icopy(ivol) = jdum ! nmed(ivol) = nmed(i144) nametmp = name(i144) ! load name into write (nametmp(5:7),'(i3)') jdum ! all_names: all_names(ivol*7-6:ivol*7) = nametmp endif ivol = ivol+1 ! go do next record enddo ! 6 mcms per cage enddo ! 12 cages enddo ! east / west write (6,*)' MCM''s and dummy MCM''s done.' write (8,*)' MCM''s and dummy MCM''s done.' *------ build and populate the cages: ---------------------------------* write (6,*)' Place rohacell c-cages by interpolation in z:' write (8,*)' Place rohacell c-cages by interpolation in z:' * First make 24 cage volumes by interpolation between the first and the icage1 = (index(all_names,'VCG0 1')+6)/7 ! first one. icage24 = (index(all_names,'VCG0 24')+6)/7 ! last one zcage1 = position(3,icage1) ! Starting point in z delz = (position(3,icage24) - position(3,icage1))/(12-1) p1 = position(1,icage1) ! x of 1st cage p2 = position(2,icage1) ! y of 1st cage do jrot = 1,nrots ! matrix of first cage if (irota(icage1).eq.irot_id(jrot)) irot1 = jrot-1 enddo write (6,*) ' irot1 = ', irot1 write (8,*) ' irot1 = ', irot1 write (6,'('' Give sag (cm) : '',$)') read (5,*) sag c sag = -5. rsag = ((12.*delz)**2/4.0 + sag**2) / (2.0*sag) ! radius of curvature write (6,'('' Give bow (cm) : '',$)') read (5,*) bow c bow = 3.0 rbow = ((12.*delz)**2/4.0 + bow**2) / (2.0*bow) ! radius of curvature write (11,*)'* Matrices for sag, bow (in cm) = ',sag,bow ivol = icage1 ! start of 1st interp. record do ieast_west = 1,2 ! loop over E->W if (ieast_west.eq.2) irot1 = irot1+12 ! first in each half do iz = 1,12 ! 12 cages along z nmcm = 0 ! How many MCMs? do jmcm = 1,6 ! 6 faces on a cage nmcm = nmcm + imcm(iz,jmcm,ieast_west) ! add up mcm's enddo ! a '0','2','3' or '4' write (c_cage_name,'(''VCG'',i1)') nmcm ! Make cage name name(ivol) = c_cage_name ! load it kcopy(nmcm+1) = kcopy(nmcm+1) + 1 ! # for this cage type icopy(ivol) = kcopy(nmcm+1) ! same for all shape(ivol) = shape(icage1) ! '' mother(ivol) = mother(icage1) ! '' position(2,ivol) = p2 ! '' position(3,ivol) = zcage1 + (iz-1)*delz ! interpolate z-pos ! now add sag: alpha = atan( position(3,ivol)/(rsag-sag) ) ! in radians position(3,ivol) = rsag*sin(alpha) ! new z position(2,ivol) = & position(2,ivol) + rsag*cos(alpha) + sag - rsag ! new y ! now add bow: beta = atan( position(3,ivol)/(rbow-bow) ) ! in radians write (6,*)' iz, beta= ', iz, beta write (8,*)' iz, beta= ', iz, beta position(3,ivol) = rbow*sin(beta) ! new z if (ieast_west.eq.1) then theta(1,iz+irot1) = 90.0 - beta *180./pi phi (1,iz+irot1) = 180.0 theta(2,iz+irot1) = 90.0 & - asin(sin(alpha)*cos(beta)) *180./pi phi (2,iz+irot1) = 90.0 & + asin(sin(alpha)*sin(-beta)) *180./pi theta(3,iz+irot1) = 90.0 & + acos(cos(alpha)*cos(beta)) *180./pi phi (3,iz+irot1) = 90.0 & - atan(sin(-beta)/sin(alpha)) *180./pi position(1,ivol) = & p1 - rbow*cos(beta) - bow + rbow ! new x elseif (ieast_west.eq.2) then theta(1,iz+irot1) = 90.0 - beta *180./pi phi (1,iz+irot1) = 0. theta(2,iz+irot1) = 90.0 & - asin(sin(alpha)*cos(beta)) * 180./pi phi (2,iz+irot1) = 90.0 & - asin(sin(alpha)*sin(-beta)) * 180./pi theta(3,iz+irot1) = 90.0 & - acos(cos(alpha)*cos(beta)) * 180./pi phi (3,iz+irot1) = 270.0 & + atan(sin(-beta)/sin(alpha)) * 180./pi position(1,ivol) = & -p1 + rbow*cos(beta) + bow - rbow ! new x endif write (11,11) irota(ivol), ! write to file & theta(1,iz+irot1), phi(1,iz+irot1), ! the new matrices & theta(2,iz+irot1), phi(2,iz+irot1), ! & theta(3,iz+irot1), phi(3,iz+irot1), & name(ivol), icopy(ivol) 11 format(' GSROTM',i5,6f8.3,' +',a4,i3) do i=1,10 ! same for all par(i,ivol) = par(i,icage1) ! '' enddo ! '' nmed(ivol) = nmed(icage1) ! '' iseen(ivol) = iseen(icage1) ! '' icol (ivol) = icol (icage1) ! '' write (nametmp,'(a4,i3)') name(ivol), icopy(ivol) all_names(ivol*7-6:ivol*7) = nametmp ! load all_names ivol = ivol + 1 ! done, increment ivol enddo ! 12 cages in z enddo ! end loop over E->W close (unit=11) write (luntty,10) idate, nvols, nrots write (8 ,10) idate, nvols, nrots *------ Now put rohacell ribs in each cage: ---------------------------* irib1 = (index(all_names,'VR01 1')+6)/7 ! first rib irib24 = (index(all_names,'VR05 12')+6)/7 ! last rib (2,2,4,4,12) ivol = irib1 ! start here * Search for cages of type i, i being the number of SI detectors do i=0,6 ! max 6 faces/cage write (c_cage_name,'(''VCG'',i1)') i ! name for i silicons if (index(all_names,c_cage_name).ne.0) then ! type i is present write (6,*)' ... cage with ',i,' Si detectors' write (8,*)' ... cage with ',i,' Si detectors' write (6,*)'irib1, name(irib1)= ',irib1, name(irib1) write (8,*)'irib1, name(irib1)= ',irib1, name(irib1) do j=1,24 ! copy 24 ribs k = irib1+j-1 ! name(ivol) = name(k) ! VR01-VR05 write (6,'(''ivol,name,mother='',i3,a5,a5)') & ivol,name(ivol),c_cage_name write (8,'(''ivol,name,mother='',i3,a5,a5)') & ivol,name(ivol),c_cage_name read(name(ivol),'(3x,i1)') irib_type ! fish out the 1-5 lcopy(irib_type) = lcopy(irib_type) + 1 ! count them separately icopy(ivol) = lcopy(irib_type) ! shape(ivol) = shape(k) ! same for all mother(ivol) = c_cage_name ! '' position(1,ivol) = position(1,k) ! '' position(2,ivol) = position(2,k) ! '' position(3,ivol) = position(3,k) ! '' do l=1,10 ! same for all par(l,ivol) = par(l,k) ! '' enddo nmed(ivol) = nmed(k) ! '' iseen(ivol) = iseen(k) icol (ivol) = icol (k) irota(ivol) = irota(k) ! '' write (nametmp,'(a4,i3)') name(ivol), icopy(ivol) all_names(ivol*7-6:ivol*7) = nametmp ivol = ivol + 1 ! done, increment ivol enddo ! copy 24 ribs endif ! cage with i populated faces enddo ! possibly 6 faces on a cage write (6,*)' Placed rohacell ribs in all c-cages.' write (8,*)' Placed rohacell ribs in all c-cages.' write (luntty,10) idate, nvols, nrots write (8 ,10) idate, nvols, nrots end ! ver_getg *======================================================================*