1 saw 1.1 SUBROUTINE G_initialize(ABORT,err)
2 *----------------------------------------------------------------------
3 *- Prototype hall C initialize routine
4 *-
5 *- Purpose and Methods : Initialization is performed and status returned
6 *-
7 *- Output: ABORT - success or failure
8 *- : err - reason for failure, if any
9 *-
10 *- Created 9-Nov-1993 Kevin B. Beard
11 *- Modified 20-Nov-1993 Kevin B. Beard
12 * $Log: g_initialize.f,v $
13 * Revision 1.21 1996/11/05 21:41:36 saw
14 * (SAW) Use CTP routines as functions rather than subroutines for
15 * porting.
16 *
17 * Revision 1.20 1996/09/04 14:37:56 saw
18 * (JRA) Open output file for charge scalers
19 *
20 * Revision 1.19 1996/04/29 19:47:42 saw
21 * (JRA) Add call to engine_command_line
22 saw 1.1 *
23 * Revision 1.18 1996/01/22 15:18:12 saw
24 * (JRA) Add call to g_target_initialize. Remove call to
25 * g_kludge_up_kinematics
26 *
27 * Revision 1.17 1996/01/16 18:24:47 cdaq
28 * (JRA) Get kinematics for runinfo event, create a tcl stats screen. Groupify
29 * CTP calls
30 *
31 * Revision 1.16 1995/10/09 18:42:57 cdaq
32 * (SAW) Move loading of ctp_kinematics database to before CTP loading. Take
33 * ntuple inialization out of spec specific init routines into a all ntuple
34 * init routine.
35 *
36 * Revision 1.15 1995/09/01 14:29:41 cdaq
37 * (JRA) Zero run time variable, read kinematics database after last book
38 *
39 * Revision 1.14 1995/07/27 19:36:41 cdaq
40 * (SAW) Relocate data statements for f2c compatibility, check error returns
41 * on thload calls and quit if important files are missing.
42 *
43 saw 1.1 * Revision 1.13 1995/05/22 20:41:40 cdaq
44 * (SAW) Split g_init_histid into h_init_histid and s_init_histid
45 *
46 * Revision 1.12 1995/04/01 19:47:22 cdaq
47 * (SAW) One report file for each of g, h, s, c instead of a single report file
48 * Allow %d for run number in filenames
49 *
50 * Revision 1.11 1994/10/11 18:39:40 cdaq
51 * (SAW) Add some hacks for event display
52 *
53 * Revision 1.10 1994/09/21 19:52:57 cdaq
54 * (SAW) Cosmetic change
55 *
56 * Revision 1.9 1994/08/30 14:47:41 cdaq
57 * (SAW) Add calls to clear the test flags and scalers
58 *
59 * Revision 1.8 1994/08/18 03:45:01 cdaq
60 * (SAW) Correct typo in adding hack stuff
61 *
62 * Revision 1.7 1994/08/04 03:08:11 cdaq
63 * (SAW) Add call to Breuer's hack_initialize
64 saw 1.1 *
65 * Revision 1.6 1994/06/22 20:55:14 cdaq
66 * (SAW) Load report templates
67 *
68 * Revision 1.5 1994/06/04 02:35:59 cdaq
69 * (KBB) Make sure CTP files are non-blank before trying to thload them
70 *
71 * Revision 1.4 1994/04/12 20:59:21 cdaq
72 * (SAW) Add call to calculation of histid's for hfilled histograms
73 *
74 * Revision 1.3 1994/03/24 22:02:31 cdaq
75 * Reorganize for online compatibility
76 *
77 * Revision 1.2 1994/02/11 18:34:49 cdaq
78 * Split off CTP variables registration from initialize routines
79 *
80 * Revision 1.1 1994/02/04 22:00:26 cdaq
81 * Initial revision
82 *
83 *-
84 *- All standards are from "Proposal for Hall C Analysis Software
85 saw 1.1 *- Vade Mecum, Draft 1.0" by D.F.Geesamn and S.Wood, 7 May 1993
86 *-
87 *--------------------------------------------------------
88 IMPLICIT NONE
89 SAVE
90 *
91 character*12 here
92 parameter (here= 'G_initialize')
93 *
94 logical ABORT
95 character*(*) err
96 *
97 INCLUDE 'gen_filenames.cmn' !all setup files
98 INCLUDE 'hms_filenames.cmn'
99 INCLUDE 't20_filenames.cmn'
100 INCLUDE 'coin_filenames.cmn'
101 INCLUDE 'gen_routines.dec'
102 INCLUDE 'gen_pawspace.cmn' !includes sizes of special CERNLIB space
103 INCLUDE 'gen_run_info.cmn'
104 include 'gen_scalers.cmn'
105 include 'hms_data_structures.cmn'
106 saw 1.1 include 't20_data_structures.cmn'
107 *
108 integer ierr
109 logical HMS_ABORT,T20_ABORT, HACK_ABORT
110 character*132 HMS_err,T20_err, HACK_err
111 *
112 character*132 file
113 logical*4 first_time ! Allows routine to be called
114 save first_time
115 data first_time /.true./ ! by online code
116 *
117 *--------------------------------------------------------
118 *
119 ABORT= .FALSE. !clear any old flags
120 err= ' ' !erase any old errors
121 HMS_err= ' '
122 T20_err= ' '
123 *
124 * set the runtime variable to avoid divide by zero during report
125 *
126 g_run_time = 0.0001
127 saw 1.1 *
128 * Book the histograms, tests and parameters
129 *
130 if(first_time) then
131 call HLIMIT(G_sizeHBOOK) !set in "gen_pawspace.cmn"
132 endif
133 * Load and book all the CTP files
134 *
135 *
136 if((first_time.or.g_parm_rebook).and.g_ctp_parm_filename.ne.' ') then
137 file = g_ctp_parm_filename
138 call g_sub_run_number(file,gen_run_number)
139 if(thload(file).ne.0) then
140 ABORT = .true.
141 err = file
142 endif
143 ierr = thbook() ! Assert parm values
144 endif ! so that ctp_database can override
145 *
146 *
147 * Now if there is a g_ctp_kinematics_filename set, pass the run number
148 saw 1.1 * to it to set CTP variables. Parameters placed in this file will
149 * override values defined in the CTP input files.
150 *
151 if(.not.ABORT.and.g_ctp_kinematics_filename.ne.' ') then
152 write(6,'(a,a60)') 'KINEMATICS FROM ',g_ctp_kinematics_filename(1:60)
153 call g_ctp_database(ABORT, err
154 $ ,gen_run_number, g_ctp_kinematics_filename)
155 IF(ABORT) THEN
156 call G_add_path(here,err)
157 endif
158 ENDIF
159 *
160 if((first_time.or.g_test_rebook).and.g_ctp_test_filename.ne.' ') then
161 file = g_ctp_test_filename
162 call g_sub_run_number(file,gen_run_number)
163 print *,'Test:',file
164 if(thload(file).ne.0) then
165 ABORT = .true.
166 if(err.ne.' ') then
167 call g_append(err,' & '//file)
168 else
169 saw 1.1 err = file
170 endif
171 endif
172 endif
173
174 write(6,'(a)') 'COMMAND LINE FLAGS'
175 call engine_command_line(.true.) ! Reset CTP vars from command line
176
177 * that was the last call to engine_command_line, the last time to input
178 * ctp variables. Set some here to avoid divide by zero errors if they
179 * were not read in.
180 if (hpcentral.le.0.001) hpcentral = 1.
181 if (tpcentral.le.0.001) tpcentral = 1.
182 if (htheta_lab.le.0.001) htheta_lab = 90.
183 if (ttheta_lab.le.0.001) ttheta_lab = 90.
184
185 if((first_time.or.g_hist_rebook).and.g_ctp_hist_filename.ne.' ') then
186 file = g_ctp_hist_filename
187 call g_sub_run_number(file,gen_run_number)
188 print *,'Hist:',file
189 if(thload(file).ne.0) then
190 saw 1.1 ABORT = .true.
191 if(err.ne.' ') then
192 call g_append(err,' & '//file)
193 else
194 err = file
195 endif
196 endif
197 endif
198 *
199 if(ABORT) then
200 call g_add_path(here,err)
201 return ! Don't try to proceed
202 endif
203
204 *
205 * Load the report definitions
206 *
207 if((first_time.or.g_report_rebook)
208 $ .and.g_report_template_filename.ne.' ') then
209 file = g_report_template_filename
210 call g_sub_run_number(file,gen_run_number)
211 saw 1.1 ierr = thload(file)
212 endif
213 *
214 if((first_time.or.g_report_rebook)
215 $ .and.g_stats_template_filename.ne.' ') then
216 file = g_stats_template_filename
217 call g_sub_run_number(file,gen_run_number)
218 ierr = thload(file)
219 endif
220 *
221 if((first_time.or.g_report_rebook)
222 $ .and.t_report_template_filename.ne.' ') then
223 file = t_report_template_filename
224 call g_sub_run_number(file,gen_run_number)
225 ierr = thload(file)
226 endif
227 *
228 if((first_time.or.g_report_rebook)
229 $ .and.h_report_template_filename.ne.' ') then
230 file = h_report_template_filename
231 call g_sub_run_number(file,gen_run_number)
232 saw 1.1 ierr = thload(file)
233 endif
234 *
235 if((first_time.or.g_report_rebook)
236 $ .and.c_report_template_filename.ne.' ') then
237 file = c_report_template_filename
238 call g_sub_run_number(file,gen_run_number)
239 ierr = thload(file)
240 endif
241 *
242 * Call thbook if any new files have been loaded
243 *
244 if(first_time.or.g_parm_rebook.or.g_test_rebook
245 $ .or.g_hist_rebook.or.g_report_rebook) then
246 ierr = thbook()
247 *
248 * Recalculate all histogram id's of user (hard wired) histograms
249 *
250 call h_init_histid(ABORT,err)
251 call t_init_histid(ABORT,err)
252 *
253 saw 1.1 if(g_alias_filename.ne.' ') then
254 file = g_alias_filename
255 call g_sub_run_number(file,gen_run_number)
256 ierr = thwhalias(file)
257 if (ierr.ne.0) print *,'called haliaswrite',ierr
258 endif
259 endif
260 *
261 call thtstclrg("default") ! Clear test flags
262 call thtstclsg("default") ! Clear test scalers
263 *
264 call g_target_initialize(ABORT,err)
265
266 * Open output file for charge scalers.
267 if (g_charge_scaler_filename.ne.' ') then
268 file=g_charge_scaler_filename
269 call g_sub_run_number(file,gen_run_number)
270 open(unit=G_LUN_CHARGE_SCALER,file=file,status='unknown')
271 write(G_LUN_CHARGE_SCALER,*) '!Charge scalers - Run #',gen_run_number
272 write(G_LUN_CHARGE_SCALER,*) '!event Unser(Hz) BCM1(Hz) BCM2(Hz)',
273 & ' BCM3(Hz) Time(s)'
274 saw 1.1 endif
275
276 * Open output file for epics events.
277 if (g_epics_output_filename.ne.' ') then
278 file=g_epics_output_filename
279 call g_sub_run_number(file,gen_run_number)
280 open(unit=G_LUN_EPICS_OUTPUT,file=file,status='unknown')
281 endif
282
283 *-HMS initialize
284 call H_initialize(HMS_ABORT,HMS_err)
285 *
286 *-T20 initialize
287 call T_initialize(T20_ABORT,T20_err)
288 *
289 ABORT= HMS_ABORT .or. T20_ABORT
290 If(HMS_ABORT .and. .NOT.T20_ABORT) Then
291 err= HMS_err
292 ElseIf(T20_ABORT .and. .NOT.HMS_ABORT) Then
293 err= T20_err
294 ElseIf(HMS_ABORT .and. T20_ABORT) Then
295 saw 1.1 err= '&'//T20_err
296 call G_prepend(HMS_err,err)
297 EndIf
298 *
299 IF(.NOT.ABORT) THEN
300 *
301 *-COIN initialize
302 *
303 call C_initialize(ABORT,err)
304 *
305 ENDIF
306 *
307 call g_ntuple_init(HACK_ABORT,HACK_err) ! Ingore error return for now
308 *
309 call hack_initialize(HACK_ABORT,HACK_err) ! Ignore error return for now
310 *
311 *-force reset of all space of all working arrays
312 *-(clear just zeros the index of each array)
313 IF(.NOT.ABORT) THEN
314 call G_reset_event(ABORT,err)
315 *
316 saw 1.1 ENDIF
317 *
318 IF(ABORT .or. err.NE.' ') call G_add_path(here,err)
319 *
320 first_time = .false.
321 *
322 RETURN
323 END
|