      PROGRAM loops
      INTEGER nedge, nnode
      PARAMETER (nedge = 3136, nnode = 545)
      INTEGER end_pts (1569, 2)
      DOUBLE PRECISION flux (273), econs
      DOUBLE PRECISION w (273, 4), p (273)
      DOUBLE PRECISION cc (273)
      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
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 (680)
      INTEGER TT3temp (4704)
      INTEGER TT4temp
      INTEGER TT5temp
      INTEGER TT6temp
      INTEGER TT7temp (3)
      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
      INTEGER TT27temp
      INTEGER TT28temp
      INTEGER TT29temp (3136)
      INTEGER TT30temp
      INTEGER TT31temp (3136)
      INTEGER TT32temp (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_mesh (end_pts, myvals, x, y, z, 3136, 545, filen)
C     CONSTRUCT G (545,, LINK (3136, end_pts (1, 1) end_pts (1, 2)))
      TT1temp = INIT_RDG_HASH_TABLE (3138)
      CALL PARTI_ELIMINATE_DUP_EDGES (TT1temp, end_pts (1, 1), end_pts (
     &1, 2), 3, 3136)
C     SET distfmt BY PARTITIONING G USING RSB
      CALL PARTI_GENERATE_RDG (TT1temp, 3, 545, TT2temp, TT3temp, TT4tem
     &p)
      CALL PARTI_PARALLEL_RSB (3, 545, TT2temp, TT3temp, TT4temp, TT1tem
     &p)
      CALL PC_mark_distribution (3, 545)
C     REDISTRIBUTE reg (distfmt)
      CALL PARTI_remap (TT1temp, TT6temp, 3, 545, TT5temp)
      CALL PC_gtable_entry (8, 545, TT5temp)
      CALL DGATHER (w (1, 1), w (1, 1), TT6temp)
      CALL DGATHER (w (1, 2), w (1, 2), TT6temp)
      CALL DGATHER (w (1, 3), w (1, 3), TT6temp)
      CALL DGATHER (w (1, 4), w (1, 4), TT6temp)
      CALL DGATHER (flux (1), flux (1), TT6temp)
      CALL DGATHER (cc (1), cc (1), TT6temp)
      CALL DGATHER (p (1), p (1), TT6temp)
      CALL DGATHER (z (1), z (1), TT6temp)
      CALL DGATHER (y (1), y (1), TT6temp)
      CALL DGATHER (x (1), x (1), TT6temp)
      econs = 1.0
      CALL PC_find_loop_bound (8, 545, TT8temp)
      CALL PC_mark_distribution (8, 545)
      DO i = 1, TT8temp
      flux (i) = 0.0
      END DO
      CALL PC_find_loop_bound (8, 545, TT9temp)
      CALL PC_mark_distribution (8, 545)
      CALL adjust_local_bounds (1, TT9temp, Tllb1, Tlub1, 1, 273)
      TT10temp = 1
      DO i = Tllb1, Tlub1
      w (i, 1) = 1.0
      END DO
      CALL PC_find_loop_bound (8, 545, TT11temp)
      CALL PC_mark_distribution (8, 545)
      CALL adjust_local_bounds (1, TT11temp, Tllb1, Tlub1, 1, 273)
      TT12temp = 1
      DO i = Tllb1, Tlub1
      w (i, 2) = 1.0
      END DO
      CALL PC_find_loop_bound (8, 545, TT13temp)
      CALL PC_mark_distribution (8, 545)
      CALL adjust_local_bounds (1, TT13temp, Tllb1, Tlub1, 1, 273)
      TT14temp = 1
      DO i = Tllb1, Tlub1
      w (i, 3) = 1.0
      END DO
      CALL PC_find_loop_bound (8, 545, TT15temp)
      CALL PC_mark_distribution (8, 545)
      CALL adjust_local_bounds (1, TT15temp, Tllb1, Tlub1, 1, 273)
      TT16temp = 1
      DO i = Tllb1, Tlub1
      w (i, 4) = 1.0
      END DO
      CALL PC_find_loop_bound (8, 545, TT17temp)
      CALL PC_mark_distribution (8, 545)
      DO i = 1, TT17temp
      cc (i) = 1.0
      END DO
      CALL PC_find_loop_bound (8, 545, TT18temp)
      CALL PC_mark_distribution (8, 545)
      DO i = 1, TT18temp
      p (i) = 1.0
      END DO
      DO 7000 j = 1, 5
      TT19temp = 3136
      CALL PC_register_loop (1, 8, 545, 0)
      CALL PC_register_loop (-1, 3, 3136, 1)
      CALL PC_get_loop_attr (1, TT20temp, TT21temp, TT22temp, TT23temp, 
     &TT24temp, TT26temp)
      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, TT28temp)
      TT30temp = 1
      DO i = 1, TT28temp, 1
      TT29temp (TT30temp) = end_pts (i, 1)
      TT30temp = TT30temp + 1
      TT29temp (TT30temp) = end_pts (i, 2)
      TT30temp = TT30temp + 1

      END DO
      
      TT30temp = TT30temp - 1
      CALL PARTI_iter_part (TT24temp, 3, 3136, TT29temp, TT30temp, 2, TT
     &21temp, TT27temp)
      CALL IGATHER (TT29temp, end_pts (1, 1), TT27temp)
      CALL IGATHER (TT31temp, end_pts (1, 2), TT27temp)
      CALL PARTI_free_sched (TT27temp)
      TT30temp = 1
      DO i = 1, TT21temp, 1
      TT32temp (TT30temp) = TT29temp (i)
      TT30temp = TT30temp + 1
      TT32temp (TT30temp) = TT31temp (i)
      TT30temp = TT30temp + 1

      END DO
      
      TT30temp = TT30temp - 1
      CALL PARTI_localize (TT24temp, TT20temp, TT32temp, mem (TT23temp +
     & 1), TT30temp, TT22temp, TT26temp, 1)
      CALL PC_store_loop_attr (1, TT20temp, TT21temp, TT22temp, TT30temp
     &, TT24temp, TT26temp)
      END IF
      DO i = 1, TT22temp, 1
      flux (TT26temp + i) = 0

      END DO
      
      CALL DGATHER (w (TT26temp + 1, 2), w (1, 2), TT20temp)
      CALL DGATHER (w (TT26temp + 1, 3), w (1, 3), TT20temp)
      CALL DGATHER (w (TT26temp + 1, 4), w (1, 4), TT20temp)
      CALL DGATHER (w (TT26temp + 1, 1), w (1, 1), TT20temp)
      CALL DGATHER (cc (TT26temp + 1), cc (1), TT20temp)
      DO i = 1, TT21temp, 1
      flux (mem (i + TT23temp)) = flux (mem (i + TT23temp)) + ((econs * 
     &w (mem (i + TT23temp), 2) + econs * w (mem (i + TT23temp), 3) + ec
     &ons * w (mem (i + TT23temp), 4)) / w (mem (i + TT23temp), 1) + (ec
     &ons * w (mem (TT21temp + i + TT23temp), 2) + econs * w (mem (TT21t
     &emp + i + TT23temp), 3) + econs * w (mem (TT21temp + i + TT23temp)
     &, 4)) / w (mem (TT21temp + i + TT23temp), 1)) / 2 + cc (mem (i + T
     &T23temp)) * econs
      flux (mem (TT21temp + i + TT23temp)) = flux (mem (TT21temp + i + T
     &T23temp)) + ((econs * w (mem (i + TT23temp), 2) + econs * w (mem (
     &i + TT23temp), 3) + econs * w (mem (i + TT23temp), 4)) / w (mem (i
     & + TT23temp), 1) + (econs * w (mem (TT21temp + i + TT23temp), 2) +
     & econs * w (mem (TT21temp + i + TT23temp), 3) + econs * w (mem (TT
     &21temp + i + TT23temp), 4)) / w (mem (TT21temp + i + TT23temp), 1)
     &) / 2 + cc (mem (TT21temp + i + TT23temp)) * econs

      END DO
      CALL DSCATTER_ADD (flux (TT26temp + 1), flux (1), TT20temp)
      
      
100   CONTINUE
7000  CONTINUE
      END
