!=======================================
PROGRAM INTERNAL_SUBROUTINE_DEMO
!Calculates areas and perimeters of a circle and a rectangle

!The circle
      PI=ACOS(-1.)
      R=200
      CALL MEASURES('circle',R,R)
      PRINT 100, R,AREA,PERIM
100   FORMAT( 'For circle, radius ',F5.1,' :',&
               T35,' Area = ',G10.3,T55,' Perimeter = ',G10.3)
                                                 
!The rectangle
      A=100;B=200
      CALL MEASURES('rectangle',A,B)
      PRINT 110, A,B,AREA,PERIM
110   FORMAT( 'For rectangle, sides ',F5.1,', 'F5.1' :',&
               T35,' Area = ',G10.3,T55,' Perimeter = ',G10.3)
               
CONTAINS !------------------------------
      SUBROUTINE MEASURES(OBJECT,LENGTH1,LENGTH2)
!Have omitted AREA, PERIM from CALL and SUBROUTINE
!statements, since they are not declared locally in
!Subroutine Measures, and are therefore the same variables
!in both program and internal subroutine (as is PI).
         CHARACTER(*) OBJECT
         REAL LENGTH1, LENGTH2
         SELECT CASE(OBJECT)
         CASE('circle')
            AREA=PI*LENGTH1**2
            PERIM=2*PI*LENGTH1
         CASE('rectangle')
            AREA=LENGTH1*LENGTH2
            PERIM=2*(LENGTH1+LENGTH2)
         ENDSELECT
      END SUBROUTINE    
END PROGRAM
!=======================================