Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-01 - decus/20-0009/nvmis2.for
There is 1 other file named nvmis2.for in the archive. Click here to see a list.
      SUBROUTINE LORGEN (J, TMASS, TP, DCTGT, BETLAB, BPLAB,
     1 DCBM, EIN, PIN, DCIN, EOUT, POUT, DCOUT )                            0030
CLORGEN    LORENTZ TRANSFORMATION GENERAL                                   0020
C     J = O GIVES TRANSFORM FROM LAB INTO C OF M                            0040
C     J NOT ZERO GIVES TRANSFORM FROM C OF M INTO LAB                       0050
C     ERROR RETURN IS POUT ZERO OR NEGATIVE                                 0060
C     BETLAB, BPLAB, DCTRA ARE TOTAL ENERGY, MOMENTUM AND DCS OF            0070
C    1   INCIDENT PART                                                      0080
C     EIN, PIN, DCIN ARE SAME FOR TRANSFORMED PART                          0090
C     POUT, DCOUT ARE SAME (RETURNED) AFTER TRANSFORMATION                  0100
C     TMASS IS TARGET MASS * ZERO FORM DECAY                                0110
C     NO COMMON REQUIRED                                                    0120
      DIMENSION    DCTOT(3), DCTGT(3), DCBM(3)                              0130
      BETA = 0                                                              0150
      DO 50   K = 1,3                                                       0160
      DCTOT(K) = DCTGT(K)*TP+DCBM(K)*BPLAB                                  0170
 50   BETA = BETA + DCTOT(K)**2                                             0180
      BETA = SQRT(BETA)                                                     0190
      DO 60   K = 1,3                                                       0200
 60   DCTOT(K) = DCTOT(K)/BETA                                              0210
      BETA = BETA/(BETLAB + SQRT(TP**2 + TMASS**2))                         0220
      IF (J)  63, 65, 63                                                    0230
 63   BETA = -BETA                                                          0240
 65   CONTINUE                                                              0250
      CALL LORTRA(BETA, DCTOT(1),EIN,PIN,DCIN,EOUT,POUT,DCOUT)              0260
      RETURN                                                                0270
      END                                                                   0280
      SUBROUTINE LORTRA(BETA,DCTRA,EIN,PIN,DCIN,EOUT,POUT,DCOUT)
CLORTRA  LORENTZ TRANSFORMATION SUBROUTINE                                  0020
      DIMENSION  DCTRA(3), DCIN(3), DCOUT(3), TRAN(4,4),PUNT(4),PTRAN(4)    0030
      GAMMA = 1.0 / SQRT( 1.0 - BETA**2 )                                   0050
 5    CONTINUE                                                              0060
      DO 10   L = 1,4                                                       0070
      DO 9   M = 1,4                                                        0080
 9    TRAN(L,M) = 0.0                                                       0090
 10   TRAN(L,L) = 1.0                                                       0100
      DO 15   L = 1,3                                                       0110
      DO 12   M = L,3                                                       0120
 12   TRAN (L,M) = TRAN (L,M) + (GAMMA - 1.0) * DCTRA(L) * DCTRA(M)         0130
      TRAN (L,4) = -BETA * DCTRA(L) * GAMMA                                 0140
      LL = L + 1                                                            0150
      DO 15   N = LL, 4                                                     0160
      TRAN (N,L) = TRAN(L,N)                                                0170
 15   CONTINUE                                                              0180
      TRAN(4, 4) = GAMMA                                                    0190
      DO 20   K = 1,3                                                       0200
 20   PUNT(K) = PIN * DCIN(K)                                               0210
      PUNT(4) = EIN                                                         0220
      DO 25   L = 1,4                                                       0230
      PTRAN(L) = 0.0                                                        0240
      DO 25   M = 1,4                                                       0250
 25   PTRAN(L) = PTRAN(L)  + TRAN(L,M) * PUNT (M)                           0260
      POUT = SQRT( PTRAN(1) **2 + PTRAN(2)**2 + PTRAN(3)**2)                0270
      DO 30   K = 1,3                                                       0280
 30   DCOUT(K) = PTRAN(K) / POUT                                            0290
      EOUT = PTRAN(4)                                                       0300
      RETURN                                                                0310
      END                                                                   0320
	SUBROUTINE LTON(N,A,L,LENGTH)
	COMMON /LET/ NBLANK,LET(30),NPLUS,NUM(10)
	DIMENSION A(2),L(2)
      EQUIVALENCE (KA,AA)
      LFLAG=+1
      NN=N
      DO 10 I=1,NN
10    L(I)=0
      NZ=1
      DO 70 I=1,NN
      AA=A(I)
      DO 30 M=1,30
      IF(KA.NE.LET(M)) GO TO 30
      KA=M
      GO TO 60
30    CONTINUE
      DO 40 M=1,10
      IF(KA.NE.NUM(M)) GO TO 40
      KA=M-1
      GO TO 60
40    CONTINUE
      IF(KA.NE.NPLUS) GO TO 50
      LFLAG=-1
      GO TO 70
50    IF(KA.EQ.NBLANK) GO TO 70
      KA=0
60    L(NZ)=LFLAG*KA
      NZ=NZ+1
      LFLAG=+1
70    CONTINUE
      LENGTH=NZ-1
	RETURN
	END
      SUBROUTINE NTOL(N,A,L)
	COMMON /LET/ NBLANK,LET(30),NPLUS,NUM(10)
	DIMENSION A(2),L(2)
	EQUIVALENCE  (KA,AA)
      DO 200 I=1,N
      LL=L(I)
      IF(LL)115,105,110
105   KA=NBLANK
      GO TO 120
110   IF(LL.LE.30) GO TO 125
115   KA=0
120   A(I)=AA
      GO TO 300
125   KA=LET(LL)
      A(I)=AA
200   CONTINUE
300   RETURN
      END
      FUNCTION NOTABL (LA, LB)
CNOTABL  FORTRAN FUNCTION TO FIND OTABLE INDEX GIVEN END LABELS             0020
C     ************************* COMMON COMMON **************************    0030
      COMMON    MAP(2000),PARS(1000),MISC(27),KLIST(500),MTABLE(2)
      DIMENSION LTABLE(9,20,2),ITABLE(6,20)
      DIMENSION PARA(1000),NPARA(1000),SNAME(1000),NAME(1000),TABLE(100)
      DIMENSION    HEAD(11), NBRNCH(10),HTABLE(7,100)
      EQUIVALENCE (MAP,ZMAP),(TABLE(1),PARA(101))
      EQUIVALENCE  (OTABLE,JTABLE,MAP(701)), (RTABLE,LTABLE,MAP(1051)),
     1             (ITABLE,MAP(1411)), (VAL,IVAL,MAP(1531)),
     2             (WGT,MAP(1631))
      EQUIVALENCE  (NCFLAG,MAP(1869)), (WEIGHT,MAP(1978)),
     1             (NTAPE,MAP(1988)), (EINC,MAP(1998)),
     2             (PINC,MAP(1999)), (BINC,MAP(2000))
      EQUIVALENCE (PARA,NPARA,PARS),(SNAME,NAME,MAP(1))
      EQUIVALENCE  (PI, MISC), (RADIAN, MISC(2)), (NIT, MISC(3)),
     1             (NOT, MISC(4)), (HEAD, MISC(5)), (NBRNCH, MISC(16)),
     2             (NPAGE, MISC(26)), (NORD, MISC(27))
      EQUIVALENCE  (LTAPE,NBRNCH(9)), (LINK,NBRNCH(10)), (HTABLE,MAP)
C     ************************* END OF C, D, E STATEMENTS **************    0260
C                                                                           0270
      IF (LA.LT.1 .OR. LA.GT.20) GO TO 15
      IF (LA.EQ.1 .AND. LB.EQ.1) GO TO 18
      DO 10   L = 1,8                                                       0280
      IF (LTABLE(L,LA,2) - LB)   10, 20, 10                                 0290
 10   CONTINUE                                                              0300
C        ERROR RETURN ON FAILURE TO FIND TRACK                              0310
 15   NOTABL = 0
      GO TO 30                                                              0330
C        BEAM TRACK
 18   NOTABL = 1
      GO TO 30
 20   NOTABL = ITABLE(2,LA) + L                                             0340
 30   RETURN                                                                0350
      END                                                                   0360
      SUBROUTINE OFIX (NFLG)
COFIX    SUBROUTINE TO SET UP OTABLE INDICES                                0020
C     ************************* COMMON COMMON **************************    0030
      COMMON    MAP(2000),PARS(1000),MISC(27),KLIST(500),MTABLE(2)
      DIMENSION ZMAP(2000)                                              NBOD0110
      DIMENSION REMARK(500)
      DIMENSION    OTABLE(7,50), JTABLE(7,50), RTABLE(9,20,2),          NBOD0120
     1             LTABLE(9,20,2), ITABLE(6,20), VAL(100), IVAL(100),   NBOD0130
     2             WGT(100)                                             NBOD0140
      DIMENSION PARA(1000),NPARA(1000),SNAME(1000),NAME(1000)
      DIMENSION    HEAD(11), NBRNCH(10)                                 NBOD0170
      DIMENSION    HTABLE(7,100)                                        NBOD0180
      EQUIVALENCE (MAP,ZMAP)                                            NBOD0340
      EQUIVALENCE (REMARK,MAP(1001))
      EQUIVALENCE  (OTABLE,JTABLE,MAP(701)), (RTABLE,LTABLE,MAP(1051)), NBOD0350
     1             (ITABLE,MAP(1411)), (VAL,IVAL,MAP(1531)),            NBOD0360
     2             (WGT,MAP(1631))                                      NBOD0370
      EQUIVALENCE  (NCFLAG,MAP(1869)), (WEIGHT,MAP(1978)),              NBOD0380
     1             (NTAPE,MAP(1988)), (EINC,MAP(1998)),                 NBOD0390
     2             (PINC,MAP(1999)), (BINC,MAP(2000))                   NBOD0400
      EQUIVALENCE (PARA,NPARA,PARS),(SNAME,NAME,MAP(1))
      EQUIVALENCE  (PI, MISC), (RADIAN, MISC(2)), (NIT, MISC(3)),       NBOD0490
     1             (NOT, MISC(4)), (HEAD, MISC(5)), (NBRNCH, MISC(16)), NBOD0500
     2             (NPAGE, MISC(26)), (NORD, MISC(27))                  NBOD0510
      EQUIVALENCE (HTABLE,MAP)
C     ************************* END OF C, D, E STATEMENTS **************    0260
C                                                                           0270
      IF (NFLG)  440, 400, 440
 400  NFLG = NFLG+1
C     OTABLE(I,1) IS RESERVED FOR THE INCIDENT BEAM TRACK
      JTABLE(6,1) = 1
      JTABLE(7,1) = 1
      II = 2
      KK = 1
C     ALLOT A POSITION IN OTABLE TO EACH REMAINING TRACK
      DO 430 K=1,20
      NPROD = ITABLE(1,K)
      IF (NPROD) 430, 430, 410
 410  DO 420 I=1,NPROD
      JTABLE(6,II) = K
      JTABLE(7,II) = LTABLE(I,K,2)
 420  II = II+1
      ITABLE(2,K) = KK
      KK = KK+NPROD
 430  CONTINUE
 440  RETURN
      END
      SUBROUTINE PAREAD(NIT,NOT,NBRNCH,HEAD,PARA,LPARA,SNAME,RMAP,LMAP)
      DIMENSION NBRNCH(10), HEAD(10), REMARK(9)
      DIMENSION PARA(2), SNAME(2), RMAP(10,2)                           PARE0060
      DIMENSION IADDRS(10), ILAST(10)
      EQUIVALENCE (TEMP, ITEMP), (TNAME, NAME)
      EQUIVALENCE (ATABLE,ITABLE), (BLANKS,IBLNKS)
      DATA BLANKS /'     '/
      DATA IH9999/'H9999'/, IOBBBB/'O    '/
      DATA ILARGE /16777216/
C                                                                       PARE0120
      NTABLE = 0                                                        PARE0130
   20 READ (NIT,1)  NBRNCH, HEAD
    1 FORMAT (10I2,10A4)
      IF(NBRNCH(1)) 25,20,20
   25 IF(LPARA.GT.0) GO TO 28
C
C     FIRST CALL - CLEAR PARA
      LPARA=IABS(LPARA)
   26 DO 27 I=1,LPARA
   27 PARA(I) = 0.
C
   28 DO 10 I=1,LPARA
   10 SNAME(I)=BLANKS
 29   LIMAP = LMAP/10                                                   JULY 12
      IF(LMAP) 30,30,11
   11 CONTINUE
      DO 12 J = 1,LIMAP                                                 PARE0340
      DO 12 I=1,10                                                      OCT 1
   12 RMAP(I,J)=BLANKS                                                  OCT 1
   30 NBRNCH(1) = IABS(NBRNCH(1))
      WRITE (NOT,2)         NBRNCH, HEAD
    2 FORMAT (1H1 10I3, 10X, 10A4 )
      II = 0                                                            PARE0460
C     BEGIN READ-IN LOOP                                                OCT 1
      DO 110 I = 1,LPARA                                                PARE0470
      READ (NIT,3)NN, ATABLE, TEMP, TNAME, REMARK                       PARE0490
    3 FORMAT (I3, A1, 1X, F12.0, 3X,A4,2X9A4)
      IF (NN) 32, 120, 32                                               PARE0510
   32 IF (NN - LPARA) 36, 36, 34                                        PARE0520
   34 WRITE (NOT,4)NN, TEMP, TNAME, REMARK                              PARE0530
    4 FORMAT(26H0THIS CARD EXCEEDS LIMITS I3, 2X, F12.5, 2X, A4, 3X,
     1 9A4)
      GO TO 110                                                         PARE0560
   36 IF (ITABLE - IBLNKS) 380, 38, 380
  380 ILONG = TEMP                                                      PARE0580
      IBEG = NN                                                         PARE0590
      IEND = IBEG + ILONG - 1                                           PARE0600
      NTABLE = NTABLE + 1                                               PARE0610
      IADDRS(NTABLE)=NN
      ILAST(NTABLE)=IEND
      IF (IEND - LPARA) 400, 400, 500                                   PARE0650
  400 READ (NIT,REMARK)(PARA(MN), MN = IBEG,IEND)                       PARE0660
      IF (NTABLE - 1) 390, 385, 390                                     PARE0670
  385 WRITE (NOT,386)                                                   PARE0680
  386 FORMAT (15H0TABLES READ IN  )
  390 WRITE (NOT,391)TNAME, ILONG, IBEG, IEND                           PARE0700
  391 FORMAT (1H0 A4, 1H( I3, 9H) = PARA( I3, 1H- I3, 1H)   /)
      WRITE (NOT,REMARK)(PARA(MN), MN = IBEG, IEND)                     PARE0720
      GO TO 110                                                         PARE0730
C                                                                       PARE0740
C     CHECK NAME FOR BLANKS AND DETERMINE FIXED OR FLOATING             PARE0750
C                                                                       PARE0760
   38 II=II+1                                                           OCT 1
      IF (NAME.GT.IH9999 .AND. NAME.LT.IOBBBB)  ITEMP = TEMP
   70 PARA(NN) = TEMP                                                   PARE0860
C                                                                       PARE0870
C     PLACE SYMBOLIC NAMES IN SNAME AND REMARKS IN RMAP                 PARE0880
C                                                                       PARE0890
      SNAME(NN) = TNAME                                                 PARE0900
      IF (II - LIMAP) 80, 80, 110                                       PARE0910
   80 RMAP(1,II) = NN                                                   PARE0920
      DO 90 JJ = 2,10                                                   PARE0930
      RMAP(JJ,II) = REMARK(JJ - 1)                                      PARE0940
   90 CONTINUE                                                          PARE0950
  110 CONTINUE                                                          PARE0960
C                                                                       PARE0970
C     PRINT OUT PARAMETERS                                              PARE0980
C                                                                       PARE0990
  120 WRITE (NOT,5)                                                     PARE1000
    5 FORMAT (25H0PARAMETERS CURRENTLY ARE  /)
C     BEGIN PRINT-OUT LOOP                                              OCT 1
      DO 180 M = 1,LPARA
      IF(NTABLE) 211,211,111
  111 DO 200 KCOR=1,NTABLE
      IF(M-IADDRS(KCOR)) 200,180,191
  191 IF(M-ILAST(KCOR))180,180,200
  200 CONTINUE
  211 TEMP = PARA(M)
      IF (IABS(ITEMP).LT.ILARGE)  GO TO 190
  185 IFLAG=0                                                           OCT 1
      GO TO 210                                                         OCT 1
  190 IFLAG=1                                                           OCT 1
  210 IF (PARA(M)) 130, 888, 130
  888 IF (SNAME(M).EQ.BLANKS) GO TO 180
  130 FM = M                                                            PARE1090
      DO 140 II = 1,LIMAP                                               PARE1100
      IJ = II                                                           PARE1110
      IF (RMAP(1,II) - FM) 140, 150, 140                                PARE1120
  140 CONTINUE                                                          PARE1130
      GO TO 160                                                         PARE1140
  150 IF (IFLAG)152,152,151                                             OCT 1
  151 WRITE(NOT,88)M, SNAME(M), ITEMP,   (RMAP(K,IJ),K=2,10)
   88 FORMAT(1H I4, 3X,A4,2XI12, 6X, 9A4)
      GO TO 180                                                         OCT 1
  152 WRITE(NOT,8) M,SNAME(M),TEMP,   (RMAP(K,IJ),K=2,10)
    8 FORMAT (1H I4, 3X,A4,2XF12.5, 6X, 9A4)
      GO TO 180                                                         PARE1170
  160 IF(IFLAG) 162,162,161                                             OCT 1
  161 WRITE (NOT,88)M, SNAME(M), ITEMP
      GO TO 180                                                         OCT 1
  162 WRITE (NOT,8) M, SNAME(M), TEMP
  180 CONTINUE                                                          PARE1200
      GO TO 1000                                                        PARE1210
  500 WRITE (NOT,501)TNAME, ILONG, IBEG                                 PARE1220
  501 FORMAT (12H0 THE TABLE  A4, 1H(  I3, 20H) BEGINNING AT PARA( I3,  PARE1230
     1 64H) EXCEEDS DIMENSION LIMITS. FURTHER EXECUTION TERMINATED BY EXPARE1240
     2IT)                                                               PARE1250
      CALL EXIT                                                         PARE1260
 1000 RETURN                                                            PARE1270
      END                                                               PARE1280
      SUBROUTINE SCALW
      COMMON MAP(2000), PARS(1000)
      EQUIVALENCE (WSCALE,MAP(1972))
      WSCALE = 1.0
      IF (PARS(93) .GT. 0.)  WSCALE = PARS(93)
      RETURN
      END
      FUNCTION SPACE (KTABLE, LIM)
CSPACE   SPACES OUT MTABLE ENTRIES FOR WEIGHTED HISTOGRAMS                  0020
C                                                                           0030
      DIMENSION    KTABLE(7,100)                                            0040
C                                                                           0060
      SPACE = 0.0                                                           0070
      MNO = 1                                                               0080
C                                                                           0090
      DO 60   K = 1, 100                                                    0100
      KC = KTABLE(1,K)                                                      0110
      KN = KTABLE(5,K)                                                      0120
      IF (KC)   10, 80, 10                                                  0130
 10   KTABLE(2,K) = MNO                                                     0140
      IF (KC - 1000)   20, 30, 30                                           0150
 20   MNOINC = 3 * (IABS(KN) + 2)                                           0160
      GO TO 60                                                              0170
 30   IF (KC - 2000)   40, 50, 50                                           0180
 40   MNOINC = 0                                                            0190
      NX = IABS(KN) + 1                                                     0200
      GO TO 60                                                              0210
 50   MNOINC= NX* (IABS(KN) + 1) + 5                                        0220
 60   MNO = MNO + MNOINC                                                    0230
C                                                                           0240
 80   IF (MNO - LIM)   100, 100, 90                                         0250
 90   SPACE = 1.0                                                           0260
 100  RETURN                                                                0270
      END                                                                   0280
      FUNCTION SQMASS (KB, KE)
C      ******************    COMMON COMMON   ***************************    0020
      COMMON    MAP(2000),PARS(1000),MISC(27),KLIST(500),MTABLE(2)
      DIMENSION OTABLE(7,50), VM(3)
      EQUIVALENCE (OTABLE,MAP(701))
C     ************************* END OF C, D, E STATEMENTS **************
C                                                                           0250
      EMS = 0.0                                                             0260
      DO 5   N = 1,3                                                        0270
 5    VM(N) = 0.0                                                           0280
      DO 30   K = KB,KE                                                     0290
      KL = KLIST(K)                                                         0300
      EMS = EMS + OTABLE(5,KL)                                              0310
      DO 10   L = 1,3                                                       0320
 10   VM(L) = VM(L) + OTABLE(L,KL) * OTABLE(4,KL)                           0330
 30   CONTINUE                                                              0340
C                                                                           0350
      SQMASS = EMS**2 - VM(1)**2 - VM(2)**2 - VM(3)**2                      0360
      RETURN                                                                0370
      END                                                                   0380
      SUBROUTINE TRHIST(NOT,NPRINT,NAME,NHST,HST,ERROR,M,A,B)
C
C      TRHIST*1  - SUBROUTINE TO PRINT HISTOGRAMS PREPARED BY HISTO
C     NPRINT = 0 FOR INTEGER HISTOGRAM (HISTO)                          TRHI0030
C     NPRINT = 1 FOR IDEOGRAM PRINT  (HISTOI)                           TRHI0040
C     NPRINT = 2 FOR WEIGHTED HISTOGRAM (HISTOW)                        TRHI0050
C
      DIMENSION  NHST(10),HST(10),ERROR(10),HIST(60),NAME(3)
      IF (NOT)  5000, 5000, 102                                         TRHI0090
 102  CONTINUE                                                          TRHI0100
      NSUM = 0                                                          TRHI0110
      NSCALE = 0                                                        TRHI0120
      SUM = 0.0                                                         TRHI0130
      SCALE = 0.0                                                       TRHI0140
      MORE = M+1                                                        TRHI0150
      LIM = M+2                                                         TRHI0160
      AA = A                                                            TRHI0170
      DO 105  I = 1, LIM                                                TRHI0180
      IF (NHST(I)) 105, 105, 106                                        TRHI0190
 105  CONTINUE                                                          TRHI0200
      WRITE (NOT,9105)NAME                                              TRHI0210
C	CHANGE 3A4 TO 3A5 FOR PDP-10
 9105 FORMAT ( 11H1HISTOGRAM   3A5, 13H IS UNFILLED         )
      GO TO 5000                                                        TRHI0230
 106  CONTINUE                                                          TRHI0240
      IF (NPRINT - 1)  180, 110, 110                                    TRHI0250
  110 DO 120 I = 1,M
      IF (HST(I) - SCALE)  120, 120, 115                                TRHI0270
 115  SCALE = HST(I)                                                    TRHI0280
  120 SUM = SUM + HST(I)                                                TRHI0290
	SUM = SUM + HIST(MORE) + HIST(LIM)
  180 DO 190 I = 1,M
      IF (NHST(I) - NSCALE)  190, 190, 185                              TRHI0310
 185  NSCALE = NHST(I)                                                  TRHI0320
  190 NSUM = NSUM + NHST(I)                                             TRHI0330
	NSUM = NSUM + NHST(MORE) + NHST(LIM)
      SCALEN = NSCALE                                                   TRHI0340
  200 EM = M                                                            TRHI0350
      D = (B-A)/EM                                                      TRHI0360
  530 WRITE (NOT,9010)NAME,NSUM,SUM,NSCALE                              TRHI0370
C	CHANGE 3A4 TO 3A5 FOR PDP-10
 9010  FORMAT (34H1 THE FOLLOWING IS A HISTOGRAM OF  3A5, 6H WITH  I5,  TRHI0380
     1  23H UNWEIGHTED EVENTS AND  F8.2, 34H WEIGHTED EVENTS.  SCALE FACTRHI0390
     2TOR =  I4///  102H0      INTERVAL          NOT       WEIGHTED     TRHI0400
     3  ERROR     HISTOGRAM BASED ON SCALE FACTOR = 60            /     TRHI0410
     4     23X 9HWEIGHTED   /)
      IF (NPRINT - 1)  535, 540, 545                                    TRHI0430
 535  NUM = (NHST(LIM) * 60 ) / NSCALE                                  TRHI0440
      WTD = 0.0                                                         TRHI0450
      GO TO 542                                                         TRHI0460
 540  NUM = (HST(LIM) * 60.0 ) / SCALE                                  TRHI0470
      WTD = HST(LIM)                                                    TRHI0480
 542  ERR = NHST(LIM)                                                   TRHI0490
      ERR = SQRT(ERR)                                                   TRHI0500
      GO TO 550                                                         TRHI0510
 545  NUM = (HST(LIM) * 60.0 ) / SCALE                                  TRHI0520
      WTD = HST(LIM)                                                    TRHI0530
      ERR = SQRT(ERROR(LIM))                                            TRHI0540
 550  CALL LOADX(HIST, NUM)                                             TRHI0550
      WRITE (NOT,9020)AA, NHST(LIM), WTD, ERR, HIST                     TRHI0560
 9020 FORMAT (13H0LESS THAN   F8.3,4XI5,5XF8.3,5XF8.3,4X60A1     /)
      DO 300 I = 1,M                                                    TRHI0580
      AB =AA + D                                                        TRHI0590
  220 IF (NPRINT-1) 230, 235, 240                                       TRHI0600
 230  NUM = (FLOAT(NHST(I)) * 60.0) / SCALEN                            TRHI0610
      WTD = 0.0                                                         TRHI0620
      GO TO 237                                                         TRHI0630
 235  NUM = ( HST(I) * 60.0 ) / SCALE                                   TRHI0640
      WTD = HST(I)                                                      TRHI0650
 237  ERR = NHST(I)                                                     TRHI0660
      ERR = SQRT(ERR)                                                   TRHI0670
      GO TO 245                                                         TRHI0680
 240  NUM = ( HST(I) * 60.0 ) / SCALE                                   TRHI0690
      WTD = HST(I)                                                      TRHI0700
      ERR = SQRT(ERROR(I))                                              TRHI0710
 245  CALL LOADX ( HIST, NUM)                                           TRHI0720
      WRITE (NOT,9030)AA, AB, NHST(I), WTD, ERR, HIST                   TRHI0730
 9030 FORMAT (1H  F8.3,4H TO  F8.3,4XI5,5XF8.3,5XF8.3,4X60A1        )   11/14/64
      AA= AB                                                            TRHI0750
  300 CONTINUE                                                          TRHI0760
      IF (NPRINT - 1)  335, 340, 345                                    TRHI0770
 335  NUM = (NHST(MORE)* 60 ) / NSCALE                                  TRHI0780
      WTD = 0.0                                                         TRHI0790
      GO TO 342                                                         TRHI0800
 340  NUM = (HST(MORE)* 60.0 ) / SCALE                                  TRHI0810
      WTD = HST(MORE)                                                   TRHI0820
 342  ERR = NHST(MORE)                                                  TRHI0830
      ERR = SQRT(ERR)                                                   TRHI0840
      GO TO 350                                                         TRHI0850
 345  NUM = (HST(MORE)* 60.0 ) / SCALE                                  TRHI0860
      WTD = HST(MORE)                                                   TRHI0870
      ERR = SQRT(ERROR(MORE))                                           TRHI0880
 350  CALL LOADX(HIST, NUM)                                             TRHI0890
      WRITE (NOT,9040)AA, NHST(MORE),WTD, ERR, HIST                     TRHI0900
 9040 FORMAT(13H0GREATER THAN F8.3,4XI5,5XF8.3,5XF8.3,4X60A1        )
 5000 RETURN                                                            TRHI0920
      END
      SUBROUTINE LOADX (XSS,NUM)
C
C
      DIMENSION XSS(60)
      DATA X /'X'/,  BLANK /' '/
      NA = MIN0(NUM,60)                                                 11/14/64
      DO 110 J = 1, NA                                                  11/14/64
  110 XSS(J)=X
      IF (NA-60) 112, 120, 120                                          11/14/64
  112 NA = NA + 1                                                       11/14/64
      DO 114 J = NA,60                                                  11/14/64
  114 XSS(J)=BLANK
  120 CONTINUE                                                          11/14/64
      RETURN                                                            11/14/64
      END