Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-01 - decus/20-0009/nvfunc.for
There is 1 other file named nvfunc.for in the archive. Click here to see a list.
      SUBROUTINE GENFUN (L,KC)
CGENFUN       SUBROUTINE TO CALL ALLL FUNCTION SUBROUTINES                  0020
C     L IS STARTING REGISTER IN KLIST AND CONYAINS FUNCTION NUMBER          0030
C     KCM = 0 FOR LABORATORY SYSTEM, = 1 FOR PARTICLE COM, = 2 FOR P + T    0040
C     KCM NEGATIVE MEANS FUNCTION RETURNS BCD NAME IN VAL(1) AND VAL(2)     0050
C      ******************    COMMON COMMON   ***************************    0060
      COMMON    MAP(2000),PARS(1000),MISC(27),KLIST(500),MTABLE(2)
      DIMENSION VAL(100),IVAL(100)
      DIMENSION    NTABLE(100), HEAD(11), NBRNCH(10)                        0090
      EQUIVALENCE (NCFLAG,MAP(1869))                                        0270
      EQUIVALENCE (NTABLE,PARS(101)),(VAL,IVAL,MAP(1531))
      EQUIVALENCE  (PI, MISC), (RADIAN, MISC(2)), (NIT, MISC(3)),
     1             (NOT, MISC(4)), (HEAD, MISC(5)), (NBRNCH, MISC(16)),
     2             (NPAGE, MISC(26)), (NORD, MISC(27))
C      ***************    END  COMMON  COMMON  *************************    0260
      KCM=KC                                                                0300
      MAXFN = 99                                                            0310
      NCFLAG=0                                                              0320
      VAL(1) = 0                                                            0330
      LL=KLIST(L)-9                                                         0340
      IF (LL) 500,500,5                                                     0350
    5 IF (KLIST(L)-MAXFN) 7,7,500                                           0360
    7 K=L+1                                                                 0370
      CALL FUNCS (LL,K,KCM)                                                 0380
  500 RETURN                                                                0390
      END                                                                   0400
      SUBROUTINE FUNCS(LL, K, KCM)
C     THIS FORTRAN VERSION ONLY CALLS FUNCS 10-19
      IF (LL-10) 5, 5, 100
5     GO TO (10, 11, 12, 13, 14, 15, 16, 17, 18, 19), LL
10    CALL FUNC10(K, KCM)
      GO TO 200
11    CALL FUNC11(K, KCM)
      GO TO 200
12    CALL FUNC12(K, KCM)
      GO TO 200
13    CALL FUNC13(K, KCM)
      GO TO 200
14    CALL FUNC14(K, KCM)
      GO TO 200
15    CALL FUNC15(K, KCM)
      GO TO 200
16    CALL FUNC16(K, KCM)
      GO TO 200
17    CALL FUNC17(K, KCM)
      GO TO 200
18    CALL FUNC18(K, KCM)
      GO TO 200
19    CALL FUNC19(K, KCM)
      GO TO 200
100   CALL DUMFUN(K, KCM)
200   RETURN
      END
	SUBROUTINE FUNC10 (K,KCM)
C	DUMMY FUNCTION
	CALL DUMFUN(K,KCM)
	RETURN
	END
	SUBROUTINE FUNC11 (K,KCM)
C	DUMMY FUNCTION
	CALL DUMFUN(K,KCM)
	RETURN
	END
	SUBROUTINE FUNC12 (K,KCM)
C	DUMMY FUNCTION
	CALL DUMFUN(K,KCM)
	RETURN
	END
	SUBROUTINE FUNC13 (K,KCM)
C	DUMMY FUNCTION
	CALL DUMFUN(K,KCM)
	RETURN
	END
	SUBROUTINE FUNC14 (K,KCM)
C	DUMMY FUNCTION
	CALL DUMFUN(K,KCM)
	RETURN
	END
	SUBROUTINE FUNC15 (K,KCM)
C	DUMMY FUNCTION
	CALL DUMFUN(K,KCM)
	RETURN
	END
	SUBROUTINE FUNC16 (K,KCM)
C	DUMMY FUNCTION
	CALL DUMFUN(K,KCM)
	RETURN
	END
	SUBROUTINE FUNC17 (K,KCM)
C	DUMMY FUNCTION
	CALL DUMFUN(K,KCM)
	RETURN
	END
	SUBROUTINE FUNC18 (K,KCM)
C	DUMMY FUNCTION
	CALL DUMFUN(K,KCM)
	RETURN
	END
	SUBROUTINE FUNC19 (K,KCM)
C	DUMMY FUNCTION
	CALL DUMFUN(K,KCM)
	RETURN
	END
      SUBROUTINE DUMFUN (KQ,KCM)
      COMMON MAP
      DIMENSION MAP(2000), VAL(2), HNAME(3)
      EQUIVALENCE (NCFLAG,MAP(1869)), (VAL,MAP(1531))
      DATA HNAME /'NOT IN DECK'/
      IF(KCM) 5,10,10
    5 DO 6 I=1,3
    6 VAL(I) = HNAME(I)
      GO TO 15
   10 VAL(1) = 0.
      NCFLAG = -1
   15 RETURN
      END