*IF DEF,CONTROL HORIZG1A.2
C ******************************COPYRIGHT****************************** GTS2F400.3979
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.3980
C GTS2F400.3981
C Use, duplication or disclosure of this code is subject to the GTS2F400.3982
C restrictions as set forth in the contract. GTS2F400.3983
C GTS2F400.3984
C Meteorological Office GTS2F400.3985
C London Road GTS2F400.3986
C BRACKNELL GTS2F400.3987
C Berkshire UK GTS2F400.3988
C RG12 2SZ GTS2F400.3989
C GTS2F400.3990
C If no contract has been raised with this copy of the code, the use, GTS2F400.3991
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.3992
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.3993
C Modelling at the above address. GTS2F400.3994
C ******************************COPYRIGHT****************************** GTS2F400.3995
C GTS2F400.3996
!+ Get horizontal displacement of variable from Arakawa A grid HORIZG1A.3
! HORIZG1A.4
! Subroutine Interface: HORIZG1A.5
SUBROUTINE HORIZ_GRID_OFFSET(ITEM,SECTION,internal_model, 2,1GSS2F305.51
& XOFFSET,YOFFSET, GSS2F305.52
*CALL ARGSTS
HORIZG1A.7
*CALL ARGPPX
GSS2F305.53
* ERRORSTATUS) HORIZG1A.8
HORIZG1A.9
IMPLICIT NONE HORIZG1A.10
! HORIZG1A.11
! Description: HORIZG1A.12
! Obtain x- and y- displacements of grid specified for a variable HORIZG1A.13
! identified by STASH section and item number relative to the HORIZG1A.14
! Arakawa A grid. HORIZG1A.15
! HORIZG1A.16
! Method: HORIZG1A.17
! Obtain information from the GR item (grid type code) specified in HORIZG1A.18
! the ppxref file for the requested variable, identified by STASH HORIZG1A.19
! item and section. The grid displacements are given by: HORIZG1A.20
! xoffset= ( x { V(i,j) } - x { A(i,j) } ) / x gridlength HORIZG1A.21
! yoffset= ( y { V(i,j) } - y { A(i,j) } ) / y gridlength HORIZG1A.22
! where V is the input variable grid and A is the Arakawa A grid. HORIZG1A.23
! {Note that y gridlength is -ve for arrays where (1,1) refers to HORIZG1A.24
! the top left corner.} HORIZG1A.25
! Error exit if STASHitem not identified in index to to ppxref file. HORIZG1A.26
! HORIZG1A.27
! Current Code Owner: R Rawlins HORIZG1A.28
! HORIZG1A.29
! History: HORIZG1A.30
! Version Date Comment HORIZG1A.31
! ------- ---- ------- HORIZG1A.32
! 3.4 4/07/94 Original code. R.Rawlins HORIZG1A.33
! 3.5 May 95 Submodels project: GSS2F305.54
! Introduced MODEL variable in arguments GSS2F305.55
! Removed reference to pp_xref, index_ppxref arrays; GSS2F305.56
! replaced these with EXPPXI function; introduced GSS2F305.57
! associated *CALLs GSS2F305.58
! S.J.Swarbrick GSS2F305.59
! HORIZG1A.34
! GSS2F305.60
! Code Description: HORIZG1A.35
! Language: FORTRAN 77 + common extensions. HORIZG1A.36
! This code is written to UMDP3 v6 programming standards. HORIZG1A.37
! HORIZG1A.38
! System component covered: HORIZG1A.39
! System Task: HORIZG1A.40
! HORIZG1A.41
! Declarations: HORIZG1A.42
! HORIZG1A.43
! 1.0 Global variables (*CALLed COMDECKs etc...): HORIZG1A.44
*CALL TYPSIZE
HORIZG1A.45
*CALL CSUBMODL
GSS2F305.61
*CALL TYPSTS
! Includes *CALL CPPXREF GSS2F305.62
*CALL C_MDI
HORIZG1A.47
*CALL PPXLOOK
GSS2F305.63
HORIZG1A.48
! 2.0 Subroutine arguments HORIZG1A.49
! 2.1 Scalar arguments with intent(in): HORIZG1A.50
INTEGER HORIZG1A.51
* ITEM ! STASH item number HORIZG1A.52
*,SECTION ! STASH section HORIZG1A.53
*,internal_model ! IN: Internal model id. GSS2F305.64
HORIZG1A.54
! 2.2 Array arguments with intent(in): HORIZG1A.55
HORIZG1A.56
! 2.3 Scalar arguments with intent(InOut): HORIZG1A.57
HORIZG1A.58
! 2.4 Array arguments with intent(InOut): HORIZG1A.59
HORIZG1A.60
! 2.5 Scalar arguments with intent(out): HORIZG1A.61
REAL HORIZG1A.62
* XOFFSET ! Grid displacement in x direction HORIZG1A.63
*,YOFFSET ! Grid displacement in y direction HORIZG1A.64
CHARACTER*36 CMESSAGE ! Error message GSS2F305.65
HORIZG1A.65
! 2.6 Array arguments with intent(out): HORIZG1A.66
HORIZG1A.67
! 2.7 ErrorStatus <Delete if ErrorStatus not used> HORIZG1A.68
INTEGER ErrorStatus ! Error flag (0 = OK) HORIZG1A.69
HORIZG1A.70
! 3.0 Local parameters: HORIZG1A.71
HORIZG1A.72
! 4.0 Local scalars: HORIZG1A.73
INTEGER HORIZG1A.74
* INDEX ! index of PP_XREF array HORIZG1A.75
* ,GR ! grid type code in record HORIZG1A.76
HORIZG1A.77
! 5.0 l dynamic arrays: HORIZG1A.78
HORIZG1A.79
! Function & Subroutine calls: HORIZG1A.80
HORIZG1A.81
INTEGER EXPPXI GSS2F305.66
EXTERNAL EXPPXI GSS2F305.67
GSS2F305.68
!- End of header HORIZG1A.82
HORIZG1A.83
HORIZG1A.84
! 1. Get grid type code GSS2F305.69
HORIZG1A.86
GR=EXPPXI
(internal_model,SECTION,ITEM,ppx_grid_type, GSS2F305.70
*CALL ARGPPX
GSS2F305.71
& ErrorStatus,CMESSAGE) GSS2F305.72
HORIZG1A.100
! 2. Decode grid type and assign offsets HORIZG1A.101
HORIZG1A.102
! Initialise offsets to Arakawa A grid HORIZG1A.103
HORIZG1A.104
XOFFSET= 0.0 HORIZG1A.105
YOFFSET= 0.0 HORIZG1A.106
HORIZG1A.107
IF(GR.GE.11.AND.GR.LE.15) THEN ! uv points on B grid HORIZG1A.108
XOFFSET=0.5 HORIZG1A.109
YOFFSET=0.5 HORIZG1A.110
ELSEIF(GR.EQ.18) THEN ! u points on C grid HORIZG1A.111
XOFFSET=0.5 HORIZG1A.112
YOFFSET=0.0 HORIZG1A.113
ELSEIF(GR.EQ.19) THEN ! v points on C grid HORIZG1A.114
XOFFSET=0.0 HORIZG1A.115
YOFFSET=0.5 HORIZG1A.116
ENDIF HORIZG1A.117
HORIZG1A.118
RETURN HORIZG1A.119
END HORIZG1A.120
*ENDIF HORIZG1A.121