File: SUBST.FT of Tape: Various/ETH/eth11-2
(Source file text) 

C
C     ..................................................................
C
C        SUBROUTINE SUBST
C
C        PURPOSE
C           DERIVE A SUBSET VECTOR INDICATING WHICH OBSERVATIONS IN A
C           SET HAVE SATISFIED CERTAIN CONDITIONS ON THE VARIABLES.
C
C        USAGE
C           CALL SUBST (A,C,R,B,S,NO,NV,NC)
C           PARAMETER B MUST BE DEFINED BY AN EXTERNAL STATEMENT IN THE
C           CALLING PROGRAM
C
C        DESCRIPTION OF PARAMETERS
C           A  - OBSERVATION MATRIX, NO BY NV
C           C  - INPUT MATRIX, 3 BY NC, OF CONDITIONS TO BE CONSIDERED.
C                THE FIRST ELEMENT OF EACH COLUMN OF C REPRESENTS THE
C                NUMBER OF THE VARIABLE (COLUMN OF THE MATRIX A) TO BE
C                TESTED, THE SECOND ELEMENT OF EACH COLUMN IS A
C                RELATIONAL CODE AS FOLLOWS
C                     1. FOR LT (LESS THAN)
C                     2. FOR LE (LESS THAN OR EQUAL TO)
C                     3. FOR EQ (EQUAL TO)
C                     4. FOR NE (NOT EQUAL TO)
C                     5. FOR GE (GREATER THAN OR EQUAL TO)
C                     6. FOR GT (GREATER THAN)
C                THE THIRD ELEMENT OF EACH COLUMN IS A QUANTITY TO BE
C                USED FOR COMPARISON WITH THE OBSERVATION VALUES. FOR
C                EXAMPLE, THE FOLLOWING COLUMN IN C
C                          2.
C                          5.
C                         92.5
C                CAUSES THE SECOND VARIABLE TO BE TESTED FOR GREATER
C                THAN OR EQUAL TO 92.5
C           R  - WORKING VECTOR USED TO STORE INTERMEDIATE RESULTS OF
C                ABOVE TESTS ON A SINGLE OBSERVATION. IF CONDITION IS
C                SATISFIED, R(I) IS SET TO 1. IF IT IS NOT, R(I) IS SET
C                TO 0. VECTOR LENGTH IS NC.
C           B  - NAME OF SUBROUTINE TO BE SUPPLIED BY THE USER. IT
C                CONSISTS OF A BOOLEAN EXPRESSION LINKING THE
C                INTERMEDIATE VALUES STORED IN VECTOR R. THE BOOLEAN
C                OPERATORS ARE '*' FOR'AND', '+' FOR 'OR'. EXAMPLE
C                     SUBROUTINE BOOL(R,T)
C                     DIMENSION R(3)
C                     T=R(1)*(R(2)+R(3))
C                     RETURN
C                     END
C                THE ABOVE EXPRESSION IS TESTED FOR
C                     R(1).AND.(R(2).OR.R(3))
C           S  - OUTPUT VECTOR INDICATING, FOR EACH OBSERVATION,
C                WHETHER OR NOT PROPOSITION B IS SATISFIED. IF IT IS,
C                S(I) IS NON-ZERO. IF IT IS NOT, S(I) IS ZERO. VECTOR
C                LENGTH IS NO.
C           NO - NUMBER OF OBSERVATIONS. NO MUST BE > OR = TO 1.
C           NV - NUMBER OF VARIABLES. NV MUST BE > OR = TO 1.
C           NC - NUMBER OF BASIC CONDITIONS TO BE SATISFIED. NC MUST BE
C                GREATER THAN OR EQUAL TO 1.
C
C        REMARKS
C           NONE
C
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
C           B  THE NAME OF ACTUAL SUBROUTINE SUPPLIED BY THE USER MAY
C              BE DIFFERENT (E.G., BOOL), BUT SUBROUTINE SUBST ALWAYS
C              CALLS IT AS B.  IN ORDER FOR SUBROUTINE SUBST TO DO THIS,
C              THE NAME OF THE USER-SUPPLIED SUBROUTINE MUST BE
C              DEFINED BY AN EXTERNAL STATEMENT IN THE CALLING PROGRAM.
C              THE NAME MUST ALSO BE LISTED IN THE ''CALL SUBST''
C              STATEMENT.  (SEE USAGE ABOVE)
C
C        METHOD
C           THE FOLLOWING IS DONE FOR EACH OBSERVATION.
C           CONDITION MATRIX IS ANALYZED TO DETERMINE WHICH VARIABLES
C           ARE TO BE EXAMINED. INTERMEDIATE VECTOR R IS FORMED. THE
C           BOOLEAN EXPRESSION (IN SUBROUTINE B) IS THEN EVALUATED TO
C           DERIVE THE ELEMENT IN SUBSET VECTOR S CORRESPONDING TO THE
C           OBSERVATION.
C
C     ..................................................................
C
      SUBROUTINE SUBST(A,C,R,B,S,NO,NV,NC)
      DIMENSION A(1),C(1),R(1),S(1)
C
      DO 9 I=1,NO
      IQ=I-NO
      K=-2
      DO 8 J=1,NC
C
C        CLEAR R VECTOR
C
      R(J)=0.0
C
C         LOCATE ELEMENT IN OBSERVATION MATRIX AND RELATIONAL CODE
C
      K=K+3
      IZ=C(K)
      IA=IQ+IZ*NO
      IGO=C(K+1)
C
C         FORM R VECTOR
C
      Q=A(IA)-C(K+2)
      GO TO(1,2,3,4,5,6),IGO
    1 IF(Q) 7,8,8
    2 IF(Q) 7,7,8
    3 IF(Q) 8,7,8
    4 IF(Q) 7,8,7
    5 IF(Q) 8,7,7
    6 IF(Q) 8,8,7
    7 R(J)=1.0
    8 CONTINUE
C
C        CALCULATE S VECTOR
C
    9 CALL B(R,S(I))
      RETURN
      END