Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50430/clustr.f4
There are no other files named clustr.f4 in the archive.
C
C PROGRAM TO REDUCE 3D DATA MATRIX TO 2D X 2 MATRICES
C OUTPUT IS TO AVGE.DAT
C
DIMENSION TITLE(13),ROW(1)
REAL SSNUM(1),SSTOT(1),TSNUM(1),TSTOT(1)
INTEGER RED1,RED2
COMMON KI,KO,INDSK,IODSK
C
C INITIALISE
C
CALL INIT
CALL OFILE(IODSK,'AVGE')
C
C GET DIMENSIONS
C
CALL DIMFND(MAXSIT,MAXSES,MAXSPC,TITLE)
IROW=MAX0(MAXSIT,MAXSES)
C
C HEAD THE LISTING
C
WRITE(KO,1)TITLE,MAXSPC,MAXSIT
1 FORMAT('1STUDY TITLE: ',10X,13A5,/,1X,11('-'),/
1'0DIMENSIONS:',/,1X,10('-'),/,
21X,I5,' ATTRIBUTES',/,
31X,I5,' OF ENTITY 1')
IF(MAXSES.NE.1)WRITE(KO,2)MAXSES
2 FORMAT(1X,I5,' OF ENTITY 2',/,
5'0OPTIONS AS READ:',/,1X,15('-'))
C
C GET OPTIONS
C
CALL GETOPT(IF,IDIV,LIST,RED1,RED2)
C
C GET ENOUGH CODE FOR ALL THE ARRAYS
C
CALL MORCOR(SSNUM,ISSN,MAXSIT*MAXSPC)
CALL MORCOR(SSTOT,ISST,MAXSIT*MAXSPC)
CALL MORCOR(TSNUM,ITSN,MAXSES*MAXSPC)
CALL MORCOR(TSTOT,ITST,MAXSES*MAXSPC)
CALL MORCOR(ROW,IRC,IROW)
C
C TEST TO SEE IF THERE WAS ENOUGH
C
ITEST=IRC.OR.ISSN.OR.ISST.OR.ITSN.OR.ITST
IF(ITEST.GE.0)GO TO 10
WRITE(KO,3)
3 FORMAT(' INSUFFICIENT CORE')
CALL EXIT
C
C READ IN THE INPUT ARRAY IN REDUCED FORM
C
10 GO TO (11,12),IF
C
12 CALL CRDSPC(SSNUM(ISSN),SSTOT(ISST),TSNUM(ITSN),TSTOT(ITST),
1 MAXSIT,MAXSES,MAXSPC,IDIV)
GO TO 15
C
11 CALL CRDSIT(SSNUM(ISSN),SSTOT(ISST),TSNUM(ITSN),TSTOT(ITST),
1 MAXSIT,MAXSES,MAXSPC,IDIV)
GO TO 15
C
C LIST THE APPROPRIATE OVERALL SUMMATION
C
15 GO TO (16,17),LIST
16 CALL LISTC(SSNUM(ISSN),SSTOT(ISST),TSNUM(ITSN),TSTOT(ITST),
1 MAXSIT,MAXSPC,MAXSES)
GO TO 20
17 CALL LISRAW(SSNUM(ISSN),SSTOT(ISST),TSNUM(ITSN),TSTOT(ITST),
1 MAXSIT,MAXSPC,MAXSES)
C
C REDUCE THE 3D TO SIT X SPC IN ONE OF 3 WAYS
C
20 GO TO(21,22,23,24,30),RED1
21 CALL LOGRD1(SSNUM(ISSN),SSTOT(ISST),MAXSIT,MAXSPC,ROW(IRC))
GO TO 30
22 CALL AV1(SSNUM(ISSN),SSTOT(ISST),MAXSIT,MAXSPC,ROW(IRC))
GO TO 30
23 CALL LOGAV1(SSNUM(ISSN),SSTOT(ISST),MAXSIT,MAXSPC,ROW(IRC))
GO TO 30
24 CALL SUMMD1(SSNUM(ISSN),SSTOT(ISST),MAXSIT,MAXSPC,ROW(IRC))
C
C REDUCE THE 3D TO TIM X SPC IN ONE OF 3 WAYS
C
30 GO TO (31,32,33,34,32),RED2
31 CALL LOGRD2(TSNUM(ITSN),TSTOT(ITST),MAXSES,MAXSPC,ROW(IRC))
GO TO 40
32 CALL AV2(TSNUM(ITSN),TSTOT(ITST),MAXSES,MAXSPC,ROW(IRC))
GO TO 40
33 CALL LOGAV2(TSNUM(ITSN),TSTOT(ITST),MAXSES,MAXSPC,ROW(IRC))
GO TO 40
34 CALL SUMMD2(TSNUM(ITSN),TSTOT(ITST),MAXSES,MAXSPC,ROW(IRC))
C
C RUN THE NEXT PROGRAM
C
40 CALL RELEAS(IODSK)
CALL RUN1
CALL EXIT
END