! ========================================================== SUBROUTINE chk1eu(q,mx,lb,ub,lbr,ubr,shaper,meqn,mout,mresult) ! ========================================================== ! ---- share variables USE method_parms use cles_interfaces implicit none include 'cles.i' INTEGER meqn, mx, mout double precision :: q(meqn,mx) INTEGER lb(1), ub(1), lbr(1), ubr(1), shaper(1),& & stride, imin(1), imax(1), i, getindx integer :: mresult DOUBLE PRECISION :: vx(nvars), xc stride = (ub(1) - lb(1))/(mx-1) imin(1) = MAX(lb(1), lbr(1)) imax(1) = MIN(ub(1), ubr(1)) IF (MOD(imin(1)-lb(1),stride) .NE. 0) THEN imin(1) = imin(1) + stride - MOD(imin(1)-lb(1),stride) ENDIF imin(1) = getindx(imin(1), lb(1), stride) IF (MOD(imax(1)-lb(1),stride) .NE. 0) THEN imax(1) = imax(1) - MOD(imax(1)-lb(1),stride) ENDIF imax(1) = getindx(imax(1), lb(1), stride) mresult = 1 DO i = imin(1), imax(1) IF (q(1,i).le.0.d0) THEN IF (mout.gt.0) THEN call cles_xLocation(i-nghost,xc) write(6,601) lb(1)+(i-imin(1))*stride, & & q(1,i),lb(1),ub(1),stride, xc END IF mresult = 0 END IF vx(1) = q(1,i) vx(2:nvars) = q(2:nvars,i)/vx(1) call cles_eqstate(q(:,i), ncomps, vx, nvars, 1, CLES_FALSE) IF (vx(5).le.0.d0) THEN IF (mout.gt.0) THEN call cles_xLocation(i-nghost,xc) write(6,602) lb(1)+(i-imin(1))*stride, & & vx(5),lb(1),ub(1),stride, xc END IF mresult = 0 END IF END DO 601 format('chk1eu: Error in rho (',i5,')',f16.8, & & ' on [(',i5,'),(',i5,'),(',i3,')] at (',f16.8,')') 602 format('chk1eu: Error in p (',i5,')',f16.8, & & ' on [(',i5,'),(',i5,')](',i3,')] at (',f16.8,')') RETURN END SUBROUTINE chk1eu ! ========================================================== SUBROUTINE chk2eu(q,mx,my,lb,ub,lbr,ubr,shaper,meqn,mout,mresult) ! ========================================================== ! ---- share variables USE method_parms use cles_interfaces implicit none include 'cles.i' DOUBLE PRECISION :: vx(nvars), xc, yc INTEGER meqn, mx, my, mout, mresult double precision :: q(meqn,mx,my) INTEGER lb(2), ub(2), lbr(2), ubr(2), shaper(2),& & stride, imin(2), imax(2), i, j, getindx, d stride = (ub(1) - lb(1))/(mx-1) DO d = 1, 2 imin(d) = MAX(lb(d), lbr(d)) imax(d) = MIN(ub(d), ubr(d)) IF (MOD(imin(d)-lb(d),stride) .NE. 0) THEN imin(d) = imin(d) + stride - MOD(imin(d)-lb(d),stride) ENDIF imin(d) = getindx(imin(d), lb(d), stride) IF (MOD(imax(d)-lb(d),stride) .NE. 0) THEN imax(d) = imax(d) - MOD(imax(d)-lb(d),stride) ENDIF imax(d) = getindx(imax(d), lb(d), stride) END DO DO i = imin(1), imax(1) DO j = imin(2), imax(2) IF (q(1,i,j).le.0.d0) THEN IF (mout.gt.0) THEN call cles_xLocation(i-nghost,xc) call cles_yLocation(j-nghost,yc) write(6,601) lb(1)+(i-imin(1))*stride, & & lb(2)+(j-imin(2))*stride,q(1,i,j), & & lb(1),lb(2),ub(1),ub(2),stride,stride,xc,yc END IF mresult = 0 END IF vx(1) = q(1,i,j) vx(2:nvars) = q(2:nvars,i,j)/vx(1) call cles_eqstate(q(:,i,j), ncomps, vx, nvars, 1, CLES_FALSE) IF (vx(5).le.0.d0) THEN IF (mout.gt.0) THEN call cles_xLocation(i-nghost,xc) call cles_yLocation(j-nghost,yc) write(6,602) lb(1)+(i-imin(1))*stride, & & lb(2)+(j-imin(2))*stride,vx(5), & & lb(1),lb(2),ub(1),ub(2),stride,stride,xc,yc END IF mresult = 0 END IF END DO END DO 601 format('chk2eu: Error in rho (',i5,',',i5,')',f16.8, & & ' on [(',i5,',',i5,'),(',i5,',',i5,'),(', & & i3,',',i3,')] at (',f16.8,',',f16.8,')') 602 format('chk2eu: Error in p (',i5,',',i5,')',f16.8, & & ' on [(',i5,',',i5,'),(',i5,',',i5,')](', & & i3,',',i3,')] at (',f16.8,',',f16.8,')') RETURN END SUBROUTINE chk2eu ! ========================================================== SUBROUTINE chk3eu(q,mx,my,mz,lb,ub,lbr,ubr,shaper,meqn,mout,mresult) ! ========================================================== ! ---- share variables USE method_parms use cles_interfaces implicit none include 'cles.i' DOUBLE PRECISION :: vx(nvars), xc, yc, zc INTEGER meqn, mx, my, mz, mout, mresult double precision :: q(meqn,mx,my,mz) INTEGER lb(3), ub(3), lbr(3), ubr(3), shaper(3),& & stride, imin(3), imax(3), i, j, k, getindx, d stride = (ub(1) - lb(1))/(mx-1) DO d = 1, 3 imin(d) = MAX(lb(d), lbr(d)) imax(d) = MIN(ub(d), ubr(d)) IF (MOD(imin(d)-lb(d),stride) .NE. 0) THEN imin(d) = imin(d) + stride - MOD(imin(d)-lb(d),stride) ENDIF imin(d) = getindx(imin(d), lb(d), stride) IF (MOD(imax(d)-lb(d),stride) .NE. 0) THEN imax(d) = imax(d) - MOD(imax(d)-lb(d),stride) ENDIF imax(d) = getindx(imax(d), lb(d), stride) END DO DO k = imin(3), imax(3) DO j = imin(2), imax(2) DO i = imin(1), imax(1) IF (q(1,i,j,k).le.0.d0) THEN IF (mout.gt.0) THEN call cles_xLocation(i-nghost,xc) call cles_yLocation(j-nghost,yc) call cles_zLocation(k-nghost,zc) write(6,601) lb(1)+(i-imin(1))*stride, & & lb(2)+(j-imin(2))*stride,lb(3)+(k-imin(3))*stride, & & q(1,i,j,k),lb(1),lb(2),lb(3),ub(1),ub(2),ub(3), & & stride,stride,stride,xc,yc,zc END IF mresult = 0 END IF vx(1) = q(1,i,j,k) vx(2:nvars) = q(2:nvars,i,j,k)/vx(1) call cles_eqstate(q(:,i,j,k), ncomps, vx, nvars, 1, useLES) IF (vx(5).le.0.d0) THEN IF (mout.gt.0) THEN call cles_xLocation(i-nghost,xc) call cles_yLocation(j-nghost,yc) call cles_zLocation(k-nghost,zc) write(6,602) lb(1)+(i-imin(1))*stride, & & lb(2)+(j-imin(2))*stride,lb(3)+(k-imin(3))*stride, & & vx(5),lb(1),lb(2),lb(3),ub(1),ub(2),ub(3), & & stride,stride,stride ,xc,yc,zc END IF mresult = 0 END IF END DO END DO END DO 601 format('chk3eu: Error in rho (',i5,',',i5,',',i5,')',f16.8, & & ' on [(',i5,',',i5,',',i5,'),(',i5,',',i5,',',i5,'),(', & & i3,',',i3,',',i3,')] at (',f16.8,',',f16.8,',',f16.8,')') 602 format('chk3eu: Error in p (',i5,',',i5,',',i5,')',f16.8, & & ' on [(',i5,',',i5,',',i5,'),(',i5,',',i5,',',i5,')](', & & i3,',',i3,',',i3,')] at (',f16.8,',',f16.8,',',f16.8,')') RETURN END SUBROUTINE chk3eu