table_slope.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	table_slope (table, stiffini, stiffmin, stiffmax, xmax)

Function/Subroutine Documentation

table_slope()

subroutine table_slope	(	type(table_4d_), intent(in)	table,
		intent(out)	stiffini,
		intent(out)	stiffmin,
		intent(out)	stiffmax,
		intent(out)	xmax )

Definition at line 31 of file table_slope.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE table4d_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(TABLE_4D_) ,INTENT(IN) ::  TABLE
      my_real ,INTENT(OUT) :: stiffini,stiffmin,stiffmax  ! initial, min and max function slopes
      my_real ,INTENT(OUT) :: xmax ! first abscissa corresponding to the max slope
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K,L,NDIM,NPT,LEN2,LEN3,LEN4
      my_real x1,x2,y1,y2,dx,dy,dydx
C=======================================================================
      ! COMPUTE INITIAL, MIN and MAX SLOPE OF A FUNCTION TABLE
C=======================================================================
      stiffini = zero
      stiffmax = zero
      stiffmin = ep20
      xmax     = zero
      y1 = 0
      ndim = table%NDIM
      npt  = SIZE(table%X(1)%VALUES)
c
      IF (ndim == 1) THEN
        x1  = table%X(1)%VALUES(1)
        y1  = table%Y1D(1)
        IF (x1 >= zero) THEN
          dx = table%X(1)%VALUES(2) - x1
          dy = table%Y1D(2) - y1
          stiffini = dy/dx
        ENDIF
        DO i = 2,npt
          x2 = table%X(1)%VALUES(i)
          y2 = table%Y1D(i)
          dx = x2 - x1
          dy = y2 - y1          
          dydx = dy/dx
          IF (dydx > stiffmax) THEN
            stiffmax = dydx
            xmax     = x1
          END IF
          stiffmin = min(stiffmin,dydx)
          IF (x1 == zero .or. x2 == zero) THEN
            stiffini = max(stiffini, dydx)
          ENDIF
          x1 = x2
          y1 = y2
        ENDDO
c        
      ELSE IF (ndim == 2) THEN
        len2 = SIZE(table%X(2)%VALUES)
        x1   = table%X(1)%VALUES(1)
        y1 = table%Y2D(1,1)
        y2 = 0
        DO i = 2,npt
          x2 = table%X(1)%VALUES(i)
          dx = x2 - x1
          DO j = 1,len2
            y2 = table%Y2D(i,j)
            dy = y2 - y1
            dydx = dy/dx
            IF (dydx > stiffmax) THEN
              stiffmax = dydx
              xmax     = x1
            END IF
            stiffmin = min(stiffmin,dydx)
            IF (x1 == zero .or. x2 == zero) THEN
              stiffini = max(stiffini, dydx)
            ENDIF
          ENDDO
          y1 = y2
          x1 = x2
        ENDDO
c        
      ELSE IF (ndim == 3) THEN
        len2 = SIZE(table%X(2)%VALUES)
        len3 = SIZE(table%X(3)%VALUES)
        x1   = table%X(1)%VALUES(1)
        DO i = 2,npt
          x2 = table%X(1)%VALUES(i)
          dx = x2 - x1
          DO j = 1,len2
            DO k = 1,len3
              y1 = table%Y3D(i-1,j,k)
              y2 = table%Y3D(i  ,j,k)
              dy = y2 - y1          
              dydx = dy/dx
              IF (dydx > stiffmax) THEN
                stiffmax = dydx
                xmax     = x1
              END IF
              stiffmin = min(stiffmin,dydx)
              IF (x1 == zero .or. x2 == zero) THEN
                stiffini = max(stiffini, dydx)
              ENDIF
            ENDDO      
          ENDDO      
          x1 = x2
        ENDDO
c        
      ELSE IF (ndim == 4) THEN
        len2 = SIZE(table%X(2)%VALUES)
        len3 = SIZE(table%X(3)%VALUES)
        len4 = SIZE(table%X(4)%VALUES)
        x1   = table%X(1)%VALUES(1)
        DO i = 2,npt
          x2 = table%X(1)%VALUES(i)
          dx = x2 - x1
          DO j = 1,len2
            DO k = 1,len3
              DO l = 1,len4
                y1 = table%Y4D(i-1,j,k,l)
                y2 = table%Y4D(i  ,j,k,l)
                dy = y2 - y1          
                dydx = dy/dx
                IF (dydx > stiffmax) THEN
                  stiffmax = dydx
                  xmax     = x1
                END IF
                stiffmin = min(stiffmin,dydx)
                IF (x1 == zero .or. x2 == zero) THEN
                  stiffini = max(stiffini, dydx)
                ENDIF
              ENDDO      
            ENDDO      
          ENDDO      
          x1 = x2
        ENDDO
c
      END IF
c-----------
      RETURN