*** * s2code.f *** *+DECK,S2MATE. *CMZ : 2.05/21 10/06/95 12.15.55 by Hal Kalechofsky *CMZ : 2.05/07 13/05/95 13.42.33 by Hal Kalechofsky *CMZ : 1.01/00 14/07/94 13.27.24 by Hal Kalechofsky *CMZ : 1.00/00 27/02/91 13.54.33 by Nick van Eijndhoven (CERN) *-- Author : Nick van Eijndhoven (CERN) 09/11/90 SUBROUTINE S2MATE C C *** DEFINITION OF MATERIALS FOR GOLIATH *** C *** NVE 08-NOV-1990 CERN GENEVA *** C C CALLED BY : SXMATE C ORIGIN : NICK VAN EIJNDHOVEN C C IMPLICIT NONE *KEEP,SCXDB. C --- Common which contains debug flags for the various detectors --- C IDBUGF(J) = Debug level (0,1,2) for detector "J" C --- Also PAW control flag (JPAWF) for each detector added --- INTEGER NDBMAX,IDBUGF,JPAWF PARAMETER (NDBMAX=15) COMMON /SCXDB/IDBUGF(NDBMAX+1),JPAWF(NDBMAX+1) C C C aris C**> Materials for the magnet. CALL GSMATE(200,'Fe $', 55.85,26., 7.87,1.76,17.1,0,0) CALL GSMATE(201,'Cu $', 63.54,29., 8.96,1.43,14.8,0,0) CALL GSMATE(202,'Al $', 26.98,13., 2.70,8.90,37.2,0,0) C**> Leave air as material 299, always, and add vacuum as material 298. CCCCCCCC ASK ARIS ?????????????????????????????? GSMATE instead ?????? C C CALL GSTMED(298,'Mag. vac$',98,0,1,20.,0.1,0.1,0.01,0.1,0.1,0,0) C C ???????????????????????????????????????????????????????????????? CALL GSMATE(298,'Mag vac $',1.E-16,1.E-16,1.E-16,1.E16,1.E16,0,0) CALL GSMATE(299,'Mag. air$',14.61,7.3,0.001205,30420.,67500.,0,0) Crep IF (JPAWF(2) .NE. 1) GO TO 9999 CrepC Crep CALL GSMATE(299,'Air$',14.61,7.3,0.001205,30420.,67500.,0,0) C aris C 9999 CONTINUE RETURN END *+DECK,S2TMED. *CMZ : 2.05/09 15/05/95 19.11.07 by Hal Kalechofsky *CMZ : 2.05/07 15/05/95 11.37.12 by Hal Kalechofsky *CMZ : 1.01/00 14/07/94 13.27.54 by Hal Kalechofsky *CMZ : 1.00/00 27/02/91 13.55.48 by Nick van Eijndhoven (CERN) *-- Author : Nick van Eijndhoven (CERN) 09/11/90 SUBROUTINE S2TMED C C *** DEFINITION OF TRACKING MEDIA FOR GOLIATH *** C *** NVE 08-NOV-1990 CERN GENEVA *** C C CALLED BY : SXTMED C ORIGIN : NICK VAN EIJNDHOVEN C C IMPLICIT NONE *KEEP,SCXDB. C --- Common which contains debug flags for the various detectors --- C IDBUGF(J) = Debug level (0,1,2) for detector "J" C --- Also PAW control flag (JPAWF) for each detector added --- INTEGER NDBMAX,IDBUGF,JPAWF PARAMETER (NDBMAX=15) COMMON /SCXDB/IDBUGF(NDBMAX+1),JPAWF(NDBMAX+1) C C *KEEP,SCXFF. C --- Common which contains FFREAD stuff for the GWA98 package --- C --- as well as the total processed event counter --- INTEGER NSXDET,NLUNS,NPLANS REAL SXGATE,SXMAGN INTEGER ISXDET,ISXDB1,ISXDB2,JDETF,ISXTRA,JTRAF,ISXDRG,JDRGF $, ISXDRT,JDRTF,IFDRAT,ISXDCH,JDCHM,JDCHN,JDCHP,ISXLUN $, ISXOUT,JOUTF,ISXPW1,ISXPW2,IMXTAR,ISXTAR,ISXTIM $, ISXPLN,JPLNF,ISXWKS,ISXMAP,ISXVAC,ISXTUB,NSXEVT,ISXBG1 $, ISXBG2,IFPART,IFVOLU,IFMATE,IFTMED,IFVERT,IFKINE,IFSETS $, IFHITS,IFDIGI,IFSECS,IFXSEC,IFLOSS,ISXEVT,ISXCHM $, MAXNSTEP $, ISXINP,ISXDIN,ISXCOOR PARAMETER (NSXDET=15,NLUNS=8,NPLANS=15) COMMON /SCXFF/ ISXDET(NSXDET+1),ISXDB1(NSXDET+1) $, ISXDB2(NSXDET+1),JDETF(NSXDET+1) $, ISXTRA(NSXDET+1),JTRAF(NSXDET+1) $, ISXDRG(NSXDET+1),JDRGF(NSXDET+1) $, ISXDRT(NSXDET+1),JDRTF(NSXDET+1),IFDRAT $, ISXDCH,JDCHM,JDCHN,JDCHP $, ISXLUN(NLUNS),ISXOUT(NSXDET+1),JOUTF(NSXDET+1) $, ISXPW1(NSXDET+1),ISXPW2(NSXDET+1),IMXTAR $, ISXTAR,ISXTIM,SXGATE(NSXDET) $, ISXPLN(NPLANS),JPLNF(NPLANS) $, ISXWKS,SXMAGN,ISXMAP,ISXVAC,ISXTUB,NSXEVT,ISXBG1 $, ISXBG2,IFPART,IFVOLU,IFMATE,IFTMED,IFVERT,IFKINE $, IFSETS,IFHITS,IFDIGI,IFSECS $, IFXSEC,IFLOSS $, ISXEVT,ISXCHM $, MAXNSTEP $, ISXINP,ISXDIN,ISXCOOR C aris *KEEP,HITKEEP. C**> Aris Angelis' Common Block with chamber etc data, various constants,flags, C**> fake plane hits and counters, limits for random track generation. INTEGER MSACS,NSIPL,NMAPL,NTOF PARAMETER (MSACS=7) PARAMETER (NSIPL=3) PARAMETER (NMAPL=3) PARAMETER (NTOF=2) INTEGER NSIMA,NSIMA1,NSIMAM,NSMMT INTEGER IRANIN,IRANUT,NPLACC,NFAKPL,IFLAT,NINFLD INTEGER NIOFLD,NSTEPS,NSIPRI,NSISEC,IFORM,NOPADS, & NMAPRI,NMASEC,NCHPRI,NCHSEC, & NTFPRI,NTFSEC,NTRPRI,NTRSEC, & NTRTF1,NTRTF2,NTRTF3,NEVONE, & NSCTF1,NSCTF2,NSCTF3, & NPINEG,NKANEG,NPBARS,NPIPOS,NKAPOS,NPROTS,NNEUTS,NPROUT,NSCOUT, & MPINEG,MKANEG,MPBARS,MPIPOS,MKAPOS,MPROTS,MNEUTS,JEVENT,MYEVNT, & NSPHOT,NSPOSI,NSELEC,NSNENO,NSMUPO,NSMUNE,NSPIPO,NSPINE,NSPIZE, & NSKAPO,NSKANE,NSKAZE,NSPROT,NSPBAR,NSNEUT,NSECXX,NEVNTS,NSECND INTEGER LIMLO,LIMHI,LIMHIX REAL DZTAR,BFACT,BETAD,TILTD,TRAD,ZCL,ZCL0,DOUT REAL XMAGPL,YMAGPL,ZMAGPL,XSIDPL,YSIDPL,ZSIDPL, & XPLANE,YPLANE,ZPLANE,ZEXT12,ZEXT37, & XLOLIM,XHILIM,YLOLIM,YHILIM, & XTOFPL,YTOFPL,ZTOFPL,BDLX,BDLY,BDLZ, & XTOFLO,XTOFHI,YTOFLO,YTOFHI,Z1REF,Z2REF REAL DCH12X,DCH12Y,DCH37X,DCH37Y,DTOFX,DTOFY,ZPREF, & XFAC12,YFAC12,XFAC37,YFAC37,XFACTF,YFACTF, & DIPMIN,DIPMAX,DIPRNG,OPNMIN,OPNMAX,OPNRNG,PINMIN,PINMAX,PINRNG, & PPMIN,PPMAX,PRNG,DIPLO,DIPHI,OPNLO,OPNHI,PMOMLO,PMOMHI, & Y0LO,Y0HI,X0LO,X0HI,YPLO,YPHI,XPLO,XPHI,TKLPLO,TKLPHI, & XMINX,XMINY,XMINZ,YMINX,YMINY,YMINZ,BXMIN,BYMIN,BZMIN, & XMAXX,XMAXY,XMAXZ,YMAXX,YMAXY,YMAXZ,BXMAX,BYMAX,BZMAX, C & BXMINX,BXMINY,BXMINZ,BYMINX,BYMINY,BYMINZ,BZMINX,BZMINY,BZMINZ, C & BXMAXX,BXMAXY,BXMAXZ,BYMAXX,BYMAXY,BYMAXZ,BZMAXX,BZMAXY,BZMAXZ, & XINOUT,YINOUT,ZINOUT,TTHICK COMMON /MYCOMM/ NSIMA,NSIMA1,NSIMAM,NSMMT, & DZTAR,BFACT,BETAD,TILTD,TRAD,ZCL,ZCL0,DOUT,IRANIN,IRANUT, & NPLACC,NFAKPL,XMAGPL(1:NMAPL),YMAGPL(1:NMAPL),ZMAGPL(1:NMAPL), & XSIDPL(1:NSIPL),YSIDPL(1:NSIPL),ZSIDPL(1:NSIPL),IFLAT,NINFLD, & XPLANE(1:MSACS),YPLANE(1:MSACS),ZPLANE(1:MSACS),ZEXT12,ZEXT37, & XLOLIM(1:MSACS),XHILIM(1:MSACS),YLOLIM(1:MSACS),YHILIM(1:MSACS), & XTOFPL(1:NTOF),YTOFPL(1:NTOF),ZTOFPL(1:NTOF),BDLX,BDLY,BDLZ, & XTOFLO(1:NTOF),XTOFHI(1:NTOF),YTOFLO(1:NTOF),YTOFHI(1:NTOF), & NIOFLD,NSTEPS,NSIPRI(1:NSIPL),NSISEC(1:NSIPL),IFORM,NOPADS, & NMAPRI(1:NMAPL),NMASEC(1:NMAPL),NCHPRI(1:MSACS),NCHSEC(1:MSACS), & NTFPRI(1:NTOF),NTFSEC(1:NTOF),NTRPRI(0:MSACS),NTRSEC(0:MSACS), & NTRTF1(0:MSACS),NTRTF2(0:MSACS),NTRTF3(0:MSACS),NEVONE, & NSCTF1(0:MSACS),NSCTF2(0:MSACS),NSCTF3(0:MSACS),Z1REF,Z2REF, & NPINEG,NKANEG,NPBARS,NPIPOS,NKAPOS,NPROTS,NNEUTS,NPROUT,NSCOUT, & MPINEG,MKANEG,MPBARS,MPIPOS,MKAPOS,MPROTS,MNEUTS,JEVENT,MYEVNT, & NSPHOT,NSPOSI,NSELEC,NSNENO,NSMUPO,NSMUNE,NSPIPO,NSPINE,NSPIZE, & NSKAPO,NSKANE,NSKAZE,NSPROT,NSPBAR,NSNEUT,NSECXX,NEVNTS,NSECND, & DCH12X,DCH12Y,DCH37X,DCH37Y,DTOFX,DTOFY,ZPREF, & XFAC12,YFAC12,XFAC37,YFAC37,XFACTF,YFACTF,LIMLO,LIMHI,LIMHIX, & DIPMIN,DIPMAX,DIPRNG,OPNMIN,OPNMAX,OPNRNG,PINMIN,PINMAX,PINRNG, & PPMIN,PPMAX,PRNG,DIPLO,DIPHI,OPNLO,OPNHI,PMOMLO,PMOMHI, & Y0LO,Y0HI,X0LO,X0HI,YPLO,YPHI,XPLO,XPHI,TKLPLO,TKLPHI, & XMINX,XMINY,XMINZ,YMINX,YMINY,YMINZ,BXMIN,BYMIN,BZMIN, & XMAXX,XMAXY,XMAXZ,YMAXX,YMAXY,YMAXZ,BXMAX,BYMAX,BZMAX, C & BXMINX,BXMINY,BXMINZ,BYMINX,BYMINY,BYMINZ,BZMINX,BZMINY,BZMINZ, C & BXMAXX,BXMAXY,BXMAXZ,BYMAXX,BYMAXY,BYMAXZ,BZMAXX,BZMAXY,BZMAXZ, & XINOUT(1:12),YINOUT(1:12),ZINOUT(1:12),TTHICK C aris C C aris C**> Use small enough step size for accurate tracking, C**> replace the wrong parameter values by NvE. C**> Retain two sets of tracking media parameters, for field-on and -off. IF (SXMAGN.NE.0.) THEN CALL GSTMED(200,'Fe plate $',200,0,1,20., & 1.,1.,0.1,0.1,0.1,0,0) CALL GSTMED(201,'Cu coil $',201,0,1,20., & 1.,1.,0.1,0.1,0.1,0,0) CALL GSTMED(202,'Al coil $',202,0,1,20., & 1.,1.,0.1,0.1,0.1,0,0) CALL GSTMED(298,'Mag vac $',298,0,1,20., & 0.1,0.1,0.01,0.1,0.1,0,0) CALL GSTMED(299,'Mag air $',299,0,1,20., & 0.1,0.1,0.01,0.1,0.1,0,0) ELSEIF (SXMAGN.EQ.0.) THEN CALL GSTMED(200,'Fe plate $',200,0,0,0., & 1.,1.,0.1,0.1,0.1,0,0) CALL GSTMED(201,'Cu coil $',201,0,0,0., & 1.,1.,0.1,0.1,0.1,0,0) CALL GSTMED(202,'Al coil $',202,0,0,0., & 1.,1.,0.1,0.1,0.1,0,0) CALL GSTMED(298,'Mag vac $',298,0,0,0., & 0.1,0.1,0.01,0.1,0.1,0,0) CALL GSTMED(299,'Mag air $',299,0,0,0., & 0.1,0.1,0.01,0.1,0.1,0,0) ENDIF Crep CALL GSTMED(200,'Fe plate $',200,0,0,0.,10.,1.,0.1,0.10,0.10,0,0) Crep CALL GSTMED(201,'Cu coil $',201,0,0,0.,10.,1.,0.1,0.10,0.10,0,0) Crep CALL GSTMED(202,'Al coil $',202,0,0,0.,10.,1.,0.1,0.10,0.10,0,0) C aris C C --- Energy cut-offs in the metal to gain time in tracking --- CALL GSTPAR(200,'CUTGAM',0.5) CALL GSTPAR(200,'CUTELE',0.5) CALL GSTPAR(200,'CUTNEU',0.5) CALL GSTPAR(200,'CUTHAD',0.5) CALL GSTPAR(201,'CUTGAM',0.5) CALL GSTPAR(201,'CUTELE',0.5) CALL GSTPAR(201,'CUTNEU',0.5) CALL GSTPAR(201,'CUTHAD',0.5) CALL GSTPAR(202,'CUTGAM',0.5) CALL GSTPAR(202,'CUTELE',0.5) CALL GSTPAR(202,'CUTNEU',0.5) CALL GSTPAR(202,'CUTHAD',0.5) C C aris C**> Remove code by NvE. Crep IF (JPAWF(2) .NE. 1) GO TO 9999 CrepC Crep CALL GSTMED(299,'Air plane$',299,1,0,0.,10.,1.,0.1,0.01,0.01,0,0) C aris C 9999 CONTINUE RETURN END *+DECK,S2GEOM. *CMZ : 2.05/07 13/05/95 13.42.33 by Hal Kalechofsky *CMZ : 1.06/00 12/09/94 17.05.23 by Hal Kalechofsky *CMZ : 1.01/00 14/07/94 16.20.38 by Hal Kalechofsky *CMZ : 1.00/00 05/04/91 14.31.41 by Nick van Eijndhoven (CERN) *-- Author : Nick van Eijndhoven (CERN) 09/11/90 SUBROUTINE S2GEOM C C *** DEFINITION OF THE GEOMETRY OF GOLIATH *** C *** NVE 08-NOV-1990 CERN GENEVA *** C C CALLED BY : SXGEOM C ORIGIN : NICK VAN EIJNDHOVEN C C IMPLICIT NONE *KEEP,SCXDB. C --- Common which contains debug flags for the various detectors --- C IDBUGF(J) = Debug level (0,1,2) for detector "J" C --- Also PAW control flag (JPAWF) for each detector added --- INTEGER NDBMAX,IDBUGF,JPAWF PARAMETER (NDBMAX=15) COMMON /SCXDB/IDBUGF(NDBMAX+1),JPAWF(NDBMAX+1) C *KEEP,SCXGEO. C --- Common which contains some general geometry parameters --- REAL DWA98,DWMAG,DTARG $, DWA98X,DWA98Y,DWA98Z $, DMAGNX,DMAGNY,DMAGNZ $, DTARGX,DTARGY,DTARGZ $, XTARG,YTARG,ZTARG,XMAG,YMAG,ZMAG COMMON /SCXGEO/ DWA98(3),DWMAG(3),DTARG(3) $, DWA98X,DWA98Y,DWA98Z $, DMAGNX,DMAGNY,DMAGNZ $, DTARGX,DTARGY,DTARGZ $, XTARG,YTARG,ZTARG,XMAG,YMAG,ZMAG C C aris *KEEP,SCXFF. C --- Common which contains FFREAD stuff for the GWA98 package --- C --- as well as the total processed event counter --- INTEGER NSXDET,NLUNS,NPLANS REAL SXGATE,SXMAGN INTEGER ISXDET,ISXDB1,ISXDB2,JDETF,ISXTRA,JTRAF,ISXDRG,JDRGF $, ISXDRT,JDRTF,IFDRAT,ISXDCH,JDCHM,JDCHN,JDCHP,ISXLUN $, ISXOUT,JOUTF,ISXPW1,ISXPW2,IMXTAR,ISXTAR,ISXTIM $, ISXPLN,JPLNF,ISXWKS,ISXMAP,ISXVAC,ISXTUB,NSXEVT,ISXBG1 $, ISXBG2,IFPART,IFVOLU,IFMATE,IFTMED,IFVERT,IFKINE,IFSETS $, IFHITS,IFDIGI,IFSECS,IFXSEC,IFLOSS,ISXEVT,ISXCHM $, MAXNSTEP $, ISXINP,ISXDIN,ISXCOOR PARAMETER (NSXDET=15,NLUNS=8,NPLANS=15) COMMON /SCXFF/ ISXDET(NSXDET+1),ISXDB1(NSXDET+1) $, ISXDB2(NSXDET+1),JDETF(NSXDET+1) $, ISXTRA(NSXDET+1),JTRAF(NSXDET+1) $, ISXDRG(NSXDET+1),JDRGF(NSXDET+1) $, ISXDRT(NSXDET+1),JDRTF(NSXDET+1),IFDRAT $, ISXDCH,JDCHM,JDCHN,JDCHP $, ISXLUN(NLUNS),ISXOUT(NSXDET+1),JOUTF(NSXDET+1) $, ISXPW1(NSXDET+1),ISXPW2(NSXDET+1),IMXTAR $, ISXTAR,ISXTIM,SXGATE(NSXDET) $, ISXPLN(NPLANS),JPLNF(NPLANS) $, ISXWKS,SXMAGN,ISXMAP,ISXVAC,ISXTUB,NSXEVT,ISXBG1 $, ISXBG2,IFPART,IFVOLU,IFMATE,IFTMED,IFVERT,IFKINE $, IFSETS,IFHITS,IFDIGI,IFSECS $, IFXSEC,IFLOSS $, ISXEVT,ISXCHM $, MAXNSTEP $, ISXINP,ISXDIN,ISXCOOR C C aris C INTEGER I REAL X,Y,Z,DY,GAP REAL DGFEB(3),DGFCT(3),DGFCB(3) $, DGALC(3),DGCUC(3) $, DGPBO(3),DGPTO(11) $, DGPBN(3),DGPTN(4) $, DPLAN(3) C C aris C**> Fe plates and holes. DIMENSION DGPL1(1:3),DGPL2(1:3),DGHOL(1:3) C aris C DATA DGFEB /225.0 , 28.5 ,180.0 / DATA DGFCT / 0.0 ,100.0 , 22.5 / DATA DGFCB / 0.0 ,100.0 , 15.0 / DATA DGALC /102.05,164.7 , 22.1 / DATA DGCUC /102.05,164.7 , 14.9 / DATA DGPBO / 39.0 ,-99.9 , 45.0 / DATA DGPBN / 22.0 ,-99.9 , 60.0 / DATA DGPTO /-99.,0.,0.,28.5,45.,16.5,26.57,28.5,45.,16.5,26.57/ C aris C**> Avoid triangular trapezia. DATA DGPTN /60.,0.5,-99.,30./ Crep DATA DGPTN / 60.,0.,-99.,30./ C aris C aris C**> Half lengths of box representing green Fe plate. DATA DGPL1 / 119.5, 97.0, 6.0 / C**> Half lengths of box representing new Fe plate. DATA DGPL2 / 119.5, 97.0, 4.0 / C**> Half length of side of box representing the hole in the plates. DATA PLHOLE / 40. / C**> Air gap between the two Fe plates. DATA AIRGAP / 2. / C**> Z of centre of green Fe plate relative to magnet centre. DATA ZPL1 / -186. / C aris C C *** Define the various elements of GOLIATH *** C C --- Adapt pillar height to gap size --- GAP=160. DGPBO(2)=DGFCT(3)+DGFCB(3)+GAP/2. DGPTO(1)=DGPBO(2) DGPBN(2)=DGPBO(2) DGPTN(3)=DGPBO(2) C C --- Fit fake planes into the gap --- DPLAN(1)=0.01 DPLAN(2)=GAP/2. DPLAN(3)=(ABS(ZTARG-ZMAG)+DGFEB(3))/2. C C --- Lift the magnet by 7.5 cm to get symmetric beam line --- DY=7.5 C C --- The iron top and bottom plates --- CALL GSVOLU('GFEB','BOX ',200,DGFEB,3,I) X=0. Y=DGPBO(2)+DGFEB(2)+DY Z=0. CALL GSPOS('GFEB',1,'WMAG',X,Y,Z,0,'ONLY') Y=-DGPBO(2)-DGFEB(2)+DY CALL GSPOS('GFEB',2,'WMAG',X,Y,Z,0,'ONLY') C C --- Define rotation matrix for the cylinders and coils --- CALL GSROTM(200,90.,0.,180.,90.,90.,90.) C --- Define rotation matrix for the trapezoids of the old pillars --- CALL GSROTM(201,180.,0.,90.,180.,90.,90.) CALL GSROTM(202,180.,0.,90.,0.,90.,270.) C --- Define rotation matrix for the trapezoids of the new pillars --- CALL GSROTM(203,0.,0.,90.,90.,90.,180.) CALL GSROTM(204,0.,0.,90.,90.,90.,0.) C C --- The iron cylinder filling the inside of the top coil --- CALL GSVOLU('GFCT','TUBE',200,DGFCT,3,I) Y=DGPBO(2)-DGFCT(3)+DY CALL GSPOS('GFCT',1,'WMAG',X,Y,Z,200,'ONLY') C --- The iron cylinder filling the inside of the bottom coil --- CALL GSVOLU('GFCB','TUBE',200,DGFCB,3,I) Y=-DGPBO(2)+DGFCB(3)+DY CALL GSPOS('GFCB',1,'WMAG',X,Y,Z,200,'ONLY') C --- The aluminium top coil --- CALL GSVOLU('GALC','TUBE',202,DGALC,3,I) Y=DGPBO(2)-DGALC(3)+DY CALL GSPOS('GALC',1,'WMAG',X,Y,Z,200,'ONLY') C --- The copper bottom coil --- CALL GSVOLU('GCUC','TUBE',201,DGCUC,3,I) Y=-DGPBO(2)+DGCUC(3)+DY CALL GSPOS('GCUC',1,'WMAG',X,Y,Z,200,'ONLY') C --- The iron support pillars --- C --- The old pillars at the back --- CALL GSVOLU('GPBO','BOX ',200,DGPBO,3,I) X=DGFEB(1)-DGPBO(1) Y=DY Z=-DGFEB(3)+DGPBO(3) CALL GSPOS('GPBO',1,'WMAG',X,Y,Z,0,'ONLY') CALL GSPOS('GPBO',2,'WMAG',-X,Y,Z,0,'ONLY') CALL GSVOLU('GPTO','TRAP',200,DGPTO,11,I) X=X-DGPBO(1)-DGPTO(4) Y=DY Z=-DGFEB(3)+(DGPTO(5)+DGPTO(6))/2. CALL GSPOS('GPTO',1,'WMAG',X,Y,Z,201,'ONLY') CALL GSPOS('GPTO',2,'WMAG',-X,Y,Z,202,'ONLY') C --- The new pillars in the front --- CALL GSVOLU('GPBN','BOX ',200,DGPBN,3,I) X=DGFEB(1)-DGPBN(1) Y=DY Z=DGFEB(3)-DGPBN(3) CALL GSPOS('GPBN',1,'WMAG',X,Y,Z,0,'ONLY') CALL GSPOS('GPBN',2,'WMAG',-X,Y,Z,0,'ONLY') CALL GSVOLU('GPTN','TRD1',200,DGPTN,4,I) X=X-DGPBN(1)-DGPTN(4) Y=DY CALL GSPOS('GPTN',1,'WMAG',X,Y,Z,203,'ONLY') CALL GSPOS('GPTN',2,'WMAG',-X,Y,Z,204,'ONLY') C aris C**> Create the boxes making up the two plates, fill with Fe. CALL GSVOLU('GPL1','BOX ',200,DGPL1,3,I) CALL GSVOLU('GPL2','BOX ',200,DGPL2,3,I) C**> Create the box making up the hole, fill with air or vacuum as the C**> case may be and place at the centre of each plate. DGHOL(1)=PLHOLE DGHOL(2)=PLHOLE DGHOL(3)=DGPL1(3) IF (ISXVAC.EQ.1) CALL GSVOLU('GHL1','BOX ',298,DGHOL,3,I) IF (ISXVAC.EQ.0) CALL GSVOLU('GHL1','BOX ',299,DGHOL,3,I) CALL GSPOS('GHL1',1,'GPL1',0.,0.,0.,0,'ONLY') DGHOL(3)=DGPL2(3) IF (ISXVAC.EQ.1) CALL GSVOLU('GHL2','BOX ',298,DGHOL,3,I) IF (ISXVAC.EQ.0) CALL GSVOLU('GHL2','BOX ',299,DGHOL,3,I) CALL GSPOS('GHL2',1,'GPL2',0.,0.,0.,0,'ONLY') C**> Position the two plates at the entrance to the magnet. CALL GSPOS('GPL1',1,'WMAG',0.,0.,ZPL1,0,'ONLY') ZPL2=ZPL1-DGPL1(3)-DGPL2(3)-AIRGAP CALL GSPOS('GPL2',1,'WMAG',0.,0.,ZPL2,0,'ONLY') C aris C CCC ASK ARIS ???????????? IF (JPAWF(2) .NE. 1) GO TO 9999 C C --- Define the plane box volume and fill with air --- CALL GSVOLU('GPLN','BOX ',299,DPLAN,3,I) C --- Place the PLANES in WMAG 20cm from the beam, starting at Z target X=20. Y=0. Z=ZTARG-ZMAG+DPLAN(3) Cbeg C**> Block internal magnet air planes. C CALL GSPOS('GPLN',1,'WMAG',X,Y,Z,0,'ONLY') C CALL GSPOS('GPLN',2,'WMAG',-X,Y,Z,0,'ONLY') Crep CALL GSPOS('GPLN',1,'WMAG',X,Y,Z,0,'ONLY') Crep CALL GSPOS('GPLN',2,'WMAG',-X,Y,Z,0,'ONLY') Cend C Cbeg C**> Block internal magnet air planes. CrepC Crep IF (JPAWF(2) .NE. 1) GO TO 9999 CrepC C**> Define the plane box volume and fill with air or vacuum. C IF (ISXVAC.EQ.1) CALL GSVOLU('GPLN','BOX ',298,DPLAN,3,I) C IF (ISXVAC.EQ.0) CALL GSVOLU('GPLN','BOX ',299,DPLAN,3,I) CrepC --- Define the plane box volume and fill with air --- Crep CALL GSVOLU('GPLN','BOX ',299,DPLAN,3,I) CC --- Place the PLANES in WMAG 20cm from the beam, starting at Z target C X=20. C Y=0. C Z=ZTARG-ZMAG+DPLAN(3) Crep CALL GSPOS('GPLN',1,'WMAG',X,Y,Z,0,'ONLY') Crep CALL GSPOS('GPLN',2,'WMAG',-X,Y,Z,0,'ONLY') Cend C CCCCCCCC ASK ARIS ??????????? C --- Set the seen attributes for the drawings --- 9999 CONTINUE CALL GSATT('GFEB','SEEN',-2) CALL GSATT('GPBO','SEEN',-2) CALL GSATT('GPTO','SEEN',-2) CALL GSATT('GPBN','SEEN',-2) CALL GSATT('GPTN','SEEN',-2) CALL GSATT('GALC','SEEN',-2) CALL GSATT('GCUC','SEEN',-2) CALL GSATT('GFCT','SEEN',0) CALL GSATT('GFCB','SEEN',0) C aris C**> Set the "seen" attributes for the drawings. CALL GSATT('GPL1','SEEN',-2) CALL GSATT('GPL2','SEEN',-2) CALL GSATT('GHL1','SEEN',-2) CALL GSATT('GHL2','SEEN',-2) C aris RETURN END *+DECK,S2SENS. *CMZ : 1.01/00 14/07/94 16.23.15 by Hal Kalechofsky *CMZ : 1.00/00 09/11/90 11.21.51 by Nick van Eijndhoven (CERN) *-- Author : Nick van Eijndhoven (CERN) 09/11/90 SUBROUTINE S2SENS C C *** DEFINE (SETS OF) SENSITIVE DETECTOR ELEMENTS FOR GOLIATH *** C *** NVE 08-NOV-1990 CERN GENEVA *** C C CALLED BY : SXSENS C ORIGIN : NICK VAN EIJNDHOVEN C IMPLICIT NONE *KEEP,SCXDB. C --- Common which contains debug flags for the various detectors --- C IDBUGF(J) = Debug level (0,1,2) for detector "J" C --- Also PAW control flag (JPAWF) for each detector added --- INTEGER NDBMAX,IDBUGF,JPAWF PARAMETER (NDBMAX=15) COMMON /SCXDB/IDBUGF(NDBMAX+1),JPAWF(NDBMAX+1) C C INTEGER NV,NH,IDET,ISET PARAMETER (NV=1,NH=5) INTEGER NBITSV(NV),NBITSH(NH) CHARACTER*4 NAMESV(NV),NAMESH(NH) REAL ORIG(NH),FACT(NH) C DATA NBITSV /NV*8 / DATA NBITSH /NH*24/ DATA ORIG /1000.,1000.,0.,2.,0./ DATA FACT /NH*1000./ C IF (JPAWF(2) .NE. 1) GO TO 9999 C C --- Define the planes for particle flux measurements as sensitive --- NAMESV(1)='GPLN' C NAMESH(1)='Y' NAMESH(2)='Z' NAMESH(3)='PART' NAMESH(4)='CHRG' NAMESH(5)='P' C CALL GSDET('GPLN','GPLN',1,NAMESV,NBITSV,201,1000,1000,ISET,IDET) CALL GSDETH('GPLN','GPLN',NH,NAMESH,NBITSH,ORIG,FACT) C 9999 CONTINUE RETURN END *+DECK,S2DRAW. *CMZ : 1.01/00 14/07/94 16.23.39 by Hal Kalechofsky *CMZ : 1.00/00 27/02/91 14.01.54 by Nick van Eijndhoven (CERN) *-- Author : Nick van Eijndhoven (CERN) 09/11/90 SUBROUTINE S2DRAW C C *** DRAWING OF THE GOLIATH LAYOUT *** C *** NVE 08-NOV-1990 CERN GENEVA *** C C CALLED BY : SXDRAW C ORIGIN : NICK VAN EIJNDHOVEN C IMPLICIT NONE C%%% CALL GDTREE('WMAG',0,011111) CALL GDFSPC('WMAG',0,0) C RETURN END *+DECK,S2END. *CMZ : 1.01/00 14/07/94 16.25.17 by Hal Kalechofsky *CMZ : 1.00/00 09/11/90 11.21.51 by Nick van Eijndhoven (CERN) *-- Author : Nick van Eijndhoven (CERN) 09/11/90 SUBROUTINE S2END C C *** TERMINATION OF THE GOLIATH SIMULATION AT THE END OF A RUN *** C *** NVE 08-NOV-1990 CERN GENEVA *** C C CALLED BY : SXEND C ORIGIN : NICK VAN EIJNDHOVEN C IMPLICIT NONE PRINT 1000 1000 FORMAT(1H /1H ,36('*'),' S2END ',36('*')/ $ 1H ,20X,'GOLIATH simulation package terminated'/ $ 1H ,80('*')) C RETURN END *+DECK,S2FLREAD. Subroutine S2FLREAD. *CMZ : 2.05/32 22/06/95 13.15.42 by Hal Kalechofsky *CMZ : 2.05/29 21/06/95 17.51.03 by Hal Kalechofsky *CMZ : 2.05/02 04/05/95 18.10.02 by Hal Kalechofsky *CMZ : 2.01/00 17/03/95 10.08.52 by Hal Kalechofsky *CMZ : 2.00/00 16/03/95 18.01.07 by Hal Kalechofsky *CMZ : 1.00/00 09/03/95 15.06.18 by Aris Angelis *>--------------------------------------------------------------------<* * This routine reads in the magnetic field components at all points * * of the magnetic field volume measured in November and December 1993 * * and puts them in common blocks. Two levels of debug printout are * * provided, for idbg = 1 and idbg >= 2. * * Work on this project started on 17 August 1994 * * Latest update 16 March 1995 * * Aris L. S. Angelis * * Latest update 29 April 1995 * * Read magnetic field map from WA98 database. * * Hal Kalechofsky * *>--------------------------------------------------------------------<* SUBROUTINE S2FLREAD(IDBG) *>--------------------------------------------------------------------<* * The measured magnetic field volume is divided into six Boxes, * * slices along Z, the boundary regions being filled in from different * * grid files in order to provide a smooth transition from Box to Box * * along Z. Field map data is put into common blocks, one common block * * per Box. Parameter statements define the index limits for each Box, * * indices i,j,k corresponding to coordinates x,y,z. * *>--------------------------------------------------------------------<* C IMPLICIT NONE *KEEP,S2FLDMAP. C**> Box #1, The Upstream Fringe Field, from Up1Gri98 & Up2Gri98 files. PARAMETER (IMIN1=-9,IMAX1=+9) PARAMETER (JMIN1=-9,JMAX1=+9) PARAMETER (KMIN1=-167,KMAX1=-90) COMMON /FLBOX1/ BX1(IMIN1:IMAX1,JMIN1:JMAX1,KMIN1:KMAX1), & BY1(IMIN1:IMAX1,JMIN1:JMAX1,KMIN1:KMAX1), & BZ1(IMIN1:IMAX1,JMIN1:JMAX1,KMIN1:KMAX1) C**> Box #2, The Magnet Entry Region, from Up1Gri98, Up2Gri98, C**> and SquGri98 files. PARAMETER (IMIN2=-13,IMAX2=+13) PARAMETER (JMIN2=-12,JMAX2=+12) PARAMETER (KMIN2=-89,KMAX2=-82) COMMON /FLBOX2/ BX2(IMIN2:IMAX2,JMIN2:JMAX2,KMIN2:KMAX2), & BY2(IMIN2:IMAX2,JMIN2:JMAX2,KMIN2:KMAX2), & BZ2(IMIN2:IMAX2,JMIN2:JMAX2,KMIN2:KMAX2) C**> Box #3, The Internal Field Volume, from In1Gri98 & In2Gri98 files C**> and the downstream edges of the Upstream and "Square" files. PARAMETER (IMIN3=-29,IMAX3=+29) PARAMETER (JMIN3=-19,JMAX3=+19) PARAMETER (KMIN3=-81,KMAX3=+68) COMMON /FLBOX3/ BX3(IMIN3:IMAX3,JMIN3:JMAX3,KMIN3:KMAX3), & BY3(IMIN3:IMAX3,JMIN3:JMAX3,KMIN3:KMAX3), & BZ3(IMIN3:IMAX3,JMIN3:JMAX3,KMIN3:KMAX3) C**> Boxes #4 & #5, The Internal Magnetic Field Volume, the slices C**> incorporating the Pillar at +ve X, from In1Gri98, In2Gri98 C**> and In3Gri98 files. PARAMETER (IMIN4=-33,IMAX4=+29) PARAMETER (JMIN3=-19,JMAX3=+19) PARAMETER (KMIN3=-81,KMAX3=+68) COMMON /FLBOX3/ BX3(IMIN3:IMAX3,JMIN3:JMAX3,KMIN3:KMAX3), & BY3(IMIN3:IMAX3,JMIN3:JMAX3,KMIN3:KMAX3), & BZ3(IMIN3:IMAX3,JMIN3:JMAX3,KMIN3:KMAX3) C**> Boxes #4 & #5, The Internal Magnetic Field Volume, the slices C**> incorporating the Pillar at +ve X, from In1Gri98, In2Gri98 C**> and In3Gri98 files. PARAMETER (IMIN4=-33,IMAX4=+29) PARAMETER (JMIN4=-19,JMAX4=+19) PARAMETER (KMIN4=+69,KMAX4=+76) COMMON /FLBOX4/ BX4(IMIN4:IMAX4,JMIN4:JMAX4,KMIN4:KMAX4), & BY4(IMIN4:IMAX4,JMIN4:JMAX4,KMIN4:KMAX4), & BZ4(IMIN4:IMAX4,JMIN4:JMAX4,KMIN4:KMAX4) PARAMETER (IMIN5=-37,IMAX5=+29) PARAMETER (JMIN5=-19,JMAX5=+19) PARAMETER (KMIN5=+77,KMAX5=+120) COMMON /FLBOX5/ BX5(IMIN5:IMAX5,JMIN5:JMAX5,KMIN5:KMAX5), & BY5(IMIN5:IMAX5,JMIN5:JMAX5,KMIN5:KMAX5), & BZ5(IMIN5:IMAX5,JMIN5:JMAX5,KMIN5:KMAX5) C**> Box #6, The Downstream Fringe Field, from Dn1Gri98, Dn2Gri98, C**> and Dn3Gri98 files. PARAMETER (IMIN6=-64,IMAX6=+31) PARAMETER (JMIN6=-19,JMAX6=+19) PARAMETER (KMIN6=+121,KMAX6=+259) COMMON /FLBOX6/ BX6(IMIN6:IMAX6,JMIN6:JMAX6,KMIN6:KMAX6), & BY6(IMIN6:IMAX6,JMIN6:JMAX6,KMIN6:KMAX6), & BZ6(IMIN6:IMAX6,JMIN6:JMAX6,KMIN6:KMAX6) *>--------------------------------------------------------------------<* C**> Input Grid File names. CHARACTER*8 FNAME DIMENSION FNAME(1:9) DATA FNAME /'In1Gri98','In2Gri98','In3Gri98', & 'Dn1Gri98','Dn2Gri98','Dn3Gri98', & 'Up1Gri98','Up2Gri98','SquGri98'/ C**> Counters for number of points per input file into each box. DIMENSION NPTBOX(1:6,1:9) C**> Total number of original points in each input file. DIMENSION NPF(1:9) DATA NPF /251296,212156,14976,173472,173472,173472, & 18392,13376,3140/ CHK Database stuff. INTEGER ISTAT,LL,JJ,IRUN,IEVT CHARACTER*80 CHPATH CHARACTER*24 CHROOT(9) CHK Database array. REAL ARRGOL1,ARRGOL2,ARRGOL3,ARRGOL4,ARRGOL5,ARRGOL6 REAL ARRGOL7,ARRGOL8,ARRGOL9 COMMON /DBARRT/ ARRGOL1(251296),ARRGOL2(251296),ARRGOL3(251296), & ARRGOL4(251296),ARRGOL5(251296),ARRGOL6(251296), & ARRGOL7(251296),ARRGOL8(251296),ARRGOL9(251296) DATA CHROOT / '//CDW8/GOLIATH/IN1GRI98/', & '//CDW8/GOLIATH/IN2GRI98/', & '//CDW8/GOLIATH/IN3GRI98/', & '//CDW8/GOLIATH/DN1GRI98/', & '//CDW8/GOLIATH/DN2GRI98/', & '//CDW8/GOLIATH/DN3GRI98/', & '//CDW8/GOLIATH/UP1GRI98/', & '//CDW8/GOLIATH/UP2GRI98/', & '//CDW8/GOLIATH/SQUGRI98/' / ISTAT = 0 NPT=NPF(1)+NPF(2)+NPF(3)+NPF(4)+NPF(5)+NPF(6)+NPF(7)+NPF(8)+NPF(9) if (idbg.ge.1) then write (6,*) '------------------', & '-------------------------------------------------------------' write (6,*) ' Debug Printout from Subroutine S2FLREAD ' write (6,*) '------------------', & '-------------------------------------------------------------' endif C**> Initialise counters for number of points per input file into each box. CALL UZERO(NPTBOX,1,54) C**> Initialise arrays for each Box. N1=(IMAX1-IMIN1+1)*(JMAX1-JMIN1+1)*(KMAX1-KMIN1+1) if (idbg.ge.1) write (6,'(a58,i10)') & ' Number of array positions reserved for Points in Box 1: ',n1 CALL UZERO(BX1,1,N1) CALL UZERO(BY1,1,N1) CALL UZERO(BZ1,1,N1) N2=(IMAX2-IMIN2+1)*(JMAX2-JMIN2+1)*(KMAX2-KMIN2+1) if (idbg.ge.1) write (6,'(a58,i10)') & ' Number of array positions reserved for Points in Box 2: ',n2 CALL UZERO(BX2,1,N2) CALL UZERO(BY2,1,N2) CALL UZERO(BZ2,1,N2) N3=(IMAX3-IMIN3+1)*(JMAX3-JMIN3+1)*(KMAX3-KMIN3+1) if (idbg.ge.1) write (6,'(a58,i10)') & ' Number of array positions reserved for Points in Box 3: ',n3 CALL UZERO(BX3,1,N3) CALL UZERO(BY3,1,N3) CALL UZERO(BZ3,1,N3) N4=(IMAX4-IMIN4+1)*(JMAX4-JMIN4+1)*(KMAX4-KMIN4+1) if (idbg.ge.1) write (6,'(a58,i10)') & ' Number of array positions reserved for Points in Box 4: ',n4 CALL UZERO(BX4,1,N4) CALL UZERO(BY4,1,N4) CALL UZERO(BZ4,1,N4) N5=(IMAX5-IMIN5+1)*(JMAX5-JMIN5+1)*(KMAX5-KMIN5+1) if (idbg.ge.1) write (6,'(a58,i10)') & ' Number of array positions reserved for Points in Box 5: ',n5 CALL UZERO(BX5,1,N5) CALL UZERO(BY5,1,N5) CALL UZERO(BZ5,1,N5) N6=(IMAX6-IMIN6+1)*(JMAX6-JMIN6+1)*(KMAX6-KMIN6+1) if (idbg.ge.1) write (6,'(a58,i10)') & ' Number of array positions reserved for Points in Box 6: ',n6 CALL UZERO(BX6,1,N6) CALL UZERO(BY6,1,N6) CALL UZERO(BZ6,1,N6) NALL=N1+N2+N3+N4+N5+N6 if (idbg.ge.1) write (6,'(a43,i10,/,a51,i10)') & ' Total number of array positions reserved: ',nall, & ' Total number of points expected from input files: ',npt C**> Open Input (binary format) files. C CALL UTFOPEN(71,MAGFILE(1),ISTAT, C & 'FORM=UNFORMATTED,STATUS=OLD,READONLY') C CALL UTFOPEN(72,MAGFILE(2),ISTAT, C & 'FORM=UNFORMATTED,STATUS=OLD,READONLY') C CALL UTFOPEN(73,MAGFILE(3),ISTAT, C & 'FORM=UNFORMATTED,STATUS=OLD,READONLY') C CALL UTFOPEN(74,MAGFILE(4),ISTAT, C & 'FORM=UNFORMATTED,STATUS=OLD,READONLY') C CALL UTFOPEN(75,MAGFILE(5),ISTAT, C & 'FORM=UNFORMATTED,STATUS=OLD,READONLY') C CALL UTFOPEN(76,MAGFILE(6),ISTAT, C & 'FORM=UNFORMATTED,STATUS=OLD,READONLY') C CALL UTFOPEN(77,MAGFILE(7),ISTAT, C & 'FORM=UNFORMATTED,STATUS=OLD,READONLY') C CALL UTFOPEN(78,MAGFILE(8),ISTAT, C & 'FORM=UNFORMATTED,STATUS=OLD,READONLY') C CALL UTFOPEN(79,MAGFILE(9),ISTAT, C & 'FORM=UNFORMATTED,STATUS=OLD,READONLY') C**> Open Input (ascii format) files. C CALL UTFOPEN(71,MAGFILE(1),ISTAT,'STATUS=OLD,READONLY') C CALL UTFOPEN(72,MAGFILE(2),ISTAT,'STATUS=OLD,READONLY') C CALL UTFOPEN(73,MAGFILE(3),ISTAT,'STATUS=OLD,READONLY') C CALL UTFOPEN(74,MAGFILE(4),ISTAT,'STATUS=OLD,READONLY') C CALL UTFOPEN(75,MAGFILE(5),ISTAT,'STATUS=OLD,READONLY') C CALL UTFOPEN(76,MAGFILE(6),ISTAT,'STATUS=OLD,READONLY') C CALL UTFOPEN(77,MAGFILE(7),ISTAT,'STATUS=OLD,READONLY') C CALL UTFOPEN(78,MAGFILE(8),ISTAT,'STATUS=OLD,READONLY') C CALL UTFOPEN(79,MAGFILE(9),ISTAT,'STATUS=OLD,READONLY') C IF (ISTAT.NE.0) THEN C PRINT *, 'S2FLREAD: UTFOPEN failed ',ISTAT C RETURN C ENDIF C**> Read in data lines (points) from database array. write (6,*) '----------------', & '---------------------------------------------------------------' write (6,*) 'S2FLREAD: Begin reading in field map from database ' if (idbg.ge.2) write (6,*) '----------------', & '---------------------------------------------------------------' C Loop and fill magnetic field variables. DO 100 IF=1,9 CALL VZERO(ARRGOL1,251296) CALL VZERO(ARRGOL2,251296) CALL VZERO(ARRGOL3,251296) CALL VZERO(ARRGOL4,251296) CALL VZERO(ARRGOL5,251296) CALL VZERO(ARRGOL6,251296) CALL VZERO(ARRGOL7,251296) CALL VZERO(ARRGOL8,251296) CALL VZERO(ARRGOL9,251296) C Check loop. IF (IF.GT.9) STOP 'S2FLREAD: IF > 9' WRITE(6,175) IF,CHROOT(IF) 175 FORMAT(1X,' Loading Goliath map; quad = ',I2,': Path = ',A25) DO JJ = 1,9 C Run and event validity. IRUN = 0 IEVT = 0 C Number of data words. NW = NPF(IF) NWOUT = 0 C Set IRC to zero each time. IRC = 0 C Path name. WRITE(CHPATH,'(A24,''GOL'',I1)') CHROOT(IF),JJ C WRITE(6,'(1X,''Path = '',A60)') CHPATH IF (JJ.EQ.1) & CALL DXGTR(CHPATH,IRUN,IEVT,ARRGOL1,NW,NWOUT,IRC) IF (JJ.EQ.2) & CALL DXGTR(CHPATH,IRUN,IEVT,ARRGOL2,NW,NWOUT,IRC) IF (JJ.EQ.3) & CALL DXGTR(CHPATH,IRUN,IEVT,ARRGOL3,NW,NWOUT,IRC) IF (JJ.EQ.4) & CALL DXGTR(CHPATH,IRUN,IEVT,ARRGOL4,NW,NWOUT,IRC) IF (JJ.EQ.5) & CALL DXGTR(CHPATH,IRUN,IEVT,ARRGOL5,NW,NWOUT,IRC) IF (JJ.EQ.6) & CALL DXGTR(CHPATH,IRUN,IEVT,ARRGOL6,NW,NWOUT,IRC) IF (JJ.EQ.7) & CALL DXGTR(CHPATH,IRUN,IEVT,ARRGOL7,NW,NWOUT,IRC) IF (JJ.EQ.8) & CALL DXGTR(CHPATH,IRUN,IEVT,ARRGOL8,NW,NWOUT,IRC) IF (JJ.EQ.9) & CALL DXGTR(CHPATH,IRUN,IEVT,ARRGOL9,NW,NWOUT,IRC) C PRINT *, 'NW,NWOUT = ',NW,NWOUT IF (IRC.NE.0) THEN PRINT *, ' Error loading MAP : NW NWOUT IRC', & NW,NWOUT,IRC ISTAT = -1 STOP ENDIF IF (NW.NE.NWOUT) THEN PRINT *, ' Read points from db disagree : ',JJ,NW,NWOUT ISTAT = -2 STOP ENDIF ENDDO NUN=70+IF L=0 LL=0 C DO 10 N=1,1000000 DO 10 N=1,NPF(IF) C READ (NUN,END=11) IH,JH,KH,R1H,R2H,R3H,B1H,B2H,B3H ! file in binary format. C READ (NUN,*,END=11) I,J,K,R1,R2,R3,B1,B2,B3 ! file in ascii format. LL = LL + 1 I = INT(ARRGOL1(LL)) J = INT(ARRGOL2(LL)) K = INT(ARRGOL3(LL)) R1 = ARRGOL4(LL) R2 = ARRGOL5(LL) R3 = ARRGOL6(LL) B1 = ARRGOL7(LL) B2 = ARRGOL8(LL) B3 = ARRGOL9(LL) if (idbg.ge.2) write (6,'(3i4,3f8.2,3f12.3)') & i,j,k,r1,r2,r3,b1,b2,b3 L=L+1 IF (K.GE.-81.AND.K.LE.+68) THEN BX3(I,J,K)=B1 BY3(I,J,K)=B2 BZ3(I,J,K)=B3 NPTBOX(3,IF)=NPTBOX(3,IF)+1 ELSEIF (K.GE.+121.AND.K.LE.+259) THEN BX6(I,J,K)=B1 BY6(I,J,K)=B2 BZ6(I,J,K)=B3 NPTBOX(6,IF)=NPTBOX(6,IF)+1 ELSEIF (K.GE.+77.AND.K.LE.+120) THEN BX5(I,J,K)=B1 BY5(I,J,K)=B2 BZ5(I,J,K)=B3 NPTBOX(5,IF)=NPTBOX(5,IF)+1 ELSEIF (K.GE.-167.AND.K.LE.-90) THEN BX1(I,J,K)=B1 BY1(I,J,K)=B2 BZ1(I,J,K)=B3 NPTBOX(1,IF)=NPTBOX(1,IF)+1 ELSEIF (K.GE.+69.AND.K.LE.+76) THEN BX4(I,J,K)=B1 BY4(I,J,K)=B2 BZ4(I,J,K)=B3 NPTBOX(4,IF)=NPTBOX(4,IF)+1 ELSEIF (K.GE.-89.AND.K.LE.-82) THEN BX2(I,J,K)=B1 BY2(I,J,K)=B2 BZ2(I,J,K)=B3 NPTBOX(2,IF)=NPTBOX(2,IF)+1 ENDIF 10 CONTINUE 11 CONTINUE if (idbg.ge.1) write (6,'(a33,a8,a2,2i8)') & ' Total and Read points from file ',fname(if),': ',npf(if),l write (6,'(a33,a8,a2,2i8)') & ' Total and Read points from file ',fname(if),': ',npf(if),l IF (NPF(IF).NE.LL) THEN PRINT *, ' Exp. total and sum points disagree: ', NPF(IF),LL ISTAT = -3 STOP ENDIF INBOX=0 DO 12 IB=1,6 if (idbg.ge.1) write (6,'(a18,i2,a1,i8)') & ' ---> into Box',ib,':',nptbox(ib,if) INBOX=INBOX+NPTBOX(IB,IF) 12 CONTINUE if (idbg.ge.1) write (6,'(a35,a8,a2,i8)') & ' Total points into Boxes from file ',fname(if),': ',inbox IF (NPF(IF).NE.INBOX) THEN PRINT *, ' Exp. total and box disagree : ',NPF(IF),INBOX ISTAT = -4 STOP ENDIF 100 CONTINUE if (idbg.ge.1) write (6,*) '----------------', & '---------------------------------------------------------------' write (6,*) 'S2FLREAD: Magnetic field files read and organised ' write (6,*) '----------------', & '---------------------------------------------------------------' RETURN END *+DECK,S2FLBVAL. Subroutine S2FLBVAL. *CMZ : 2.00/00 15/03/95 15.39.46 by Hal Kalechofsky *CMZ : 1.00/00 09/03/95 15.06.19 by Aris Angelis *-- Author : Aris Angelis 09/03/95 *>--------------------------------------------------------------------<* * This routine returns the magnetic field components at a given * * point within the magnetic field volume measured in November and De- * * cember 1993, via three dimensional linear interpolation among the * * eight closest measured points on the grid. X,Y,Z are the coordinates * * passed to the routine and Bx,By,Bz the returned field components. * * In case the point submitted lies outside the measured volume all the * * field components are returned 0. * * For idbg >= 1 debug printout is obtained. * * Work on this project started on 18 August 1994 * * Latest update 25 November 1994 * * Aris L. S. Angelis * *>--------------------------------------------------------------------<* SUBROUTINE S2FLBVAL(X,Y,Z,BX,BY,BZ,IDBG) *>--------------------------------------------------------------------<* C IMPLICIT NONE *KEEP,S2FLDMAP. C**> Box #1, The Upstream Fringe Field, from Up1Gri98 & Up2Gri98 files. PARAMETER (IMIN1=-9,IMAX1=+9) PARAMETER (JMIN1=-9,JMAX1=+9) PARAMETER (KMIN1=-167,KMAX1=-90) COMMON /FLBOX1/ BX1(IMIN1:IMAX1,JMIN1:JMAX1,KMIN1:KMAX1), & BY1(IMIN1:IMAX1,JMIN1:JMAX1,KMIN1:KMAX1), & BZ1(IMIN1:IMAX1,JMIN1:JMAX1,KMIN1:KMAX1) C**> Box #2, The Magnet Entry Region, from Up1Gri98, Up2Gri98, C**> and SquGri98 files. PARAMETER (IMIN2=-13,IMAX2=+13) PARAMETER (JMIN2=-12,JMAX2=+12) PARAMETER (KMIN2=-89,KMAX2=-82) COMMON /FLBOX2/ BX2(IMIN2:IMAX2,JMIN2:JMAX2,KMIN2:KMAX2), & BY2(IMIN2:IMAX2,JMIN2:JMAX2,KMIN2:KMAX2), & BZ2(IMIN2:IMAX2,JMIN2:JMAX2,KMIN2:KMAX2) C**> Box #3, The Internal Field Volume, from In1Gri98 & In2Gri98 files C**> and the downstream edges of the Upstream and "Square" files. PARAMETER (IMIN3=-29,IMAX3=+29) PARAMETER (JMIN3=-19,JMAX3=+19) PARAMETER (KMIN3=-81,KMAX3=+68) COMMON /FLBOX3/ BX3(IMIN3:IMAX3,JMIN3:JMAX3,KMIN3:KMAX3), & BY3(IMIN3:IMAX3,JMIN3:JMAX3,KMIN3:KMAX3), & BZ3(IMIN3:IMAX3,JMIN3:JMAX3,KMIN3:KMAX3) C**> Boxes #4 & #5, The Internal Magnetic Field Volume, the slices C**> incorporating the Pillar at +ve X, from In1Gri98, In2Gri98 C**> and In3Gri98 files. PARAMETER (IMIN4=-33,IMAX4=+29) PARAMETER (JMIN3=-19,JMAX3=+19) PARAMETER (KMIN3=-81,KMAX3=+68) COMMON /FLBOX3/ BX3(IMIN3:IMAX3,JMIN3:JMAX3,KMIN3:KMAX3), & BY3(IMIN3:IMAX3,JMIN3:JMAX3,KMIN3:KMAX3), & BZ3(IMIN3:IMAX3,JMIN3:JMAX3,KMIN3:KMAX3) C**> Boxes #4 & #5, The Internal Magnetic Field Volume, the slices C**> incorporating the Pillar at +ve X, from In1Gri98, In2Gri98 C**> and In3Gri98 files. PARAMETER (IMIN4=-33,IMAX4=+29) PARAMETER (JMIN4=-19,JMAX4=+19) PARAMETER (KMIN4=+69,KMAX4=+76) COMMON /FLBOX4/ BX4(IMIN4:IMAX4,JMIN4:JMAX4,KMIN4:KMAX4), & BY4(IMIN4:IMAX4,JMIN4:JMAX4,KMIN4:KMAX4), & BZ4(IMIN4:IMAX4,JMIN4:JMAX4,KMIN4:KMAX4) PARAMETER (IMIN5=-37,IMAX5=+29) PARAMETER (JMIN5=-19,JMAX5=+19) PARAMETER (KMIN5=+77,KMAX5=+120) COMMON /FLBOX5/ BX5(IMIN5:IMAX5,JMIN5:JMAX5,KMIN5:KMAX5), & BY5(IMIN5:IMAX5,JMIN5:JMAX5,KMIN5:KMAX5), & BZ5(IMIN5:IMAX5,JMIN5:JMAX5,KMIN5:KMAX5) C**> Box #6, The Downstream Fringe Field, from Dn1Gri98, Dn2Gri98, C**> and Dn3Gri98 files. PARAMETER (IMIN6=-64,IMAX6=+31) PARAMETER (JMIN6=-19,JMAX6=+19) PARAMETER (KMIN6=+121,KMAX6=+259) COMMON /FLBOX6/ BX6(IMIN6:IMAX6,JMIN6:JMAX6,KMIN6:KMAX6), & BY6(IMIN6:IMAX6,JMIN6:JMAX6,KMIN6:KMAX6), & BZ6(IMIN6:IMAX6,JMIN6:JMAX6,KMIN6:KMAX6) *>--------------------------------------------------------------------<* C**> Step sizes (cm). DATA DX,DY,DZ /4.,4.,2./ C**> Positions of points (cm) corresponding to lowest and highest C**> values of indices for each Box. DATA X1LO,X2LO,X3LO,X4LO,X5LO,X6LO & /-36.,-52.,-116.,-132.,-148.,-256./ DATA X1HI,X2HI,X3HI,X4HI,X5HI,X6HI & /+36.,+52.,+116.,+116.,+116.,+124./ DATA Y1LO,Y2LO,Y3LO,Y4LO,Y5LO,Y6LO & /-36.,-48.,-76.,-76.,-76.,-76./ DATA Y1HI,Y2HI,Y3HI,Y4HI,Y5HI,Y6HI & /+36.,+48.,+76.,+76.,+76.,+76./ DATA Z1LO,Z2LO,Z3LO,Z4LO,Z5LO,Z6LO & /-334.,-178.,-162.,+138.,+154.,+242./ DATA Z1HI,Z2HI,Z3HI,Z4HI,Z5HI,Z6HI & /-180.,-164.,+136.,+152.,+240.,+518./ if (idbg.ge.1) then write (6,*) '------------------', & '-------------------------------------------------------------' write (6,*) ' Debug Printout from Subroutine S2FlBval ' write (6,*) '------------------', & '-------------------------------------------------------------' endif C**> Initialise magnetic field values. BX=0. BY=0. BZ=0. C**> Check point belongs inside one of the six boxes of the measured C**> magnetic field volume, or in any of the narrow boundary areas C**> between them. If not exit. IF ((X.GE.X3LO.AND.X.LE.X3HI).AND.(Y.GE.Y3LO.AND.Y.LE.Y3HI) & .AND.(Z.GE.Z3LO.AND.Z.LE.Z3HI)) THEN IB=3 ELSEIF ((X.GE.X6LO.AND.X.LE.X6HI).AND.(Y.GE.Y6LO.AND.Y.LE.Y6HI) & .AND.(Z.GE.Z6LO.AND.Z.LE.Z6HI)) THEN IB=6 ELSEIF ((X.GE.X5LO.AND.X.LE.X5HI).AND.(Y.GE.Y5LO.AND.Y.LE.Y5HI) & .AND.(Z.GE.Z5LO.AND.Z.LE.Z5HI)) THEN IB=5 ELSEIF ((X.GE.X1LO.AND.X.LE.X1HI).AND.(Y.GE.Y1LO.AND.Y.LE.Y1HI) & .AND.(Z.GE.Z1LO.AND.Z.LE.Z1HI)) THEN IB=1 ELSEIF ((X.GE.X4LO.AND.X.LE.X4HI).AND.(Y.GE.Y4LO.AND.Y.LE.Y4HI) & .AND.(Z.GE.Z4LO.AND.Z.LE.Z4HI)) THEN IB=4 ELSEIF ((X.GE.X2LO.AND.X.LE.X2HI).AND.(Y.GE.Y2LO.AND.Y.LE.Y2HI) & .AND.(Z.GE.Z2LO.AND.Z.LE.Z2HI)) THEN IB=2 C**> Now check boundary regions. ELSEIF ((X.GE.X1LO.AND.X.LE.X1HI).AND.(Y.GE.Y1LO.AND.Y.LE.Y1HI) & .AND.(Z.GT.Z1HI.AND.Z.LT.Z2LO)) THEN IB=12 ELSEIF ((X.GE.X2LO.AND.X.LE.X2HI).AND.(Y.GE.Y2LO.AND.Y.LE.Y2HI) & .AND.(Z.GT.Z2HI.AND.Z.LT.Z3LO)) THEN IB=23 ELSEIF ((X.GE.X3LO.AND.X.LE.X3HI).AND.(Y.GE.Y3LO.AND.Y.LE.Y3HI) & .AND.(Z.GT.Z3HI.AND.Z.LT.Z4LO)) THEN IB=34 ELSEIF ((X.GE.X4LO.AND.X.LE.X4HI).AND.(Y.GE.Y4LO.AND.Y.LE.Y4HI) & .AND.(Z.GT.Z4HI.AND.Z.LT.Z5LO)) THEN IB=45 ELSEIF ((X.GE.X5LO.AND.X.LE.X5HI).AND.(Y.GE.Y5LO.AND.Y.LE.Y5HI) & .AND.(Z.GT.Z5HI.AND.Z.LT.Z6LO)) THEN IB=56 C**> Particle outside measured volume, exit. ELSE GOTO 1 ENDIF if (idbg.ge.1) write (6,'(A23,3F8.2,A9,I2)') & ' Input point (X,Y,Z) = ',X,Y,Z,' , Box = ',IB C**> Find the indices for the closest measured grid points C**> to the input point (x,y,z). I1=INT(X/DX)+INT((SIGN(1.,X)-1.)*0.5) I2=I1+1 J1=INT(Y/DY)+INT((SIGN(1.,Y)-1.)*0.5) J2=J1+1 K1=INT(Z/DZ)+INT((SIGN(1.,Z)-1.)*0.5) K2=K1+1 if (idbg.ge.1) write (6,'(a27,3f8.2,6i4)') & ' X,Y,Z,I1,I2,J1,J2,K1,K2 = ',x,y,z,i1,i2,j1,j2,k1,k2 C**> According to which Box the point belongs to obtain the C**> spatial coordinates and the magnetic field components of C**> the eight closest points on the measured grid. IF (IB.EQ.3) THEN X01=X3LO+DX*(I1-IMIN3) X02=X01+DX Y01=Y3LO+DY*(J1-JMIN3) Y02=Y01+DY Z01=Z3LO+DZ*(K1-KMIN3) Z02=Z01+DZ BX01=BX3(I1,J1,K1) BX02=BX3(I2,J1,K1) BX03=BX3(I2,J1,K2) BX04=BX3(I1,J1,K2) BX05=BX3(I1,J2,K1) BX06=BX3(I2,J2,K1) BX07=BX3(I2,J2,K2) BX08=BX3(I1,J2,K2) BY01=BY3(I1,J1,K1) BY02=BY3(I2,J1,K1) BY03=BY3(I2,J1,K2) BY04=BY3(I1,J1,K2) BY05=BY3(I1,J2,K1) BY06=BY3(I2,J2,K1) BY07=BY3(I2,J2,K2) BY08=BY3(I1,J2,K2) BZ01=BZ3(I1,J1,K1) BZ02=BZ3(I2,J1,K1) BZ03=BZ3(I2,J1,K2) BZ04=BZ3(I1,J1,K2) BZ05=BZ3(I1,J2,K1) BZ06=BZ3(I2,J2,K1) BZ07=BZ3(I2,J2,K2) BZ08=BZ3(I1,J2,K2) ELSEIF (IB.EQ.6) THEN X01=X6LO+DX*(I1-IMIN6) X02=X01+DX Y01=Y6LO+DY*(J1-JMIN6) Y02=Y01+DY Z01=Z6LO+DZ*(K1-KMIN6) Z02=Z01+DZ BX01=BX6(I1,J1,K1) BX02=BX6(I2,J1,K1) BX03=BX6(I2,J1,K2) BX04=BX6(I1,J1,K2) BX05=BX6(I1,J2,K1) BX06=BX6(I2,J2,K1) BX07=BX6(I2,J2,K2) BX08=BX6(I1,J2,K2) BY01=BY6(I1,J1,K1) BY02=BY6(I2,J1,K1) BY03=BY6(I2,J1,K2) BY04=BY6(I1,J1,K2) BY05=BY6(I1,J2,K1) BY06=BY6(I2,J2,K1) BY07=BY6(I2,J2,K2) BY08=BY6(I1,J2,K2) BZ01=BZ6(I1,J1,K1) BZ02=BZ6(I2,J1,K1) BZ03=BZ6(I2,J1,K2) BZ04=BZ6(I1,J1,K2) BZ05=BZ6(I1,J2,K1) BZ06=BZ6(I2,J2,K1) BZ07=BZ6(I2,J2,K2) BZ08=BZ6(I1,J2,K2) ELSEIF (IB.EQ.5) THEN X01=X5LO+DX*(I1-IMIN5) X02=X01+DX Y01=Y5LO+DY*(J1-JMIN5) Y02=Y01+DY Z01=Z5LO+DZ*(K1-KMIN5) Z02=Z01+DZ BX01=BX5(I1,J1,K1) BX02=BX5(I2,J1,K1) BX03=BX5(I2,J1,K2) BX04=BX5(I1,J1,K2) BX05=BX5(I1,J2,K1) BX06=BX5(I2,J2,K1) BX07=BX5(I2,J2,K2) BX08=BX5(I1,J2,K2) BY01=BY5(I1,J1,K1) BY02=BY5(I2,J1,K1) BY03=BY5(I2,J1,K2) BY04=BY5(I1,J1,K2) BY05=BY5(I1,J2,K1) BY06=BY5(I2,J2,K1) BY07=BY5(I2,J2,K2) BY08=BY5(I1,J2,K2) BZ01=BZ5(I1,J1,K1) BZ02=BZ5(I2,J1,K1) BZ03=BZ5(I2,J1,K2) BZ04=BZ5(I1,J1,K2) BZ05=BZ5(I1,J2,K1) BZ06=BZ5(I2,J2,K1) BZ07=BZ5(I2,J2,K2) BZ08=BZ5(I1,J2,K2) ELSEIF (IB.EQ.1) THEN X01=X1LO+DX*(I1-IMIN1) X02=X01+DX Y01=Y1LO+DY*(J1-JMIN1) Y02=Y01+DY Z01=Z1LO+DZ*(K1-KMIN1) Z02=Z01+DZ BX01=BX1(I1,J1,K1) BX02=BX1(I2,J1,K1) BX03=BX1(I2,J1,K2) BX04=BX1(I1,J1,K2) BX05=BX1(I1,J2,K1) BX06=BX1(I2,J2,K1) BX07=BX1(I2,J2,K2) BX08=BX1(I1,J2,K2) BY01=BY1(I1,J1,K1) BY02=BY1(I2,J1,K1) BY03=BY1(I2,J1,K2) BY04=BY1(I1,J1,K2) BY05=BY1(I1,J2,K1) BY06=BY1(I2,J2,K1) BY07=BY1(I2,J2,K2) BY08=BY1(I1,J2,K2) BZ01=BZ1(I1,J1,K1) BZ02=BZ1(I2,J1,K1) BZ03=BZ1(I2,J1,K2) BZ04=BZ1(I1,J1,K2) BZ05=BZ1(I1,J2,K1) BZ06=BZ1(I2,J2,K1) BZ07=BZ1(I2,J2,K2) BZ08=BZ1(I1,J2,K2) ELSEIF (IB.EQ.4) THEN X01=X4LO+DX*(I1-IMIN4) X02=X01+DX Y01=Y4LO+DY*(J1-JMIN4) Y02=Y01+DY Z01=Z4LO+DZ*(K1-KMIN4) Z02=Z01+DZ BX01=BX4(I1,J1,K1) BX02=BX4(I2,J1,K1) BX03=BX4(I2,J1,K2) BX04=BX4(I1,J1,K2) BX05=BX4(I1,J2,K1) BX06=BX4(I2,J2,K1) BX07=BX4(I2,J2,K2) BX08=BX4(I1,J2,K2) BY01=BY4(I1,J1,K1) BY02=BY4(I2,J1,K1) BY03=BY4(I2,J1,K2) BY04=BY4(I1,J1,K2) BY05=BY4(I1,J2,K1) BY06=BY4(I2,J2,K1) BY07=BY4(I2,J2,K2) BY08=BY4(I1,J2,K2) BZ01=BZ4(I1,J1,K1) BZ02=BZ4(I2,J1,K1) BZ03=BZ4(I2,J1,K2) BZ04=BZ4(I1,J1,K2) BZ05=BZ4(I1,J2,K1) BZ06=BZ4(I2,J2,K1) BZ07=BZ4(I2,J2,K2) BZ08=BZ4(I1,J2,K2) ELSEIF (IB.EQ.2) THEN X01=X2LO+DX*(I1-IMIN2) X02=X01+DX Y01=Y2LO+DY*(J1-JMIN2) Y02=Y01+DY Z01=Z2LO+DZ*(K1-KMIN2) Z02=Z01+DZ BX01=BX2(I1,J1,K1) BX02=BX2(I2,J1,K1) BX03=BX2(I2,J1,K2) BX04=BX2(I1,J1,K2) BX05=BX2(I1,J2,K1) BX06=BX2(I2,J2,K1) BX07=BX2(I2,J2,K2) BX08=BX2(I1,J2,K2) BY01=BY2(I1,J1,K1) BY02=BY2(I2,J1,K1) BY03=BY2(I2,J1,K2) BY04=BY2(I1,J1,K2) BY05=BY2(I1,J2,K1) BY06=BY2(I2,J2,K1) BY07=BY2(I2,J2,K2) BY08=BY2(I1,J2,K2) BZ01=BZ2(I1,J1,K1) BZ02=BZ2(I2,J1,K1) BZ03=BZ2(I2,J1,K2) BZ04=BZ2(I1,J1,K2) BZ05=BZ2(I1,J2,K1) BZ06=BZ2(I2,J2,K1) BZ07=BZ2(I2,J2,K2) BZ08=BZ2(I1,J2,K2) ELSEIF (IB.EQ.12) THEN X01=X1LO+DX*(I1-IMIN1) X02=X01+DX Y01=Y1LO+DY*(J1-JMIN1) Y02=Y01+DY Z01=Z1LO+DZ*(K1-KMIN1) Z02=Z01+DZ BX01=BX1(I1,J1,K1) BX02=BX1(I2,J1,K1) BX03=BX2(I2,J1,K2) BX04=BX2(I1,J1,K2) BX05=BX1(I1,J2,K1) BX06=BX1(I2,J2,K1) BX07=BX2(I2,J2,K2) BX08=BX2(I1,J2,K2) BY01=BY1(I1,J1,K1) BY02=BY1(I2,J1,K1) BY03=BY2(I2,J1,K2) BY04=BY2(I1,J1,K2) BY05=BY1(I1,J2,K1) BY06=BY1(I2,J2,K1) BY07=BY2(I2,J2,K2) BY08=BY2(I1,J2,K2) BZ01=BZ1(I1,J1,K1) BZ02=BZ1(I2,J1,K1) BZ03=BZ2(I2,J1,K2) BZ04=BZ2(I1,J1,K2) BZ05=BZ1(I1,J2,K1) BZ06=BZ1(I2,J2,K1) BZ07=BZ2(I2,J2,K2) BZ08=BZ2(I1,J2,K2) ELSEIF (IB.EQ.23) THEN X01=X2LO+DX*(I1-IMIN2) X02=X01+DX Y01=Y2LO+DY*(J1-JMIN2) Y02=Y01+DY Z01=Z2LO+DZ*(K1-KMIN2) Z02=Z01+DZ BX01=BX2(I1,J1,K1) BX02=BX2(I2,J1,K1) BX03=BX3(I2,J1,K2) BX04=BX3(I1,J1,K2) BX05=BX2(I1,J2,K1) BX06=BX2(I2,J2,K1) BX07=BX3(I2,J2,K2) BX08=BX3(I1,J2,K2) BY01=BY2(I1,J1,K1) BY02=BY2(I2,J1,K1) BY03=BY3(I2,J1,K2) BY04=BY3(I1,J1,K2) BY05=BY2(I1,J2,K1) BY06=BY2(I2,J2,K1) BY07=BY3(I2,J2,K2) BY08=BY3(I1,J2,K2) BZ01=BZ2(I1,J1,K1) BZ02=BZ2(I2,J1,K1) BZ03=BZ3(I2,J1,K2) BZ04=BZ3(I1,J1,K2) BZ05=BZ2(I1,J2,K1) BZ06=BZ2(I2,J2,K1) BZ07=BZ3(I2,J2,K2) BZ08=BZ3(I1,J2,K2) ELSEIF (IB.EQ.34) THEN X01=X3LO+DX*(I1-IMIN3) X02=X01+DX Y01=Y3LO+DY*(J1-JMIN3) Y02=Y01+DY Z01=Z3LO+DZ*(K1-KMIN3) Z02=Z01+DZ BX01=BX3(I1,J1,K1) BX02=BX3(I2,J1,K1) BX03=BX4(I2,J1,K2) BX04=BX4(I1,J1,K2) BX05=BX3(I1,J2,K1) BX06=BX3(I2,J2,K1) BX07=BX4(I2,J2,K2) BX08=BX4(I1,J2,K2) BY01=BY3(I1,J1,K1) BY02=BY3(I2,J1,K1) BY03=BY4(I2,J1,K2) BY04=BY4(I1,J1,K2) BY05=BY3(I1,J2,K1) BY06=BY3(I2,J2,K1) BY07=BY4(I2,J2,K2) BY08=BY4(I1,J2,K2) BZ01=BZ3(I1,J1,K1) BZ02=BZ3(I2,J1,K1) BZ03=BZ4(I2,J1,K2) BZ04=BZ4(I1,J1,K2) BZ05=BZ3(I1,J2,K1) BZ06=BZ3(I2,J2,K1) BZ07=BZ4(I2,J2,K2) BZ08=BZ4(I1,J2,K2) ELSEIF (IB.EQ.45) THEN X01=X4LO+DX*(I1-IMIN4) X02=X01+DX Y01=Y4LO+DY*(J1-JMIN4) Y02=Y01+DY Z01=Z4LO+DZ*(K1-KMIN4) Z02=Z01+DZ BX01=BX4(I1,J1,K1) BX02=BX4(I2,J1,K1) BX03=BX5(I2,J1,K2) BX04=BX5(I1,J1,K2) BX05=BX4(I1,J2,K1) BX06=BX4(I2,J2,K1) BX07=BX5(I2,J2,K2) BX08=BX5(I1,J2,K2) BY01=BY4(I1,J1,K1) BY02=BY4(I2,J1,K1) BY03=BY5(I2,J1,K2) BY04=BY5(I1,J1,K2) BY05=BY4(I1,J2,K1) BY06=BY4(I2,J2,K1) BY07=BY5(I2,J2,K2) BY08=BY5(I1,J2,K2) BZ01=BZ4(I1,J1,K1) BZ02=BZ4(I2,J1,K1) BZ03=BZ5(I2,J1,K2) BZ04=BZ5(I1,J1,K2) BZ05=BZ4(I1,J2,K1) BZ06=BZ4(I2,J2,K1) BZ07=BZ5(I2,J2,K2) BZ08=BZ5(I1,J2,K2) ELSEIF (IB.EQ.56) THEN X01=X5LO+DX*(I1-IMIN5) X02=X01+DX Y01=Y5LO+DY*(J1-JMIN5) Y02=Y01+DY Z01=Z5LO+DZ*(K1-KMIN5) Z02=Z01+DZ BX01=BX5(I1,J1,K1) BX02=BX5(I2,J1,K1) BX03=BX6(I2,J1,K2) BX04=BX6(I1,J1,K2) BX05=BX5(I1,J2,K1) BX06=BX5(I2,J2,K1) BX07=BX6(I2,J2,K2) BX08=BX6(I1,J2,K2) BY01=BY5(I1,J1,K1) BY02=BY5(I2,J1,K1) BY03=BY6(I2,J1,K2) BY04=BY6(I1,J1,K2) BY05=BY5(I1,J2,K1) BY06=BY5(I2,J2,K1) BY07=BY6(I2,J2,K2) BY08=BY6(I1,J2,K2) BZ01=BZ5(I1,J1,K1) BZ02=BZ5(I2,J1,K1) BZ03=BZ6(I2,J1,K2) BZ04=BZ6(I1,J1,K2) BZ05=BZ5(I1,J2,K1) BZ06=BZ5(I2,J2,K1) BZ07=BZ6(I2,J2,K2) BZ08=BZ6(I1,J2,K2) ENDIF IF (X.LT.X01.OR.X.GT.X02) WRITE (6,'(A44,I2,2I4,3F8.2)') & ' Error, X01,X02 wrong: IB,I1,I2,X,X01,X02 = ',IB,I1,I2,X,X01,X02 IF (Y.LT.Y01.OR.Y.GT.Y02) WRITE (6,'(A44,I2,2I4,3F8.2)') & ' Error, Y01,Y02 wrong: IB,J1,J2,Y,Y01,Y02 = ',IB,J1,J2,Y,Y01,Y02 IF (Z.LT.Z01.OR.Z.GT.Z02) WRITE (6,'(A44,I2,2I4,3F8.2)') & ' Error, Z01,Z02 wrong: IB,K1,K2,Z,Z01,Z02 = ',IB,K1,K2,Z,Z01,Z02 if (idbg.ge.1) then write (6,'(a27,6f8.2)') & ' X01,X02,Y01,Y02,Z01,Z02 = ',x01,x02,y01,y02,z01,z02 write (6,'(a32,3f10.2)') & ' Bx01,By01,Bz01 (i,j,k=1,1,1) = ',bx01,by01,bz01 write (6,'(a32,3f10.2)') & ' Bx02,By02,Bz02 (i,j,k=2,1,1) = ',bx02,by02,bz02 write (6,'(a32,3f10.2)') & ' Bx03,By03,Bz03 (i,j,k=2,1,2) = ',bx03,by03,bz03 write (6,'(a32,3f10.2)') & ' Bx04,By04,Bz04 (i,j,k=1,1,2) = ',bx04,by04,bz04 write (6,'(a32,3f10.2)') & ' Bx05,By05,Bz05 (i,j,k=1,2,1) = ',bx05,by05,bz05 write (6,'(a32,3f10.2)') & ' Bx06,By06,Bz06 (i,j,k=2,2,1) = ',bx06,by06,bz06 write (6,'(a32,3f10.2)') & ' Bx07,By07,Bz07 (i,j,k=2,2,2) = ',bx07,by07,bz07 write (6,'(a32,3f10.2)') & ' Bx08,By08,Bz08 (i,j,k=1,2,2) = ',bx08,by08,bz08 endif C**> Calculate slopes along X,Y,Z. SLX=(X-X01)/(X02-X01) SLY=(Y-Y01)/(Y02-Y01) SLZ=(Z-Z01)/(Z02-Z01) IF ((SLX.LT.0..OR.SLX.GT.1.).OR.(SLY.LT.0..OR.SLY.GT.1.) & .OR.(SLZ.LT.0..OR.SLZ.GT.1.)) GOTO 1 if (idbg.ge.1) write (6,'(a15,3f10.4)') & ' Slx,Sly,Slz = ',slx,sly,slz OSLX=1.-SLX OSLY=1.-SLY OSLZ=1.-SLZ C**> Perform 3-d linear interpolation. C**> Contribution from 1st point. WEI=OSLX*OSLY*OSLZ BX=BX+WEI*BX01 BY=BY+WEI*BY01 BZ=BZ+WEI*BZ01 C**> Contribution from 2nd point. WEI=SLX*OSLY*OSLZ BX=BX+WEI*BX02 BY=BY+WEI*BY02 BZ=BZ+WEI*BZ02 C**> Contribution from 3rd point. WEI=SLX*OSLY*SLZ BX=BX+WEI*BX03 BY=BY+WEI*BY03 BZ=BZ+WEI*BZ03 C**> Contribution from 4th point. WEI=OSLX*OSLY*SLZ BX=BX+WEI*BX04 BY=BY+WEI*BY04 BZ=BZ+WEI*BZ04 C**> Contribution from 5th point. WEI=OSLX*SLY*OSLZ BX=BX+WEI*BX05 BY=BY+WEI*BY05 BZ=BZ+WEI*BZ05 C**> Contribution from 6th point. WEI=SLX*SLY*OSLZ BX=BX+WEI*BX06 BY=BY+WEI*BY06 BZ=BZ+WEI*BZ06 C**> Contribution from 7th point. WEI=SLX*SLY*SLZ BX=BX+WEI*BX07 BY=BY+WEI*BY07 BZ=BZ+WEI*BZ07 C**> Contribution from 8th point. WEI=OSLX*SLY*SLZ BX=BX+WEI*BX08 BY=BY+WEI*BY08 BZ=BZ+WEI*BZ08 1 CONTINUE if (idbg.ge.1) then write (6,'(a12,3f12.3)') ' Bx,By,Bz = ',bx,by,bz write (6,*) '------------------', & '-------------------------------------------------------------' endif RETURN END *>--------------------------------------------------------------------<* *+DECK,S2FLREAD_FILE. Subroutine S2FLREAD_FILE. *CMZ : 2.05/32 22/06/95 13.28.48 by Hal Kalechofsky *CMZ : 2.05/29 21/06/95 16.50.52 by Hal Kalechofsky *CMZ : 2.05/02 04/05/95 17.51.44 by Hal Kalechofsky *CMZ : 2.01/00 17/03/95 10.08.52 by Hal Kalechofsky *CMZ : 2.00/00 16/03/95 18.01.07 by Hal Kalechofsky *CMZ : 1.00/00 09/03/95 15.06.18 by Aris Angelis *-- Author : Aris Angelis 09/03/95 *>--------------------------------------------------------------------<* * This routine reads in the magnetic field components at all points * * of the magnetic field volume measured in November and December 1993 * * and puts them in common blocks. Two levels of debug printout are * * provided, for idbg = 1 and idbg >= 2. * * Work on this project started on 17 August 1994 * * Latest update 16 March 1995 * * Aris L. S. Angelis * *>--------------------------------------------------------------------<* SUBROUTINE S2FLREAD_FILE(IDBG) *>--------------------------------------------------------------------<* * The measured magnetic field volume is divided into six Boxes, * * slices along Z, the boundary regions being filled in from different * * grid files in order to provide a smooth transition from Box to Box * * along Z. Field map data is put into common blocks, one common block * * per Box. Parameter statements define the index limits for each Box, * * indices i,j,k corresponding to coordinates x,y,z. * *>--------------------------------------------------------------------<* C IMPLICIT NONE *KEEP,S2FLDMAP. C**> Box #1, The Upstream Fringe Field, from Up1Gri98 & Up2Gri98 files. PARAMETER (IMIN1=-9,IMAX1=+9) PARAMETER (JMIN1=-9,JMAX1=+9) PARAMETER (KMIN1=-167,KMAX1=-90) COMMON /FLBOX1/ BX1(IMIN1:IMAX1,JMIN1:JMAX1,KMIN1:KMAX1), & BY1(IMIN1:IMAX1,JMIN1:JMAX1,KMIN1:KMAX1), & BZ1(IMIN1:IMAX1,JMIN1:JMAX1,KMIN1:KMAX1) C**> Box #2, The Magnet Entry Region, from Up1Gri98, Up2Gri98, C**> and SquGri98 files. PARAMETER (IMIN2=-13,IMAX2=+13) PARAMETER (JMIN2=-12,JMAX2=+12) PARAMETER (KMIN2=-89,KMAX2=-82) COMMON /FLBOX2/ BX2(IMIN2:IMAX2,JMIN2:JMAX2,KMIN2:KMAX2), & BY2(IMIN2:IMAX2,JMIN2:JMAX2,KMIN2:KMAX2), & BZ2(IMIN2:IMAX2,JMIN2:JMAX2,KMIN2:KMAX2) C**> Box #3, The Internal Field Volume, from In1Gri98 & In2Gri98 files C**> and the downstream edges of the Upstream and "Square" files. PARAMETER (IMIN3=-29,IMAX3=+29) PARAMETER (JMIN3=-19,JMAX3=+19) PARAMETER (KMIN3=-81,KMAX3=+68) COMMON /FLBOX3/ BX3(IMIN3:IMAX3,JMIN3:JMAX3,KMIN3:KMAX3), & BY3(IMIN3:IMAX3,JMIN3:JMAX3,KMIN3:KMAX3), & BZ3(IMIN3:IMAX3,JMIN3:JMAX3,KMIN3:KMAX3) C**> Boxes #4 & #5, The Internal Magnetic Field Volume, the slices C**> incorporating the Pillar at +ve X, from In1Gri98, In2Gri98 C**> and In3Gri98 files. PARAMETER (IMIN4=-33,IMAX4=+29) PARAMETER (JMIN3=-19,JMAX3=+19) PARAMETER (KMIN3=-81,KMAX3=+68) COMMON /FLBOX3/ BX3(IMIN3:IMAX3,JMIN3:JMAX3,KMIN3:KMAX3), & BY3(IMIN3:IMAX3,JMIN3:JMAX3,KMIN3:KMAX3), & BZ3(IMIN3:IMAX3,JMIN3:JMAX3,KMIN3:KMAX3) C**> Boxes #4 & #5, The Internal Magnetic Field Volume, the slices C**> incorporating the Pillar at +ve X, from In1Gri98, In2Gri98 C**> and In3Gri98 files. PARAMETER (IMIN4=-33,IMAX4=+29) PARAMETER (JMIN4=-19,JMAX4=+19) PARAMETER (KMIN4=+69,KMAX4=+76) COMMON /FLBOX4/ BX4(IMIN4:IMAX4,JMIN4:JMAX4,KMIN4:KMAX4), & BY4(IMIN4:IMAX4,JMIN4:JMAX4,KMIN4:KMAX4), & BZ4(IMIN4:IMAX4,JMIN4:JMAX4,KMIN4:KMAX4) PARAMETER (IMIN5=-37,IMAX5=+29) PARAMETER (JMIN5=-19,JMAX5=+19) PARAMETER (KMIN5=+77,KMAX5=+120) COMMON /FLBOX5/ BX5(IMIN5:IMAX5,JMIN5:JMAX5,KMIN5:KMAX5), & BY5(IMIN5:IMAX5,JMIN5:JMAX5,KMIN5:KMAX5), & BZ5(IMIN5:IMAX5,JMIN5:JMAX5,KMIN5:KMAX5) C**> Box #6, The Downstream Fringe Field, from Dn1Gri98, Dn2Gri98, C**> and Dn3Gri98 files. PARAMETER (IMIN6=-64,IMAX6=+31) PARAMETER (JMIN6=-19,JMAX6=+19) PARAMETER (KMIN6=+121,KMAX6=+259) COMMON /FLBOX6/ BX6(IMIN6:IMAX6,JMIN6:JMAX6,KMIN6:KMAX6), & BY6(IMIN6:IMAX6,JMIN6:JMAX6,KMIN6:KMAX6), & BZ6(IMIN6:IMAX6,JMIN6:JMAX6,KMIN6:KMAX6) *>--------------------------------------------------------------------<* C**> Input Grid File names. CHARACTER*8 FNAME DIMENSION FNAME(1:9) DATA FNAME /'In1Gri98','In2Gri98','In3Gri98', & 'Dn1Gri98','Dn2Gri98','Dn3Gri98', & 'Up1Gri98','Up2Gri98','SquGri98'/ C**> Counters for number of points per input file into each box. DIMENSION NPTBOX(1:6,1:9) C**> Total number of original points in each input file. DIMENSION NPF(1:9) DATA NPF /251296,212156,14976,173472,173472,173472, & 18392,13376,3140/ CHK We put the file names here. C**> The magnetic field map file names. C**> For ascii files, change GBIN to GRID. CHARACTER*80 MAGFILE(9) c+SELF,IF=VAX,VMSALPHA. c DATA MAGFILE / 'WA98:[DBASE]IN1GRI98.GBIN', c & 'WA98:[DBASE]IN2GRI98.GBIN', c & 'WA98:[DBASE]IN3GRI98.GBIN', c & 'WA98:[DBASE]DN1GRI98.GBIN', c & 'WA98:[DBASE]DN2GRI98.GBIN', c & 'WA98:[DBASE]DN3GRI98.GBIN', c & 'WA98:[DBASE]UP1GRI98.GBIN', c & 'WA98:[DBASE]UP2GRI98.GBIN', c & 'WA98:[DBASE]SQUGRI98.GBIN' / *+SELF,IF=UNIXALPHA,DECS,HPUX,SGI,APO,LINUX. DATA MAGFILE / '/WA98/DBASE/IN1GRI98.GBIN', & '/WA98/DBASE/IN2GRI98.GBIN', & '/WA98/DBASE/IN3GRI98.GBIN', & '/WA98/DBASE/DN1GRI98.GBIN', & '/WA98/DBASE/DN2GRI98.GBIN', & '/WA98/DBASE/DN3GRI98.GBIN', & '/WA98/DBASE/UP1GRI98.GBIN', & '/WA98/DBASE/UP2GRI98.GBIN', & '/WA98/DBASE/SQUGRI98.GBIN' / *+SELF. NPT=NPF(1)+NPF(2)+NPF(3)+NPF(4)+NPF(5)+NPF(6)+NPF(7)+NPF(8)+NPF(9) if (idbg.ge.1) then write (6,*) '------------------', & '-------------------------------------------------------------' write (6,*) ' Debug Printout from Subroutine S2FLREAD ' write (6,*) '------------------', & '-------------------------------------------------------------' endif C**> Initialise counters for number of points per input file into each box. CALL UZERO(NPTBOX,1,54) C**> Initialise arrays for each Box. N1=(IMAX1-IMIN1+1)*(JMAX1-JMIN1+1)*(KMAX1-KMIN1+1) if (idbg.ge.1) write (6,'(a58,i10)') & ' Number of array positions reserved for Points in Box 1: ',n1 CALL UZERO(BX1,1,N1) CALL UZERO(BY1,1,N1) CALL UZERO(BZ1,1,N1) N2=(IMAX2-IMIN2+1)*(JMAX2-JMIN2+1)*(KMAX2-KMIN2+1) if (idbg.ge.1) write (6,'(a58,i10)') & ' Number of array positions reserved for Points in Box 2: ',n2 CALL UZERO(BX2,1,N2) CALL UZERO(BY2,1,N2) CALL UZERO(BZ2,1,N2) N3=(IMAX3-IMIN3+1)*(JMAX3-JMIN3+1)*(KMAX3-KMIN3+1) if (idbg.ge.1) write (6,'(a58,i10)') & ' Number of array positions reserved for Points in Box 3: ',n3 CALL UZERO(BX3,1,N3) CALL UZERO(BY3,1,N3) CALL UZERO(BZ3,1,N3) N4=(IMAX4-IMIN4+1)*(JMAX4-JMIN4+1)*(KMAX4-KMIN4+1) if (idbg.ge.1) write (6,'(a58,i10)') & ' Number of array positions reserved for Points in Box 4: ',n4 CALL UZERO(BX4,1,N4) CALL UZERO(BY4,1,N4) CALL UZERO(BZ4,1,N4) N5=(IMAX5-IMIN5+1)*(JMAX5-JMIN5+1)*(KMAX5-KMIN5+1) if (idbg.ge.1) write (6,'(a58,i10)') & ' Number of array positions reserved for Points in Box 5: ',n5 CALL UZERO(BX5,1,N5) CALL UZERO(BY5,1,N5) CALL UZERO(BZ5,1,N5) N6=(IMAX6-IMIN6+1)*(JMAX6-JMIN6+1)*(KMAX6-KMIN6+1) if (idbg.ge.1) write (6,'(a58,i10)') & ' Number of array positions reserved for Points in Box 6: ',n6 CALL UZERO(BX6,1,N6) CALL UZERO(BY6,1,N6) CALL UZERO(BZ6,1,N6) NALL=N1+N2+N3+N4+N5+N6 if (idbg.ge.1) write (6,'(a43,i10,/,a51,i10)') & ' Total number of array positions reserved: ',nall, & ' Total number of points expected from input files: ',npt C**> Open Input (binary format) files. CALL UTFOPEN(71,MAGFILE(1),ISTAT, & 'FORM=UNFORMATTED,STATUS=OLD,READONLY') CALL UTFOPEN(72,MAGFILE(2),ISTAT, & 'FORM=UNFORMATTED,STATUS=OLD,READONLY') CALL UTFOPEN(73,MAGFILE(3),ISTAT, & 'FORM=UNFORMATTED,STATUS=OLD,READONLY') CALL UTFOPEN(74,MAGFILE(4),ISTAT, & 'FORM=UNFORMATTED,STATUS=OLD,READONLY') CALL UTFOPEN(75,MAGFILE(5),ISTAT, & 'FORM=UNFORMATTED,STATUS=OLD,READONLY') CALL UTFOPEN(76,MAGFILE(6),ISTAT, & 'FORM=UNFORMATTED,STATUS=OLD,READONLY') CALL UTFOPEN(77,MAGFILE(7),ISTAT, & 'FORM=UNFORMATTED,STATUS=OLD,READONLY') CALL UTFOPEN(78,MAGFILE(8),ISTAT, & 'FORM=UNFORMATTED,STATUS=OLD,READONLY') CALL UTFOPEN(79,MAGFILE(9),ISTAT, & 'FORM=UNFORMATTED,STATUS=OLD,READONLY') C**> Open Input (ascii format) files. C CALL UTFOPEN(71,MAGFILE(1),ISTAT,'STATUS=OLD,READONLY') C CALL UTFOPEN(72,MAGFILE(2),ISTAT,'STATUS=OLD,READONLY') C CALL UTFOPEN(73,MAGFILE(3),ISTAT,'STATUS=OLD,READONLY') C CALL UTFOPEN(74,MAGFILE(4),ISTAT,'STATUS=OLD,READONLY') C CALL UTFOPEN(75,MAGFILE(5),ISTAT,'STATUS=OLD,READONLY') C CALL UTFOPEN(76,MAGFILE(6),ISTAT,'STATUS=OLD,READONLY') C CALL UTFOPEN(77,MAGFILE(7),ISTAT,'STATUS=OLD,READONLY') C CALL UTFOPEN(78,MAGFILE(8),ISTAT,'STATUS=OLD,READONLY') C CALL UTFOPEN(79,MAGFILE(9),ISTAT,'STATUS=OLD,READONLY') C**> Loop over input files and read in data lines (points). write (6,*) '----------------', & '---------------------------------------------------------------' write (6,*) 'S2FLREAD: Begin reading in magnetic field files ' if (idbg.ge.2) write (6,*) '----------------', & '---------------------------------------------------------------' ISTOP=0 DO 100 IF=1,9 NUN=70+IF L=0 DO 10 N=1,1000000 READ (NUN,END=11) I,J,K,R1,R2,R3,B1,B2,B3 ! file in binary format. C READ (NUN,*,END=11) I,J,K,R1,R2,R3,B1,B2,B3 ! file in ascii format. if (idbg.ge.2) write (6,'(3i4,3f8.2,3f12.3)') & i,j,k,r1,r2,r3,b1,b2,b3 L=L+1 IF (K.GE.-81.AND.K.LE.+68) THEN BX3(I,J,K)=B1 BY3(I,J,K)=B2 BZ3(I,J,K)=B3 NPTBOX(3,IF)=NPTBOX(3,IF)+1 ELSEIF (K.GE.+121.AND.K.LE.+259) THEN BX6(I,J,K)=B1 BY6(I,J,K)=B2 BZ6(I,J,K)=B3 NPTBOX(6,IF)=NPTBOX(6,IF)+1 ELSEIF (K.GE.+77.AND.K.LE.+120) THEN BX5(I,J,K)=B1 BY5(I,J,K)=B2 BZ5(I,J,K)=B3 NPTBOX(5,IF)=NPTBOX(5,IF)+1 ELSEIF (K.GE.-167.AND.K.LE.-90) THEN BX1(I,J,K)=B1 BY1(I,J,K)=B2 BZ1(I,J,K)=B3 NPTBOX(1,IF)=NPTBOX(1,IF)+1 ELSEIF (K.GE.+69.AND.K.LE.+76) THEN BX4(I,J,K)=B1 BY4(I,J,K)=B2 BZ4(I,J,K)=B3 NPTBOX(4,IF)=NPTBOX(4,IF)+1 ELSEIF (K.GE.-89.AND.K.LE.-82) THEN BX2(I,J,K)=B1 BY2(I,J,K)=B2 BZ2(I,J,K)=B3 NPTBOX(2,IF)=NPTBOX(2,IF)+1 ENDIF 10 CONTINUE 11 CONTINUE if (idbg.ge.1) write (6,'(a33,a8,a2,2i8)') & ' Total and Read points from file ',fname(if),': ',npf(if),l write (6,'(a33,a8,a2,2i8)') & ' Total and Read points from file ',fname(if),': ',npf(if),l IF (NPF(IF).NE.L) ISTOP=1 INBOX=0 DO 12 IB=1,6 if (idbg.ge.1) write (6,'(a18,i2,a1,i8)') & ' ---> into Box',ib,':',nptbox(ib,if) INBOX=INBOX+NPTBOX(IB,IF) 12 CONTINUE if (idbg.ge.1) write (6,'(a35,a8,a2,i8)') & ' Total points into Boxes from file ',fname(if),': ',inbox IF (NPF(IF).NE.INBOX) ISTOP=1 100 CONTINUE if (idbg.ge.1) write (6,*) '----------------', & '---------------------------------------------------------------' write (6,*) 'S2FLREAD: Magnetic field files read and organised ' write (6,*) '----------------', & '---------------------------------------------------------------' IF (ISTOP.NE.0) THEN PRINT *, ' S2FLREAD: Incorrect ISTOP = ',ISTOP STOP ENDIF RETURN END *+DECK,S2KEY. *CMZ : 2.05/36 22/06/95 21.00.54 by Hal Kalechofsky *CMZ : 2.05/29 21/06/95 16.50.52 by Hal Kalechofsky *CMZ : 2.05/28 16/06/95 16.39.02 by Hal Kalechofsky *CMZ : 2.05/22 12/06/95 11.11.47 by Hal Kalechofsky *-- Author : SUBROUTINE S2KEY C C *********************************************************************** C * * C * Definition of FFREAD Keys * C * * C *********************************************************************** C * * C * CALLED BY : SXKEY * C * CONTACT : * C * * C * ORIGIN : C * REWRITTEN : C * MODIFICATIONS : * C * * C *********************************************************************** IMPLICIT NONE *KEEP,SC2FFK. C --- Common with the users defined FFKEY cards INTEGER INAME1,INAME2,IMIX1 REAL SNAME1,SNAME2,SMIX2,SMIX3 COMMON /SC2FFK/INAME1,INAME2,SNAME1,SNAME2,IMIX1,SMIX2,SMIX3 * Here write comments for each card. Transfer the same comments to the * runcards file. * In the examples the data cards are EXMP1, EXMP2 and EXMP3. * The first one has two Integer variables, INAME1 and INAME2 that can * take the values that the user specifies from the runcards file. * Similarly the EXMP2 has 2 real variables while the EXMP3 has 3 mixed * variables * * DATA CARD : EXMP1 * to control the ........... * INAME1 = 100 ==> .... * INAME1 = 200 ==> .... * * INAME2 = 1000 ==> ... * INAME2 = 2000 ==> ... * * * DATA CARD : EXMP2 * to control the ........... * SNAME1 = 100. ==> .... * SNAME1 = 200. ==> .... * * SNAME2 = 1000. ==> ... * SNAME2 = 2000. ==> ... * C INAME1 = 100 C INAME2 = 1000 C CALL FFKEY('EXMP1',INAME1, 2,'INTEGER') C C SNAME1 = 100.0 C SNAME2 = 1000.0 C CALL FFKEY('EXMP2',SNAME1, 2,'REAL') C C IMIX1 = 0 C SMIX2 = 0. C SMIX3 = 0. C CALL FFKEY( 'EXMP3',IMIX1,3,'MIXE' ) 9999 CONTINUE RETURN END