CTITLEFOTPCL -- TIME-PICK FILE CLOSING AND DEALLOCATION                 00000101
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
CA    AUTHOR                 J. V. S. HARVEY                            00000200
CA    DESIGNER               J. V. S. HARVEY                            00000300
CA    LANGUAGE               VS FORTRAN (77)                            00000400
CA    SYSTEM                 IBM (SEE CRAY)                             00000500
CA    WRITTEN                FEB 1985                                   00000600
C     REVISED                11-20-85 ESN.  RENAMED FROM ZZTPCL AND     00000700
C                            RELEASED FOR PRODUCTION.                   00000800
CA                                                                      00000900
CA                                                                      00001000
CA    THIS SUBROUTINE CLOSES AND DEALLOCATES THE TIME-PICK FILE.        00001100
CA                   ( FOTPOP MUST BE CALLED FIRST )                    00001200
CA                                                                      00001300
CA                                                                      00001400
CA    CALL FOTPCL( TPDCB, ERR1, ERR2 )                                  00001500
CA                                                                      00001600
CA    IN/OUT  ARGUMENT  TYPE  DESCRIPTION                               00001700
CA                                                                      00001800
CA    IN      TPDCB       I4  DCB ADDRESS OF TIME PICK FILE             00001900
CA    IN/OUT  ERR1        I4  ERROR FLAG:                               00002000
CA                               0 FOR   NO ERROR                       00002100
CA                               1       OPEN FAILURE                   00002200
CA                            2 TO   9   ERROR FROM FOTPRD              00002300
CA                           -1 TO  -9   ERROR DURING ALLOCATION        00002400
CA                          -10 TO -19   ERROR DURING DEALLOCATION      00002500
CA                             -12          RETURN CODE  -- SEE ERR2    00002600
CA                             -13          SVC 99 ERROR -- SEE ERR2    00002700
CA                             -14          SYSTEM ERROR -- SEE ERR2    00002800
CA                             -15          CLOSE FAILURE OF TEMPORARY  00002900
CA                             -17          FREEMAIN FOR DCB            00003000
CA                             -18          BLANK NAME                  00003100
CA    IN/OUT  ERR2        I4  SECONDARY ERROR FLAG                      00003200
CA                                                                      00003300
C***********************************************************************00003400
C                                                                       00003500
      SUBROUTINE FOTPCL( TPDCB, ERR1, ERR2 )                            00003600
      IMPLICIT INTEGER (A-Z)                                            00003700
C                                                                       00003800
C                        CLOSE PERMANENT FILE                           00003900
C                                                                       00004000
C     IN/OUT  ARGUMENT  TYPE  DESCRIPTION                               00004100
C                                                                       00004200
C     IN      TPDCB       I4  DCB ADDRESS                               00004300
C     OUT     IERR        I4  ERROR CODE                                00004400
C                                                                       00004500
      IF( ERR1 .EQ. 0 .OR. ERR1 .GT. 1 ) CALL FGCRTR( TPDCB, IERR )     00004600
C---------------------------------------------------------------------- 00004700
C                                                                       00004800
C                   DEALLOCATE THE PERMANENT FILE                       00004900
C                                                                       00005000
C     IN/OUT  ARGUMENT  TYPE  DESCRIPTION                               00005100
C                                                                       00005200
C     IN      TPDCB       I4  DCB ADDRESS                               00005300
C     OUT     ERR0        I4  ERROR CODE                                00005400
C                                1 FOR NO ERROR                         00005500
C                                2     RETURN CODE  -- SEE ERR2         00005600
C                                3     SVC 99 ERROR -- SEE ERR2         00005700
C                                4     SYSTEM ERROR -- SEE ERR2         00005800
C                                5     CLOSE FAILURE OF TEMPORARY       00005900
C                                7     FREEMAIN FOR DCB                 00006000
C                                8     BLANK NAME                       00006100
C     OUT     IERR        I4  DYNAMIC ALLOC CODES (SVC 99)              00006200
C                                                                       00006300
      IF( ERR1 .GE. 0 ) THEN                                            00006400
         CALL UGUNAL( TPDCB, ERR0, IERR )                               00006500
         IF( ERR1 .EQ. 0 .AND. ERR0 .GT. 1 ) THEN                       00006600
            ERR1 = -10 - ERR0                                           00006700
            ERR2 = IERR                                                 00006800
            ENDIF                                                       00006900
         ENDIF                                                          00007000
      RETURN                                                            00007100
      END                                                               00007200