*IF DEF,C90_1A,OR,DEF,C90_2A,OR,DEF,C90_2B AAD2F404.289
C ******************************COPYRIGHT****************************** GTS2F400.10927
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.10928
C GTS2F400.10929
C Use, duplication or disclosure of this code is subject to the GTS2F400.10930
C restrictions as set forth in the contract. GTS2F400.10931
C GTS2F400.10932
C Meteorological Office GTS2F400.10933
C London Road GTS2F400.10934
C BRACKNELL GTS2F400.10935
C Berkshire UK GTS2F400.10936
C RG12 2SZ GTS2F400.10937
C GTS2F400.10938
C If no contract has been raised with this copy of the code, the use, GTS2F400.10939
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.10940
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.10941
C Modelling at the above address. GTS2F400.10942
C ******************************COPYRIGHT****************************** GTS2F400.10943
C GTS2F400.10944
CLL SUBROUTINE UV_TO_P--------------------------------------------- UVTOP1A.3
CLL UVTOP1A.4
CLL Purpose: Interpolates a horizontal field from wind to pressure UVTOP1A.5
CLL points on an Arakawa B grid. Under UPDATE UVTOP1A.6
CLL identifier GLOBAL the data is assumed periodic along UVTOP1A.7
CLL rows. Otherwise, the first value on each row is set CW250393.9
CLL eqal to the second value on each row . The output arra CW250393.10
CLL contains one less row than the input array. UVTOP1A.10
CLL UVTOP1A.11
CLL Not suitable for single column use. UVTOP1A.12
CLL UVTOP1A.13
CLL Written by A. Dickinson UVTOP1A.14
CLL UVTOP1A.15
CLL Model Modification history from model version 3.0: UVTOP1A.16
CLL version date UVTOP1A.17
CLL 3.2 25/03/93 Removed one-sided differencing for first and last CW250393.11
CLL points if not global. CW250393.12
CLL Author: C.A.Wilson Reviewer: A.Dickinson CW250393.13
! 3.5 28/03/95 MPP code: Take account of halos P.Burton APB0F305.95
! 4.1 02/04/96 Modifications to MPP code P.Burton APB0F401.132
! 4.2 10/10/96 Extra brackets to ensure bit-reproducability APB1F402.35
! between single/multi-processor runs. D. Robinson APB1F402.36
CLL UVTOP1A.18
CLL Programming standard: Unified Model Documentation Paper No 3 UVTOP1A.19
CLL Version No 1 15/1/90 UVTOP1A.20
CLL UVTOP1A.21
CLL System component: S101 UVTOP1A.22
CLL UVTOP1A.23
CLL System task: S1 UVTOP1A.24
CLL UVTOP1A.25
CLL Documentation: The equation used is (2.1) UVTOP1A.26
CLL in unified model documentation paper No. S1 UVTOP1A.27
CLL UVTOP1A.28
CLLEND------------------------------------------------------------- UVTOP1A.29
UVTOP1A.30
C UVTOP1A.31
C*L Arguments:--------------------------------------------------- UVTOP1A.32
SUBROUTINE UV_TO_P 63UVTOP1A.33
1 (U_DATA,P_DATA,U_FIELD,P_FIELD,ROW_LENGTH,ROWS) UVTOP1A.34
UVTOP1A.35
IMPLICIT NONE UVTOP1A.36
UVTOP1A.37
INTEGER UVTOP1A.38
* ROWS !IN Number of rows to be updated. UVTOP1A.39
*, ROW_LENGTH !IN Number of points per row UVTOP1A.40
*, P_FIELD !IN Number of points in output field UVTOP1A.41
*, U_FIELD !IN Number of points in input field UVTOP1A.42
UVTOP1A.43
REAL UVTOP1A.44
* P_DATA(P_FIELD) ! OUT Data on p points UVTOP1A.45
*,U_DATA(U_FIELD) !IN Data on uv points UVTOP1A.46
C*--------------------------------------------------------------------- UVTOP1A.47
UVTOP1A.48
C*L Local arrays:---------------------------------------------------- UVTOP1A.49
C None UVTOP1A.50
C*--------------------------------------------------------------------- UVTOP1A.51
*IF DEF,MPP APB0F305.96
! Parameters and Common blocks APB0F305.97
*CALL PARVARS 
APB0F305.98
*ENDIF APB0F305.99
UVTOP1A.52
C*L External subroutine calls:---------------------------------------- UVTOP1A.53
C None UVTOP1A.54
C*--------------------------------------------------------------------- UVTOP1A.55
UVTOP1A.56
C---------------------------------------------------------------------- UVTOP1A.57
C Define local variables UVTOP1A.58
C---------------------------------------------------------------------- UVTOP1A.59
INTEGER UVTOP1A.60
* P_POINTS ! Number of values at p points UVTOP1A.61
*,I ! Horizontal loop indices CW250393.14
*IF DEF,MPP APB0F305.100
INTEGER J,extra APB0F305.101
*ENDIF APB0F305.102
UVTOP1A.63
C--------------------------------------------------------------------- UVTOP1A.64
CL 1. Initialise local constants UVTOP1A.65
C--------------------------------------------------------------------- UVTOP1A.66
UVTOP1A.67
P_POINTS = ROW_LENGTH * (ROWS-1) UVTOP1A.68
UVTOP1A.69
C--------------------------------------------------------------------- UVTOP1A.70
CL 2. Calculate horizontal average at p points UVTOP1A.71
C--------------------------------------------------------------------- UVTOP1A.72
UVTOP1A.73
DO 200 I=2,P_POINTS UVTOP1A.74
P_DATA(I)=0.25*( ( U_DATA(I)+U_DATA(I-1) ) + APB1F402.37
& ( U_DATA(I+ROW_LENGTH)+U_DATA(I-1+ROW_LENGTH) ) ) APB1F402.38
200 CONTINUE UVTOP1A.77
UVTOP1A.78
C End points UVTOP1A.79
UVTOP1A.80
*IF DEF,GLOBAL UVTOP1A.81
UVTOP1A.82
*IF -DEF,MPP APB0F305.103
DO 201 I=1,P_POINTS,ROW_LENGTH UVTOP1A.83
P_DATA(I)=0.25*( ( U_DATA(I)+U_DATA(I-1+ROW_LENGTH) ) + APB1F402.39
& ( U_DATA(I+ROW_LENGTH)+U_DATA(I-1+2*ROW_LENGTH) ) ) APB1F402.40
201 CONTINUE UVTOP1A.86
*ELSE APB0F305.104
! Cyclic wrap around already taken account of via halo APB0F305.105
*ENDIF APB0F305.106
*ELSE UVTOP1A.87
C Set first values on each row equal to second values CW250393.15
*IF -DEF,MPP APB0F305.107
DO 201 I=1,P_POINTS,ROW_LENGTH CW250393.16
P_DATA(I)=P_DATA(I+1) CW250393.17
201 CONTINUE UVTOP1A.93
*ELSE APB0F305.108
IF (atleft) THEN APB0F305.109
DO I=1,P_POINTS,ROW_LENGTH APB0F305.110
P_DATA(I+Offx)=P_DATA(I+Offx+1) APB0F305.111
ENDDO APB0F305.112
ENDIF APB0F305.113
*ENDIF APB0F305.117
UVTOP1A.94
*ENDIF UVTOP1A.95
*IF DEF,MPP APB0F401.133
! and set a sensible number in the top left corner APB0F401.134
P_DATA(1)=P_DATA(2) APB0F401.135
APB0F401.136
*ENDIF APB0F401.137
UVTOP1A.96
RETURN UVTOP1A.97
END UVTOP1A.98
UVTOP1A.99
*ENDIF UVTOP1A.100