MODULE Generic_CaptureDC ! ---- over-writes the flux interplotion (fxi) elements ! ---- with those caluclated by WENO in locations where ! ---- dcflag is 1 INTERFACE CaptureDC MODULE PROCEDURE OneDCaptureDc MODULE PROCEDURE TwoDCaptureDc MODULE PROCEDURE ThreeDCaptureDc END INTERFACE CONTAINS SUBROUTINE OneDCaptureDc(ux,vx,fx,fxi,dcflag,direction,ifilter) ! ---- Shared Variables USE mesh USE array_bounds USE method_parms ! ---- Shared Procedures USE OneDweno USE Generic_EvalsAndETAX IMPLICIT NONE include 'cles.i' DOUBLE PRECISION, INTENT(IN) :: ux(ncomps,ixlo:ixhi) DOUBLE PRECISION, INTENT(IN) :: vx(nvars,ixlo:ixhi) DOUBLE PRECISION, INTENT(IN) :: fx(nvars,ixlo:ixhi) INTEGER, INTENT(IN) :: dcflag(1:nx+1,1) INTEGER, INTENT(IN) :: direction, ifilter DOUBLE PRECISION, INTENT(OUT) :: fxi(ncomps,ixlo:ixhi,1) ! ----- local eigen values and H-correction DOUBLE PRECISION, ALLOCATABLE :: locfxi(:,:) DOUBLE PRECISION, ALLOCATABLE :: lami(:,:,:) DOUBLE PRECISION, ALLOCATABLE :: eta(:) INTEGER :: i, iret ! nothing to do if ( use_dcflag .eq. CLES_TRUE .and. SUM(dcflag(:,direction) ) .eq. 0 ) return if ( use_carbfix .eq. 0 ) then ALLOCATE (lami(2,3,1), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'OneDCaptureDc/lami', iret) endif ALLOCATE (eta(1), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'OneDCaptureDc/eta', iret) endif endif whichdirection: SELECT CASE (direction) CASE (1) ALLOCATE (locfxi(ncomps,ixlo:ixhi), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'OneDCaptureDc/locfxi', iret) endif ! ---- the x-direction if ( use_carbfix .eq. 1 ) then ALLOCATE (lami(2,3,nx+1), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'OneDCaptureDc/lami', iret) endif ALLOCATE (eta(nx+1), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'OneDCaptureDc/eta', iret) endif do i=1,nx+1 CALL EvalsAndETAX(ux,vx,i-1,lami(:,:,i),eta(i)) enddo endif locfxi = fxi(:,:,direction) CALL FluxInterpWENO(locfxi, fx(1,ixlo), & ux(1,ixlo), vx(1,ixlo), lami, eta, & dcflag(1,direction), ixlo, ixhi, nx) if ( ifilter .eq. CLES_TRUE .and. method .eq. CLES_METHOD_HYBRID ) then do i=1, nx+1 if ( dcflag(i,direction) .eq. CLES_SWITCH_TCD ) then fxi(1:nvars,i,direction) = fxi(1:nvars,i,direction)*alpha_eta1 + locfxi(1:nvars,i)*alpha_eta2 else fxi(1:nvars,i,direction) = locfxi(1:nvars,i) endif enddo else fxi(1:nvars,1:nx+1,direction) = locfxi(1:nvars,1:nx+1) endif if ( use_carbfix .eq. 1 ) then DEALLOCATE (lami, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'OneDCaptureDc/lami', iret) endif DEALLOCATE (eta, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'OneDCaptureDc/eta', iret) endif DEALLOCATE(locfxi, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'OneDCaptureDc/locfxi', iret) endif endif END SELECT whichdirection if ( use_carbfix .eq. 0 ) then DEALLOCATE (lami, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'OneDCaptureDc/lami', iret) endif DEALLOCATE (eta, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'OneDCaptureDc/eta', iret) endif endif END SUBROUTINE OneDCaptureDc SUBROUTINE TwoDCaptureDc(ux,vx,fx,fxi,dcflag,direction,ifilter) ! ---- Shared Variables USE mesh USE array_bounds USE method_parms ! ---- Shared Procedures USE OneDweno USE Generic_EvalsAndETAX USE Generic_EvalsAndETAY IMPLICIT NONE include 'cles.i' DOUBLE PRECISION, INTENT(IN) :: ux(ncomps,ixlo:ixhi,iylo:iyhi) DOUBLE PRECISION, INTENT(IN) :: vx(nvars,ixlo:ixhi,iylo:iyhi) DOUBLE PRECISION, INTENT(IN) :: fx(nvars,ixlo:ixhi,iylo:iyhi) INTEGER, INTENT(IN) :: dcflag(1:nx+1,1:ny+1,2) INTEGER, INTENT(IN) :: direction, ifilter DOUBLE PRECISION, INTENT(OUT) :: fxi(ncomps,ixlo:ixhi,iylo:iyhi,2) ! ---- local copies of the data used in WENO ! ---- these are a fixed size: no problems with AMR DOUBLE PRECISION, ALLOCATABLE :: locfxi(:,:) DOUBLE PRECISION, ALLOCATABLE :: locfx(:,:) DOUBLE PRECISION, ALLOCATABLE :: locux(:,:) DOUBLE PRECISION, ALLOCATABLE :: locvx(:,:) INTEGER, ALLOCATABLE :: locdc(:) ! ----- local eigenvalues and H-correction DOUBLE PRECISION, ALLOCATABLE :: lami(:,:,:) DOUBLE PRECISION, ALLOCATABLE :: eta(:) DOUBLE PRECISION :: dtmp INTEGER :: i, j, iret ! nothing to do if ( use_dcflag .eq. CLES_TRUE .and. SUM(dcflag(:,:,direction) ) .eq. 0 ) return if ( use_carbfix .eq. 0 ) then ALLOCATE (lami(2,3,1), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'TwoDCaptureDc/lami', iret) endif ALLOCATE (eta(1), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'TwoDCaptureDc/eta', iret) endif endif whichdirection: SELECT CASE (direction) CASE (1) ALLOCATE (locfxi(ncomps,ixlo:ixhi), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'TwoDCaptureDc/locfxi', iret) endif ! ---- the x-direction if ( use_carbfix .eq. 1 ) then ALLOCATE (lami(2,3,nx+1), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'TwoDCaptureDc/lami', iret) endif ALLOCATE (eta(nx+1), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'TwoDCaptureDc/eta', iret) endif endif DO j=1,ny, 1 if ( use_carbfix .eq. 1 ) then do i=1,nx+1 CALL EvalsAndETAX(ux,vx,i-1,j,lami(:,:,i),eta(i)) enddo endif locfxi = fxi(:,:,j,direction) CALL FluxInterpWENO(locfxi, fx(1,ixlo,j), & ux(1,ixlo,j), vx(1,ixlo,j), lami, eta, & dcflag(1,j,direction), ixlo, ixhi, nx) if ( ifilter .eq. CLES_TRUE .and. method .eq. CLES_METHOD_HYBRID ) then do i=1, nx+1 if ( dcflag(i,j,direction) .eq. CLES_SWITCH_TCD ) then fxi(1:nvars,i,j,direction) = fxi(1:nvars,i,j,direction)*alpha_eta1 + locfxi(1:nvars,i)*alpha_eta2 else fxi(1:nvars,i,j,direction) = locfxi(1:nvars,i) endif enddo else fxi(1:nvars,1:nx+1,j,direction) = locfxi(1:nvars,1:nx+1) endif END DO if ( use_carbfix .eq. 1 ) then DEALLOCATE (lami, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'TwoDCaptureDc/lami', iret) endif DEALLOCATE (eta, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'TwoDCaptureDc/eta', iret) endif endif DEALLOCATE(locfxi, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'TwoDCaptureDc/locfxi', iret) endif CASE (2) ALLOCATE (locfxi(ncomps,iylo:iyhi), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'TwoDCaptureDc/locfxi', iret) endif ALLOCATE (locfx(nvars,iylo:iyhi), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'TwoDCaptureDc/locfx', iret) endif ALLOCATE (locux(ncomps,iylo:iyhi), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'TwoDCaptureDc/locux', iret) endif ALLOCATE (locvx(nvars,iylo:iyhi), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'TwoDCaptureDc/locvx', iret) endif ALLOCATE (locdc(1:ny+1), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'TwoDCaptureDc/locdc', iret) endif if ( use_carbfix .eq. 1 ) then ALLOCATE (lami(2,3,ny+1), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'TwoDCaptureDc/lami', iret) endif ALLOCATE (eta(ny+1), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'TwoDCaptureDc/eta', iret) endif endif ! ---- the y-direction DO i=1, nx, 1 if ( use_carbfix .eq. 1 ) then do j=1,ny+1 CALL EvalsAndETAY(ux,vx,i,j-1,lami(:,:,j),eta(j)) enddo endif locfxi(:,:) = fxi(:,i,:,direction) locfx(:,:) = fx(:,i,:) locux(:,:) = ux(:,i,:) locvx(:,:) = vx(:,i,:) locdc(:) = dcflag(i,:,direction) ! Swap u for v in fxi, fx, ux, vx do j=iylo, iyhi dtmp = locfxi(2,j) locfxi(2,j) = locfxi(3,j) locfxi(3,j) = dtmp enddo do j=iylo, iyhi dtmp = locfx(2,j) locfx(2,j) = locfx(3,j) locfx(3,j) = dtmp enddo do j=iylo, iyhi dtmp = locux(2,j) locux(2,j) = locux(3,j) locux(3,j) = dtmp enddo do j=iylo, iyhi dtmp = locvx(2,j) locvx(2,j) = locvx(3,j) locvx(3,j) = dtmp enddo ! ---- Do the WENO interpolation at this point CALL FluxInterpWENO(locfxi, locfx, locux, locvx, lami, eta, & locdc, iylo, iyhi, ny) do j=iylo, iyhi dtmp = locfxi(2,j) locfxi(2,j) = locfxi(3,j) locfxi(3,j) = dtmp enddo if ( ifilter .eq. CLES_TRUE .and. method .eq. CLES_METHOD_HYBRID ) then do j=1, ny+1 if ( locdc(j) .eq. CLES_SWITCH_TCD ) then fxi(1:nvars,i,j,direction) = fxi(1:nvars,i,j,direction)*alpha_eta1 + locfxi(1:nvars,j)*alpha_eta2 else fxi(1:nvars,i,j,direction) = locfxi(1:nvars,j) endif enddo else fxi(1:nvars,i,1:ny+1,direction) = locfxi(1:nvars,1:ny+1) endif ENDDO DEALLOCATE(locfxi, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'TwoDCaptureDc/locfxi', iret) endif DEALLOCATE(locfx, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'TwoDCaptureDc/locfx', iret) endif DEALLOCATE(locux, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'TwoDCaptureDc/locux', iret) endif DEALLOCATE(locvx, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'TwoDCaptureDc/locvx', iret) endif DEALLOCATE(locdc, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'TwoDCaptureDc/locdc', iret) endif if ( use_carbfix .eq. 1 ) then DEALLOCATE (lami, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'TwoDCaptureDc/lami', iret) endif DEALLOCATE (eta, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'TwoDCaptureDc/eta', iret) endif endif END SELECT whichdirection if ( use_carbfix .eq. 0 ) then DEALLOCATE (lami, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'TwoDCaptureDc/lami', iret) endif DEALLOCATE (eta, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'TwoDCaptureDc/eta', iret) endif endif END SUBROUTINE TwoDCaptureDc SUBROUTINE ThreeDCaptureDc(ux,vx,fx,fxi,dcflag,direction,ifilter) ! ---- Shared Variables USE mesh USE array_bounds USE method_parms ! ---- Shared Procedures USE OneDweno USE Generic_EvalsAndETAX USE Generic_EvalsAndETAY USE Generic_EvalsAndETAZ IMPLICIT NONE include 'cles.i' DOUBLE PRECISION, INTENT(IN) :: ux(ncomps,ixlo:ixhi,iylo:iyhi,izlo:izhi) DOUBLE PRECISION, INTENT(IN) :: vx(nvars,ixlo:ixhi,iylo:iyhi,izlo:izhi) DOUBLE PRECISION, INTENT(IN) :: fx(nvars,ixlo:ixhi,iylo:iyhi,izlo:izhi) INTEGER, INTENT(IN) :: dcflag(1:nx+1,1:ny+1,1:nz+1,3) INTEGER, INTENT(IN) :: direction, ifilter DOUBLE PRECISION, INTENT(OUT) :: fxi(ncomps,ixlo:ixhi,iylo:iyhi,izlo:izhi,3) ! ---- local copies of the data used in WENO ! ---- these are a fixed size: no problems with AMR DOUBLE PRECISION, ALLOCATABLE :: locfxi(:,:) DOUBLE PRECISION, ALLOCATABLE :: locfx(:,:) DOUBLE PRECISION, ALLOCATABLE :: locux(:,:) DOUBLE PRECISION, ALLOCATABLE :: locvx(:,:) INTEGER, ALLOCATABLE :: locdc(:) ! ----- local eigenvalues and H-correction DOUBLE PRECISION, ALLOCATABLE :: lami(:,:,:) DOUBLE PRECISION, ALLOCATABLE :: eta(:) DOUBLE PRECISION :: dtmp INTEGER :: i,j,k, iret call cleslog_log_enter('ThreeDCaptureDc') ! nothing to do if ( use_dcflag .eq. CLES_TRUE .and. SUM(dcflag(:,:,:,direction) ) .eq. 0 ) goto 11 if ( use_carbfix .eq. 0 ) then ALLOCATE (lami(2,3,1), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'ThreeDCaptureDc/lami', iret) endif ALLOCATE (eta(1), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'ThreeDCaptureDc/eta', iret) endif endif whichdirection: SELECT CASE (direction) CASE (1) ALLOCATE (locfxi(ncomps,ixlo:ixhi), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'ThreeDCaptureDc/locfxi', iret) endif ! ---- the x-direction if ( use_carbfix .eq. 1 ) then ALLOCATE (lami(2,3,nx+1), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'ThreeDCaptureDc/lami', iret) endif ALLOCATE (eta(nx+1), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'ThreeDCaptureDc/eta', iret) endif endif DO k = 1,nz,1 DO j = 1,ny, 1 if ( use_carbfix .eq. 1 ) then do i=1,nx+1 CALL EvalsAndETAX(ux,vx,i-1,j,k,lami(:,:,i), eta(i)) enddo endif locfxi = fxi(:,:,j,k,direction) CALL FluxInterpWENO(locfxi, fx(1,ixlo,j,k), & ux(1,ixlo,j,k), vx(1,ixlo,j,k), lami, eta, & dcflag(1,j,k,direction), ixlo, ixhi, nx) if ( ifilter .eq. CLES_TRUE .and. method .eq. CLES_METHOD_HYBRID ) then do i=1, nx+1 if ( dcflag(i,j,k,direction) .eq. CLES_SWITCH_TCD ) then fxi(1:nvars,i,j,k,direction) = fxi(1:nvars,i,j,k,direction)*alpha_eta1 + locfxi(1:nvars,i)*alpha_eta2 else fxi(1:nvars,i,j,k,direction) = locfxi(1:nvars,i) endif enddo else fxi(1:nvars,1:nx+1,j,k,direction) = locfxi(1:nvars,1:nx+1) endif END DO END DO if ( use_carbfix .eq. 1 ) then DEALLOCATE (lami, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'ThreeDCaptureDc/lami', iret) endif DEALLOCATE (eta, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'ThreeDCaptureDc/eta', iret) endif endif DEALLOCATE(locfxi, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'ThreeDCaptureDc/locfxi', iret) endif CASE (2) ALLOCATE (locfxi(ncomps,iylo:iyhi), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'ThreeDCaptureDc/locfxi', iret) endif ALLOCATE (locfx(nvars,iylo:iyhi), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'ThreeDCaptureDc/locfx', iret) endif ALLOCATE (locux(ncomps,iylo:iyhi), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'ThreeDCaptureDc/locux', iret) endif ALLOCATE (locvx(nvars,iylo:iyhi), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'ThreeDCaptureDc/locvx', iret) endif ALLOCATE (locdc(1:ny+1), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'ThreeDCaptureDc/locdc', iret) endif if ( use_carbfix .eq. 1 ) then ALLOCATE (lami(2,3,ny+1), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'ThreeDCaptureDc/lami', iret) endif ALLOCATE (eta(ny+1), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'ThreeDCaptureDc/eta', iret) endif endif ! ---- the y-direction DO k=1, nz, 1 DO i=1, nx, 1 if ( use_carbfix .eq. 1 ) then do j=1,ny+1 CALL EvalsAndETAY(ux,vx,i,j-1,k,lami(:,:,j), eta(j)) enddo endif locfxi(:,:) = fxi(:,i,:,k,direction) locfx(:,:) = fx(:,i,:,k) locux(:,:) = ux(:,i,:,k) locvx(:,:) = vx(:,i,:,k) locdc(:) = dcflag(i,:,k,direction) ! Swap u for v in fx, ux, vx do j=iylo, iyhi dtmp = locfxi(2,j) locfxi(2,j) = locfxi(3,j) locfxi(3,j) = dtmp enddo do j=iylo, iyhi dtmp = locfx(2,j) locfx(2,j) = locfx(3,j) locfx(3,j) = dtmp enddo do j=iylo, iyhi dtmp = locux(2,j) locux(2,j) = locux(3,j) locux(3,j) = dtmp enddo do j=iylo, iyhi dtmp = locvx(2,j) locvx(2,j) = locvx(3,j) locvx(3,j) = dtmp enddo ! ---- Do the WENO interpolation at this point CALL FluxInterpWENO(locfxi, locfx, locux, locvx, lami, eta,& locdc, iylo, iyhi, ny) do j=iylo, iyhi dtmp = locfxi(2,j) locfxi(2,j) = locfxi(3,j) locfxi(3,j) = dtmp enddo if ( ifilter .eq. CLES_TRUE .and. method .eq. CLES_METHOD_HYBRID ) then do j=1, ny+1 if ( locdc(j) .eq. CLES_SWITCH_TCD ) then fxi(1:nvars,i,j,k,direction) = fxi(1:nvars,i,j,k,direction)*alpha_eta1 + locfxi(1:nvars,j)*alpha_eta2 else fxi(1:nvars,i,j,k,direction) = locfxi(1:nvars,j) endif enddo else fxi(1:nvars,i,1:ny+1,k,direction) = locfxi(1:nvars,1:ny+1) endif END DO END DO DEALLOCATE(locfxi, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'ThreeDCaptureDc/locfxi', iret) endif DEALLOCATE(locfx, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'ThreeDCaptureDc/locfx', iret) endif DEALLOCATE(locux, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'ThreeDCaptureDc/locux', iret) endif DEALLOCATE(locvx, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'ThreeDCaptureDc/locvx', iret) endif DEALLOCATE(locdc, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'ThreeDCaptureDc/locdc', iret) endif if ( use_carbfix .eq. 1 ) then DEALLOCATE (lami, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'ThreeDCaptureDc/lami', iret) endif DEALLOCATE (eta, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'ThreeDCaptureDc/eta', iret) endif endif CASE (3) ALLOCATE (locfxi(ncomps,izlo:izhi), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'ThreeDCaptureDc/locfxi', iret) endif ALLOCATE (locfx(nvars,izlo:izhi), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'ThreeDCaptureDc/locfx', iret) endif ALLOCATE (locux(ncomps,izlo:izhi), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'ThreeDCaptureDc/locux', iret) endif ALLOCATE (locvx(nvars,izlo:izhi), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'ThreeDCaptureDc/locvx', iret) endif ALLOCATE (locdc(1:nz+1), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'ThreeDCaptureDc/locdc', iret) endif if ( use_carbfix .eq. 1 ) then ALLOCATE (lami(2,3,nz+1), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'ThreeDCaptureDc/lami', iret) endif ALLOCATE (eta(nz+1), stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_ALLOCATE, & 'ThreeDCaptureDc/eta', iret) endif endif ! ---- the z-direction DO j = 1, ny, 1 DO i= 1, nx, 1 if ( use_carbfix .eq. 1 ) then do k=1,nz+1 CALL EvalsAndETAZ(ux,vx,i,j,k-1,lami(:,:,k), eta(k)) enddo endif locfxi(:,:) = fxi(:,i,j,:,direction) locfx(:,:) = fx(:,i,j,:) locux(:,:) = ux(:,i,j,:) locvx(:,:) = vx(:,i,j,:) locdc(:) = dcflag(i,j,:,direction) ! Swap u for v in fx, ux, vx do k=izlo, izhi dtmp = locfxi(2,k) locfxi(2,k) = locfxi(4,k) locfxi(4,k) = dtmp enddo do k=izlo, izhi dtmp = locfx(2,k) locfx(2,k) = locfx(4,k) locfx(4,k) = dtmp enddo do k=izlo, izhi dtmp = locux(2,k) locux(2,k) = locux(4,k) locux(4,k) = dtmp enddo do k=izlo, izhi dtmp = locvx(2,k) locvx(2,k) = locvx(4,k) locvx(4,k) = dtmp enddo ! ---- Do the WENO interpolation at this point CALL FluxInterpWENO(locfxi, locfx, locux, locvx, lami, eta,& locdc, izlo, izhi, nz) do k=izlo, izhi dtmp = locfxi(2,k) locfxi(2,k) = locfxi(4,k) locfxi(4,k) = dtmp enddo if ( ifilter .eq. CLES_TRUE .and. method .eq. CLES_METHOD_HYBRID ) then do k=1, nz+1 if ( locdc(k) .eq. CLES_SWITCH_TCD ) then fxi(1:nvars,i,j,k,direction) = fxi(1:nvars,i,j,k,direction)*alpha_eta1 + locfxi(1:nvars,k)*alpha_eta2 else fxi(1:nvars,i,j,k,direction) = locfxi(1:nvars,k) endif enddo else fxi(1:nvars,i,j,1:nz+1,direction) = locfxi(1:nvars,1:nz+1) endif END DO END DO DEALLOCATE(locfxi, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'ThreeDCaptureDc/locfxi', iret) endif DEALLOCATE(locfx, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'ThreeDCaptureDc/locfx', iret) endif DEALLOCATE(locux, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'ThreeDCaptureDc/locux', iret) endif DEALLOCATE(locvx, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'ThreeDCaptureDc/locvx', iret) endif DEALLOCATE(locdc, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'ThreeDCaptureDc/locdc', iret) endif if ( use_carbfix .eq. 1 ) then DEALLOCATE (lami, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'ThreeDCaptureDc/lami', iret) endif DEALLOCATE (eta, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'ThreeDCaptureDc/eta', iret) endif endif END SELECT whichdirection if ( use_carbfix .eq. 0 ) then DEALLOCATE (lami, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'ThreeDCaptureDc/lami', iret) endif DEALLOCATE (eta, stat=iret) if ( iret .ne. 0 ) then call cleslog_error(CLESLOG_ERROR_DEALLOCATE, & 'ThreeDCaptureDc/eta', iret) endif endif 11 call cleslog_log_exit('ThreeDCaptureDc') END SUBROUTINE ThreeDCaptureDc END MODULE Generic_CaptureDC