31 subroutine gsvolu(name, shape, nmed, par, npar, ivol)
33 subroutine ksvolu(name, shape, nmed, par, npar, ivol)
38 character name*4, shape*4, fmt*150
39 integer nmed, npar, ivol,
k
47 if (dogeom) call gsvolu(
name, shape, nmed, par, npar, ivol)
51 if (lunlist.ne.0)
then
56 write(fmt,
'(A,I2,A)')
'(a4,1x,a6,1x,a4,1x,a4,2i5,',
max(npar,1),
58 write(lunlist,fmt)
context, rname,
name, shape, nmed, npar,
61 if (luncode.ne.0)
then
62 write(luncode,
'(''{'')')
64 write(luncode,1000)
name, shape, nmed, npar
65 1000
format(
'G4gsvolu(name="',
a,
'",shape="',
a,
'",nmed=',i5,
66 +
',par,npar=',i4,
');')
67 write(luncode,
'(''}'')')
73 subroutine gspos(name, num, moth, x, y, z, irot, only)
75 subroutine kspos(name, num, moth, x, y, z, irot, only)
80 character name*4, moth*4, only*4
89 if (dogeom) call gspos(
name,
num, moth,
x,
y,
z, irot, only)
91 if (lunlist.ne.0)
then
93 +
'(a4,1x,a6,1x,a4,i5,1x,a4,3(1x,e16.8),i5,1x,a4)')
96 if (luncode.ne.0)
then
97 write(luncode,
'(''{'')')
101 write(luncode,1000)
name,
num,moth,irot,only
102 1000
format(
'G4gspos(name="',
a,
'",num=',i5,
',moth="',
a,
103 +
'",x,y,z,irot=',i5,
',only="',
a,
'");')
104 write(luncode,
'(''}'')')
110 subroutine gsposp(name, num, moth, x, y, z, irot, only, par, npar)
112 subroutine ksposp(name, num, moth, x, y, z, irot, only, par, npar)
117 character name*4, moth*4, only*4
118 integer num, irot, npar,
k
119 real x,
y,
z, par(npar)
120 character rname*6, fmt*150
121 #include "G3toG4.inc"
122 data rname /
'GSPOSP'/
126 if (dogeom) call gsposp(
name,
num, moth,
x,
y,
z, irot, only,
129 if (lunlist.ne.0)
then
131 if (abs(par(
k)).gt.1.e10)
then
132 print *,
'Warning: huge junk value in PAR for GSPOS'
143 write(fmt,
'(A,A,I2,A)')
144 >
'(a4,1x,a6,1x,a4,i5,1x,a4,3(1x,e16.8),',
145 +
'i5,1x,a4,i5,',
max(npar,1),
'(1x,e16.8))'
147 +
context, rname,
name,
num, moth,
x,
y,
z, irot, only,
151 if (luncode.ne.0)
then
152 write(luncode,
'(''{'')')
157 write(luncode,1000)
name,
num,moth,irot,only,npar
158 1000
format(
'G4gsposp(name="',
a,
'",num=',i5,
',moth="',
a,
159 +
'",x,y,z,irot=',i5,
',only="',
a,
'",par,npar=',i4,
');')
160 write(luncode,
'(''}'')')
166 subroutine gsatt(name, attr, ival)
173 character name*4, attr*4
176 #include "G3toG4.inc"
177 data rname /
'GSATT '/
181 if (dogeom) call gsatt(
name, attr, ival)
183 if (lunlist.ne.0)
then
185 +
'(a4,1x,a6,1x,a4,1x,a4,i12)')
188 if (luncode.ne.0)
then
189 write(luncode,
'(''{'')')
190 write(luncode,1000)
name,attr,ival
191 1000
format(
'G4gsatt(name="',
a,
'",attr="',
a,
'",ival=',i10,
');')
192 write(luncode,
'(''}'')')
198 subroutine gsrotm(irot, theta1, phi1, theta2, phi2,
201 subroutine ksrotm(irot, theta1, phi1, theta2, phi2,
208 real theta1, phi1, theta2, phi2, theta3, phi3
210 #include "G3toG4.inc"
211 data rname /
'GSROTM'/
215 if (dogeom) call gsrotm(irot, theta1, phi1, theta2, phi2,
218 if (lunlist.ne.0)
then
220 +
'(a4,1x,a6,i5,6f11.5)')
221 +
context, rname, irot, theta1, phi1, theta2, phi2,
224 if (luncode.ne.0)
then
225 write(luncode,
'(''{'')')
226 call
rtocp(
'theta1',theta1)
227 call
rtocp(
'phi1',phi1)
228 call
rtocp(
'theta2',theta2)
229 call
rtocp(
'phi2',phi2)
230 call
rtocp(
'theta3',theta3)
231 call
rtocp(
'phi3',phi3)
232 write(luncode,1000) irot
233 1000
format(
'G4gsrotm(irot=',i5,
234 +
',theta1,phi1,theta2,phi2,theta3,phi3);')
235 write(luncode,
'(''}'')')
241 subroutine gsdvn(name, moth, ndiv, iaxis)
243 subroutine ksdvn(name, moth, ndiv, iaxis)
248 character name*4, moth*4
251 #include "G3toG4.inc"
252 data rname /
'GSDVN '/
256 if (dogeom) call gsdvn(
name, moth, ndiv, iaxis)
258 if (lunlist.ne.0)
then
260 +
'(a4,1x,a6,1x,a4,1x,a4,i5,i3)')
263 if (luncode.ne.0)
then
264 write(luncode,
'(''{'')')
265 write(luncode,1000)
name, moth, ndiv, iaxis
266 1000
format(
'G4gsdvn(name="',
a,
'",moth="',
a,
'",ndiv=',i3,
268 write(luncode,
'(''}'')')
274 subroutine gsdvt(name, moth, step, iaxis, numed, ndvmx)
276 subroutine ksdvt(name, moth, step, iaxis, numed, ndvmx)
281 character name*4, moth*4
283 integer iaxis, numed, ndvmx
285 #include "G3toG4.inc"
286 data rname /
'GSDVT '/
290 if (dogeom) call gsdvt(
name, moth, step, iaxis, numed, ndvmx)
292 if (lunlist.ne.0)
then
294 +
'(a4,1x,a6,1x,a4,1x,a4,(1x,e16.8),3i5)')
295 +
context, rname,
name, moth, step, iaxis, numed, ndvmx
297 if (luncode.ne.0)
then
298 write(luncode,
'(''{'')')
299 call
rtocp(
'step',step)
300 write(luncode,1000)
name,moth,iaxis,numed,ndvmx
301 1000
format(
'G4gsdvt(name="',
a,
'",moth="',
a,
'",step,iaxis=',
302 + i1,
',numed=',i4,
',ndvmx=',i4,
');')
303 write(luncode,
'(''}'')')
309 subroutine gsdvx(name, moth, ndiv, iaxis, step, c0, numed, ndvmx)
311 subroutine ksdvx(name, moth, ndiv, iaxis, step, c0, numed, ndvmx)
316 character name*4, moth*4
317 integer ndiv, iaxis, numed, ndvmx
320 #include "G3toG4.inc"
321 data rname /
'GSDVX '/
325 if (dogeom) call gsdvx(
name, moth, ndiv, iaxis, step, c0, numed,
328 if (lunlist.ne.0)
then
330 +
'(a4,1x,a6,1x,a4,1x,a4,i5,i3,2(1x,e16.8),2i5)')
331 +
context, rname,
name, moth, ndiv, iaxis,step, c0,
334 if (luncode.ne.0)
then
335 write(luncode,
'(''{'')')
336 call
rtocp(
'step',step)
338 write(luncode,1000)
name,moth,ndiv,iaxis,numed,ndvmx
339 1000
format(
'G4gsdvx(name="',
a,
'",moth="',
a,
'",ndiv=',i3,
',iaxis=',
340 + i1,
',step,c0,numed=',i4,
',ndvmx=',i4,
');')
341 write(luncode,
'(''}'')')
347 subroutine gsdvn2(name, moth, ndiv, iaxis, c0, numed)
349 subroutine ksdvn2(name, moth, ndiv, iaxis, c0, numed)
354 character name*4, moth*4
355 integer ndiv, iaxis, numed
358 #include "G3toG4.inc"
359 data rname /
'GSDVN2'/
363 if (dogeom) call gsdvn2(
name, moth, ndiv, iaxis, c0, numed)
365 if (lunlist.ne.0)
then
367 +
'(a4,1x,a6,1x,a4,1x,a4,i5,i3,(1x,e16.8),i5)')
368 +
context, rname,
name, moth, ndiv, iaxis, c0, numed
370 if (luncode.ne.0)
then
371 write(luncode,
'(''{'')')
373 write(luncode, 1000)
name,moth,ndiv,iaxis,numed
374 1000
format(
'G4gsdvn2(name="',
a,
'",moth="',
a,
'",ndiv=',i3,
',iaxis=',
375 + i1,
',c0,numed=',i4,
');')
376 write(luncode,
'(''}'')')
382 subroutine gsdvt2(name, moth, step, iaxis, c0, numed, ndvmx)
384 subroutine ksdvt2(name, moth, step, iaxis, c0, numed, ndvmx)
389 character name*4, moth*4
390 integer iaxis, numed, ndvmx
393 #include "G3toG4.inc"
394 data rname /
'GSDVT2'/
398 if (dogeom) call gsdvt2(
name, moth, step, iaxis, c0, numed, ndvmx)
400 if (lunlist.ne.0)
then
402 +
'(a4,1x,a6,1x,a4,1x,a4,(1x,e16.8),i3,(1x,e16.8),2i5)')
403 +
context, rname,
name, moth, step, iaxis, c0, numed, ndvmx
405 if (luncode.ne.0)
then
406 write(luncode,
'(''{'')')
407 call
rtocp(
'step',step)
409 write(luncode,1000)
name,moth,iaxis,numed,ndvmx
410 1000
format(
'G4gsdvt2(name="',
a,
'",moth="',
a,
'",step,iaxis=',
411 + i1,
',c0,numed=',i4,
',ndvmx=',i4,
');')
412 write(luncode,
'(''}'')')
418 subroutine gsmate(imate, name, a, z, dens, radl, absl, ubf, nwbf)
420 subroutine ksmate(imate, name, a, z, dens, radl, absl, ubf, nwbf)
426 integer imate, nwbf,
k
427 real a,
z, dens, radl, absl, ubf(nwbf)
428 character rname*6, fmt*150
429 #include "G3toG4.inc"
430 data rname /
'GSMATE'/
434 if (dogeom) call gsmate
435 + (imate,
name,
a,
z, dens, radl, absl, ubf, nwbf)
437 if (lunlist.ne.0)
then
438 write(fmt,
'(A,I3,A)')
439 >
'(a4,1x,a6,i5,1x,''"'',a,''"'',4(1x,e16.8),i3,',
440 >
max(nwbf,1),
'(1x,e16.8))'
443 + nwbf, (ubf(
k),
k=1,nwbf)
445 if (luncode.ne.0)
then
446 write(luncode,
'(''{'')')
449 call
rtocp(
'dens',dens)
450 call
rtocp(
'radl',radl)
452 write(luncode,1000) imate,
name, nwbf
453 1000
format(
'G4gsmate(imate=',i4,
',name="',
a,
454 +
'",a,z,dens,radl,npar=',i4,
',par);')
455 write(luncode,
'(''}'')')
461 subroutine gsmixt(imate, name, a, z, dens, nlmat, wmat)
463 subroutine ksmixt(imate, name, a, z, dens, nlmat, wmat)
469 integer imate, nlmat,
k, nlmata
470 real a(*),
z(*), dens, wmat(*)
471 character rname*6, fmt*150
472 #include "G3toG4.inc"
473 data rname /
'GSMIXT'/
477 if (dogeom) call gsmixt
478 + (imate,
name,
a,
z, dens, nlmat, wmat)
480 if (lunlist.ne.0)
then
482 write(fmt,
'(A,I3,A,I3,A,I3,A)')
483 +
'(a4,1x,a6,i5,1x,''"'',a,''"'',1x,e16.8,1x,i3,',
485 >
'(1x,e16.8),',
max(nlmata,1),
'(1x,e16.8),',
486 >
max(nlmata,1),
'(1x,e16.8))'
490 + (
a(
k),
k=1,abs(nlmat)),
491 + (
z(
k),
k=1,abs(nlmat)),
492 + (wmat(
k),
k=1,abs(nlmat))
494 if (luncode.ne.0)
then
495 write(luncode,
'(''{'')')
496 call
rtocp(
'dens',dens)
499 call
artocp(
'wmat',wmat,abs(nlmat))
500 write(luncode,1000) imate,
name,nlmat
501 1000
format(
'G4gsmixt(imate=',i5,
',name="',
a,
502 +
'",aa,zz,dens,nlmat=',i3,
',wmat);')
503 write(luncode,
'(''}'')')
510 + itmed,
name, nmat, isvol, ifield, fieldm,
511 + tmaxfd, stemax, deemax, epsil, stmin, ubuf, nwbuf)
514 + itmed,
name, nmat, isvol, ifield, fieldm,
515 + tmaxfd, stemax, deemax, epsil, stmin, ubuf, nwbuf)
521 integer itmed, nmat, isvol, ifield, nwbuf,
k
522 real fieldm, tmaxfd, stemax, deemax, epsil, stmin, ubuf(nwbuf)
523 character rname*6, fmt*150
524 #include "G3toG4.inc"
525 data rname /
'GSTMED'/
529 if (dogeom) call gstmed(
530 + itmed,
name, nmat, isvol, ifield, fieldm,
531 + tmaxfd, stemax, deemax, epsil, stmin, ubuf, nwbuf)
533 if (lunlist.ne.0)
then
539 write(fmt,
'(A,I3,A)')
540 >
'(a4,1x,a6,i5,1x,''"'',a,''"'',3i3,6(1x,e16.8),i3,',
541 >
max(nwbuf,1),
'(1x,e16.8))'
543 +
context, rname, itmed,
name, nmat, isvol, ifield, fieldm,
544 + tmaxfd, stemax, deemax, epsil, stmin,
545 + nwbuf, (ubuf(
k),
k=1,nwbuf)
547 if (luncode.ne.0)
then
548 write(luncode,
'(''{'')')
549 call
rtocp(
'fieldm',fieldm)
550 call
rtocp(
'tmaxfd',tmaxfd)
551 call
rtocp(
'stemax',stemax)
552 call
rtocp(
'deemax',deemax)
553 call
rtocp(
'epsil',epsil)
554 call
rtocp(
'stmin',stmin)
556 write(luncode,1000) itmed,
name,nmat,isvol,ifield,nwbuf
557 1000
format(
'G4gstmed(itmed=',i4,
',name="',
a,
'",nmat=',i4,
558 +
',isvol=',i2,
',ifield=',i2,
',',/
559 +
' fieldm,tmaxfd,stemax,deemax,epsil,stmin,par,npar=',
561 write(luncode,
'(''}'')')
567 subroutine gstpar(itmed, chpar, parval)
578 #include "G3toG4.inc"
579 data rname /
'GSTPAR'/
583 if (dogeom) call gstpar(itmed, chpar, parval)
585 if (lunlist.ne.0)
then
587 +
'(a4,1x,a6,i5,1x,a4,(1x,e16.8))')
588 +
context, rname, itmed, chpar, parval
590 if (luncode.ne.0)
then
591 write(luncode,
'(''{'')')
592 write(luncode,1000) itmed, chpar, parval
593 1000
format(
'G4gstpar(itmed=',i4,
',chpar="',
a,
'",parval=',
595 write(luncode,
'(''}'')')
602 +
ipart, chpar, itrtyp, amass,
charge, tlife, ub, nwb)
605 +
ipart, chpar, itrtyp, amass,
charge, tlife, ub, nwb)
611 integer ipart, itrtyp, nwb,
k
612 real amass,
charge, tlife, ub(nwb)
613 character rname*6, fmt*150
614 #include "G3toG4.inc"
615 data rname /
'GSPART'/
619 if (dogeom) call gspart(
620 +
ipart, chpar, itrtyp, amass,
charge, tlife, ub, nwb)
622 if (lunlist.ne.0)
then
627 write(fmt,
'(A,I3,A)')
628 >
'(a4,1x,a6,i5,1x,''"'',a,''"'',i3,3(1x,e16.8),i3,',
629 >
max(nwb,1),
'(1x,e16.8))'
633 + nwb, (ub(
k),
k=1,nwb)
635 if (luncode.ne.0)
then
636 write(luncode,
'(''{'')')
637 call
rtocp(
'amass',amass)
639 call
rtocp(
'tlife',tlife)
641 write(luncode,1000)
ipart,chpar,itrtyp,nwb
642 1000
format(
'G4gspart(ipart=',i8,
',chpar="',
a,
'",itrtyp=',i8,
643 +
',amass,charge,'/
' tlife,par,npar=',i4,
');')
644 write(luncode,
'(''}'')')
650 subroutine gsdk(ipart, bratio, mode)
652 subroutine ksdk(ipart, bratio, mode)
657 integer ipart, mode(6)
660 #include "G3toG4.inc"
665 if (dogeom) call gsdk(
ipart, bratio, mode)
667 if (lunlist.ne.0)
then
671 +
'(a4,1x,a6,i5,i3,6(1x,e16.8),6i8)')
674 if (luncode.ne.0)
then
675 write(luncode,
'(''{'')')
676 call
artocp(
'bratio',bratio,6)
677 call
aitocp(
'mode',mode,6)
678 write(luncode,1000)
ipart
679 1000
format(
'G4gsdk(ipart=',i8,
',bratio,mode);')
680 write(luncode,
'(''}'')')
686 subroutine gsdet(chset, chdet, nv, chnam, nbits, idtyp, nwhi,
689 subroutine ksdet(chset, chdet, nv, chnam, nbits, idtyp, nwhi,
695 integer nv, nbits(nv), idtyp, nwhi, nwdi, iset, idet,
k
696 character rname*6, chset*4, chdet*4, chnam(nv)*4, fmt*150
697 #include "G3toG4.inc"
698 data rname /
'GSDET '/
702 if (dogeom) call gsdet(chset, chdet, nv, chnam, nbits, idtyp,
703 + nwhi, nwdi, iset, idet)
705 if (lunlist.ne.0)
then
710 write(fmt,
'(A,I3,A,I3,A)')
'(a4,1x,a6,1x,a4,1x,a4,i5,',
711 >
max(nv,1),
'(1x,a4),',
max(nv,1),
'i10,i10,2i5)'
713 +
context, rname, chset, chdet, nv, (chnam(
k),
k=1,nv),
714 + (nbits(
k),
k=1,nv), idtyp, nwhi, nwdi
716 if (luncode.ne.0)
then
717 write(luncode,
'(''{'')')
718 call
astocp(
'chnam',chnam,nv)
719 call
aitocp(
'nbits',nbits,nv)
720 write(luncode,1000) chset, chdet, nv, idtyp, nwhi, nwdi
721 1000
format(
'G4gsdet(chset="',
a,
'",chdet="',
a,
'",nv=',i3,
722 +
',chnam,nbits,idtyp=',i8,
','/
723 +
' nwhi=',i8,
',nwdi=',i8,
');')
724 write(luncode,
'(''}'')')
730 subroutine gsdetv(chset, chdet, idtyp, nwhi, nwdi, iset, idet)
732 subroutine ksdetv(chset, chdet, idtyp, nwhi, nwdi, iset, idet)
737 integer idtyp, nwhi, nwdi, iset, idet
738 character rname*6, chset*4, chdet*4
739 #include "G3toG4.inc"
740 data rname /
'GSDETV'/
744 if (dogeom) call gsdetv(chset, chdet, idtyp,
745 + nwhi, nwdi, iset, idet)
747 if (lunlist.ne.0)
then
749 +
'(a4,1x,a6,1x,a4,1x,a4,i10,2i5)')
750 +
context, rname, chset, chdet, idtyp, nwhi, nwdi
752 if (luncode.ne.0)
then
753 write(luncode,
'(''{'')')
754 write(luncode,1000) chset, chdet, idtyp, nwhi, nwdi
755 1000
format(
'G4gsdetv(chset="',
a,
'",chdet="',
a,
'",idtyp=',i8,
756 +
',nwhi=',i8,
',nwdi=',i8,
');')
757 write(luncode,
'(''}'')')
763 subroutine gsdeta(chset, chdet, chali, nwhi, nwdi, iali)
765 subroutine ksdeta(chset, chdet, chali, nwhi, nwdi, iali)
770 integer nwhi, nwdi, iali
771 character rname*6, chset*4, chdet*4, chali*4
772 #include "G3toG4.inc"
773 data rname /
'GSDETA'/
777 if (dogeom) call gsdeta(chset, chdet, chali, nwhi, nwdi, iali)
779 if (lunlist.ne.0)
then
781 +
'(a4,1x,a6,1x,a4,1x,a4,1x,a4,2i5)')
782 +
context, rname, chset, chdet, chali, nwhi, nwdi
784 if (luncode.ne.0)
then
785 write(luncode,
'(''{'')')
786 write(luncode,1000) chset, chdet, chali, nwhi, nwdi
787 1000
format(
'G4gsdeta(chset="',
a,
'",chdet="',
a,
'",chali="',
a,
788 +
'",nwhi=',i8,
',nwdi=',i8,
');')
789 write(luncode,
'(''}'')')
795 subroutine gsdeth(chset, chdet, nh, chnam, nbits, orig, fact)
797 subroutine ksdeth(chset, chdet, nh, chnam, nbits, orig, fact)
802 integer nh, nbits(nh),
k
803 real orig(nh), fact(nh)
804 character rname*6, chset*4, chdet*4, chnam(nh)*4, fmt*150
805 #include "G3toG4.inc"
806 data rname /
'GSDETH'/
810 if (dogeom) call gsdeth(chset, chdet, nh, chnam, nbits,
813 if (lunlist.ne.0)
then
819 write(fmt,
'(A,I3,A,I3,A,I3,A,I3,A)')
820 >
'(a4,1x,a6,1x,a4,1x,a4,i5,',
max(nh,1),
'(1x,a4),',
821 >
max(nh,1),
'i5,',
max(nh,1),
'(1x,e16.8),',
max(nh,1),
824 +
context, rname, chset, chdet, nh, (chnam(
k),
k=1,nh),
825 + (nbits(
k),
k=1,nh), (orig(
k),
k=1,nh), (fact(
k),
k=1,nh)
827 if (luncode.ne.0)
then
828 write(luncode,
'(''{'')')
829 call
astocp(
'chnam',chnam,nh)
830 call
aitocp(
'nbits',nbits,nh)
831 call
artocp(
'orig',orig,nh)
832 call
artocp(
'fact',fact,nh)
833 write(luncode,1000) chset,chdet,nh
834 1000
format(
'G4gsdeth(chset="',
a,
'",chdet="',
a,
'",nh=',i4,
835 +
',chnam,nbits,orig,fact);')
836 write(luncode,
'(''}'')')
842 subroutine gsdetd(chset, chdet, nd, chnam, nbits)
844 subroutine ksdetd(chset, chdet, nd, chnam, nbits)
849 integer nd, nbits(nd),
k
850 character rname*6, chset*4, chdet*4, chnam(nd)*4, fmt*150
851 #include "G3toG4.inc"
852 data rname /
'GSDETD'/
856 if (dogeom) call gsdetd(chset, chdet, nd, chnam, nbits)
858 if (lunlist.ne.0)
then
863 write(fmt,
'(A,I3,A,I3,A)')
864 +
'(a4,1x,a6,1x,a4,1x,a4,i5,',
max(nd,1),
'(1x,a4),',
867 +
context, rname, chset, chdet, nd, (chnam(
k),
k=1,nd),
870 if (luncode.ne.0)
then
871 write(luncode,
'(''{'')')
872 call
astocp(
'chnam',chnam,nd)
873 call
aitocp(
'nbits',nbits,nd)
874 write(luncode,1000) chset, chdet, nd
875 1000
format(
'G4gsdetd(chset="',
a,
'",chdet="',
a,
'",nd=',i4,
877 write(luncode,
'(''}'')')
883 subroutine gsdetu(chset, chdet, nupar, upar)
885 subroutine ksdetu(chset, chdet, nupar, upar)
892 character rname*6, chset*4, chdet*4, fmt*150
893 #include "G3toG4.inc"
894 data rname /
'GSDETU'/
898 if (dogeom) call gsdetu(chset, chdet, nupar, upar)
900 if (lunlist.ne.0)
then
904 write(fmt,
'(A,I3,A)')
905 +
'(a4,1x,a6,1x,a4,1x,a4,i5,',
max(nupar,1),
'(1x,e16.8))'
907 +
context, rname, chset, chdet, nupar, (upar(
k),
k=1,nupar)
909 if (luncode.ne.0)
then
910 write(luncode,
'(''{'')')
912 write(luncode,1000) chset, chdet, nupar
913 1000
format(
'G4gsdetu(chset="',
a,
'",chdet="',
a,
'",npar=',
915 write(luncode,
'(''}'')')
929 #include "G3toG4.inc"
930 data rname /
'GGCLOS'/
934 if (dogeom) call ggclos
936 if (lunlist.ne.0)
then
937 write(lunlist,
'(a4,1x,a6)')
context, rname
940 if (luncode.ne.0)
then
941 write(luncode,
'(''//GeoMgr->CloseGeometry();'')')
942 write(luncode,
'(''}'')')
954 character name*4, shape*4
955 real ph, par(*),
tt, raddeg
958 raddeg = 180./3.1415926
960 if (shape(1:3).eq.
'BOX'.and.npar.ne.3)
then
961 print *,
'!! error, BOX with ',npar,
' parameters, vol ',
name
963 if (shape.eq.
'TRD1'.and.npar.ne.4)
then
964 print *,
'!! error, TRD1 with ',npar,
' parameters, vol ',
name
966 if (shape.eq.
'TRD2'.and.npar.ne.5)
then
967 print *,
'!! error, TRD2 with ',npar,
' parameters, vol ',
name
969 if (shape.eq.
'TRAP'.and.npar.ne.35.and.npar.ne.11)
then
971 print *,
'!! error, TRAP with ',npar,
' parameters, vol ',
name
973 if (shape.eq.
'TUBE'.and.npar.ne.3)
then
974 print *,
'!! error, TUBE with ',npar,
' parameters, vol ',
name
976 if (shape.eq.
'TUBS'.and.npar.ne.5)
then
977 print *,
'!! error, TUBS with ',npar,
' parameters, vol ',
name
979 if (shape.eq.
'CONE'.and.npar.ne.5)
then
980 print *,
'!! error, CONE with ',npar,
' parameters, vol ',
name
982 if (shape.eq.
'CONS'.and.npar.ne.7)
then
983 print *,
'!! error, CONS with ',npar,
' parameters, vol ',
name
985 if (shape.eq.
'SPHE'.and.npar.ne.6)
then
986 print *,
'!! error, SPHE with ',npar,
' parameters, vol ',
name
988 if (shape.eq.
'PARA'.and.npar.ne.6)
then
989 print *,
'!! error, PARA with ',npar,
' parameters, vol ',
name
991 if (shape.eq.
'PARA')
then
996 if (par(5).ne.0.) ph = atan2(par(6),par(5))*raddeg
997 tt =
sqrt(par(5)**2+par(6)**2)
998 par(4) = atan(par(4))*raddeg
999 if (par(4).gt.90.0) par(4) = par(4)-180.0
1000 par(5) = atan(
tt)*raddeg
1001 if (ph.lt.0.0) ph = ph + 360.0
1004 if (shape.eq.
'TRAP')
then
1010 if (par(2).ne.0.) ph = atan2(par(3),par(2))*raddeg
1011 tt =
sqrt(par(2)**2+par(3)**2)
1012 par(2) = atan(
tt)*raddeg
1013 if (ph.lt.0.0) ph = ph+360.0
1015 par(7) = atan(par(7))*raddeg
1016 if (par(7).gt.90.0) par(7) = par(7)-180.0
1017 par(11)= atan(par(11))*raddeg
1018 if (par(11).gt.90.0) par(11) = par(11)-180.0