kldim.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
#ifndef DNC
!||====================================================================
!||    kldim   ../engine/stub/kldim.F
!||====================================================================
      SUBROUTINE kldim(EIGIPM, EIGIBUF, NDOF  , LDIAG, LJDIK, 
     .                 LJDIK2, NDDL   , K_DIAG, K_LT , IADK , 
     .                 JDIK  , IKC    , NMS   , INLOC, IDDL )
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      "units_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER EIGIPM(*), EIGIBUF(*),NDOF(*), LDIAG, LJDIK, LJDIK2, 
     .        NDDL, IADK(*), JDIK(*), IKC(*), NMS, INLOC(*), IDDL(*)
      my_real
     .        k_diag(*), k_lt(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER ICT, ICR, NN1, NN2, BDOF(6), I, II, J, JD, ITAG(NDDL),
     .        NBDOF, IND_IB(NDDL), ITAGN(NUMNOD), N, ITAG2(NDDL)
C
      ict=eigipm(3)
      icr=eigipm(4)
      nn1=eigipm(10)
      nn2=eigipm(11)
      DO i=1,6
         bdof(i)=0
      ENDDO
      IF (ict==1) THEN
         bdof(3)=1
         nbdof=1
      ELSEIF (ict==2) THEN
         bdof(2)=1
         nbdof=1
      ELSEIF (ict==3) THEN
         bdof(2)=1
         bdof(3)=1
         nbdof=2
      ELSEIF (ict==4) THEN
         bdof(1)=1
         nbdof=1
      ELSEIF (ict==5) THEN
         bdof(1)=1
         bdof(3)=1
         nbdof=2
      ELSEIF (ict==6) THEN
         bdof(1)=1
         bdof(2)=1
         nbdof=2
      ELSEIF (ict==7) THEN
         bdof(1)=1
         bdof(2)=1
         bdof(3)=1
         nbdof=3
      ENDIF    
      IF (icr==1) THEN
         bdof(6)=1
         nbdof=nbdof+1
      ELSEIF (icr==2) THEN
         bdof(5)=1
         nbdof=nbdof+1
      ELSEIF (icr==3) THEN
         bdof(5)=1
         bdof(6)=1
         nbdof=nbdof+2
      ELSEIF (icr==4) THEN
         bdof(4)=1
         nbdof=nbdof+1
      ELSEIF (icr==5) THEN
         bdof(4)=1
         bdof(6)=1
         nbdof=nbdof+2
      ELSEIF (icr==6) THEN
         bdof(4)=1
         bdof(5)=1
         nbdof=nbdof+2
      ELSEIF (icr==7) THEN
         bdof(4)=1
         bdof(5)=1
         bdof(6)=1
         nbdof=nbdof+3
      ENDIF
C
      DO i=1,numnod
         itagn(i)=0
      ENDDO
      DO i=1,nn1
         ii=eigibuf(i)
         itagn(ii)=1
      ENDDO
      DO i=1,nn2
         ii=eigibuf(nn1+i)
         itagn(ii)=2
      ENDDO
C
      DO i=1,nddl
         itag(i)=0
      ENDDO
      nms=0
      DO i=1,numnod
         n=inloc(i)
         ii=iddl(n)
         IF (itagn(n)==1) THEN
            DO j=1,ndof(n)
               itag(ii+j)=1
            ENDDO
         ELSEIF (itagn(n)==2) THEN
            DO j=1,ndof(n)
               IF (ikc(ii+j)<1.AND.bdof(j)==1) nms=nms+1
               itag(ii+j)=bdof(j)+1
            ENDDO
         ENDIF
         DO j=1,ndof(n)
            IF (ikc(ii+j)>=1) itag(ii+j)=-1
         ENDDO
      ENDDO
C Elimination des ddls bloques dans la liste
      DO i=1,nddl
         itag2(i)=itag(i)
         itag(i)=0
      ENDDO
      ii=0
      DO i=1,nddl
         IF (itag2(i)>=0) THEN
            ii=ii+1
            itag(ii)=itag2(i)
         ENDIF
      ENDDO
C
      DO i=1,nddl
         ind_ib(i)=0
      ENDDO
      ldiag=0
      ljdik=0
      ljdik2=0
      DO i=1,nddl
         IF (itag(i)>=1) THEN
            ldiag=ldiag+1
            DO j=iadk(i),iadk(i+1)-1
               jd=jdik(j)
               IF (itag(jd)>=1) THEN
                  ljdik=ljdik+1
                  IF (itag(jd)==2.AND.itag(i)==1) 
     .                              ind_ib(i)=ind_ib(i)+1
                  IF (itag(jd)==1.AND.itag(i)==2) 
     .                              ind_ib(jd)=ind_ib(jd)+1
               ENDIF
            ENDDO
         ENDIF
      ENDDO
      DO i=1,nddl
         ljdik2=ljdik2+ind_ib(i)
      ENDDO
C
      RETURN
      END   
#endif