*IF DEF,CONTROL,AND,DEF,OCEAN,OR,DEF,CONVPP,OR,DEF,CONVIEEE UDG1F405.31
C ******************************COPYRIGHT****************************** GTS2F400.10819
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.10820
C GTS2F400.10821
C Use, duplication or disclosure of this code is subject to the GTS2F400.10822
C restrictions as set forth in the contract. GTS2F400.10823
C GTS2F400.10824
C Meteorological Office GTS2F400.10825
C London Road GTS2F400.10826
C BRACKNELL GTS2F400.10827
C Berkshire UK GTS2F400.10828
C RG12 2SZ GTS2F400.10829
C GTS2F400.10830
C If no contract has been raised with this copy of the code, the use, GTS2F400.10831
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.10832
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.10833
C Modelling at the above address. GTS2F400.10834
C ******************************COPYRIGHT****************************** GTS2F400.10835
C GTS2F400.10836
CLL Routines: UNPACK -------------------------------------------------- UNPACK1.3
CLL UNPACK1.4
CLL Purpose: This subroutine uses the index arrays UNPACK1.5
CLL INDEX_COMP(N_SEG), INDEX_EXP(N_SEG) and UNPACK1.6
CLL INDEX_TO_ROWS(MAX_ROW,MAX_LEVEL) to unpack data UNPACK1.7
CLL FROM T_COMP(N_COMP) into T_EXP(IMAX,JMAX,KMAX) UNPACK1.8
CLL UNPACK1.9
CLL Tested under compiler: cft77,(cf77 -ZP) UNPACK1.10
CLL Tested under OS version: UNICOS 5.1 UNPACK1.11
CLL UNPACK1.12
CLL Author: S.J.Nightingale UNPACK1.13
CLL UNPACK1.14
CLL Model Modification history from model version 3.0: UNPACK1.15
CLL version date UNPACK1.16
CLL UNPACK1.17
CLL Programming standard : UMDP PAPER 3 UNPACK1.18
CLL UNPACK1.19
CLL system components covered : F4 UNPACK1.20
CLL UNPACK1.21
CLL External documentation: UNPACK1.22
CLL UNPACK1.23
CLLEND----------------------------------------------------------------- UNPACK1.24
C*L UNPACK1.25
SUBROUTINE UNPACK(J1,J2,K1,K2,MAX_ROW,MAX_LEVEL, 22UNPACK1.26
*IMAX,JMAX,KMAX,INDEX_COMP,INDEX_EXP,N_SEG,INDEX_TO_ROWS, UNPACK1.27
*N_COMP,T_COMP,T_EXP,REAL_MDI,CYCLIC) UNPACK1.28
C* UNPACK1.29
IMPLICIT NONE UNPACK1.30
CL Argument variables UNPACK1.31
INTEGER UNPACK1.32
* J1 ! (IN) FIRST ROW OF DATA TO BE UNPACKED UNPACK1.33
*,J2 ! (IN) LAST ROW OF DATA TO BE UNPACKED UNPACK1.34
*,K1 ! (IN) FIRST LEVEL OF DATA TO BE UNPACKED UNPACK1.35
*,K2 ! (IN) LAST LEVEL OF DATA TO BE UNPACKED UNPACK1.36
*,IMAX ! (IN) NUMBER OF POINTS EAST-WEST UNPACK1.37
*,JMAX ! (IN) NUMBER OF POINTS NORTH-SOUTH UNPACK1.38
*,KMAX ! (IN) NUMBER OF POINTS IN VERTICAL UNPACK1.39
*,N_SEG ! (IN) TOTAL NUMBER OF SEA SEGMENTS UNPACK1.40
*,N_COMP ! (IN) DIMENSION OF COMPRESSED ARRAY UNPACK1.41
*,MAX_ROW ! (IN) UPPER LIMIT ON JMAX UNPACK1.42
*,MAX_LEVEL ! (IN) UPPER LIMIT ON KMAX UNPACK1.43
*,INDEX_COMP(N_SEG) ! (IN) CONTAINS POSITIONS IN COMPRESSED ARRAY UNPACK1.44
C ! OF START OF EACH SEA SEGMENT UNPACK1.45
*,INDEX_EXP(N_SEG) ! (IN) CONTAINS POSITIONS IN 1-DIMENSIONAL UNPACK1.46
C ! EXPANDED ARRAY UNPACK1.47
C ! T_EXP_1_D(IMAX*MAX_ROW*MAX_LEVEL) UNPACK1.48
C ! OF START OF EACH SEA SEGMENT UNPACK1.49
*,INDEX_TO_ROWS(MAX_ROW,MAX_LEVEL) ! (IN) CONTAINS NUMBER OF FIRST UNPACK1.50
C ! SEA SEGMENT IN EACH ROW UNPACK1.51
C ! AT EACH LEVEL IF THERE IS A UNPACK1.52
C ! SEA SEGMENT IN THE ROW UNPACK1.53
C ! CONTAINS NUMBER OF NEXT UNPACK1.54
C ! SEA SEGMENT OTHERWISE UNPACK1.55
*,I_DATA ! NUMBER OF DISTINCT DATA POINTS EAST-WEST UNPACK1.56
UNPACK1.57
REAL UNPACK1.58
* REAL_MDI ! (IN) REAL MISSING DATA INDICATOR UNPACK1.59
*,T_COMP(N_COMP) ! (IN) COMPRESSED ARRAY UNPACK1.60
*,T_EXP(IMAX,JMAX,KMAX) ! (OUT) 3-DIMENSIONAL EXPANDED ARRAY UNPACK1.61
UNPACK1.62
LOGICAL UNPACK1.63
* CYCLIC ! (IN) INDICATES WHETHER T_EXP(IMAX,JMAX,KMAX) INCLUDES UNPACK1.64
C ! DATA FOR CYCLIC WRAP-AROUND POINTS UNPACK1.65
UNPACK1.66
CL Local variables UNPACK1.67
INTEGER UNPACK1.68
* J60 ! LOCAL LOOP INDEX FOR 60 UNPACK1.69
*,JSPAN ! LOCAL NUMBER OF ITERATIONS OF ROWS UNPACK1.70
*,KSPAN ! LOCAL NUMBER OF ITERATIONS OF LEVELS UNPACK1.71
*,I ! LOCAL LOOP INDEX FOR COLUMNS UNPACK1.72
*,J ! LOCAL LOOP INDEX FOR ROWS UNPACK1.73
*,K ! LOCAL LOOP INDEX FOR LEVELS UNPACK1.74
*,JN,KN ! LOCAL VARIABLES UNPACK1.75
*,NUM_SEG ! NUMBER OF SEA SEGMENTS IN PRESENT ROW UNPACK1.76
*,LEN_SEG ! LENGTH OF PRESENT SEA SEGMENT UNPACK1.77
*,COUNT ! LOCAL COUNTER FOR POINTS IN A SEA SEGMENT UNPACK1.78
*,SEG ! LOCAL LOOP INDEX FOR SEA SEGMENTS IN PRESENT ROW UNPACK1.79
*,SEG_POS ! LOCAL COUNTER FOR SEA SEGMENTS UNPACK1.80
*,X_POS ! LOCAL COUNTER FOR POINTS IN A ROW UNPACK1.81
*,IPOINT_EXP ! LOCAL POINTER TO EXPANDED ARRAY UNPACK1.82
*,IPOINT_COMP ! LOCAL POINTER TO COMPRESSED ARRAY UNPACK1.83
UNPACK1.84
CL--------------------------------------------------------------------- UNPACK1.85
CL 1. Fill the expanded array with real missing data indicators UNPACK1.86
UNPACK1.87
DO 30,K=1,KMAX UNPACK1.88
DO 20,J=1,JMAX UNPACK1.89
DO 10,I=1,IMAX UNPACK1.90
T_EXP(I,J,K)=REAL_MDI UNPACK1.91
10 CONTINUE UNPACK1.92
20 CONTINUE UNPACK1.93
30 CONTINUE UNPACK1.94
CL---------------------------------------------------------------------- UNPACK1.95
CL 2. Set the wrap-around parameters UNPACK1.96
UNPACK1.97
IF (CYCLIC) THEN UNPACK1.98
I_DATA=IMAX-2 UNPACK1.99
ELSE UNPACK1.100
I_DATA=IMAX UNPACK1.101
END IF UNPACK1.102
CL---------------------------------------------------------------------- UNPACK1.103
CL 3. Unpack levels and rows UNPACK1.104
CL 3.1 Set the number of iterations over rows and levels UNPACK1.105
JSPAN = J2 - J1 + 1 UNPACK1.106
KSPAN = K2 - K1 + 1 UNPACK1.107
UNPACK1.108
CL 3.2 Force multitasking over rows-levels loop UNPACK1.109
CMIC$ DO ALL SHARED(MAX_ROW,K1,K2,J1,J2,MAX_LEVEL,N_SEG,N_COMP, UNPACK1.110
CMIC$1 I_DATA,INDEX_TO_ROWS,INDEX_COMP,INDEX_EXP, UNPACK1.111
CMIC$2 T_EXP,JSPAN,KSPAN,T_COMP) UNPACK1.112
CMIC$3 PRIVATE(K,J,JN,KN,NUM_SEG,SEG_POS,LEN_SEG,IPOINT_EXP, UNPACK1.113
CMIC$4 IPOINT_COMP,X_POS,COUNT,SEG,J60) UNPACK1.114
DO 60,J60=0,JSPAN*KSPAN-1 UNPACK1.115
UNPACK1.116
CL 3.3 Set up 2-d loop indices UNPACK1.117
UNPACK1.118
K = J60/JSPAN UNPACK1.119
J = J60 - K*JSPAN + J1 UNPACK1.120
K = K + K1 UNPACK1.121
UNPACK1.122
CL 3.4 Define the next row and level UNPACK1.123
UNPACK1.124
IF (J.EQ.MAX_ROW) THEN UNPACK1.125
JN=1 UNPACK1.126
KN=K+1 UNPACK1.127
ELSE UNPACK1.128
JN=J+1 UNPACK1.129
KN=K UNPACK1.130
END IF UNPACK1.131
UNPACK1.132
CL 3.5 Calculate the number of segments in the present row UNPACK1.133
UNPACK1.134
IF (KN.GT.MAX_LEVEL) THEN UNPACK1.135
NUM_SEG=N_SEG-INDEX_TO_ROWS(J,K)+1 UNPACK1.136
ELSE UNPACK1.137
NUM_SEG=INDEX_TO_ROWS(JN,KN)-INDEX_TO_ROWS(J,K) UNPACK1.138
END IF UNPACK1.139
UNPACK1.140
DO 50,SEG=1,NUM_SEG UNPACK1.141
SEG_POS=INDEX_TO_ROWS(J,K)+SEG-1 UNPACK1.142
UNPACK1.143
CL 3.6 Calculate the length of the present sea segment UNPACK1.144
UNPACK1.145
IF (SEG_POS.LT.N_SEG) THEN UNPACK1.146
LEN_SEG=INDEX_COMP(SEG_POS+1)-INDEX_COMP(SEG_POS) UNPACK1.147
ELSE UNPACK1.148
LEN_SEG=N_COMP-INDEX_COMP(SEG_POS)+1 UNPACK1.149
END IF UNPACK1.150
UNPACK1.151
CL 3.7 Calculate t_exp(i,j,k) for each point in the segment UNPACK1.152
UNPACK1.153
DO 40,COUNT=1,LEN_SEG UNPACK1.154
IPOINT_EXP=INDEX_EXP(SEG_POS)+COUNT-1 UNPACK1.155
IPOINT_COMP=INDEX_COMP(SEG_POS)+COUNT-1 UNPACK1.156
X_POS=IPOINT_EXP-(K-1)*I_DATA*MAX_ROW-(J-1)*I_DATA UNPACK1.157
T_EXP(X_POS,J-J1+1,K-K1+1)=T_COMP(IPOINT_COMP) UNPACK1.158
40 CONTINUE UNPACK1.159
50 CONTINUE UNPACK1.160
60 CONTINUE UNPACK1.161
CL---------------------------------------------------------------------- UNPACK1.162
CL 4. Calculate t_exp(i,j,k) for wrap-around points if necessary UNPACK1.163
UNPACK1.164
IF (CYCLIC) THEN UNPACK1.165
DO 90,K=1,KMAX UNPACK1.166
DO 80,J=1,JMAX UNPACK1.167
T_EXP(IMAX-1,J,K)=T_EXP(1,J,K) UNPACK1.168
T_EXP(IMAX,J,K)=T_EXP(2,J,K) UNPACK1.169
80 CONTINUE UNPACK1.170
90 CONTINUE UNPACK1.171
END IF UNPACK1.172
UNPACK1.173
RETURN UNPACK1.174
END UNPACK1.175
*ENDIF UNPACK1.176