ECCE @ EIC Software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
g3tog4.F
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file g3tog4.F
1 *
2 * ********************************************************************
3 * * License and Disclaimer *
4 * * *
5 * * The Geant4 software is copyright of the Copyright Holders of *
6 * * the Geant4 Collaboration. It is provided under the terms and *
7 * * conditions of the Geant4 Software License, included in the file *
8 * * LICENSE and available at http://cern.ch/geant4/license . These *
9 * * include a list of copyright holders. *
10 * * *
11 * * Neither the authors of this software system, nor their employing *
12 * * institutes,nor the agencies providing financial support for this *
13 * * work make any representation or warranty, express or implied, *
14 * * regarding this software system or assume any liability for its *
15 * * use. Please see the license in the file LICENSE and URL above *
16 * * for the full disclaimer and the limitation of liability. *
17 * * *
18 * * This code implementation is the result of the scientific and *
19 * * technical work of the GEANT4 collaboration. *
20 * * By using, copying, modifying or distributing the software (or *
21 * * any work based on the software) you agree to acknowledge its *
22 * * use in resulting scientific publications, and indicate your *
23 * * acceptance of all terms of the Geant4 Software license. *
24 * ********************************************************************
25 *
26 *
27 *
28 *
29 * G3toG4
30 *
31 * Package to convert Geant3 Fortran geometry code to a call list
32 * file to be interpreted by the Geant4 geometry call list
33 * interpreter, or alternatively, directly to Geant4 code.
34 *
35 * This set of routines is to be linked in front of, so overriding,
36 * the standard Geant library.
37 *
38 * It is possible to execute the Geant calls while at the same
39 * time building the call list/Geant4 code. In order to do this,
40 * these routines must occupy a different name space to that of
41 * the real Geant routines. This is provided by the CALL_GEANT
42 * cpp flag. If these routines are compiled with this flag,
43 * the routine names begin with K rather than G. eg. GSVOLU
44 * becomes KSVOLU. Routine names in your source code must be so
45 * converted; a perl script is provided to do this.
46 * $$$ provide the script
47 * Under normal circumstances it should *not* be necessary to go
48 * through this; it is only necessary if during the geometry
49 * generation process your code extracts information from Geant
50 * about material already generated.
51 *
52 * Torre Wenaus, LLNL 6/95
53 *
54 * To Do
55 * - option to divide generated Geant4 code into separate files/routines
56 * based on context
57 *
58 ************************************************************************
59 *
60  subroutine g3tog4(luni,lunc,chopt)
61 ************************************************************************
62 *
63 * G3toG4
64 *
65 * Initialization/setup routine
66 *
67 * luni (call list), lunc (C++ code) logical unit numbers:
68 * lun>0: Open output file on unit lun. Filenames used:
69 * g3calls.dat Call list file
70 * g4geom.cc Geant4 C++ geometry code
71 * lun<0: File open has been done by the user. Just write to |lun|
72 * lun=0: Don't generate this output.
73 * ie. luni=0: Don't generate the call list
74 * lunc=0: Don't generate the Geant4 code
75 *
76 * chopt options:
77 * 'G' execute the actual Geant calls as well as building the
78 * code/call list. In case users use info obtained from Geant
79 * during the geometry building process. THIS IS THE DEFAULT
80 * at present:
81 #define CALL_GEANT
82 *
83 ************************************************************************
84  implicit none
85  integer luni, lunc
86  character chopt*(*)
87 #include "G3toG4.inc"
88 *
89  print *,'Initializing Geant3 to Geant4 conversion'
90 #ifdef CALL_GEANT
91 c dogeom = index(chopt,'G') + index(chopt,'g') .ne. 0
92  dogeom = .true.
93 #else
94  dogeom = .false.
95 #endif
96  context = '----'
97  if (luni.eq.0.and.lunc.eq.0) then
98  print *,'G3TOG4: No output requested by user. No output'//
99  + ' will be generated.'
100  endif
101  lunlist = abs(luni)
102  luncode = abs(lunc)
103  if (lunlist.ne.0) then
104  doclist = .true.
105  else
106  doclist = .false.
107  endif
108  if (luncode.ne.0) then
109  docode = .true.
110  else
111  docode = .false.
112  endif
113 *** If lun>0, open the file
114  if (lunlist.gt.0) then
115  open(unit=lunlist,file='g3calls.dat',status='unknown')
116  endif
117  if (luncode.gt.0) then
118  nfile = 1
119  call g3source
120  endif
121 *
122  end
123 *
124  subroutine g4init
125 ************************************************************************
126 ************************************************************************
127  implicit none
128 #include "G3toG4.inc"
129 *
130  if (luncode.ne.0) then
131  write(luncode,
132  + '(''//G4GeometryManager* GeoMgr = new G4GeometryManager();'')')
133 * call ctocp('void G3G4init();')
134  endif
135 *
136  end
137 *
138  subroutine g3header
139 ************************************************************************
140 *
141 ************************************************************************
142  implicit none
143  call g4init
144  end
145 
146  subroutine g3source
147 ************************************************************************
148 *
149 ************************************************************************
150  implicit none
151 #include "G3toG4.inc"
152  character fname*30
153  if (luncode.le.0) return
154  if (nfile.gt.1) write(luncode,'(''}'')')
155  close(luncode)
156  write (fname,'(''G3toG4code_'',i2.2,''.cc'')') nfile
157  open(unit=luncode,file=fname,status='unknown')
158  write(luncode,'(''#include "G3toG4.hh"'')')
159  if (nfile.eq.1) call g3header
160  write(luncode,'(/''void G3toG4code_'',i2.2,''()'')') nfile
161  write(luncode,'(''{'')')
162  call ctocp('// init to 0 avoids "unused" warnings')
163  call ctocp('G4int nd=0,nh=0,nv=0,imate=0,itmed=0,nmat=0,')
164  call ctocp(' isvol=0,ifield=0,nwhi=0,nwdi=0,idtyp=0,ipart=0,')
165  call ctocp(' itrtyp=0,nlmat=0,npar=0,ndvmx=0,numed=0,iaxis=0,')
166  call ctocp(
167  + ' ndiv=0,irot=0,ival=0,num=0,nmed=0,nbits[100],mode[6];')
168  call ctocp('G4String chnam[100];')
169  call ctocp('G4String name="",moth="",attr="",only="",shape="";')
170  call ctocp('G4String chset="",chdet="",chali="",chpar="";')
171  call ctocp('G4double amass=0.,charge=0.,tlife=0.,parval=0.;')
172  call ctocp('G4double c0=0.,step=0.,a=0.,dens=0.,radl=0.,x=0.;')
173  call ctocp('G4double y=0.,z=0.,theta1=0.,phi1=0.,theta2=0.;')
174  call ctocp('G4double phi2=0.,theta3=0.,phi3=0.,fieldm=0.;')
175  call ctocp('G4double tmaxfd=0.,stemax=0.,deemax=0.,epsil=0.;')
176  call ctocp('G4double stmin=0.,par[100],fact[100],orig[100];')
177  call ctocp('G4double bratio[6],aa[100],zz[100],wmat[100];')
178  call ctocp('nbits[0]=mode[0]=0;chnam[0]="";par[0]=0.;')
179  call ctocp('fact[0]=orig[0]=bratio[0]=aa[0]=zz[0]=wmat[0]=0.;')
180  call ctocp(' ')
181  if (nfile.eq.1) then
182 * call ctocp('G3G4init();')
183  call ctocp(' ')
184  endif
185  end
186 
187  subroutine g3main
188 ************************************************************************
189 ************************************************************************
190  implicit none
191 #include "G3toG4.inc"
192  integer i
193 *
194  close(luncode)
195  open(unit=luncode,file='G3toG4code.cc',status='unknown')
196  do i=1,nfile
197  write(luncode,'('' void G3toG4code_'',i2.2,''();'')') i
198  enddo
199  call ctocp('void G3toG4code()')
200  call ctocp('{')
201  do i=1,nfile
202  write(luncode,'('' G3toG4code_'',i2.2,''();'')') i
203  enddo
204  call ctocp('}')
205  close(luncode)
206  end
207 
208  subroutine g3context(cntxt)
209 ************************************************************************
210 *
211 * g3context
212 *
213 * Set the current geometry code context. eg. context can be used
214 * to distinguish code for different subdetectors. The Geant4
215 * call list interpreter can then execute the code selectively for
216 * a particular context only, if desired. Spaces not allowed.
217 *
218 ************************************************************************
219  implicit none
220  character*(*) cntxt
221 #include "G3toG4.inc"
222  context = cntxt
223  end
224 *
225  subroutine ctocp(string)
226 ************************************************************************
227 ************************************************************************
228  implicit none
229  character*(*) string
230 #include "G3toG4.inc"
231  write (luncode,*) string
232  end
233 *
234  subroutine rtocp(string,x)
235 ************************************************************************
236 ************************************************************************
237  implicit none
238  character*(*) string
239  real x
240 #include "G3toG4.inc"
241  write(luncode,'(4x,a,'' = '',e14.8,'';'')')
242  + string, x
243  end
244 *
245  subroutine artocp(string,ax,n)
246 ************************************************************************
247 ************************************************************************
248  implicit none
249  character*(*) string
250  real ax(*)
251  integer n,i
252 #include "G3toG4.inc"
253  do i=1,n
254  write(luncode,'('' '',a,''['',i3,''] = '',e14.8,'';'')')
255  + string, i-1, ax(i)
256  enddo
257  end
258 *
259  subroutine aitocp(string,ai,n)
260 ************************************************************************
261 ************************************************************************
262  implicit none
263  character*(*) string
264  integer ai(*)
265  integer n,i
266 #include "G3toG4.inc"
267  do i=1,n
268  write(luncode,'('' '',a,''['',i3,''] = '',i10,'';'')')
269  + string, i-1, ai(i)
270  enddo
271  end
272 *
273  subroutine astocp(string,ac,n)
274 ************************************************************************
275 ************************************************************************
276  implicit none
277  character*(*) string, ac(*)
278  integer n,i
279 #include "G3toG4.inc"
280 c write(luncode,'('' G4String '',a,''['',i3,''];'')') string, n
281  do i=1,n
282  write(luncode,'('' '',a,''['',i3,''] = "'',a,''";'')')
283  + string, i-1, ac(i)
284  enddo
285  end
286 *
287  subroutine g3ldpar(par,npar)
288 ************************************************************************
289 *
290 * g3ldpar
291 *
292 ************************************************************************
293  implicit none
294 *
295  integer npar, i
296  real par(*)
297 #include "G3toG4.inc"
298 *
299  if (npar.gt.0) then
300  write(luncode,'('' par['',i4,''] = '',e14.8,'';'')')
301  + (i-1,par(i),i=1,npar)
302  endif
303  end
304 *
305  subroutine check_lines
306 ************************************************************************
307 ************************************************************************
308  implicit none
309 #include "G3toG4.inc"
310  if (luncode.ne.0) then
311  nlines = nlines +1
312  if (nlines.gt.maxlines) then
313  nfile = nfile +1
314  call g3source
315  nlines = 0
316  endif
317  endif
318  end