*DECK PTULAND
*/ 
*/ This is a FAMOUS mod. 
*/ 
*IF DEF,C90_1A,OR,DEF,C90_2A,OR,DEF,C90_2B
C *****************************COPYRIGHT******************************
C (c) CROWN COPYRIGHT 1996, 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******************************
CLL  SUBROUTINE P_TO_UV---------------------------------------------
CLL
CLL  Purpose:   Interpolates a horizontal land field from pressure to
CLL             wind points on an Arakawa B grid. Under UPDATE
CLL             identifier GLOBAL the data is assumed periodic along
CLL             rows. Otherwise, the last value on each row is set 
CLL             equal to the penultimate value on each row.Output array
CLL             contains one less row than the input array.
CLL
CLL  Not suitable for single column use.
CLL
CLL  Adapted from PTOUV by Nic Gedney (09/99)
CLL
CLL  Model            Modification history from model version 3.0:
CLL version  date
CLL
CLL  Programming standard:  Unified Model Documentation Paper No 3
CLL
CLL
CLLEND-------------------------------------------------------------
 
C
C*L  Arguments:----------------------------------------------------
      SUBROUTINE P_TO_UV_LAND
     1  (P_DATA,U_DATA,P_FIELD,U_FIELD,FLANDG,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 input field
     &, U_FIELD            !IN    Number of points in output field
 
      REAL
     & P_DATA(P_FIELD)     !INOUT Data on p points
     &,U_DATA(U_FIELD)     !OUT   Data on uv points
     &,FLANDG(P_FIELD)      !IN    Fraction of land in grid box.
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
     &  U_POINTS      !     Number of values at u points
     &,I              !     Horizontal loop indices
 
      REAL
     &  TOTFRAC       !     Fractional weighting
C---------------------------------------------------------------------
CL    1.     Initialise local constants
C---------------------------------------------------------------------
 
      U_POINTS      =  ROW_LENGTH * (ROWS-1)
 
C---------------------------------------------------------------------
CL    2.     Calculate horizontal average at u points
C---------------------------------------------------------------------
 
      DO 200 I=1,U_POINTS-1
       TOTFRAC=FLANDG(I)+FLANDG(I+1)+FLANDG(I+ROW_LENGTH) +
     &         FLANDG(I+1+ROW_LENGTH)
       IF(TOTFRAC.GT.0.0)THEN
         U_DATA(I)=FLANDG(I)*P_DATA(I)+FLANDG(I+1)*P_DATA(I+1) +
     &           FLANDG(I+ROW_LENGTH)*P_DATA(I+ROW_LENGTH) +
     &           FLANDG(I+1+ROW_LENGTH)*P_DATA(I+1+ROW_LENGTH)
         U_DATA(I)=U_DATA(I)/TOTFRAC
       ELSE
         U_DATA(I)=0.0
       ENDIF
200   CONTINUE
 
C  End points
 
*IF DEF,GLOBAL
*IF -DEF,MPP
C Cyclic wrap around
      DO 201 I=ROW_LENGTH,U_POINTS,ROW_LENGTH
       TOTFRAC=FLANDG(I)+FLANDG(I+1-ROW_LENGTH)+FLANDG(I+ROW_LENGTH) +
     &           FLANDG(I+1)
       IF(TOTFRAC.GT.0.0)THEN
         U_DATA(I)=FLANDG(I)*P_DATA(I) +
     &           FLANDG(I+1-ROW_LENGTH)*P_DATA(I+1-ROW_LENGTH) +
     &           FLANDG(I+ROW_LENGTH)*P_DATA(I+ROW_LENGTH) +
     &           FLANDG(I+1)*P_DATA(I+1)
         U_DATA(I)=U_DATA(I)/TOTFRAC
       ELSE
         U_DATA(I)=0.0
       ENDIF
201   CONTINUE
*ELSE
! Cyclic wrap around already taken account of via halo
*ENDIF
*ELSE
C Set last values on row
*IF -DEF,MPP
      DO 201 I=ROW_LENGTH,U_POINTS,ROW_LENGTH
       U_DATA(I)=U_DATA(I-1)
201   CONTINUE
*ELSE
       IF (atright) THEN
! Set the last values on row
         DO I=ROW_LENGTH,U_POINTS,ROW_LENGTH
           U_DATA(I-Offx)=U_DATA(I-Offx-1)
         ENDDO
       ENDIF
 
*ENDIF
 
*ENDIF
*IF DEF,MPP
! Set a sensible number in the bottom right corner
      U_DATA(U_POINTS)=U_DATA(U_POINTS-1)
 
*ENDIF
 
      RETURN
      END
*ENDIF
