biquad_coefficients.F File Reference

#include "implicit_f.inc"
#include "scr05_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	biquad_coefficients (c1, c2, c3, c4, c5, l, x_1, x_2, e1, e2, e3, e4)

Function/Subroutine Documentation

biquad_coefficients()

subroutine biquad_coefficients	(		c1,
			c2,
			c3,
			c4,
			c5,
		integer	l,
			x_1,
			x_2,
			e1,
			e2,
			e3,
			e4 )

Definition at line 32 of file biquad_coefficients.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "scr05_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER L
      my_real  c1,c2,c3,c4,c5
      my_real  e1,e2,e3,e4
      my_real  x_1(2),x_2(3)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER  I, J, K, IPIV2(2), IPIV3(3), INFO
      my_real triax_1_lin, triax_2_lin, triax_3_lin,
     .        triax_4_lin, triax_5_lin
      my_real triax_1_quad, triax_2_quad, 
     .        triax_3_quad, triax_4_quad, triax_5_quad
      my_real a_1(2,2), b_1(2)
      my_real a_2(3,3), b_2(3)
      DATA triax_1_lin, triax_2_lin, triax_3_lin, triax_4_lin,
     .        triax_5_lin 
     .     / -0.33333333, 0.0, 0.33333333, 0.57735, 0.66666667 /
      DATA triax_1_quad, triax_2_quad, triax_3_quad, 
     .     triax_4_quad, triax_5_quad 
     .     / 0.111111, 0.0, 0.111111, 0.333333, 0.444444 /
#ifndef WITHOUT_LINALG
C=======================================================================
C
C pre definition for user-input data when only 
C tension test data are provided
C
C=============================================  
       IF (l/=0)THEN
         IF     (l == 1) THEN      ! Mild Seel (c3 = 0.6)
           c1 =  3.5 * c3
           c2 =  1.6 * c3         
           c4 =  0.6 * c3
           c5 =  1.5 * c3
         ELSEIF (l == 2) THEN      ! DP600 (c3 = 0.5)
           c1 =  4.3 * c3
           c2 =  1.4 * c3          
           c4 =  0.6 * c3
           c5 =  1.6 * c3
         ELSEIF (l == 3) THEN      ! Boron (c3 = 0.12)
           c1 =   5.2 * c3
           c2 =   3.1 * c3         
           c4 =   0.8 * c3
           c5 =   3.5 * c3
         ELSEIF (l == 4) THEN      ! Aluminium AA5182 (c3 = 0.3)
           c1 =   5.0 * c3
           c2 =   1.0 * c3         
           c4 =   0.4 * c3
           c5 =   0.8 * c3
         ELSEIF (l == 5) THEN      ! Aluminium AA6082-T6 (c3 = 0.17)
           c1 =   7.8 * c3
           c2 =   3.5 * c3         
           c4 =   0.6 * c3
           c5 =   2.8 * c3
         ELSEIF (l == 6) THEN      ! Plastic light_eBody PA6GF30 (c3 = 0.1)
           c1 =   3.6 * c3
           c2 =   0.6 * c3         
           c4 =   0.5 * c3
           c5 =   0.6 * c3
         ELSEIF (l == 7) THEN      ! Plastic light_eBody PP T40 ( c3=0.11 )
           c1 =  10.0 * c3
           c2 =   2.7 * c3         
           c4 =   0.6 * c3
           c5 =   0.7 * c3
         ELSEIF (l == 99) THEN     ! user scalling factors
           c1 =    e1 * c3
           c2 =    e2 * c3        
           c4 =    e3 * c3
           c5 =    e4 * c3
         ELSE                      ! ELSE --> Mild Seel
           c1 =  3.5 * c3
           c2 =  1.6 * c3          
           c4 =  0.6 * c3
           c5 =  1.5 * c3
         ENDIF        
       ELSEIF(c1 == zero .AND. c2 == zero .AND. c4 == zero .AND. c5 == zero) THEN
         c1 =  3.5 * c3
         c2 =  1.6 * c3    
         c4 =  0.6 * c3
         c5 =  1.5 * c3
       ENDIF
C=======================================================================
C
C determine coefficient matrix for parable_1
C
C=======================================================================
        a_1(1,1) = triax_1_lin
        a_1(1,2) = triax_1_quad
        a_1(2,1) = triax_3_lin
        a_1(2,2) = triax_3_quad
        b_1(1)   =   c1 - c2
        b_1(2)   =   c3 - c2
C
C!      fitting the first quadratic function
        IF (iresp == 0) THEN 
          CALL dgesv(2, 1, a_1, 2, ipiv2, b_1, 2, info)
        ELSE
          CALL sgesv(2, 1, a_1, 2, ipiv2, b_1, 2, info)
        ENDIF
        x_1(1:2) = b_1(1:2)
C
C
C=======================================================================
C
C determine coefficient matrix for parable_2
C
C=======================================================================
        a_2(1,1) = 1.0
        a_2(1,2) = triax_3_lin
        a_2(1,3) = triax_3_quad
        a_2(2,1) = 1.0
        a_2(2,2) = triax_4_lin
        a_2(2,3) = triax_4_quad
        a_2(3,1) = 1.0
        a_2(3,2) = triax_5_lin
        a_2(3,3) = triax_5_quad
        b_2(1)   =   c3
        b_2(2)   =   c4
        b_2(3)   =   c5
C
C!      fitting the second quadratic function
        IF (iresp == 0) THEN 
          CALL dgesv(3, 1, a_2, 3, ipiv3, b_2, 3, info)
        ELSE
          CALL sgesv(3, 1, a_2, 3, ipiv3, b_2, 3, info)
        ENDIF
        x_2(1:3) = b_2(1:3)
#else 
        WRITE(6,*) "Error: Blas/Lapack required for /FAIL/BIQUAD"
#endif
C
c------------
       RETURN