*IF DEF,C96_1A,OR,DEF,C96_1B                                               GPB3F403.242    
*IF DEF,MPP                                                                GPB3F403.243    
C ******************************COPYRIGHT******************************    GTS2F400.12599  
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.    GTS2F400.12600  
C                                                                          GTS2F400.12601  
C Use, duplication or disclosure of this code is subject to the            GTS2F400.12602  
C restrictions as set forth in the contract.                               GTS2F400.12603  
C                                                                          GTS2F400.12604  
C                Meteorological Office                                     GTS2F400.12605  
C                London Road                                               GTS2F400.12606  
C                BRACKNELL                                                 GTS2F400.12607  
C                Berkshire UK                                              GTS2F400.12608  
C                RG12 2SZ                                                  GTS2F400.12609  
C                                                                          GTS2F400.12610  
C If no contract has been raised with this copy of the code, the use,      GTS2F400.12611  
C duplication or disclosure of it is strictly prohibited.  Permission      GTS2F400.12612  
C to do so must first be obtained in writing from the Head of Numerical    GTS2F400.12613  
C Modelling at the above address.                                          GTS2F400.12614  
C                                                                          GTS2F400.12615  
!+ Parallel UM version of BUFFOUT                                          PBFOUT1A.3      
!                                                                          PBFOUT1A.4      
! Subroutine Interface:                                                    PBFOUT1A.5      

      SUBROUTINE BUFFOUT(NFT,ARRAY,ISIZE,LEN_IO,IOSTAT)                     71,1PBFOUT1A.6      
                                                                           PBFOUT1A.7      
      IMPLICIT NONE                                                        PBFOUT1A.8      
!                                                                          PBFOUT1A.9      
! Description:                                                             PBFOUT1A.10     
!  This routine provides a BUFFOUT routine for the Parallel Unified        PBFOUT1A.11     
!  Model. It is used where the same data has to be written out from        PBFOUT1A.12     
!  all processors. (Contrasting with WRITE_MULTI where each                PBFOUT1A.13     
!  processor writes its own local data to a larger global field).          PBFOUT1A.14     
!                                                                          PBFOUT1A.15     
! Method:                                                                  PBFOUT1A.16     
!  The C BUFFOUT is renamed BUFFOUT_SINGLE under *DEF,MPP. This            PBFOUT1A.17     
!  routine causes BUFFOUT_SINGLE to be called by PE 0 only.                PBFOUT1A.18     
!  Note : No check is made that all processors are attempting              PBFOUT1A.19     
!         to write out identical data. It is assumed that the              PBFOUT1A.20     
!         data on PE 0 is the same as that on all other processors.        PBFOUT1A.21     
!                                                                          PBFOUT1A.22     
! Current Code Owner: Paul Burton                                          PBFOUT1A.23     
!                                                                          PBFOUT1A.24     
! History:                                                                 PBFOUT1A.25     
!  Model    Date     Modification history from model version 3.5           PBFOUT1A.26     
!  version                                                                 PBFOUT1A.27     
!    3.5    5/1/95   New DECK created for the Parallel Unified             PBFOUT1A.28     
!                    Model. P.Burton + D.Salmond                           PBFOUT1A.29     
!    4.1    18/3/96  Broadcast return code from I/O                        GPB0F401.261    
!                                                                          PBFOUT1A.30     
! Subroutine Arguments:                                                    PBFOUT1A.31     
                                                                           PBFOUT1A.32     
      INTEGER                                                              PBFOUT1A.33     
     &  NFT          !   IN : FORTRAN unit number                          PBFOUT1A.34     
     & ,LEN_IO       !  OUT : no. of words written out                     PBFOUT1A.35     
     & ,ISIZE        !   IN : no. of words to write out                    PBFOUT1A.36     
                                                                           PBFOUT1A.37     
      REAL                                                                 PBFOUT1A.38     
     &  IOSTAT       !  OUT : Return code                                  PBFOUT1A.39     
     & ,ARRAY(ISIZE) !   IN : Array to write out                           PBFOUT1A.40     
                                                                           PBFOUT1A.41     
! Parameters and Common blocks                                             PBFOUT1A.42     
                                                                           PBFOUT1A.43     
*CALL PARVARS                                                              PBFOUT1A.44     
                                                                           PBFOUT1A.45     
! Local variables                                                          PBFOUT1A.46     
                                                                           PBFOUT1A.47     
      INTEGER info                                                         PBFOUT1A.48     
      REAL stats(2)                                                        GPB0F401.262    
                                                                           GPB0F401.263    
                                                                           PBFOUT1A.49     
! ------------------------------------------------------------------       PBFOUT1A.50     
                                                                           PBFOUT1A.51     
      IOSTAT=-1.0                                                          PBFOUT1A.52     
      LEN_IO=ISIZE                                                         PBFOUT1A.53     
                                                                           PBFOUT1A.54     
      IF (mype .EQ. 0) THEN                                                PBFOUT1A.55     
        CALL BUFFOUT_SINGLE(NFT,ARRAY,ISIZE,LEN_IO,IOSTAT)                 PBFOUT1A.56     
        stats(1)=LEN_IO                                                    GPB0F401.264    
        stats(2)=IOSTAT                                                    GPB0F401.265    
      ENDIF                                                                PBFOUT1A.57     
                                                                           GPB0F401.266    
      CALL GC_RBCAST(521,2,0,nproc,info,stats)                             GPB0F401.267    
      LEN_IO=stats(1)                                                      GPB0F401.268    
      IOSTAT=stats(2)                                                      GPB0F401.269    
                                                                           PBFOUT1A.59     
      RETURN                                                               PBFOUT1A.60     
      END                                                                  PBFOUT1A.61     
                                                                           PBFOUT1A.62     
*ENDIF                                                                     PBFOUT1A.63     
*ENDIF                                                                     GPB3F403.244