SubTab_dble Subroutine

public subroutine SubTab_dble(x, Nx)

Subtabulate array x, creating interpolated array of length Nx

Arguments

Type IntentOptional Attributes Name
real(kind=8), intent(inout) :: x(Nx)
integer, intent(in) :: Nx

Called by

proc~~subtab_dble~~CalledByGraph proc~subtab_dble SubTab_dble interface~subtab SubTab interface~subtab->proc~subtab_dble proc~readati3d ReadATI3D proc~readati3d->interface~subtab proc~readbty3d ReadBTY3D proc~readbty3d->interface~subtab proc~readfreqvec ReadfreqVec proc~readfreqvec->interface~subtab proc~readraybearingangles ReadRayBearingAngles proc~readraybearingangles->interface~subtab proc~readrayelevationangles ReadRayElevationAngles proc~readrayelevationangles->interface~subtab proc~readvector ReadVector proc~readvector->interface~subtab proc~readenvironment ReadEnvironment proc~readenvironment->proc~readfreqvec proc~readenvironment->proc~readraybearingangles proc~readenvironment->proc~readrayelevationangles proc~readrcvrbearings ReadRcvrBearings proc~readenvironment->proc~readrcvrbearings proc~readrcvrranges ReadRcvrRanges proc~readenvironment->proc~readrcvrranges proc~readsxsy ReadSxSy proc~readenvironment->proc~readsxsy proc~readszrz ReadSzRz proc~readenvironment->proc~readszrz proc~readrcvrbearings->proc~readvector proc~readrcvrranges->proc~readvector proc~readsxsy->proc~readvector proc~readszrz->proc~readvector program~bellhop3d BELLHOP3D program~bellhop3d->proc~readati3d program~bellhop3d->proc~readbty3d program~bellhop3d->proc~readenvironment program~bellhop BELLHOP program~bellhop->proc~readenvironment

Source Code

  SUBROUTINE SubTab_dble( x, Nx )
  !! Subtabulate array `x`, creating interpolated array of length `Nx`

    INTEGER,       INTENT( IN )    :: Nx
    REAL (KIND=8), INTENT( INOUT ) :: x( Nx )
    REAL (KIND=8)                  :: deltax

    IF ( Nx >= 3 ) THEN
       IF ( ABS( x( 3 ) - ( -999.9D0 ) ) < 0.01D0 ) THEN
          IF ( ABS( x( 2 ) - ( -999.9D0 ) ) < 0.01D0 ) x( 2 ) = x( 1 )
          deltax      = ( x( 2 ) - x( 1 ) ) / ( Nx - 1 )
          x( 1 : Nx ) = x( 1 ) + [ ( ix, ix = 0, Nx - 1 ) ] * deltax
       END IF
    END IF

  END SUBROUTINE SubTab_dble