*DECK UTPSEA
*IF DEF,C90_1A,OR,DEF,C90_2A,OR,DEF,C90_2B
C ******************************COPYRIGHT******************************
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.
C
C Use, duplication or disclosure of this code is subject to the
C restrictions as set forth in the contract.
C
C                Meteorological Office
C                London Road
C                BRACKNELL
C                Berkshire UK
C                RG12 2SZ
C
C If no contract has been raised with this copy of the code, the use,
C duplication or disclosure of it is strictly prohibited.  Permission
C to do so must first be obtained in writing from the Head of Numerical
C Modelling at the above address.
C ******************************COPYRIGHT******************************
C
CLL  SUBROUTINE UV_TO_P_SEA-----------------------------------------
CLL
CLL  Purpose:   Interpolates a horizontal sea field from wind to 
CLL             pressure points on an Arakawa B grid. Under UPDATE
CLL             identifier GLOBAL the data is assumed periodic along
CLL             rows. Otherwise, the first value on each row is set
CLL             eqal to the second value on each row . The output arra
CLL             contains one less row than the input array.
CLL
CLL  Not suitable for single column use.
CLL
CLL  Adapted from UVTOP by Nic Gedney (09/99)
CLL
CLL  Programming standard: Unified Model Documentation Paper No 3
CLL                        Version No 1 15/1/90
CLL
CLL  System component: S101
CLL
CLL  System task: S1
CLL
CLL  Documentation:  The equation it is based on is (2.1)
CLL                  in unified model documentation paper No. S1
CLL
CLLEND-------------------------------------------------------------
 
C
C*L  Arguments:---------------------------------------------------
      SUBROUTINE UV_TO_P_SEA
     1  (U_DATA,P_DATA,U_FIELD,P_FIELD,FLANDG_UV,ROW_LENGTH,ROWS)
 
      IMPLICIT NONE
 
      INTEGER
     *  ROWS               !IN    Number of rows to be updated.
     *, ROW_LENGTH         !IN    Number of points per row
     *, P_FIELD            !IN    Number of points in output field
     *, U_FIELD            !IN    Number of points in input field
 
      REAL
     * P_DATA(P_FIELD)     !OUT   Data on p  points
     *,U_DATA(U_FIELD)     !IN    Data on uv points
     *,FLANDG_UV(U_FIELD)   !IN    Land fraction on uv points
C*---------------------------------------------------------------------
 
C*L  Local arrays:-----------------------------------------------------
C    None
C*---------------------------------------------------------------------
*IF DEF,MPP
! Parameters and Common blocks
*CALL PARVARS
*ENDIF
 
C*L  External subroutine calls:----------------------------------------
C    None
C*---------------------------------------------------------------------
 
C----------------------------------------------------------------------
C    Define local variables
C----------------------------------------------------------------------
      INTEGER
     *  P_POINTS      !     Number of values at p points
     *,I              !     Horizontal loop indices
      REAL
     &  TOTFRAC
*IF DEF,MPP
      INTEGER J,extra
*ENDIF
 
C---------------------------------------------------------------------
CL    1.     Initialise local constants
C---------------------------------------------------------------------
 
      P_POINTS      =  ROW_LENGTH * (ROWS-1)
 
C---------------------------------------------------------------------
CL    2.     Calculate horizontal average at p points
C---------------------------------------------------------------------
 
      DO 200 I=2,P_POINTS
       TOTFRAC=4.0-(FLANDG_UV(I)+FLANDG_UV(I-1) +
     &         FLANDG_UV(I+ROW_LENGTH)+FLANDG_UV(I-1+ROW_LENGTH))
       IF(TOTFRAC.GT.0.0)THEN
         P_DATA(I)=(1.-FLANDG_UV(I))*U_DATA(I) +
     &           (1.-FLANDG_UV(I-1))*U_DATA(I-1) +
     &           (1.-FLANDG_UV(I+ROW_LENGTH))*U_DATA(I+ROW_LENGTH) +
     &           (1.-FLANDG_UV(I-1+ROW_LENGTH))*U_DATA(I-1+ROW_LENGTH)
         P_DATA(I)=P_DATA(I)/TOTFRAC
       ELSE
         P_DATA(I)=0.0
       ENDIF
200   CONTINUE
 
C  End points
 
*IF DEF,GLOBAL
 
*IF -DEF,MPP
      DO 201 I=1,P_POINTS,ROW_LENGTH
       TOTFRAC=4.0-(FLANDG_UV(I)+FLANDG_UV(I-1+ROW_LENGTH) +
     &         FLANDG_UV(I+ROW_LENGTH)+FLANDG_UV(I-1+2*ROW_LENGTH))
       IF(TOTFRAC.GT.0.0)THEN
         P_DATA(I)=(1.-FLANDG_UV(I))*U_DATA(I) +
     &         (1.-FLANDG_UV(I-1+ROW_LENGTH))*U_DATA(I-1+ROW_LENGTH) +
     &         (1.-FLANDG_UV(I+ROW_LENGTH))*U_DATA(I+ROW_LENGTH) +
     &         (1.-FLANDG_UV(I-1+2*ROW_LENGTH))*U_DATA(I-1+2*ROW_LENGTH)
         P_DATA(I)=P_DATA(I)/TOTFRAC
       ELSE
         P_DATA(I)=0.0
       ENDIF
201   CONTINUE
*ELSE
!  Cyclic wrap around already taken account of via halo
*ENDIF
*ELSE
C Set first values on each row equal to second values
*IF -DEF,MPP
      DO 201 I=1,P_POINTS,ROW_LENGTH
       P_DATA(I)=P_DATA(I+1)
201   CONTINUE
*ELSE
        IF (atleft) THEN
          DO I=1,P_POINTS,ROW_LENGTH
            P_DATA(I+Offx)=P_DATA(I+Offx+1)
          ENDDO
        ENDIF
*ENDIF
 
*ENDIF
*IF DEF,MPP
! and set a sensible number in the top left corner
      P_DATA(1)=P_DATA(2)
 
*ENDIF
 
      RETURN
      END
 
*ENDIF
