program drho
      implicit none
c
c     Driver for the resistivity subroutine
c     Reads material ID into varable "id" and prints the
c     associated resistivity
c     Execution terminates for negative material ID
c
      integer id
      real rho, resistivity
      data id /1/
c
      do while (id.ge.0)
         write(*,2000)
         read *, id
         resistivity=rho(id)
         write (*,2001) id,resistivity
      end do
 2000 format(/,' Enter a Material ID (integer from 1-4):')
 2001 format(' Resistivity for material ', i2,' is ',1p, e10.3,
     $         ' ohm*m')
      end
c
      function rho(i)
      implicit none
c
c     Function to return resistivity (ohms*meters) of the following metals:
c     ID     Metal
c      1     Aluminum
c      2     Copper
c      3     Gold
c      4     Silver
c
c     If the ID is not in the range 1-4, an error message is printed
c     execution is terminated.
c
c     Programmed by:   M. Fillmore   3/30/69
c     Modified by:     R. Hayes     2/11/78  (Added Error Message)
      integer i
      real rho
c----------------------------------------------------------------
         select case (i)
         case (1)
            rho= 2.655e-8
         case(2)
            rho = 1.673e-8
         case(3)
            rho = 2.350e-8
         case (4)
            rho = 1.59e-8
         case default
            write(6,2000) i
 2000       format('**** Function RHO*****  Invalid Material ID:', i5)
            stop
         end select
c----------------------------------------------------------------
      end