C     PROGRAM LIGHTBULB_CHANGE
C     WRITTEN IN 1957, STILL WORKS
C     LAST MODIFIED: NEVER
C     AUTHOR: DR. PUNCH-CARD
      PROGRAM LIGHTBULB_CHANGE
      IMPLICIT NONE

C     VARIABLE DECLARATIONS (ALL MUST START BEFORE COLUMN 7)
      INTEGER*4 BULB_STATUS, ERROR_CODE
      REAL*8 VOLTAGE, WATTAGE, TEMPERATURE
      CHARACTER*6 BULB_TYPE
      LOGICAL IS_WORKING

C     COMMON BLOCK FOR SHARING VARIABLES
      COMMON /BULBDATA/ VOLTAGE, WATTAGE

C     FORMAT STATEMENTS
 10   FORMAT(1X,'***LIGHT BULB CHANGE PROCEDURE INITIATED***')
 20   FORMAT(1X,'CURRENT BULB STATUS: ',I2)
 30   FORMAT(1X,'ERROR CODE: ',I4,' - CONTACT IBM MAINTENANCE')

C     INITIALIZE VARIABLES
      BULB_STATUS = 0
      ERROR_CODE = 0
      VOLTAGE = 220.0D0
      WATTAGE = 60.0D0
      TEMPERATURE = 0.0D0
      BULB_TYPE = 'TYPE-A'
      IS_WORKING = .FALSE.

C     PRINT HEADER
      WRITE(6,10)

C     CHECK IF BULB EXISTS
      CALL CHECK_BULB_STATUS(BULB_STATUS)
      IF (BULB_STATUS .LT. 0) THEN
         WRITE(6,30) ERROR_CODE
         STOP 'ABNORMAL TERMINATION'
      ENDIF

C     PERFORM CALCULATIONS
      CALL CALCULATE_POWER_REQUIREMENTS(
     &     VOLTAGE,
     &     WATTAGE,
     &     TEMPERATURE)

C     CHANGE THE BULB
      CALL CHANGE_BULB(
     &     BULB_TYPE,
     &     TEMPERATURE,
     &     IS_WORKING,
     &     ERROR_CODE)

C     CHECK RESULTS
      IF (ERROR_CODE .NE. 0) THEN
         WRITE(6,30) ERROR_CODE
         CALL ABORT
      ENDIF

C     WRITE RESULTS TO PUNCH CARDS
      CALL WRITE_TO_CARDS(
     &     BULB_TYPE,
     &     BULB_STATUS,
     &     IS_WORKING)

      END

C     SUBROUTINE TO CHECK BULB STATUS
      SUBROUTINE CHECK_BULB_STATUS(STATUS)
      INTEGER*4 STATUS
C     COMPLICATED PHYSICS CALCULATIONS HERE
      RETURN
      END

C     SUBROUTINE TO CALCULATE POWER
      SUBROUTINE CALCULATE_POWER_REQUIREMENTS(V, W, T)
      REAL*8 V, W, T
C     MORE COMPLICATED PHYSICS
      RETURN
      END

C     SUBROUTINE TO CHANGE BULB
      SUBROUTINE CHANGE_BULB(TYPE, TEMP, WORKING, ERR)
      CHARACTER*6 TYPE
      REAL*8 TEMP
      LOGICAL WORKING
      INTEGER*4 ERR
C     ACTUAL BULB CHANGE LOGIC
      RETURN
      END