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

C	WESTERN MICHIGAN UNIVERSITY
C	NLINEQ.FOR (FILE NAME ON LIBRARY DECTAPE)
C	NLINEQ, 2.9.1 (CALLING NAME, SUBLST NO.)
C	SOLUTION OF NON-LINEAR ALGEBRAIC EQUATIONS
C	ADAPTED BY BERENICE GAN HOUCHARD FROM "A FORTRAN SUBROUTINE FOR
C	 SOLVING SYSTEMS OF NON-LINEAR ALGEBRAIC EQUATIONS." BY
C	 M.J.F. POWELL, ATOMIC ENERGY RESEARCH ESTABLISHMENT,
C	 HARWELL, BERKSHIRE, ENGLAND, 1968.
C	THIS PROGRAM WRITES A SUBROUTINE CONTAINING USER'S FUNCTIONS,
C	 (CALCUN.F4) AND UTILIZES THE SUBROUTINE RUNUUO TO COMPILE
C	 AND LOAD IT WITH THE REST OF THE PROGRAM AUTOMATICALLY.  AS
C	 A RESULT, THE MAIN PROGRAM IS SPLIT INTO TWO, THE FIRST ONE
C	 BEING NLINEQ.FOR AND THE SECOND ONE NLIN2.FOR.
C	LIBRARY DECTAPE PROGS. USED:  USAGE.MAC
C	FORWMU PROGS. USED:  TTYPTY, RUNUUO
C	ABOVE COMMENTS AND RIGHT ADJUSTED COMMENTS PUT IN BY WG
C
C
C	LIMITATIONS:
C
C	(1)  NUMBER OF EQUATIONS IS BETWEEN 2 AND 50 INCLUSIVE
C
C	(2)  A MAXIMUM OF 80 COLUMNS ALLOTED TO EACH FUNCTION
C
C	(3)  A MAXIMUM OF 99,999 CALCULATIONS POSSIBLE PER SOLUTION
C**********************************************************************
C***********************************************************************
C---------------FUNCTIONS ARE READ ONE AT A TIME INTO THESE LOCATIONS
	DIMENSION F1(80)
C	CALL USAGE('NLINEQ')
C
C***********************************************************************
C	DEVICES USED:
C
C	IDLG---DEVICE USED TO COMMUNICATE WITH USERS
C	       IT IS ALWAYS SET TO -4
C	ICC----DEVICE USED TO ACCEPT USER'S RESPONSES
C	       IT IS ALWAYS SET TO -1
C	IOUT---DEVICE USED TO WRITE OUT THE REPORT
C	       IT IS ALWAYS SET TO 30
C	IDSK---DEVICE USED TO WRITE THE TEMPORARY SUBROUTINE
C	       IT IS ALWAYS SET TO 1
C	ITEMP--DEVICE USED TO WRITE A TEMPORARY FILE TO BE READ IN
C	       BY NLIN2.F4
C	       IT IS ALWAYS SET TO 20
C***********************************************************************
C
	IDLG=-4
	ICC=-1
	IOUT=30
	IDSK=1
	ITEMP=20
C
C***********************************************************************
C	DETERMINE IF JOB IS FROM TELETYPE OR PSEUDO-TELETYPE
C	IF ICODE  = -1  JOB IS FROM PSEUDO-TELETYPE
C	          = 0   JOB IS FROM TELETYPE
C***********************************************************************
C
C---------------ICODE RETURNED
	CALL TTYPTY(ICODE)
C
C***********************************************************************
C	NUMBER OF EQUATIONS
C***********************************************************************
C
1	WRITE(IDLG,10)
10	FORMAT(/' NUMBER OF EQUATIONS: ',$)
	READ(ICC,11) N
11	FORMAT(I)
	IF ((N.GT.1).AND.(N.LE.50)) GO TO 20
	WRITE(IDLG,12)
12	FORMAT(' NUMBER OF EQUATIONS OUTSIDE ALLOWABLE RANGE,TRY
     1 AGAIN'/)
	IF (ICODE.GE.0) GO TO 1
13	CALL EXIT
C
C***********************************************************************
C	WRITE THE TEMPORARY FILE TO BE USED BY NLIN2.F4
C***********************************************************************
C
20	WRITE(ITEMP) IDLG,ICC,IOUT,IDSK,N
C
C***********************************************************************
C	WRITE THE SUBROUTINE CONTAINING USER'S FUNCTIONS
C***********************************************************************
C
	OPEN(UNIT=1,ACCESS='SEQOUT',MODE='ASCII',FILE='CALFUN.F4')
	WRITE(IDSK,21)
21	FORMAT(6X,'SUBROUTINE CALFUN (N,X,F)'/6X,'DIMENSION X(1),
     1 F(1)')
	WRITE(IDLG,22)
22	FORMAT(/' ENTER FUNCTIONS'/)
	DO 23 I=1,N
230	READ(ICC,24) F1
24	FORMAT(80A1)
	DO 250 J=80,1,-1
	IF (F1(J).NE.' ') GO TO 252
250	CONTINUE
	WRITE(IOUT,251)
251	FORMAT(' ERROR IN USER''S FUNCTION,ONE BLANK LINE. TRY AGAIN'/)
	IF (ICODE) 13,230,230
252	JJ=J
	IF (J.GT.61) JJ=61
	WRITE(IDSK,253) I,(F1(K),K=1,JJ)
253	FORMAT(6X,'F(',I1,')=',61A1)
	IF (JJ.LT.J) WRITE(IDSK,254)(F1(K),K=JJ+1,J)
254	FORMAT(5X,'1 ',19A1)
23	CONTINUE
	WRITE(IDSK,26)
26	FORMAT(6X,'RETURN'/6X,'END')
	ENDFILE IDSK
	CLOSE(UNIT=IDSK)
	ENDFILE ITEMP
	CALL RELEAS (ITEMP)
C---------------/FOROTS IS NO LONGER NECESSARY.  AT THIS
C---------------N.LIN2.FOR IS MAIN PROG.
	CALL RUNUUO('EX/FOROTS/F10 REL:NLIN2,DSK:CALFUN.F4,
     1  SYS:FORLIB/LIB')
	END