PHOS/reconstruction/iniwl_rc_v3.f

   1 c *******************     INIWL          ********************************
   2
   3         SUBROUTINE iniwl(s1gev,ampshum)
   4
   5         common /comgeom/igeomflag
   6
   7         lun=99
   8         open (lun,FILE='phos_geom_r_new.dat',FORM='FORMATTED',STATUS
   9      $       ='OLD')
  10         call rgeomnew(lun)
  11
  12 c   general walls information & geometry
  13         call rwlgen
  14         call rallwl
  15         call addwsh
  16 c coefficients
  17         iw=1
  18         cfdum=1.
  19         call rcoef(iw,nbcff,cfdum)
  20
  21 c Initialisation PHOS parameters
  22         call inisigma(s1gev,ampshum)
  23
  24         return
  25         end
  26
  27         subroutine rwlgen
  28         common /comgeom/igeomflag
  29         include 'comwlgen.for'
  30
  31         madwl(1)=0
  32
  33         nwall=1
  34
  35         idw1=104
  36         if(igeomflag.eq.2) then
  37                 jdw1=352
  38         else
  39                 jdw1=88
  40         endif
  41
  42         nwll(1)=idw1*jdw1
  43         madwl(1+1)=madwl(1)+nwll(1)
  44
  45         idimw(1)=idw1
  46         jdimw(1)=jdw1
  47         nspace(1)=0
  48
  49         dimblc(1,1)=22.
  50         dimblc(2,1)=22.
  51         dimblc(3,1)=200.
  52
  53         xyzwall(1,1)=0.
  54         xyzwall(2,1)=0.
  55         xyzwall(3,1)=0.
  56
  57         nhwl(1)=0
  58
  59         dwx=dimblc(1,1)*float(idimw(1))
  60         dwy=dimblc(2,1)*float(jdimw(1))
  61         xlbon(1,1)=-dwx/2.+xyzwall(1,1)
  62         xrbon(1,1)=dwx/2.+xyzwall(1,1)
  63         xlbon(2,1)=-dwy/2.+xyzwall(2,1)
  64         xrbon(2,1)=dwy/2.+xyzwall(2,1)
  65
  66         return
  67
  68         end
  69
  70         SUBROUTINE addwsh
  71         common /comgeom/igeomflag
  72
  73         include 'comalwl.for'
  74         include 'comwlgen.for'
  75
  76         xyzwall(1,1)=0.
  77         xyzwall(2,1)=0.
  78         xyzwall(3,1)=4600.
  79
  80         if(igeomflag.eq.1) then
  81 c       nw=1
  82 c        DO I=1,NT
  83 c       if(mm(i).gt.madwl(nw+1)) nw=nw+1
  84 c        x(1,I)=x(1,I)+XYZWALL(1,NW)
  85 c        x(2,I)=x(2,I)+XYZWALL(2,NW)
  86 c        x(3,I)=x(3,I)+XYZWALL(3,NW)
  87 c        ENDDO
  88         else
  89         endif
  90
  91         return
  92         end
  93
  94         SUBROUTINE rallwl
  95
  96         common /comgeom/igeomflag
  97         include 'comalwl.for'
  98         include 'comwlgen.for'
  99
 100         lun=20
 101
 102         OPEN (lun,FILE='geomf_old.dat',FORM='FORMATTED',status='old')
 103 c       WRITE (*,*) 'READ WALL INF from geomf_old.dat'
 104
 105         READ  (lun,*) NT
 106 c       write (*,*) ' ngl ',nt
 107         READ  (lun,*) (MM(I),I=1,NT)
 108         READ  (lun,*) (D(1,I),I=1,NT)
 109         READ  (lun,*) (D(2,I),I=1,NT)
 110         READ  (lun,*) (D(3,I),I=1,NT)
 111         READ  (lun,*) (X(1,I),I=1,NT)
 112         READ  (lun,*) (x(2,I),I=1,NT)
 113         READ  (lun,*) (x(3,I),I=1,NT)
 114         READ  (lun,*) (NS(I),I=1,NT)
 115         READ  (lun,*) (NKS(I),I=1,NT)
 116         READ  (lun,*) ((KS(J,I),J=1,10),I=1,NT)
 117              CLOSE (lun)
 118         RETURN
 119         END
 120
 121
 122         SUBROUTINE RCOEF(jw,ng,dum)
 123
 124         common /coefil/ filcff(4)
 125
 126         include 'comalwl.for'
 127         include 'comwlgen.for'
 128
 129         real dum(10)
 130
 131 c       WRITE (*,*) ' IN THIS VERSION ALL COEFFICIENTS SET TO 1. '
 132
 133         iw=jw
 134         i0w=madwl(iw)
 135         nggw=madwl(iw+1)-madwl(iw)
 136         do i=1,nggw
 137         cf(i0w+i)=dum(iw)
 138         enddo
 139
 140         return
 141         end
 142
 143         subroutine inisigma(sigph,sigpd)
 144
 145         common /comdevpar/sigmaph,sigmapd,sigphsq,sigpdsq
 146
 147         sigmaph=sigph
 148         sigmapd=sigpd
 149
 150         sigphsq=sigmaph**2
 151         sigpdsq=sigmapd**2
 152
 153 c        write (*,*) ' phe statistic ',sigph,' pedestal noise ',sigpd
 154
 155         return
 156         end
 157
 158
 159         subroutine rgeomnew(lun)
 160         include 'comarray.for'
 161
 162         read (lun,*) ncells
 163
 164         do n=1,ncells
 165         read (lun,*) idcells(n),idcelmat(n),(cellsize(k,n),k=1,3)
 166         enddo
 167
 168         read (lun,*) narray
 169
 170         do n=1,narray
 171         read (lun,*) idarray(n),idcellar(n),isizarray(n),nholes(n),
 172      ,                (ijarray(k,n),k=1,2),(sizarray(k,n),k=1,3)
 173
 174         do nh=1,nholes(n)
 175         read (lun,*) (poshole(k,nh,n),k=1,3),(sizhole(k,nh,n),k=1,3)
 176         enddo
 177         enddo
 178
 179         read (lun,*) ncompose
 180
 181         do n=1,ncompose
 182         read (lun,*) ncomparr(n),mmincomp(n),mmaxcomp(n),
 183      ,                (poscomp(k,n),k=1,3)
 184         do na=1,ncomparr(n)
 185         read (lun,*) idcomparr(na,n),mmaxcompar(na,n),
 186      ,  mmincompar(na,n),(poscompar(k,na,n),k=1,3)
 187         enddo
 188         enddo
 189
 190         read (lun,*) ipmmm
 191
 192         do n=1,ipmmm
 193         read (lun,*) mmcells(n),neibortyp(n),
 194      ,                (cellpos(k,n),k=1,3)
 195         enddo
 196
 197         close (lun)
 198         return
 199         end
 200
 201
 202
 203
 204