tensor0.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	tensor0 (elbuf_tab, iparg, itens, pm, el2fa, nbf, tens, ipart, ipartsp)

Function/Subroutine Documentation

tensor0()

subroutine tensor0	(	type (elbuf_struct_), dimension(ngroup), target	elbuf_tab,
		integer, dimension(nparg,*)	iparg,
		integer	itens,
			pm,
		integer, dimension(*)	el2fa,
		integer	nbf,
			tens,
		integer, dimension(lipart1,*)	ipart,
		integer, dimension(*)	ipartsp )

Definition at line 30 of file tensor0.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE elbufdef_mod         
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      "com01_c.inc"                                             
#include      "param_c.inc"                                             
#include      "scr17_c.inc"
C-----------------------------------------------                        
C   D u m m y   A r g u m e n t s                                       
C-----------------------------------------------                        
C     REAL                                                    
      my_real                                                           
     .   tens(6,*),pm(npropm,*)                      
      INTEGER IPARG(NPARG,*),ITENS, EL2FA(*),                           
     .   NBF,IPART(LIPART1,*),IPARTSP(*)                      
      TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
C-----------------------------------------------                        
      REAL R4(18),WA(6*NBF)                                                      
      INTEGER I,II(6),J,N,  NG, NEL, IPT, MT1, MLW,NN1,IPRT,JJ
      TYPE(G_BUFEL_) ,POINTER :: GBUF     
      TYPE(L_BUFEL_) ,POINTER :: LBUF     
C=======================================================================
      DO j=1,18                                                      
        r4(j) = zero                                                 
      ENDDO                                                         
C                                                                       
      nn1 = 1                                                           
c      NN2 = NN1 + (NUMSPH+MAXPJET)                                      
C                                                                       
      DO 490 ng=1,ngroup                                               
              mlw = iparg(1,ng)
        nel = iparg(2,ng)                                            
        nft = iparg(3,ng)
        ity = iparg(5,ng)
        lft=1                                                           
        llt=nel                                                         
!
        DO i=1,6
          ii(i) = (i-1)*nel
        ENDDO
!
C-----------------------------------------------                        
        IF (ity == 51) THEN                                               
C         PARTICULES SPH.                                               
C-----------------------------------------------                        
          gbuf => elbuf_tab(ng)%GBUF
          lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
          iprt=ipartsp(1 + nft)                                         
          mt1 =ipart(1,iprt)                                            
C-----------------------------------------------                        
          IF(itens == 1)THEN                                            
C          STRESS                                                       
C-----------------------------------------------                        
           DO i=lft,llt                                                 
             n = i + nft                                                
             IF(el2fa(nn1+n)/=0)THEN                                  
               tens(1,el2fa(nn1+n)) = gbuf%SIG(ii(1) + i)
               tens(2,el2fa(nn1+n)) = gbuf%SIG(ii(2) + i)
               tens(3,el2fa(nn1+n)) = gbuf%SIG(ii(3) + i)
               tens(4,el2fa(nn1+n)) = gbuf%SIG(ii(4) + i)
               tens(5,el2fa(nn1+n)) = gbuf%SIG(ii(5) + i)
               tens(6,el2fa(nn1+n)) = gbuf%SIG(ii(6) + i)
             ENDIF                                                      
           ENDDO                                                        
C-----------------------------------------------                        
          ELSEIF (itens == 4 .AND. mlw == 24 .AND.                              
     .            nint(pm(56,mt1)) == 1) THEN              
C          CRACKS                                                       
C-----------------------------------------------                        
           DO i=lft,llt                                                 
             n = i + nft                                                
             IF(el2fa(nn1+n)/=0)THEN                                  
               tens(1,el2fa(nn1+n)) =  lbuf%DGLO(ii(1) + i)
               tens(2,el2fa(nn1+n)) =  lbuf%DGLO(ii(2) + i)
               tens(3,el2fa(nn1+n)) =  lbuf%DGLO(ii(3) + i)        
               tens(4,el2fa(nn1+n)) =  lbuf%DGLO(ii(4) + i)
               tens(5,el2fa(nn1+n)) =  lbuf%DGLO(ii(5) + i)
               tens(6,el2fa(nn1+n)) =  lbuf%DGLO(ii(6) + i)
             ENDIF                                                      
           ENDDO                                                        
          ELSE                                                          
C-----------------------------------------------                        
           DO i=lft,llt                                                 
             n = i + nft                                                
             IF(el2fa(nn1+n)/=0)THEN                                  
               tens(1,el2fa(nn1+n)) = zero                              
               tens(2,el2fa(nn1+n)) = zero                              
               tens(3,el2fa(nn1+n)) = zero                              
               tens(4,el2fa(nn1+n)) = zero                              
               tens(5,el2fa(nn1+n)) = zero                              
               tens(6,el2fa(nn1+n)) = zero                              
             ENDIF                                                      
           ENDDO                                                        
          ENDIF                                                         
C-----------------------------------------------                        
        ELSE                                                            
        ENDIF                                                           
 490   CONTINUE                                                         
 500  CONTINUE                                                          
C-----------------------------------------------                        
      DO n=1,nbf                                                        
        r4(1) = tens(1,n)                                               
        r4(2) = tens(2,n)                                               
        r4(3) = tens(3,n)                                               
        r4(4) = tens(4,n)                                               
        r4(5) = tens(5,n)                                               
        r4(6) = tens(6,n)                                               
        CALL write_r_c(r4,6)                                            
      ENDDO                                                             
C-----------------------------------------------                        
      RETURN