      PROGRAM unstruc_loop
      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), cc (273), 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
      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_mesh (end_pts, myvals, x, y, z, 3136, 545, filen)
C     CONSTRUCT G (545, GEOMETRY (3, x, y, z))
C     SET distfmt BY PARTITIONING G USING RCB
      CALL PARALLEL_BINARY_DISSECTION (3, 545, 3, x, y, z, TT1temp)
      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 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
      econs = 1.0
      DO 7000 j = 1, 100
      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
