40 parameter(maxdivols=20000)
41 integer nvol, nrotm, nmate, ntmed, nset, i, jma, nmixt, k, nin,
42 > jdiv, jd, iaxis, ivo, ndiv, numed, npar, natt, ivol, jin,
43 > nparv, npard, nr, irot, konly, nwbuf, isvol, nmat, ifield,
44 > nbits(5000), idtyp, nwhi, nwdi, iset, idet, j,
in, jmx,
45 > jdh, jdd, jdu, ndet, nn, nupar, npos, ndvol, ndivols, ii,
46 > npositioned, iia(10000), imate, smixt
48 real c0, step,
x,
y,
z,
a, dens, radl, absl,
fact(5000),
49 > fieldm, tmaxfd, stemax, deemax, epsil, stmin, orig(5000),
52 character shape*4,
name*4, dname*4, chonly*4, chmat*20, chtmed*20,
53 > chset*4, chdet*4, chnms(5000)*4, divols(maxdivols)*4
59 print *,
'Materials: ',nmate
63 call uhtoc(iq(jma+1),4,chmat,20)
74 write(6,101) imate, chmat,
a,
z, dens, radl, absl
75 call ksmate(ii, chmat,
a,
z, dens, radl, absl,
79 write(6,102) imate, chmat,
a,
z, dens, radl, absl,
80 > (j,q(jmx+j),q(jmx+nmixt+j),q(jmx+2*nmixt+j),
82 call ksmixt(ii, chmat, q(jmx+1), q(jmx+nmixt+1),
83 > dens, smixt, q(jmx+2*nmixt+1))
87 101
format(1
x,i5,1
x,a12,f6.2,f5.1,f8.2,2f9.2)
88 102
format(1
x,i5,1
x,a12,f6.2,f5.1,f8.2,2f9.2,1
x,i2, f6.2, f5.1,
89 > f6.2/(57
x, i2, f6.2, f5.1, f6.2))
93 print *,
'Media: ',ntmed
97 call uhtoc(iq(j+1),4,chtmed,20)
108 call kstmed(ii,chtmed,nmat,isvol,ifield,fieldm,tmaxfd,stemax,
109 + deemax,epsil,stmin,q(j+15),nwbuf)
114 print *,
'Rotms: ',nrotm
118 call ksrotm(ii,q(j+11),q(j+12),q(j+13),q(j+14),q(j+15),q(j+16))
124 print *,
'Volumes: ',nvol
135 call uhtoc(iq(jvolum+ivo),4,dname,4)
137 if (ndivols.gt.maxdivols)
then 140 +
'!!!ERROR!!! ndivols array exhausted. ',
141 +
'Too many divisions.' 143 divols(ndivols) = dname
151 call uhtoc(iq(jvolum+ii),4,
name,4)
158 if (divols(k).eq.
name)
then 164 call ksvolu(
name, shape, numed, q(j+7), npar, ivol)
167 print *,
'Divided volumes: ',ndvol
170 call uhtoc(iq(jvolum+1),4,
name,4)
173 print *,
'mother volume: ',
name,
' shape: ',shape
178 call uhtoc(iq(jvolum+ii),4,
name,4)
187 call uhtoc(iq(jvolum+ivo),4,dname,4)
194 else if (nin.gt.0)
then 199 call uhtoc(iq(jvolum+ivo),4,dname,4)
214 npositioned = npositioned +1
229 print *,
'Sets: ',nset
233 call uhtoc(iq(jset+i),4,chset,4)
237 call uhtoc(iq(j+k),4,chdet,4)
238 call gfdet(chset, chdet, nn, chnms, nbits, idtyp,
239 + nwhi, nwdi, iset, idet)
240 call ksdet(chset, chdet, nn, chnms, nbits, idtyp,
241 + nwhi, nwdi, iset, idet)
244 call gfdeth(chset,chdet,nn,chnms,nbits,orig,
fact)
245 call ksdeth(chset,chdet,nn,chnms,nbits,orig,
fact)
249 call gfdetd(chset,chdet,nn,chnms,nbits)
250 call ksdetd(chset,chdet,nn,chnms,nbits)
254 call gfdetu(chset,chdet,100,nupar,upar)
255 call ksdetu(chset,chdet,nupar,upar)
259 print *,
'Positioned volumes (gspos, gsposp):',npositioned
subroutine ksposp(name, num, moth, x, y, z, irot, only, par, npar)
subroutine ksmixt(imate, name, a, z, dens, nlmat, wmat)
subroutine ksmate(imate, name, a, z, dens, radl, absl, ubf, nwbf)
subroutine ksdetu(chset, chdet, nupar, upar)
subroutine ksvolu(name, shape, nmed, par, npar, ivol)
subroutine bankcnt(link, iia, nbanks)
subroutine ksrotm(irot, theta1, phi1, theta2, phi2, theta3, phi3)
subroutine kspos(name, num, moth, x, y, z, irot, only)
void print(G4double elem)
subroutine ksdet(chset, chdet, nv, chnam, nbits, idtyp, nwhi, nwdi, iset, idet)
subroutine ksdetd(chset, chdet, nd, chnam, nbits)
subroutine ksdvn2(name, moth, ndiv, iaxis, c0, numed)
subroutine jshape(RSHAPE, SHAPE)
subroutine kstmed(itmed, name, nmat, isvol, ifield, fieldm, tmaxfd, stemax, deemax, epsil, stmin, ubuf, nwbuf)
subroutine ksdeth(chset, chdet, nh, chnam, nbits, orig, fact)