check_opVar_prerequisites Subroutine

private subroutine check_opVar_prerequisites(operType, nInputs, input_varname, varSys, nComps, isSatisfied)

This subroutine checks whether input variables satisfy requirements for opertype.

For example: nComponents, number of inputs etc. If input_varname not found in varSys then this function returns false. If user defined nComps = -1 then nComps is set according to operType.

This subroutine checks operations used in both treelm and solvers

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: operType

Operation type
integer, intent(in) :: nInputs

Number of inputs
character(len=*), intent(in) :: input_varname(nInputs)

Input varnames for current operation
type(tem_varSys_type), intent(in) :: varSys

Variable system to look for input_varname
integer, intent(inout) :: nComps

Number of components defined for operation variable. If nComps == -1 then current nComps is set here
logical, intent(out) :: isSatisfied

true if all requirements for opertype are satisfied

Calls

proc~~check_opvar_prerequisites~~CallsGraph proc~check_opvar_prerequisites check_opVar_prerequisites interface~positionofval~5 positionofval proc~check_opvar_prerequisites->interface~positionofval~5 proc~tem_abort tem_abort proc~check_opvar_prerequisites->proc~tem_abort proc~posofval_label posofval_label interface~positionofval~5->proc~posofval_label mpi_abort mpi_abort proc~tem_abort->mpi_abort interface~sortedposofval~5 sortedposofval proc~posofval_label->interface~sortedposofval~5 proc~sortposofval_label sortposofval_label interface~sortedposofval~5->proc~sortposofval_label

Called by

proc~~check_opvar_prerequisites~~CalledByGraph proc~check_opvar_prerequisites check_opVar_prerequisites proc~tem_varsys_append_opervar tem_varSys_append_operVar proc~tem_varsys_append_opervar->proc~check_opvar_prerequisites proc~tem_varsys_append_luavar tem_varSys_append_luaVar proc~tem_varsys_append_luavar->proc~tem_varsys_append_opervar

Source Code

  subroutine check_opVar_prerequisites( operType, nInputs, input_varname, &
    &                                   varSys, nComps, isSatisfied )
    !--------------------------------------------------------------------------!
    !> Operation type
    character(len=*), intent(in) :: operType
    !> Number of inputs
    integer, intent(in) :: nInputs
    !> Input varnames for current operation
    character(len=*), intent(in) :: input_varname(nInputs)
    !> Variable system to look for input_varname
    type(tem_varSys_type), intent(in) :: varSys
    !> Number of components defined for operation variable.
    !! If nComps == -1 then current nComps is set here
    integer, intent(inout) :: nComps
    !> true if all requirements for opertype are satisfied
    logical, intent(out) :: isSatisfied
    !--------------------------------------------------------------------------!
    integer :: iIn, total_input_nComps
    integer :: inpos(nInputs), input_nComps(nInputs)
    !--------------------------------------------------------------------------!
    write(logUnit(7),*) 'Checking prerequisites for opertype: '//trim(operType)
    isSatisfied = .true.

    ! Position of input variables in varSys
    do iIn = 1, nInputs
      inPos(iIn) = PositionofVal(varSys%varname, input_varname(iIn))
    end do

    if ( all(inPos > 0) ) then
      input_nComps(:) = varSys%method%val(inPos(:))%nComponents
    else
      isSatisfied = .false.
      write(logUnit(1),*) 'Error: input varnames not found in varsys'
      return
    end if

    select case (trim(operType))
    case ('addition', 'difference', 'rel_difference', 'multiplication', &
      &   'division')
      ! operations which require two inputs and both to have same number of
      ! components
      if (size(input_varname) /= 2) then
        write(logUnit(1),*) 'Error: In operation type: '//trim(operType)
        write(logUnit(1),*) 'Number of input_varname /= 2'
        call tem_abort()
      end if

      if (nComps == -1) then
        nComps = input_nComps(1)
        write(logUnit(7),*) 'INFO: nComponents is not defined by user.'
        write(logUnit(7),*)  '     nComps set to nComps of 1st input variable'
      end if

      if (.not. all(input_nComps == nComps)) then
        write(logUnit(1),*) 'Error: nComps of operation variable does not ' &
          &               //'match with input variables nComps'
        write(logUnit(1),*) 'Input nComps: ', input_nComps
        call tem_abort()
      end if

    case ('multiply_scalar_times_vector')
      ! operations which require two inputs and 1st input must be a scalar
      if (size(input_varname) /= 2) then
        write(logUnit(1),*) 'Error: In operation type: '//trim(operType)
        write(logUnit(1),*) 'Number of input_varname /= 2'
        call tem_abort()
      end if

      ! 1st input variable must be scalar
      if (input_nComps(1) /= 1) then
        write(logUnit(1),*) 'Error: In operation type: '//trim(operType)
        write(logUnit(1),*) '1st input variable is not a scalar'
        call tem_abort()
      end if

      if (nComps == -1 .or. nComps /= input_nComps(2)) then
        write(logUnit(1),*) 'Warning: nComps for operVar is wrong.'
        write(logUnit(1),*) '         Setting nComps =', input_nComps(2)
        nComps = input_nComps(2)
      end if

    case ('divide_vector_by_scalar')
      ! operations which require two inputs and 1st input must be a scalar
      if (size(input_varname) /= 2) then
        write(logUnit(1),*) 'Error: In operation type: '//trim(operType)
        write(logUnit(1),*) 'Number of input_varname /= 2'
        call tem_abort()
      end if

      ! 2nd input variable must be scalar
      if (input_nComps(2) /= 1) then
        write(logUnit(1),*) 'Error: In operation type: '//trim(operType)
        write(logUnit(1),*) '1st input variable is not a scalar'
        call tem_abort()
      end if

      if (nComps == -1 .or. nComps /= input_nComps(1)) then
        write(logUnit(1),*) 'Warning: nComps for operVar is wrong.'
        write(logUnit(1),*) '         Setting nComps =', input_nComps(1)
        nComps = input_nComps(1)
      end if

    case ('magnitude')
      ! operations which require only one input and ncomponents must be 1
      if (nInputs /= 1 ) then
        write(logUnit(1),*) 'Error: In operation type: '//trim(operType)
        write(logUnit(1),*) 'Number of input_varname /= 1'
        call tem_abort()
      end if

      if ( nComps /= 1 ) then
        write(logUnit(1),*) 'Warning: nComps /= 1. Setting nComps = 1'
        nComps = 1
      end if

    case ('meansquare')
      ! operations which require only one input and ncomps == input_ncomps
      if (nInputs /= 1 ) then
        write(logUnit(1),*) 'Error: In operation type: '//trim(operType)
        write(logUnit(1),*) 'Number of input_varname /= 1'
        call tem_abort()
      end if

      if ( nComps /= input_nComps(1) ) then
        write(logUnit(1),*) 'Warning: nComps /= input, should be:', &
          &                 input_nComps(1)
        write(logUnit(1),*) 'but is:', nComps
        write(logUnit(1),*) 'Setting it to ', input_nComps(1)
        nComps = input_nComps(1)
      end if

    case ('locall2mean','deviation')
      ! operations which require only one input and ncomps == input_ncomps
      if (nInputs /= 1 ) then
        write(logUnit(1),*) 'Error: In operation type: '//trim(operType)
        write(logUnit(1),*) 'Number of input_varname /= 1'
        call tem_abort()
      end if

      if ( nComps /= input_nComps(1) ) then
        write(logUnit(1),*) 'Warning: nComps /= input, should be:', &
          &                 input_nComps(1)
        write(logUnit(1),*) 'but is:', nComps
        write(logUnit(1),*) 'Setting it to ', input_nComps(1)
        nComps = input_nComps(1)
      end if


    case ('extract', 'gradient', 'gradientX', 'gradientY', 'gradientZ', &
      &   'reduction_transient'                                         )
      ! operations which require only one input and ncomponents can be >= 1
      if (nInputs /= 1 ) then
        write(logUnit(1),*) 'Error: In operation type: '//trim(operType)
        write(logUnit(1),*) 'Number of input_varname /= 1'
        call tem_abort()
      end if

      if (nComps == -1) then
        write(logUnit(1),*) 'Error: nComps for operVar is not defined.'
        call tem_abort()
      end if

    case ('combine')
      ! operations which require more than two inputs and
      ! nComps is sum of nComps of input vars
      total_input_nComps = sum(input_nComps)
      if (nComps /= total_input_nComps) then
        write(logUnit(llerror),*) 'Warning: In variable operation combine'
        write(logUnit(llerror),*) '  User defined nComps ' &
          &                    // '/= sum(input_nComponents).'
        write(logUnit(llerror),*) &
          &  '  So, setting nComps = sum(input_nComponents)'
        write(logUnit(llerror),*) '  nComps: ', total_input_nComps
        nComps = total_input_nComps
      end if

    case( 'greater_than', 'gt', '>',         &
      & 'greater_than_or_equal', 'ge', '>=', &
      & 'less_than', 'lt', '<',              &
      & 'less_than_or_equal', 'le', '<=',    &
      & 'equal', 'eq', '=',                  &
      & 'not_equal', 'ne', '/=',             &
      & 'and',                               &
      & 'or'                                 )
      if (size(input_varname) /= 2) then
        write(logUnit(1),*) 'Error: In operation type: '//trim(operType)
        write(logUnit(1),*) 'Number of input_varname /= 2'
        call tem_abort()
      end if

    case default
      write(logUnit(1),*) 'ERROR: operType: ' // trim(operType) &
        & // ' not supported. Variable is not appended.'
      call tem_abort()
    end select

  end subroutine check_opVar_prerequisites