39 parameter(maxdivols=20000)
40 integer nvol, nrotm, nmate, ntmed, nset, i, jma, nmixt,
k, nin,
41 > jdiv, jd, iaxis, ivo, ndiv, numed, npar,
natt, ivol, jin,
42 > nparv, npard, nr, irot, konly, nwbuf, isvol, nmat, ifield,
43 > nbits(5000), idtyp, nwhi, nwdi, iset, idet, j,
in, jmx,
44 > jdh, jdd, jdu, ndet, nn, nupar, npos, ndvol, ndivols, ii,
45 > npositioned, iia(10000), imate, smixt
47 real c0, step,
x,
y,
z,
a, dens, radl, absl, fact(5000),
48 > fieldm, tmaxfd, stemax, deemax, epsil, stmin, orig(5000),
51 character shape*4,
name*4, dname*4, chonly*4, chmat*20, chtmed*20,
52 > chset*4, chdet*4, chnms(5000)*4, divols(maxdivols)*4
58 print *,
'Materials: ',nmate
62 call uhtoc(iq(jma+1),4,chmat,20)
73 write(6,101) imate, chmat,
a,
z, dens, radl, absl
74 call
ksmate(ii, chmat,
a,
z, dens, radl, absl,
78 write(6,102) imate, chmat,
a,
z, dens, radl, absl,
79 > (j,q(jmx+j),q(jmx+nmixt+j),q(jmx+2*nmixt+j),
81 call
ksmixt(ii, chmat, q(jmx+1), q(jmx+nmixt+1),
82 > dens, smixt, q(jmx+2*nmixt+1))
86 101
format(1
x,i5,1
x,a12,f6.2,f5.1,f8.2,2f9.2)
87 102
format(1
x,i5,1
x,a12,f6.2,f5.1,f8.2,2f9.2,1
x,i2, f6.2, f5.1,
88 > f6.2/(57
x, i2, f6.2, f5.1, f6.2))
92 print *,
'Media: ',ntmed
96 call uhtoc(iq(j+1),4,chtmed,20)
107 call
kstmed(ii,chtmed,nmat,isvol,ifield,fieldm,tmaxfd,stemax,
108 + deemax,epsil,stmin,q(j+15),nwbuf)
113 print *,
'Rotms: ',nrotm
117 call
ksrotm(ii,q(j+11),q(j+12),q(j+13),q(j+14),q(j+15),q(j+16))
123 print *,
'Volumes: ',nvol
134 call uhtoc(iq(jvolum+ivo),4,dname,4)
136 if (ndivols.gt.maxdivols)
then
139 +
'!!!ERROR!!! ndivols array exhausted. ',
140 +
'Too many divisions.'
142 divols(ndivols) = dname
150 call uhtoc(iq(jvolum+ii),4,
name,4)
157 if (divols(
k).eq.
name)
then
163 call
ksvolu(
name, shape, numed, q(j+7), npar, ivol)
166 print *,
'Divided volumes: ',ndvol
169 call uhtoc(iq(jvolum+1),4,
name,4)
172 print *,
'mother volume: ',
name,
' shape: ',shape
177 call uhtoc(iq(jvolum+ii),4,
name,4)
186 call uhtoc(iq(jvolum+ivo),4,dname,4)
192 call
ksdvn2(dname,
name, ndiv, iaxis, c0, numed)
193 else if (nin.gt.0)
then
198 call uhtoc(iq(jvolum+ivo),4,dname,4)
213 npositioned = npositioned +1
228 print *,
'Sets: ',nset
232 call uhtoc(iq(jset+i),4,chset,4)
236 call uhtoc(iq(j+
k),4,chdet,4)
237 call gfdet(chset, chdet, nn, chnms, nbits, idtyp,
238 + nwhi, nwdi, iset, idet)
239 call
ksdet(chset, chdet, nn, chnms, nbits, idtyp,
240 + nwhi, nwdi, iset, idet)
243 call gfdeth(chset,chdet,nn,chnms,nbits,orig,fact)
244 call
ksdeth(chset,chdet,nn,chnms,nbits,orig,fact)
248 call gfdetd(chset,chdet,nn,chnms,nbits)
249 call
ksdetd(chset,chdet,nn,chnms,nbits)
253 call gfdetu(chset,chdet,100,nupar,upar)
254 call
ksdetu(chset,chdet,nupar,upar)
258 print *,
'Positioned volumes (gspos, gsposp):',npositioned
268 #include "gcbank.inc"
269 integer i, link, nbanks, iia(*)
272 if (link.eq.0)
return
276 if(lq(link-i).ne.0)
then