*IF DEF,C90_1A,OR,DEF,C90_2A,OR,DEF,C90_2B AAD2F404.295
C ******************************COPYRIGHT****************************** GTS2F400.7777
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.7778
C GTS2F400.7779
C Use, duplication or disclosure of this code is subject to the GTS2F400.7780
C restrictions as set forth in the contract. GTS2F400.7781
C GTS2F400.7782
C Meteorological Office GTS2F400.7783
C London Road GTS2F400.7784
C BRACKNELL GTS2F400.7785
C Berkshire UK GTS2F400.7786
C RG12 2SZ GTS2F400.7787
C GTS2F400.7788
C If no contract has been raised with this copy of the code, the use, GTS2F400.7789
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.7790
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.7791
C Modelling at the above address. GTS2F400.7792
C ******************************COPYRIGHT****************************** GTS2F400.7793
C GTS2F400.7794
CLL SUBROUTINE P_TO_CU--------------------------------------------- PTOCU1A.3
CLL PTOCU1A.4
CLL Purpose: Interpolates a horizontal field from pressure to wind PTOCU1A.5
CLL points on an Arakawa C grid. This routine carries out PTOCU1A.6
CLL E-W interpolation to u-point. Under UPDATE PTOCU1A.7
CLL identifier GLOBAL the data is assumed periodic along PTOCU1A.8
CLL rows. Otherwise, the first and last value on each row are PTOCU1A.9
CLL calculated using one-sided differencing. PTOCU1A.10
CLL PTOCU1A.11
CLL Not suitable for single column use. PTOCU1A.12
CLL PTOCU1A.13
CLL Written 12/9/91 by A. Dickinson PTOCU1A.14
CLL PTOCU1A.15
CLL Model Modification history from model version 3.0: PTOCU1A.16
CLL version date PTOCU1A.17
CLL PTOCU1A.18
CLL Programming standard: Unified Model Documentation Paper No 3 PTOCU1A.19
CLL Version No 3 18/12/90 PTOCU1A.20
CLL PTOCU1A.21
CLL System component: S101 PTOCU1A.22
CLL PTOCU1A.23
CLL System task: S1 PTOCU1A.24
CLL PTOCU1A.25
CLL Documentation: The equation used is (2.1) PTOCU1A.26
CLL in unified model documentation paper No. S1 PTOCU1A.27
CLL PTOCU1A.28
CLLEND------------------------------------------------------------- PTOCU1A.29
PTOCU1A.30
C PTOCU1A.31
C*L Arguments:--------------------------------------------------- PTOCU1A.32
SUBROUTINE P_TO_CU 1PTOCU1A.33
1 (P_DATA,U_DATA,P_FIELD,U_FIELD,ROW_LENGTH,ROWS) PTOCU1A.34
PTOCU1A.35
IMPLICIT NONE PTOCU1A.36
PTOCU1A.37
INTEGER PTOCU1A.38
* ROWS !IN Number of rows to be updated. PTOCU1A.39
*, ROW_LENGTH !IN Number of points per row PTOCU1A.40
*, P_FIELD !IN Number of points in input field PTOCU1A.41
*, U_FIELD !IN Number of points in output field PTOCU1A.42
PTOCU1A.43
REAL PTOCU1A.44
* P_DATA(P_FIELD) !INOUT Data on p points PTOCU1A.45
*,U_DATA(U_FIELD) ! OUT Data on uv points PTOCU1A.46
C*--------------------------------------------------------------------- PTOCU1A.47
PTOCU1A.48
C*L Local arrays:----------------------------------------------------- PTOCU1A.49
C None PTOCU1A.50
C*--------------------------------------------------------------------- PTOCU1A.51
PTOCU1A.52
C*L External subroutine calls:--------------------------------------- PTOCU1A.53
C None PTOCU1A.54
C*--------------------------------------------------------------------- PTOCU1A.55
PTOCU1A.56
C---------------------------------------------------------------------- PTOCU1A.57
C Define local variables PTOCU1A.58
C---------------------------------------------------------------------- PTOCU1A.59
INTEGER PTOCU1A.60
* U_POINTS ! Number of values at u points PTOCU1A.61
*,I,M ! Horizontal loop indices PTOCU1A.62
PTOCU1A.63
C--------------------------------------------------------------------- PTOCU1A.64
CL 1. Initialise local constants PTOCU1A.65
C--------------------------------------------------------------------- PTOCU1A.66
PTOCU1A.67
U_POINTS = ROW_LENGTH * ROWS PTOCU1A.68
PTOCU1A.69
C--------------------------------------------------------------------- PTOCU1A.70
CL 2. Calculate horizontal average at u points PTOCU1A.71
C--------------------------------------------------------------------- PTOCU1A.72
PTOCU1A.73
DO 200 I=1,U_POINTS-1 PTOCU1A.74
U_DATA(I)=0.5*(P_DATA(I)+P_DATA(I+1)) PTOCU1A.75
200 CONTINUE PTOCU1A.76
PTOCU1A.77
C End points PTOCU1A.78
PTOCU1A.79
*IF DEF,GLOBAL PTOCU1A.80
C Cyclic wrap around PTOCU1A.81
DO 201 I=ROW_LENGTH,U_POINTS,ROW_LENGTH PTOCU1A.82
U_DATA(I)=0.5*(P_DATA(I)+P_DATA(I+1-ROW_LENGTH)) PTOCU1A.83
201 CONTINUE PTOCU1A.84
*ELSE PTOCU1A.85
C One sided differences PTOCU1A.86
DO 201 I=ROW_LENGTH,U_POINTS,ROW_LENGTH PTOCU1A.87
M=I-ROW_LENGTH+1 PTOCU1A.88
U_DATA(I)=2.*U_DATA(I-1)-U_DATA(I-2) PTOCU1A.89
U_DATA(M)=2.*U_DATA(M+1)-U_DATA(M+2) PTOCU1A.90
201 CONTINUE PTOCU1A.91
PTOCU1A.92
PTOCU1A.93
*ENDIF PTOCU1A.94
PTOCU1A.95
RETURN PTOCU1A.96
END PTOCU1A.97
*ENDIF PTOCU1A.98