*IF DEF,C96_1A,OR,DEF,C96_1B                                               GPB3F403.245    
*IF DEF,MPP                                                                GPB3F403.246    
C ******************************COPYRIGHT******************************    GTS2F400.12616  
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.    GTS2F400.12617  
C                                                                          GTS2F400.12618  
C Use, duplication or disclosure of this code is subject to the            GTS2F400.12619  
C restrictions as set forth in the contract.                               GTS2F400.12620  
C                                                                          GTS2F400.12621  
C                Meteorological Office                                     GTS2F400.12622  
C                London Road                                               GTS2F400.12623  
C                BRACKNELL                                                 GTS2F400.12624  
C                Berkshire UK                                              GTS2F400.12625  
C                RG12 2SZ                                                  GTS2F400.12626  
C                                                                          GTS2F400.12627  
C If no contract has been raised with this copy of the code, the use,      GTS2F400.12628  
C duplication or disclosure of it is strictly prohibited.  Permission      GTS2F400.12629  
C to do so must first be obtained in writing from the Head of Numerical    GTS2F400.12630  
C Modelling at the above address.                                          GTS2F400.12631  
C                                                                          GTS2F400.12632  
!+ Parallel UM version of FILE_CLOSE                                       PCLOSE1A.3      
!                                                                          PCLOSE1A.4      
! Subroutine Interface:                                                    PCLOSE1A.5      

      SUBROUTINE FILE_CLOSE(NFTIN,ENV,NENV,ENV_VAR,DELETE,ERR)              35,1APB1F402.43     
                                                                           PCLOSE1A.7      
      IMPLICIT NONE                                                        PCLOSE1A.8      
!                                                                          PCLOSE1A.9      
! Description:                                                             PCLOSE1A.10     
!  This routine provides an interface to FILE_CLOSE for the Parallel       PCLOSE1A.11     
!  Unified Model.                                                          PCLOSE1A.12     
!                                                                          PCLOSE1A.13     
! Method:                                                                  PCLOSE1A.14     
!  The C FILE_CLOSE is renamed CLOSE_SINGLE under *DEF,MPP. This           PCLOSE1A.15     
!  routine causes CLOSE_SINGLE to be called by PE 0 only.                  PCLOSE1A.16     
!                                                                          PCLOSE1A.17     
! Current Code Owner: Paul Burton                                          PCLOSE1A.18     
!                                                                          PCLOSE1A.19     
! History:                                                                 PCLOSE1A.20     
!  Model    Date     Modification history from model version 3.5           PCLOSE1A.21     
!  version                                                                 PCLOSE1A.22     
!    3.5    5/1/95   New DECK created for the Parallel Unified             PCLOSE1A.23     
!                    Model. A.Dickinson + D.Salmond                        PCLOSE1A.24     
!    4.2    15/10/96 Added ERR argument to match non-MPP code              APB1F402.41     
!                    P.Burton                                              APB1F402.42     
!                                                                          PCLOSE1A.25     
! Subroutine Arguments:                                                    PCLOSE1A.26     
                                                                           PCLOSE1A.27     
      INTEGER                                                              PCLOSE1A.28     
     * NFTIN         !IN Unit number for I/O                               PCLOSE1A.29     
     *,NENV          !IN Length of ENV                                     PCLOSE1A.30     
     *,DELETE        !IN =0, do not delete file                            PCLOSE1A.31     
     *               !   <>0, delete file                                  PCLOSE1A.32     
     *,ENV_VAR       !IN =0 file name stored in environment var            PCLOSE1A.33     
     *               !   <>0 file name specified explicitly                PCLOSE1A.34     
     *,ERR      ! OUT return code (0=no error)                             APB1F402.44     
                                                                           PCLOSE1A.35     
      CHARACTER*(*)                                                        PCLOSE1A.36     
     * ENV          !IN Environment name of file                           PCLOSE1A.37     
                                                                           PCLOSE1A.38     
! Parameters and Common blocks                                             PCLOSE1A.39     
                                                                           PCLOSE1A.40     
*CALL PARVARS                                                              PCLOSE1A.41     
                                                                           PCLOSE1A.42     
! ------------------------------------------------------------------       PCLOSE1A.43     
                                                                           PCLOSE1A.44     
      IF (mype .EQ. 0) THEN    ! only PE 0 does any I/O                    PCLOSE1A.45     
        CALL CLOSE_SINGLE(NFTIN,ENV,NENV,ENV_VAR,DELETE,ERR)               APB1F402.45     
      ENDIF                                                                PCLOSE1A.47     
                                                                           PCLOSE1A.48     
      RETURN                                                               PCLOSE1A.49     
      END                                                                  PCLOSE1A.50     
                                                                           PCLOSE1A.51     
*ENDIF                                                                     PCLOSE1A.52     
*ENDIF                                                                     GPB3F403.247