parsorf.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	parsorf (iadd, iparg, ixt, ixp, ixr, mater, el2fa, ipartt, ipartp, ipartr, nfacptx, ixedge)

Function/Subroutine Documentation

parsorf()

subroutine parsorf	(	integer, dimension(*)	iadd,
		integer, dimension(nparg,*)	iparg,
		integer, dimension(nixt,*)	ixt,
		integer, dimension(nixp,*)	ixp,
		integer, dimension(nixr,*)	ixr,
		integer, dimension(*)	mater,
		integer, dimension(*)	el2fa,
		integer, dimension(*)	ipartt,
		integer, dimension(*)	ipartp,
		integer, dimension(*)	ipartr,
		integer, dimension(3,*)	nfacptx,
		integer, dimension(2,*)	ixedge )

Definition at line 30 of file parsorf.F.

      use element_mod , only : nixt,nixp,nixr                          
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      "com01_c.inc"                                             
#include      "com04_c.inc"                                             
#include      "param_c.inc"                                             
C-----------------------------------------------                        
C   D u m m y   A r g u m e n t s                                       
C-----------------------------------------------                        
      INTEGER IADD(*),IPARG(NPARG,*),                                   
     .        IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),                      
     .        MATER(*),EL2FA(*),                                        
     .        IPARTT(*),IPARTP(*),IPARTR(*),                            
     .        NFACPTX(3,*),IXEDGE(2,*)                                  
C-----------------------------------------------                        
      INTEGER II(4),IE,NG, ITY, LFT, LLT, N, I, J,                 
     .        IPRT, NEL, IAD, NPAR, NFT,MTN,                
     .        NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,JJ,NAX1D                                                     
C-----------------------------------------------                        
      ie = 0                                                            
C                                                                       
      nn1 = 1                                                           
      nn2 = 1                                                           
      nn3 = 1                                                           
      nn4 = nn3                                                         
      nn5 = nn4                                                         
      nn6 = nn5                                                         
      nn7 = nn6 + numelt                                                
      nn8 = nn7 + numelp                                                
c      NN9 = NN8 + NUMELR                                                
c      NN10= NN9                                                         
C-----------------------------------------------                        
      npar = 0                                                          
C-----------------------------------------------                        
C     PART                                                              
C-----------------------------------------------                        
      IF(numelp + numelt + numelr/=0)THEN                             
      jj = 0                                                            
      DO 500 iprt=1,npart                                               
       IF(mater(iprt)/=3)GOTO 500                                     
       IF(numelx>0)THEN                                              
         IF(nfacptx(1,iprt)>0)GOTO 500                               
       ENDIF                                                            
       npar = npar + 1                                                  
       DO 490 ng=1,ngroup                                               
        mtn   =iparg(1,ng)                                              
        nel   =iparg(2,ng)                                              
        nft   =iparg(3,ng)                                              
        iad   =iparg(4,ng)                                              
        ity   =iparg(5,ng)                                              
        lft=1                                                           
        llt=nel                                                         
C-----------------------------------------------                        
C       TRUSS                                                           
C-----------------------------------------------                        
        IF(ity==4)THEN                                                
         DO 140 i=lft,llt                                               
          n = i + nft                                                   
          IF(ipartt(n)/=iprt)GOTO 140                                 
          ii(1) = ixt(2,n)-1                                            
          ii(2) = ixt(3,n)-1                                            
          CALL write_i_c(ii,2)                                          
          ie = ie + 1                                                   
          el2fa(nn6+n) = ie                                             
          jj = jj + 2                                                   
 140     CONTINUE                                                       
C-----------------------------------------------                        
C       POUTRES                                                         
C-----------------------------------------------                        
        ELSEIF(ity==5)THEN                                            
         DO 150 i=lft,llt                                               
          n = i + nft                                                   
          IF(ipartp(n)/=iprt)GOTO 150                                 
          ii(1) = ixp(2,n)-1                                            
          ii(2) = ixp(3,n)-1                                            
          CALL write_i_c(ii,2)                                          
          ie = ie + 1                                                   
          el2fa(nn7+n) = ie                                             
          jj = jj + 2                                                   
 150     CONTINUE                                                       
C-----------------------------------------------                        
C       RESSORTS                                                        
C-----------------------------------------------                        
        ELSEIF(ity==6)THEN                                            
         DO 160 i=lft,llt                                               
          n = i + nft                                                   
          IF(ipartr(n)/=iprt)GOTO 160                                 
          ii(1) = ixr(2,n)-1                                            
          ii(2) = ixr(3,n)-1                                            
          CALL write_i_c(ii,2)                                          
          ie = ie + 1                                                   
          el2fa(nn8+n) = ie                                             
          jj = jj + 2                                                   
          IF(mtn==3)THEN                                              
            ii(1) = ixr(3,n)-1                                          
            ii(2) = ixr(4,n)-1                                          
            CALL write_i_c(ii,2)                                        
            ie = ie + 1                                                 
            jj = jj + 2                                                 
          ENDIF                                                         
 160     CONTINUE                                                       
        ELSE                                                            
        ENDIF                                                           
 490   CONTINUE                                                         
C-----------------------------------------------                        
C       PART ADRESS                                                     
C-----------------------------------------------                        
       iadd(npar) = ie                                                  
 500  CONTINUE                                                          
      ENDIF                                                             
C-----------------------------------------------                        
C     X-ELEMENTS PARTS ARE WRITTEN AFTER ALL (BUT RBODIES) 1D PARTS.   
C-----------------------------------------------                        
      IF (nanim1d>0) THEN                                            
      nax1d=0                                                           
      DO 600 iprt=1,npart                                               
       IF(mater(iprt)/=3)GOTO 600                                     
       IF(nfacptx(1,iprt)/=0) THEN                                    
         npar = npar + 1                                                
         DO j=1,nfacptx(1,iprt)                                         
          ii(1)=ixedge(1,nax1d+j)-1                                     
          ii(2)=ixedge(2,nax1d+j)-1                                     
          CALL write_i_c(ii,2)                                          
          jj = jj+2                                                     
         ENDDO                                                          
        nax1d=nax1d+nfacptx(1,iprt)                                     
        ie=ie+nfacptx(1,iprt)                                           
        iadd(npar)=ie                                                   
       ENDIF                                                            
 600  CONTINUE                                                          
      ENDIF                                                             
C-----------------------------------------------                        
      RETURN