SUBROUTINE DECOMP_FILTR( 1DECMFLTR.20
*CALL ARGSIZE 
DECMFLTR.21
*CALL ARGOCALL ORH1F405.89
& L_OSYMM,L_OFREESFC) ORH1F405.90
! DECMFLTR.24
! Description: This subroutine is intended to define all the DECMFLTR.25
! variables required when distributing fourier filtering DECMFLTR.26
! across all pes rather than just the pes closest to the DECMFLTR.27
! North/South. DECMFLTR.28
! DECMFLTR.29
! Author: R. Hill DECMFLTR.30
! DECMFLTR.31
! Date : March 1997 DECMFLTR.32
! DECMFLTR.33
! ORH1F405.91
! Modification History ORH1F405.92
! ORH1F405.93
! Date Name Description ORH1F405.94
! -------- --------- -------------------------------------- ORH1F405.95
! 09.01.98 RSR Hill Completely revise work distribution ORH1F405.96
! to try to acheive optimum load balance. ORH1F405.97
! ORH1F405.98
!******************************************************************** DECMFLTR.34
DECMFLTR.35
IMPLICIT NONE DECMFLTR.36
DECMFLTR.37
*CALL TYPSIZE DECMFLTR.38
*CALL TYPOCALL ORH1F405.99
*CALL PARVARS DECMFLTR.40
*CALL COCNINDX DECMFLTR.41
DECMFLTR.42
DECMFLTR.43
!********************************************************************* DECMFLTR.44
! LOCAL VARIABLES DECMFLTR.45
!********************************************************************* DECMFLTR.46
INTEGER OLD_PE DECMFLTR.47
ORH1F405.100
& ,J DECMFLTR.49
& ,INFO DECMFLTR.50
DECMFLTR.51
INTEGER FILT_ROW_GLOBAL (JMT_GLOBAL) ! Rows which get filtered DECMFLTR.52
& , TEMPA DECMFLTR.53
DECMFLTR.54
INTEGER WORK_SIZE_U(KM*LSEGF*NJTBFU) ! Amount of work per ORH1F405.101
&, WORK_SIZE_T(KM*LSEGF*NJTBFT) ! segment. ORH1F405.102
&, WORK_PE_U(KM*LSEGF*NJTBFU) ! The PE who owns the ORH1F405.103
&, WORK_PE_T(KM*LSEGF*NJTBFT) ! segment. ORH1F405.104
&, WORK_K_U(KM*LSEGF*NJTBFU) ! The level of the segment ORH1F405.105
&, WORK_K_T(KM*LSEGF*NJTBFT) ! on the owner PE. ORH1F405.106
&, WORK_SEG_U(KM*LSEGF*NJTBFU) ! The segment number in the ORH1F405.107
&, WORK_SEG_T(KM*LSEGF*NJTBFT) ! level on the owner PE. ORH1F405.108
&, U_OR_T ! Temporary flag ORH1F405.109
& ! 1 = U field ORH1F405.110
& ! 2 = V field ORH1F405.111
& ! 3 = T field ORH1F405.112
&, SEG_CNT_U ! counter ORH1F405.113
&, SEG_CNT_T ! counter ORH1F405.114
&, IPROC ! PE index ORH1F405.115
&, JY ! End J (global) for any pe ORH1F405.116
&, JJ ! Filter row index ORH1F405.117
&, JIND ! loop index ORH1F405.118
&, FIRST_PE ! PE index ORH1F405.119
&, LAST_PE ! PE index ORH1F405.120
&, I,K,L ! Loop indices ORH1F405.121
&, PE ! PE index ORH1F405.122
&, PE_MIN ORH1F405.123
&, PE_F ORH1F405.124
&, MAX_IPROC ! Temporary PE value ORH1F405.125
&, MAX_K ! Temporary level value ORH1F405.126
&, MAX_SEG ! Temp L ORH1F405.127
&, MAX_WORK ! Temporary - to find largest bit of work ORH1F405.128
&, SAVE_L ! Temp counter ORH1F405.129
&, SEG_LEN ! Length of a sea segment ORH1F405.130
&, WORKLOAD(0:O_NPROC-1) ! Amount of work for each PE ORH1F405.131
&, WORKLOAD_F(0:O_NPROC-1) ! Amount of work for each PE ORH1F405.132
&, TOT_WORK_LEFT ! Temporary - number of work chunks left ORH1F405.133
ORH1F405.134
LOGICAL L_OSYMM ! Symmetry conditions switch ORH1F405.135
&, L_OFREESFC ! Free surface switch ORH1F405.136
ORH1F405.137
DECMFLTR.55
DECMFLTR.56
! We need to know what the maximum number of rows is on DECMFLTR.57
! any one PE DECMFLTR.58
MAX_ROW_INDEX = J_JMTM1 DECMFLTR.59
CALL GC_IMAX(1,O_NPROC,INFO,MAX_ROW_INDEX) DECMFLTR.60
DECMFLTR.61
WRITE(6,*) "MAX_ROW_INDEX = ", MAX_ROW_INDEX DECMFLTR.62
DECMFLTR.63
!*************************************************************** DECMFLTR.64
! First compute how much work is done on each (local) value of J ORH1F405.138
! for velocities in the CLINIC subroutine. ORH1F405.139
!*************************************************************** DECMFLTR.67
DECMFLTR.68
ORH1F405.140
DO J = 1, JMT ORH1F405.141
SLAV_CNT_U(J) = 0 ORH1F405.142
MAST_CNT_U(J) = 0 ORH1F405.143
SLAV_CNT_T(J) = 0 ORH1F405.144
MAST_CNT_T(J) = 0 ORH1F405.145
ENDDO ORH1F405.146
ORH1F405.147
DO J = 1, JMT ORH1F405.148
DO K = 1, KM ORH1F405.149
MAST_PE_U(K,J) = 0 ORH1F405.150
MAST_PE_T(K,J) = 0 ORH1F405.151
MAST_K_U(K,J) = 0 ORH1F405.152
MAST_K_T(K,J) = 0 ORH1F405.153
ENDDO ORH1F405.154
ORH1F405.155
ORH1F405.156
IF (L_OFREESFC) THEN ORH1F405.157
DO L = 1, LSEGF ORH1F405.158
MAST_PE_F(((J-1)*JMT)+L)=0 ORH1F405.159
MAST_ROW_F(((J-1)*JMT)+L)=0 ORH1F405.160
MAST_SEG_F(((J-1)*JMT)+L)=0 ORH1F405.161
ENDDO ORH1F405.162
ENDIF ORH1F405.163
ENDDO ORH1F405.164
ORH1F405.165
SLAV_CNT_F=0 ORH1F405.166
MAST_CNT_F=0 ORH1F405.167
DO IPROC =0, O_NPROC - 1 ! For all PEs ORH1F405.168
WORKLOAD_F(IPROC) = 0 ORH1F405.169
ENDDO ORH1F405.170
ORH1F405.171
! For each row (locally) ORH1F405.172
DO JIND = J_1, MAX_ROW_INDEX ORH1F405.173
ORH1F405.174
SEG_CNT_U = 0 ORH1F405.175
SEG_CNT_T = 0 ORH1F405.176
ORH1F405.177
! For each PE/row row to be filtered, see how much work is to ORH1F405.178
! be done (proportional to N squared) ORH1F405.179
DO IPROC =0, O_NPROC - 1 ! For all PEs ORH1F405.180
ORH1F405.181
! INitialise work load for all PEs ORH1F405.182
WORKLOAD(IPROC) = 0 ORH1F405.183
ORH1F405.184
! Work out the final row owned by PE IPROC ORH1F405.185
JY = g_datastart(2,IPROC) + g_blsizeu(2,IPROC) - 1 ORH1F405.186
ORH1F405.187
! Work out the current row as defined by JIND ORH1F405.188
! applied to IPROC. ORH1F405.189
J = JIND + g_datastart(2,IPROC) - O_NS_HALO - 1 ORH1F405.190
ORH1F405.191
! If the current row is within the range owned by ORH1F405.192
! PE IPROC, then consider it for filtering. ORH1F405.193
IF (J.LE.JY) THEN ORH1F405.194
ORH1F405.195
! See if we must filter this row for U and V ORH1F405.196
IF ((J.GE.JFRST.AND.J.LE.JFU1).OR. ORH1F405.197
& (J.GE.JFU2.AND.J.LE.JMTM1_GLOBAL)) THEN ORH1F405.198
ORH1F405.199
! We only deal with row JMTM1_GLOBAL if L_OSYMM = t ORH1F405.200
IF (J.LE.JMTM1_GLOBAL.AND. ORH1F405.201
& (L_OSYMM.OR.(J.NE.JMTM1_GLOBAL))) THEN ORH1F405.202
ORH1F405.203
! Whats the J index for the segment array? ORH1F405.204
JJ=J-JFRST+1 ORH1F405.205
IF (J.GE.JFU2) JJ=JJ-JSKPU+1 ORH1F405.206
ORH1F405.207
! Check each vertical level ORH1F405.208
DO K = 1, KM ORH1F405.209
! Check each segment ORH1F405.210
DO L = 1, LSEGF ORH1F405.211
! If there's a start index, we have a segment ORH1F405.212
IF (ISUF(JJ,L,K).GT.0) THEN ORH1F405.213
SEG_LEN = IEUF(JJ,L,K) - ISUF(JJ,L,K) + 1 ORH1F405.214
SEG_CNT_U = SEG_CNT_U + 1 ORH1F405.215
WORK_PE_U(SEG_CNT_U) = IPROC ORH1F405.216
WORK_K_U(SEG_CNT_U) = K ORH1F405.217
WORK_SEG_U(SEG_CNT_U) = L ORH1F405.218
WORK_SIZE_U(SEG_CNT_U) = SEG_LEN ORH1F405.219
ENDIF ORH1F405.220
ENDDO ! Over L ORH1F405.221
ENDDO ! Over K ORH1F405.222
ORH1F405.223
ENDIF ORH1F405.224
ORH1F405.225
ENDIF ! If this is a UV row to be filtered ORH1F405.226
ORH1F405.227
ENDIF ! If J <= JY ORH1F405.228
ORH1F405.229
! Adjust JY for Tracer filtering since this may be ORH1F405.230
! different from the U/V value. ORH1F405.231
JY = g_datastart(2,IPROC) + g_blsizep(2,IPROC) - 1 ORH1F405.232
ORH1F405.233
IF (J.LE.JY) THEN ORH1F405.234
ORH1F405.235
! See if we must filter this row for U and V ORH1F405.236
IF ((J.GE.JFRST.AND.J.LE.JFT1).OR. ORH1F405.237
& (J.GE.JFT2.AND. ORH1F405.238
& J.LE.JMTM1_GLOBAL)) THEN ORH1F405.239
ORH1F405.240
! Whats the J index for the segment array? ORH1F405.241
JJ=J-JFRST+1 ORH1F405.242
IF (J.GE.JFT2) JJ=JJ-JSKPT+1 ORH1F405.243
ORH1F405.244
! Check each vertical level ORH1F405.245
DO K = 1, KM ORH1F405.246
ORH1F405.247
! Check each segment ORH1F405.248
DO L = 1, LSEGF ORH1F405.249
! If there's a start index, we have a segment ORH1F405.250
IF (ISTF(JJ,L,K).GT.0) THEN ORH1F405.251
SEG_LEN = IETF(JJ,L,K) - ISTF(JJ,L,K) + 1 ORH1F405.252
SEG_CNT_T = SEG_CNT_T + 1 ORH1F405.253
WORK_PE_T(SEG_CNT_T) = IPROC ORH1F405.254
WORK_K_T(SEG_CNT_T) = K ORH1F405.255
WORK_SEG_T(SEG_CNT_T) = L ORH1F405.256
WORK_SIZE_T(SEG_CNT_T) = SEG_LEN ORH1F405.257
ENDIF ORH1F405.258
ENDDO ! Over L ORH1F405.259
ORH1F405.260
ENDDO ! Over K ORH1F405.261
ORH1F405.262
ENDIF ORH1F405.263
ORH1F405.264
ENDIF ! If J <= JY ORH1F405.265
ORH1F405.266
ENDDO ! Over IPROC ORH1F405.267
ORH1F405.268
! We now have a list of all the U/V and T segments which ORH1F405.269
! will need filtering (on this JIND), together which ORH1F405.270
! which PE and level they belong to plus the amount of ORH1F405.271
! filtering work involved for eack segment. ORH1F405.272
! All we have to do now is assign each segment to ORH1F405.273
! the most suitable PE in order to acheive the best ORH1F405.274
! possible load balance... piece of cake! ORH1F405.275
ORH1F405.276
FIRST_PE = 0 ORH1F405.277
LAST_PE = O_NPROC - 1 ORH1F405.278
ORH1F405.279
1120 CONTINUE ORH1F405.280
ORH1F405.281
! For each PE ORH1F405.282
DO PE = FIRST_PE,LAST_PE ORH1F405.283
ORH1F405.284
MAX_WORK = 0 ORH1F405.285
TOT_WORK_LEFT = 0 ORH1F405.286
U_OR_T = 0 ORH1F405.287
ORH1F405.288
! For each U/V segment ORH1F405.289
DO L = 1, SEG_CNT_U ORH1F405.290
ORH1F405.291
! If this segment is still available ORH1F405.292
IF (WORK_SIZE_U(L).GT.0) THEN ORH1F405.293
ORH1F405.294
! Keep track of how much more work there is ORH1F405.295
! to be assigned. ORH1F405.296
TOT_WORK_LEFT = TOT_WORK_LEFT + 1 ORH1F405.297
ORH1F405.298
! If this lump of work is bigger than the one ORH1F405.299
! we currently think is the biggest, then save ORH1F405.300
! its details. ORH1F405.301
IF (WORK_SIZE_U(L).GT.MAX_WORK) THEN ORH1F405.302
MAX_WORK = WORK_SIZE_U(L) ORH1F405.303
MAX_IPROC = WORK_PE_U(L) ORH1F405.304
MAX_K = WORK_K_U(L) ORH1F405.305
MAX_SEG = WORK_SEG_U(L) ORH1F405.306
U_OR_T = 1 ORH1F405.307
SAVE_L = L ORH1F405.308
ENDIF ORH1F405.309
ENDIF ORH1F405.310
ENDDO ! Over L ORH1F405.311
ORH1F405.312
DO L = 1, SEG_CNT_T ORH1F405.313
ORH1F405.314
IF (WORK_SIZE_T(L).GT.0) THEN ORH1F405.315
ORH1F405.316
! Keep track of how much more work there is ORH1F405.317
! to be assigned. ORH1F405.318
TOT_WORK_LEFT = TOT_WORK_LEFT + 1 ORH1F405.319
ORH1F405.320
! If this lump of work is bigger than the one ORH1F405.321
! we currently think is the biggest, then save ORH1F405.322
! its details. ORH1F405.323
IF (WORK_SIZE_T(L).GT.MAX_WORK) THEN ORH1F405.324
MAX_WORK = WORK_SIZE_T(L) ORH1F405.325
MAX_IPROC = WORK_PE_T(L) ORH1F405.326
MAX_K = WORK_K_T(L) ORH1F405.327
MAX_SEG = WORK_SEG_T(L) ORH1F405.328
U_OR_T = 3 ORH1F405.329
SAVE_L = L ORH1F405.330
ENDIF ORH1F405.331
ENDIF ORH1F405.332
ORH1F405.333
ENDDO ! Over L ORH1F405.334
ORH1F405.335
! If we identified some work to do. ORH1F405.336
IF (MAX_WORK.GT.0) THEN ORH1F405.337
ORH1F405.338
! Was it U/V work? ORH1F405.339
IF (U_OR_T.EQ.1) THEN ORH1F405.340
ORH1F405.341
! Do I own it? Add 1 to my slave count. ORH1F405.342
IF (MAX_IPROC.EQ.O_MYPE) THEN ORH1F405.343
SLAV_CNT_U(JIND) = SLAV_CNT_U(JIND) + 1 ORH1F405.344
ENDIF ORH1F405.345
ORH1F405.346
! Have I been assigned to do this work ORH1F405.347
! .... who's my new master, what's the level ORH1F405.348
! and which segment is it? ORH1F405.349
IF (PE.EQ.O_MYPE) THEN ORH1F405.350
MAST_CNT_U(JIND) = MAST_CNT_U(JIND) + 1 ORH1F405.351
MAST_PE_U(MAST_CNT_U(JIND),JIND) = MAX_IPROC ORH1F405.352
MAST_K_U(MAST_CNT_U(JIND),JIND) = MAX_K ORH1F405.353
MAST_SEG_U(MAST_CNT_U(JIND),JIND) = MAX_SEG ORH1F405.354
ENDIF ORH1F405.355
ORH1F405.356
! Set size of work element to zero to avoid extra ORH1F405.357
! work next time round the loop. ORH1F405.358
WORK_SIZE_U(SAVE_L) = 0 ORH1F405.359
ORH1F405.360
ENDIF ! U_OR_T = 1 ORH1F405.361
ORH1F405.362
! Was it T work? ORH1F405.363
IF (U_OR_T.EQ.3) THEN ORH1F405.364
ORH1F405.365
! Do I own it? Add 1 to my slave count. ORH1F405.366
IF (MAX_IPROC.EQ.O_MYPE) THEN ORH1F405.367
SLAV_CNT_T(JIND) = SLAV_CNT_T(JIND) + 1 ORH1F405.368
ENDIF ORH1F405.369
ORH1F405.370
! Have I been assigned to do this work ORH1F405.371
! .... who's my new master, what's the level ORH1F405.372
! on and which segment is it? ORH1F405.373
IF (PE.EQ.O_MYPE) THEN ORH1F405.374
MAST_CNT_T(JIND) = MAST_CNT_T(JIND) + 1 ORH1F405.375
MAST_PE_T(MAST_CNT_T(JIND),JIND) = MAX_IPROC ORH1F405.376
MAST_K_T(MAST_CNT_T(JIND),JIND) = MAX_K ORH1F405.377
MAST_SEG_T(MAST_CNT_T(JIND),JIND) = MAX_SEG ORH1F405.378
ENDIF ORH1F405.379
ORH1F405.380
! Set size of work element to zero to avoid extra ORH1F405.381
! work next time round the loop. ORH1F405.382
WORK_SIZE_T(SAVE_L) = 0 ORH1F405.383
ORH1F405.384
ENDIF ! U_OR_T = 3 ORH1F405.385
ORH1F405.386
! If its on level 1, this segment gets filtered ORH1F405.387
! by the free surface code too - which PE does it ORH1F405.388
IF (MAX_K.EQ.1.AND.L_OFREESFC) THEN ORH1F405.389
ORH1F405.390
3000 CONTINUE ORH1F405.391
ORH1F405.392
PE_MIN = 0 ORH1F405.393
ORH1F405.394
DO PE_F = 0, O_NPROC - 1 ORH1F405.395
IF (WORKLOAD_F(PE_F).LT. ORH1F405.396
& WORKLOAD_F(PE_MIN)) THEN ORH1F405.397
PE_MIN = PE_F ORH1F405.398
ENDIF ORH1F405.399
ENDDO ORH1F405.400
ORH1F405.401
! Do I own it? Add 1 to my slave count. ORH1F405.402
IF (MAX_IPROC.EQ.O_MYPE) THEN ORH1F405.403
SLAV_CNT_F = SLAV_CNT_F + 1 ORH1F405.404
ENDIF ORH1F405.405
ORH1F405.406
! Have I been assigned to do this work ORH1F405.407
! .... who's my new master, what's the row ORH1F405.408
! and which segment is it? ORH1F405.409
IF (PE_MIN.EQ.O_MYPE) THEN ORH1F405.410
MAST_CNT_F = MAST_CNT_F + 1 ORH1F405.411
MAST_PE_F(MAST_CNT_F) = MAX_IPROC ORH1F405.412
MAST_ROW_F(MAST_CNT_F) = JIND ORH1F405.413
MAST_SEG_F(MAST_CNT_F) = ORH1F405.414
* MAX_SEG + (LSEGF*(U_OR_T-1)) ORH1F405.415
ORH1F405.416
ENDIF ORH1F405.417
ORH1F405.418
ORH1F405.419
WORKLOAD_F(PE_MIN) = WORKLOAD_F(PE_MIN) + ORH1F405.420
& MAX_WORK ORH1F405.421
ORH1F405.422
! to consider. ORH1F405.423
IF (U_OR_T.EQ.1) THEN ORH1F405.424
U_OR_T = 2 ORH1F405.425
GOTO 3000 ORH1F405.426
ENDIF ORH1F405.427
ORH1F405.428
ENDIF ORH1F405.429
! Add this work to PEs total work load ORH1F405.430
WORKLOAD(PE) = WORKLOAD(PE) + MAX_WORK ORH1F405.431
ORH1F405.432
! Subtract 1 from the total no of work chunks ORH1F405.433
TOT_WORK_LEFT = TOT_WORK_LEFT - 1 ORH1F405.434
ORH1F405.435
ENDIF ! MAX_WORK > 0 ORH1F405.436
ORH1F405.437
ENDDO ! Over PE ORH1F405.438
ORH1F405.439
! Is there any more work to be assigned? ORH1F405.440
IF (TOT_WORK_LEFT.GT.0) THEN ORH1F405.441
! Which PE has the least amount of work? ORH1F405.442
FIRST_PE = 0 ORH1F405.443
ORH1F405.444
DO PE = 0, O_NPROC - 1 ORH1F405.445
ORH1F405.446
IF (WORKLOAD(PE).LT.WORKLOAD(FIRST_PE)) THEN ORH1F405.447
FIRST_PE = PE ORH1F405.448
ENDIF ORH1F405.449
ORH1F405.450
ENDDO ORH1F405.451
ORH1F405.452
! Set ending PE loop index to start value so that only ORH1F405.453
! 1 PE is actually dealt with. ORH1F405.454
LAST_PE = FIRST_PE ORH1F405.455
ORH1F405.456
GOTO 1120 ! Sorry.. I cant figure out how to avoid this ORH1F405.457
! while keeping the code reasonably readable! ORH1F405.458
ENDIF ! More work to do ORH1F405.459
ORH1F405.460
ENDDO ! Over JIND ORH1F405.461
ORH1F405.462
DECMFLTR.78
DECMFLTR.185
DECMFLTR.186
RETURN DECMFLTR.187
END DECMFLTR.188
*ENDIF DECMFLTR.189