Optimize prolong3: precompute coarse index/parity maps

AMSS_NCKU_source/prolongrestrict_cell.f90

@@ -1937,6 +1937,12 @@
   integer :: i,j,k,ii,jj,kk
   real*8, dimension(6,6) :: tmp2
   real*8, dimension(6) :: tmp1
+  integer, dimension(extf(1)) :: cix
+  integer, dimension(extf(2)) :: ciy
+  integer, dimension(extf(3)) :: ciz
+  logical, dimension(extf(1)) :: evenx
+  logical, dimension(extf(2)) :: eveny
+  logical, dimension(extf(3)) :: evenz
 
   real*8, parameter :: C1=7.7d1/8.192d3,C2=-6.93d2/8.192d3,C3=3.465d3/4.096d3
   real*8, parameter :: C6=6.3d1/8.192d3,C5=-4.95d2/8.192d3,C4=1.155d3/4.096d3
@@ -2020,26 +2026,33 @@
           return
   endif
 
+  do i = imino,imaxo
+     ii = i + lbf(1) - 1
+     cix(i) = ii/2 - lbc(1) + 1
+     evenx(i) = (ii/2*2 == ii)
+  enddo
+  do j = jmino,jmaxo
+     jj = j + lbf(2) - 1
+     ciy(j) = jj/2 - lbc(2) + 1
+     eveny(j) = (jj/2*2 == jj)
+  enddo
+  do k = kmino,kmaxo
+     kk = k + lbf(3) - 1
+     ciz(k) = kk/2 - lbc(3) + 1
+     evenz(k) = (kk/2*2 == kk)
+  enddo
+
   call symmetry_bd(3,extc,func,funcc,SoA)
      
 !~~~~~~> prolongation start...
   do k = kmino,kmaxo
    do j = jmino,jmaxo
     do i = imino,imaxo
-       cxI(1) = i
-       cxI(2) = j
-       cxI(3) = k
-! change to coarse level reference
-!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---| 
-!|=======x===============x===============x===============x=======|
-       cxI = (cxI+lbf-1)/2
-! change to array index      
-       cxI = cxI - lbc + 1
+       cxI(1) = cix(i)
+       cxI(2) = ciy(j)
+       cxI(3) = ciz(k)
 
        if(any(cxI+3 > extc)) write(*,*)"error in prolong"
-       ii=i+lbf(1)-1
-       jj=j+lbf(2)-1
-       kk=k+lbf(3)-1
 #if 0
        if(ii/2*2==ii)then
          if(jj/2*2==jj)then
@@ -2127,7 +2140,7 @@
          endif
        endif
 #else 
-       if(kk/2*2==kk)then
+       if(evenz(k))then
              tmp2= C1*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+&
                    C2*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+&
                    C3*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)  )+&
@@ -2143,13 +2156,13 @@
                    C1*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3)
        endif
 
-       if(jj/2*2==jj)then
+       if(eveny(j))then
              tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5*tmp2(:,5)+C6*tmp2(:,6)
        else
              tmp1= C6*tmp2(:,1)+C5*tmp2(:,2)+C4*tmp2(:,3)+C3*tmp2(:,4)+C2*tmp2(:,5)+C1*tmp2(:,6)
        endif
 
-       if(ii/2*2==ii)then
+       if(evenx(i))then
              funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5*tmp1(5)+C6*tmp1(6)
        else
              funf(i,j,k)= C6*tmp1(1)+C5*tmp1(2)+C4*tmp1(3)+C3*tmp1(4)+C2*tmp1(5)+C1*tmp1(6)