*IF DEF,C96_1A,OR,DEF,C96_1B                                               GPB3F403.251    
*IF DEF,MPP                                                                GPB3F403.252    
C ******************************COPYRIGHT******************************    GTS2F400.12701  
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.    GTS2F400.12702  
C                                                                          GTS2F400.12703  
C Use, duplication or disclosure of this code is subject to the            GTS2F400.12704  
C restrictions as set forth in the contract.                               GTS2F400.12705  
C                                                                          GTS2F400.12706  
C                Meteorological Office                                     GTS2F400.12707  
C                London Road                                               GTS2F400.12708  
C                BRACKNELL                                                 GTS2F400.12709  
C                Berkshire UK                                              GTS2F400.12710  
C                RG12 2SZ                                                  GTS2F400.12711  
C                                                                          GTS2F400.12712  
C If no contract has been raised with this copy of the code, the use,      GTS2F400.12713  
C duplication or disclosure of it is strictly prohibited.  Permission      GTS2F400.12714  
C to do so must first be obtained in writing from the Head of Numerical    GTS2F400.12715  
C Modelling at the above address.                                          GTS2F400.12716  
C                                                                          GTS2F400.12717  
!+ Parallel UM version of SETPOS                                           PSTPOS1A.3      
!                                                                          PSTPOS1A.4      
! Subroutine Interface:                                                    PSTPOS1A.5      

      SUBROUTINE SETPOS(NFT,IPOS,ICODE)                                     112,1GPB0F401.232    
                                                                           PSTPOS1A.7      
      IMPLICIT NONE                                                        PSTPOS1A.8      
!                                                                          PSTPOS1A.9      
! Description:                                                             PSTPOS1A.10     
!  This routine provides an interface to SETPOS for the Parallel           PSTPOS1A.11     
!  Unified Model.                                                          PSTPOS1A.12     
!                                                                          PSTPOS1A.13     
! Method:                                                                  PSTPOS1A.14     
!  The C SETPOS is renamed SETPOS_SINGLE under *DEF,MPP. This              PSTPOS1A.15     
!  routine causes SETPOS_SINGLE to be called by PE 0 only.                 PSTPOS1A.16     
!                                                                          PSTPOS1A.17     
! Current Code Owner: Paul Burton                                          PSTPOS1A.18     
!                                                                          PSTPOS1A.19     
! History:                                                                 PSTPOS1A.20     
!  Model    Date     Modification history from model version 3.5           PSTPOS1A.21     
!  version                                                                 PSTPOS1A.22     
!    3.5    5/1/95   New DECK created for the Parallel Unified             PSTPOS1A.23     
!                    Model. A.Dickinson + D.Salmond                        PSTPOS1A.24     
!    4.1    21/05/96   Added ICODE argument   P.Burton                     GPB0F401.233    
!                                                                          PSTPOS1A.25     
! Subroutine Arguments:                                                    PSTPOS1A.26     
                                                                           PSTPOS1A.27     
      INTEGER NFT,   ! IN : Fortran unit number                            PSTPOS1A.28     
     &        IPOS   ! IN : Position in file                               PSTPOS1A.29     
     &,       ICODE  ! OUT : Return code                                   GPB0F401.234    
                                                                           PSTPOS1A.30     
! Parameters and Common blocks                                             PSTPOS1A.31     
                                                                           PSTPOS1A.32     
*CALL PARVARS                                                              PSTPOS1A.33     
                                                                           PSTPOS1A.34     
! ------------------------------------------------------------------       PSTPOS1A.35     
                                                                           PSTPOS1A.36     
      IF (mype .EQ. 0) THEN    ! only PE 0 does any I/O                    PSTPOS1A.37     
        CALL SETPOS_SINGLE(NFT,IPOS,ICODE)                                 GPB0F401.235    
      ENDIF                                                                PSTPOS1A.39     
                                                                           PSTPOS1A.40     
      RETURN                                                               PSTPOS1A.41     
      END                                                                  PSTPOS1A.42     
                                                                           PSTPOS1A.43     
*ENDIF                                                                     PSTPOS1A.44     
*ENDIF                                                                     GPB3F403.253