*IF DEF,CONTROL,AND,DEF,OCEAN PACK1.2
C ******************************COPYRIGHT****************************** GTS2F400.7147
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.7148
C GTS2F400.7149
C Use, duplication or disclosure of this code is subject to the GTS2F400.7150
C restrictions as set forth in the contract. GTS2F400.7151
C GTS2F400.7152
C Meteorological Office GTS2F400.7153
C London Road GTS2F400.7154
C BRACKNELL GTS2F400.7155
C Berkshire UK GTS2F400.7156
C RG12 2SZ GTS2F400.7157
C GTS2F400.7158
C If no contract has been raised with this copy of the code, the use, GTS2F400.7159
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.7160
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.7161
C Modelling at the above address. GTS2F400.7162
C ******************************COPYRIGHT****************************** GTS2F400.7163
C GTS2F400.7164
CLL Routines: PACK ---------------------------------------------------- PACK1.3
CLL PACK1.4
CLL Purpose: This subroutine uses the index arrays PACK1.5
CLL PACK1.6
CLL INDEX_COMP(N_SEG), INDEX_EXP(N_SEG) and PACK1.7
CLL INDEX_TO_ROWS(MAX_ROW,MAX_LEVEL) PACK1.8
CLL to pack data from T(IMAX,JMAX,KMAX) into T_COMP(N_COMP) PACK1.9
CLL PACK1.10
CLL Tested under compiler: cft77,(cf77 -ZP) PACK1.11
CLL Tested under OS version: UNICOS 5.1 PACK1.12
CLL PACK1.13
CLL Author: S.J.Nightingale Date: 20 February 1991 PACK1.14
CLL PACK1.15
CLL Model Modification history from model version 3.0: PACK1.16
CLL version date PACK1.17
CLL PACK1.18
CLL programming standard : UMDOC PAPER NUMBER 3 (CONTROL ROUTINES) PACK1.19
CLL PACK1.20
CLL system components covered : S71 PACK1.21
CLL PACK1.22
CLL External documentation: PACK1.23
CLL PACK1.24
CLLEND----------------------------------------------------------------- PACK1.25
C*L PACK1.26
SUBROUTINE PACK(FIELD,J1,J2,K1,K2,MAX_ROW,MAX_LEVEL, 3PACK1.27
*IMAX,JMAX,KMAX,INDEX_COMP,INDEX_EXP,N_SEG,INDEX_TO_ROWS, PACK1.28
*N_COMP,T_COMP,T,REAL_MDI,CYCLIC) PACK1.29
C* PACK1.30
IMPLICIT NONE PACK1.31
PACK1.32
C Argument variables PACK1.33
C PACK1.34
INTEGER PACK1.35
* FIELD ! (IN) SET FIELD=0 FOR TRACERS, FIELD=1 FOR CURRENTS PACK1.36
*,J1 ! (IN) FIRST ROW OF DATA TO BE PACKED PACK1.37
*,J2 ! (IN) LAST ROW OF DATA TO BE PACKED PACK1.38
*,K1 ! (IN) FIRST LEVEL OF DATA TO BE PACKED PACK1.39
*,K2 ! (IN) LAST LEVEL OF DATA TO BE PACKED PACK1.40
*,IMAX ! (IN) TOTAL NUMBER OF DATA POINTS EAST-WEST PACK1.41
*,JMAX ! (IN) NUMBER OF POINTS NORTH-SOUTH PACK1.42
C ! IN SECTION OF DATA TO BE PACKED PACK1.43
*,KMAX ! (IN) NUMBER OF POINTS IN VERTICAL PACK1.44
C ! IN SECTION OF DATA TO BE PACKED PACK1.45
*,MAX_ROW ! (IN) UPPER LIMIT ON JMAX PACK1.46
*,MAX_LEVEL ! (IN) UPPER LIMIT ON KMAX PACK1.47
*,N_SEG ! (IN) TOTAL NUMBER OF SEA SEGMENTS PACK1.48
*,N_COMP ! (IN) DIMENSION OF COMPRESSED ARRAY PACK1.49
*,INDEX_COMP(N_SEG) ! (IN) CONTAINS POSITIONS IN COMPRESSED PACK1.50
C ! ARRAY OF START OF EACH SEA SEGMENT PACK1.51
*,INDEX_EXP(N_SEG) ! (IN) CONTAINS POSITIONS IN 1-DIMENSIONAL PACK1.52
C ! EXPANDED ARRAY OF START OF EACH SEA SEGMENT PACK1.53
*,INDEX_TO_ROWS(MAX_ROW,MAX_LEVEL) ! (IN) CONTAINS NUMBER OF FIRST PACK1.54
C ! SEA SEGMENT IN EACH ROW PACK1.55
C ! AT EACH LEVEL IF THERE IS A PACK1.56
C ! SEA SEGMENT IN THE ROW PACK1.57
C ! CONTAINS NUMBER OF NEXT PACK1.58
C ! SEA SEGMENT OTHERWISE PACK1.59
PACK1.60
REAL PACK1.61
* REAL_MDI ! (IN) REAL MISSING DATA INDICATOR PACK1.62
*,T_COMP(N_COMP) ! (OUT) COMPRESSED ARRAY PACK1.63
*,T(IMAX,JMAX,KMAX) ! (IN) 3-DIMENSIONAL ARRAY OF DATA TO BE PACK1.64
C ! PACKED PACK1.65
PACK1.66
LOGICAL PACK1.67
* CYCLIC ! (IN) INDICATES WHETHER T(IMAX,JMAX,KMAX) INCLUDES PACK1.68
C ! DATA FOR CYCLIC WRAP-AROUND POINTS PACK1.69
PACK1.70
CL local variables PACK1.71
INTEGER PACK1.72
* J ! LOCAL LOOP INDEX FOR ROWS PACK1.73
*,K ! LOCAL LOOP INDEX FOR LEVELS PACK1.74
*,JN,KN ! LOCAL TEMPS PACK1.75
*,JSPAN ! LOCAL NUMBER OF ITERATIONS OF ROWS PACK1.76
*,KSPAN ! LOCAL NUMBER OF ITERATIONS OF LEVELS PACK1.77
*,J30 ! LOCAL LOOP INDEX OF ROWS-LEVELS LOOP PACK1.78
*,NUM_SEG ! NUMBER OF SEA SEGMENTS IN PRESENT ROW PACK1.79
*,LEN_SEG ! LENGTH OF PRESENT SEA SEGMENT PACK1.80
*,COUNT ! LOCAL COUNTER FOR POINTS IN A SEA SEGMENT PACK1.81
*,SEG ! LOCAL LOOP INDEX FOR SEA SEGMENTS IN PRESENT ROW PACK1.82
*,SEG_POS ! LOCAL COUNTER FOR SEA SEGMENTS PACK1.83
*,X_POS ! LOCAL COUNTER FOR POINTS IN A ROW PACK1.84
*,IPOINT_EXP ! LOCAL POINTER TO EXPANDED ARRAY PACK1.85
*,IPOINT_COMP ! LOCAL POINTER TO COMPRESSED ARRAY PACK1.86
*,I_DATA ! NUMBER OF DISTINCT DATA POINTS EAST-WEST PACK1.87
PACK1.88
CL---------------------------------------------------------------------- PACK1.89
CL 1. Set the wrap-around parameters PACK1.90
PACK1.91
IF (CYCLIC) THEN PACK1.92
I_DATA=IMAX-2 PACK1.93
ELSE PACK1.94
I_DATA=IMAX PACK1.95
END IF PACK1.96
PACK1.97
CL---------------------------------------------------------------------- PACK1.98
CL 2. Loop over levels and rows packing PACK1.99
PACK1.100
CL 2.1 Set up span of j and k loops PACK1.101
JSPAN = J2 - J1 + 1 PACK1.102
KSPAN = K2 - K1 + 1 PACK1.103
PACK1.104
CL 2.2 Force multitasking over loop 30 PACK1.105
PACK1.106
CMIC$ DO ALL SHARED(MAX_ROW,K1,K2,J1,J2,MAX_LEVEL,N_SEG,N_COMP, PACK1.107
CMIC$1 I_DATA,INDEX_TO_ROWS,INDEX_COMP,INDEX_EXP, PACK1.108
CMIC$2 FIELD,REAL_MDI,T,JSPAN,KSPAN,T_COMP) PACK1.109
CMIC$3 PRIVATE(K,J,JN,KN,NUM_SEG,SEG_POS,LEN_SEG,IPOINT_EXP, PACK1.110
CMIC$4 IPOINT_COMP,X_POS,COUNT,SEG,J30) PACK1.111
PACK1.112
DO 30,J30=0,JSPAN*KSPAN-1 PACK1.113
PACK1.114
CL 2.3 Set up indices to the 2-d array PACK1.115
PACK1.116
K = J30/JSPAN PACK1.117
J = J30 - K*JSPAN + J1 PACK1.118
K = K + K1 PACK1.119
PACK1.120
CL 2.4 Define the next row and level PACK1.121
PACK1.122
IF (J.EQ.MAX_ROW) THEN PACK1.123
JN=1 PACK1.124
KN=K+1 PACK1.125
ELSE PACK1.126
JN=J+1 PACK1.127
KN=K PACK1.128
END IF PACK1.129
PACK1.130
CL 2.5 Calculate the number of sea segments in the present row PACK1.131
PACK1.132
IF (KN.GT.MAX_LEVEL) THEN PACK1.133
NUM_SEG=N_SEG-INDEX_TO_ROWS(J,K)+1 PACK1.134
ELSE PACK1.135
NUM_SEG=INDEX_TO_ROWS(JN,KN)-INDEX_TO_ROWS(J,K) PACK1.136
END IF PACK1.137
PACK1.138
DO 20,SEG=1,NUM_SEG PACK1.139
SEG_POS=INDEX_TO_ROWS(J,K)+SEG-1 PACK1.140
PACK1.141
CL 2.6 Calculate the length of the present sea segment PACK1.142
PACK1.143
IF (SEG_POS.LT.N_SEG) THEN PACK1.144
LEN_SEG=INDEX_COMP(SEG_POS+1)-INDEX_COMP(SEG_POS) PACK1.145
ELSE PACK1.146
LEN_SEG=N_COMP-INDEX_COMP(SEG_POS)+1 PACK1.147
END IF PACK1.148
PACK1.149
CL 2.7 Calculate t_comp for all points in the segment except the last PACK1.150
PACK1.151
DO 10,COUNT=1,LEN_SEG-1 PACK1.152
IPOINT_EXP=INDEX_EXP(SEG_POS)+COUNT-1 PACK1.153
IPOINT_COMP=INDEX_COMP(SEG_POS)+COUNT-1 PACK1.154
X_POS=IPOINT_EXP-(K-1)*I_DATA*MAX_ROW-(J-1)*I_DATA PACK1.155
T_COMP(IPOINT_COMP)=T(X_POS,J-J1+1,K-K1+1) PACK1.156
10 CONTINUE PACK1.157
PACK1.158
CL 2.8 Calculate t_comp for the last point in the segment PACK1.159
PACK1.160
IPOINT_EXP=INDEX_EXP(SEG_POS)+LEN_SEG-1 PACK1.161
IPOINT_COMP=INDEX_COMP(SEG_POS)+LEN_SEG-1 PACK1.162
X_POS=IPOINT_EXP-(K-1)*I_DATA*MAX_ROW-(J-1)*I_DATA PACK1.163
PACK1.164
CL 2.9 Case of tracer field: set t_comp as before PACK1.165
PACK1.166
IF (FIELD.EQ.0) THEN PACK1.167
T_COMP(IPOINT_COMP)=T(X_POS,J-J1+1,K-K1+1) PACK1.168
PACK1.169
CL 2.10 Case of current field: PACK1.170
PACK1.171
ELSE IF (FIELD.EQ.1) THEN PACK1.172
PACK1.173
CL 2.11 Case of sea segment crossing the longitude boundary: PACK1.174
PACK1.175
IF ((X_POS.EQ.I_DATA).AND. PACK1.176
* (INDEX_EXP(INDEX_TO_ROWS(J,K)).EQ. PACK1.177
* (1+(J-1)*I_DATA+(K-1)*I_DATA*MAX_ROW))) PACK1.178
* THEN PACK1.179
T_COMP(IPOINT_COMP)=T(X_POS,J-J1+1,K-K1+1) PACK1.180
PACK1.181
CL 2.12 Set t_comp to real missing data indicator otherwise PACK1.182
PACK1.183
ELSE PACK1.184
T_COMP(IPOINT_COMP)=REAL_MDI PACK1.185
END IF PACK1.186
END IF PACK1.187
20 CONTINUE PACK1.188
30 CONTINUE PACK1.189
PACK1.190
RETURN PACK1.191
END PACK1.192
*ENDIF PACK1.193