ChemEngNumMeth/EX211.FOR at master · navoj/ChemEngNumMeth · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
C
C*****************************	ABSTRACT  *******************************
C
C     THIS PROGRAM APPLIES NEWTON'S METHOD FOR THE SOLUTION OF A
C  SINGLE NONLINEAR EQUATION.
C
C****************************  NOMENCLATURE  ****************************
C
C  ERLIM- CONVERGENCE CRITERIA
C  ICMAX- THE MAXIMUM NUMBER OF ITERATIONS ALLOWED
C  IPRINT- PRINT FLAG =1 PRINT INTERMEDIATE VALUES; =0 NO PRINT
C  X-  THE INITIAL GUESS FOR THE ROOT (INPUT); THE SOLUTION VALUE OF
C      X (OUTPUT)
C
C************************************************************************
C
C  SPECIFY EXTERNAL STATEMENT
      IMPLICIT REAL*8(A-H,O-Z)
      EXTERNAL F,FP
C  SPECIFY PARAMETERS
      ERLIM=1.E-6
      ICMAX=100
      IPRINT=1
C  SPECIFY STARTING POINT
      X=.3927
C
C  CALL NEWT1D
C
      CALL NEWT1D(F,FP,ERLIM,ICMAX,IPRINT,X)
C
C  END
C
      STOP
      END
C
C*****************************  ABSTRACT  *******************************
C
C     THIS SUBROUTINE APPLIES NEWTON'S METHOD FOR THE SOLUTION OF A
C  SINGLE NONLINEAR EQUATION.
C
C****************************  NOMENCLATURE  ****************************
C
C  DF- THE DERIVATIVE OF F(X) WITH RESPECT TO X
C  ERLIM- CONVERGENCE CRITERIA
C  FV- THE FUNCTION VALUE
C  IC- THE ITERATION COUNTER
C  ICMAX- THE MAXIMUM NUMBER OF ITERATIONS ALLOWED
C  IPRINT- PRINT FLAG =1 PRINT INTERMEDIATE VALUES; =0 NO PRINT
C  X-  THE INITIAL GUESS FOR THE ROOT (INPUT); THE SOLUTION VALUE OF
C      X (OUTPUT)
C  XS- VARIABLE USED TO SAVE THE OLD VALUE OF X
C
C************************************************************************
C
      SUBROUTINE NEWT1D(F,FP,ERLIM,ICMAX,IPRINT,X)
      IMPLICIT REAL*8(A-H,O-Z)
      EXTERNAL F,FP
      IC=0
C
C  BEGIN ITERATIVE LOOP
C
   10 IC=IC+1
C  SAVE CURRENT VALUE OF X
      XS=X
C  CALL SUBRUTINE F
      CALL F(X,FV)
C  CALL SUBRUTINE FP
      CALL FP(X,DF)
C  EVALUATE FUNCTION VALUE
      X=X-FV/DF
C  CALCULATE CHANGE IN X
      DX=X-XS
C  PRINT OUT INTERMEDIATE RESULTS
      IF(IPRINT.EQ.1)WRITE(6,11)IC,X,FV
   11 FORMAT( 5X,' IC=',I3,5X,' X=',D10.3,5X,' F(X)=',D10.3)
C  CHECK FOR EXCESSIVE ITERATIONS
      IF(IC.GT.ICMAX)WRITE(6,22)
   22 FORMAT( ' NEWTONS METHOD DID NOT CONVERGE')
      IF(IC.GT.ICMAX)STOP
C  CHECK FOR CONVERGENCE
      IF(DABS(DX).GT.ERLIM)GO TO 10
      CALL F(X1,F1)
C
C  CONVERGED SOLUTION OBTAINED; RETURNING TO CALLING PROGRAM
C
      RETURN
      END
C
C*****************************  ABSTRACT  *******************************
C
C     THIS SUBROUTINE CALCULATES THE CALCULATES THE VALUE OF F(X)
C  GIVEN THE VALUE OF X.
C
C************************************************************************
C
      SUBROUTINE F(X,FV)
      IMPLICIT REAL*8(A-H,O-Z)
      FV=X*DTAN(X)-1.
      RETURN
      END
C
C*****************************  ABSTRACT  *******************************
C
C     THIS SUBROUTINE CALCULATES THE CALCULATES THE VALUE OF DF(X)/DX
C  GIVEN THE VALUE OF X.
C
C************************************************************************
C
      SUBROUTINE FP(X,DF)
      IMPLICIT REAL*8(A-H,O-Z)
      DF=X/(DCOS(X))**2+DTAN(X)
      RETURN
      END