COSMOS v7.655  COSMOSv7655
(AirShowerMC)
Functions/Subroutines
copenf.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine copenf (io, fnin, icon)
 
subroutine copenfw (io, fnin, icon)
 
subroutine cskiptoeof (iodev)
 
subroutine copenfw2 (io, fnin, form, icon)
 
subroutine cskiptoeof2 (iodev, form)
 
subroutine cgetfname (fnin, fn)
 
subroutine creplst (fn, j, ch)
 
subroutine cgethost (leng, hostn)
 

Function/Subroutine Documentation

◆ cgetfname()

subroutine cgetfname ( character*(*)  fnin,
character*(*)  fn 
)

Definition at line 275 of file copenf.f.

References creplst().

Referenced by chookbgrun(), copenf(), copenfw(), copenfw2(), cwriteseed(), and xbgrun().

275  implicit none
276 
277  character*(*) fnin ! input. for %, #, @.
278  ! see the top of file.
279 
280  character*(*) fn ! output.
281 
282 
283  integer j
284  fn = ' '
285  if( fnin(1:1) == "~" ) then
286  fn = "$HOME/"//fnin(2:)
287  else
288  fn = fnin
289  endif
290  j = index( fn, '$')
291  do while ( j > 0 )
292  call creplst( fn, j, '$')
293  j = index( fn, '$')
294  enddo
295 
296  j = index(fn, '%')
297  do while ( j .gt. 0 )
298  call creplst( fn, j, '%')
299  j = index(fn, '%')
300  enddo
301 
302  j = index(fn, '#1')
303  do while ( j .gt. 0 )
304  call creplst( fn, j, 'R')
305  j = index(fn, '#1')
306  enddo
307  j = index(fn, '#2')
308  do while ( j .gt. 0 )
309  call creplst( fn, j, 'r')
310  j = index(fn, '#2')
311  enddo
312 
313  j = index(fn, '#')
314  do while ( j .gt. 0 )
315  call creplst( fn, j, '#')
316  j = index(fn, '#')
317  enddo
318 
319  j = index(fn, '@')
320  do while ( j .gt. 0 )
321  call creplst( fn, j, '@')
322  j = index(fn, '@')
323  enddo
324 
325  do
326  if(fn(1:1) /= " ") then
327  exit
328  endif
329  fn = fn(2:)
330  enddo
331 
j
********************block data cblkHeavy ********************integer j data *HeavyG2symbol *data *HeavyG2code kiron data j
Definition: cblkHeavy.h:36
creplst
subroutine creplst(fn, j, ch)
Definition: copenf.f:334
Here is the call graph for this function:
Here is the caller graph for this function:

◆ cgethost()

subroutine cgethost ( integer  leng,
character*(*)  hostn 
)

Definition at line 472 of file copenf.f.

References cerrormsg().

Referenced by cmkseed(), and creplst().

472  integer leng ! output
473  character*(*) hostn ! output
474 
475  character*1 null
476  integer kgetenv, j
477 
478  null = char(0)
479  leng = kgetenv("HOSTNAME"//null, hostn)
480  if(leng .eq. 0) then
481  leng = kgetenv("HOST"//null, hostn)
482  if(leng .eq. 0) then
483  call
484  * cerrormsg('Env. var. HOST or HOSTNAME not found',0)
485  endif
486  endif
487 
488  j =index(hostn, '.')
489 
490  if(j .gt. 0) then
491  leng = j-1
492  hostn = hostn(1:leng)
493  endif
cerrormsg
subroutine cerrormsg(msg, needrtn)
Definition: cerrorMsg.f:4
leng
integer leng
Definition: interface2.h:1
j
********************block data cblkHeavy ********************integer j data *HeavyG2symbol *data *HeavyG2code kiron data j
Definition: cblkHeavy.h:36
Here is the call graph for this function:
Here is the caller graph for this function:

◆ copenf()

subroutine copenf ( integer  io,
character(*), intent(in)  fnin,
integer  icon 
)

Definition at line 8 of file copenf.f.

References cerrormsg(), and cgetfname().

Referenced by __ccalcstdatmos.f__(), __smashskel.f__(), __smashskelsmallfileno.f__(), __smashskeltrial.f__(), checkenergy(), checkptcls(), cinisegatmos(), cinisprim0(), cmcsconstformedia(), cnrldataread(), cqversion(), crdgeomag(), crigcut0(), csampaf0(), softenpik::csoftenpik(), cstdatmos0(), cwhatjob(), and cxabyxpxsec().

8 ! io: integer. input. Fortran logical device number
9 ! fnin: character(*). input. Disk file name to be openend.
10 ! top blanks, if any, are removed.
11 ! This is needed for Gfortran(see note below)
12 ! All %, #, #1, #2, @ $ treated as follows:
13 ! $(XXX) type. XXX is regarded as enevrionmental
14 ! variable and replaced actual valu
15 ! $XXX/ or $XXX type. same as above
16 !
17 ! @ is replaced by the hostname if AtEnv is ' '
18 ! If hostname contianes domainname, only hostname
19 ! is extracted.
20 ! #1 is replaced by the initial Seed of the random number
21 ! (1st of 2 32-bit integers)
22 ! #2 is //
23 ! (2nd of 2 32 bit integers)
24 ! If # is not followed by 1 or 2, it
25 ! is replaced by unix process number if SharpEnv is ' '.
26 !
27 ! % is replaoced by YYMMDDHHMMSS if PercentEnv is ' '
28 !
29 ! In all cases above, if the corresponding variable
30 ! (AtEnv etc is non blank (say, 'XYZ'),
31 ! the envrionmental variable XYZ is assumed to exist
32 ! and its value is used instead of hostname etc.
33 ! NOTE:
34 ! Suppose a progam
35 ! integer:: i
36 ! character(10):: fname
37 ! read(*, '(i2, a)') i, fname
38 ! call copenf(11, fname, icon)
39 ! and this executable is a.out: echo 10 "input" | ./a.out
40 ! will get fname as " input". and the open statement
41 ! result in error because file " input" is non existent. (Gfortran on mac).
42 ! (don't know Linux Gfortran). If echo "input" | ... top blank is not
43 ! added.
44 ! icon: integer. output. 0--> ok
45 ! 1--> cannot be opened.
46  implicit none
47 #include "Zreadonly.h"
48 
49  character(*),intent(in):: fnin
50  logical opn, ex
51  integer io, ios, icon, klena, fornamelist
52  character*300 msg
53  character*256 fn
54 
55  fornamelist = 0
56  goto 10
57 ! ***************
58  entry copennlf(io, fnin, icon)
59 ! ***************
60  fornamelist = 1
61  10 continue
62  call cgetfname(fnin, fn)
63 ! see if already opened.
64  inquire(file=fn(1:klena(fn)), opened=opn, exist=ex)
65  if(opn) then
66  icon = 0
67  elseif(ex) then
68 #if defined (PCLinux) || defined (PCLinuxIFC) || defined (MACOSX) || defined (PCLinuxIFC8) || defined (PCLinuxIFC64) || defined (MacIFC)
69 #define SPECIAL 1
70 #define DELIM ,delim='apostrophe'
71 #else
72 #define SPECIAL 0
73 #define DELIM
74 #endif
75 
76 #ifdef ACTION_READ
77 ! for non-writable file action ='read'
78 ! is needed.
79  if(fornamelist .eq. special) then
80  open(io, file=fn(1:klena(fn)),
81  * iostat=ios, access='sequential',
82  * form='formatted', action='read' delim)
83  else
84  open(io, file=fn(1:klena(fn)),
85  * iostat=ios, access='sequential',
86  * form='formatted', action='read')
87  endif
88 #else
89  if(fornamelist .eq. special) then
90  open(io, file=fn(1:klena(fn)),
91  * iostat=ios, access='sequential',
92  * form='formatted' delim )
93  else
94  open(io, file=fn(1:klena(fn)),
95  * iostat=ios, access='sequential',
96  * form='formatted')
97  endif
98 #endif
99  if(ios .eq. 0) then
100  icon = 0
101  else
102  write(msg, *)' file=',fn(1:klena(fn)),
103  * ' exists but cannot be opened'
104  call cerrormsg(msg, 1)
105  write(msg,*) ' see copnef.f in Manager dir'
106  call cerrormsg(msg, 1)
107  icon =1
108  endif
109  else
110  write(msg, *) ' file=', fn(1:klena(fn)),' not exist'
111  call cerrormsg(msg, 1)
112  icon = 1
113  endif
cgetfname
subroutine cgetfname(fnin, fn)
Definition: copenf.f:275
cerrormsg
subroutine cerrormsg(msg, needrtn)
Definition: cerrorMsg.f:4
softenpik::special
logical, save special
Definition: csoftenPiK.f:55
klena
integer function klena(cha)
Definition: klena.f:20
Here is the call graph for this function:
Here is the caller graph for this function:

◆ copenfw()

subroutine copenfw ( integer  io,
character*(*)  fnin,
integer  icon 
)

Definition at line 122 of file copenf.f.

References cerrormsg(), and cgetfname().

Referenced by cinitracking(), cnrldatawrite(), crigcut2data(), crigcut2grid(), cwhatjob(), and outtrace().

122 !
123 ! io: integer. input. Fortran logical device number
124 ! fnin: character(*). input. Disk file name to be openend.
125 ! icon: integer. output. 0--> ok
126 ! 1--> cannot be opened.
127  implicit none
128 #include "Zreadonly.h"
129 
130  character*(*) fnin
131  logical opn, ex
132  integer io, ios, icon, klena, fornamelist
133  character*100 msg, fn
134 
135 
136  fornamelist = 0
137  goto 10
138 
139 ! *******************
140  entry copennlfw(io, fnin, icon)
141 ! *******************
142  fornamelist = 1
143  10 continue
144 
145  call cgetfname(fnin, fn)
146 ! see if already opened.
147  inquire(file=fn(1:klena(fn)), opened=opn, exist=ex)
148  if(opn) then
149  icon = 0
150  elseif(ex) then
151  if(fornamelist .eq. special) then
152  open(io, file=fn(1:klena(fn)),
153  * iostat=ios, access='sequential',
154  * form='formatted' delim )
155  else
156  open(io, file=fn(1:klena(fn)),
157  * iostat=ios, access='sequential',
158  * form='formatted')
159  endif
160 
161  if(ios .eq. 0) then
162  icon = 0
163  else
164  write(msg, *)' file=',fn(1:klena(fn)),
165  * ' exists but cannot be opened'
166  call cerrormsg(msg, 1)
167  write(msg,*) ' see copnef.f in Manager dir'
168  call cerrormsg(msg, 1)
169  icon =1
170  endif
171  else
172  if(fornamelist .eq. special) then
173  open(io, file=fn(1:klena(fn)),
174  * iostat=ios, access='sequential',
175  * form='formatted' delim )
176  else
177  open(io, file=fn(1:klena(fn)),
178  * iostat=ios, access='sequential',
179  * form='formatted')
180  endif
181  if(ios .eq. 0) then
182  icon = 0
183  else
184  icon = 3
185  endif
186  endif
cgetfname
subroutine cgetfname(fnin, fn)
Definition: copenf.f:275
cerrormsg
subroutine cerrormsg(msg, needrtn)
Definition: cerrorMsg.f:4
softenpik::special
logical, save special
Definition: csoftenPiK.f:55
klena
integer function klena(cha)
Definition: klena.f:20
Here is the call graph for this function:
Here is the caller graph for this function:

◆ copenfw2()

subroutine copenfw2 ( integer  io,
character*(*)  fnin,
integer  form,
integer  icon 
)

Definition at line 205 of file copenf.f.

References cerrormsg(), and cgetfname().

Referenced by __add2hist.f__(), __add2hyb.f__(), __add2nrfai.f__(), __bin2asciicomp.f__(), __mknrfai.f__(), __mknrfaifromdat.f__(), __reducebinsize.f__(), __reduceeachsize.bin.f__(), __reduceeachsize.binbyl.f__(), __reduceeachsize.f__(), __reducesize.f__(), __smashskel.f__(), __smashskelsmallfileno.f__(), __smashskeltrial.f__(), __timeslice.f__(), __timeslice2.f__(), chookbgrun(), convcoord(), init(), latfit(), main(), modbin2ascii::openhyb(), modzbin2ascii::openhyb(), openhyb(), timefit(), tranfit(), and xbgrun().

205  implicit none
206 !
207  integer io ! input. Fortran logical device number
208  character*(*) fnin ! input. Disk file name to be openend.
209  integer form ! input. if 1--> formatted file
210  ! 2--> binary file
211  integer icon !. output. 0 file is newly created and opened
212  ! 1 file exists and opened
213  ! 2 file has been already opened
214  ! 3 file cannot be opened.
215  logical opn, ex
216  integer ios, klena
217  character*11 format
218  character*256 fn
219 
220  if(form .eq. 1) then
221  format='formatted'
222  elseif(form .eq. 2) then
223  format='unformatted'
224  else
225  call cerrormsg(
226  * 'form input to chookopenfw is invalid',0)
227  endif
228  call cgetfname(fnin, fn) ! replace @ # etc to hostname etc
229 ! see if already opened.
230  inquire(file=fn(1:klena(fn)), opened=opn, exist=ex)
231  if(opn) then
232  icon = 2
233  elseif(ex) then
234  open(io, file=fn(1:klena(fn)),
235  * iostat=ios, access='sequential',
236  * form=format)
237  if(ios .eq. 0) then
238  icon = 1
239  else
240  call cerrormsg(fn, 1)
241  call cerrormsg(
242  * 'exists but cannot be opened', 1)
243  icon =3
244  endif
245  else
246  open(io, file=fn(1:klena(fn)),
247  * iostat=ios, access='sequential',
248  * form=format, status='new' )
249  if(ios .eq. 0) then
250  icon = 0
251  else
252  icon = 3
253  endif
254  endif
cgetfname
subroutine cgetfname(fnin, fn)
Definition: copenf.f:275
cerrormsg
subroutine cerrormsg(msg, needrtn)
Definition: cerrorMsg.f:4
klena
integer function klena(cha)
Definition: klena.f:20
Here is the call graph for this function:
Here is the caller graph for this function:

◆ creplst()

subroutine creplst ( character*(*)  fn,
integer  j,
character*1  ch 
)

Definition at line 334 of file copenf.f.

References cerrormsg(), cgethost(), cqinirn(), and kseblk().

Referenced by cgetfname().

334  implicit none
335 #include "Zmanagerp.h"
336 
337  character*(*) fn ! input. must be < 256
338  ! output
339  integer j ! input. j-th chr pos. has %, # or @ $
340  integer jj
341  character*1 ch ! input. one of %, #, @. R, r or $
342 
343  integer klena, leng, kgetpid, dummy, kgetenv2, kgetnow
344 
345  character*64 replst ! to contain hostname, etc to replace %, # of or @
346  integer ir(2)
347  character*16 envname
348  character*256 fntemp
349  integer jp
350 
351  jj = 1
352  if( ch == '$' ) then
353  if( fn(j+1:j+1) == '(' ) then
354 ! $(USER) style
355  jp =index( fn(j+1:), ')')
356  if( jp > 0 ) then
357  jj = jp + j -1
358  envname = fn(j+2:jj)
359  leng = kgetenv2(envname, replst)
360  if(leng == 0 ) then
361  write(0,*) ' envrironmetal variable =', envname
362  write(0,*) ' not found for fn=',trim(fn)
363  goto 100
364  endif
365  jj = jj + 1
366  jj = jj-j+1
367  else
368  write(0,*) ' $( is used in file name fn=',fn
369  write(0,*) ' but no counterpart ) '
370  stop
371  endif
372  else
373 ! $USER/ type or $USER only
374  jp =index( fn(j+1:), '/')
375  if( jp > 0 ) then
376  jj = jp + j-1
377 ! 1 jj
378 ! /tmp/$USER/
379  envname = fn(j+1:jj)
380  else
381  envname = trim(fn(j+1:))
382 ! USER
383  jj = len(trim(fn(j+1:)))+j
384  endif
385  leng = kgetenv2(envname, replst)
386  if(leng == 0 ) then
387  write(0,*) ' Env. =', envname, ' not exist'
388  goto 100
389  endif
390  jj = jj - j + 1
391  endif
392  endif
393 
394  if( ch .eq. '@' ) then
395  if(atenv .ne. ' ' ) then
396  leng = kgetenv2(atenv, replst)
397  if(leng .eq. 0) then
398  call cerrormsg(
399  * 'Environmental variable specified by AtEnv=', 1)
400  call cerrormsg(atenv, 1)
401  call cerrormsg(' Not exist ', 1)
402  goto 100
403  endif
404  else
405  call cgethost(leng, replst)
406  endif
407  endif
408  if( ch .eq. 'R') then
409  call cqinirn(ir)
410  replst = ' '
411  write(replst,'(i11)') ir(1)
412  call kseblk(replst, '{', leng)
413  jj=2
414  endif
415 
416  if( ch .eq. 'r') then
417  call cqinirn(ir)
418  replst = ' '
419  write(replst,'(i11)') ir(2)
420  call kseblk(replst, '{', leng)
421  jj=2
422  endif
423 
424  if( ch .eq. '#' ) then
425  if(sharpenv .ne. ' ' ) then
426  leng = kgetenv2(sharpenv, replst)
427  if(leng .eq. 0) then
428  call cerrormsg(
429  * 'Environmental variable specified by SharpEnv=', 1)
430  call cerrormsg(sharpenv, 1)
431  call cerrormsg(' Not exist ', 1)
432  goto 100
433  endif
434  else
435  replst = ' '
436  write(replst, '(i10)') kgetpid(dummy)
437  call kseblk(replst, '{', leng)
438  endif
439  endif
440 
441  if( ch .eq. '%' ) then
442  if(percentenv .ne. ' ' ) then
443  leng = kgetenv2(percentenv, replst)
444  if(leng .eq. 0) then
445  call cerrormsg(
446  * 'Environmental variable specified by PercentEnv=', 1)
447  call cerrormsg(percentenv, 1)
448  call cerrormsg(' Not exist ', 1)
449  goto 100
450  endif
451  else
452  replst = ' '
453  leng = kgetnow(replst) ! get YYMMDDHHMMSS
454  leng = klena(replst)
455  endif
456  endif
457  if( j .eq. 1 ) then
458  fntemp = replst(1:leng)//fn(j+jj:klena(fn))
459  fn = fntemp
460  else
461  fntemp =
462  * fn(1:j-1)//replst(1:leng)//fn(jj+j:)
463  fn = fntemp
464  endif
465  return
466  100 continue
467  write(0,*) ' input fn=',fn
468  stop
cerrormsg
subroutine cerrormsg(msg, needrtn)
Definition: cerrorMsg.f:4
kgetenv2
integer function kgetenv2(envname, envresult)
Definition: cgetLoginN.f:77
leng
integer leng
Definition: interface2.h:1
j
********************block data cblkHeavy ********************integer j data *HeavyG2symbol *data *HeavyG2code kiron data j
Definition: cblkHeavy.h:36
klena
integer function klena(cha)
Definition: klena.f:20
cgethost
subroutine cgethost(leng, hostn)
Definition: copenf.f:472
cqinirn
subroutine cqinirn(ir)
Definition: cwriteSeed.f:4
kseblk
subroutine kseblk(text, c, lc)
Definition: kseblk.f:18
Here is the call graph for this function:
Here is the caller graph for this function:

◆ cskiptoeof()

subroutine cskiptoeof ( integer  iodev)

Definition at line 189 of file copenf.f.

References true.

Referenced by cwhatjob().

189  implicit none
190  integer iodev
191 
192 ! skip to the end of previous write
193  do while(.true.)
194  read(iodev, *, end=100)
195  enddo
196  100 continue
true
block data cblkElemag data *AnihiE ! Eposi< 1 TeV, anihilation considered *X0/365.667/, ! radiation length of air in kg/m2 *Ecrit/81.e-3/, ! critical energy of air in GeV *MaxComptonE/1./, ! compton is considered below 1 GeV *MaxPhotoE/1.e-3/, ! above this, PhotoElectric effect neg. *MinPhotoProdE/153.e-3/, ! below 153 MeV, no gp --> hadrons ! scattering const not MeV *Knockon true
Definition: cblkElemag.h:7
Here is the caller graph for this function:

◆ cskiptoeof2()

subroutine cskiptoeof2 ( integer  iodev,
integer  form 
)

Definition at line 258 of file copenf.f.

References true.

258  implicit none
259  integer iodev ! input dev. no
260  integer form ! input 1--> ascii file
261  ! 2--> binary file
262 
263 ! skip to the end of previous write
264  do while(.true.)
265  if(form .eq. 1) then
266  read(iodev, *, end=100)
267  elseif(form .eq. 2) then
268  read(iodev, end=100)
269  endif
270  enddo
271  100 continue
true
block data cblkElemag data *AnihiE ! Eposi< 1 TeV, anihilation considered *X0/365.667/, ! radiation length of air in kg/m2 *Ecrit/81.e-3/, ! critical energy of air in GeV *MaxComptonE/1./, ! compton is considered below 1 GeV *MaxPhotoE/1.e-3/, ! above this, PhotoElectric effect neg. *MinPhotoProdE/153.e-3/, ! below 153 MeV, no gp --> hadrons ! scattering const not MeV *Knockon true
Definition: cblkElemag.h:7