#!/bin/sh
# to extract, remove the header and type "sh filename"
if `test ! -s ./squaremod.f90`
then
echo "writting ./squaremod.f90"
cat > ./squaremod.f90 << '\Rogue\Monster\'
module square_module
  private
  public square
  interface square
    module procedure isquare,rsquare,csquare
  end interface
contains
  integer function isquare(ival)
    integer,intent(in) :: ival
    isquare = ival*ival
  end function
  real function rsquare(rval)
    real,intent(in) :: rval
    rsquare = rval*rval
  end function
  complex function csquare(cval)
    complex,intent(in) :: cval
    csquare = cval*cval
  end function
end module
\Rogue\Monster\
else
  echo "will not over write ./squaremod.f90"
fi
if `test ! -s ./squareprog.f90`
then
echo "writting ./squareprog.f90"
cat > ./squareprog.f90 << '\Rogue\Monster\'
!
! square_example
!    A generic function is defined in square_module (squaremod.f90)
!    which squares a real, integer or complex value depending on the
!    type of its argument.
!
! Author: The Numerical Algorithms Group Ltd
!         Malcolm Cohen, Robert Iles
!
program square_example
        use square_module
        use f90_iostat
        character option
        integer ival,iostatus
        real rval
        complex cval
        write(*,1000) ! heading
        write(*,1005) ! menu
process:do
           write(*,1010,advance='no')
readoption:do
             read(*,1020,advance='no',iostat=iostatus) option
             if (iostatus==0) then
                exit readoption
             else if (iostatus==IOERR_EOF) then
                exit process
             else if (iostatus/=IOERR_EOR) then
                print *,'Unexpected i/o error code',iostatus
                exit process
             endif
           end do readoption

           select case (option)
              case('q','Q')
                 exit process
              case('i','I')
                 write(*,'("Enter Integer value: ")',advance='no')
                 read(*,*,iostat=iostatus) ival
                 if (iostatus==0) then
                    print *,'SQUARE(',ival,') is ',square(ival)
                 else
                    print *,'Expected an integer number following the I option'
                 endif
              case('r','R')
                 write(*,'("Enter Real value: ")',advance='no')
                 read(*,*,iostat=iostatus) rval
                 if (iostatus==0) then
                    print *,'SQUARE(',rval,') is ',square(rval)
                 else
                    print *,'Expected a real number following the R option'
                 endif
              case('c','C')
                 write(*,'("Enter Complex value e.g. (x,y): ")',advance='no')
                 read(*,*,iostat=iostatus) cval
                 if (iostatus==0) then
                    print *,'SQUARE(',cval,') is ',square(cval)
                 else
                    print *,'Expected a complex number following the C option'
                 endif
              case default
                 print *,'Unknown option "',option,'"'
                 write(*,1005)
              end select
           end do process
           write(*,1015)
1000 format(//' Example program for generic names'//' The SQUARE function.'//)
1005 format(' Options are: '/'     Q - Quit',&
                             '     I - Integer square',&
                             '     R - Real square',&
                             '     C - Complex square'/)
1010 format(/'Option? ')
1015 format(/' Program Terminated'/)
1020 format(a)
end program








\Rogue\Monster\
else
  echo "will not over write ./squareprog.f90"
fi
echo "Finished archive 1 of 1"
exit