vtf-logo

src/generic/Check.f90


!     ==========================================================
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,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,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,xc)
              call cles_yLocation(j,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,xc)
              call cles_yLocation(j,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,xc)
                 call cles_yLocation(j,yc)
                 call cles_zLocation(k,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,xc)
                 call cles_yLocation(j,yc)
                 call cles_zLocation(k,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

<