Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50430/bracur.f4
There are no other files named bracur.f4 in the archive.
C
C CALCULATE FOUR DISSIMILARITY MATRICES FROM MAT(1-4).DAT
C AND WRITE THEIR LOWER TRIANGLES TO DSK IN DEN(1-4).DAT
C
C ALL DISSIMILARITIES ARE CALCULATED ON COLUMN VERSUS COLUMN
C ENTITIES. CONDIT HAS WRITTEN MATRIX TRANSPOSE WHERE NECESSARY.
C
DIMENSION RMAT(1),WORK(1),RT(4),OVT(8,4)
DIMENSION IDO(4),CT(4)
DIMENSION IDISS(4),IPRT(4),TITLE(13)
COMMON KI,KO,INDSK,IODSK
C
C OVERALL TITLES FOR FOUR MATRICES
C
DATA (OVT(I,1),I=1,8)/'ENT1/ATTR DATA ENT1/ENT1 DISSIMILARITY'/
DATA (OVT(I,2),I=1,8)/'ENT1/ATTR DATA ATTR/ATTR DISSIMILARITY'/
DATA (OVT(I,3),I=1,8)/'ENT2/ATTR DATA ENT2/ENT2 DISSIMILARITY'/
DATA (OVT(I,4),I=1,8)/'ENT2/ATTR DATA ATTR/ATTR DISSIMILARITY'/
C
C ROW AND COLUMN TITLES FOR TRELLICE PRINTOUTS
C
DATA RT/'ENT1 ATTR.ENT2 ATTR.'/
DATA CT/'ENT1 ATTR.ENT2 ATTR.'/
C
C INITIALISE AND GET APPROPRIATE OPTIONS
C
CALL INIT
CALL GBRA(IDISS,TITLE,IPRT,IDO)
ISQ=0
IGOT=0
C
C LOOP FOUR TIMES IF REQD TO DO EACH MATRIX
C
DO 25 NMAT=1,4
IF(IDISS(NMAT).EQ.7)GO TO 25
C
C MAKE INPUT ANND OUTPUT FILENAMES
C
ENCODE(5,5,FILE)NMAT
5 FORMAT('MAT',I1,' ')
ENCODE(5,7,DFLE)NMAT
7 FORMAT('DEN',I1,' ')
CALL IFILE(INDSK,FILE)
C
C DIMENSIONS FOR THIS ONE AND GET NEEDED CORE
READ(INDSK)NR,NC
IF(NR*NC.LE.IGOT)GO TO 10
CALL MORCOR(RMAT,IR,NR*NC)
IGOT=NR*NC
10 IF(MAX0(NR,NC)**2.LE.ISQ)GO TO 12
CALL MORCOR(WORK,IW,MAX0(NR,NC)**2)
ISQ=MAX0(NR,NC)**2
C
C READ IN THE ARRAY
C
12 CALL GETARR(RMAT(IR),NC,NR)
C
C CALCULATE THE DESIRED DISSIMILARITY
C
GO TO (13,14,15,16,17,18,20),IDISS(NMAT)
13 CALL BRACUR(RMAT(IR),NR,NC,WORK(IW))
GO TO 20
14 CALL MANHAT(RMAT(IR),NR,NC,WORK(IW))
GO TO 20
15 CALL CANBRA(RMAT(IR),NR,NC,WORK(IW))
GO TO 20
16 CALL DSQRD(RMAT(IR),NR,NC,WORK(IW))
GO TO 20
17 CALL MATCH(RMAT(IR),NR,NC,WORK(IW))
GO TO 20
18 CALL RATIO(RMAT(IR),NR,NC,WORK(IW))
GO TO 20
C
C WRITE OUT THE LOWER TRIANGLE
C
20 CALL LTWR(WORK(IW),NC,DFLE,OVT(1,NMAT),TITLE)
C
C PRINT THE TRELLICE IF REQD USING 'STANDARD ' WRITING ROUTINE
C
IF(.NOT.IPRT(NMAT))GO TO 25
CALL MATWRT(WORK(IW),NC,NC,RT(NMAT),CT(NMAT),OVT(1,NMAT),TITLE)
C
25 CONTINUE
C
C RUN THEE NEXT ON IN THE SUITE
C
CALL RUN3
CALL EXIT
END