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

!The circle
   R=200
   CALL MEASURES('circle',R,R,AREA,PERIM)
      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,AREA,PERIM)
      PRINT 110, A,B,AREA,PERIM
110   FORMAT( 'For rectangle, sides ',F5.1,','F5.1' :',&
               T35,' Area = ',G10.3,T55,' Perimeter = ',G10.3)

END PROGRAM
!---------------------------------------
!An external subroutine follows:-
SUBROUTINE MEASURES(OBJECT,LENGTH1,LENGTH2,AREA,PERIM)
!Can't omit AREA, PERIM from CALL and SUBROUTINE statements, since
!they are now local variables in both program and subroutine.

   CHARACTER(*) OBJECT
   REAL LENGTH1, LENGTH2
   DATA K/1/      !Alternatively INTEGER :: K=1
   SAVE PI,K
   IF (K==1) THEN !on first call only, assign PI
      PI=ACOS(-1.)
      K=0
   ENDIF
   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    
!=======================================