assparxx.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/.
!||====================================================================
!||    assparxx   ../engine/source/assembly/assparxx.F
!||--- called by ------------------------------------------------------
!||    resol      ../engine/source/engine/resol.F
!||--- uses       -----------------------------------------------------
!||    tri7box    ../engine/share/modules/tri7box.F
!||====================================================================
      SUBROUTINE assparxx(ITSK,INTLIST,NBINTC,IPARI,NODADT_THERM) 
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE tri7box
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      "param_c.inc"
#include      "task_c.inc"
#include      "scr18_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ,INTENT(IN) :: NODADT_THERM
      INTEGER ITSK,NBINTC,INTLIST(*),IPARI(NPARI,*)
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER K,NIN,NODFI,ISHIFT,IG,NI,NTY,NODFTSK,NODLTSK,INTTH,NODFIE
C
 
      DO ni = 1,nbintc
         nin= intlist(ni)
         nty   =ipari(7,nin)
         intth = ipari(47,nin)
 
         IF(nty /= 7 .AND. nty /= 10 .AND. nty /= 11.AND. nty /= 24 .AND. nty /= 25 .AND. nty /= 20.AND. nty /= 23) cycle
         nodfi = nlskyfi(nin)
          
         nodftsk   = 1+itsk*nodfi/ nthread
         nodltsk   = (itsk+1)*nodfi/nthread
 
         DO k=2,nthread
 
            ishift = nodfi*(k-1)
 
            DO ig=nodftsk,nodltsk !LENR
              afi(nin)%P(1,ig)=afi(nin)%P(1,ig)+afi(nin)%P(1,ig+ishift)
              afi(nin)%P(2,ig)=afi(nin)%P(2,ig)+afi(nin)%P(2,ig+ishift)
              afi(nin)%P(3,ig)=afi(nin)%P(3,ig)+afi(nin)%P(3,ig+ishift)
              stnfi(nin)%P(ig)=stnfi(nin)%P(ig)+stnfi(nin)%P(ig+ishift)
C
              afi(nin)%P(1,ig+ishift) = zero
              afi(nin)%P(2,ig+ishift) = zero
              afi(nin)%P(3,ig+ishift) = zero
              stnfi(nin)%P(ig+ishift) = zero
            ENDDO
 
            IF (intth /=0)THEN
              DO ig=nodftsk,nodltsk !LENR
                fthefi(nin)%P(ig)=fthefi(nin)%P(ig)+fthefi(nin)%P(ig+ishift)
                fthefi(nin)%P(ig+ishift)=zero
 
                IF(nodadt_therm == 1 ) THEN  
                  condnfi(nin)%P(ig)=condnfi(nin)%P(ig)+condnfi(nin)%P(ig+ishift)
                  condnfi(nin)%P(ig+ishift)=zero
                ENDIF
              ENDDO
            ENDIF
 
            IF(kdtint/=0)THEN
              DO ig=nodftsk,nodltsk
                vscfi(nin)%P(ig)=vscfi(nin)%P(ig)+vscfi(nin)%P(ig+ishift)
                vscfi(nin)%P(ig+ishift)=zero
              ENDDO
            ENDIF
         ENDDO
 
         IF(nty==20 .OR. (nty==25 .AND. ipari(58,nin) > 0))THEN
            nodfie =  nlskyfie(nin)
            IF(nodfie > 0)THEN
               nodftsk   = 1+itsk*nodfie/ nthread
               nodltsk   = (itsk+1)*nodfie/nthread
 
               DO k=2,nthread
                 ishift = nodfie*(k-1)
                 DO ig=nodftsk,nodltsk !LENR
                   afie(nin)%P(1,ig)=afie(nin)%P(1,ig)+afie(nin)%P(1,ig+ishift)
                   afie(nin)%P(2,ig)=afie(nin)%P(2,ig)+afie(nin)%P(2,ig+ishift)
                   afie(nin)%P(3,ig)=afie(nin)%P(3,ig)+afie(nin)%P(3,ig+ishift)
                   stnfie(nin)%P(ig)=stnfie(nin)%P(ig)+stnfie(nin)%P(ig+ishift)
C
                   afie(nin)%P(1,ig+ishift) = zero
                   afie(nin)%P(2,ig+ishift) = zero
                   afie(nin)%P(3,ig+ishift) = zero
                   stnfie(nin)%P(ig+ishift) = zero
                 ENDDO
 
                 IF(kdtint/=0)THEN
                    DO ig=nodftsk,nodltsk
                     vscfie(nin)%P(ig)=vscfi(nin)%P(ig)+vscfie(nin)%P(ig+ishift)
                     vscfie(nin)%P(ig+ishift)=zero
                    ENDDO
                ENDIF
               ENDDO
 
                
            ENDIF
         ENDIF
      ENDDO
      
 
      RETURN
      END