array3as.f

PROGRAM ARRAY3AS
c
c    This program illustrates use of allocatable arrays accross
c    subprograms
c
c    John Mahaffy   2/3/95
c
      IMPLICIT NONE
      INTEGER I,J,IERR,N,NDAT
c
c    Declare A, B, and C to be arrays to be ALLOCATABLE
c
      REAL, ALLOCATABLE :: A(:),B(:),C(:)
      REAL CSUM,CMAX,CMIN,AVERAGE,RAVERAGE
c
      call size (NDAT)
c
c   ALLOCATE must take place at the highest level the arrays are used.
c   I can't allocate the space in subroutines size or input.
c
c
      ALLOCATE (A(1:NDAT),B(NDAT),C(NDAT))
c
      call input(A,B,NDAT)
      if (NDAT.eq.0) then
         print *, 'No Lines in the Data File'
         stop
      endif
      call cprop(A,B,C,NDAT,AVERAGE,RAVERAGE,CMAX,CMIN)
      call writec(C,NDAT,AVERAGE,RAVERAGE,CMAX,CMIN)
      stop
      end
      SUBROUTINE SIZE  (N)
c
c     Read input file to determine data needs
c
      REAL DUMMY
      INTEGER N
      OPEN(11,FILE='array3a.in',ERR=400)
      NDAT=0
  10  READ(11,*,END=20) DUMMY
      N=N+1
      GO TO 10
  20  CONTINUE
c
c    Having gone through Unit 11, I need to reposition it at the beginning
c
      REWIND(11)
      return
 400  print *, 'Can not open array3a.in'
      stop
      end
c
      SUBROUTINE INPUT (A,B,N)
c
c     Read A and B arrays
c
      REAL DUMMY,A(N),B(N)
      INTEGER N
c
      DO 30 I=1,N
         READ(11,*) A(I), B(I)
  30     CONTINUE
      RETURN
      END
      SUBROUTINE CPROP(A,B,C,NDAT,AVERAGE,RAVERAGE,CMAX,CMIN)
c
c    This subroutine doesn't care whether A, B, or C are allocatable.
c    but I will allocate RA for internal use.
c
      REAL A(NDAT),B(NDAT),C(NDAT)
      REAL,  ALLOCATABLE::RA(:)
c
c    The next line does a default allocate, because "RB" is not in the
c    argument list, but NDAT is. RB is called an "automatic" array.
c
      REAL RB(NDAT)
      REAL AVERAGE,RAVERAGE,CMAX,CMIN
      INTEGER NDAT,ISTAT
      LOGICAL lalloc
c
c   Process as before
c
      ALLOCATE (RA(1:NDAT))
      RA(1:NDAT)=1./A(1:NDAT)
      RB(1:NDAT)=1./B(1:NDAT)
      C(1:NDAT)=A(1:NDAT)+B(1:NDAT)
      CSUM=SUM(C(1:NDAT))
      CMIN=MINVAL(C(1:NDAT))
      CMAX=MAXVAL(C(1:NDAT))
C
      AVERAGE=CSUM/NDAT
      RAVERAGE=SUM(RA(1:NDAT)+RB(1:NDAT))/(2*NDAT)
c
c    In a Program with a lot of branching,
c
      lalloc=allocated(RA)
      print *, 'Allocation status of RA is ', lalloc
c
c    If you allocate an Array in a subroutine or function you should
c    deallocate it before returning.  Otherwise the array enters an
c    undefined state, and Fortran 90 makes no guarantees about whether
c    you can reuse contents.  The memory used is wasted (can't be reused by
c    another allocation, but is still credited to the total size of your
c    executing program.  Also remember that the process of ALLOCATE and
c    DEALLOCATE in a subroutine or function that is used many times will
c    consume an excessive amount of computer time.
c

      if (lalloc) then
         DEALLOCATE(RA,STAT=ISTAT)
         if (ISTAT.NE.0) then
            print *, 'Trouble deallocating RA in CPROP'
         endif
         lalloc=allocated(RA)
         print *, 'Allocation status of RA is ', lalloc
      endif
c
c     RB is automatically deallocated at the RETURN, but the above
c     warning for excessive computer time associated with the ALLOCATE
c     and DEALLOCATE cycle, applies to this array too.  In reality the
c     computer treats it no differently than I have RA
c
      RETURN
      END
      SUBROUTINE WRITEC (C,NDAT,AVERAGE,RAVERAGE,CMAX,CMIN)
      REAL AVERAGE,RAVERAGE,SUM,CMAX,CMIN,C(1:NDAT)
      INTEGER NDAT,ISTAT
      WRITE(*,'(//,'' RESULTS FOR ELEMENTS 1 THROUGH '',I3,'' OF C'')')
     & NDAT
      WRITE(6,2002)AVERAGE,CMIN,CMAX
 2002 FORMAT(' AVERAGE OF SELECTED ELEMENTS IN C = ', F8.3,/,
     &       ' MINIMUM OF SELECTED ELEMENTS IN C = ', F8.3,/,
     &       ' MAXIMUM OF SELECTED ELEMENTS IN C = ', F8.3)
      WRITE(6,*) 'Average of all reciprocals is: ',RAVERAGE
      WRITE(6,2003) C(1:NDAT)
 2003 FORMAT(' C = ',/,(1P,8E10.2))
c
      RETURN
 400  PRINT *,' Empty or missing input file: array3a.in'
      RETURN
      END