PROGRAM loops INTEGER nedge, nnode PARAMETER (nedge = 3136, nnode = 545) INTEGER end_pts (1569, 2) INTEGER wt (273) DOUBLE PRECISION flux (273), econs DOUBLE PRECISION w (273, 4), p (273) DOUBLE PRECISION cc (273) DOUBLE PRECISION ftemp, flux_sum DOUBLE PRECISION x (273), y (273), z (273) INTEGER i, j CHARACTER * 80 filen C DIRPROCESSORS p (4) C DECOMPOSITION reg (545), reg2 (3136) C DISTRIBUTE reg (MBLOCK), reg2 (MBLOCK) C ALIGN (:, *) WITH reg2 : : end_pts C ALIGN (:, *) WITH reg : : w C ALIGN (:) WITH reg : : p, cc, flux, wt C ALIGN (:) WITH reg : : x, y, z INTEGER Tllb1 INTEGER Tlub1 INTEGER minLoc1, maxLoc1, minLoc2, maxLoc2, minLoc3, maxLoc3, coor &d(3) COMMON /g_to_l/minLoc1, maxLoc1, minLoc2, maxLoc2, minLoc3, maxLoc &3, coord INTEGER mem(100000) COMMON /lattr/mem INTEGER proclist(8) INTEGER TT0temp (3) INTEGER TT1temp INTEGER TT2temp INTEGER TT3temp INTEGER TT4temp (3) INTEGER TT5temp INTEGER TT6temp INTEGER TT7temp INTEGER TT8temp INTEGER TT9temp INTEGER TT10temp INTEGER TT11temp INTEGER TT12temp INTEGER TT13temp INTEGER TT14temp INTEGER TT15temp INTEGER TT16temp INTEGER TT17temp INTEGER TT18temp INTEGER TT19temp INTEGER TT20temp INTEGER TT21temp INTEGER TT22temp INTEGER TT23temp INTEGER TT24temp INTEGER TT25temp INTEGER TT26temp (3136) INTEGER TT27temp INTEGER TT28temp (3136) INTEGER TT29temp (3136) CALL PC_ssinit() CALL PARTI_reg_translation_table(3, 3136, itab0) CALL PC_gtable_entry(3, 3136, itab0) CALL PARTI_reg_translation_table(3, 545, itab1) CALL PC_gtable_entry(3, 545, itab1) CALL NICE_init() proclist(1)=-1 filen = 'm6.545.part' CALL read_mesh2 (end_pts, myvals, x, y, z, 3136, 545, filen, wt) C CONSTRUCT G (545,, GEOMETRY (3, x, y, z) LOAD (wt)) C SET distfmt BY PARTITIONING G USING WIBS CALL PAR_WEIGHTED_INERTIAL_BISECTION (3, 545, wt, 3, x, y, z, TT1t &emp) CALL PC_mark_distribution (3, 545) C REDISTRIBUTE reg (distfmt) CALL PARTI_remap (TT1temp, TT3temp, 3, 545, TT2temp) CALL PC_gtable_entry (8, 545, TT2temp) CALL DGATHER (w (1, 1), w (1, 1), TT3temp) CALL DGATHER (w (1, 2), w (1, 2), TT3temp) CALL DGATHER (w (1, 3), w (1, 3), TT3temp) CALL DGATHER (w (1, 4), w (1, 4), TT3temp) CALL IGATHER (wt (1), wt (1), TT3temp) CALL DGATHER (flux (1), flux (1), TT3temp) CALL DGATHER (cc (1), cc (1), TT3temp) CALL DGATHER (p (1), p (1), TT3temp) CALL DGATHER (z (1), z (1), TT3temp) CALL DGATHER (y (1), y (1), TT3temp) CALL DGATHER (x (1), x (1), TT3temp) CALL PC_find_loop_bound (8, 545, TT5temp) CALL PC_mark_distribution (8, 545) DO i = 1, TT5temp flux (i) = 0.0 END DO CALL PC_find_loop_bound (8, 545, TT6temp) CALL PC_mark_distribution (8, 545) CALL adjust_local_bounds (1, TT6temp, Tllb1, Tlub1, 1, 273) TT7temp = 1 DO i = Tllb1, Tlub1 w (i, 1) = 1.0 END DO CALL PC_find_loop_bound (8, 545, TT8temp) CALL PC_mark_distribution (8, 545) CALL adjust_local_bounds (1, TT8temp, Tllb1, Tlub1, 1, 273) TT9temp = 1 DO i = Tllb1, Tlub1 w (i, 2) = 1.0 END DO CALL PC_find_loop_bound (8, 545, TT10temp) CALL PC_mark_distribution (8, 545) CALL adjust_local_bounds (1, TT10temp, Tllb1, Tlub1, 1, 273) TT11temp = 1 DO i = Tllb1, Tlub1 w (i, 3) = 1.0 END DO CALL PC_find_loop_bound (8, 545, TT12temp) CALL PC_mark_distribution (8, 545) CALL adjust_local_bounds (1, TT12temp, Tllb1, Tlub1, 1, 273) TT13temp = 1 DO i = Tllb1, Tlub1 w (i, 4) = 1.0 END DO CALL PC_find_loop_bound (8, 545, TT14temp) CALL PC_mark_distribution (8, 545) DO i = 1, TT14temp cc (i) = 1.0 END DO CALL PC_find_loop_bound (8, 545, TT15temp) CALL PC_mark_distribution (8, 545) DO i = 1, TT15temp p (i) = 1.0 END DO DO 7000 j = 1, 5 econs = 1.0 TT16temp = 3136 CALL PC_register_loop (1, 8, 545, 0) CALL PC_register_loop (-1, 3, 3136, 1) CALL PC_get_loop_attr (1, TT17temp, TT18temp, TT19temp, TT20temp, &TT21temp, TT23temp) CALL PC_inspector_check (1, is_Insp_needed) CALL PC_mark_distribution (8, 545) IF (is_Insp_needed) THEN CALL PC_find_loop_bound (3, 3136, TT25temp) TT27temp = 1 DO i = 1, TT25temp, 1 TT26temp (TT27temp) = end_pts (i, 1) TT27temp = TT27temp + 1 TT26temp (TT27temp) = end_pts (i, 2) TT27temp = TT27temp + 1 END DO TT27temp = TT27temp - 1 CALL PARTI_iter_part (TT21temp, 3, 3136, TT26temp, TT27temp, 2, TT &18temp, TT24temp) CALL IGATHER (TT26temp, end_pts (1, 1), TT24temp) CALL IGATHER (TT28temp, end_pts (1, 2), TT24temp) CALL PARTI_free_sched (TT24temp) TT27temp = 1 DO i = 1, TT18temp, 1 TT29temp (TT27temp) = TT26temp (i) TT27temp = TT27temp + 1 TT29temp (TT27temp) = TT28temp (i) TT27temp = TT27temp + 1 END DO TT27temp = TT27temp - 1 CALL PARTI_localize (TT21temp, TT17temp, TT29temp, mem (TT20temp + & 1), TT27temp, TT19temp, TT23temp, 1) CALL PC_store_loop_attr (1, TT17temp, TT18temp, TT19temp, TT27temp &, TT21temp, TT23temp) END IF DO i = 1, TT19temp, 1 flux (TT23temp + i) = 0 END DO CALL DGATHER (w (TT23temp + 1, 2), w (1, 2), TT17temp) CALL DGATHER (w (TT23temp + 1, 3), w (1, 3), TT17temp) CALL DGATHER (w (TT23temp + 1, 4), w (1, 4), TT17temp) CALL DGATHER (w (TT23temp + 1, 1), w (1, 1), TT17temp) CALL DGATHER (cc (TT23temp + 1), cc (1), TT17temp) DO i = 1, TT18temp, 1 flux (mem (i + TT20temp)) = flux (mem (i + TT20temp)) + ((econs * &w (mem (i + TT20temp), 2) + econs * w (mem (i + TT20temp), 3) + ec &ons * w (mem (i + TT20temp), 4)) / w (mem (i + TT20temp), 1) + (ec &ons * w (mem (TT18temp + i + TT20temp), 2) + econs * w (mem (TT18t &emp + i + TT20temp), 3) + econs * w (mem (TT18temp + i + TT20temp) &, 4)) / w (mem (TT18temp + i + TT20temp), 1)) / 2 + cc (mem (i + T &T20temp)) * econs flux (mem (TT18temp + i + TT20temp)) = flux (mem (TT18temp + i + T &T20temp)) + ((econs * w (mem (i + TT20temp), 2) + econs * w (mem ( &i + TT20temp), 3) + econs * w (mem (i + TT20temp), 4)) / w (mem (i & + TT20temp), 1) + (econs * w (mem (TT18temp + i + TT20temp), 2) + & econs * w (mem (TT18temp + i + TT20temp), 3) + econs * w (mem (TT &18temp + i + TT20temp), 4)) / w (mem (TT18temp + i + TT20temp), 1) &) / 2 + cc (mem (TT18temp + i + TT20temp)) * econs END DO CALL DSCATTER_ADD (flux (TT23temp + 1), flux (1), TT17temp) 100 CONTINUE 7000 CONTINUE END