fr.F File Reference

#include "implicit_f.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	frv (s1, s2, s3, s4, s5, s6, sm, vk0, vk, rob, fc, rt, rc, rct1, rct2, aa, ac, bc, bt, rok, tol, fa, nindex, index, ibug, nel, seq, icrit_outp)

Function/Subroutine Documentation

frv()

subroutine frv	(	dimension(nel)	s1,
		dimension(nel)	s2,
		dimension(nel)	s3,
		dimension(nel)	s4,
		dimension(nel)	s5,
		dimension(nel)	s6,
		dimension(nel)	sm,
		dimension(nel)	vk0,
		intent(out)	vk,
		dimension(nel)	rob,
			fc,
			rt,
			rc,
			rct1,
			rct2,
			aa,
			ac,
			bc,
			bt,
		dimension(nel)	rok,
			tol,
		dimension(nel)	fa,
		integer	nindex,
		integer, dimension(nel)	index,
		integer	ibug,
		integer	nel,
		dimension(nel)	seq,
		integer	icrit_outp )

Definition at line 28 of file fr.F.

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-----------------------------------------------
      INTEGER NINDEX, INDEX(NEL),ICRIT_OUTP
      my_real :: fc,rt,rc,rct1,rct2,aa,ac,bc,bt,tol
      my_real, DIMENSION(NEL) :: s1,s2,s3,s4,s5,s6,sm,vk0,rob,rok,fa,seq
      my_real, DIMENSION(NEL),INTENT(OUT):: vk
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, N, NEL, IBUG
      my_real  bb, df, rf, r2, aj3, cs3t
C=======================================================================
#include "vectorize.inc"
      DO n = 1,nindex
        i = index(n)
        IF (i > 0) THEN
          IF (sm(i) >= rt-tol ) THEN                                        
            vk(i) = one                                                               
          ELSEIF( sm(i) > rc ) THEN                                            
            vk(i) = one+(one-vk0(i))*(rct1-two*rc*sm(i)+sm(i)**2)/rct2       
          ELSEIF(sm(i) > rok(i))THEN                                              
            vk(i) = vk0(i)                                                           
          ELSE                                                                    
            vk(i) = vk0(i)*(one - ((sm(i)-rok(i))/(rob(i)-rok(i)))**2)                
          ENDIF                                                               
C
          IF (sm(i) > ac/aa) THEN                                           
            fa(i) = half*(sm(i)-ac/aa) / min(bc,bt)/fc           
          ELSEIF (sm(i) <= rob(i)) THEN                                           
            bb = max(bc,bt)                                                  
            df = sqrt(bb*bb-aa*rob(i)+ac)                                   
            rf = (-bb+df)/aa                                                   
            fa(i) = two*rf*(sm(i)-rob(i))/(rob(i)-rok(i))/fc                 
          ELSE                                                                    
            r2 = (s1(i)**2+s2(i)**2+s3(i)**2)+ two*s4(i)**2+two*s5(i)**2       
     .         + two*s6(i)**2                                                   
            IF (ibug == 0) THEN                                                   
              aj3 = s1(i)*s2(i)*s3(i)-s1(i)*s5(i)*s5(i)-s2(i)*s6(i)*s6(i)         
     .            - s3(i)*s4(i)*s4(i) + two*s4(i)*s5(i)*s6(i)                                       
            ELSE   ! old version                               
              aj3 = s1(i)*s2(i)*s3(i)-s1(i)*s5(i)*s5(i)-s2(i)*s6(i)*s6(i)         
     .            - s3(i)*s4(i)*s4(i)                                             
            ENDIF                                                                 
c
            cs3t = half * aj3*(three/(half*max(r2,em20)))**three_half                  
            cs3t = min(one,cs3t)                                                   
            cs3t = max(-one,cs3t)                                                  
            bb = half*((one -cs3t)*bc+(one +cs3t)*bt)                       
            df = sqrt(max(zero,bb*bb-aa*sm(i)+ac,zero))                     
            rf = (-bb+df)/aa                                                   
            fa(i)=(sqrt(r2)-vk(i)*rf)/fc                                          
c
!!            IF (ICRIT_OUTP == 0) THEN ! (EQUIVALENT STRESS)/CTITERION FOR OUTPUT  
!!              SEQ(I) = FA(I)                                               
!!              ICRIT_OUTP = 1                                                      
!!            ENDIF ! IF (ICRIT_OUTP == 0)                                          
          ENDIF                                                                   
c
        ENDIF                                                                   
      ENDDO
c-----------
      RETURN