Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	DIMENSION TPT(1),SITPT(1),SPPT1(1),SPPT2(1)
	DIMENSION SITSPC(1),IF2(8),TIMSPC(1),ROW(1)
C
C	MAIN PROGRAM TO SET UP CORE FOR RESORTED MATRIX LISTING PROGRAM
C
	COMMON KI,KO,INDSK,IODSK
C
C	INITIALISE AND GET MAXIMUM DIMENSIONS TO BE WORKED WITH
C
	CALL INIT
	CALL IFILE(INDSK,'AVGE')
	READ(INDSK)MST,MSS,MSP
	CALL RELEAS(INDSK)
C
	J=MAX0(MST,MSS)
	J=MAX0(J,MSP)
C
C	NOW GET THE CORE
C
	CALL MORCOR(TPT,IT,MSS)
	CALL MORCOR(SITPT,IS,MST)
	CALL MORCOR(SPPT1,I1,MSP)
	CALL MORCOR(SPPT2,I2,MSP)
	CALL MORCOR(SITSPC,ISS,MST*MSP)
	CALL MORCOR(TIMSPC,ITS,MSS*MSP)
	CALL MORCOR(ROW,IR,J)
C
C	AND GO AND DO THE RESORTING
C
	CALL RESWKS(TPT(IT),SITPT(IS),SPPT1(I1),SPPT2(I2),
	1	SITSPC(ISS),TIMSPC(ITS),ROW(IR),MST,MSS)
C
	CALL RUN6
	END
	SUBROUTINE RESWKS(TPT,SITPT,SPPT1,SPPT2,SITSPC,TIMSPC,
	1		ROW,MSIT,MSES)
	INTEGER TPT(1),RED1,RED2,SITPT(1),SPPT1(1),SPPT2(1)
	DIMENSION SITSPC(MSIT,1),IF2(8),TIMSPC(MSES,1),ROW(1)
C
C	PROGRAM TO RESORT THE TWO 'AVGE' MATRICES - ACCORDING TO THE
C	POINTERS FOUND IN RESVC.
C
	DIMENSION OT1(16),ST(13),OT2(16)
	DIMENSION IF1(20),IDEN(4),ITT(2)
	COMMON KI,KO,INDSK,IODSK
C
	DATA OT1/'RESORTED ENT1/ATTR MATRIX AVGED IN ENT2',
	18*'     '/
	DATA OT2/'RESORTED ENT2/ATTR MATRIX AVGED IN ENT1',
	18*'     '/
C
C	INITIALISE AND START FILES FOR MATRIX INPUT
C
	CALL INIT
	CALL IFILE(INDSK,'AVGE')
	CALL IFILE(IODSK,'RESVC')
C
C	GET INITIAL PARAMETERS OPTIONS AND CHECK FOR VALID PREREQUISITES
C
	READ(INDSK) MAXSIT,MAXSES,MAXSPC,ST
	READ(INDSK)IF1,IDEN,ITT,IF2,RED1,RED2
	IF(ITT(1).EQ.4.AND.ITT(2).EQ.4)GO TO 70
	BOTH1 = (IDEN(1) .GT. 0) .AND. (IDEN(2) .GT. 0)
	BOTH2 = (IDEN(3) .GT. 0) .AND. (IDEN(4) .GT. 0)
	IF(.NOT.(BOTH1 .OR. BOTH2)) GO TO 70
C
C	READ THE MATRICES TO BE RESORTED
C
	DO 5 J=1,MAXSPC
5	READ(INDSK)(SITSPC(I,J),I=1,MAXSIT)
	DO 10 J=1,MAXSPC
10	READ(INDSK)(TIMSPC(I,J),I=1,MAXSES)
	CALL RELEAS(INDSK)
C
C	GET THE VECTORS FOR ROWS AND COLS IF CONDITIONS MET
C
	IF( (IDEN(1) .GT. 0) .AND.MAXSIT.NE.1)CALL GETVEC(SITPT,MAXSIT)
	IF( (IDEN(2) .GT. 0) .AND.MAXSPC.NE.1)CALL GETVEC(SPPT1,MAXSPC)
	IF( (IDEN(3) .GT. 0) .AND.MAXSES.NE.1)CALL GETVEC(TPT,MAXSES)
	IF( (IDEN(4) .GT. 0) .AND.MAXSPC.NE.1)CALL GETVEC(SPPT2,MAXSPC)
	IF(MAXSPC.EQ.1)SPPT1(1)=1
	IF(MAXSPC.EQ.1)SPPT2(1)=1
	IF(MAXSES.EQ.1)TPT(1)=1
	IF(MAXSIT.EQ.1)SITPT(1)=1
15	CALL RELEAS(IODSK)
C
	CALL OFILE(IODSK,'RSAV')
C
C  RESORT SITE/SPEC MATRIX
C
	IF(ITT(1).EQ.4)GO TO 42
	IF(.NOT. BOTH1) GO TO 42
	DO 40 K=1,MAXSPC
	L=SPPT1(K)
	DO 30 I=1,MAXSIT
	J=SITPT(I)
30	ROW(I)=SITSPC(J,L)
40	CALL WDSKA(ROW,MAXSIT)
C
C  RESORT TIME/SPEC MATRIX
C
42	IF(ITT(2).EQ.4)GO TO 65
	IF(.NOT. BOTH2) GO TO 65
	DO 60 K=1,MAXSPC
	L=SPPT2(K)
	DO 50 I=1,MAXSES
	J=TPT(I)
50	ROW(I)=TIMSPC(J,L)
60	CALL WDSKA(ROW,MAXSES)
65	CALL RELEAS(IODSK)
C
	CALL IFILE(INDSK,'RSAV')
C
C	READ THEM BACK  IN RESORTED ORDER
C
	IF(ITT(1).LT.4.AND.BOTH1)CALL GETARR(SITSPC,MAXSIT
	1, MAXSPC)
	IF(ITT(2).LT.4.AND.BOTH2)CALL GETARR(TIMSPC,MAXSES
	1, MAXSPC)
C
C	CALL THE 'VARIABLE(POINTER)' ROUTINE FOR MATRIX PRINTING
C	TO PRINT THE MATRICES OUT
C
	IF(BOTH1.AND.(ITT(1).EQ.1.OR.ITT(1).EQ.3))
	1CALL MATWV(SITSPC,MAXSPC,MAXSIT,'ATTR','ENT1',OT1,ST,
	1SITPT,SPPT1)
	IF(MAXSES.NE.1.AND.BOTH2.AND.(ITT(2).EQ.1
	1 .OR.ITT(2).EQ.3)    )
	1CALL MATWV(TIMSPC,MAXSPC,MAXSES,'ATTR','ENT2',OT2,ST,
	1TPT,SPPT2)
C
C	IF DETRANSFORMING IS REQUIRED DO IT
C
	IF(ITT(1).NE.2.AND.ITT(1).NE.3) GO TO 66
	IF(.NOT.BOTH1 )GO TO 66
	CALL DELOG(SITSPC,MAXSPC,MAXSIT)
	CALL MATWV(SITSPC,MAXSPC,MAXSIT,'ATTR','ENT1',OT1,ST,
	1	SITPT,SPPT1)
C
66	IF(ITT(2).NE.2.AND.ITT(2).NE.3)GO TO 70
	IF(.NOT.BOTH2)GO TO 70
	CALL DELOG(TIMSPC,MAXSPC,MAXSES)
	CALL MATWV(TIMSPC,MAXSPC,MAXSES,'ATTR','ENT2',OT2,ST,
	1	TPT,SPPT2)
C
C
C	END THE PROCEDURE
C
	CALL RELEAS(INDSK)
70	RETURN
	END