dsdim.F File Reference

#include "implicit_f.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr23_c.inc"
#include "sms_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	dsdim0 (ndof, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, kxx, ixx, geo)

Function/Subroutine Documentation

dsdim0()

subroutine dsdim0	(	integer, dimension(*)	ndof,
		integer, dimension(nixs,*)	ixs,
		integer, dimension(nixq,*)	ixq,
		integer, dimension(nixc,*)	ixc,
		integer, dimension(nixt,*)	ixt,
		integer, dimension(nixp,*)	ixp,
		integer, dimension(nixr,*)	ixr,
		integer, dimension(nixtg,*)	ixtg,
		integer, dimension(nixx,*)	kxx,
		integer, dimension(*)	ixx,
			geo )

Definition at line 29 of file dsdim.F.

      use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg,nixtg
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      "com04_c.inc"
#include      "param_c.inc"
#include      "scr23_c.inc"
#include      "sms_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NDOF(*), IXS(NIXS,*), IXQ(NIXQ,*), IXC(NIXC,*), 
     .        IXT(NIXT,*), IXP(NIXP,*), IXR(NIXR,*),
     .        IXTG(NIXTG,*), KXX(NIXX,*), IXX(*)
      my_real
     .        geo(npropg,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, IEL, J, N, IGTYP, NN
      INTEGER, DIMENSION(:), ALLOCATABLE :: TAG8
 
      ALLOCATE(tag8(numnod))
C
C Filling of ndof (see dim_glob_k in engine)
C
      DO i=1,numnod
         ndof(i)=0
      ENDDO
C
      IF(isms==0)THEN
C----   IMPLICIT
        DO iel=1,numels
           DO j=1,8
              n=ixs(j+1,iel)
              IF(n/=0)ndof(n)=3
           ENDDO
        ENDDO
        DO iel=1,numelt
           DO j=1,2
              n=ixt(j+1,iel)
              IF(n/=0)ndof(n)=3
           ENDDO
        ENDDO
        DO iel=1,numelc
           DO j=1,4
              n=ixc(j+1,iel)
              IF(n/=0)ndof(n)=6
           ENDDO
        ENDDO
        DO iel=1,numeltg
           DO j=1,3
              n=ixtg(j+1,iel)
              IF(n/=0)ndof(n)=6
           ENDDO
        ENDDO
        DO iel=1,numelp
           DO j=1,2
              n=ixp(j+1,iel)
              IF(n/=0)ndof(n)=6
           ENDDO
        ENDDO
        DO iel=1,numelr
           igtyp= nint(geo(12,ixr(1,iel)))
           IF (igtyp==8.OR.igtyp==13 .OR. igtyp == 23) THEN
              DO j=1,2
                 n=ixr(j+1,iel)
                 IF(n/=0)ndof(n)=6
              ENDDO
           ELSEIF (igtyp==4) THEN
              DO j=1,2
                 n=ixr(j+1,iel)
                 IF(n/=0)ndof(n)=max(ndof(n),3)
              ENDDO
           ENDIF
        ENDDO
C
C      DO I=1,NRBYKIN
C         N=NPBY(1,I)
C         IF(N/=0)NDOF(N)=6
C      ENDDO
C
      ELSE
C----   AMS
        DO iel=1,numels
          DO j=1,8                               
            n = ixs(j+1,iel) 
            IF(n/=0)tag8(n)=0
          ENDDO
          nn=0                           
          DO j=1,8                               
            n = ixs(j+1,iel) 
            IF(n/=0)THEN
              IF(tag8(n)==0)THEN
                nn=nn+1
                tag8(n)=1
              END IF                  
            END IF                  
          ENDDO                                    
          DO j=1,8                               
            n = ixs(j+1,iel) 
            IF(n/=0)tag8(n)=0
          ENDDO                                    
          DO j=1,8                               
            n = ixs(j+1,iel) 
            IF(n/=0)THEN
              IF(tag8(n)==0)THEN
                ndof(n)=nn-1
                tag8(n)=1
              END IF                  
            END IF                  
          ENDDO                                    
        ENDDO
        DO iel=1,numelt
           DO j=1,2
              n=ixt(j+1,iel)
              IF(n/=0)ndof(n)=1
           ENDDO
        ENDDO
        DO iel=1,numelc
           DO j=1,4
              n=ixc(j+1,iel)
              IF(n/=0)ndof(n)=3
           ENDDO
        ENDDO
        DO iel=1,numeltg
           DO j=1,3
              n=ixtg(j+1,iel)
              IF(n/=0)ndof(n)=2
           ENDDO
        ENDDO
        DO iel=1,numelp
           DO j=1,2
              n=ixp(j+1,iel)
              IF(n/=0)ndof(n)=1
           ENDDO
        ENDDO
        DO iel=1,numelr
           igtyp= nint(geo(12,ixr(1,iel)))
           IF (igtyp==8.OR.igtyp==13 .OR. igtyp == 23) THEN
              DO j=1,2
                 n=ixr(j+1,iel)
                 IF(n/=0)ndof(n)=1
              ENDDO
           ELSEIF (igtyp==4) THEN
              DO j=1,2
                 n=ixr(j+1,iel)
                 IF(n/=0)ndof(n)=1
              ENDDO
           ENDIF
        ENDDO
      END IF
      DEALLOCATE(tag8)
      RETURN