read_cluster.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/.
!||====================================================================
!||    read_cluster   ../engine/source/output/cluster/read_cluster.F
!||--- called by ------------------------------------------------------
!||    rdresb         ../engine/source/output/restart/rdresb.f
!||--- calls      -----------------------------------------------------
!||    read_db        ../common_source/tools/input_output/read_db.F
!||    read_i_c       ../common_source/tools/input_output/write_routtines.c
!||--- uses       -----------------------------------------------------
!||    cluster_mod    ../engine/share/modules/cluster_mod.F
!||====================================================================
      SUBROUTINE read_cluster(CLUSTER)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE cluster_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      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE (CLUSTER_) ,DIMENSION(NCLUSTER) :: CLUSTER
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,IL,RL,ITY,NEL,NNOD,IFAIL
      INTEGER ILCLUSTER_MAX, RLCLUSTER_MAX
      my_real, DIMENSION(:), ALLOCATABLE :: rcltab
      INTEGER, DIMENSION(:), ALLOCATABLE :: ICLTAB
      INTEGER, DIMENSION(NCLUSTER) :: ILCLUSTER,RLCLUSTER
 
C=======================================================================
 
      CALL read_i_c(ilcluster,ncluster)
      CALL read_i_c(rlcluster,ncluster)
      rlcluster_max = 0
      ilcluster_max = 0
      DO i = 1, ncluster
        IF ( rlcluster_max < rlcluster(i) ) THEN 
          rlcluster_max = rlcluster(i)
        ENDIF 
        IF ( ilcluster_max < ilcluster(i) ) THEN 
          ilcluster_max = ilcluster(i)
        ENDIF 
      ENDDO
 
      ALLOCATE (icltab(ilcluster_max)) ! Integer CLuster TABle
      ALLOCATE (rcltab(rlcluster_max)) ! Real CLuster TABle
 
      DO i = 1, ncluster
        rcltab = zero
        icltab = 0
        CALL read_db(rcltab,rlcluster(i))
        CALL read_i_c(icltab,ilcluster(i))
        il = 0
        rl = 0
        cluster(i)%ID      =   icltab(il+1) 
        cluster(i)%TYPE    =   icltab(il+2) 
        cluster(i)%IFAIL   =   icltab(il+3) 
        cluster(i)%IGR     =   icltab(il+4) 
        cluster(i)%NEL     =   icltab(il+5) 
        cluster(i)%NNOD    =   icltab(il+6) 
        cluster(i)%SKEW    =   icltab(il+7) 
        cluster(i)%OFF     =   icltab(il+8) 
        il = il + 8
        cluster(i)%FAIL    =   rcltab(rl+1) 
        rl = rl + 1
        nel   = cluster(i)%NEL
        nnod  = cluster(i)%NNOD
        ifail = cluster(i)%IFAIL 
        ALLOCATE (cluster(i)%NG(nel))
        ALLOCATE (cluster(i)%ELEM(nel))
        ALLOCATE (cluster(i)%NOD1(nnod))
        ALLOCATE (cluster(i)%NOD2(nnod))
        DO j = 1, nel
          cluster(i)%NG(j)   =  icltab(il + j)      !element  group number
          cluster(i)%ELEM(j) =  icltab(il + j+nel)  !element index in the group
        ENDDO  ! J = 1,NEL
        il = il + nel*2      
 
        DO j = 1, nnod
           cluster(i)%NOD1(j) = icltab(il + j)      
           cluster(i)%NOD2(j) = icltab(il + j+nnod) 
        ENDDO
 
        il = il + nnod*2      
        IF (cluster(i)%IFAIL > 0) THEN
          ALLOCATE (cluster(i)%FMAX(2))            
          ALLOCATE (cluster(i)%MMAX(2))     
          cluster(i)%FMAX(1) = rcltab(rl + 1)  
          cluster(i)%FMAX(2) = rcltab(rl + 2)  
          cluster(i)%MMAX(1) = rcltab(rl + 3)  
          cluster(i)%MMAX(2) = rcltab(rl + 4)  
          rl = rl + 4
        ELSE 
          ALLOCATE (cluster(i)%FMAX(2)) 
          ALLOCATE (cluster(i)%MMAX(2)) 
        ENDIF
        IF (cluster(i)%IFAIL == 3) THEN
          ALLOCATE (cluster(i)%AX(4)) 
          ALLOCATE (cluster(i)%NX(4))
          cluster(i)%AX(1) =  rcltab(rl + 1) 
          cluster(i)%AX(2) =  rcltab(rl + 2) 
          cluster(i)%AX(3) =  rcltab(rl + 3) 
          cluster(i)%AX(4) =  rcltab(rl + 4) 
          cluster(i)%NX(1) =  rcltab(rl + 5) 
          cluster(i)%NX(2) =  rcltab(rl + 6) 
          cluster(i)%NX(3) =  rcltab(rl + 7) 
          cluster(i)%NX(4) =  rcltab(rl + 8) 
        ELSE                                        
          ALLOCATE (cluster(i)%AX(0))                                    
          ALLOCATE (cluster(i)%NX(0))             
        ENDIF
      ENDDO  !  I = 1, NCLUSTER_L
 
      DEALLOCATE (rcltab)
      DEALLOCATE (icltab)
 
C-----------
      RETURN
      END