Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50430/condit.f4
There are no other files named condit.f4 in the archive.
C
C PROGRAM TO CONDITION REDUCED MATRICES
C INPUT IS FROM AVGE.DAT
C OUTPUT IS TO MAT(1-4).DAT
C
DIMENSION INPUT1(1),INPUT2(1),TITLE(13),WORK(1)
DIMENSION ICONPT(4),IPWR(4),IDO(4)
REAL INPUT1,INPUT2
COMMON KI,KO,INDSK,IODSK
C
C INITIALISE AND GET OPTIONS
C
CALL INIT
CALL IFILE(INDSK,'AVGE')
READ(INDSK)MAXSIT,MAXSES,MAXSPC,TITLE
CALL GCON(ICONPT,IPWR,IDO)
C
C GET CORE FOR THE TWO MATRICES
C
CALL MORCOR(INPUT1,I1,MAXSIT*MAXSPC)
CALL GETARR(INPUT1(I1),MAXSIT,MAXSPC)
CALL MORCOR(INPUT2,I2,MAXSES*MAXSPC)
CALL GETARR(INPUT2(I2),MAXSES,MAXSPC)
CALL RELEAS(INDSK)
C
C NEED A WORKING VECTOR FOR ROUTINES
C
20 KT=MAX0(MAXSIT,MAXSPC)
CALL MORCOR(WORK,IW,MAX0(KT,MAXSES))
C
C DO THE SITE X SPECIES FOR SITE X SITE DISSIMILARITY
C
GO TO (21,22,23,24,30),ICONPT(1)
21 CALL PWRNOT(INPUT1(I1),IPWR(1),'MAT1',MAXSIT,MAXSPC,WORK(IW))
GO TO 30
22 CALL STNNOT(INPUT1(I1),'MAT1',MAXSIT,MAXSPC,WORK(IW))
GO TO 30
23 CALL NOTNOT(INPUT1(I1),'MAT1',MAXSIT,MAXSPC)
GO TO 30
24 CALL DEVNOT(INPUT1(I1),'MAT1',MAXSIT,MAXSPC,WORK(IW))
GO TO 30
C
C DO THE TIMES BY SPECIES CONDITIONING FOR TIME X TIME DISSIMILARITY
C
30 GO TO (31,32,33,34,40),ICONPT(3)
31 CALL PWRNOT(INPUT2(I2),IPWR(3),'MAT3',MAXSES,MAXSPC,WORK(IW))
GOTO40
32 CALL STNNOT(INPUT2(I2),'MAT3',MAXSES,MAXSPC,WORK(IW))
GO TO 40
33 CALL NOTNOT(INPUT2(I2),'MAT3',MAXSES,MAXSPC)
GO TO 40
34 CALL DEVNOT(INPUT2(I2),'MAT3',MAXSES,MAXSPC,WORK(IW))
GO TO 40
C
C DO THE SIT X SPC CONDITIONING FOR SPC X SPC DISSIMILARITY
C WRITTEN OUT TRANSPOSE FOR SPC X SPC DISSIMIL.
C
40 GO TO (41,42,43,44,50),ICONPT(2)
41 CALL PWRTRN(INPUT1(I1),IPWR(2),'MAT2',MAXSIT,MAXSPC,WORK(IW))
GO TO 50
42 CALL STNTRN(INPUT1(I1),'MAT2',MAXSIT,MAXSPC,WORK(IW))
GOTO50
43 CALL NOTTRN(INPUT1(I1),'MAT2',MAXSIT,MAXSPC)
GO TO 50
44 CALL DEVTRN(INPUT1(I1),'MAT2',MAXSIT,MAXSPC,WORK(IW))
GO TO 50
C
C DO TIM X SPC CONDITIONING FOR SPC X SPC DISSIMILARITY
C WRITTEN OUT TRANSPOSE ALSO
C
50 GO TO (51,52,53,54,60),ICONPT(4)
51 CALL PWRTRN(INPUT2(I2),IPWR(4),'MAT4',MAXSES,MAXSPC,WORK(IW))
GO TO 60
52 CALL STNTRN(INPUT2(I2),'MAT4',MAXSES,MAXSPC,WORK(IW))
GO TO 60
53 CALL NOTTRN(INPUT2(I2),'MAT4',MAXSES,MAXSPC)
GO TO 60
54 CALL DEVTRN(INPUT2(I2),'MAT4',MAXSIT,MAXSPC,WORK(IW))
GO TO 60
C
C GO ON TO THE NEXT PROGRAM
C
60 CALL RUN2
CALL EXIT
END