*IF DEF,O35_1A,OR,DEF,PPTOANC UIE3F404.36
C ******************************COPYRIGHT****************************** GTS2F400.6571
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.6572
C GTS2F400.6573
C Use, duplication or disclosure of this code is subject to the GTS2F400.6574
C restrictions as set forth in the contract. GTS2F400.6575
C GTS2F400.6576
C Meteorological Office GTS2F400.6577
C London Road GTS2F400.6578
C BRACKNELL GTS2F400.6579
C Berkshire UK GTS2F400.6580
C RG12 2SZ GTS2F400.6581
C GTS2F400.6582
C If no contract has been raised with this copy of the code, the use, GTS2F400.6583
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.6584
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.6585
C Modelling at the above address. GTS2F400.6586
C ******************************COPYRIGHT****************************** GTS2F400.6587
C GTS2F400.6588
CLL Routines: OA_PACK, OA_UNPACK and OA_LEV_CMP OAPACK1A.3
CLL OAPACK1A.4
CLL Author: M. J. Bell Date: 7 January 1992 OAPACK1A.5
CLL OAPACK1A.6
CLL Model Modification history from model version 3.0: OAPACK1A.7
CLL version date OAPACK1A.8
CLL OAPACK1A.9
CLL 3.3 REAL_MDI declared as REAL not INTEGER in OA_PACK, OA_UNPACK. MB051293.3
CLL 4.4 Changes for uncompressed primary fields OFR0F404.1
CLL MB051293.4
CLL Logical components covered: OAPACK1A.10
CLL OAPACK1A.11
CLL Tested under compiler: VAX: Vax Fortran 5.4 Cray: cf77 OAPACK1A.12
CLL Tested under OS version: VAX: VAX/VMS V5.5 Cray: Unicos 5.0 OAPACK1A.13
CLL OAPACK1A.14
CLL Programming standard : FOAM Doc Paper 3/2/1 OAPACK1A.15
CLL OAPACK1A.16
C----------------------------------------------------------------------- OAPACK1A.17
C*L OAPACK1A.18
SUBROUTINE OA_PACK(ICODE, CMESSAGE, LL_AC_TIM, 2OAPACK1A.19
# NO_ROWS_M, NO_COLS_M, NO_LEVS_M, NO_SEG, NO_CMP_KLEV, OAPACK1A.20
# INDX_CMP, INDX_EXP, INDX_TO_ROWS, NO_CMP, REAL_MDI, OAPACK1A.21
# KLEV, I_FLD_TYP, LL_CYC_M, FLD_EXP, FLD_CMP) OAPACK1A.22
C* OAPACK1A.23
CLL Purpose: This subroutine packs one full field of model data OAPACK1A.24
CLL at a given level into compressed form. OAPACK1A.25
C OAPACK1A.26
IMPLICIT NONE OAPACK1A.27
C OAPACK1A.28
C*L ARGUMENT LIST OAPACK1A.29
C OAPACK1A.30
INTEGER ICODE ! return error code OAPACK1A.31
CHARACTER*256 CMESSAGE ! return error message ORH0F401.47
LOGICAL LL_AC_TIM ! T => time output on input and exit OAPACK1A.33
C Dimensions OAPACK1A.34
INTEGER NO_ROWS_M ! IN number of rows on model grid OAPACK1A.35
INTEGER NO_COLS_M ! IN number of columns on expanded model grid OAPACK1A.36
INTEGER NO_LEVS_M ! IN number of levels on model grid OAPACK1A.37
INTEGER NO_SEG ! IN total number of sea segments OAPACK1A.38
INTEGER NO_CMP_KLEV! IN number of sea points on this level OAPACK1A.39
C Compression and expansion indices OAPACK1A.40
INTEGER INDX_CMP(NO_SEG) ! IN contains position in compressed arra OAPACK1A.41
C of start of each sea segment OAPACK1A.42
INTEGER INDX_EXP(NO_SEG) ! IN contains position in expanded array OAPACK1A.43
C of start of each sea segment OAPACK1A.44
INTEGER INDX_TO_ROWS(NO_ROWS_M*NO_LEVS_M) ! IN contains number of OAPACK1A.45
C first/next sea segment for each row and level OAPACK1A.46
INTEGER NO_CMP ! IN total no of points in a 3D OAPACK1A.47
C compressed array OAPACK1A.48
REAL REAL_MDI ! IN missing data indicator MB051293.5
C Level and field type OAPACK1A.50
INTEGER KLEV ! IN model level OAPACK1A.51
INTEGER I_FLD_TYP ! IN =0 for tracers, =1 for currents OAPACK1A.52
LOGICAL LL_CYC_M ! T => FLD_EXP is cyclic in W-E OAPACK1A.53
C Fields OAPACK1A.54
REAL FLD_EXP(NO_COLS_M*NO_ROWS_M) ! IN data on expanded grid OAPACK1A.55
REAL FLD_CMP(NO_CMP_KLEV) ! OUT data on compressed grid OAPACK1A.56
C* OAPACK1A.57
CL NO PARAMETERS OAPACK1A.58
C OAPACK1A.59
CL* NO WORK ARRAYS OAPACK1A.60
C OAPACK1A.61
C NO EXTERNAL SUBROUTINES CALLED OAPACK1A.62
C OAPACK1A.63
C LIST OF OTHER VARIABLES OAPACK1A.64
C OAPACK1A.65
INTEGER ICYC ! number of columns of expanded field; sec. 1. OAPACK1A.66
INTEGER ICOUNT ! index for loop over points in segment OAPACK1A.67
INTEGER INC_CYC ! extra columns on cyclic grid; sec. 1 OAPACK1A.68
INTEGER IPT_CMP ! pointer to location in compressed field OAPACK1A.69
INTEGER IPT_EXP ! pointer to location in 3D expanded field OAPACK1A.70
INTEGER IPT_EXP_CYC ! pointer to location in 2D expanded cyclic fi OAPACK1A.71
INTEGER IPT_SEG ! segment index number OAPACK1A.72
INTEGER ISEG ! index for loop over segments in row OAPACK1A.73
INTEGER ISEG_ST ! first segment on this level OAPACK1A.74
INTEGER IST_CMP_M1 ! index of 1st point in compressed field at th OAPACK1A.75
C level, minus one OAPACK1A.76
INTEGER IST_EXP_M1 ! index of 1st point in expanded field at this OAPACK1A.77
C level (for non-cyclic grid), minus one OAPACK1A.78
INTEGER J ! index for loop over rows on level OAPACK1A.79
INTEGER JPT ! point index number OAPACK1A.80
INTEGER LEN_SEG ! number of grid points in current segment OAPACK1A.81
INTEGER NO_SEG_ROW ! number of segments in row OAPACK1A.82
C* OAPACK1A.83
C----------------------------------------------------------------------- OAPACK1A.84
C OAPACK1A.85
CL 1. Prelminaries OAPACK1A.86
C OAPACK1A.87
CL 1.1 Set the number of columns of distinct data OAPACK1A.88
IF (LL_CYC_M) THEN OAPACK1A.89
INC_CYC = 2 OAPACK1A.90
ICYC = NO_COLS_M - 2 OAPACK1A.91
ELSE OAPACK1A.92
INC_CYC = 0 OAPACK1A.93
ICYC = NO_COLS_M OAPACK1A.94
END IF OAPACK1A.95
C OAPACK1A.96
CL 1.2 Set offsets for compressed and expanded fields at this level OAPACK1A.97
ISEG_ST = INDX_TO_ROWS(NO_ROWS_M*(KLEV-1) + 1) OAPACK1A.98
IST_CMP_M1 = INDX_CMP(ISEG_ST) - 1 OAPACK1A.99
IST_EXP_M1 = (KLEV-1)*NO_ROWS_M*ICYC OAPACK1A.100
C OAPACK1A.101
CL 2. Loop over rows (index J) OAPACK1A.102
C OAPACK1A.103
CL 2.1 Force multitasking over loop over rows (index J) OAPACK1A.104
C OAPACK1A.105
CMIC$ DO ALL SHARED(FLD_EXP, FLD_CMP, ICYC,INC_CYC, I_FLD_TYP, OAPACK1A.106
CMIC$1 INDX_TO_ROWS, INDX_CMP, INDX_EXP, IST_CMP_M1, IST_EXP_M1, OAPACK1A.107
CMIC$2 KLEV, LL_CYC_M, NO_ROWS_M, NO_LEVS_M, NO_SEG, NO_CMP, OAPACK1A.108
CMIC$3 REAL_MDI) OAPACK1A.109
CMIC$4 PRIVATE(ICOUNT, IPT_CMP, IPT_EXP, IPT_EXP_CYC, IPT_SEG, OAPACK1A.110
CMIC$5 ISEG, J, JPT, LEN_SEG, NO_SEG_ROW) OAPACK1A.111
C OAPACK1A.112
CL 2.2 Start loop over rows and define the pointer to the row OAPACK1A.113
C OAPACK1A.114
DO J = 1, NO_ROWS_M OAPACK1A.115
JPT = (KLEV - 1)*NO_ROWS_M + J OAPACK1A.116
C OAPACK1A.117
CL 2.3 Calculate the number of sea segments in the row OAPACK1A.118
C OAPACK1A.119
IF (JPT .EQ. NO_LEVS_M*NO_ROWS_M ) THEN OAPACK1A.120
NO_SEG_ROW = NO_SEG - INDX_TO_ROWS(JPT) + 1 OAPACK1A.121
ELSE OAPACK1A.122
NO_SEG_ROW = INDX_TO_ROWS(JPT+1) - INDX_TO_ROWS(JPT) OAPACK1A.123
END IF OAPACK1A.124
C OAPACK1A.125
CL 2.4 Start loop over sea segments and define pointer to segment OAPACK1A.126
DO ISEG = 1, NO_SEG_ROW OAPACK1A.127
IPT_SEG = INDX_TO_ROWS(JPT) + ISEG - 1 OAPACK1A.128
C OAPACK1A.129
CL 2.5 Calculate the length of the present sea segment OAPACK1A.130
C OAPACK1A.131
IF (IPT_SEG .LT. NO_SEG) THEN OAPACK1A.132
LEN_SEG = INDX_CMP(IPT_SEG+1) - INDX_CMP(IPT_SEG) OAPACK1A.133
ELSE OAPACK1A.134
LEN_SEG = NO_CMP - INDX_CMP(IPT_SEG) + 1 OAPACK1A.135
END IF OAPACK1A.136
C OAPACK1A.137
CL 2.6 Calculate FLD_CMP for all points in the segment OAPACK1A.138
CL (the last point may be overwritten in 2.7 if I_FLD_TYP = 1) OAPACK1A.139
C OAPACK1A.140
DO ICOUNT = 1, LEN_SEG OAPACK1A.141
IPT_EXP = INDX_EXP(IPT_SEG) + ICOUNT - 1 OAPACK1A.142
IPT_EXP_CYC = IPT_EXP - IST_EXP_M1 + INC_CYC*(J-1) OAPACK1A.143
IPT_CMP = INDX_CMP(IPT_SEG) + ICOUNT - 1 OAPACK1A.144
FLD_CMP(IPT_CMP - IST_CMP_M1) = FLD_EXP(IPT_EXP_CYC) OAPACK1A.145
END DO ! index ICOUNT OAPACK1A.146
C OAPACK1A.147
CL 2.7 Case of current field: OAPACK1A.148
C OAPACK1A.149
IF (I_FLD_TYP .EQ. 1) THEN OAPACK1A.150
C OAPACK1A.151
CL Last value in segment is only retained if grid is cyclic and OAPACK1A.152
CL the first point on the row is ICYC-1 points before it. OAPACK1A.153
IF(LL_CYC_M)THEN OAPACK1A.154
IF(IPT_EXP-INDX_EXP(IPT_SEG+1-ISEG) .NE. ICYC-1)THEN OAPACK1A.155
FLD_CMP(IPT_CMP - IST_CMP_M1) = REAL_MDI OAPACK1A.156
END IF OAPACK1A.157
ELSE OAPACK1A.158
FLD_CMP(IPT_CMP - IST_CMP_M1) = REAL_MDI OAPACK1A.159
END IF OAPACK1A.160
END IF OAPACK1A.161
C OAPACK1A.162
END DO ! index ISEG OAPACK1A.163
C OAPACK1A.164
END DO ! index J OAPACK1A.165
C OAPACK1A.166
CL End loop over rows OAPACK1A.167
C OAPACK1A.168
RETURN OAPACK1A.169
END OAPACK1A.170
C OAPACK1A.171
C----------------------------------------------------------------------- OAPACK1A.172
C*L OAPACK1A.173
SUBROUTINE OA_UNPACK(ICODE, CMESSAGE, LL_AC_TIM, OAPACK1A.174
# NO_ROWS_M, NO_COLS_M, NO_LEVS_M, NO_SEG, NO_CMP_KLEV, OAPACK1A.175
# INDX_CMP, INDX_EXP, INDX_TO_ROWS, NO_CMP, REAL_MDI, OAPACK1A.176
# KLEV, I_FLD_TYP, LL_CYC_M, FLD_CMP, FLD_EXP) OAPACK1A.177
C* OAPACK1A.178
CLL Purpose: This subroutine unpacks one full field of model data OAPACK1A.179
CLL at a given level into expanded form. OAPACK1A.180
C OAPACK1A.181
IMPLICIT NONE OAPACK1A.182
C OAPACK1A.183
C*L ARGUMENT LIST OAPACK1A.184
C OAPACK1A.185
INTEGER ICODE ! return error code OAPACK1A.186
CHARACTER*256 CMESSAGE ! return error message ORH0F401.48
LOGICAL LL_AC_TIM ! T => time output on input and exit OAPACK1A.188
C Dimensions OAPACK1A.189
INTEGER NO_ROWS_M ! IN number of rows on model grid OAPACK1A.190
INTEGER NO_COLS_M ! IN number of columns on expanded model grid OAPACK1A.191
INTEGER NO_LEVS_M ! IN number of levels on model grid OAPACK1A.192
INTEGER NO_SEG ! IN total number of sea segments OAPACK1A.193
INTEGER NO_CMP_KLEV ! IN number of sea points on this level OAPACK1A.194
C Compression and expansion indices OAPACK1A.195
INTEGER INDX_CMP(NO_SEG) ! IN contains position in compressed arra OAPACK1A.196
C of start of each sea segment OAPACK1A.197
INTEGER INDX_EXP(NO_SEG) ! IN contains position in expanded array OAPACK1A.198
C of start of each sea segment OAPACK1A.199
INTEGER INDX_TO_ROWS(NO_ROWS_M*NO_LEVS_M) ! IN contains number of OAPACK1A.200
C first/next sea segment for each row and level OAPACK1A.201
INTEGER NO_CMP ! IN total no of points in a 3D OAPACK1A.202
C compressed array OAPACK1A.203
REAL REAL_MDI ! IN missing data indicator MB051293.6
C Level and field type OAPACK1A.205
INTEGER KLEV ! IN model level OAPACK1A.206
INTEGER I_FLD_TYP ! IN =0 for tracers, =1 for currents OAPACK1A.207
LOGICAL LL_CYC_M ! T => FLD_EXP is cyclic in W-E OAPACK1A.208
C Fields OAPACK1A.209
REAL FLD_CMP(NO_CMP_KLEV) ! IN data on compressed grid OAPACK1A.210
REAL FLD_EXP(NO_COLS_M*NO_ROWS_M) ! OUT data on expanded grid OAPACK1A.211
C* OAPACK1A.212
CL NO PARAMETERS OAPACK1A.213
C OAPACK1A.214
CL* NO WORK ARRAYS OAPACK1A.215
C OAPACK1A.216
C NO EXTERNAL SUBROUTINES CALLED OAPACK1A.217
C OAPACK1A.218
C LIST OF OTHER VARIABLES OAPACK1A.219
C OAPACK1A.220
INTEGER ICOUNT ! index for loop over points in segment OAPACK1A.221
INTEGER IJ ! index for loop over all points on level OAPACK1A.222
INTEGER INC_CYC ! extra columns on cyclic grid; sec. 1.2 OAPACK1A.223
INTEGER INC_ROW ! no. of pts in cyclic grid before this row OAPACK1A.224
INTEGER IPT_CMP ! pointer to location in compressed field OAPACK1A.225
INTEGER IPT_EXP ! pointer to location in 3D expanded field OAPACK1A.226
INTEGER IPT_EXP_CYC ! pointer to location in 2D expanded cyclic fi OAPACK1A.227
INTEGER IPT_SEG ! segment index number OAPACK1A.228
INTEGER ISEG ! index for loop over segments in row OAPACK1A.229
INTEGER ISEG_ST ! index for first segment on this level OAPACK1A.230
INTEGER IST_CMP_M1 ! index of 1st point in compressed field at th OAPACK1A.231
C level, minus one OAPACK1A.232
INTEGER IST_EXP_M1 ! index of 1st point in expanded field at this OAPACK1A.233
C level (for non-cyclic grid), minus one OAPACK1A.234
INTEGER J ! index for loop over rows on level OAPACK1A.235
INTEGER JPT ! point index number OAPACK1A.236
INTEGER LEN_SEG ! number of grid points in current segment OAPACK1A.237
INTEGER NO_SEG_ROW ! number of segments in row OAPACK1A.238
C* OAPACK1A.239
C----------------------------------------------------------------------- OAPACK1A.240
C OAPACK1A.241
CL 1. Preliminaries OAPACK1A.242
C OAPACK1A.243
CL 1.1 Fill the expanded array with real missing data indicators OAPACK1A.244
C OAPACK1A.245
DO IJ = 1, NO_COLS_M*NO_ROWS_M OAPACK1A.246
FLD_EXP(IJ) = REAL_MDI OAPACK1A.247
END DO OAPACK1A.248
C OAPACK1A.249
CL 1.2 Set the number of extra columns for cyclic overlap OAPACK1A.250
C OAPACK1A.251
IF (LL_CYC_M) THEN OAPACK1A.252
INC_CYC = 2 OAPACK1A.253
ELSE OAPACK1A.254
INC_CYC = 0 OAPACK1A.255
END IF OAPACK1A.256
C OAPACK1A.257
CL 1.3 Set offsets for compressed and expanded grids for this level OAPACK1A.258
ISEG_ST = INDX_TO_ROWS(NO_ROWS_M*(KLEV-1) + 1) OAPACK1A.259
IST_CMP_M1 = INDX_CMP(ISEG_ST) - 1 OAPACK1A.260
IST_EXP_M1 = (KLEV-1)*NO_ROWS_M*(NO_COLS_M - INC_CYC) OAPACK1A.261
C OAPACK1A.262
CL 2. Loop over rows (index J) OAPACK1A.263
C OAPACK1A.264
CL 2.1 Force multitasking over loop over rows OAPACK1A.265
C OAPACK1A.266
CMIC$ DO ALL SHARED(FLD_EXP, FLD_CMP, INC_CYC, I_FLD_TYP, OAPACK1A.267
CMIC$1 INDX_TO_ROWS, INDX_CMP, INDX_EXP, IST_CMP_M1, IST_EXP_M1, OAPACK1A.268
CMIC$2 KLEV, LL_CYC_M, NO_ROWS_M, NO_LEVS_M, NO_SEG, NO_CMP, OAPACK1A.269
CMIC$3 REAL_MDI) OAPACK1A.270
CMIC$4 PRIVATE(ICOUNT, INC_ROW, IPT_CMP, IPT_EXP, IPT_EXP_CYC, OAPACK1A.271
CMIC$5 IPT_SEG, ISEG, J, JPT, LEN_SEG, NO_SEG_ROW) OAPACK1A.272
C OAPACK1A.273
CL 2.2 Start loop over rows and define the pointer to the row OAPACK1A.274
C OAPACK1A.275
DO J = 1, NO_ROWS_M OAPACK1A.276
JPT = (KLEV - 1)*NO_ROWS_M + J OAPACK1A.277
C OAPACK1A.278
CL 2.3 Calculate the number of sea segments in the row OAPACK1A.279
C OAPACK1A.280
IF (JPT .EQ. NO_LEVS_M*NO_ROWS_M ) THEN OAPACK1A.281
NO_SEG_ROW = NO_SEG - INDX_TO_ROWS(JPT) + 1 OAPACK1A.282
ELSE OAPACK1A.283
NO_SEG_ROW = INDX_TO_ROWS(JPT+1) - INDX_TO_ROWS(JPT) OAPACK1A.284
END IF OAPACK1A.285
C OAPACK1A.286
CL 2.4 Start loop over sea segments and define pointer to segment OAPACK1A.287
DO ISEG = 1, NO_SEG_ROW OAPACK1A.288
IPT_SEG = INDX_TO_ROWS(JPT) + ISEG - 1 OAPACK1A.289
C OAPACK1A.290
CL 2.5 Calculate the length of the present sea segment OAPACK1A.291
C OAPACK1A.292
IF (IPT_SEG .LT. NO_SEG) THEN OAPACK1A.293
LEN_SEG = INDX_CMP(IPT_SEG+1) - INDX_CMP(IPT_SEG) OAPACK1A.294
ELSE OAPACK1A.295
LEN_SEG = NO_CMP - INDX_CMP(IPT_SEG) + 1 OAPACK1A.296
END IF OAPACK1A.297
C OAPACK1A.298
CL 2.6 Calculate FLD_CMP for all points in the segment OAPACK1A.299
C OAPACK1A.300
DO ICOUNT = 1, LEN_SEG OAPACK1A.301
IPT_EXP = INDX_EXP(IPT_SEG) + ICOUNT - 1 OAPACK1A.302
IPT_EXP_CYC = IPT_EXP - IST_EXP_M1 + INC_CYC*(J-1) OAPACK1A.303
IPT_CMP = INDX_CMP(IPT_SEG) + ICOUNT - 1 OAPACK1A.304
FLD_EXP(IPT_EXP_CYC) = FLD_CMP(IPT_CMP - IST_CMP_M1) OAPACK1A.305
END DO ! index ICOUNT OAPACK1A.306
C OAPACK1A.307
END DO ! index ISEG OAPACK1A.308
C OAPACK1A.309
END DO ! index J OAPACK1A.310
C OAPACK1A.311
CL End loop over rows OAPACK1A.312
C OAPACK1A.313
CL 3. Put in cyclic points if necessary OAPACK1A.314
C OAPACK1A.315
IF(LL_CYC_M)THEN OAPACK1A.316
DO J = 1, NO_ROWS_M OAPACK1A.317
INC_ROW = (J-1)*NO_COLS_M OAPACK1A.318
FLD_EXP(INC_ROW + NO_COLS_M - 1) = FLD_EXP(INC_ROW + 1) OAPACK1A.319
FLD_EXP(INC_ROW + NO_COLS_M) = FLD_EXP(INC_ROW + 2) OAPACK1A.320
END DO OAPACK1A.321
END IF OAPACK1A.322
CL OAPACK1A.323
RETURN OAPACK1A.324
END OAPACK1A.325
C OAPACK1A.326
C----------------------------------------------------------------------- OAPACK1A.327
C*L OAPACK1A.328
SUBROUTINE OA_LEV_CMP(L_OCOMP, NO_ROWS_M, NO_COLS_M, NO_LEVS_M OFR0F404.2
& ,NO_SEG, INDX_CMP, INDX_TO_ROWS, NO_CMP, KLEV OFR0F404.3
& ,KLEV_OFF_CMP, NO_CMP_KLEV, KLEV_OFF_UV, NO_UV_KLEV) OFR0F404.4
C* OAPACK1A.331
CLL Purpose: This subroutine calculates the index of the first value OAPACK1A.332
CLL and the number of points in the 3D compressed array OAPACK1A.333
CLL or 3D uncompressed array for a given level OFR0F404.5
C OAPACK1A.335
IMPLICIT NONE OAPACK1A.336
C OAPACK1A.337
C*L ARGUMENT LIST OAPACK1A.338
C OAPACK1A.339
C Logicals OFR0F404.6
LOGICAL L_OCOMP ! IN T => field has land points compressed out OFR0F404.7
C Dimensions OAPACK1A.340
INTEGER NO_ROWS_M ! IN number of rows on model grid OAPACK1A.341
INTEGER NO_COLS_M ! IN number of columns on model grid OFR0F404.8
INTEGER NO_LEVS_M ! IN number of levels on model grid OAPACK1A.342
INTEGER NO_SEG ! IN number of sea segments in 3D compressed fi OAPACK1A.343
C Compression and expansion indices OAPACK1A.344
INTEGER INDX_CMP(NO_SEG) ! IN index in compressed array of start o OAPACK1A.345
C each sea segment OAPACK1A.346
INTEGER INDX_TO_ROWS(NO_ROWS_M*NO_LEVS_M) ! IN index of first/next OAPACK1A.347
C sea segment for each row and level OAPACK1A.348
INTEGER NO_CMP ! IN total no of points in a 3D OAPACK1A.349
C Level OAPACK1A.350
INTEGER KLEV ! IN model level OAPACK1A.351
C Output OAPACK1A.352
INTEGER KLEV_OFF_CMP ! OUT offset of 1st compressed point on this OAPACK1A.353
C level from 1st compressed point OAPACK1A.354
INTEGER NO_CMP_KLEV ! OUT number of compressed points on this lev OAPACK1A.355
INTEGER KLEV_OFF_UV ! OUT offset to u-v grid data on this level OFR0F404.9
INTEGER NO_UV_KLEV ! OUT no. of u-v grid points on this level OFR0F404.10
C* OAPACK1A.356
C LIST OF OTHER VARIABLES OAPACK1A.357
INTEGER ISEG_ST ! index for first segment on this level OAPACK1A.358
INTEGER ISEG_NXT ! index for first segment on next level OAPACK1A.359
C* OAPACK1A.360
C----------------------------------------------------------------------- OAPACK1A.361
C OAPACK1A.362
IF (.NOT. L_OCOMP) THEN ! the field is uncompressed OFR0F404.11
OFR0F404.12
NO_CMP_KLEV = NO_ROWS_M * NO_COLS_M OFR0F404.13
KLEV_OFF_CMP = (KLEV-1) * NO_CMP_KLEV OFR0F404.14
*IF DEF,MPP OFR0F404.15
! u and v fields have same no. of rows as t field in MPP mode OFR0F404.16
NO_UV_KLEV = NO_ROWS_M * NO_COLS_M OFR0F404.17
*ELSE OFR0F404.18
! u and v fields have 1 row less than t field in non-MPP mode OFR0F404.19
NO_UV_KLEV = (NO_ROWS_M-1) * NO_COLS_M OFR0F404.20
*ENDIF OFR0F404.21
KLEV_OFF_UV = (KLEV-1) * NO_UV_KLEV OFR0F404.22
OFR0F404.23
ELSE ! if the field is compressed OFR0F404.24
OFR0F404.25
CL 1. Find KLEV_OFF_CMP OAPACK1A.363
ISEG_ST = INDX_TO_ROWS( (KLEV-1)*NO_ROWS_M + 1) OAPACK1A.364
KLEV_OFF_CMP = INDX_CMP(ISEG_ST) - 1 OAPACK1A.365
C OAPACK1A.366
CL 2. Find NO_CMP_KLEV OAPACK1A.367
IF (KLEV .NE. NO_LEVS_M) THEN OAPACK1A.368
ISEG_NXT = INDX_TO_ROWS( KLEV*NO_ROWS_M + 1) OAPACK1A.369
NO_CMP_KLEV = INDX_CMP(ISEG_NXT) - KLEV_OFF_CMP - 1 OAPACK1A.370
ELSE OAPACK1A.371
NO_CMP_KLEV = NO_CMP - KLEV_OFF_CMP OAPACK1A.372
END IF OAPACK1A.373
C OAPACK1A.374
NO_UV_KLEV = NO_CMP_KLEV OFR0F404.26
KLEV_OFF_UV = KLEV_OFF_CMP OFR0F404.27
OFR0F404.28
END IF ! L_OCOMP OFR0F404.29
OFR0F404.30
RETURN OAPACK1A.375
END OAPACK1A.376
C OAPACK1A.377
C----------------------------------------------------------------------- OAPACK1A.378
*ENDIF O35_1A OAPACK1A.379