*IF DEF,C93_1A,OR,DEF,C93_2A GNF0F402.14
C ******************************COPYRIGHT****************************** GTS2F400.3799
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.3800
C GTS2F400.3801
C Use, duplication or disclosure of this code is subject to the GTS2F400.3802
C restrictions as set forth in the contract. GTS2F400.3803
C GTS2F400.3804
C Meteorological Office GTS2F400.3805
C London Road GTS2F400.3806
C BRACKNELL GTS2F400.3807
C Berkshire UK GTS2F400.3808
C RG12 2SZ GTS2F400.3809
C GTS2F400.3810
C If no contract has been raised with this copy of the code, the use, GTS2F400.3811
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.3812
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.3813
C Modelling at the above address. GTS2F400.3814
C ******************************COPYRIGHT****************************** GTS2F400.3815
C GTS2F400.3816
CLL SUBROUTINE H_GRAD-------------------------------------------------- HGRAD1A.3
CLL HGRAD1A.4
CLL PURPOSE: Calculates the linear horizontal gradients of a field HGRAD1A.5
CLL Tested under compiler CFT77 HGRAD1A.6
CLL Tested under OS version 5.1 HGRAD1A.7
CLL HGRAD1A.8
CLL Author J.T.Heming HGRAD1A.9
CLL HGRAD1A.10
CLL Code version 1.0 Date 22/02/91 HGRAD1A.11
CLL HGRAD1A.12
CLL Model Modification history from model version 3.0: HGRAD1A.13
CLL version date HGRAD1A.14
CLL vn4.2 07/11/96:Allow this routine to be used in C93_2A (Farnon) GNF0F402.13
CLL HGRAD1A.15
CLL vn4.2 18/03/97:MPP Changes - now hard-wired for U_Fields GSM3F403.400
CLL S.D. Mullerworth GSM3F403.401
!LL vn4.5 17/04/98 Make sure corner points initialised (FIRST_FLD_PT GSM1F405.585
!LL etc.) so routine is it into line with loop GSM1F405.586
!LL ranges in CAT S.D.Mullerworth GSM1F405.587
CLL Logical components covered HGRAD1A.16
CLL Project TASK: HGRAD1A.17
CLL HGRAD1A.18
CLL Programming standard: U M DOC Paper NO. 4, HGRAD1A.19
CLL HGRAD1A.20
CLL External documentation HGRAD1A.21
CLL HGRAD1A.22
CLLEND------------------------------------------------------------------ HGRAD1A.23
C HGRAD1A.24
C*L ARGUMENTS:--------------------------------------------------------- HGRAD1A.25
SUBROUTINE H_GRAD( 2HGRAD1A.26
*CALL ARGFLDPT 
GSM3F403.402
C data and constants in HGRAD1A.27
& N,POINTS,SEC_LATITUDE,ROW_LENGTH,EW_SPACE,NS_SPACE, HGRAD1A.28
C data out HGRAD1A.29
& DN_DX,DN_DY) HGRAD1A.30
C* HGRAD1A.31
C*L HGRAD1A.32
C----------------------------------------------------------------------- HGRAD1A.33
IMPLICIT NONE HGRAD1A.34
C----------------------------------------------------------------------- HGRAD1A.35
INTEGER HGRAD1A.36
* POINTS ! IN NO OF POINTS ON REQUIRED GRID HGRAD1A.37
*,ROW_LENGTH ! IN NO OF COLUMNS HGRAD1A.38
C----------------------------------------------------------------------- HGRAD1A.39
REAL HGRAD1A.40
* N(POINTS) ! IN INPUT FIELD ON REQUIRED GRID HGRAD1A.41
*,DN_DX(POINTS) ! OUT HORIZONTAL GRADIENT IN THE X-DIRECTION HGRAD1A.42
*,DN_DY(POINTS) ! OUT HORIZONTAL GRADIENT IN THE Y-DIRECTION HGRAD1A.43
*,SEC_LATITUDE(POINTS) ! IN 1/COS(LAT) ON REQUIRED GRID HGRAD1A.44
*,EW_SPACE ! IN LONGITUDE GRID SPACING HGRAD1A.45
*,NS_SPACE ! IN LATITUDE GRID SPACING HGRAD1A.46
* ! BOTH THE ABOVE IN DEGREES HGRAD1A.47
C* HGRAD1A.48
C*L HGRAD1A.49
C----------------------------------------------------------------------- HGRAD1A.50
C Local Variables HGRAD1A.51
C----------------------------------------------------------------------- HGRAD1A.52
INTEGER HGRAD1A.53
* I,J ! LOOP COUNTERS HGRAD1A.54
C----------------------------------------------------------------------- HGRAD1A.55
REAL HGRAD1A.56
* LONG_SI_OVER_TWO_A ! LONGITUDE STEP INVERSE (IN RADIANS) HGRAD1A.57
* ! DIVIDED BY (2*EARTH'S RADIUS(A)) HGRAD1A.58
*,LAT_SI_OVER_TWO_A ! LATITUDE STEP INVERSE (IN RADIANS) HGRAD1A.59
* ! DIVIDED BY (2*EARTH'S RADIUS(A)) HGRAD1A.60
C----------------------------------------------------------------------- HGRAD1A.61
C Constants required : A=radius of Earth, HGRAD1A.62
C RECIP_PI_OVER_180=180/Pi HGRAD1A.63
C----------------------------------------------------------------------- HGRAD1A.64
*CALL C_A HGRAD1A.65
*CALL C_PI HGRAD1A.66
*CALL TYPFLDPT GSM3F403.403
C*---------------------------------------------------------------------- HGRAD1A.67
C HGRAD1A.68
C *N1 - *N2 *N3 La = Latitude HGRAD1A.69
C ^ Lo = Longitude HGRAD1A.70
C dLa dLa = Latitude interval in radians HGRAD1A.71
C ^ dLo = Longitude interval in radians HGRAD1A.72
C *N4 - *N5 *N6 A = Radius of Earth in metres HGRAD1A.73
C N1-9= Variable at model grid-points HGRAD1A.74
C ^--dLo--^ HGRAD1A.75
C HGRAD1A.76
C *N7 *N8 *N9 HGRAD1A.77
C HGRAD1A.78
C dN N3-N1 dN N1-N7 HGRAD1A.79
C -- = --------------- -- = ----------- HGRAD1A.80
C dX Cos(La)*2*dLo*A dY 2*dLa*A HGRAD1A.81
C HGRAD1A.82
C HGRAD1A.83
C----------------------------------------------------------------------- HGRAD1A.84
CL 1. Calculate 1/(2*dLo*A) and 1/(2*dLa*A) HGRAD1A.85
C----------------------------------------------------------------------- HGRAD1A.86
LONG_SI_OVER_TWO_A = 0.5*RECIP_PI_OVER_180/EW_SPACE/A HGRAD1A.87
LAT_SI_OVER_TWO_A = 0.5*RECIP_PI_OVER_180/NS_SPACE/A HGRAD1A.88
C======================================================================= HGRAD1A.89
C HGRAD1A.90
C======================================================================= HGRAD1A.91
CL 2.Calculate dN/dX and dN/dY for all points except first and last rows HGRAD1A.92
C----------------------------------------------------------------------- HGRAD1A.93
*IF DEF,MPP GSM3F403.404
DO I=START_POINT_NO_HALO,END_U_POINT_NO_HALO GSM1F405.588
*ELSE GSM3F403.406
DO I=ROW_LENGTH+1,POINTS-ROW_LENGTH HGRAD1A.94
*ENDIF GSM3F403.407
C HGRAD1A.95
DN_DX(I)=(N(I+1)-N(I-1))*SEC_LATITUDE(I)*LONG_SI_OVER_TWO_A HGRAD1A.96
C HGRAD1A.97
DN_DY(I)=(N(I-ROW_LENGTH)-N(I+ROW_LENGTH))*LONG_SI_OVER_TWO_A HGRAD1A.98
C HGRAD1A.99
ENDDO HGRAD1A.100
C----------------------------------------------------------------------- HGRAD1A.101
CL 3. Calculate dN/dX and dN/dY for first row HGRAD1A.102
CL dN/dY calculated by one-sided differences (extrapolation) HGRAD1A.103
C----------------------------------------------------------------------- HGRAD1A.104
*IF -DEF,MPP GSM3F403.408
DN_DY(1)=2.0*DN_DY(1+ROW_LENGTH)-DN_DY(1+2*ROW_LENGTH) HGRAD1A.105
*ENDIF GSM3F403.409
C HGRAD1A.106
*IF DEF,MPP GSM3F403.410
IF (at_top_of_LPG) THEN GSM3F403.411
DO I=FIRST_FLD_PT+1,START_POINT_NO_HALO-1 GSM1F405.589
*ELSE GSM3F403.413
DO I=2,ROW_LENGTH HGRAD1A.107
*ENDIF GSM3F403.414
C HGRAD1A.108
DN_DX(I)=(N(I+1)-N(I-1))*SEC_LATITUDE(I)*LONG_SI_OVER_TWO_A HGRAD1A.109
C HGRAD1A.110
DN_DY(I)=2.0*DN_DY(I+ROW_LENGTH)-DN_DY(I+2*ROW_LENGTH) HGRAD1A.111
C HGRAD1A.112
ENDDO HGRAD1A.113
*IF DEF,MPP GSM3F403.415
! Initialise first point on row GSM1F405.590
DN_DX(FIRST_FLD_PT)=DN_DX(FIRST_FLD_PT+1) GSM1F405.591
DN_DY(FIRST_FLD_PT)=DN_DY(FIRST_FLD_PT+1) GSM1F405.592
END IF GSM3F403.416
*ENDIF GSM3F403.417
C----------------------------------------------------------------------- HGRAD1A.114
CL 4. Calculate dN/dX and dN/dY for last row HGRAD1A.115
CL dN/dY calculated by one-sided differences (extrapolation) HGRAD1A.116
C----------------------------------------------------------------------- HGRAD1A.117
*IF -DEF,MPP GSM3F403.418
DN_DY(POINTS)=2.0*DN_DY(POINTS-ROW_LENGTH)- HGRAD1A.118
& DN_DY(POINTS-2*ROW_LENGTH) HGRAD1A.119
*ENDIF GSM3F403.419
C HGRAD1A.120
*IF DEF,MPP GSM3F403.420
IF (at_base_of_LPG) THEN GSM3F403.421
DO I=U_BOT_ROW_START,LAST_U_FLD_PT-1 GSM1F405.593
*ELSE GSM3F403.423
DO I=POINTS-ROW_LENGTH+1,POINTS-1 HGRAD1A.121
*ENDIF GSM3F403.424
C HGRAD1A.122
DN_DX(I)=(N(I+1)-N(I-1))*SEC_LATITUDE(I)*LONG_SI_OVER_TWO_A HGRAD1A.123
C HGRAD1A.124
DN_DY(I)=2.0*DN_DY(I-ROW_LENGTH)-DN_DY(I-2*ROW_LENGTH) HGRAD1A.125
C HGRAD1A.126
ENDDO HGRAD1A.127
*IF DEF,MPP GSM3F403.425
! Initialise last point on row GSM1F405.594
DN_DX(LAST_U_FLD_PT)=DN_DX(LAST_U_FLD_PT-1) GSM1F405.595
DN_DY(LAST_U_FLD_PT)=DN_DY(LAST_U_FLD_PT-1) GSM1F405.596
ENDIF GSM3F403.426
*ENDIF GSM3F403.427
*IF -DEF,MPP GSM3F403.428
*IF DEF,GLOBAL HGRAD1A.128
C----------------------------------------------------------------------- HGRAD1A.129
CL GLOBAL only HGRAD1A.130
CL 5. Recalculate dN/dX for first and last points in each row HGRAD1A.131
C----------------------------------------------------------------------- HGRAD1A.132
DO I=1,POINTS-ROW_LENGTH+1,ROW_LENGTH HGRAD1A.133
C HGRAD1A.134
DN_DX(I)=(N(I+1)-N(I-1+ROW_LENGTH))*SEC_LATITUDE(I) HGRAD1A.135
& *LONG_SI_OVER_TWO_A HGRAD1A.136
C HGRAD1A.137
ENDDO HGRAD1A.138
C----------------------------------------------------------------------- HGRAD1A.139
DO I=ROW_LENGTH,POINTS,ROW_LENGTH HGRAD1A.140
C HGRAD1A.141
DN_DX(I)=(N(I+1-ROW_LENGTH)-N(I-1))*SEC_LATITUDE(I) HGRAD1A.142
& *LONG_SI_OVER_TWO_A HGRAD1A.143
C HGRAD1A.144
ENDDO HGRAD1A.145
*ELSE HGRAD1A.146
C----------------------------------------------------------------------- HGRAD1A.147
CL LIMITED AREA only HGRAD1A.148
CL 6. Recalculate dN/dX at the first and last points in each row HGRAD1A.149
CL by one-sided differences (extrapolation of adjacent two points) HGRAD1A.150
C----------------------------------------------------------------------- HGRAD1A.151
DO I=ROW_LENGTH,POINTS,ROW_LENGTH HGRAD1A.152
C HGRAD1A.153
J=I-ROW_LENGTH+1 HGRAD1A.154
DN_DX(I)=2.0*DN_DX(I-1)-DN_DX(I-2) HGRAD1A.155
DN_DX(J)=2.0*DN_DX(J+1)-DN_DX(J+2) HGRAD1A.156
C HGRAD1A.157
ENDDO HGRAD1A.158
*ENDIF GSM3F403.429
*ENDIF HGRAD1A.159
C======================================================================= HGRAD1A.160
C END OF SUBROUTINE H_GRAD HGRAD1A.161
C======================================================================= HGRAD1A.162
RETURN HGRAD1A.163
END HGRAD1A.164
C======================================================================= HGRAD1A.165
*ENDIF HGRAD1A.166