!     These modules are needed by the program ref90.f.  The files one.f
!     and two.f in this directory contain the modules.  They must be 
!     compiled separately using the command   xlf90 -c module_name.f  
!     and the object files, one.o and two.o, linked when ref90.f is 
!     compiled.  See Usage, below.

      Module one        ! This module is used to share global data with
                        ! a subroutine.  RS/6K users see note below.
      Implicit None
      Real :: Alpha = 3.0, Beta = 3.0, Gamma = 2.0, Delta
      End Module one

      Module two        ! This module is used to share global data with
                        ! a subroutine.  RS/6K users see note below.
      Implicit None
      Real :: Epsilon=4.0, Zeta=3.0, Eta=2.0, Theta=1.0
      End Module Two

      Program ref90a

!     A pastiche of FORTRAN 90 structures in one long program.  It
!       was adapted from the Watfor 77 program FORTREF.FOR.  Certain
!       constructs, e.g., overloading, are not yet included and what
!       is included here must be considered somewhat preliminary.

!     Everything included here compiles and runs under Salford/NAG
!       FTN90 Compiler Version 2.1 - in BOTH fixed and free format.
!       (You use the .for extension for fixed and the .f for free.)
!       This program works with the xlf90 compiler on the RS/6000;
!       then the extension is .f
!       It was also modified in late 1997, early 1998 to work 
!       using the Lahey ELF90 compiler - which is NOT backwardly
!       compatible with Fortran 77.  Numerous, but small changes
!       were required at that time.

!     Ampersands have been positioned in column 73 to indicate 
!       continuation. These aren't read in NAG Fortran 90 with 
!       fixed format, but are necessary when this program is run on 
!       the RS/6000 under xlf90.

!***********************************************************************
!     R.J.Ribando, 310 MEC, Univ. of Virginia, December 1994.
!     Copyright (c) 1994, 1997 All rights reserved.

!     This program may be distributed freely for instructional purposes
!       only providing:  (1.) The file be distributed in its entirety
!       including disclaimer and copyright notices. (2.) No part of it
!       may be incorporated into any commercial product.

!**********************************************************************
!     DISCLAIMER
!       The author shall not be responsible for losses of any kind
!       resulting from the use of the program or of any documentation
!       and can in no way provide compensation for any losses sustained
!       including but not limited to any obligation, liability, right,
!       or remedy for tort nor any business expense, machine downtime
!       or damages caused to the user by any deficiency, defect or
!       error in the program or in any such documentation or any
!       malfunction of the program or for any incidental or consequential
!       losses, damages or costs, however caused.
!***********************************************************************

!     References:
!          G. Coschi and J.B.Schueler, WATFOR-77 Language Reference Manual,
!          WATCOM Publications Limited, Waterloo, Canada (1985).

!          L. Nyhoff and S. Leestma, Introduction to FORTRAN 90 for 
!          Engineers and Scientists, Prentice-Hall (1997).

!          J.M.Ortega, An Introduction to Fortran 90 for Scientific
!          Computing, Saunders (1994).

!          W.E. Mayo and M. Cwiakala, Introduction to Computing for
!          Engineers, McGraw-Hill, NY (1991)

!          W.S. Brainerd, C.H.Goldberg, and J.C. Adams, Programmer's
!          Guide to Fortran 90, 2nd Ed., Unicomp, Albuquerque (1994)

!          J.F.Kerrigan, Migrating to Fortran 90, O'Reilly & Associates,
!          Sebastopol, CA (1993)

!          Nagware FTN90 User's Guide, Salford Software (1995).

!          Elf90 Essential Lahey Fortran, Revision B, Lahey Computer
!          Systems, 1996

!          W.H.Press, S.A.Teukolsky, W.T.Vetterling, B.P.Flannery,
!          M.Metcalf, Numerical Recipes in Fortran 90, The Art of Scientific
!          Computing, Vol. 2 of Fortran Numerical Recipes, Cambridge University
!          Press, New York (1996).
!***********************************************************************
!     Sources:

!          Numerical Algorithms Group (NAG), Inc.
!          (630) 971-2337
!          http://nag.com

!          Lahey Computer Systems, Inc.
!          865 Tahoe Blvd., P.O.,Box 6091
!          Incline Village, NV 89450-6091
!          (800) 548-4778
!          sales@lahey.com
!          http://www.lahey.com
!       
!          Digital (what used to be Microsoft Fortran)
!          http://www.digital.com/fortran/dvf-spd.html
!
!          Absoft
!          http://www.absoft.com

!***********************************************************************
!     Revisions:
!         6/ 9/94:  Added some array operations.
!        12/23/94:  Added disclaimer, internal recursive subroutine, etc.
!        12/28/94:  Added allocatable arrays, derived types, etc.
!         1/ 5/95:  Added module
!         4/26/96:  Added intent in and out
!         4/28/96:  Added cshift and eoshift and some housekeeping.
!         5/ 3/96:  Added tab descriptor, use of masks
!         5/28/96:  Added Concatenation and Trim and fixed up data structure.
!         5/29/96:  Fixing up to run on RS/6000.  Changed all * in column
!                   1 to ! and put a continuation (&) out beyond column 72.
!         6/ 5/96:  Works on RS/6000!
!         5/ 5/97:  Switching to work under ELF90.  Remove x descriptors
!                   (for skipping spaces) in all Format statements, added
!                   double colons in all declaration statements, added
!                   explicit interfaces for the external subprograms, 
!                   removed all unused variables, removed print*, removed 
!                   commons, data statements, etc.  Literally hundreds of 
!                   minor changes were required because ELF90 is not backwardly
!                   compatible with Fortran 77.
!         11/1/97:  Section on Pointers and Targets added by Mark Fisher.
!         1/14/98:  Housekeeping

!***********************************************************************
!     Usage:

!     xlf90 compiler on the IBM RS/6000:
!
!     First cut off and compile the module one.f with the command
!             xlf90 -c one.f
!       which will produce the files one.o and one.mod
!     Do same with second module.
!     Then compile this program, ref90.f with the command
!             xlf90 ref90.f one.o
!       which will produce an executable file named a.out
!
!     To run the program, type  a.out
!
!     Salford/NAG (PC) Users:

!     ftn90 ref90.f/lgo    (free format)
!     or 
!     ftn90 ref90.for/lgo  (fixed format)

!***********************************************************************

      Use One            ! Here is where the modules for sharing data are put.
      Use Two

      Implicit None
!     Declarations:
      Integer:: I, j, K=3, Caseno, Badnum, n, L=4, M=5
      Integer:: mg1, ng1
      Integer, Parameter::Imax = 10, Jmax =10
      Real :: Array(Imax, Jmax)
      Real :: Barray(3, 3), Carray(3, 3), Darray(3, 3)
      Real, Target :: Earray(2, 2), Farray(3, 3)
      Real :: Ashft(4,4), Bshft(4,4)
      Real :: Vec(10), Vect1(-4:5)
      Real :: vector1(5), vector2(5)
      Real, Dimension (:,:), Allocatable :: G1  ! The array G1 is set
                                       ! up for dynamic redimensioning
      Real :: A= .7132, B = .532, Numgrad, Magnit, Diam = 4.2, Circum,  &
     &    Area       ! Declare and initialize on same line.
      Real :: Dotprod, Top_of_the_line
      Real :: Angle, Xval = -1.0, Yval = -1.0

!     WARNING: kind = 2 may be used for double precision on some compilers.
      Real (kind = 8) :: Pidoub
      Real, Pointer :: Apoint(:,:)

      Character (len=20)  :: Name
      Character (len=50)  :: Warning
      Character (len=10)  :: Strng
      Character (len=1)   :: Ltrgrad
      Character (len=8)   :: date
      Character (len=10)  :: time
      Character (len=80)  :: Linetext
      Character (len=1)   :: Aselect
      Complex :: Z

      Logical :: Mask(Imax, Jmax)
      Logical :: Check = .true.

!     Set up a derived data type and then declare a variable of that type:
      Type :: Person
         Character (len =20)  :: Full_Name
         Character (len = 7)  :: Sex
         Integer :: Age, Weight
         Character (len = 20) :: Occupation
      End Type Person
      Type (Person) :: Flintstone(4)

!     Note:  COMMON and DATA statements are not allowed in ELF90, nor
!            are statement functions.

!     Explicit interfaces are needed for all external subprograms (in ELF90)
      Interface             
         Function Hypot(L,M)
         Implicit None
         Integer, Intent(IN) :: L, M
         Real :: Hypot
      End Function Hypot

      Subroutine Circle(Diam, Circum, Area)
         Implicit None
         Real, Intent (IN) :: Diam
         Real, Intent (OUT) :: Circum, Area
      End Subroutine Circle

      End Interface

      Write(6,*)  ! Now the executable statements
      write(6,*) 'This program (REF90.FOR) demonstrates a pastiche of '
      write(6,*) '  Fortran 90 features.  All the statements were written'
      write(6,*) '  originally in fixed (Fortran77) format, so the .FOR'
      write(6,*) '  extension was used on the filename.  As it stands'
      write(6,*) '  now, it can be run under the NAG compiler in EITHER'
      write(6,*) '  fixed (.for) or free (.f) format.  On the RS/6K'
      write(6,*) '  you would use .f as the extension.'
      write(6,*) '  It will also run under the ELF90 compiler.'
      write(6,*)

!     Assignment statements:
      Epsilon = 3.0       ! Multiple statements are allowed on one line
      Zeta    = 0.5       ! in some Fortran 90's, but not ELF90
      Eta = Alpha + Beta + Gamma                                        &
     &    + Epsilon + Zeta             ! A continued statement.
      Top_of_the_line = 17.0           ! Variables having up to 31 alphanumeric
                                       ! characters and underlines.

      Write(6,100,advance='no')           ! Non-advancing IO (this seems
  100 format(' Please input your name:')  ! to be automatic with ELF90)
      Read(5,fmt=1020) Name
      Write(6,fmt=1030) Name
      Write(6,*) 'Top of the line = ',Top_of_the_line

!************************************************
!     Repetition                                *
!************************************************

!     Simple Do loop (Line numbered loops not allowed in Elf90):
      write(6,*) 'Next is output from simple DO LOOP:'
      read(5,*)    ! These read(5,*) are to stop the program.
                   ! The "pause" statement is considered obsolescent.
      Do J = 1,10
!        Use an intrinsic (library) function (Sin) and
!        a user-defined function (Square):
         Vec(J) =  Sin(Real(J)) + Square(J)
         Vect1(J-5) = Real(J)
!        Use list-directed output:
         Write(6,*) Vec(J),Vect1(J-5)
      End Do
      Write(6,*)

!     Nested Do loop (without line numbers, but with names):
      write(6,*) 'Next is output from Nested DO LOOP:'
      read(5,*)
      Fred : Do J = Jmax,1,-2               ! Note named loops
         Barney : Do I = 1,Imax,2
            array(I,J) = Hypot(I,J)
            Write(6,fmt=1000) I,J,array(I,J)
         end do  Barney
         Write(6,fmt=1010) (array(I,J), I = 1,Imax,2)    ! Note implied Do Loop
      end do  Fred
      Write(6,*)

!     Do While - (Pretest Loop):
      write(6,*) 'Next is output from DO WHILE:'
      read(5,*)
      do while (k .lt. 10)        ! Note that in WATFOR77 this
         K = K + 1                ! would be: While ( ) do
         Write (6,*) K            !              ....
      end do                      !           end while
      Write(6,*)

!     Do - End Do with an EXIT.  This allows the stopping criterion
!     to be placed anywhere in the loop and is preferred over previous.
      write(6,*) 'Next is output from DO - END DO with an EXIT:'
      Do
         if (k > 20) Exit
         k = k + 1
         Write(6,*) k
      End do
      write(6,*)

!************************************************
!     Selection                                 *
!************************************************

!     Logical IF statement:
      Read(5,*)
      write(6,*) 'Next is output from LOGICAL IF statement:'
      IF (K .GE. 0) Write(6,1040) Name
      Write(6,*)

!     Block If statement with compound logical operator:
!     Note use of symbolic representation for relational operator.
      Read(5,*)
      write(6,*) 'Next is output from BLOCK IF statement:'
      If (Jmax <= 100 .and. Imax >= 0 .and. k > -20) Then
         Do J = 1,3
               Vec(J) = 0.0
            Do I = 2,4
               Vec(J) = Vec(J) + Real(I)**3
            end do
         end do
            Write(6,fmt=1050) J, Vec(J), Vec(J)
      End If
      Write(6,*)

!     Multialternative selection structure - IF - Else IF:
      Write(6,*)  'Next is output from IF - ELSE IF:'
      Write(6,*)  'Input your numerical grade, please. (0. - 100.)'
!     "Iostat" will be used to trap input errors:
      Read(5,*,Iostat = Badnum) Numgrad
      do While (Badnum .GT. 0)     ! Here we're getting the number grade
         Badnum = 0
         Write(6,*) 'Bad Data, Try again.'
         Write(6,*) 'Input your numerical grade, please. (0. -100.)'
         Read(5,*,Iostat = Badnum) Numgrad
      END do

      Grade_Assign: IF (Numgrad .LT. 60.) Then
         Ltrgrad = 'F'
      Else IF (Numgrad .LT. 70.) Then
         Ltrgrad = 'D'
      Else IF (Numgrad .LT. 80.) Then
         Ltrgrad = 'C'
      Else IF (Numgrad .LT. 90.) Then
         Ltrgrad = 'B'
      Else
         Ltrgrad = 'A'
      End If Grade_Assign
      Write(6,fmt=1060) Numgrad, Ltrgrad
      If (Numgrad < 65 ) Then
         Warning = 'Shape up, '
         Write(6,*) Trim(Warning)//' '//Trim(Name)//'!'
      End If
      Write(6,*)

!     Select Case - End Select construct
      Write(6,*) 'Next is output from SELECT - END SELECT:'
      Write(6,*) 'Input an integer, please:'
      Read(5,*,Iostat = Badnum) Caseno
      do while (badnum .gt. 0)
         Badnum = 0
         Write(6,*) 'Bad Data, Try again.'
         Write(6,*) 'Input an integer, please:'
         Read(5,*,Iostat = Badnum) Caseno
      end do
      Select Case(Caseno)
         Case (-1000 : 0)
            Write(6,*) 'This is Case 1'
         Case (1 : 4)
            Write(6,*) 'This is Case 2'
         Case (5, 7, 9)
            Write(6,*) 'This is Case 3'
         Case (6, 8, 10:1000)
            Write(6,*) 'This is Case 4'
         Case Default
            Write(6,*) 'This is everything else'
      End Select
      Write (6,*)

!*************************************************
!     Miscellaneous                              *
!*************************************************

!     Subroutines
      write(6,*) 'Next is output from SUBROUTINE:'
      read (5,*)
      Call Circle(Diam, Circum, Area)
      Write(6,fmt=1100) Diam, Circum, Area
!     Note Delta is shared through a module and Theta is passed via module.
      Write(6,*) 'Delta =  ', Delta
      Write(6,*) 'Theta =  ', Theta
      Write(6,*)

!     Recursive Functions
      Write(6,*) 'RECURSIVE FUNCTIONS.'
      Write(6,*) '(Handled as an internal function)'
      Write(6,*) 'Input the value of an integer less than or equal '
      Write(6,*) 'to 12 that you want to compute the factorial of:'
      
      Read(5,*) n
      write(6,fmt=1130) n, F(n)
      If (n > 12) Then
         Write(6,*) 'WARNING!'
         Write(6,*) 'The computed value is WRONG!  The correct value is'
         Write(6,*) 'greater than the biggest integer allowed!'
      End if

      write(6,*)
      Write(6,*) 'Hypotenuse = ', Hypot(L,M)   ! Use an external function

!     Complex numbers
      write(6,*) 'Next is output from COMPLEX ARITHMETIC:'
      read(5,*)
      Z = Cmplx(A, B)
      Magnit = abs(Z)
      Write(6,*) Z
      Write(6,fmt=1080) Real(Z)
      Write(6,fmt=1090) Aimag(Z), Magnit
      Write(6,*)

!     Logical variables
      IF (Check) Write (6,*) 'Check was True'
      Write(6,*)

!     Integer arithmetic
      write(6,*) 'Next is output based on INTEGER ARITMETIC:'
      read(5,*)
      Do K = 1,100
         IF (K/10*10 == K) Write(6,*) K     ! Only true if K is a multiple
      end do                                ! of 10.
      Write(6,*)

      write(6,*) 'Next is "DOUBLE PRECISION" (Real*8 - 15-16 significant&
     & figures.)'
      Write(6,*) '(and shows how to find pi from inverse cosine.)'
      read(5,*)
!     Double precision (Real*8)
      Pidoub = acos(-1.0)
      Write(6,*) Pidoub
      Write(6,*)

!     Atan2 vs. Atan.  Atan runs between -pi/2 and pi/2; Atan2 runs
!     between -pi and +pi.
      Angle = Atan(Yval/Xval)
      Write(6,*) 'Angle using Atan function = ', Angle
      Angle = Atan2(Yval,Xval)
      Write(6,*) 'Angle using Atan2 function = ', Angle

      Write(6,*)
      write(6,*) 'Next gives the DATE and TIME:'
      read(5,*)
      Call date_and_time(date,time)
      Write(6,*)  'date = ',date
      Write(6,*)  'time = ',time
      write(6,*)

!     Use of internal Write statement to change an integer or real to
!     a character variable so that it can be used in a legend or label.
      write(6,*) 'Next is output from INTERNAL WRITE section:'
      read(5,*)
      Write(Strng,'(I10)') I
      Write(6,fmt=1021) 'I =', Strng
      Write(Strng,'(F5.2)') Alpha
      Write(6,fmt=1021) 'Alpha =', Strng
      Write(Strng,'(1PE9.2)') Alpha
      Write(6,fmt=1021) 'Alpha =', Strng

      write(6,*)
      Write(6,*) 'Use of DATA STRUCTURE:'
      write(6,*)
      Flintstone(1) = Person("Fred_Flintstone","male",38,190,"quarryman"&
     &)
      Flintstone(2) = Person("Wilma_Flintstone","female",36,120,"systems&
     & analyst")
      Flintstone(3) = Person("Pebbles_Flintstone","female",8,75,"student&
     &")
      Flintstone(4) = Person("Dino_Flintstone","male",3,120,"pet")

!     Use of Concatenation and Trim  
      Do k = 1, 4
          Write(Strng, '(I2)') Flintstone(k)%Age
          If (Strng(1:1) == '8' .or. Strng(1:2) == ' 8') Then
             Write(6,*) Trim(Flintstone(k)%full_name)//' is an '        &
     &          //Trim(Strng)//'-year-old, '//Trim(Flintstone(k)%Sex)// & 
     &          ' '//Trim(Flintstone(k)%Occupation)//'.'
          Else
             Write(6,*) Trim(Flintstone(k)%full_name)//' is a '         &
     &          //Trim(Strng)//'-year-old, '//Trim(Flintstone(k)%Sex)// &
     &          ' '//Trim(Flintstone(k)%Occupation)//'.'
          End if
      end do

      write(6,*)
      Linetext = Flintstone(1)%Full_name
      If (Flintstone(1)%Weight > Flintstone(2)%Weight) then
         Write(6,*) Trim(Linetext)//' weighs more than '//              &
     &      Trim(Flintstone(2)%Full_Name)//'.'
      Else if (Flintstone(1)%Weight < Flintstone(2)%weight) then
         Write(6,*) Trim(Linetext)//' weighs less than '//              &
     &      Trim(Flintstone(2)%full_name)//'.'
      Else
         Write(6,*) Trim(Linetext)//' and '//                           &
     &   Trim(Flintstone(2)%full_name)//'weigh the same.'                                                
      end if
      write(6,*)

!***********************************************************************
!     Simplified Array operations:                                     *
!        (Very useful in finite-difference/volume/element calculations)*
!***********************************************************************
      Barray = 3.      ! Initialize both arrays here (because Data
      Carray = 4.      ! statements are forbidden.)
      write(6,*) 'Next is an ARRAY ADDITION:'
      read(5,*)
      darray = barray + carray  ! No Do Loops needed!
      do i = 1,3
         write(6, fmt=1010) (darray(i,j), j =1,3)
      end do
      write(6,*)

      carray(1:2,3) = 0.0      ! Work on just a section of an array.
      mask = .true.            ! Set up masks.
      mask(1,   1:jmax) = .false.    ! Left side.
      mask(imax,1:jmax) = .false.    ! Right side.
      mask(1:imax,1   ) = .false.    ! Bottom
      mask(1:imax,jmax) = .false.    ! Top

      write(6,*) 'Next is use of the WHERE construct:'
      read (5,*)
      array = 9.9         ! Initialize whole array here, then reset part
      Where (.not. mask)  ! in this statement.
         array = 0.0
      End where
      do j = 10,1,-1
         write(6, fmt=1010) (array(i,j), i=1,10)
      end do

      Read(5,*)
      Write(6,*) 'Next is use of CSHIFT/EOSHIFT operators - Original arr&
     &ay:'
!     Use of Cshift and Eoshift to access neighbors without having to
!     use the i,j subscripts (along with do loops).

      Write(6,fmt=119) 'Label1', 'Label2', 'Label3', 'Label4'
 119  Format(t12, A6, t32, A6, t52, A6, t72, A6)   ! Note use of T (Tab) descriptor
      Do J = 1,4
         Do I = 1,4
            Ashft(i,j) = 10*i + j    ! This is just to initialize the array.
         End Do 
      End do
      Do J = 4, 1, -1
         Write(6,fmt=120) (Ashft(i,j), i = 1,4)
      End do
 120  Format(t10, f8.3, t30, f8.3, t50, f8.3, t70, f8.3) ! Note Tab descriptor

      Bshft = Cshift(Ashft, 1, Dim = 2)
      Write(6,*)
      Write(6,*) 'Array shifted down 1 using CSHIFT (circular shift)'
      Do J = 4, 1, -1
         Write(6,120) (Bshft(i,j), i = 1,4)
      End do

      Bshft = Eoshift(Ashft, -1, Dim = 1)
      Write(6,*)
      Write(6,*) 'Array shifted to right using EOSHIFT (end-off shift)'
      Do J = 4, 1, -1
         Write(6,fmt=120) (Bshft(i,j), i = 1,4)
      End do

      Read(5,*)
      Write(6,*) 'Next is use of DYNAMIC REDIMENSIONING.'
      Write(6,*) 'Input dimensions of a 2-D array separated by comma.'
      Write(6,*) '(It would be preferrable to keep the integers less'
      Write(6,*) 'than 10 or so to minimize the printing later.)'
      Read(5,*)  mg1, ng1
      Allocate (G1(mg1,ng1))   !  Allocate the desired memory
      Do J = 1, NG1
         Do I = 1, mg1
            G1(i,j) = i-j      !  Assign some values.
         End do
         Write(6,1150) (G1(i,j), i = 1, mg1)
      End do
      Deallocate (G1)          !  Return the memory.

      write(6,*)
      write(6,*) 'Next is use of an INTRINSIC FUNCTION for vectors:'
      read(5,*)
      call random_seed()               ! Use the supplied random number
      call random_number(vector1)      ! generator to get some values.
      call random_number(vector2)
      dotprod = dot_product(vector1,vector2)
      write(6,fmt=1120) dotprod
      write(6,*)

      write(6,*)       
      write(6,*) 'Next is use of POINTERS and TARGETS for arrays:'
      read(5,*)
      Earray = 5.                              ! Initialize Earray
      Farray = 7.                              ! Initialize Farray
      write(6,*) 'Chose the array you would like to display, Earray or F&
     &array'
      write(6,*) 'Enter e or f (it must be lower case)'
      read(5,*) Aselect
      if (Aselect == 'e') Apoint => Earray     ! Assign Apoint to Earray
      if (Aselect == 'f') Apoint => Farray     ! Assign Apoint to Farray
      write(6,*) Apoint
      nullify (Apoint)
      write(6,*)

!***************************
!     File processing      *
!***************************

!     All data is written to "Scratch" files, so no files will be
!     left when the job is done.
!     List directed
      Write(6,*) 'Next is output from file processing section (LIST-DIRE&
     &CTED):'
      Read(5,*)
      Open (Unit = 12, Status = 'Scratch')
      Write(12,*) Vec
      Rewind(12)
      Read(12,*) Vec
      Write(6,*) Vec
      Close(12)

!     Formatted
      Write(6,*)
      Write(6,*) 'Next is output from the file processing section (FORMA&
     &TTED): '
      read(5,*)

      Open(unit = 15, status = 'scratch')
      Write(15, fmt=1140) vec
      rewind(15)
!     read(15, fmt=1140) vec
      write(6,*) 'got here'
      write(6, fmt=1140) vec
      close(15)                 ! Files should be closed at end.

!     Unformatted: Default record length might have to be increased
!     to handle longer vectors.  The file is written, then read
!     unformatted, then printed list-directed.
      Write(6,*) 'Next is output from file processing section, written a&
     &nd read unformatted, then printed list-directed.'
      read(5,*)
      Open (Unit = 13, Form = 'Unformatted', Status = 'Scratch')
      Write(13) Vec
      Rewind(13)
      Read(13) Vec
      Write(6,*) Vec
      Close(13)

!     Use of "End =" when exact number of entries in a file are not known.
      Open(Unit = 14, Status = 'Scratch')
      Write(6,*)
      Write(6,*) 'Next is when you do not know the exact number of entri&
     &es in a file'
      Do I = 1,7
         Write(14,*) Vec(I)
      end do
      Rewind(14)
      Do I = 1, 10
         Read(14,*,End = 420) Vec(I)
         Write(6,*) I, Vec(I)
      end do
  420 I = I-1
      Write(6,fmt=1110) I
      Close(14)

!************************************************************************
!     Format statments                                                  *
!        Note that the use of _x to give blanks is forbidden in ELF90.  *
!        Use '   ' instead.                                             *
!************************************************************************

 1000 Format('  ','I = ',I3,'  J = ',I3,'  array(I,J) = ',F9.2)
 1010 Format(5('  ',EN10.3))   ! Note multiple!
 1020 Format(A20)
 1021 Format(2A10)
 1030 Format(//,' You are in for the thrill of your life, ',A20,/)
 1040 Format(' We''re doing well, ',A20)
 1050 Format('  ',I5,'  ',E15.8,'  ',EN11.4)
 1060 Format('  ','Number Grade =', F8.1,'     ', 'Letter Grade =',A2)
 1080 Format('  ','Magnitude of a complex number whose real part is',F6.&
     &2)
 1090 Format('  ','and imaginary part is', F6.2, '  is:',F6.2)
 1100 Format('  ','Diameter = ',F6.2,'    Area = ',F6.2,'    Circumferen&
     &ce = ',F9.2)
 1110 Format('  ','There were ',I2,' entries in the file.',/)
 1120 Format('  ','Dotproduct of the two vectors = ', f10.4)
 1130 Format('  ','The factorial of ',I3, ' = ', I20)
 1140 Format(4('  ',e15.8))
 1150 Format(5g15.8)

      stop '**** O.K.'
      contains

!     Internal Subprograms: 

      Function Square(J)
         Implicit None
         Real:: Square
         Integer, Intent(In) :: J
         Square = Real(J**2)
         Return
      End Function Square

      Recursive Function F(n)  Result(Fac)
!     Function for the factorial.
!     This is treated as an internal function here.
!     Note that it calls itself!
!     WARNING:  This gives a wrong answer for n > 12 !!

      Implicit None
      Integer, Intent(In) :: N
      Integer :: Fac
      If (n == 1) then
         Fac = 1
      Else
         Fac = N*f(n-1)
      end if
      Return
      end function f

      end program ref90a

!     External subprograms

      Function Hypot(L,M)
!     This is an example of a function subprogram
      Implicit None
      Integer, Intent(IN) :: L, M
      Real :: Hypot
      Real :: Square2
      Square2 = Real(L)**2 + Real(M)**2
      Hypot =  Sqrt(Square2)
      Return
      End function hypot

      Subroutine Circle(Diam, Circum, Area)
      Use one                ! Use of a module to share data
      Use two
!     An example of a subroutine subprogram
      Implicit None

!     INTENT(IN) causes the compiler to balk if you try to change
!     a variable that is only supposed to be input to the subroutine.
!     INTENT(OUT) means the variable is an output. INOUT can be either.
!     Great when several programmers working on same job!
      Real, Intent(In)  :: Diam
      Real, Intent(Out) :: Circum, Area
      Real :: PI, H

      Pi = Acos(-1.0)
      Circum = Pi * Diam
      Area = Pi * Diam**2 / 4.0
      Delta = Alpha + Beta + Gamma
      h = epsilon + zeta + theta
      Area = h*area
!     Diam = 3.0  ! The compiler would choke if this weren't commented out.
      Return
      End Subroutine Circle