*IF DEF,C96_1A,OR,DEF,C96_1B GPB3F403.239
*IF DEF,MPP GPB3F403.240
C ******************************COPYRIGHT****************************** GTS2F400.12582
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.12583
C GTS2F400.12584
C Use, duplication or disclosure of this code is subject to the GTS2F400.12585
C restrictions as set forth in the contract. GTS2F400.12586
C GTS2F400.12587
C Meteorological Office GTS2F400.12588
C London Road GTS2F400.12589
C BRACKNELL GTS2F400.12590
C Berkshire UK GTS2F400.12591
C RG12 2SZ GTS2F400.12592
C GTS2F400.12593
C If no contract has been raised with this copy of the code, the use, GTS2F400.12594
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.12595
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.12596
C Modelling at the above address. GTS2F400.12597
C GTS2F400.12598
!+ Parallel UM version of BUFFIN PBFIN1A.3
! PBFIN1A.4
! Subroutine Interface: PBFIN1A.5
SUBROUTINE BUFFIN(NFT,ARRAY,ISIZE,LEN_IO,IOSTAT) 102,2PBFIN1A.6
IMPLICIT NONE PBFIN1A.7
! PBFIN1A.8
! Description: PBFIN1A.9
! This routine provides a BUFFIN routine for the Parallel Unified PBFIN1A.10
! Model. It is used where the same data has to be read in to PBFIN1A.11
! all processors. (Contrasting with READ_MULTI where each PBFIN1A.12
! processor reads its own local data from a larger global field). PBFIN1A.13
! PBFIN1A.14
! Method: PBFIN1A.15
! The C BUFFIN is renamed BUFFIN_SINGLE under *DEF,MPP. This PBFIN1A.16
! routine causes BUFFIN_SINGLE to be called by PE 0 only, and PBFIN1A.17
! then the data is broadcast to all other processors. PBFIN1A.18
! PBFIN1A.19
! Current Code Owner: Paul Burton PBFIN1A.20
! PBFIN1A.21
! History: PBFIN1A.22
! Model Date Modification history from model version 3.5 PBFIN1A.23
! version PBFIN1A.24
! 3.5 5/1/95 New DECK created for the Parallel Unified PBFIN1A.25
! Model. P.Burton + D.Salmond PBFIN1A.26
! 4.1 18/3/96 Broadcast return code from I/O GPB0F401.237
! 4.2 18/11/96 Add *CALL AMAXSIZE before IOVARS P.Burton GPB3F402.66
! 4.2 18/11/96 Ad GPB1F404.48
! 4.4 24/06/97 Remove use of memory aligned buf array - read GPB1F404.49
! data straight into ARRAY P.Burton GPB1F404.50
! 4.5 16/07/98 Added code to get the broadcast flag for ASB1F405.73
! a unit, so that the broadcast of data to ASB1F405.74
! all the PE's can be surpressed if required - ASB1F405.75
! NUMOBS initially. ASB1F405.76
! Authors: Bob Carruthers & Deborah Salmond ASB1F405.77
! Cray Research ASB1F405.78
! PBFIN1A.27
! Subroutine Arguments: PBFIN1A.28
PBFIN1A.29
INTEGER PBFIN1A.30
& NFT ! IN : FORTRAN unit number PBFIN1A.31
& ,LEN_IO ! OUT : no. of words read in PBFIN1A.32
& ,ISIZE ! IN : no. of words to be read in PBFIN1A.33
PBFIN1A.34
REAL PBFIN1A.35
& IOSTAT ! OUT : Return code PBFIN1A.36
& ,ARRAY(ISIZE) ! OUT : Array to read data in to PBFIN1A.37
PBFIN1A.38
! Parameters and Common blocks PBFIN1A.39
PBFIN1A.40
*CALL PARVARS 
PBFIN1A.41
PBFIN1A.42
! Local variables PBFIN1A.43
PBFIN1A.44
INTEGER info GPB1F404.51
REAL return_codes(2) GPB1F404.52
GPB1F404.53
PBFIN1A.46
! ------------------------------------------------------------------ PBFIN1A.47
PBFIN1A.48
IOSTAT=-1.0 PBFIN1A.49
LEN_IO=ISIZE PBFIN1A.50
PBFIN1A.51
GPB1F404.54
IF (mype .EQ. 0) THEN GPB1F404.55
CALL BUFFIN_SINGLE(NFT,ARRAY,ISIZE,LEN_IO,IOSTAT) GPB1F404.56
return_codes(1)=LEN_IO GPB1F404.57
return_codes(2)=IOSTAT GPB1F404.58
ENDIF GPB1F404.59
GPB1F404.60
c--get the broadcast flag ASB1F405.79
call find_unit_bcast_flag(nft, info) ASB1F405.80
c--skip the broadcasts if the flag is set ASB1F405.81
if(info.eq.0) then ASB1F405.82
CALL GC_RBCAST(1,ISIZE,0,nproc,info,ARRAY) ! data GPB1F404.61
CALL GC_RBCAST(2,2,0,nproc,info,return_codes) ! return codes GPB1F404.62
endif ASB1F405.83
ASB1F405.84
GPB1F404.63
LEN_IO=return_codes(1) GPB1F404.64
IOSTAT=return_codes(2) GPB1F404.65
PBFIN1A.57
RETURN PBFIN1A.58
END PBFIN1A.59
PBFIN1A.60
*ENDIF PBFIN1A.61
*ENDIF GPB3F403.241