*IF DEF,C92_1A BOXBND1.2
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.15303
C GTS2F400.15304
C Use, duplication or disclosure of this code is subject to the GTS2F400.15305
C restrictions as set forth in the contract. GTS2F400.15306
C GTS2F400.15307
C Meteorological Office GTS2F400.15308
C London Road GTS2F400.15309
C BRACKNELL GTS2F400.15310
C Berkshire UK GTS2F400.15311
C RG12 2SZ GTS2F400.15312
C GTS2F400.15313
C If no contract has been raised with this copy of the code, the use, GTS2F400.15314
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.15315
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.15316
C Modelling at the above address. GTS2F400.15317
C ******************************COPYRIGHT****************************** GTS2F400.15318
C GTS2F400.15319
CLL SUBROUTINE BOX_BND BOXBND1.3
CLL BOXBND1.4
CLL Routine sets up arrays of indexes and boundaries of target grid BOXBND1.5
CLL boxes relative to a source grid for use by BOX_SUM so that BOXBND1.6
CLL area weighted means can be calculated. BOXBND1.7
CLL BOXBND1.8
CLL NOT SUITABLE FOR SINGLE COLUMN USE BOXBND1.9
CLL BOXBND1.10
CLL SUITABLE FOR ROTATED GRIDS BOXBND1.11
CLL BOXBND1.12
CLL ORIGINAL VERSION FOR CRAY Y-MP/IBM BOXBND1.13
CLL WRITTEN 06/09/91 BY C. WILSON BOXBND1.14
CLL BOXBND1.15
CLL CODE REVIEWED BY R.SMITH ??/??/?? BOXBND1.16
CLL BOXBND1.17
CLL VERSION NO. 1 DATED 06/09/91 BOXBND1.18
CLL COSMOS DSN MS15.CWUM.JOBS(BOXBND1) BOXBND1.19
CLL PROGRAMMING STANDARD: UNIFIED MODEL DOCUMENTATION PAPER NO. 4, BOXBND1.20
CLL VERSION 1, DATED 12/09/89 BOXBND1.21
! History: UDG2F401.120
! Version Date Comment UDG2F401.121
! ------- ---- ------- UDG2F401.122
! 4.0 12/04/95 Imported into Unified model. D.M. Goddard UDG2F401.123
! 4.1 12/06/96 Corrections to longitude indexes at boundary. UDG2F401.124
! D.M. Goddard UDG2F401.125
! 4.5 12/10/98 Stops LONG_L and COLAT_T becoming negative in UDG6F405.134
! top row, preventing out of bound in index array. UDG6F405.135
! Author D.M Goddard UDG6F405.136
CLL BOXBND1.22
CLL SYSTEM TASK: S1 (part,extension for area mean interpolation) BOXBND1.23
CLL BOXBND1.24
CLL PURPOSE: To set up for grid-boxes on a target grid the longitude, BOXBND1.25
CLL colatitude,and indexes of the overlapping source grid- BOXBND1.26
CLL boxes at left hand side and top of target grid-boxes. BOXBND1.27
CLL Both grids are regular lat-long with the same pole BOXBND1.28
CLL and orientation. Either may be a 'p-grid' (ie with BOXBND1.29
CLL half-size boxes at the poles) or a 'u-grid' (ie with BOXBND1.30
CLL regular size boxes everywhere.) BOXBND1.31
CLL BOXBND1.32
CLL NB The units used are "source grid-box lengths" BOXBND1.33
CLL The area of the target grid_boxes in squared "source BOXBND1.34
CLL grid-box units" is also returned. BOXBND1.35
CLL BOXBND1.36
CLL DOCUMENTATION: UNIFIED MODEL DOCUMENTATION S1 BOXBND1.37
CLL BY A.DICKINSON/C WILSON VERSION ??DATED ??/??/91 BOXBND1.38
CLL BOXBND1.39
CLL BOXBND1.40
CLLEND------------------------------------------------------------- BOXBND1.41
BOXBND1.42
C BOXBND1.43
C*L ARGUMENTS:--------------------------------------------------- BOXBND1.44
SUBROUTINE BOX_BND 3BOXBND1.45
1 (I_L,LONG_L,J_T,COLAT_T,AREA_BOX, BOXBND1.46
2 ROW_LENGTH,ROWS,ROW_LENGTH_SRCE,ROWS_SRCE, BOXBND1.47
3 DELTA_LONG,DELTA_LAT,START_LONG,START_LAT, BOXBND1.48
4 DELTA_LONG_SRCE,DELTA_LAT_SRCE,START_LONG_SRCE,START_LAT_SRCE, BOXBND1.49
5 IGRID,IGRID_SRCE,GLOBAL) BOXBND1.50
BOXBND1.51
IMPLICIT NONE BOXBND1.52
BOXBND1.53
INTEGER BOXBND1.54
* ROW_LENGTH !IN Number of points per row target area BOXBND1.55
*, ROWS !IN Number of rows of target area BOXBND1.56
*, ROW_LENGTH_SRCE !IN Number of points per row source area BOXBND1.57
*, ROWS_SRCE !IN Number of rows of source area BOXBND1.58
C BOXBND1.59
INTEGER BOXBND1.60
1 I_L(ROW_LENGTH+1)!OUT Index of source box overlapping lhs of BOXBND1.61
& ! target grid-box BOXBND1.62
2,J_T(ROWS+1) !OUT Index of source box overlapping top of BOXBND1.63
& ! target grid-box BOXBND1.64
C BOXBND1.65
REAL BOXBND1.66
1 LONG_L(ROW_LENGTH +1) !OUT Left longitude of target grid-box (in BOXBND1.67
+ ! units of DELTA_LONG_SRCE) BOXBND1.68
2,COLAT_T(ROWS+1) !OUT Colatitude of top of target grid-box BOXBND1.69
+ ! (in units of DELTA_LAT_SRCE) BOXBND1.70
3, AREA_BOX !OUT area of grid box in sq units of source grid BOXBND1.71
BOXBND1.72
REAL BOXBND1.73
1 DELTA_LONG !IN Longitude increment of target grid (deg) BOXBND1.74
2,DELTA_LAT !IN Latitude increment of target grid (deg) BOXBND1.75
3,START_LONG !IN start longitude of centre of first grid- BOXBND1.76
+ ! box in target area BOXBND1.77
4,START_LAT !IN start latitude of centre of first grid- BOXBND1.78
+ ! box in target area BOXBND1.79
5,DELTA_LAT_SRCE !IN Latitude increment of source grid BOXBND1.80
6,DELTA_LONG_SRCE !IN Longitude increment of source grid BOXBND1.81
7,START_LONG_SRCE !IN start longitude of centre of first grid- BOXBND1.82
+ ! box in source area BOXBND1.83
8,START_LAT_SRCE !IN start latitude of centre of first grid BOXBND1.84
+ ! box in source area BOXBND1.85
BOXBND1.86
INTEGER BOXBND1.87
1 IGRID !IN Grid indicator 1=p-grid,2=u-grid BOXBND1.88
2,IGRID_SRCE !IN Grid indicator 1=p-grid,2=u-grid BOXBND1.89
BOXBND1.90
LOGICAL GLOBAL !IN true if global area required BOXBND1.91
C*--------------------------------------------------------------------- BOXBND1.92
BOXBND1.93
C*L WORKSPACE USAGE:------------------------------------------------- BOXBND1.94
C NONE BOXBND1.95
C*--------------------------------------------------------------------- BOXBND1.96
C BOXBND1.97
C*L EXTERNAL SUBROUTINES CALLED--------------------------------------- BOXBND1.98
C EXTERNAL NONE BOXBND1.99
C*------------------------------------------------------------------ BOXBND1.100
C---------------------------------------------------------------------- BOXBND1.101
C DEFINE LOCAL VARIABLES BOXBND1.102
REAL EW_BOX ! length of grid box in units of source BOXBND1.103
+ ! (DELTA_LONG_SRCE) BOXBND1.104
1, NS_BOX ! height of grid box in units of source BOXBND1.105
+ ! (DELTA_LAT_SRCE) BOXBND1.106
2,START_LONG_BOX ! start longitude of first grid box left edge BOXBND1.107
3,START_COLAT_BOX! start colatitude of first grid box top edge BOXBND1.108
4,START_LONG_BOX_SRCE ! start longitude of first grid box left BOXBND1.109
+ ! edge ( source) BOXBND1.110
5,START_COLAT_BOX_SRCE! start colatitude of first grid box top BOXBND1.111
+ ! edge ( source) BOXBND1.112
6,LONG_OFFSET ! start longitude difference BOXBND1.113
7,COLAT_OFFSET ! start colatitude difference BOXBND1.114
BOXBND1.115
INTEGER I,J ! loop counters BOXBND1.116
REAL P1,P2 BOXBND1.117
LOGICAL LNER BOXBND1.118
LNER(P1,P2) = ((ABS(P1-P2)) .GT. (1.E-5*ABS(P1+P2))) BOXBND1.119
BOXBND1.120
CL ********************************************************************* BOXBND1.121
CL 1.0 Set target gridbox length,height and area in units of source grid BOXBND1.122
CL Set start 'longitude' and 'colatitude' of first grid box BOXBND1.123
CL also in source units. BOXBND1.124
CL ********************************************************************* BOXBND1.125
BOXBND1.126
EW_BOX= DELTA_LONG/DELTA_LONG_SRCE BOXBND1.127
NS_BOX= DELTA_LAT/DELTA_LAT_SRCE BOXBND1.128
AREA_BOX= EW_BOX*NS_BOX BOXBND1.129
BOXBND1.130
CL ********************************************************************* BOXBND1.131
CL 1.1 Set start colatitude of top and start longitude of LHS of first BOXBND1.132
CL boxes on both target and source grids. BOXBND1.133
CL ********************************************************************* BOXBND1.134
write(6,*) DELTA_LAT_SRCE,DELTA_LAT BOXBND1.135
write(6,*) DELTA_LONG_SRCE,DELTA_LONG BOXBND1.136
write(6,*) START_LAT_SRCE,START_LAT BOXBND1.137
write(6,*) START_LONG_SRCE,START_LONG BOXBND1.138
START_LONG_BOX = START_LONG - 0.5*DELTA_LONG BOXBND1.139
START_COLAT_BOX = (90. - START_LAT) - 0.5*DELTA_LAT BOXBND1.140
START_LONG_BOX_SRCE = START_LONG_SRCE - 0.5*DELTA_LONG_SRCE BOXBND1.141
START_COLAT_BOX_SRCE = (90. - START_LAT_SRCE) - 0.5*DELTA_LAT_SRCE BOXBND1.142
BOXBND1.143
C## START_LONG_BOX = START_LONG/DELTA_LONG_SRCE - 0.5*EW_BOX BOXBND1.144
C## START_COLAT_BOX = (90. - START_LAT)/DELTA_LAT_SRCE - 0.5*NS_BOX BOXBND1.145
C## START_LONG_BOX_SRCE = START_LONG_SRCE/DELTA_LONG_SRCE - 0.5 BOXBND1.146
C## START_COLAT_BOX_SRCE = (90. - START_LAT_SRCE)/DELTA_LAT_SRCE - 0.5 BOXBND1.147
BOXBND1.148
IF(GLOBAL) THEN BOXBND1.149
IF(IGRID_SRCE.EQ.1.AND.LNER(START_LAT_SRCE,90.)) THEN BOXBND1.150
WRITE(6,*)' BOX_BND: source grid not global' GIE0F403.92
STOP BOXBND1.152
ENDIF BOXBND1.153
IF(IGRID_SRCE.EQ.2.AND. BOXBND1.154
& LNER(START_LAT_SRCE,(90.-DELTA_LAT_SRCE*0.5))) THEN BOXBND1.155
WRITE(6,*)' BOX_BND: source grid not global' GIE0F403.93
ENDIF BOXBND1.158
ELSE BOXBND1.159
WRITE (6,*) 'BOX_BND' BOXBND1.160
WRITE (6,*) 'start_colat_box ',START_COLAT_BOX BOXBND1.161
WRITE (6,*) 'start_colat_box_srce ',START_COLAT_BOX_SRCE BOXBND1.162
IF(LNER(START_COLAT_BOX,START_COLAT_BOX_SRCE)) THEN BOXBND1.163
WRITE(6,*)' BOX_BND: target area larger than source area' GIE0F403.94
STOP BOXBND1.165
ENDIF BOXBND1.166
ENDIF BOXBND1.167
BOXBND1.168
LONG_OFFSET =(START_LONG_BOX-START_LONG_BOX_SRCE)/ BOXBND1.169
& DELTA_LONG_SRCE BOXBND1.170
COLAT_OFFSET = (START_COLAT_BOX - START_COLAT_BOX_SRCE)/ BOXBND1.171
& DELTA_LAT_SRCE BOXBND1.172
BOXBND1.173
IF (.NOT.GLOBAL) THEN BOXBND1.174
IF (LONG_OFFSET.LT.0.0) THEN BOXBND1.175
WRITE (6,*) ' LONG_OFFSET = ',LONG_OFFSET,' ; Reset to 0.0' BOXBND1.176
LONG_OFFSET = 0.0 BOXBND1.177
ENDIF BOXBND1.178
IF (COLAT_OFFSET.LT.0.0) THEN BOXBND1.179
WRITE (6,*) ' COLAT_OFFSET = ',COLAT_OFFSET,' ; Reset to 0.0' BOXBND1.180
COLAT_OFFSET = 0.0 BOXBND1.181
ENDIF BOXBND1.182
ENDIF BOXBND1.183
CL ********************************************************************* BOXBND1.184
CL 2.0 Set grid box left longitudes, top colatitudes and indices BOXBND1.185
CL ********************************************************************* BOXBND1.186
BOXBND1.187
DO 220 I=1,ROW_LENGTH + 1 BOXBND1.188
LONG_L(I) = LONG_OFFSET + (I-1)*EW_BOX BOXBND1.189
IF(GLOBAL.AND.LONG_L(I).LT.0.0)THEN UDG2F401.126
LONG_L(I)=LONG_L(I)+REAL(ROW_LENGTH_SRCE) UDG2F401.127
ELSE IF(GLOBAL.AND.LONG_L(I).GE.ROW_LENGTH_SRCE)THEN UDG2F401.128
LONG_L(I)=LONG_L(I)-REAL(ROW_LENGTH_SRCE) UDG2F401.129
END IF UDG2F401.130
I_L(I) = LONG_L(I) +1 BOXBND1.192
220 CONTINUE BOXBND1.193
IF(LONG_L(1).LT.0.0)LONG_L(1)=0.0 UDG6F405.137
BOXBND1.194
WRITE(6,*) ' I_L' GIE0F403.95
WRITE(6,*) I_L GIE0F403.96
WRITE(6,*) ' LONG_L' GIE0F403.97
WRITE(6,*) LONG_L GIE0F403.98
BOXBND1.199
C## COLAT_T(1) = START_COLAT_BOX - START_COLAT_BOX_SRCE BOXBND1.200
COLAT_T(1) = COLAT_OFFSET BOXBND1.201
IF(GLOBAL.AND.IGRID.EQ.1)THEN BOXBND1.202
C## COLAT_T(1) = 0.0 - START_COLAT_BOX_SRCE BOXBND1.203
COLAT_T(1) = (0.0 - START_COLAT_BOX_SRCE)/DELTA_LAT_SRCE BOXBND1.204
ENDIF BOXBND1.205
IF(COLAT_T(1).LT.0.0)COLAT_T(1)=0.0 UDG6F405.138
J_T(1) = COLAT_T(1) + 1 BOXBND1.206
DO 230 J=2,ROWS+1 BOXBND1.207
COLAT_T(J) = COLAT_OFFSET + (J-1)*NS_BOX BOXBND1.208
J_T(J) = COLAT_T(J) + 1 BOXBND1.209
230 CONTINUE BOXBND1.210
C ROWS+1 ie bottom boundary BOXBND1.211
IF(GLOBAL) THEN BOXBND1.212
IF(IGRID.EQ.1)COLAT_T(ROWS+1) = COLAT_T(ROWS+1)-0.5*NS_BOX BOXBND1.213
J_T(ROWS+1) = ROWS_SRCE BOXBND1.214
ELSE BOXBND1.215
IF(J_T(ROWS+1).GT.ROWS_SRCE) THEN BOXBND1.216
IF(COLAT_T(ROWS+1).GT.REAL(ROWS_SRCE)) THEN BOXBND1.217
WRITE(6,*)' BOX_BND: target area larger than source area' GIE0F403.99
STOP BOXBND1.219
ELSE BOXBND1.220
J_T(ROWS+1) = ROWS_SRCE BOXBND1.221
ENDIF BOXBND1.222
ENDIF BOXBND1.223
ENDIF BOXBND1.224
BOXBND1.225
WRITE(6,*) ' J_T' GIE0F403.100
WRITE(6,*) J_T GIE0F403.101
WRITE(6,*) ' COLAT_T' GIE0F403.102
WRITE(6,*) COLAT_T GIE0F403.103
BOXBND1.230
RETURN BOXBND1.231
END BOXBND1.232
*ENDIF BOXBND1.233