*IF DEF,C96_1A,OR,DEF,C96_1B                                               GPB3F403.248    
*IF DEF,MPP                                                                GPB3F403.249    
C ******************************COPYRIGHT******************************    GTS2F400.12650  
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.    GTS2F400.12651  
C                                                                          GTS2F400.12652  
C Use, duplication or disclosure of this code is subject to the            GTS2F400.12653  
C restrictions as set forth in the contract.                               GTS2F400.12654  
C                                                                          GTS2F400.12655  
C                Meteorological Office                                     GTS2F400.12656  
C                London Road                                               GTS2F400.12657  
C                BRACKNELL                                                 GTS2F400.12658  
C                Berkshire UK                                              GTS2F400.12659  
C                RG12 2SZ                                                  GTS2F400.12660  
C                                                                          GTS2F400.12661  
C If no contract has been raised with this copy of the code, the use,      GTS2F400.12662  
C duplication or disclosure of it is strictly prohibited.  Permission      GTS2F400.12663  
C to do so must first be obtained in writing from the Head of Numerical    GTS2F400.12664  
C Modelling at the above address.                                          GTS2F400.12665  
C                                                                          GTS2F400.12666  
!+ Parallel UM version of FILE_OPEN                                        POPEN1A.3      
!                                                                          POPEN1A.4      
! Subroutine Interface:                                                    POPEN1A.5      

      SUBROUTINE FILE_OPEN(NFTIN,ENV,NENV,READ_WRITE,ENV_VAR,ERR)           104,1POPEN1A.6      
                                                                           POPEN1A.7      
      IMPLICIT NONE                                                        POPEN1A.8      
!                                                                          POPEN1A.9      
! Description:                                                             POPEN1A.10     
!  This routine provides an interface to FILE_OPEN for the Parallel        POPEN1A.11     
!  Unified Model.                                                          POPEN1A.12     
!                                                                          POPEN1A.13     
! Method:                                                                  POPEN1A.14     
!  The C FILE_OPEN is renamed OPEN_SINGLE under *DEF,MPP. This             POPEN1A.15     
!  routine causes OPEN_SINGLE to be called by PE 0 only.                   POPEN1A.16     
!                                                                          POPEN1A.17     
! Current Code Owner: Paul Burton                                          POPEN1A.18     
!                                                                          POPEN1A.19     
! History:                                                                 POPEN1A.20     
!  Model    Date     Modification history from model version 3.5           POPEN1A.21     
!  version                                                                 POPEN1A.22     
!    3.5    5/1/95   New DECK created for the Parallel Unified             POPEN1A.23     
!                    Model. A.Dickinson + D.Salmond                        POPEN1A.24     
!    4.3    7/3/96   Broadcast return code to all PEs  P.Burton            GPB3F403.85     
!                                                                          POPEN1A.25     
! Subroutine Arguments:                                                    POPEN1A.26     
                                                                           POPEN1A.27     
      INTEGER                                                              POPEN1A.28     
     * NFTIN         !IN Unit number for I/O                               POPEN1A.29     
     *,NENV          !IN Length of ENV                                     POPEN1A.30     
     *,READ_WRITE    !IN =0 read only, <> 0 read and write                 POPEN1A.31     
     *,ENV_VAR       !IN =0 file name stored in environment var            POPEN1A.32     
     *               !   <>0 file name specified explicitly                POPEN1A.33     
     *,ERR           !OUT =0 file OPENED                                   POPEN1A.34     
     *               !   <>0 file NOT OPENED because of error              POPEN1A.35     
                                                                           POPEN1A.36     
      CHARACTER*(*)                                                        POPEN1A.37     
     * ENV           !IN Environment name or explicit file name            POPEN1A.38     
                                                                           POPEN1A.39     
      INTEGER info                                                         GPB3F403.86     
! Parameters and Common blocks                                             POPEN1A.40     
                                                                           POPEN1A.41     
*CALL PARVARS                                                              POPEN1A.42     
                                                                           POPEN1A.43     
! ------------------------------------------------------------------       POPEN1A.44     
                                                                           POPEN1A.45     
      ERR=0                                                                POPEN1A.46     
      IF (mype .EQ. 0) THEN    ! only PE 0 does any I/O                    POPEN1A.47     
        CALL OPEN_SINGLE(NFTIN,ENV,NENV,READ_WRITE,ENV_VAR,ERR)            POPEN1A.48     
      ENDIF                                                                POPEN1A.49     
      CALL GC_IBCAST(1,1,0,nproc,info,ERR)                                 GPB3F403.87     
                                                                           POPEN1A.50     
      RETURN                                                               POPEN1A.51     
      END                                                                  POPEN1A.52     
                                                                           POPEN1A.53     
*ENDIF                                                                     POPEN1A.54     
*ENDIF                                                                     GPB3F403.250