SUBROUTINE UM_INDEX( 1,5UMINDEX1.32
*CALL ARGSIZE 
SF011193.40
*CALL ARGSZSP UMINDEX1.33
*CALL ARGSZSPA UMINDEX1.34
*CALL ARGSZSPO UMINDEX1.35
*CALL ARGSZSPW WRB1F401.902
*CALL ARGSZSPC UMINDEX1.36
& ICODE,CMESSAGE) UMINDEX1.37
C UMINDEX1.38
C*---------------------------------------------------------------------- UMINDEX1.39
IMPLICIT NONE UMINDEX1.40
C UMINDEX1.41
C Subroutines called UMINDEX1.42
C UMINDEX1.43
EXTERNAL TIMER UMINDEX1.44
C UMINDEX1.45
*IF DEF,ATMOS UMINDEX1.46
EXTERNAL UM_INDEX_A UMINDEX1.47
*ENDIF UMINDEX1.48
*IF DEF,OCEAN UMINDEX1.49
EXTERNAL UM_INDEX_O UMINDEX1.50
*ENDIF UMINDEX1.51
*IF DEF,WAVE WRB1F401.903
EXTERNAL UM_INDEX_W WRB1F401.904
*ENDIF WRB1F401.905
C UMINDEX1.52
C Local variables UMINDEX1.53
C UMINDEX1.54
INTEGER ICODE ! Work - Internal return code UMINDEX1.55
CHARACTER*80 CMESSAGE ! Work - Internal error message WRB1F401.906
C UMINDEX1.57
C Configuration-dependent sizes for dynamic arrays UMINDEX1.58
C UMINDEX1.59
*CALL CSUBMODL ! Provides N_INTERNAL_MODEL parameter for STASH array GSS1F305.809
*CALL TYPSIZE UMINDEX1.60
C UMINDEX1.61
C ppxref parameters needed for a STASH array GSS1F305.810
*CALL CPPXREF UMINDEX1.63
C UMINDEX1.64
C Super array sizes for dynamic allocation in U_MODEL UMINDEX1.65
C UMINDEX1.66
*CALL TYPSZSP UMINDEX1.67
*CALL TYPSZSPA UMINDEX1.68
*CALL TYPSZSPO UMINDEX1.69
*CALL TYPSZSPW WRB1F401.907
*CALL TYPSZSPC UMINDEX1.70
*CALL CHSUNITS GSM1F401.13
*CALL CCONTROL GSM1F401.14
C GRR1F402.54
*CALL TYPD1 ! Holds D1_LIST_LEN needed to calculate array size GSM2F403.222
C GSM2F403.223
GSM1F401.15
*CALL PARVARS GRR0F402.93
*CALL DECOMPTP GRR0F402.94
*CALL DECOMPDB GRR0F402.95
C UMINDEX1.71
C Addresses of arrays in super arrays. UMINDEX1.72
C UMINDEX1.73
*CALL SPINDEX UMINDEX1.74
C UMINDEX1.75
INTEGER LEN_D1_ADDR GSM2F403.224
CL---------------------------------------------------------------------- UMINDEX1.76
CL 0. Start Timer running UMINDEX1.77
CL UMINDEX1.78
IF(LTIMER) THEN GSM1F401.16
CALL TIMER('UM_INDEX',3) GSM1F401.17
END IF GSM1F401.18
ICODE=0 UMINDEX1.80
UDR2F404.27
! 0.1 Initialise variables in TYPSIZE UDR2F404.28
LEN_A_IXSTS = A_IXSTS_LEN UDR2F404.29
LEN_O_IXSTS = O_IXSTS_LEN UDR2F404.30
LEN_W_IXSTS = W_IXSTS_LEN UDR2F404.31
LEN_A_SPSTS = 0 UDR2F404.32
LEN_O_SPSTS = 0 UDR2F404.33
LEN_W_SPSTS = 0 UDR2F404.34
CL---------------------------------------------------------------------- UMINDEX1.81
CL 1. Calculate addresses in super array and each super array length UMINDEX1.82
CL UMINDEX1.83
CL 1.1 D1 super array UMINDEX1.84
CL UMINDEX1.85
CL super array addresses UMINDEX1.86
LEN_D1_ADDR=D1_LIST_LEN*N_OBJ_D1_MAX*N_SUBMODEL_PARTITION GSM2F403.225
*IF DEF,T3E GBC6F404.301
c--make sure the increment aligns on to an Scache boundary, GBC6F404.302
c if the initial location of D1 is set properly GBC6F404.303
len_d1_addr=((len_d1_addr+7)/8)*8 GBC6F404.304
*ENDIF GBC6F404.305
IXD1(1)=1 UMINDEX1.87
IXD1(2)=LEN_D1_ADDR+1 GSM2F403.226
IXD1(3)=LEN_D1_ADDR+1 ! array not used GSM2F403.227
IXD1(4)=LEN_D1_ADDR+1 ! array not used GSM2F403.228
*IF DEF,ATMOS,AND,DEF,OCEAN GRR1F402.59
*IF DEF,MPP GRR1F402.60
IF (L_AO_D1_MEMORY) THEN ! D1 images in memory for A-O coupling GDR5F404.6
IXD1(3)=IXD1(2) + LEN_TOT GSM2F403.229
IXD1(4)=IXD1(3) + A_LEN_D1 GSM2F403.230
ENDIF GRR1F402.64
*ENDIF GRR1F402.65
*ENDIF GRR1F402.66
CL UMINDEX1.88
CL super array length UMINDEX1.89
SPD1_LEN=LEN_TOT+LEN_D1_ADDR GSM2F403.231
*IF DEF,ATMOS,AND,DEF,OCEAN GRR1F402.67
*IF DEF,MPP GRR1F402.68
SPD1_LEN=IXD1(4) + O_LEN_D1 GSM2F403.232
SPD1_LEN=SPD1_LEN - 1 GRR1F402.70
*ENDIF GRR1F402.71
*ENDIF GRR1F402.72
CL UMINDEX1.91
CL UMINDEX1.92
! 1.2 STASH super array GSS1F305.812
GSS1F305.813
! super array addresses GSS1F305.814
! SF GSS1F305.815
IXSTS( 1)=1 GSS1F305.816
! STINDEX GSS1F305.817
IXSTS( 2)=IXSTS( 1)+ (NITEMS+1)*(NSECTS+1) GSS1F305.818
! STLIST GSS1F305.819
IXSTS( 3)=IXSTS( 2)+2*NITEMS *(NSECTS+1) GSS1F305.820
& *N_INTERNAL_MODEL GSS1F305.821
! SI GSS1F305.822
IXSTS( 4)=IXSTS( 3)+ LEN_STLIST*TOTITEMS GSS1F305.823
! STTABL GSS1F305.824
IXSTS( 5)=IXSTS( 4)+ NITEMS *(NSECTS+1) GSS1F305.825
& *N_INTERNAL_MODEL GSS1F305.826
! STASH_MAXLEN GSS1F305.827
IXSTS( 6)=IXSTS( 5)+ NSTTIMS *NSTTABL GSS1F305.828
! PPINDEX GSS1F305.829
IXSTS( 7)=IXSTS( 6)+ (NSECTS+1)*N_INTERNAL_MODEL GSS1F305.830
! STASH_LEVELS GSS1F305.831
IXSTS( 8)=IXSTS( 7)+ NITEMS *N_INTERNAL_MODEL GSS1F305.832
! STASH_PSEUDO_LEVELS GSS1F305.833
IXSTS( 9)=IXSTS( 8)+ (NUM_STASH_LEVELS+1)*NUM_LEVEL_LISTS GSS1F305.834
! STASH_SERIES GSS1F305.835
IXSTS(10)=IXSTS( 9)+ (NUM_STASH_PSEUDO+1)*NUM_PSEUDO_LISTS GSS1F305.836
! STASH_SERIES_INDEX GSS1F305.837
IXSTS(11)=IXSTS(10)+ TIME_SERIES_REC_LEN*NSTASH_SERIES_RECORDS GSS1F305.838
! MOS_MASK GSS1F305.839
IXSTS(12)=IXSTS(11)+2*NSTASH_SERIES_BLOCK GSS1F305.840
GSS1F305.841
CL UMINDEX1.109
CL super array length UMINDEX1.110
SPSTS_LEN =IXSTS(12)+ MOS_MASK_LEN GSS1F305.842
SPSTS_LEN =SPSTS_LEN -1 UMINDEX1.112
CL UMINDEX1.113
CL UMINDEX1.114
CL 1.3 Input boundary conditions super array UMINDEX1.115
CL UMINDEX1.116
CL super array addresses UMINDEX1.117
IXBND(1) =1 UMINDEX1.118
CL UMINDEX1.119
CL super array length UMINDEX1.120
SPBND_LEN =IXBND(1)+ 2 + FLOORFLDSA GSI1F405.70
SPBND_LEN =SPBND_LEN -1 UMINDEX1.122
CL UMINDEX1.123
CL---------------------------------------------------------------------- UMINDEX1.124
CL 2. atmosphere super arrays UMINDEX1.125
*IF DEF,ATMOS UMINDEX1.126
CL UMINDEX1.127
CALL UM_INDEX_A( UMINDEX1.128
*CALL ARGSZSPA UMINDEX1.129
& ICODE,CMESSAGE) UMINDEX1.130
*ENDIF UMINDEX1.131
CL UMINDEX1.132
CL---------------------------------------------------------------------- UMINDEX1.133
CL 3. ocean super arrays UMINDEX1.134
*IF DEF,OCEAN UMINDEX1.135
CL UMINDEX1.136
CALL UM_INDEX_O( UMINDEX1.137
*CALL ARGSIZE SF011193.41
*CALL ARGSZSPO UMINDEX1.138
& ICODE,CMESSAGE) UMINDEX1.139
*ENDIF UMINDEX1.140
CL---------------------------------------------------------------------- UMINDEX1.141
CL 4. wave super arrays WRB1F401.908
*IF DEF,WAVE WRB1F401.909
CL WRB1F401.910
CALL UM_INDEX_W( WRB1F401.911
*CALL ARGSIZE WRB1F401.912
*CALL ARGSZSPW WRB1F401.913
& ICODE,CMESSAGE) WRB1F401.914
*ENDIF WRB1F401.915
CL---------------------------------------------------------------------- WRB1F401.916
CL 5. coupled super arrays WRB1F401.917
*IF DEF,ATMOS,AND,DEF,OCEAN UMINDEX1.143
CL GRR0F402.96
*IF DEF,MPP GRR0F402.97
CL Get global sizes (all PEs) for coupling routines GRR0F402.98
AOCPL_IMT =decomp_db_glsize(1,decomp_standard_ocean) GRR0F402.99
AOCPL_JMT =decomp_db_glsize(2,decomp_standard_ocean) GRR0F402.100
AOCPL_ROW_LENGTH=decomp_db_glsize(1,decomp_standard_atmos) GRR0F402.101
AOCPL_P_ROWS =decomp_db_glsize(2,decomp_standard_atmos) GRR0F402.102
*ELSE GRR0F402.103
AOCPL_IMT =IMT GRR0F402.104
AOCPL_JMT =JMT GRR0F402.105
AOCPL_ROW_LENGTH=ROW_LENGTH GRR0F402.106
AOCPL_P_ROWS =P_ROWS GRR0F402.107
*ENDIF GRR0F402.108
CL UMINDEX1.144
CL super array addresses UMINDEX1.145
AO_IXCPL(1) =1 GRR0F402.109
AO_IXCPL(2) =AO_IXCPL(1) + AOCPL_IMT+1 GRR0F402.110
AO_IXCPL(3) =AO_IXCPL(2) + AOCPL_IMT GRR0F402.111
AO_IXCPL(4) =AO_IXCPL(3) + AOCPL_JMT+1 GRR0F402.112
AO_IXCPL(5) =AO_IXCPL(4) + AOCPL_JMT GRR0F402.113
AO_IXCPL(6) =AO_IXCPL(5) + AOCPL_ROW_LENGTH+1 GRR0F402.114
AO_IXCPL(7) =AO_IXCPL(6) + AOCPL_ROW_LENGTH+1 GRR0F402.115
AO_IXCPL(8) =AO_IXCPL(7) + AOCPL_P_ROWS GRR0F402.116
CL GRR0F402.117
CL super array length GRR0F402.118
AO_SPCPL_LEN =AO_IXCPL(8)+ AOCPL_P_ROWS+1 GRR0F402.119
AO_SPCPL_LEN =AO_SPCPL_LEN -1 UMINDEX1.157
*ENDIF UMINDEX1.158
CL---------------------------------------------------------------------- UMINDEX1.159
CL 6. Exit processing WRB1F401.918
CL UMINDEX1.161
write(6,*) 'Super array lengths:', UMINDEX1.162
*CALL ARGSZSP UMINDEX1.163
&' not sub-model' WRB1F401.919
write(6,*) 'Super array lengths:', UMINDEX1.165
*CALL ARGSZSPA UMINDEX1.166
&' atmosphere' WRB1F401.920
write(6,*) 'Super array lengths:', UMINDEX1.168
*CALL ARGSZSPO UMINDEX1.169
&' ocean' WRB1F401.921
write(6,*) 'Super array lengths:', UMINDEX1.171
*CALL ARGSZSPW WRB1F401.922
&' wave' WRB1F401.923
write(6,*) 'Super array lengths:', WRB1F401.924
*CALL ARGSZSPC UMINDEX1.172
&' coupled' WRB1F401.925
IF(LTIMER) THEN GSM1F401.19
CALL TIMER('UM_INDEX',4) GSM1F401.20
END IF GSM1F401.21
C UMINDEX1.175
RETURN UMINDEX1.176
END UMINDEX1.177
*ENDIF UMINDEX1.178
*IF DEF,CONTROL,AND,DEF,ATMOS UMINDEX1.179
CLL Subroutine: UM_INDEX_A--------------------------------------------- UMINDEX1.180
CLL UMINDEX1.181
CLL Purpose: Calculate addresses and lengths of atmosphere super arrays UMINDEX1.182
CLL UMINDEX1.183
CLL Tested under compiler: cft77 UMINDEX1.184
CLL Tested under OS version: UNICOS 6.1.5A UMINDEX1.185
CLL UMINDEX1.186
CLL Model Modification history: UMINDEX1.187
CLL version date UMINDEX1.188
CLL 3.2 30/03/93 Introduced as new DECK to allow dynamic allocation UMINDEX1.189
CLL of main data arrays in U_MODEL. UMINDEX1.190
CLL 3.2 22/11/93 Add 3 more A_IXPTR values for aerosol pointers. RB221193.119
CLL R.T.H.Barnes. RB221193.120
CLL 3.4 29/09/94 Add 6 more A_IXPTR values for multi-level murk and GRB0F304.325
CLL user ancillaries. R.T.H.Barnes. GRB0F304.326
CLL 3.4 18/5/94 Add extra u field to A_SPCON (argcona). J Thomson GJT1F304.37
!LL 4.0 06/09/95 Added atmos stash superarray. K Rogers GKR0F400.2
CLL UMINDEX1.191
CLL Programming standard: UM Doc Paper 3, version 2 (7/9/90) UMINDEX1.192
CLL UMINDEX1.193
CLL Logical components covered: C0 UMINDEX1.194
CLL UMINDEX1.195
CLL Project task: C0 UMINDEX1.196
CLL UMINDEX1.197
CLL External documentation: On-line UM document C1 - The top-level UMINDEX1.198
CLL dynamic allocation UMINDEX1.199
CLL UMINDEX1.200
CLL ------------------------------------------------------------------- UMINDEX1.201
C*L Interface and arguments: ------------------------------------------ UMINDEX1.202
C UMINDEX1.203
SUBROUTINE UM_INDEX_A( 1UMINDEX1.204
*CALL ARGSZSPA UMINDEX1.205
& ICODE,CMESSAGE) UMINDEX1.206
C UMINDEX1.207
C*---------------------------------------------------------------------- UMINDEX1.208
IMPLICIT NONE UMINDEX1.209
C UMINDEX1.210
C Subroutines called UMINDEX1.211
C UMINDEX1.212
C Local variables UMINDEX1.213
C UMINDEX1.214
INTEGER ICODE ! Work - Internal return code UMINDEX1.215
CHARACTER*80 CMESSAGE ! Work - Internal error message WRB1F401.926
C UMINDEX1.217
C Configuration-dependent sizes for dynamic arrays UMINDEX1.218
C UMINDEX1.219
*CALL TYPSIZE UMINDEX1.220
C UMINDEX1.221
C Parameters for constants arrays UMINDEX1.222
*CALL CMAXSIZE UMINDEX1.223
*CALL CCONSTS UMINDEX1.224
C Ancillary file parameters for ancillary length calculations UMINDEX1.225
*CALL CONANC UMINDEX1.226
*CALL CSENARIO AWI1F403.63
C UMINDEX1.227
C Super array sizes for dynamic allocation in U_MODEL UMINDEX1.228
C UMINDEX1.229
*CALL TYPSZSPA UMINDEX1.230
C UMINDEX1.231
C Addresses of arrays in super arrays. UMINDEX1.232
C UMINDEX1.233
*CALL SPINDEX UMINDEX1.234
C UMINDEX1.235
CL---------------------------------------------------------------------- UMINDEX1.236
CL UMINDEX1.237
ICODE=0 UMINDEX1.238
GKR0F400.3
!L GKR0F400.4
!L 1.0 Calculate size of atmosphere stash array GKR0F400.5
!L GKR0F400.6
a_ixsts(1) = 1 ! a_levdepc(jak) GKR0F400.7
a_ixsts(2) = a_ixsts(1) + p_levels ! a_levdepc(jbk) GKR0F400.8
a_ixsts(3) = a_ixsts(2) + p_levels ! akh GKR0F400.9
a_ixsts(4) = a_ixsts(3) + p_levels + 1 ! bkh GKR0F400.10
a_ixsts(5) = a_ixsts(4) + p_levels + 1 ! a_levdepc(jdelta_ak) GKR0F400.11
a_ixsts(6) = a_ixsts(5) + p_levels ! a_levdepc(jdelta_bk) GKR0F400.12
a_ixsts(7) = a_ixsts(6) + p_levels ! pexner pointer GKR0F400.13
a_ixsts(8) = a_ixsts(7) + 1 ! pstar pointer GKR0F400.14
a_ixsts(9) = a_ixsts(8) + 1 ! cos_p_latitude GKR0F400.15
a_ixsts(10) = a_ixsts(9) + row_length * p_rows ! cos_u_latitude GKR0F400.16
a_ixsts(11) = a_ixsts(10) + row_length * u_rows ! land GKR0F400.17
a_spsts_len = a_ixsts(11) + p_field GKR0F400.18
! Store A_SPSTS_LEN in TYPSIZE UDR2F404.35
LEN_A_SPSTS = A_SPSTS_LEN UDR2F404.36
GKR0F400.19
CL UMINDEX1.239
CL 1.1 DUMP super array UMINDEX1.240
CL UMINDEX1.241
CL super array addresses UMINDEX1.242
A_IXDUM(1) =1 UMINDEX1.243
A_IXDUM(2) =A_IXDUM(1) + LEN_FIXHD UMINDEX1.244
A_IXDUM(3) =A_IXDUM(2) + A_LEN_INTHD UMINDEX1.245
A_IXDUM(4) =A_IXDUM(3) + A_LEN_CFI1+1 UMINDEX1.246
A_IXDUM(5) =A_IXDUM(4) + A_LEN_CFI2+1 UMINDEX1.247
A_IXDUM(6) =A_IXDUM(5) + A_LEN_CFI3+1 UMINDEX1.248
A_IXDUM(7) =A_IXDUM(6) + A_LEN_REALHD UMINDEX1.249
A_IXDUM(8) =A_IXDUM(7) + A_LEN1_LEVDEPC*A_LEN2_LEVDEPC+1 UMINDEX1.250
A_IXDUM(9) =A_IXDUM(8) + A_LEN1_ROWDEPC*A_LEN2_ROWDEPC+1 UMINDEX1.251
A_IXDUM(10)=A_IXDUM(9) + A_LEN1_COLDEPC*A_LEN2_COLDEPC+1 UMINDEX1.252
A_IXDUM(11)=A_IXDUM(10)+ A_LEN1_FLDDEPC*A_LEN2_FLDDEPC+1 UMINDEX1.253
A_IXDUM(12)=A_IXDUM(11)+ A_LEN_EXTCNST+1 UMINDEX1.254
A_IXDUM(13)=A_IXDUM(12)+ LEN_DUMPHIST+1 UMINDEX1.255
*IF DEF,MPP GSM1F403.44
A_IXDUM(14)=A_IXDUM(13)+ LEN1_LOOKUP*A_LEN2_LOOKUP GSM1F403.45
*ENDIF GSM1F403.46
GSM1F403.47
CL UMINDEX1.256
CL super array length UMINDEX1.257
*IF DEF,MPP GSM1F403.48
A_SPDUM_LEN =A_IXDUM(14)+ MPP_LEN1_LOOKUP*A_LEN2_LOOKUP GSM1F403.49
*ELSE GSM1F403.50
A_SPDUM_LEN =A_IXDUM(13)+ LEN1_LOOKUP*A_LEN2_LOOKUP UMINDEX1.258
*ENDIF GSM1F403.51
A_SPDUM_LEN =A_SPDUM_LEN -1 UMINDEX1.259
CL UMINDEX1.260
CL UMINDEX1.261
CL 1.2 Pointers super array UMINDEX1.262
CL UMINDEX1.263
CL super array addresses UMINDEX1.264
GDR7F405.10
! Comment at end of each line corresponds to the matching GDR7F405.11
! pointer in ARGPTRA. eg A_IXPTR(3) in ARTPTRA = jtheta in ARGPTRA GDR7F405.12
GDR7F405.13
! For each line : A_IXPTR(n+1) = A_IXPTR(n) + n_levs GDR7F405.14
! where n_levs in the no of levels for pointer n. GDR7F405.15
GDR7F405.16
A_IXPTR(1) =1 ! ju GDR7F405.17
A_IXPTR(2) =A_IXPTR(1) + P_LEVELS ! jv GDR7F405.18
A_IXPTR(3) =A_IXPTR(2) + P_LEVELS ! jtheta GDR7F405.19
A_IXPTR(4) =A_IXPTR(3) + P_LEVELS ! jq GDR7F405.20
A_IXPTR(5) =A_IXPTR(4) + Q_LEVELS ! jqcl GDR7F405.21
A_IXPTR(6) =A_IXPTR(5) + Q_LEVELS ! jqcf GDR7F405.22
A_IXPTR(7) =A_IXPTR(6) + Q_LEVELS ! j_deep_soil_temp GDR7F405.23
A_IXPTR(8) =A_IXPTR(7) + ST_LEVELS ! jsmcl GDR7F405.24
A_IXPTR(9) =A_IXPTR(8) + SM_LEVELS ! jozone GDR7F405.25
A_IXPTR(10)=A_IXPTR(9) + OZONE_LEVELS ! jtracer GDR7F405.26
A_IXPTR(11)=A_IXPTR(10)+ TR_LEVELS*(TR_VARS+1) ! jp_exner GDR7F405.27
A_IXPTR(12)=A_IXPTR(11)+ P_LEVELS+1 ! jso4 GDR7F405.28
A_IXPTR(13)=A_IXPTR(12)+ TR_LEVELS ! jh2so4 GDR7F405.29
A_IXPTR(14)=A_IXPTR(13)+ TR_LEVELS ! jsoot GDR7F405.30
A_IXPTR(15)=A_IXPTR(14)+ TR_LEVELS ! jmurk GDR7F405.31
A_IXPTR(16)=A_IXPTR(15)+ P_LEVELS ! jmurk_source GDR7F405.32
A_IXPTR(17)=A_IXPTR(16)+ P_LEVELS ! juser_mult1 GDR7F405.33
A_IXPTR(18)=A_IXPTR(17)+ P_LEVELS ! juser_mult2 GDR7F405.34
A_IXPTR(19)=A_IXPTR(18)+ P_LEVELS ! juser_mult3 GDR7F405.35
A_IXPTR(20)=A_IXPTR(19)+ P_LEVELS ! juser_mult4 GDR7F405.36
A_IXPTR(21)=A_IXPTR(20)+ P_LEVELS ! juser_mult5 GDR7F405.37
A_IXPTR(22)=A_IXPTR(21)+ P_LEVELS ! juser_mult6 GDR7F405.38
A_IXPTR(23)=A_IXPTR(22)+ P_LEVELS ! juser_mult7 GDR7F405.39
A_IXPTR(24)=A_IXPTR(23)+ P_LEVELS ! juser_mult8 GDR7F405.40
A_IXPTR(25)=A_IXPTR(24)+ P_LEVELS ! juser_mult9 GDR7F405.41
A_IXPTR(26)=A_IXPTR(25)+ P_LEVELS ! juser_mult10 GDR7F405.42
A_IXPTR(27)=A_IXPTR(26)+ P_LEVELS ! juser_mult11 GDR7F405.43
A_IXPTR(28)=A_IXPTR(27)+ P_LEVELS ! juser_mult12 GDR7F405.44
A_IXPTR(29)=A_IXPTR(28)+ P_LEVELS ! juser_mult13 GDR7F405.45
A_IXPTR(30)=A_IXPTR(29)+ P_LEVELS ! juser_mult14 GDR7F405.46
A_IXPTR(31)=A_IXPTR(30)+ P_LEVELS ! juser_mult15 GDR7F405.47
A_IXPTR(32)=A_IXPTR(31)+ P_LEVELS ! juser_mult16 GDR7F405.48
A_IXPTR(33)=A_IXPTR(32)+ P_LEVELS ! juser_mult17 GDR7F405.49
A_IXPTR(34)=A_IXPTR(33)+ P_LEVELS ! juser_mult18 GDR7F405.50
A_IXPTR(35)=A_IXPTR(34)+ P_LEVELS ! juser_mult19 GDR7F405.51
A_IXPTR(36)=A_IXPTR(35)+ P_LEVELS ! juser_mult20 GDR7F405.52
A_IXPTR(37)=A_IXPTR(36)+ P_LEVELS ! jsthu GDR7F405.53
A_IXPTR(38)=A_IXPTR(37)+ SM_LEVELS ! jsthf GDR7F405.54
A_IXPTR(39)=A_IXPTR(38)+ SM_LEVELS ! jso2 GDR7F405.55
A_IXPTR(40)=A_IXPTR(39)+ P_LEVELS ! jdms GDR7F405.56
A_IXPTR(41)=A_IXPTR(40)+ P_LEVELS ! jso4_aitken GDR7F405.57
A_IXPTR(42)=A_IXPTR(41)+ P_LEVELS ! jso4_accu GDR7F405.58
A_IXPTR(43)=A_IXPTR(42)+ P_LEVELS ! jso4_diss GDR7F405.59
A_IXPTR(44)=A_IXPTR(43)+ P_LEVELS ! jh2o2 GDR7F405.60
A_IXPTR(45)=A_IXPTR(44)+ P_LEVELS ! jso2_natem GDR7F405.61
A_IXPTR(46)=A_IXPTR(45)+ P_LEVELS ! joh GDR7F405.62
A_IXPTR(47)=A_IXPTR(46)+ P_LEVELS ! jho2 GDR7F405.63
A_IXPTR(48)=A_IXPTR(47)+ P_LEVELS ! jh2o2_limit GDR7F405.64
A_IXPTR(49)=A_IXPTR(48)+ P_LEVELS ! jo3_chem GDR7F405.65
A_IXPTR(50)=A_IXPTR(49)+ P_LEVELS ! jhadcm2_so4 GDR7F405.66
A_IXPTR(51)=A_IXPTR(50)+ NSULPAT ! jcca GDR7F405.67
A_IXPTR(52)=A_IXPTR(51)+ N_CCA_LEV ! jrhc GDR7F405.68
A_IXPTR(53)=A_IXPTR(52)+ Q_LEVELS ! jnh3 GDR7F405.69
A_IXPTR(54)=A_IXPTR(53)+ P_LEVELS ! jsoot_new GDR7F405.70
A_IXPTR(55)=A_IXPTR(54)+ P_LEVELS ! jsoot_agd GDR7F405.71
A_IXPTR(56)=A_IXPTR(55)+ P_LEVELS ! jsoot_cld GDR7F405.72
A_IXPTR(57)=A_IXPTR(56)+ P_LEVELS ! jco2 GDR7F405.73
CL UMINDEX1.278
CL super array length UMINDEX1.279
A_SPPTR_LEN =A_IXPTR(57)+ P_LEVELS GDR7F405.74
A_SPPTR_LEN =A_SPPTR_LEN -1 UMINDEX1.281
CL UMINDEX1.282
CL UMINDEX1.283
CL 1.3 Derived constants super array UMINDEX1.284
CL UMINDEX1.285
CL super array addresses UMINDEX1.286
A_IXCON(1) =1 UMINDEX1.287
A_IXCON(2) =A_IXCON(1) + P_LEVELS UMINDEX1.288
A_IXCON(3) =A_IXCON(2) + P_LEVELS UMINDEX1.289
A_IXCON(4) =A_IXCON(3) + P_LEVELS+1 UMINDEX1.290
A_IXCON(5) =A_IXCON(4) + P_LEVELS+1 UMINDEX1.291
A_IXCON(6) =A_IXCON(5) + P_LEVELS+1 UMINDEX1.292
A_IXCON(7) =A_IXCON(6) + P_LEVELS+1 UMINDEX1.293
A_IXCON(8) =A_IXCON(7) + U_FIELD UMINDEX1.294
A_IXCON(9) =A_IXCON(8) + P_FIELD UMINDEX1.295
A_IXCON(10)=A_IXCON(9) + U_FIELD UMINDEX1.296
A_IXCON(11)=A_IXCON(10)+ P_FIELD UMINDEX1.297
A_IXCON(12)=A_IXCON(11)+ U_FIELD UMINDEX1.298
A_IXCON(13)=A_IXCON(12)+ ROW_LENGTH UMINDEX1.299
A_IXCON(14)=A_IXCON(13)+ ROW_LENGTH UMINDEX1.300
A_IXCON(15)=A_IXCON(14)+ P_FIELD UMINDEX1.301
A_IXCON(16)=A_IXCON(15)+ U_FIELD UMINDEX1.302
A_IXCON(17)=A_IXCON(16)+ U_FIELD UMINDEX1.303
A_IXCON(18)=A_IXCON(17)+ U_FIELD UMINDEX1.304
A_IXCON(19)=A_IXCON(18)+ P_FIELD UMINDEX1.305
A_IXCON(20)=A_IXCON(19)+ ROW_LENGTH UMINDEX1.306
A_IXCON(21)=A_IXCON(20)+ P_FIELD/ROW_LENGTH UMINDEX1.307
A_IXCON(22)=A_IXCON(21)+ UMINDEX1.308
& MATRIX_POLY_ORDER*MATRIX_POLY_ORDER*P_LEVELS UMINDEX1.309
*IF -DEF,MPP GPB0F305.378
A_IXCON(23)=A_IXCON(22)+ LAND_FIELD UMINDEX1.310
A_IXCON(24)=A_IXCON(23) + LAND_FIELD GJT1F304.38
*ELSE GPB0F305.379
A_IXCON(23)=A_IXCON(22)+ P_FIELD GPB0F305.380
A_IXCON(24)=A_IXCON(23) + P_FIELD GPB0F305.381
! ! land point fields are allocated P_FIELD amount of space in D1 GPB0F305.382
*ENDIF GPB0F305.383
CL UMINDEX1.311
CL super array length UMINDEX1.312
A_SPCON_LEN =A_IXCON(24) + U_FIELD GJT1F304.39
A_SPCON_LEN =A_SPCON_LEN -1 UMINDEX1.314
CL UMINDEX1.315
CL UMINDEX1.316
CL 1.4 Interface output (boundary conditions) super array UMINDEX1.317
CL UMINDEX1.318
CL super array addresses UMINDEX1.319
A_IXINF(1) =1 UMINDEX1.320
A_IXINF(2) =A_IXINF(1) + LEN_FIXHD*N_INTF_A UMINDEX1.321
A_IXINF(3) =A_IXINF(2) + PP_LEN_INTHD*N_INTF_A UMINDEX1.322
A_IXINF(4) =A_IXINF(3) + LEN1_LOOKUP*INTF_LOOKUPSA*N_INTF_A UMINDEX1.323
A_IXINF(5) =A_IXINF(4) + PP_LEN_REALHD*N_INTF_A UMINDEX1.324
A_IXINF(6) =A_IXINF(5) + MAX_INTF_P_LEVELS*INTF_LEN2_LEVDEPC* UMINDEX1.325
& N_INTF_A UMINDEX1.326
A_IXINF(7) =A_IXINF(6) + TOT_LEN_INTFA_P UMINDEX1.327
A_IXINF(8) =A_IXINF(7) + TOT_LEN_INTFA_P UMINDEX1.328
A_IXINF(9) =A_IXINF(8) + TOT_LEN_INTFA_U UMINDEX1.329
A_IXINF(10)=A_IXINF(9) + TOT_LEN_INTFA_U UMINDEX1.330
A_IXINF(11)=A_IXINF(10)+ TOT_LEN_INTFA_P UMINDEX1.331
A_IXINF(12)=A_IXINF(11)+ TOT_LEN_INTFA_P UMINDEX1.332
A_IXINF(13)=A_IXINF(12)+ TOT_LEN_INTFA_P UMINDEX1.333
A_IXINF(14)=A_IXINF(13)+ TOT_LEN_INTFA_P UMINDEX1.334
A_IXINF(15)=A_IXINF(14)+ TOT_LEN_INTFA_U UMINDEX1.335
A_IXINF(16)=A_IXINF(15)+ TOT_LEN_INTFA_U UMINDEX1.336
A_IXINF(17)=A_IXINF(16)+ TOT_LEN_INTFA_U UMINDEX1.337
A_IXINF(18)=A_IXINF(17)+ TOT_LEN_INTFA_U UMINDEX1.338
A_IXINF(19)=A_IXINF(18)+ TOT_LEN_INTFA_U UMINDEX1.339
A_IXINF(20)=A_IXINF(19)+ TOT_LEN_INTFA_U UMINDEX1.340
A_IXINF(21)=A_IXINF(20)+ U_FIELD_INTFA GDR2F405.47
A_IXINF(22)=A_IXINF(21)+ U_FIELD_INTFA GDR2F405.48
A_IXINF(23)=A_IXINF(22)+ (MAX_INTF_P_LEVELS+1)*N_INTF_A GDR2F405.49
A_IXINF(24)=A_IXINF(23)+ (MAX_INTF_P_LEVELS+1)*N_INTF_A GDR2F405.50
A_IXINF(25)=A_IXINF(24)+ MAX_INTF_P_LEVELS *N_INTF_A GDR2F405.51
CL UMINDEX1.342
CL super array length UMINDEX1.343
A_SPINF_LEN =A_IXINF(25)+ MAX_INTF_P_LEVELS*N_INTF_A GDR2F405.52
A_SPINF_LEN =A_SPINF_LEN -1 UMINDEX1.345
CL UMINDEX1.346
write (6,*) 'umindex : a_spinf_len ',a_spinf_len GDR2F405.53
CL UMINDEX1.347
CL 1.5 Ancillary file super array UMINDEX1.348
CL UMINDEX1.349
CL super array addresses UMINDEX1.350
A_IXANC(1) =1 UMINDEX1.351
A_IXANC(2) =A_IXANC(1) + LEN_FIXHD*NANCIL_DATASETSA UMINDEX1.352
A_IXANC(3) =A_IXANC(2) + A_LEN_INTHD*NANCIL_DATASETSA UMINDEX1.353
A_IXANC(4) =A_IXANC(3) + LEN1_LOOKUP*NANCIL_LOOKUPSA UMINDEX1.354
CL UMINDEX1.355
CL super array length UMINDEX1.356
A_SPANC_LEN =A_IXANC(4)+ A_LEN_REALHD*NANCIL_DATASETSA UMINDEX1.357
A_SPANC_LEN =A_SPANC_LEN -1 UMINDEX1.358
CL UMINDEX1.359
CL UMINDEX1.360
CL 1.6 Input boundary constants super array UMINDEX1.361
CL UMINDEX1.362
CL super array addresses UMINDEX1.363
A_IXBND(1) =1 UMINDEX1.364
A_IXBND(2) =A_IXBND(1) + LEN_FIXHD*2 UMINDEX1.365
A_IXBND(3) =A_IXBND(2) + A_LEN_INTHD*2 UMINDEX1.366
A_IXBND(4) =A_IXBND(3) + LEN1_LOOKUP*BOUND_LOOKUPSA UMINDEX1.367
CL UMINDEX1.368
CL super array length UMINDEX1.369
A_SPBND_LEN =A_IXBND(4)+ A_LEN_REALHD*2 UMINDEX1.370
A_SPBND_LEN =A_SPBND_LEN -1 UMINDEX1.371
CL UMINDEX1.372
CL---------------------------------------------------------------------- UMINDEX1.373
CL UMINDEX1.374
RETURN UMINDEX1.375
END UMINDEX1.376
*ENDIF UMINDEX1.377
*IF DEF,CONTROL,AND,DEF,OCEAN UMINDEX1.378
CLL Subroutine: UM_INDEX_O--------------------------------------------- UMINDEX1.379
CLL UMINDEX1.380
CLL Purpose: Calculate addresses and lengths of ocean super arrays WRB1F401.927
CLL UMINDEX1.382
CLL Tested under compiler: cft77 UMINDEX1.383
CLL Tested under OS version: UNICOS 6.1.5A UMINDEX1.384
CLL UMINDEX1.385
CLL Model Modification history: UMINDEX1.386
CLL version date UMINDEX1.387
CLL 3.2 30/03/93 Introduced as new DECK to allow dynamic allocation UMINDEX1.388
CLL of main data arrays in U_MODEL. UMINDEX1.389
!LL 4.0 06/09/95 Added ocean stash superarray. K Rogers GKR0F400.20
CLL UMINDEX1.390
CLL Programming standard: UM Doc Paper 3, version 2 (7/9/90) UMINDEX1.391
CLL UMINDEX1.392
CLL Logical components covered: C0 UMINDEX1.393
CLL UMINDEX1.394
CLL Project task: C0 UMINDEX1.395
CLL UMINDEX1.396
CLL External documentation: On-line UM document C1 - The top-level UMINDEX1.397
CLL dynamic allocation UMINDEX1.398
CLL UMINDEX1.399
CLL ------------------------------------------------------------------- UMINDEX1.400
C*L Interface and arguments: ------------------------------------------ UMINDEX1.401
C UMINDEX1.402
SUBROUTINE UM_INDEX_O( 1,1UMINDEX1.403
*CALL ARGSIZE SF011193.42
*CALL ARGSZSPO UMINDEX1.404
& ICODE,CMESSAGE) UMINDEX1.405
C UMINDEX1.406
C*---------------------------------------------------------------------- UMINDEX1.407
IMPLICIT NONE UMINDEX1.408
C UMINDEX1.409
C Subroutines called UMINDEX1.410
C UMINDEX1.411
EXTERNAL OCNARYPT UMINDEX1.412
C UMINDEX1.413
C Local variables UMINDEX1.414
C UMINDEX1.415
INTEGER ICODE ! Work - Internal return code UMINDEX1.416
CHARACTER*80 CMESSAGE ! Work - Internal error message WRB1F401.928
C UMINDEX1.418
C Configuration-dependent sizes for dynamic arrays UMINDEX1.419
C UMINDEX1.420
*CALL TYPSIZE UMINDEX1.421
C UMINDEX1.422
C Ancillary file parameters for ancillary length calculations UMINDEX1.423
*CALL CONANC UMINDEX1.424
C UMINDEX1.425
C Super array sizes for dynamic allocation in U_MODEL UMINDEX1.426
C UMINDEX1.427
*CALL TYPSZSPO UMINDEX1.428
C UMINDEX1.429
C Addresses of arrays in super arrays. UMINDEX1.430
C UMINDEX1.431
*CALL SPINDEX UMINDEX1.432
C UMINDEX1.433
CL---------------------------------------------------------------------- UMINDEX1.434
CL UMINDEX1.435
ICODE=0 UMINDEX1.436
GKR0F400.21
!L GKR0F400.22
!L 1.0 Calculate size of ocean stash array GKR0F400.23
!L GKR0F400.24
o_ixsts(1) = 1 ! joc_tracer GKR0F400.25
o_ixsts(2) = o_ixsts(1) + 2 * nt ! joc_u GKR0F400.26
o_ixsts(3) = o_ixsts(2) + 2 ! joc_v GKR0F400.27
o_ixsts(4) = o_ixsts(3) + 2 ! joc_no_seapts GKR0F400.28
o_ixsts(5) = o_ixsts(4) + 1 ! joc_no_segs GKR0F400.29
o_ixsts(6) = o_ixsts(5) + 1 ! o_cfi1 GKR0F400.30
o_ixsts(7) = o_ixsts(6) + o_len_cfi1 ! o_cfi2 GKR0F400.31
o_ixsts(8) = o_ixsts(7) + o_len_cfi2 ! o_cfi3 GKR0F400.32
o_ixsts(9) = o_ixsts(8) + o_len_cfi3 ! len_ocwork GKR0F400.33
o_ixsts(10) = o_ixsts(9) + 1 ! dummy GKR0F400.34
o_ixsts(11) = o_ixsts(10) + 1 ! land mask ORH2F405.18
o_spsts_len = o_ixsts(11) + IMT * JMT ORH2F405.19
! ORH2F405.20
! Store O_SPSTS_LEN in TYPSIZE UDR2F404.37
LEN_O_SPSTS = O_SPSTS_LEN UDR2F404.38
GKR0F400.37
CL UMINDEX1.437
CL 1.1 DUMP super array UMINDEX1.438
CL UMINDEX1.439
CL super array addresses UMINDEX1.440
O_IXDUM(1) =1 UMINDEX1.441
O_IXDUM(2) =O_IXDUM(1) + LEN_FIXHD UMINDEX1.442
O_IXDUM(3) =O_IXDUM(2) + O_LEN_INTHD UMINDEX1.443
O_IXDUM(4) =O_IXDUM(3) + O_LEN_CFI1+1 UMINDEX1.444
O_IXDUM(5) =O_IXDUM(4) + O_LEN_CFI2+1 UMINDEX1.445
O_IXDUM(6) =O_IXDUM(5) + O_LEN_CFI3+1 UMINDEX1.446
O_IXDUM(7) =O_IXDUM(6) + O_LEN_REALHD UMINDEX1.447
O_IXDUM(8) =O_IXDUM(7) + O_LEN1_LEVDEPC*O_LEN2_LEVDEPC+1 UMINDEX1.448
O_IXDUM(9) =O_IXDUM(8) + O_LEN1_ROWDEPC*O_LEN2_ROWDEPC+1 UMINDEX1.449
O_IXDUM(10)=O_IXDUM(9) + O_LEN1_COLDEPC*O_LEN2_COLDEPC+1 UMINDEX1.450
O_IXDUM(11)=O_IXDUM(10)+ O_LEN1_FLDDEPC*O_LEN2_FLDDEPC+1 UMINDEX1.451
O_IXDUM(12)=O_IXDUM(11)+ O_LEN_EXTCNST+1 UMINDEX1.452
O_IXDUM(13)=O_IXDUM(12)+ LEN_DUMPHIST+1 UMINDEX1.453
*IF DEF,MPP GSM1F403.52
O_IXDUM(14)=O_IXDUM(13)+ LEN1_LOOKUP*O_LEN2_LOOKUP GSM1F403.53
*ENDIF GSM1F403.54
GSM1F403.55
CL UMINDEX1.454
CL super array length UMINDEX1.455
*IF DEF,MPP GSM1F403.56
O_SPDUM_LEN =O_IXDUM(14)+ MPP_LEN1_LOOKUP*O_LEN2_LOOKUP GSM1F403.57
*ELSE GSM1F403.58
O_SPDUM_LEN =O_IXDUM(13)+ LEN1_LOOKUP*O_LEN2_LOOKUP UMINDEX1.456
*ENDIF GSM1F403.59
O_SPDUM_LEN =O_SPDUM_LEN -1 UMINDEX1.457
CL UMINDEX1.458
CL UMINDEX1.459
CL 1.2 Pointers super array UMINDEX1.460
CL UMINDEX1.461
CL super array addresses UMINDEX1.462
O_IXPTR(1) =1 UMINDEX1.463
CL UMINDEX1.464
CL super array length UMINDEX1.465
O_IXPTR(2) =O_IXPTR(1)+ NT*2 ! joc_tracer GSI1F405.71
O_SPPTR_LEN =O_IXPTR(2)+ NT ! joc_bdy_tracer GSI1F405.72
O_SPPTR_LEN =O_SPPTR_LEN -1 UMINDEX1.467
CL UMINDEX1.468
CL UMINDEX1.469
CL 1.3 Derived constants super array UMINDEX1.470
CL UMINDEX1.471
CL super array addresses UMINDEX1.472
O_IXCON(1) =1 UMINDEX1.473
CL UMINDEX1.474
CL super array length UMINDEX1.475
CL Ocean addresses for this array are calculated and passed internally UMINDEX1.476
CL to OCEAN routines only. This is a special case. UMINDEX1.477
CL UMINDEX1.478
CALL OCNARYPT ( SF011193.43
*CALL ARGSIZE SF011193.44
*O_SPCON_LEN,ICODE,CMESSAGE) SF011193.45
CL UMINDEX1.480
CL Note that this is the only UMINDEX1.481
CL array which is passed down without decomposing into constituent UMINDEX1.482
CL arrays, each with dedicated sizes. UMINDEX1.483
CL UMINDEX1.484
CL 1.4 Interface output (boundary conditions) super array GMB1F405.339
CL GMB1F405.340
CL super array addresses GMB1F405.341
O_IXINF(1) =1 GMB1F405.342
O_IXINF(2) =O_IXINF(1) + LEN_FIXHD*N_INTF_O GMB1F405.343
O_IXINF(3) =O_IXINF(2) + PP_LEN_INTHD*N_INTF_O GMB1F405.344
O_IXINF(4) =O_IXINF(3) + LEN1_LOOKUP*INTF_LOOKUPSO*N_INTF_O GMB1F405.345
O_IXINF(5) =O_IXINF(4) + PP_LEN_REALHD*N_INTF_O GMB1F405.346
O_IXINF(6) =O_IXINF(5) + MAX_INTF_P_LEVELS_O*INTF_LEN2_LEVDEPC_O GMB1F405.347
& *N_INTF_O GMB1F405.348
O_IXINF(7) =O_IXINF(6) + TOT_LEN_INTFO_P GMB1F405.349
O_IXINF(8) =O_IXINF(7) + TOT_LEN_INTFO_P GMB1F405.350
O_IXINF(9) =O_IXINF(8) + TOT_LEN_INTFO_U GMB1F405.351
O_IXINF(10)=O_IXINF(9) + TOT_LEN_INTFO_U GMB1F405.352
O_IXINF(11)=O_IXINF(10)+ TOT_LEN_INTFO_P GMB1F405.353
O_IXINF(12)=O_IXINF(11)+ TOT_LEN_INTFO_P GMB1F405.354
O_IXINF(13)=O_IXINF(12)+ TOT_LEN_INTFO_P GMB1F405.355
O_IXINF(14)=O_IXINF(13)+ TOT_LEN_INTFO_P GMB1F405.356
O_IXINF(15)=O_IXINF(14)+ TOT_LEN_INTFO_U GMB1F405.357
O_IXINF(16)=O_IXINF(15)+ TOT_LEN_INTFO_U GMB1F405.358
O_IXINF(17)=O_IXINF(16)+ TOT_LEN_INTFO_U GMB1F405.359
O_IXINF(18)=O_IXINF(17)+ TOT_LEN_INTFO_U GMB1F405.360
O_IXINF(19)=O_IXINF(18)+ TOT_LEN_INTFO_U GMB1F405.361
O_IXINF(20)=O_IXINF(19)+ TOT_LEN_INTFO_U GMB1F405.362
O_IXINF(21)=O_IXINF(20)+ NPTS_U_FIELD_O GMB1F405.363
O_IXINF(22)=O_IXINF(21)+ NPTS_U_FIELD_O GMB1F405.364
O_IXINF(23)=O_IXINF(22)+ TOT_LEN_INTFO_U GMB1F405.365
CL GMB1F405.366
CL super array length GMB1F405.367
O_SPINF_LEN =O_IXINF(23)+ TOT_LEN_INTFO_U GMB1F405.368
O_SPINF_LEN =O_SPINF_LEN -1 GMB1F405.369
CL UMINDEX1.509
CL UMINDEX1.510
CL 1.5 Ancillary file super array UMINDEX1.511
CL UMINDEX1.512
CL super array addresses UMINDEX1.513
O_IXANC(1) =1 UMINDEX1.514
O_IXANC(2) =O_IXANC(1) + LEN_FIXHD*NANCIL_DATASETSO UMINDEX1.515
O_IXANC(3) =O_IXANC(2) + O_LEN_INTHD*NANCIL_DATASETSO UMINDEX1.516
O_IXANC(4) =O_IXANC(3) + LEN1_LOOKUP*NANCIL_LOOKUPSO UMINDEX1.517
CL UMINDEX1.518
CL super array length UMINDEX1.519
O_SPANC_LEN =O_IXANC(4)+ O_LEN_REALHD*NANCIL_DATASETSO UMINDEX1.520
O_SPANC_LEN =O_SPANC_LEN -1 UMINDEX1.521
CL UMINDEX1.522
CL UMINDEX1.523
CL 1.6 Input boundary constants super array UMINDEX1.524
CL UMINDEX1.525
CL super array addresses UMINDEX1.526
O_IXBND(1) =1 UMINDEX1.527
O_IXBND(2) =O_IXBND(1) + LEN_FIXHD*2 UMINDEX1.528
O_IXBND(3) =O_IXBND(2) + O_LEN_INTHD*2 UMINDEX1.529
O_IXBND(4) =O_IXBND(3) + LEN1_LOOKUP*BOUND_LOOKUPSO UMINDEX1.530
CL UMINDEX1.531
CL super array length UMINDEX1.532
O_SPBND_LEN =O_IXBND(4)+ O_LEN_REALHD*2 UMINDEX1.533
O_SPBND_LEN =O_SPBND_LEN -1 UMINDEX1.534
CL WRB1F401.929
CL---------------------------------------------------------------------- WRB1F401.930
CL WRB1F401.931
RETURN WRB1F401.932
END WRB1F401.933
*ENDIF WRB1F401.934
*IF DEF,CONTROL,AND,DEF,WAVE WRB1F401.935
CLL Subroutine: UM_INDEX_W--------------------------------------------- WRB1F401.936
CLL WRB1F401.937
CLL Purpose: Calculate addresses and lengths of wave super arrays WRB1F401.938
CLL WRB1F401.939
CLL Tested under compiler: cft77 WRB1F401.940
CLL Tested under OS version: UNICOS 8 WRB1F401.941
CLL WRB1F401.942
CLL Model Modification history: WRB1F401.943
CLL version date WRB1F401.944
!LL 4.1 15/03/96 Introduce Wave sub-model. RTHBarnes. WRB1F401.945
CLL WRB1F401.946
CLL Programming standard: UM Doc Paper 3, version 2 (7/9/90) WRB1F401.947
CLL WRB1F401.948
CLL Logical components covered: C0 WRB1F401.949
CLL WRB1F401.950
CLL Project task: C0 WRB1F401.951
CLL WRB1F401.952
CLL External documentation: On-line UM document C1 - The top-level WRB1F401.953
CLL dynamic allocation WRB1F401.954
CLL WRB1F401.955
CLL ------------------------------------------------------------------- WRB1F401.956
C*L Interface and arguments: ------------------------------------------ WRB1F401.957
C WRB1F401.958
SUBROUTINE UM_INDEX_W( 1WRB1F401.959
*CALL ARGSIZE WRB1F401.960
*CALL ARGSZSPW WRB1F401.961
& ICODE,CMESSAGE) WRB1F401.962
C WRB1F401.963
C*---------------------------------------------------------------------- WRB1F401.964
IMPLICIT NONE WRB1F401.965
C WRB1F401.966
C Subroutines called WRB1F401.967
C WRB1F401.968
! EXTERNAL WRB1F401.969
C WRB1F401.970
C Local variables WRB1F401.971
C WRB1F401.972
INTEGER ICODE ! Work - Internal return code WRB1F401.973
CHARACTER*80 CMESSAGE ! Work - Internal error message WRB1F401.974
C WRB1F401.975
C Configuration-dependent sizes for dynamic arrays WRB1F401.976
C WRB1F401.977
*CALL TYPSIZE WRB1F401.978
C WRB1F401.979
C Ancillary file parameters for ancillary length calculations WRB1F401.980
*CALL CONANC WRB1F401.981
C WRB1F401.982
C Super array sizes for dynamic allocation in U_MODEL WRB1F401.983
C WRB1F401.984
*CALL TYPSZSPW WRB1F401.985
C WRB1F401.986
C Addresses of arrays in super arrays. WRB1F401.987
C WRB1F401.988
*CALL SPINDEX WRB1F401.989
C WRB1F401.990
CL---------------------------------------------------------------------- WRB1F401.991
CL WRB1F401.992
ICODE=0 WRB1F401.993
WRB1F401.994
!L WRB1F401.995
!L 1.0 Calculate size of wave stash array WRB1F401.996
!L WRB1F401.997
w_ixsts(1) = 1 ! land sea mask WRB1F401.998
w_ixsts(2) = w_ixsts(1) + ngx*ngy ! size of field WRB1F401.999
w_ixsts(3) = w_ixsts(2) + 1 ! dummy WRB1F401.1000
w_ixsts(4) = w_ixsts(3) + 1 ! dummy WRB1F401.1001
w_ixsts(5) = w_ixsts(4) + 1 ! dummy WRB1F401.1002
w_ixsts(6) = w_ixsts(5) + 1 ! dummy WRB1F401.1003
w_ixsts(7) = w_ixsts(6) + 1 ! dummy WRB1F401.1004
w_ixsts(8) = w_ixsts(7) + 1 ! dummy WRB1F401.1005
w_ixsts(9) = w_ixsts(8) + 1 ! dummy WRB1F401.1006
w_ixsts(10) = w_ixsts(9) + 1 ! dummy WRB1F401.1007
w_ixsts(11) = w_ixsts(10) + 1 ! dummy WRB1F401.1008
w_spsts_len = w_ixsts(11) + 1 WRB1F401.1009
! Store W_SPSTS_LEN in TYPSIZE UDR2F404.39
LEN_W_SPSTS = W_SPSTS_LEN UDR2F404.40
WRB1F401.1010
CL WRB1F401.1011
CL 1.1 DUMP super array WRB1F401.1012
CL WRB1F401.1013
CL super array addresses WRB1F401.1014
W_IXDUM(1) =1 WRB1F401.1015
W_IXDUM(2) =W_IXDUM(1) + LEN_FIXHD WRB1F401.1016
W_IXDUM(3) =W_IXDUM(2) + W_LEN_INTHD WRB1F401.1017
W_IXDUM(4) =W_IXDUM(3) + W_LEN_CFI1+1 WRB1F401.1018
W_IXDUM(5) =W_IXDUM(4) + W_LEN_CFI2+1 WRB1F401.1019
W_IXDUM(6) =W_IXDUM(5) + W_LEN_CFI3+1 WRB1F401.1020
W_IXDUM(7) =W_IXDUM(6) + W_LEN_REALHD WRB1F401.1021
W_IXDUM(8) =W_IXDUM(7) + W_LEN1_LEVDEPC*W_LEN2_LEVDEPC+1 WRB1F401.1022
W_IXDUM(9) =W_IXDUM(8) + W_LEN1_ROWDEPC*W_LEN2_ROWDEPC+1 WRB1F401.1023
W_IXDUM(10)=W_IXDUM(9) + W_LEN1_COLDEPC*W_LEN2_COLDEPC+1 WRB1F401.1024
W_IXDUM(11)=W_IXDUM(10)+ W_LEN1_FLDDEPC*W_LEN2_FLDDEPC+1 WRB1F401.1025
W_IXDUM(12)=W_IXDUM(11)+ W_LEN_EXTCNST+1 WRB1F401.1026
W_IXDUM(13)=W_IXDUM(12)+ LEN_DUMPHIST+1 WRB1F401.1027
CL WRB1F401.1028
CL super array length WRB1F401.1029
W_SPDUM_LEN =W_IXDUM(13)+ LEN1_LOOKUP*W_LEN2_LOOKUP WRB1F401.1030
W_SPDUM_LEN =W_SPDUM_LEN -1 WRB1F401.1031
CL WRB1F401.1032
CL WRB1F401.1033
CL 1.2 Pointers super array WRB1F401.1034
CL WRB1F401.1035
CL super array addresses WRB1F401.1036
W_IXPTR(1) =1 WRB1F401.1037
CL WRB1F401.1038
CL super array length WRB1F401.1039
W_SPPTR_LEN =W_IXPTR(1)+ 1 WRB1F401.1040
W_SPPTR_LEN =W_SPPTR_LEN -1 WRB1F401.1041
CL WRB1F401.1042
CL WRB1F401.1043
CL 1.3 Derived constants super array WRB1F401.1044
CL WRB1F401.1045
CL super array addresses WRB1F401.1046
W_IXCON(1) =1 WRB1F401.1047
W_SPCON_LEN = 1 WRB1F401.1048
CL WRB1F401.1049
CL super array length WRB1F401.1050
CL Wave addresses for this array are calculated and passed internally WRB1F401.1051
CL to WAVE routines only. WRB1F401.1052
CL This is a special case - by analogy with Ocean model. WRB1F401.1053
CL WRB1F401.1054
CALL WAVARYPT ( WRB1F401.1055
*CALL ARGSIZE WRB1F401.1056
*W_SPCON_LEN,ICODE,CMESSAGE) WRB1F401.1057
CL WRB1F401.1058
CL Note that this is the only WRB1F401.1059
CL array which is passed down without decomposing into constituent WRB1F401.1060
CL arrays, each with dedicated sizes. WRB1F401.1061
CL WRB1F401.1062
CL 1.4 Interface output (boundary conditions) super array WRB1F401.1063
CL (DUMMY ADDRESSES until wave bc code developed) WRB1F401.1064
CL super array addresses WRB1F401.1065
W_IXINF(1) =1 WRB1F401.1066
W_IXINF(2) =1 WRB1F401.1067
W_IXINF(3) =1 WRB1F401.1068
W_IXINF(4) =1 WRB1F401.1069
W_IXINF(5) =1 WRB1F401.1070
W_IXINF(6) =1 WRB1F401.1071
W_IXINF(7) =1 WRB1F401.1072
W_IXINF(8) =1 WRB1F401.1073
W_IXINF(9) =1 WRB1F401.1074
W_IXINF(10)=1 WRB1F401.1075
W_IXINF(11)=1 WRB1F401.1076
W_IXINF(12)=1 WRB1F401.1077
W_IXINF(13)=1 WRB1F401.1078
W_IXINF(14)=1 WRB1F401.1079
W_IXINF(15)=1 WRB1F401.1080
W_IXINF(16)=1 WRB1F401.1081
W_IXINF(17)=1 WRB1F401.1082
W_IXINF(18)=1 WRB1F401.1083
W_IXINF(19)=1 WRB1F401.1084
W_IXINF(20)=1 WRB1F401.1085
W_IXINF(21)=1 WRB1F401.1086
CL WRB1F401.1087
CL super array length WRB1F401.1088
W_SPINF_LEN =W_IXINF(21)+ 1 WRB1F401.1089
W_SPINF_LEN =W_SPINF_LEN -1 WRB1F401.1090
CL WRB1F401.1091
CL WRB1F401.1092
CL 1.5 Ancillary file super array WRB1F401.1093
CL WRB1F401.1094
CL super array addresses WRB1F401.1095
W_IXANC(1) =1 WRB1F401.1096
W_IXANC(2) =W_IXANC(1) + LEN_FIXHD*NANCIL_DATASETSW WRB1F401.1097
W_IXANC(3) =W_IXANC(2) + W_LEN_INTHD*NANCIL_DATASETSW WRB1F401.1098
W_IXANC(4) =W_IXANC(3) + LEN1_LOOKUP*NANCIL_LOOKUPSW WRB1F401.1099
CL WRB1F401.1100
CL super array length WRB1F401.1101
W_SPANC_LEN =W_IXANC(4)+ W_LEN_REALHD*NANCIL_DATASETSW WRB1F401.1102
W_SPANC_LEN =W_SPANC_LEN -1 WRB1F401.1103
CL WRB1F401.1104
CL WRB1F401.1105
CL 1.6 Input boundary constants super array WRB1F401.1106
CL WRB1F401.1107
CL super array addresses WRB1F401.1108
W_IXBND(1) =1 WRB1F401.1109
W_IXBND(2) =W_IXBND(1) + LEN_FIXHD*2 WRB1F401.1110
W_IXBND(3) =W_IXBND(2) + W_LEN_INTHD*2 WRB1F401.1111
W_IXBND(4) =W_IXBND(3) + LEN1_LOOKUP*BOUND_LOOKUPSW WRB1F401.1112
CL WRB1F401.1113
CL super array length WRB1F401.1114
W_SPBND_LEN =W_IXBND(4)+ W_LEN_REALHD*2 WRB1F401.1115
W_SPBND_LEN =W_SPBND_LEN -1 WRB1F401.1116
CL UMINDEX1.535
CL---------------------------------------------------------------------- UMINDEX1.536
CL UMINDEX1.537
RETURN UMINDEX1.538
END UMINDEX1.539
*ENDIF UMINDEX1.540