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
          EXTERNAL F, C05ADF

    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
            CALL C05ADF (X1,X2,TOL,ETA,F,X3,IFAIL)
            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
Advertisements

Leave a Comment »

No comments yet.

RSS feed for comments on this post. TrackBack URI

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Blog at WordPress.com.

%d bloggers like this: