Google
 

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