amr_1blk_fc_prol_user.f90

做网格的好程序

        enddo

        endif


! save new interpolated solution

      if (curvilinear) then
! Generate cell volume data for the current child block
      call amr_block_geometry(lb,mype)

! Divide interpolated solution by the 2**ndim*volume of the child cells
      factor = .5**ndim
      endif

        do k=kcl,kcu
        do j=jcl,jcu
        do i=icl,icu+iface_off
        if (curvilinear) then
           facevarx1(ivar,i,j,k,idest)=temp(ivar,i,j,k) & 
     &                                *factor/cell_area1(i,j,k)
        else
           facevarx1(ivar,i,j,k,idest)=temp(ivar,i,j,k)
        endif

        enddo
        enddo
        enddo


        endif                              ! end of iface=1 



        if(iface.eq.2) then

      if (curvilinear) then
! Multiply parent solution by the area of the parent cells y face
      do k=kl_bnd1,ku_bnd1
      do j=jl_bnd1,ju_bnd1+k2d
      do i=il_bnd1,iu_bnd1
        recv(ivar,i,j,k) = recv(ivar,i,j,k)*cell_area2(i,j,k)
      enddo
      enddo
      enddo
      endif

!
! Perform sweep in y direction
        do k=klow,khi
        do i=ilow,ihi
           do j=jcl,jcu+iface_off
              j1  = prol_f_indexy(1,j,j_ind)
              j1p = prol_f_indexy(2,j,j_ind)
              dyy = prol_f_dy(j)
              cyy = 1.-dyy

! compute interpolated values at location (i,j,k)
                 temp(ivar,i,j,k) = & 
     &                          dyy*recv(ivar,i,j1,k) + & 
     &                          cyy*recv(ivar,i,j1p,k)
           enddo
        enddo
        enddo


        do k=klow,khi
        do j=jcl,jcu+iface_off
        do i=ilow,ihi
        recv1(ivar,i,j,k) = temp(ivar,i,j,k)
        enddo
        enddo
        enddo

!
! Perform sweep in x direction
        do k=klow,khi
        do j=jcl,jcu+iface_off
        do i=icl,icu
           ii = (i-nguard-1+largei)/2+nguard+1+ioff-largei/2
              gradl = (recv1(ivar,ii,j,k)-recv1(ivar,ii-1,j,k)) & 
     &                                         *dxpr
              gradr = (recv1(ivar,ii+1,j,k)-recv1(ivar,ii,j,k)) & 
     &                                         *dxpr
              gradc = (recv1(ivar,ii+1,j,k)-recv1(ivar,ii-1,j,k)) & 
     &                                         *dxpr*.5
              ss = sign(1.,gradc)
              gradm = ss*max(0.,min(abs(gradc),2.*gradr*ss, & 
     &                                       2.*gradl*ss))
              is = mod(i-nguard-1+largei,2)
              sdx = real(2*is-1)*.5
              temp(ivar,i,j,k) = recv1(ivar,ii,j,k)+gradm*sdx
        enddo
        enddo
        enddo


! Perform sweep in z direction
        if(ndim.eq.3) then

        do k=klow,khi
        do j=jcl,jcu+iface_off
        do i=icl,icu
        recv1(ivar,i,j,k) = temp(ivar,i,j,k)
        enddo
        enddo
        enddo

        do j=jcl,jcu+iface_off
        do i=icl,icu
        do k=kcl,kcu
           kk = (k-nguard-1+largei)/2+nguard+1+koff-largei/2
              gradl = (recv1(ivar,i,j,kk)-recv1(ivar,i,j,kk-k3d)) & 
     &                                         *dzpr
              gradr = (recv1(ivar,i,j,kk+k3d)-recv1(ivar,i,j,kk)) & 
     &                                         *dzpr
              gradc = (recv1(ivar,i,j,kk+k3d)-recv1(ivar,i,j,kk-k3d)) & 
     &                                         *dzpr*.5
              ss = sign(1.,gradc)
              gradm = ss*max(0.,min(abs(gradc),2.*gradr*ss, & 
     &                                       2.*gradl*ss))
              is = mod(k-nguard-1+largei,2)
              sdz = real(2*is-1)*.5
              temp(ivar,i,j,k) = recv1(ivar,i,j,kk)+gradm*sdz
        enddo
        enddo
        enddo

        endif

! save new interpolated solution

      if (curvilinear) then
! Generate cell volume data for the current child block
      call amr_block_geometry(lb,mype)

! Divide interpolated solution by the 2**ndim*volume of the child cells
      factor = .5**ndim
      endif

        do k=kcl,kcu
        do j=jcl,jcu+iface_off
        do i=icl,icu
        if (curvilinear) then
           facevary1(ivar,i,j,k,idest)=temp(ivar,i,j,k) & 
     &                                *factor/cell_area2(i,j,k)
        else
           facevary1(ivar,i,j,k,idest)=temp(ivar,i,j,k)
        endif
        enddo
        enddo
        enddo


        endif                              ! end of iface=2 



        if(iface.eq.3) then

      if (curvilinear) then
! Multiply parent solution by the area of the parent cells y face
      do k=kl_bnd1,ku_bnd1+k3d
      do j=jl_bnd1,ju_bnd1
      do i=il_bnd1,iu_bnd1
        recv(ivar,i,j,k) = recv(ivar,i,j,k)*cell_area3(i,j,k)
      enddo
      enddo
      enddo
      endif
!
! Perform sweep in z direction
        do j=jlow,jhi
        do i=ilow,ihi
           do k=kcl,kcu+iface_off
              k1  = prol_f_indexz(1,k,k_ind)
              k1p = prol_f_indexz(2,k,k_ind)
              dzz = prol_f_dz(k)
              czz = 1.-dzz

! compute interpolated values at location (i,j,k)
                 temp(ivar,i,j,k) = & 
     &                          dzz*recv(ivar,i,j,k1) + & 
     &                          czz*recv(ivar,i,j,k1p)
           enddo
        enddo
        enddo

!
! Perform sweep in x direction
        do k=kcl,kcu+iface_off
        do j=jlow,jhi
        do i=ilow,ihi
        recv1(ivar,i,j,k) = temp(ivar,i,j,k)
        enddo
        enddo
        enddo

        do k=kcl,kcu+iface_off
        do j=jlow,jhi
        do i=icl,icu
           ii = (i-nguard-1+largei)/2+nguard+1+ioff-largei/2
              gradl = (recv1(ivar,ii,j,k)-recv1(ivar,ii-1,j,k)) & 
     &                                         *dxpr
              gradr = (recv1(ivar,ii+1,j,k)-recv1(ivar,ii,j,k)) & 
     &                                         *dxpr
              gradc = (recv1(ivar,ii+1,j,k)-recv1(ivar,ii-1,j,k)) & 
     &                                         *dxpr*.5
              ss = sign(1.,gradc)
              gradm = ss*max(0.,min(abs(gradc),2.*gradr*ss, & 
     &                                       2.*gradl*ss))
              is = mod(i-nguard-1+largei,2)
              sdx = real(2*is-1)*.5
              temp(ivar,i,j,k) = recv1(ivar,ii,j,k)+gradm*sdx
        enddo
        enddo
        enddo

!
! Perform sweep in y direction
        do k=kcl,kcu+iface_off
        do j=jlow,jhi
        do i=icl,icu
        recv1(ivar,i,j,k) = temp(ivar,i,j,k)
        enddo
        enddo
        enddo

        do k=kcl,kcu+iface_off
        do i=icl,icu
        do j=jcl,jcu
           jj = (j-nguard-1+largei)/2+nguard+1+joff-largei/2
              gradl = (recv1(ivar,i,jj,k)-recv1(ivar,i,jj-k2d,k)) & 
     &                                         *dypr
              gradr = (recv1(ivar,i,jj+k2d,k)-recv1(ivar,i,jj,k)) & 
     &                                         *dypr
              gradc = (recv1(ivar,i,jj+k2d,k)-recv1(ivar,i,jj-k2d,k)) & 
     &                                         *dypr*.5
              ss = sign(1.,gradc)
              gradm = ss*max(0.,min(abs(gradc),2.*gradr*ss, & 
     &                                       2.*gradl*ss))
              is = mod(j-nguard-1+largei,2)
              sdy = real(2*is-1)*.5
              temp(ivar,i,j,k) = recv1(ivar,i,jj,k)+gradm*sdy
        enddo
        enddo
        enddo

! save new interpolated solution

      if (curvilinear) then
! Generate cell volume data for the current child block
      call amr_block_geometry(lb,mype)

! Divide interpolated solution by the 2**ndim*volume of the child cells
      factor = .5**ndim

      endif


        do k=kcl,kcu+iface_off
        do j=jcl,jcu
        do i=icl,icu
        if (curvilinear) then
           facevarz1(ivar,i,j,k,idest)=temp(ivar,i,j,k) & 
     &                                *factor/cell_area3(i,j,k)
        else
           facevarz1(ivar,i,j,k,idest)=temp(ivar,i,j,k)
        endif   
        enddo
        enddo
        enddo


        endif                              ! end of iface=3 


      return
      end subroutine amr_1blk_fc_prol_user