starter_2source_2restart_2ddsplit_2w__cluster_8F_source.html

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/.

!||====================================================================

!||    w_cluster     ../starter/source/restart/ddsplit/w_cluster.F

!||--- called by ------------------------------------------------------

!||    ddsplit       ../starter/source/restart/ddsplit/ddsplit.F

!||--- calls      -----------------------------------------------------

!||--- uses       -----------------------------------------------------

!||    cluster_mod   ../starter/share/modules1/cluster_mod.F

!||====================================================================


      SUBROUTINE w_cluster(CLUSTER,IPARG,NODLOCAL,

     .                     NCLUSTER_L,CEP,PROC,

     .                     NUMLOCGROUP, LEN_IA,LEN_AM )

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      "param_c.inc"

#include      "com01_c.inc"

#include      "com04_c.inc"

C-----------------------------------------------

C   D u m m y   A r g u m e n t s

C-----------------------------------------------

      INTEGER CEP(*),NODLOCAL(*),IPARG(NPARG,*)

      INTEGER NCLUSTER_L,PROC,LEN_IA,LEN_AM

      INTEGER :: NUMLOCGROUP(NGROUP)

      TYPE (CLUSTER_) ,DIMENSION(NCLUSTER) :: CLUSTER

C-----------------------------------------------

C   L o c a l  V a r i a b l e s

C-----------------------------------------------

      INTEGER I,II,J,K,ID,NEL,NG,NELG,NNOD,NFT,ITY,IFAIL

      INTEGER IL, RL

      INTEGER ESHIFT(3), ILCLUSTER_MAX, RLCLUSTER_MAX

      my_real, DIMENSION(:), ALLOCATABLE :: rcltab

      INTEGER, DIMENSION(:), ALLOCATABLE :: ICLTAB,INDX,ILCLUSTER,RLCLUSTER


C=======================================================================

      eshift(1) = 0                                   ! brick  cluster

      eshift(2) = numels+numelq+numelc+numelt+numelp  ! spring cluster

      eshift(3) = numels+numelq+numelc+numelt+numelp  ! spring cluster special

      ALLOCATE(indx(ncluster_l)) ! INDeXes of local clusters

      ALLOCATE(ilcluster(ncluster_l)) ! Integer Lengths of local CLUSTERs

      ALLOCATE(rlcluster(ncluster_l)) ! Real Lengths of local CLUSTERs

      j = 0

      ilcluster(1:ncluster_l)  = 0

      rlcluster(1:ncluster_l) =  0

      rlcluster_max = 0

      ilcluster_max = 0


      DO i = 1, ncluster

        ity   = cluster(i)%TYPE

        IF ( cep(cluster(i)%ELEM(1) + eshift(ity)) ==  proc ) THEN

          j = j + 1

          nel   = cluster(i)%NEL

          nnod  = cluster(i)%NNOD

          ifail = cluster(i)%IFAIL

          ilcluster(j) = 8 + 2 * (nel + nnod)

          rlcluster(j) = 1

          IF (ifail > 0) rlcluster(j) = rlcluster(j) + 4

          IF (ifail == 3) rlcluster(j) = rlcluster(j) + 8

          indx(j) = i

          IF ( rlcluster_max < rlcluster(j) ) THEN

            rlcluster_max = rlcluster(j)

          ENDIF

          IF ( ilcluster_max < ilcluster(j) ) THEN

            ilcluster_max = ilcluster(j)

          ENDIF

        ENDIF

      ENDDO

c-----

      CALL write_i_c(ilcluster,ncluster_l)

      len_ia = len_ia + ncluster_l

      CALL write_i_c(rlcluster,ncluster_l)

      len_ia = len_ia + ncluster_l

c-----

      ALLOCATE (icltab(ilcluster_max)) ! Integer CLuster TABle

      ALLOCATE (rcltab(rlcluster_max)) ! Real CLuster TABle

      DO i = 1, ncluster_l

        ii = indx(i) ! global number of the cluster


!        ICLTAB(1:ILCLUSTER(I)) = 0

!        RCLTAB(1:RLCLUSTER(I)) = ZERO


        il = 0

        rl = 0

        icltab(il+1) = cluster(ii)%ID

        icltab(il+2) = cluster(ii)%TYPE

        icltab(il+3) = cluster(ii)%IFAIL

        icltab(il+4) = cluster(ii)%IGR

        icltab(il+5) = cluster(ii)%NEL

        icltab(il+6) = cluster(ii)%NNOD

        icltab(il+7) = cluster(ii)%SKEW

        icltab(il+8) = cluster(ii)%OFF

        il = il + 8

        rcltab(rl+1) = cluster(ii)%FAIL

        rl = rl + 1

        nel  = cluster(ii)%NEL

        nnod = cluster(ii)%NNOD

c

        DO j = 1,nel

          id = cluster(ii)%ELEM(j)

          k = 0

          DO ng = 1,ngroup

            nelg = iparg(2,ng)

            nft  = iparg(3,ng)

            ity  = iparg(5,ng)

            IF (ity == 1 .AND. cluster(ii)%TYPE == 1) THEN

              k = id - nft

              IF (k <= nelg) GOTO 100

            ELSEIF (ity == 6 .AND. cluster(ii)%TYPE == 2) THEN

              k = id - nft

              IF (k <= nelg) GOTO 100

            ENDIF

          ENDDO  ! NG = 1,NGROUP

 100      CONTINUE

          icltab(il + j)     = numlocgroup(ng) !element local group number

          icltab(il + j+nel) = k  ! element index in the group

        ENDDO  ! J = 1,NEL

c

        il = il + nel*2

        DO j = 1,nnod

          icltab(il + j)      = nodlocal(cluster(ii)%NOD1(j))

          icltab(il + j+nnod) = nodlocal(cluster(ii)%NOD2(j))

        ENDDO

        il = il + nnod*2

c------------------------------

        IF (cluster(ii)%IFAIL > 0) THEN

          rcltab(rl + 1) = cluster(ii)%FMAX(1)

          rcltab(rl + 2) = cluster(ii)%FMAX(2)

          rcltab(rl + 3) = cluster(ii)%MMAX(1)

          rcltab(rl + 4) = cluster(ii)%MMAX(2)

          rl = rl + 4

        ENDIF

        IF (cluster(ii)%IFAIL == 3) THEN

          rcltab(rl + 1) = cluster(ii)%AX(1)

          rcltab(rl + 2) = cluster(ii)%AX(2)

          rcltab(rl + 3) = cluster(ii)%AX(3)

          rcltab(rl + 4) = cluster(ii)%AX(4)

          rcltab(rl + 5) = cluster(ii)%NX(1)

          rcltab(rl + 6) = cluster(ii)%NX(2)

          rcltab(rl + 7) = cluster(ii)%NX(3)

          rcltab(rl + 8) = cluster(ii)%NX(4)

          rl = rl + 8

        ENDIF

!       ------------------

!       check if I/R CLTAB is fully initialized

        IF(il< ilcluster(i)) icltab(il+1:ilcluster(i)) = 0

        IF(rl<rlcluster(i)) rcltab(rl+1:rlcluster(i)) = zero

!       ------------------

c-----

        CALL write_db(rcltab,rlcluster(i))

        len_am = len_am + rlcluster(i)

        CALL write_i_c(icltab,ilcluster(i))

        len_ia = len_ia + ilcluster(i)


c-----

      ENDDO  !  I = 1, NCLUSTER_L

      DEALLOCATE (indx)

      DEALLOCATE (ilcluster)

      DEALLOCATE (rlcluster)

      DEALLOCATE (rcltab)

      DEALLOCATE (icltab)


C-----------

      RETURN


      END


!||====================================================================

!||    c_cluster     ../starter/source/restart/ddsplit/w_cluster.F

!||--- called by ------------------------------------------------------

!||    ddsplit       ../starter/source/restart/ddsplit/ddsplit.F

!||--- uses       -----------------------------------------------------

!||    cluster_mod   ../starter/share/modules1/cluster_mod.F

!||====================================================================


      SUBROUTINE c_cluster(CLUSTERS,PROC,CEP,NCLUSTER_L,CLUSTERS_ID_L)

C Count the number of clusters per PROC

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-----------------------------------------------

      INTEGER PROC, NCLUSTER_L

      INTEGER CEP(*), CLUSTERS_ID_L(NCLUSTER)

      TYPE (CLUSTER_) ,DIMENSION(NCLUSTER) :: CLUSTERS

C-----------------------------------------------

C   L o c a l  V a r i a b l e s

C-----------------------------------------------

      INTEGER  I,OFF

C=======================================================================

      ncluster_l = 0

      clusters_id_l(1:ncluster) = 0

      DO i = 1,ncluster

        off = 0

        IF (clusters(i)%TYPE /= 1) THEN

          off = numels+numelq+numelc+numelt+numelp

        END IF

        IF (cep(clusters(i)%ELEM(1)+off) == proc) THEN

          ncluster_l = ncluster_l + 1

c    Local ID of the Ith global cluster

          clusters_id_l(i) = ncluster_l

        END IF

      END DO

      RETURN


      END

!||====================================================================

!||    applysort2cluster   ../starter/source/restart/ddsplit/w_cluster.F

!||--- uses       -----------------------------------------------------

!||    cluster_mod         ../starter/share/modules1/cluster_mod.F

!||====================================================================


      SUBROUTINE applysort2cluster(CLUSTERS,PERMUTATIONS)

C Apply the new numbering (given in permutations) to the elements of clusters

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-----------------------------------------------

      INTEGER PERMUTATIONS(*)

      TYPE (CLUSTER_) ,DIMENSION(NCLUSTER) :: CLUSTERS

C-----------------------------------------------

C   L o c a l  V a r i a b l e s

C-----------------------------------------------

      INTEGER  I, J, OFFSET

C=======================================================================


      DO i = 1, ncluster

        offset = 0

        IF (clusters(i)%TYPE /= 1) THEN

          offset = numels+numelq+numelc+numelt+numelp

        END IF

        DO j = 1, clusters(i)%NEL

          clusters(i)%ELEM(j) = permutations(clusters(i)%ELEM(j))

        END DO

      END DO

      RETURN


      END

my_real
#define my_real
Definition cppsort.cpp:32

cluster_mod
Definition cluster_mod.F:40

applysort2cluster
subroutine applysort2cluster(clusters, permutations)
Definition w_cluster.F:248

c_cluster
subroutine c_cluster(clusters, proc, cep, ncluster_l, clusters_id_l)
Definition w_cluster.F:203

w_cluster
subroutine w_cluster(cluster, iparg, nodlocal, ncluster_l, cep, proc, numlocgroup, len_ia, len_am)
Definition w_cluster.F:34

write_db
subroutine write_db(a, n)
Definition write_db.F:140

write_i_c
void write_i_c(int *w, int *len)
Definition write_routtines.c:645