cm58in3.F File Reference

#include "implicit_f.inc"
#include "vect01_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	cm58in3 (irep, dir1, dir2, uparam, uvar, aldt, nel, nuvar, tan_phi, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)

Function/Subroutine Documentation

cm58in3()

subroutine cm58in3	(	integer	irep,
			dir1,
			dir2,
			uparam,
			uvar,
			aldt,
		integer	nel,
		integer	nuvar,
			tan_phi,
		intent(in)	x1,
		intent(in)	x2,
		intent(in)	x3,
		intent(in)	x4,
		intent(in)	y1,
		intent(in)	y2,
		intent(in)	y3,
		intent(in)	y4,
		intent(in)	z1,
		intent(in)	z2,
		intent(in)	z3,
		intent(in)	z4,
		intent(in)	e1x,
		intent(in)	e2x,
		intent(in)	e3x,
		intent(in)	e1y,
		intent(in)	e2y,
		intent(in)	e3y,
		intent(in)	e1z,
		intent(in)	e2z,
		intent(in)	e3z )

Definition at line 30 of file cm58in3.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "vect01_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NEL,NUVAR,IREP
C     REAL
      my_real uparam(*),uvar(nel,*),aldt(nel),tan_phi(nel),dir1(nel,2),dir2(nel,2)
      my_real, DIMENSION(NEL), INTENT(IN) :: e1x,e2x,e3x,e1y,e2y,e3y,e1z,e2z,e3z,
     .                                       x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
      my_real
     .   r,s,d1,d2,d11,d12,d21,d22,u1x,u1y,u2x,u2y,det,w1x,w2x,w1y,w2y,
     .   phi,csp,snp,tana,r1,r2,s1,s2,g0,aa,bb,suma,v1,v2,v3,wr,ws
      my_real , DIMENSION(NEL) :: e11,e12,e13,e21,e22,e23
C======================================================================|
C---  isoparametric (material) axes        
      IF (ity == 3) THEN                   
C---    shell 4N                           
        DO i=1,nel                       
          e11(i)= x2(i)+x3(i)-x1(i)-x4(i)  
          e12(i)= y2(i)+y3(i)-y1(i)-y4(i)  
          e13(i)= z2(i)+z3(i)-z1(i)-z4(i)  
          e21(i)= x3(i)+x4(i)-x1(i)-x2(i)  
          e22(i)= y3(i)+y4(i)-y1(i)-y2(i)  
          e23(i)= z3(i)+z4(i)-z1(i)-z2(i)  
        ENDDO                              
      ELSEIF (ity == 7) THEN                              
C---    shell 3N                           
        DO i=1,nel                       
          e11(i)= x2(i)-x1(i)              
          e12(i)= y2(i)-y1(i)              
          e13(i)= z2(i)-z1(i)              
          e21(i)= x3(i)-x1(i)              
          e22(i)= y3(i)-y1(i)              
          e23(i)= z3(i)-z1(i)              
        ENDDO                              
      ENDIF                                
C------  Initialise UVAR 
      g0    = uparam(13)                                               
      DO i=1,nel
        aa = dir1(i,1)                                                     
        bb = dir1(i,2)                                                     
        v1 = aa*e11(i) + bb*e21(i)                                         
        v2 = aa*e12(i) + bb*e22(i)                                         
        v3 = aa*e13(i) + bb*e23(i)                                         
        wr = v1*e1x(i)+ v2*e1y(i) + v3*e1z(i)                              
        ws = v1*e2x(i)+ v2*e2y(i) + v3*e2z(i)                              
        suma = max( sqrt(wr*wr + ws*ws), em20)                             
        r1 = wr/suma                                                       
        s1 = ws/suma                                                       
        aa = dir2(i,1)                                                     
        bb = dir2(i,2)                                                     
        v1 = aa*e11(i) + bb*e21(i)                                         
        v2 = aa*e12(i) + bb*e22(i)                                         
        v3 = aa*e13(i) + bb*e23(i)                                         
        wr = v1*e1x(i)+ v2*e1y(i) + v3*e1z(i)                              
        ws = v1*e2x(i)+ v2*e2y(i) + v3*e2z(i)                              
        suma = max( sqrt(wr*wr + ws*ws), em20)                             
        r2   = wr/suma
        s2   = ws/suma
        tana = (r1*r2 + s1*s2) / (r1*s2 - r2*s1)   ! Tan(alpha_totale)     
c
        uvar(i,1:nuvar) = zero                                                 
        uvar(i,6)  = tana                                                  
        tan_phi(i) = tana                                                  
        uvar(i,10) = tana*g0                                               
        uvar(i,14) = aldt(i)                                               
        uvar(i,40) = one                                               
      ENDDO                                                                
C----
      RETURN