EPOS/epos167/epos-app-158.f

   1 c 10.04.2003 Main program and random number generator of epos
   2 c (Do not compile it for CONEX or Corsika)
   3
   4 c-----------------------------------------------------------------------
   5       program aamain
   6 c-----------------------------------------------------------------------
   7
   8       include 'epos.inc'
   9
  10       save nopeno
  11       call aaset(0)
  12       call atitle
  13       call xiniall
  14
  15 9999  continue
  16       call aread
  17       if(nopen.eq.-1) then !after second round aread
  18         nopen=nopeno
  19         iecho=1
  20         call xiniall
  21         goto 9999
  22       endif
  23       call utpri('aamain',ish,ishini,4)
  24       if(model.ne.1)call IniModel(model)
  25
  26       if(iappl.ne.0)then
  27         do nrebin= 1,noebin
  28           call ainit
  29                                 ! if (nrebin.eq.1) call xini
  30           if(nevent.gt.0)then
  31             call aseed(2)
  32             write(ifmt,'(a,i10,a,f10.2,a)')'generate',nevent
  33      &       ,'  events for engy =',engy,'  ...'
  34             if(icotabr.eq.1)nevent=1
  35             if(icotabr.eq.1)nrevt=1
  36             if(nfull.gt.0)nevent=nfreeze*nfull
  37             if(mod(nevent,nfreeze).ne.0)
  38      &        stop'nevent must be a multiple of nfreeze!!!!!!!!!      '
  39             if(istore.ne.0) call bstora
  40             do  n=1,nevent
  41               call evgen(n)
  42               if(istore.ge.1.and.istore.le.4) call bstore
  43               if(istore.eq.5) call ustore
  44             enddo
  45             call astati
  46           else
  47             call xana
  48           endif
  49         enddo
  50         call bfinal
  51       endif
  52       if(istore.eq.3) write(ifdt,*) ' 0 0 '
  53  99   write(6,'(a)')'rewind copy-file'
  54       rewind (ifcp)
  55       nopeno=nopen
  56       nopen=-1
  57       iecho=0
  58       call utprix('aamain',ish,ishini,4)
  59       goto 9999
  60
  61       end
  62
  63       subroutine evgen(n)
  64       include 'epos.inc'
  65
  66       if(irewch.eq.1)rewind(ifch)
  67       nfr=mod(n-1,nfreeze)*ispherio
  68       if(nfr.ne.0)goto77
  69       do nin=1,iabs(ninicon)
  70         if(icotabr.eq.0)call aepos(isign(1,-ninicon)*nin)
  71         if(icocore.ne.0)call IniCon(nin)
  72       enddo
  73   77  if(ispherio.ne.0)then
  74       if(nfr.eq.0)write(ifmt,'(a)')
  75      & 'spherio evolution + hadronization ...'
  76       if(mod(nfr+1,50).eq.0)
  77      & write(ifmt,*)'hadronization ',nfr+1,' / ',nfreeze
  78 c                  call spherio2(nrevt,nfr)
  79       if(ish.ge.2)call alist('list after spherio&',1,nptl)
  80       call decayall(1)
  81       if(ish.ge.2)call alist('list after decay&',1,nptl)
  82       endif
  83       call aafinal
  84       if(iurqmd.eq.1)call urqmd
  85       call afinal
  86       call xana
  87       if(nfr+1.eq.nfreeze.or.ispherio.eq.0)call aseed(1)
  88
  89       end
  90
  91       subroutine setinp(ifname, nifname)
  92       include 'epos.inc'
  93       character*255 ifname
  94
  95       ifop=19
  96       open(UNIT=ifop,FILE=ifname(1:nifname),STATUS='UNKNOWN')
  97       write(*, '(a,a)')'Connecting input to file: ', ifname(1:nifname)
  98
  99       end
 100 c-----------------------------------------------------------------------
 101       function rangen()
 102 c-----------------------------------------------------------------------
 103 c     generates a random number
 104 c-----------------------------------------------------------------------
 105       include 'epos.inc'
 106 1     rangen=ranf()
 107       if(rangen.le.0.)goto1
 108       if(rangen.ge.1.)goto1
 109       if(irandm.eq.1)write(ifch,*)'rangen()= ',rangen
 110
 111       return
 112       end
 113
 114 c-----------------------------------------------------------------------
 115       double precision function drangen(dummy)
 116 c-----------------------------------------------------------------------
 117 c     generates a random number
 118 c-----------------------------------------------------------------------
 119       include 'epos.inc'
 120       double precision dummy,dranf
 121 1     drangen=dranf()
 122       if(drangen.le.0.d0)goto1
 123       if(drangen.ge.1.d0)goto1
 124       if(irandm.eq.1)write(ifch,*)'rangen()= ',drangen
 125
 126       return
 127       end
 128
 129 c-----------------------------------------------------------------------
 130       function cxrangen(dummy)
 131 c-----------------------------------------------------------------------
 132 c     generates a random number
 133 c-----------------------------------------------------------------------
 134       include 'epos.inc'
 135       double precision dummy
 136 1     cxrangen=ranf()
 137       if(cxrangen.le.0.)goto1
 138       if(cxrangen.ge.1.)goto1
 139       if(irandm.eq.1)write(ifch,*)'rangen()= ',cxrangen
 140
 141       return
 142       end
 143
 144 c-----------------------------------------------------------------------
 145       real function ranf()
 146 c-----------------------------------------------------------------------
 147 c     uniform random number generator from cern library
 148 c-----------------------------------------------------------------------
 149       double precision    dranf,    g900gt,   g900st
 150       double precision    ds(2),    dm(2),    dseed
 151       double precision    dx24,     dx48
 152       double precision    dl,       dc,       du,       dr
 153       logical             single
 154       data      ds     /  1665 1885.d0, 286 8876.d0  /
 155       data      dm     /  1518 4245.d0, 265 1554.d0  /
 156       data      dx24   /  1677 7216.d0  /
 157       data      dx48   /  281 4749 7671 0656.d0  /
 158       single  =  .true.
 159       goto 10
 160       entry dranf()
 161       single  =  .false.
 162   10  dl  =  ds(1) * dm(1)
 163       dc  =  dint(dl/dx24)
 164       dl  =  dl - dc*dx24
 165       du  =  ds(1)*dm(2) + ds(2)*dm(1) + dc
 166       ds(2)  =  du - dint(du/dx24)*dx24
 167       ds(1)  =  dl
 168       dr     =  (ds(2)*dx24 + ds(1)) / dx48
 169       if(single)  then
 170          ranf  =  sngl(dr)
 171       else
 172          dranf  =  dr
 173       endif
 174       return
 175       entry g900gt()
 176       g900gt  =  ds(2)*dx24 + ds(1)
 177       return
 178       entry g900st(dseed)
 179       ds(2)  =  dint(dseed/dx24)
 180       ds(1)  =  dseed - ds(2)*dx24
 181       g900st =  ds(1)
 182       return
 183       end
 184
 185 c-----------------------------------------------------------------------
 186       subroutine ranfgt(seed)
 187 c-----------------------------------------------------------------------
 188       double precision    seed,     g900gt,   g900st,   dummy
 189       seed  =  g900gt()
 190       return
 191       entry ranfst(seed)
 192       dummy  =  g900st(seed)
 193       return
 194       end