*IF DEF,C96_1A,OR,DEF,C96_1B GPB0F403.3115
*IF DEF,MPP GPB0F403.3116
C *****************************COPYRIGHT****************************** GLTOLO1.3
C (c) CROWN COPYRIGHT 1996, METEOROLOGICAL OFFICE, All Rights Reserved. GLTOLO1.4
C GLTOLO1.5
C Use, duplication or disclosure of this code is subject to the GLTOLO1.6
C restrictions as set forth in the contract. GLTOLO1.7
C GLTOLO1.8
C Meteorological Office GLTOLO1.9
C London Road GLTOLO1.10
C BRACKNELL GLTOLO1.11
C Berkshire UK GLTOLO1.12
C RG12 2SZ GLTOLO1.13
C GLTOLO1.14
C If no contract has been raised with this copy of the code, the use, GLTOLO1.15
C duplication or disclosure of it is strictly prohibited. Permission GLTOLO1.16
C to do so must first be obtained in writing from the Head of Numerical GLTOLO1.17
C Modelling at the above address. GLTOLO1.18
C ******************************COPYRIGHT****************************** GLTOLO1.19
!+ Parallel UM : Transform from global to local co-ordinates: GLTOLO1.20
! GLOBAL_TO_LOCAL_SUBDOMAIN: converts global subdomain boundaries GLTOLO1.21
! to local subdomain boundaries GLTOLO1.22
! GLOBAL_TO_LOCAL_RC: converts global row,column co-ordinates to GLTOLO1.23
! processor co-ordinates plus local GLTOLO1.24
! co-ordinates within the processor. GLTOLO1.25
! GLTOLO1.26
! Subroutine Interface: GLTOLO1.27
SUBROUTINE GLOBAL_TO_LOCAL_SUBDOMAIN( 16,1GLTOLO1.28
& L_include_halosEW, GLTOLO1.29
& L_include_halosNS, GLTOLO1.30
& grid_code,procid, GLTOLO1.31
& global_north_in,global_east_in, GLTOLO1.32
& global_south_in,global_west_in, GLTOLO1.33
& local_north,local_east, GLTOLO1.34
& local_south,local_west) GLTOLO1.35
IMPLICIT NONE GLTOLO1.36
! GLTOLO1.37
! Description: GLTOLO1.38
! Takes a global definition of a subdomain region (in terms of GLTOLO1.39
! model gridpoints) and translates it into local numbers. GLTOLO1.40
! This effectively means local co-ordinates of the region of the GLTOLO1.41
! subdomain which intersects with this processor's area. GLTOLO1.42
! GLTOLO1.43
! Method: GLTOLO1.44
! Use the datastart variable in PARVARS to see if the requested GLTOLO1.45
! subdomain intersects with this processor's area, if it does GLTOLO1.46
! then use datastart to convert to local co-ordinate and do a bit GLTOLO1.47
! of logic using MAX and MIN to ensure the local co-ordinates GLTOLO1.48
! actually lie within the local area Then make any corrections GLTOLO1.49
! necessary to account for a subdomain which crosses over the GLTOLO1.50
! 0 longitude line. Finally, if L_include_halos is set to GLTOLO1.51
! .TRUE. - include any relevant halo regions. GLTOLO1.52
! GLTOLO1.53
! Current code owner : Paul Burton GLTOLO1.54
! GLTOLO1.55
! History: GLTOLO1.56
! Model Date Modification history from model version 4.2 GLTOLO1.57
! version GLTOLO1.58
! 4.2 03/09/96 New deck created for MPP code. P.Burton GLTOLO1.59
! 4.3 13/03/97 Various bug fixes P.Burton GPB0F403.3117
! 4.4 12/06/97 Another bug fix P.Burton GPB0F404.58
! GLTOLO1.60
! Subroutine arguments: GLTOLO1.61
GLTOLO1.62
LOGICAL GLTOLO1.63
& L_include_halosEW ! IN : include East-West halos in local GLTOLO1.64
! ! region if set to .TRUE. GLTOLO1.65
&, L_include_halosNS ! IN : include North-South halos in local GLTOLO1.66
! ! region if set to .TRUE. GLTOLO1.67
INTEGER GLTOLO1.68
GLTOLO1.69
& grid_code ! IN : STASH grid type of field GLTOLO1.70
&, procid ! IN : processor to produce result for GLTOLO1.71
&, global_north_in ! IN : northern boundary of global subdomain GLTOLO1.72
&, global_east_in ! IN : eastern boundary of global subdomain GLTOLO1.73
&, global_south_in ! IN : southern boundary of global subdomain GLTOLO1.74
&, global_west_in ! IN : western boundary of global subdomain GLTOLO1.75
GLTOLO1.76
&, local_north ! OUT : northern boundary of local subdomain GLTOLO1.77
&, local_east ! OUT : eastern boundary of local subdomain GLTOLO1.78
&, local_south ! OUT : southern boundary of local subdomain GLTOLO1.79
&, local_west ! OUT : western boundary of local subdomain GLTOLO1.80
GLTOLO1.81
! Parameters and Common blocks GLTOLO1.82
GLTOLO1.83
*CALL PARVARS
GLTOLO1.84
*CALL STERR
GPB0F403.3118
GLTOLO1.85
! Local variables GLTOLO1.86
INTEGER GLTOLO1.87
! Copies of the input arguments, that can be modified for GLTOLO1.88
! wrap-around calculations GLTOLO1.89
& global_north,global_east,global_south,global_west GLTOLO1.90
&, fld_type ! is field on P or U grid? GLTOLO1.91
&, row_len_nh ! row length when halos are removed GLTOLO1.92
&, nrows_nh ! number of rows when halos are removed GLTOLO1.93
&, first_global_pt_EW ! global point number of first and last GPB0F403.3119
&, last_global_pt_EW ! local points in local area GPB0F403.3120
&, first_global_pt_NS ! in the East-West and GPB0F403.3121
&, last_global_pt_NS ! North-South directions GPB0F403.3122
GLTOLO1.94
LOGICAL GLTOLO1.95
! Logicals indicating if this processor contains part of a GLTOLO1.96
! subdomain GLTOLO1.97
& NS_intersect,EW_intersect GLTOLO1.98
&, wrap ! set to .TRUE. if the subdomain passes over the GLTOLO1.99
! ! the 0 degree longitude line GLTOLO1.100
&, fullfield ! if the field is NOT a subdomain GPB0F403.3123
GLTOLO1.101
INTEGER GET_FLD_TYPE ! function GLTOLO1.102
GLTOLO1.103
! ------------------------------------------------------------------ GLTOLO1.104
GLTOLO1.105
! Copy the global_in variables into local variables GLTOLO1.106
GLTOLO1.107
global_north=global_north_in GLTOLO1.108
global_east=global_east_in GLTOLO1.109
global_south=global_south_in GLTOLO1.110
global_west=global_west_in GLTOLO1.111
GLTOLO1.112
! Find out if the data is on a mass or velocity grid GLTOLO1.113
GLTOLO1.114
fld_type=GET_FLD_TYPE
(grid_code) GLTOLO1.115
GLTOLO1.116
IF (fld_type .EQ. fld_type_unknown) THEN GLTOLO1.117
WRITE(6,*) 'GLOBAL_TO_LOCAL_SUBDOMAIN encountered ', GLTOLO1.118
& 'field with gridtype code ',grid_code GLTOLO1.119
WRITE(6,*) 'Unable to process this field.' GLTOLO1.120
local_north=st_no_data GPB0F403.3124
local_south=st_no_data GPB0F403.3125
local_east=st_no_data GPB0F403.3126
local_west=st_no_data GPB0F403.3127
GOTO 9999 GLTOLO1.125
ENDIF GLTOLO1.126
GLTOLO1.127
! Set up logical indicating if this is a full field, or just GPB0F403.3128
! a subdomain GPB0F403.3129
GPB0F403.3130
fullfield= ((( global_west .EQ. 1 ) .AND. GPB0F403.3131
& ( global_east .EQ. glsize(1)) .AND. GPB0F403.3132
& ( global_north .EQ. 1 )) .AND. GPB0F403.3133
& (((fld_type .EQ. fld_type_p) .AND. GPB0F403.3134
& (global_south .EQ. glsize(2))) .OR. GPB0F403.3135
& ((fld_type .EQ. fld_type_u) .AND. GPB0F403.3136
& (global_south .EQ. glsize(2)-1)))) GPB0F403.3137
GPB0F403.3138
! If this is a fullfield (ie. not a subdomain) the local addressing GPB0F403.3139
! is easy: GPB0F403.3140
GPB0F403.3141
IF (fullfield) THEN GPB0F403.3142
GPB0F403.3143
IF (L_include_halosNS) THEN GPB0F403.3144
local_north=1 GPB0F403.3145
local_south=g_lasize(2,procid) GPB0F403.3146
ELSE GPB0F403.3147
local_north=1+Offy GPB0F403.3148
local_south=g_lasize(2,procid)-Offy GPB0F403.3149
ENDIF GPB0F403.3150
IF (L_include_halosEW) THEN GPB0F403.3151
local_west=1 GPB0F403.3152
local_east=g_lasize(1,procid) GPB0F403.3153
ELSE GPB0F403.3154
local_west=1+Offx GPB0F403.3155
local_east=g_lasize(1,procid)-Offx GPB0F403.3156
ENDIF GPB0F403.3157
GPB0F403.3158
ELSE ! a subdomain requires some careful analysis: GPB0F403.3159
GPB0F403.3160
row_len_nh=g_blsizep(1,procid) GPB0F403.3161
IF (fld_type .EQ. fld_type_p) THEN GPB0F403.3162
nrows_nh=g_blsizep(2,procid) GPB0F403.3163
ELSE GPB0F403.3164
nrows_nh=g_blsizeu(2,procid) GPB0F403.3165
ENDIF GPB0F403.3166
GPB0F403.3167
! Set up variables giving the global point numbers of the GPB0F403.3168
! start and end of this processor's subdomain GPB0F403.3169
GPB0F403.3170
first_global_pt_EW=g_datastart(1,procid) GPB0F403.3171
last_global_pt_EW=first_global_pt_EW+row_len_nh-1 GPB0F403.3172
GPB0F403.3173
first_global_pt_NS=g_datastart(2,procid) GPB0F403.3174
last_global_pt_NS=first_global_pt_NS+nrows_nh-1 GPB0F403.3175
GLTOLO1.134
! If global_east is greater than the global row length, this GLTOLO1.135
! indicates a wrap around - but not in the format this code GLTOLO1.136
! wants - where it expects a wrap around to be indicated by GLTOLO1.137
! the east column being less than the west column. GPB0F403.3176
GLTOLO1.139
IF (global_east .LT. global_west) THEN GPB0F403.3177
wrap=.TRUE. GPB0F403.3178
ELSEIF (global_east .GT. glsize(1)) THEN GPB0F403.3179
wrap=.TRUE. GPB0F403.3180
global_east=global_east-glsize(1) GPB0F403.3181
ELSE GPB0F403.3182
wrap=.FALSE. GPB0F403.3183
ENDIF GPB0F403.3184
GLTOLO1.148
EW_intersect = GPB0F403.3185
& (( .NOT. wrap) .AND. GPB0F403.3186
& ((global_east .GE. first_global_pt_EW) .AND. GPB0F403.3187
& (global_west .LE. last_global_pt_EW))) GPB0F403.3188
& .OR. GPB0F403.3189
& ((wrap) .AND. GPB0F403.3190
& ((global_west .LE. last_global_pt_EW) .OR. GPB0F403.3191
& (global_east .GE. first_global_pt_EW))) GPB0F403.3192
GLTOLO1.149
NS_intersect = GPB0F403.3193
& ((global_south .GE. first_global_pt_NS) .AND. GPB0F403.3194
& (global_north .LE. last_global_pt_NS)) GPB0F403.3195
GLTOLO1.160
IF (NS_intersect) THEN GPB0F403.3196
GLTOLO1.165
IF ((global_north .GE. first_global_pt_NS) .AND. GPB0F403.3197
& (global_north .LE. last_global_pt_NS)) THEN GPB0F403.3198
! This processor contains the NS start of the subarea GPB0F403.3199
local_north=global_north-first_global_pt_NS+Offy+1 GPB0F403.3200
ELSE GPB0F403.3201
! This processor is below the start of the subarea GPB0F403.3202
local_north=1+Offy GPB0F403.3203
ENDIF GPB0F403.3204
GLTOLO1.167
IF ((global_south .GE. first_global_pt_NS) .AND. GPB0F403.3205
& (global_south .LE. last_global_pt_NS)) THEN GPB0F403.3206
! This processor contains the NS end of the subarea GPB0F403.3207
local_south=global_south-first_global_pt_NS+Offy+1 GPB0F403.3208
ELSE GPB0F403.3209
! This processor is above the end of the subarea GPB0F403.3210
local_south=Offy+nrows_nh GPB0F403.3211
ENDIF GPB0F403.3212
GLTOLO1.171
ELSE GPB0F403.3213
GLTOLO1.175
local_north=st_no_data GPB0F403.3214
local_south=st_no_data GPB0F403.3215
GLTOLO1.177
ENDIF GPB0F403.3216
GLTOLO1.180
IF (EW_intersect) THEN GPB0F403.3217
GLTOLO1.182
IF ((global_west .GE. first_global_pt_EW) .AND. GPB0F403.3218
& (global_west .LE. last_global_pt_EW)) THEN GPB0F403.3219
! This processor contains the EW start of the subarea GPB0F403.3220
local_west=global_west-first_global_pt_EW+Offx+1 GPB0F403.3221
ELSE GPB0F403.3222
! This processor is to the right of the start of the subarea GPB0F403.3223
local_west=1+Offx GPB0F403.3224
ENDIF GPB0F403.3225
GLTOLO1.184
IF ((global_east .GE. first_global_pt_EW) .AND. GPB0F403.3226
& (global_east .LE. last_global_pt_EW)) THEN GPB0F403.3227
! This processor contains the EW end of the subarea GPB0F403.3228
local_east=global_east-first_global_pt_EW+Offx+1 GPB0F403.3229
ELSE GPB0F403.3230
! This processor is to the left of the end of the subarea GPB0F403.3231
local_east=Offx+row_len_nh GPB0F403.3232
ENDIF GPB0F403.3233
GLTOLO1.188
ELSE GPB0F403.3234
GLTOLO1.192
local_east=st_no_data GPB0F403.3235
local_west=st_no_data GPB0F403.3236
GLTOLO1.194
ENDIF GPB0F403.3237
GLTOLO1.197
ENDIF ! is this a fullfield? GPB0F403.3238
GLTOLO1.226
9999 CONTINUE GLTOLO1.227
GLTOLO1.228
RETURN GLTOLO1.229
END GLTOLO1.230
GLTOLO1.231
! Subroutine Interface: GLTOLO1.232
SUBROUTINE GLOBAL_TO_LOCAL_RC(grid_code, 11,1GLTOLO1.233
& global_column_in , global_row, GLTOLO1.234
& processor_x , processor_y, GLTOLO1.235
& local_column, local_row) GLTOLO1.236
GLTOLO1.237
IMPLICIT NONE GLTOLO1.238
! GLTOLO1.239
! Description: GLTOLO1.240
! Takes a global co-ordinate, in model gridpoints, and returns GLTOLO1.241
! the processor co-ordinate of the processor containing that GLTOLO1.242
! point, and the local co-ordinates of the point on that processor. GLTOLO1.243
! GLTOLO1.244
! GLTOLO1.245
! Current code owner : Paul Burton GLTOLO1.246
! GLTOLO1.247
! History: GLTOLO1.248
! Model Date Modification history from model version 4.2 GLTOLO1.249
! version GLTOLO1.250
! 4.2 17 /09/96 New deck created for MPP code. P.Burton GLTOLO1.251
! 4.3 13/03/97 Various bug fixes P.Burton GPB0F403.3239
! 4.4 18/06/97 Check that row number is valid P.Burton GPB1F404.24
! 06/10/97 Set correct row length and n_rows GPB1F404.25
! in dowhile loop. P.Burton GPB1F404.26
! GLTOLO1.252
! Subroutine arguments: GLTOLO1.253
GLTOLO1.254
INTEGER GLTOLO1.255
& grid_code ! IN : STASH grid type code GLTOLO1.256
&, global_column_in ! IN : global column number GLTOLO1.257
&, global_row ! IN : global row number GLTOLO1.258
&, processor_x ! OUT : processor X (EW) co-ordinate GLTOLO1.259
! ! (0->nproc_x) GLTOLO1.260
&, processor_y ! OUT : processor Y (NS) co-ordinate GLTOLO1.261
! (0->nproc_y) GLTOLO1.262
&, local_column ! OUT : local column number on processor GLTOLO1.263
&, local_row ! OUT : local row number on processor GLTOLO1.264
GLTOLO1.265
! Parameters and COMMON blocks GLTOLO1.266
*CALL PARVARS
GLTOLO1.267
*CALL STERR
GPB0F403.3240
GLTOLO1.268
! Local variables GLTOLO1.269
GLTOLO1.270
INTEGER GLTOLO1.271
& global_column ! modified version of global_column_in which GLTOLO1.272
! ! takes account of domains wrapping over GLTOLO1.273
! ! 0 degree longitude GLTOLO1.274
&, fld_type ! field stored on P grid or U grid? GLTOLO1.275
&, row_len_nh,nrows_nh ! row_len and n_rows when halos removed GLTOLO1.276
&, proc ! loop counter for loop over processors GLTOLO1.277
! global column and row numbers delimiting a processors area GLTOLO1.278
&, start_col,end_col,start_row,end_row GLTOLO1.279
GLTOLO1.280
INTEGER GET_FLD_TYPE ! function GLTOLO1.281
GLTOLO1.282
! ------------------------------------------------------------------ GLTOLO1.283
GLTOLO1.284
! Find out if the data is on a mass or velocity grid GLTOLO1.285
GLTOLO1.286
fld_type=GET_FLD_TYPE
(grid_code) GLTOLO1.287
GLTOLO1.288
IF (fld_type .EQ. fld_type_unknown) THEN GLTOLO1.289
WRITE(6,*) 'GLOBAL_TO_LOCAL_RC encountered ', GLTOLO1.290
& 'field with gridtype code ',grid_code GLTOLO1.291
WRITE(6,*) 'Unable to process this field.' GLTOLO1.292
processor_x=st_no_data GPB0F403.3241
processor_y=st_no_data GPB0F403.3242
local_column=st_no_data GPB0F403.3243
local_row=st_no_data GPB0F403.3244
GOTO 9999 GLTOLO1.297
ENDIF GLTOLO1.298
GLTOLO1.299
! If global_column_in is more than the global row length, perform GLTOLO1.300
! a wrap around to ensure it falls within the global bounds GLTOLO1.301
GLTOLO1.302
IF (global_column_in .GT. glsize(1)) THEN GLTOLO1.303
global_column=MOD(global_column_in+1,glsize(1))-1 GLTOLO1.304
ELSE GLTOLO1.305
global_column=global_column_in GLTOLO1.306
ENDIF GLTOLO1.307
GPB1F404.27
IF ((global_column .LT. 1) .OR. GPB1F404.28
& (global_row .LT. 1) .OR. GPB1F404.29
& (global_row .GT. glsize(2))) THEN GPB1F404.30
GPB1F404.31
WRITE(6,*) 'GLOBAL_TO_LOCAL_RC encountered ', GPB1F404.32
& 'impossible global row/column co-ordinates ', GPB1F404.33
& 'row: ',global_row,' column: ',global_column GPB1F404.34
GPB1F404.35
processor_x=st_no_data GPB1F404.36
processor_y=st_no_data GPB1F404.37
local_column=st_no_data GPB1F404.38
local_row=st_no_data GPB1F404.39
GPB1F404.40
ENDIF GPB1F404.41
GLTOLO1.308
! Make a first guess at the processor co-ordinates GLTOLO1.309
GLTOLO1.310
processor_x=MIN(global_column/(glsize(1)/gridsize(1)), GLTOLO1.311
& nproc_x-1) GLTOLO1.312
processor_y=MIN(global_row/(glsize(2)/gridsize(2)), GLTOLO1.313
& nproc_y-1) GLTOLO1.314
GLTOLO1.315
proc=processor_x+processor_y*gridsize(1) GLTOLO1.316
GLTOLO1.317
row_len_nh=g_blsizep(1,proc) GLTOLO1.318
IF (fld_type .EQ. fld_type_p) THEN GLTOLO1.319
nrows_nh=g_blsizep(2,proc) GLTOLO1.320
ELSE GLTOLO1.321
nrows_nh=g_blsizeu(2,proc) GLTOLO1.322
ENDIF GLTOLO1.323
GLTOLO1.324
start_col=g_datastart(1,proc) GLTOLO1.325
end_col=start_col+row_len_nh-1 GLTOLO1.326
start_row=g_datastart(2,proc) GLTOLO1.327
end_row=start_row+nrows_nh-1 GLTOLO1.328
GLTOLO1.329
! Now iterate around these processors until we hit the right one GLTOLO1.330
GLTOLO1.331
DO WHILE GLTOLO1.332
& (((global_column .LT. start_col) .OR. GLTOLO1.333
& (global_column .GT. end_col )) GLTOLO1.334
& .OR. GLTOLO1.335
& ((global_row .LT. start_row) .OR. GLTOLO1.336
& (global_row .GT. end_row))) GLTOLO1.337
GLTOLO1.338
GLTOLO1.339
IF (global_column .LT. start_col) THEN GLTOLO1.340
processor_x=processor_x-1 GPB0F404.59
ELSEIF (global_column .GT. end_col) THEN GLTOLO1.342
processor_x=processor_x+1 GPB0F404.60
ENDIF GLTOLO1.344
GLTOLO1.345
IF (global_row .LT. start_row) THEN GLTOLO1.346
processor_y=processor_y-1 GPB0F404.61
ELSEIF (global_row .GT. end_row) THEN GLTOLO1.348
processor_y=processor_y+1 GPB0F404.62
ENDIF GLTOLO1.350
GLTOLO1.351
proc=processor_x+processor_y*gridsize(1) GLTOLO1.352
GLTOLO1.353
row_len_nh=g_blsizep(1,proc) GPB1F404.42
IF (fld_type .EQ. fld_type_p) THEN GPB1F404.43
nrows_nh=g_blsizep(2,proc) GPB1F404.44
ELSE GPB1F404.45
nrows_nh=g_blsizeu(2,proc) GPB1F404.46
ENDIF GPB1F404.47
start_col=g_datastart(1,proc) GLTOLO1.354
end_col=start_col+row_len_nh-1 GLTOLO1.355
start_row=g_datastart(2,proc) GLTOLO1.356
end_row=start_row+nrows_nh-1 GLTOLO1.357
GLTOLO1.358
ENDDO GLTOLO1.359
GLTOLO1.360
! Now we have the processor co-ordinates, we can calculate the GLTOLO1.361
! local co-ordinates. GLTOLO1.362
GLTOLO1.363
local_column=Offx+global_column-start_col+1 GLTOLO1.364
local_row=Offy+global_row-start_row+1 GLTOLO1.365
GLTOLO1.366
9999 CONTINUE GLTOLO1.367
GLTOLO1.368
RETURN GLTOLO1.369
END GLTOLO1.370
GLTOLO1.371
! Function Interface GLTOLO1.372
INTEGER FUNCTION GET_FLD_TYPE (grid_type_code) 13GLTOLO1.373
GLTOLO1.374
IMPLICIT NONE GLTOLO1.375
GLTOLO1.376
! GLTOLO1.377
! Description: GLTOLO1.378
! Takes a STASH grid type code, and returns which type of GLTOLO1.379
! grid this is - mass or wind grid. GLTOLO1.380
! GLTOLO1.381
! Current code owner : Paul Burton GLTOLO1.382
! GLTOLO1.383
! History: GLTOLO1.384
! Model Date Modification history from model version 4.2 GLTOLO1.385
! version GLTOLO1.386
! 4.2 21/11/96 New deck created for MPP code. P.Burton GLTOLO1.387
! GLTOLO1.388
! Subroutine arguments: GLTOLO1.389
GLTOLO1.390
INTEGER GLTOLO1.391
& grid_type_code ! IN : STASH grid type code GLTOLO1.392
GLTOLO1.393
! Parameters GLTOLO1.394
*CALL CPPXREF
GLTOLO1.395
*CALL PARPARM
GLTOLO1.396
GLTOLO1.397
IF (((grid_type_code .GE. ppx_atm_tall) .AND. GLTOLO1.398
& (grid_type_code .LE. ppx_atm_tmerid)) .OR. GLTOLO1.399
& (grid_type_code .EQ. ppx_atm_cuall) .OR. GPB0F403.3245
& (grid_type_code .EQ. ppx_atm_ozone) .OR. GLTOLO1.400
& (grid_type_code .EQ. ppx_atm_compressed) .OR. GLTOLO1.401
& (grid_type_code .EQ. ppx_ocn_tall) .OR. GLTOLO1.402
& (grid_type_code .EQ. ppx_ocn_cuall) .OR. GPB0F403.3246
& (grid_type_code .EQ. ppx_ocn_tfield) .OR. GLTOLO1.403
& (grid_type_code .EQ. ppx_ocn_tzonal) .OR. GLTOLO1.404
& (grid_type_code .EQ. ppx_ocn_tmerid)) THEN GLTOLO1.405
GET_FLD_TYPE=fld_type_p GLTOLO1.406
ELSEIF GLTOLO1.407
& (((grid_type_code .GE. ppx_atm_uall) .AND. GLTOLO1.408
& (grid_type_code .LE. ppx_atm_umerid)) .OR. GLTOLO1.409
& (grid_type_code .EQ. ppx_atm_cvall) .OR. GPB0F403.3247
& (grid_type_code .EQ. ppx_ocn_uall) .OR. GLTOLO1.410
& (grid_type_code .EQ. ppx_ocn_cvall) .OR. GPB0F403.3248
& (grid_type_code .EQ. ppx_ocn_ufield) .OR. GLTOLO1.411
& (grid_type_code .EQ. ppx_ocn_uzonal) .OR. GLTOLO1.412
& (grid_type_code .EQ. ppx_ocn_umerid)) THEN GLTOLO1.413
GET_FLD_TYPE=fld_type_u GLTOLO1.414
ELSE GLTOLO1.415
GET_FLD_TYPE=fld_type_unknown GLTOLO1.416
ENDIF GLTOLO1.417
GLTOLO1.418
RETURN GLTOLO1.419
GLTOLO1.420
END GLTOLO1.421
GLTOLO1.422
*ENDIF GPB0F403.3249
*ENDIF GLTOLO1.423