*IF DEF,C92_1A,OR,DEF,MAKEBC UIE3F404.65
C ******************************COPYRIGHT****************************** GTS2F400.11899
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.11900
C GTS2F400.11901
C Use, duplication or disclosure of this code is subject to the GTS2F400.11902
C restrictions as set forth in the contract. GTS2F400.11903
C GTS2F400.11904
C Meteorological Office GTS2F400.11905
C London Road GTS2F400.11906
C BRACKNELL GTS2F400.11907
C Berkshire UK GTS2F400.11908
C RG12 2SZ GTS2F400.11909
C GTS2F400.11910
C If no contract has been raised with this copy of the code, the use, GTS2F400.11911
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.11912
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.11913
C Modelling at the above address. GTS2F400.11914
C ******************************COPYRIGHT****************************** GTS2F400.11915
C GTS2F400.11916
CLL Subroutine W_COEFF------------------------------------------------ WCOEFF1A.3
CLL WCOEFF1A.4
CLL Purpose: WCOEFF1A.5
CLL Calculates coefficients used to translate u and v compo- WCOEFF1A.6
CLL nents of wind between equatorial (eq) latitude-longitude WCOEFF1A.7
CLL grid and standard latitude-longitude grid (or visa versa). WCOEFF1A.8
CLL Input latitudes and longitudes are in degrees. WCOEFF1A.9
CLL WCOEFF1A.10
CLL Written by A. Dickinson WCOEFF1A.11
CLL WCOEFF1A.12
CLL Model Modification history from model version 3.0: WCOEFF1A.13
CLL version date WCOEFF1A.14
CLL 4.5 2/07/98 Correction for special case when no rotation occurs ie URR1F405.1
CLL rotated grid is identical to original. R. Rawlins URR1F405.2
CLL WCOEFF1A.15
CLL Documentation: The transformation formulae are described in WCOEFF1A.16
CLL unified model on-line documentation paper S1. WCOEFF1A.17
CLL WCOEFF1A.18
CLL ------------------------------------------------------------------ WCOEFF1A.19
C WCOEFF1A.20
C*L Arguments:-------------------------------------------------------- WCOEFF1A.21
SUBROUTINE W_COEFF 8WCOEFF1A.22
*(COEFF1,COEFF2,LAMBDA,LAMBDA_EQ,PHI_POLE,LAMBDA_POLE,POINTS) WCOEFF1A.23
WCOEFF1A.24
IMPLICIT NONE WCOEFF1A.25
WCOEFF1A.26
INTEGER WCOEFF1A.27
* POINTS !IN Number of points to be processed WCOEFF1A.28
WCOEFF1A.29
REAL WCOEFF1A.30
* COEFF1(POINTS) !OUT Coefficient of rotation no 1 WCOEFF1A.31
*,COEFF2(POINTS) !OUT Coefficient of rotation no 2 WCOEFF1A.32
*,LAMBDA(POINTS) !IN Longitude WCOEFF1A.33
*,LAMBDA_EQ(POINTS) !IN Longitude in equatorial lat-lon coords WCOEFF1A.34
*,PHI_POLE !IN Latitude of equatorial lat-lon pole WCOEFF1A.35
*,LAMBDA_POLE !IN Longitude of equatorial lat-lon pole WCOEFF1A.36
C Workspace usage:----------------------------------------------------- WCOEFF1A.37
C None WCOEFF1A.38
C---------------------------------------------------------------------- WCOEFF1A.39
C External subroutines called:----------------------------------------- WCOEFF1A.40
C None WCOEFF1A.41
C*--------------------------------------------------------------------- WCOEFF1A.42
C Define local varables:----------------------------------------------- WCOEFF1A.43
REAL A_LAMBDA,E_LAMBDA,SIN_E_LAMBDA,SIN_PHI_POLE WCOEFF1A.44
* ,COS_PHI_POLE,C1,C2,LAMBDA_ZERO WCOEFF1A.45
INTEGER I WCOEFF1A.46
C---------------------------------------------------------------------- WCOEFF1A.47
C Constants from comdecks:--------------------------------------------- WCOEFF1A.48
*CALL C_PI 
WCOEFF1A.49
C---------------------------------------------------------------------- WCOEFF1A.50
WCOEFF1A.51
CL 0.1 Check for special case of no rotation (or complete N-S rotation) URR1F405.3
C URR1F405.4
URR1F405.5
IF(ABS(PHI_POLE).LT.90.) THEN ! Normal rotation URR1F405.6
URR1F405.7
CL 1. Initialise local constants WCOEFF1A.52
C WCOEFF1A.53
C Longitude of zeroth meridian WCOEFF1A.54
LAMBDA_ZERO=LAMBDA_POLE+180. WCOEFF1A.55
WCOEFF1A.56
C Sine and cosine of latitude of eq pole WCOEFF1A.57
WCOEFF1A.58
SIN_PHI_POLE=SIN(PI_OVER_180*PHI_POLE) WCOEFF1A.59
COS_PHI_POLE=COS(PI_OVER_180*PHI_POLE) WCOEFF1A.60
WCOEFF1A.61
CL 2. Evaluate translation coefficients WCOEFF1A.62
C WCOEFF1A.63
DO 200 I=1,POINTS WCOEFF1A.64
WCOEFF1A.65
C Actual longitude converted to radians WCOEFF1A.66
WCOEFF1A.67
A_LAMBDA=PI_OVER_180*(LAMBDA(I)-LAMBDA_ZERO) WCOEFF1A.68
WCOEFF1A.69
C Convert eq longitude to radians and take sine WCOEFF1A.70
WCOEFF1A.71
E_LAMBDA=LAMBDA_EQ(I)*PI_OVER_180 WCOEFF1A.72
SIN_E_LAMBDA=SIN(E_LAMBDA) WCOEFF1A.73
WCOEFF1A.74
C Formulae used are from eqs (4.19) and (4.21) WCOEFF1A.75
WCOEFF1A.76
C1=SIN(A_LAMBDA)*SIN_E_LAMBDA*SIN_PHI_POLE WCOEFF1A.77
* +COS(A_LAMBDA)*COS(E_LAMBDA) WCOEFF1A.78
COEFF1(I)=C1 WCOEFF1A.79
C2=SQRT(1.0-C1*C1) WCOEFF1A.80
COEFF2(I)=SIGN(C2,SIN_E_LAMBDA) WCOEFF1A.81
WCOEFF1A.82
200 CONTINUE WCOEFF1A.83
URR1F405.8
ELSE ! Special case: no rotation (or complete N-S rotation) URR1F405.9
URR1F405.10
C1=SIGN(1.0,PHI_POLE) ! =1.0 if no rotation URR1F405.11
DO I=1,POINTS URR1F405.12
COEFF1(I)=C1 URR1F405.13
COEFF2(I)=0. URR1F405.14
ENDDO URR1F405.15
URR1F405.16
ENDIF ! End of test for special case of no rotation URR1F405.17
WCOEFF1A.84
RETURN WCOEFF1A.85
END WCOEFF1A.86
*ENDIF WCOEFF1A.87