utilities_mod.f

Go to the documentation of this file.

MODULE utilities

  IMPLICIT NONE

CONTAINS

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
!  function: mfix_isnan                                                !
!  Purpose: check whether argument is NAN                              !
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      LOGICAL FUNCTION mfix_isnan(x)

! Dummy arguments
!---------------------------------------------------------------------//
      double precision, intent(in) :: x

! Local variables
!---------------------------------------------------------------------//
      CHARACTER(LEN=80) :: notnumber
!---------------------------------------------------------------------//

      mfix_isnan = .false.
      WRITE(notnumber,*) x
! To check for NaN's in x, see if x (a real number) contain a letter "N"
! "n" or symbol "?", in which case it is a NaN (Not a Number)

      IF(index(notnumber,'?') > 0 .OR.     &
         index(notnumber,'n') > 0 .OR.     &
         index(notnumber,'N') > 0 ) THEN
        mfix_isnan = .true.
         RETURN
      ENDIF

      RETURN
      END FUNCTION mfix_isnan

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
!                                                                      C
!  function: MAX_VEL_INLET                                             C
!  Purpose: Find maximum velocity at inlets.                           C
!                                                                      C
!  Author: S. Benyahia                                Date: 26-AUG-05  C
!                                                                      C
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
      DOUBLE PRECISION FUNCTION max_vel_inlet()

! Modules
!---------------------------------------------------------------------//
      use bc, only: bc_defined, bc_type_enum
      use bc, only: mass_inflow, p_inflow
      use bc, only: bc_plane
      use bc, only: bc_k_b, bc_k_t, bc_j_s, bc_j_n, bc_i_w, bc_i_e
      use compar, only: dead_cell_at
      use fldvar, only: u_g, v_g, w_g, u_s, v_s, w_s
      use functions, only: funijk, is_on_mype_owns
      use functions, only: im_of, jm_of, km_of
      use mpi_utility, only: global_all_max
      use param, only: dimension_bc
      use param1, only: zero, small_number
      use physprop, only: mmax
      use run, only: units
      use toleranc, only: max_allowed_vel, max_inlet_vel, max_inlet_vel_fac
      IMPLICIT NONE

! Local variables
!---------------------------------------------------------------------//
      INTEGER :: L, I, J, K, IJK, M
      DOUBLE PRECISION :: maxVEL
!---------------------------------------------------------------------//

! initializing
      maxvel = zero

      DO l = 1, dimension_bc

         IF(.NOT.(bc_defined(l).AND.(bc_type_enum(l)==mass_inflow .OR. &
            bc_type_enum(l) == p_inflow))) cycle

         DO k = bc_k_b(l), bc_k_t(l)
         DO j = bc_j_s(l), bc_j_n(l)
         DO i = bc_i_w(l), bc_i_e(l)

            IF (.NOT.is_on_mype_owns(i,j,k)) cycle
            IF (dead_cell_at(i,j,k)) cycle
            ijk = funijk(i,j,k)

            SELECT CASE (bc_plane(l))
            CASE ('E'); maxvel = max(maxvel,abs(u_g(ijk)))
            CASE ('N'); maxvel = max(maxvel,abs(v_g(ijk)))
            CASE ('T'); maxvel = max(maxvel,abs(w_g(ijk)))
            CASE ('W'); maxvel = max(maxvel,abs(u_g(im_of(ijk))))
            CASE ('S'); maxvel = max(maxvel,abs(v_g(jm_of(ijk))))
            CASE ('B'); maxvel = max(maxvel,abs(w_g(km_of(ijk))))
            END SELECT

            DO m=1,mmax
               SELECT CASE (bc_plane(l))
               CASE ('E'); maxvel = max(maxvel,abs(u_s(ijk,m)))
               CASE ('N'); maxvel = max(maxvel,abs(v_s(ijk,m)))
               CASE ('T'); maxvel = max(maxvel,abs(w_s(ijk,m)))
               CASE ('W'); maxvel = max(maxvel,abs(u_s(im_of(ijk),m)))
               CASE ('S'); maxvel = max(maxvel,abs(v_s(jm_of(ijk),m)))
               CASE ('B'); maxvel = max(maxvel,abs(w_s(km_of(ijk),m)))
               END SELECT
            ENDDO

         ENDDO
         ENDDO
         ENDDO
      ENDDO

      CALL global_all_max(maxvel, max_vel_inlet)

! If no inlet velocity is specified, use an upper limit defined in
! toleranc_mod.f
      IF(max_vel_inlet <= small_number) THEN
         max_vel_inlet = max_allowed_vel
         IF(units == 'SI') max_inlet_vel = 1d-2*max_allowed_vel
      ELSE
! Scale the value using a user defined scale factor
         max_vel_inlet = 100.0d0*max_inlet_vel_fac*max_vel_inlet
      ENDIF

      RETURN
      END FUNCTION max_vel_inlet


!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
!                                                                      C
!  Function: CHECK_VEL_BOUND()                                         C
!  Purpose: Check velocities upper bound to be less than speed of      C
!           sound                                                      C
!                                                                      C
!  Author: S. Benyahia                                Date: 25-AUG-05  C
!                                                                      C
!                                                                      C
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
      LOGICAL FUNCTION check_vel_bound ()

! Modules
!---------------------------------------------------------------------//
      use compar, only: ijkstart3, ijkend3
      use discretelement, only: des_continuum_coupled, des_continuum_hybrid
      use fldvar, only: ep_g, u_g, v_g, w_g
      use fldvar, only: ep_s, u_s, v_s, w_s
      use functions, only: fluid_at 
      use indices, only: i_of, j_of, k_of
      use mpi_utility, only: global_all_or
      use physprop, only: mmax
      use toleranc, only: max_inlet_vel

      IMPLICIT NONE

! Local variables
!---------------------------------------------------------------------//
      INTEGER :: M
! Indices
      INTEGER :: IJK
      LOGICAL :: ALL_IS_ERROR
!---------------------------------------------------------------------//

!!$omp   parallel do private(IJK)
! initializing
      check_vel_bound = .false.
      all_is_error    = .false.

loop_fluid : DO ijk = ijkstart3, ijkend3

         IF (fluid_at(ijk)) THEN
            IF(abs(u_g(ijk)) > max_inlet_vel .OR. &
               abs(v_g(ijk)) > max_inlet_vel .OR. &
               abs(w_g(ijk)) > max_inlet_vel) THEN
               check_vel_bound = .true.
               WRITE(*,1000) max_inlet_vel, i_of(ijk), j_of(ijk), k_of(ijk), &
                             ep_g(ijk), u_g(ijk), v_g(ijk), w_g(ijk)
               EXIT loop_fluid
            ENDIF

            IF (.NOT.des_continuum_coupled .OR. des_continuum_hybrid) THEN
               DO m = 1, mmax
                 IF(abs(u_s(ijk,m)) > max_inlet_vel .OR. &
                    abs(v_s(ijk,m)) > max_inlet_vel .OR. &
                    abs(w_s(ijk,m)) > max_inlet_vel) THEN
                   check_vel_bound = .true.
                   WRITE(*,1010) max_inlet_vel, i_of(ijk), j_of(ijk), k_of(ijk), m, &
                                 ep_s(ijk, m), u_s(ijk,m), v_s(ijk,m), w_s(ijk,m)
                   EXIT loop_fluid
                 ENDIF
               ENDDO
            ENDIF   ! end if(.not.des_continuum_coupled or des_continuum_hybrid)
         ENDIF

      ENDDO loop_fluid

      CALL global_all_or(check_vel_bound, all_is_error)
      IF(all_is_error) check_vel_bound = .true.

      RETURN
 1000 FORMAT(1x,'Message from: CHECK_VEL_BOUND',/&
            'WARNING: velocity higher than maximum allowed velocity: ', &
            g12.5, '(to change this adjust the scale factor MAX_INLET_VEL_FAC)'/&
            'in this cell: ','I = ',i4,2x,' J = ',i4,2x,' K = ',i4, /&
            '  ','Epg = ', g12.5, 'Ug = ', g12.5, 'Vg = ', g12.5, 'Wg = ', g12.5)
 1010 FORMAT(1x,'Message from: CHECK_VEL_BOUND',/&
            'WARNING: velocity higher than maximum allowed velocity: ', &
            g12.5,/&
            'in this cell: ','I = ',i4,2x,' J = ',i4,2x,' K = ',i4,' M = ',i4, /&
            '  ','Eps = ', g12.5,'Us = ', g12.5, 'Vs = ', g12.5, 'Ws = ', g12.5)

      END FUNCTION check_vel_bound


!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
!  Function: SEEK_COMMENT                                              !
!  Purpose: determine if (and where) a comment character appears       !
!           in a data input line                                       !
!     The function SEEK_COMMENT returns the index to where a comment   !
!     character was found in the input data line.  Equals MAXCOL + 1   !
!     if no-comment characters in the line.                            !
!                                                                      !
!  Author: P.Nicoletti                                Date: 25-NOV-91  !
!                                                                      !
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      INTEGER FUNCTION seek_comment (LINE, MAXCOL)
      IMPLICIT NONE

! Dummy arguments
!---------------------------------------------------------------------//
! input data line
      CHARACTER(len=*) :: LINE
! maximum column of input data line to search
      INTEGER :: MAXCOL

! Local parameters
!---------------------------------------------------------------------//
! the number of designated comment characters
      INTEGER, PARAMETER :: DIM_COMMENT = 2

! Local variables
!---------------------------------------------------------------------//
! loop indicies
      INTEGER :: L, L2
! the comment characters
      CHARACTER, DIMENSION(DIM_COMMENT) :: COMMENT_CHAR
!---------------------------------------------------------------------//
      DATA comment_char/'#', '!'/

      DO l = 1, maxcol
         DO l2 = 1, dim_comment
            IF (line(l:l) == comment_char(l2)) THEN
               seek_comment = l
               RETURN
            ENDIF
         END DO
      END DO
      seek_comment = maxcol + 1
      RETURN
      END FUNCTION seek_comment


!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
!  Function: SEEK_END                                                  !
!  Purpose: determine where trailing blanks begin in a line            !
!     The function SEEK_END returns the index to where the last        !
!     character was found in the input data line.  Equals MAXCOL       !
!     if no trailing blank characters in the line.                     !
!                                                                      !
!  Author: P.Nicoletti, M. Syamlal                    Date: 7-AUG-92   !
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      INTEGER FUNCTION seek_end (LINE, MAXCOL)
      IMPLICIT NONE

! Dummy arguments
!---------------------------------------------------------------------//
! maximum column of input data line to search
      INTEGER :: MAXCOL
! input data line
      CHARACTER :: LINE*(*)

! Local variables
!---------------------------------------------------------------------//
      INTEGER :: L
!---------------------------------------------------------------------//
      seek_end = 0
      DO l = 1, maxcol
         IF (line(l:l) /= ' ') seek_end = l
      END DO
      RETURN
      END FUNCTION seek_end


!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
!  Function: LINE_TOO_BIG                                              !
!  Purpose: return an error condition if input data is located past    !
!           column MAXCOL in the data input file                       !
!     The function LINE_TOO_BIG returns a value greater than 0 to      !
!     indicate an error condition (data passed column MAXCOL in LINE)  !
!                                                                      !
!  Author: P.Nicoletti                                Date: 25-NOV-91  !
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      INTEGER FUNCTION line_too_big (LINE, LINE_LEN, MAXCOL)
      IMPLICIT NONE

! Dummy arguments
!---------------------------------------------------------------------//
! input data line
      CHARACTER(LEN=*) :: LINE
! length of input data line
      INTEGER :: LINE_LEN
! maximum column that non-blank charcaters are
! are in the input data line
      INTEGER :: MAXCOL

! Local variables
!---------------------------------------------------------------------//
! Loop index
      INTEGER :: L
!---------------------------------------------------------------------//
      DO l = maxcol + 1, line_len
         IF (line(l:l) /= ' ') THEN
            line_too_big = l
            RETURN
         ENDIF
      ENDDO
      line_too_big = 0
      RETURN
      END FUNCTION line_too_big


!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
! Function: BLANK_LINE                                                 !
! Author: P. Nicoletti                                Date: 25-NOV-91  !
!                                                                      !
! Purpose: Return .TRUE. if a line contains no input or only spaces.   !
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      LOGICAL FUNCTION blank_line (line)
      IMPLICIT NONE

! Dummy arguments
!---------------------------------------------------------------------//
      CHARACTER :: LINE*(*)

! Local variables
!---------------------------------------------------------------------//
      INTEGER :: L
!---------------------------------------------------------------------//
      blank_line = .false.
      DO l=1, len(line)
         IF(line(l:l)/=' ' .and. line(l:l)/='    ')RETURN
      ENDDO
      blank_line = .true.
      RETURN
      END FUNCTION blank_line


!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
!  Subroutine: bound_x                                                 !
!  Purpose: bound the values of x array                                !
!                                                                      !
!  Author: M. Syamlal                                 Date: 15-SEP-98  !
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      SUBROUTINE bound_x(ARRAY, IJKMAX2)

! Modules
!---------------------------------------------------------------------//
      USE param, only: dimension_3
      USE param1, only: one, zero
      IMPLICIT NONE

! Dummy arguments
!---------------------------------------------------------------------//
! Maximum dimension
      INTEGER :: IJKMAX2
! Array
      DOUBLE PRECISION :: Array(dimension_3)
!--------------------------------------------------------------------//
      IF (ijkmax2 > 0) THEN
         array(:) = min(one,max(zero,array(:)))
      ENDIF
      RETURN
      END SUBROUTINE bound_x

END MODULE utilities