# Rcjp's Weblog

## February 15, 1991

### BSc Fortran Numerics Course

Filed under: physics — rcjp @ 10:58 am

This a retro blog entry for the first ever fortran programming courses at Salford (taught by Dr Keeler iirc). I’ve had a FORTRAN directory kicking around on my machine for years containing all my old files so I thought I’d clean things up and create a blog entry for posterity.

How do I know the date so accurately?… well some of the files were log files generated from the compiles like…

``````
Prospero Fortran Compiler  -  iid 2.1     Date: 1991 February 15  16:41:17.28

Compilation of: A:\BESSEL\DRUMDRW.FOR

Options:    A1 B0 C0 E3 G1 H0 I1 L0 M0 N3 O1 Q0 R0 S1 T0 U1 V1 Y1

5  ===    5  ===    0 INCLUDE C:\PUBLIC\PROFOR\INCLUDE\F77PC.FOR
``````

Ah yes, Prospero fortran, and we wrote our code on 3 1/2 inch floppies which we had to carry around with us. I think we used Prospero, even though the Salford
compiler FTN77 was available because the graphics were much easier to produce as they were built in. I remember it being a shock when I went over to FTN77 which found lots of bugs in my code that Prospero had allowed, guess that is why I went to work for Salford all those years later.

We used Fortran as just a calculator really e.g.

``````
CCCC  ******************************************************************
CCCC  **    PRINTS THE VALUE OF THE BESSEL FUNCTION FOR X=0-20        **
CCCC  **           AND ALLOWS BOUNDARIES FOR SOLUTION                 **
CCCC  **                BY BISECTION TO BE FOUND                      **
CCCC  ******************************************************************

REAL X,Y,TOL,BESS
PRINT99,'X','Y'
DO 10 X=0,20
Y=BESS(X,1.0E-5)
CALL DISP (X,Y)
10 CONTINUE
99 FORMAT (2(10X,A))
END

REAL FUNCTION BESS(X,TOL)
REAL X,TOL,OLD,TERM,J
INTEGER N
TERM=1
J=1
N=0
DO WHILE (ABS(TERM-OLD).GE.TOL)
OLD=TERM
N=N+1
TERM=-(OLD*X*X)/(4.0*N*N)
J=J+TERM
END DO
120 BESS=J
END

SUBROUTINE DISP(X,Y)
REAL X,Y
INTEGER XN,YN,OLDX,OLDY
IF (X.EQ.0) THEN
OLDX=20
OLDY=175
ENDIF
XN=INT(X*30+20)
YN=INT(175-Y*170)
PRINT*,X,Y
OLDX=XN
OLDY=YN
END
``````

or solving simple equations that we’d use some symbolic maths package these days to solve…

``````
CCCC  ******************************************************************
CCCC  **       CALCULATES THE CURRENT IN A DIODE OR P-N JUNCTION      **
CCCC  **              FOR A SERIES OF VALUES OF Vo                    **
CCCC  **   SOLUTION IS FOUND BY SOLVING THE TRANSCENDENTAL EQUATION   **
CCCC  **      Vo=iR+(kT/e)ln(i/i(s)+1)                                **
CCCC  **             where i(s)=reverse bias saturation current       **
CCCC  **                   Vo  =supply voltage                        **
CCCC  ******************************************************************
DOUBLE PRECISION F

CCCC  Initialise Variables

DOUBLE PRECISION C,V,R,K,T,E,IS,TOL,X1,X2,X3,X4,ETA
INTEGER MNIT,J,IFAIL

C      BLOCK DATA
C      COMMON /PARAM/V,R,C,IS
C      DATA R,K,T,E,IS,MNIT,TOL,ETA/1000,1.38E-23,300,1.6E-19,1.8E-15
C     1  ,50,1D-4,0.0/
C      END
COMMON /PARAM/V,R,C,IS

R=1000
K=1.38D-23
T=300
E=1.6D-19
IS=1.8D-15
MNIT=50
TOL=1D-4
ETA=0.0
IFAIL=0

CCCC  Print table

PRINT100,'VOLTAGE','CURRENT NAG ','CURRENT OWN'
DO 10 V=1,10
C=K*T/E
X1=0
X2=V/R
CALL SOLV(MNIT,X1,X2,J,X4,TOL)
C=K*T/E
X1=0
X2=V/R
IF (IFAIL.NE.0) STOP
PRINT101,V,X3,X4
10 CONTINUE
100 FORMAT (3X,A,8X,A,5X,A,/)
101 FORMAT (3X,F5.2,7X,D12.5,9X,D12.5)
END

CCCC  Solution of transcendental equations
CCCC        by bisection method

SUBROUTINE SOLV(MNIT,X1,X2,J,X3,TOL)
DOUBLE PRECISION V,R,C,IS,X1,X2,X3,OLD,TOL
INTEGER J,MNIT
COMMON /PARAM/V,R,C,IS
DO 200 J=1,MNIT
X3=0.5*(X1+X2)
IF (F(X1)*F(X3).LT.0.0) THEN
X2=X3
ELSE
X1=X3
ENDIF
IF (J.NE.0) THEN
PRINT *,'OLD-F3 ',ABS(F(OLD)-F(X3))
C        PRINT *,TOL
C        PRINT *,'F3 ',F(X3)
IF (ABS(F(OLD)-F(X3)).LE.TOL) RETURN
ENDIF
OLD=X3
200 CONTINUE
END

CCCC  FUNCTION

DOUBLE PRECISION FUNCTION F(X)
DOUBLE PRECISION X,V,R,C,IS
COMMON /PARAM/V,R,C,IS
F=X*R+C*LOG(X/IS+1.0)-V
END
``````

ahh, uppercase programming, seems so retro these days. I can vaguely remember seeing the oscillations of a drumskin on the screen and I guess the following is the program that did it – though it used prospero’s own graphics routines so I can’t really check

``````
CCCC  ******************************************************************
CCCC  **   DISPLAYS THE VIBRATIONS ON A DRUMSKIN AFTER BEING STRUCK   **
CCCC  ******************************************************************

INCLUDE 'F77PC'
REAL R,URT,A,K,T
INTEGER N
DIMENSION A(7),K(7)
PARAMETER (PI=3.14159)
DATA (A(I),I=1,6),(K(I),I=1,6)/0.5267,0.7074,0.7925,0.8433,
1  0.8642,0.8746,2.404,5.52,8.65,11.79,14.92,18.16/
CALL INISCR

DO 20 T=0,PI,0.1
DO 15 R=0,1.05,0.05
DO 10 N=1,7
URT=URT+A(N)*BESS(K(N)*R,1E-5)*COS(K(N)*T)
10     CONTINUE
C       PRINT*,R,URT
CALL DISP(R,URT)
URT=0
15   CONTINUE
20 CONTINUE
END

REAL FUNCTION BESS(X,TOL)
REAL X,TOL,OLD,TERM,J
INTEGER N
TERM=1
J=1
N=0
IF (X.EQ.0.0) THEN
J=1
GOTO 120
ENDIF
DO WHILE (ABS(TERM-OLD).GE.TOL)
OLD=TERM
N=N+1
TERM=-(OLD*X*X)/(4.0*N*N)
J=J+TERM
END DO
120   BESS=J
END

SUBROUTINE INISCR
CALL INITSCREEN
CALL SETSCREENMODE(16)
CALL CLRVIDEO
END
``````