*IF DEF,C92_1A,OR,DEF,MAKEBC UIE3F404.7
C ******************************COPYRIGHT****************************** GTS2F400.2467
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.2468
C GTS2F400.2469
C Use, duplication or disclosure of this code is subject to the GTS2F400.2470
C restrictions as set forth in the contract. GTS2F400.2471
C GTS2F400.2472
C Meteorological Office GTS2F400.2473
C London Road GTS2F400.2474
C BRACKNELL GTS2F400.2475
C Berkshire UK GTS2F400.2476
C RG12 2SZ GTS2F400.2477
C GTS2F400.2478
C If no contract has been raised with this copy of the code, the use, GTS2F400.2479
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.2480
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.2481
C Modelling at the above address. GTS2F400.2482
C ******************************COPYRIGHT****************************** GTS2F400.2483
C GTS2F400.2484
CLL Subroutine EQTOLL------------------------------------------------- EQTOLL1A.3
CLL EQTOLL1A.4
CLL Purpose: Calculates latitude and longitude on standard grid EQTOLL1A.5
CLL from input arrays of latitude and longitude on EQTOLL1A.6
CLL equatorial latitude-longitude (eq) grid used EQTOLL1A.7
CLL in regional models. Both input and output latitudes EQTOLL1A.8
CLL and longitudes are in degrees. EQTOLL1A.9
CLL EQTOLL1A.10
CLL Written by A. Dickinson EQTOLL1A.11
CLL EQTOLL1A.12
CLL Model Modification history from model version 3.0: EQTOLL1A.13
CLL version Date EQTOLL1A.14
CLL EQTOLL1A.15
CLL Documentation: The transformation formulae are described in EQTOLL1A.16
CLL unified model on-line documentation paper S1. EQTOLL1A.17
CLL EQTOLL1A.18
CLL Logical components covered : S131 EQTOLL1A.19
CLL EQTOLL1A.20
CLL Project task : EQTOLL1A.21
CLL EQTOLL1A.22
CLL External documentation: EQTOLL1A.23
CLL EQTOLL1A.24
CLLEND----------------------------------------------------------------- EQTOLL1A.25
C EQTOLL1A.26
C*L Arguments:-------------------------------------------------------- EQTOLL1A.27
SUBROUTINE EQTOLL 16EQTOLL1A.28
*(PHI_EQ,LAMBDA_EQ,PHI,LAMBDA,PHI_POLE,LAMBDA_POLE,POINTS) EQTOLL1A.29
EQTOLL1A.30
IMPLICIT NONE EQTOLL1A.31
EQTOLL1A.32
INTEGER EQTOLL1A.33
* POINTS !IN Number of points to be processed EQTOLL1A.34
EQTOLL1A.35
REAL EQTOLL1A.36
* PHI(POINTS) !OUT Latitude EQTOLL1A.37
*,LAMBDA(POINTS) !OUT Longitude (0 =< LON < 360) EQTOLL1A.38
*,LAMBDA_EQ(POINTS) !IN Longitude in equatorial lat-lon coords EQTOLL1A.39
*,PHI_EQ(POINTS) !IN Latitude in equatorial lat-lon coords EQTOLL1A.40
*,PHI_POLE !IN Latitude of equatorial lat-lon pole EQTOLL1A.41
*,LAMBDA_POLE !IN Longitude of equatorial lat-lon pole EQTOLL1A.42
EQTOLL1A.43
C Workspace usage:----------------------------------------------------- EQTOLL1A.44
C None EQTOLL1A.45
C---------------------------------------------------------------------- EQTOLL1A.46
C External subroutines called:----------------------------------------- EQTOLL1A.47
C None EQTOLL1A.48
C*--------------------------------------------------------------------- EQTOLL1A.49
C Local varables:------------------------------------------------------ EQTOLL1A.50
REAL E_LAMBDA,E_PHI,A_LAMBDA,ARG,A_PHI,SIN_PHI_POLE,COS_PHI_POLE EQTOLL1A.51
REAL TERM1,TERM2,SMALL,LAMBDA_ZERO EQTOLL1A.52
INTEGER I EQTOLL1A.53
PARAMETER(SMALL=1.0E-6) EQTOLL1A.54
C---------------------------------------------------------------------- EQTOLL1A.55
C Constants from comdecks:--------------------------------------------- EQTOLL1A.56
*CALL C_PI 
EQTOLL1A.57
C---------------------------------------------------------------------- EQTOLL1A.58
EQTOLL1A.59
CL 1. Initialise local constants EQTOLL1A.60
C EQTOLL1A.61
C Latitude of zeroth meridian EQTOLL1A.62
LAMBDA_ZERO=LAMBDA_POLE+180. EQTOLL1A.63
C Sine and cosine of latitude of eq pole EQTOLL1A.64
SIN_PHI_POLE=SIN(PI_OVER_180*PHI_POLE) EQTOLL1A.65
COS_PHI_POLE=COS(PI_OVER_180*PHI_POLE) EQTOLL1A.66
EQTOLL1A.67
CL 2. Transform from equatorial to standard latitude-longitude EQTOLL1A.68
EQTOLL1A.69
DO 200 I= 1,POINTS EQTOLL1A.70
EQTOLL1A.71
C Scale eq longitude to range -180 to +180 degs EQTOLL1A.72
EQTOLL1A.73
E_LAMBDA=LAMBDA_EQ(I) EQTOLL1A.74
IF(E_LAMBDA.GT. 180.0) E_LAMBDA=E_LAMBDA-360.0 EQTOLL1A.75
IF(E_LAMBDA.LT.-180.0) E_LAMBDA=E_LAMBDA+360.0 EQTOLL1A.76
EQTOLL1A.77
C Convert eq latitude & longitude to radians EQTOLL1A.78
EQTOLL1A.79
E_LAMBDA=PI_OVER_180*E_LAMBDA EQTOLL1A.80
E_PHI=PI_OVER_180*PHI_EQ(I) EQTOLL1A.81
EQTOLL1A.82
C Compute latitude using equation (4.7) EQTOLL1A.83
EQTOLL1A.84
ARG=COS_PHI_POLE*COS(E_LAMBDA)*COS(E_PHI) EQTOLL1A.85
* +SIN(E_PHI)*SIN_PHI_POLE EQTOLL1A.86
ARG=MIN(ARG, 1.0) EQTOLL1A.87
ARG=MAX(ARG,-1.0) EQTOLL1A.88
A_PHI=ASIN(ARG) EQTOLL1A.89
PHI(I)=RECIP_PI_OVER_180*A_PHI EQTOLL1A.90
EQTOLL1A.91
C Compute longitude using equation (4.8) EQTOLL1A.92
EQTOLL1A.93
TERM1 =(COS(E_PHI)*COS(E_LAMBDA)*SIN_PHI_POLE EQTOLL1A.94
* -SIN(E_PHI)*COS_PHI_POLE) EQTOLL1A.95
TERM2=COS(A_PHI) EQTOLL1A.96
IF(TERM2.LT.SMALL) THEN EQTOLL1A.97
A_LAMBDA=0.0 EQTOLL1A.98
ELSE EQTOLL1A.99
ARG=TERM1/TERM2 EQTOLL1A.100
ARG=MIN(ARG, 1.0) EQTOLL1A.101
ARG=MAX(ARG,-1.0) EQTOLL1A.102
A_LAMBDA=RECIP_PI_OVER_180*ACOS(ARG) EQTOLL1A.103
A_LAMBDA=SIGN(A_LAMBDA,E_LAMBDA) EQTOLL1A.104
A_LAMBDA=A_LAMBDA+LAMBDA_ZERO EQTOLL1A.105
END IF EQTOLL1A.106
EQTOLL1A.107
C Scale longitude to range 0 to 360 degs EQTOLL1A.108
EQTOLL1A.109
IF(A_LAMBDA.GE.360.0) A_LAMBDA=A_LAMBDA-360.0 EQTOLL1A.110
IF(A_LAMBDA.LT.0.0) A_LAMBDA=A_LAMBDA+360.0 EQTOLL1A.111
LAMBDA(I)=A_LAMBDA EQTOLL1A.112
EQTOLL1A.113
200 CONTINUE EQTOLL1A.114
EQTOLL1A.115
RETURN EQTOLL1A.116
END EQTOLL1A.117
*ENDIF EQTOLL1A.118