w_cluster.F File Reference

#include "implicit_f.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	w_cluster (cluster)

Function/Subroutine Documentation

w_cluster()

subroutine w_cluster

(

type (cluster_), dimension(ncluster)

cluster

)

Definition at line 33 of file w_cluster.F.

C-----------------------------------------------
C  Description:
C        -IN: Array of CLUSTER structures 
C        -OUT: nothing
C  Writes the structure into the restart file
C  (reading done READ_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,K, IEL, NEL,NELG, NNOD
      INTEGER II,IFAIL,ITY,ID,RL,IL
      INTEGER ILCLUSTER(NCLUSTER),RLCLUSTER(NCLUSTER)
      INTEGER RLCLUSTER_MAX,ILCLUSTER_MAX
      my_real,
     .   DIMENSION(:), ALLOCATABLE :: rcltab  
      INTEGER, DIMENSION(:), ALLOCATABLE :: ICLTAB
C=======================================================================
 
      IF(ncluster > 0) THEN
        ilcluster(1:ncluster)  = 0 
        rlcluster(1:ncluster) =  zero
      ENDIF
      rlcluster_max = 0
      ilcluster_max = 0
   
      DO i = 1, ncluster
        ity   = cluster(i)%TYPE
        nel   = cluster(i)%NEL
        nnod  = cluster(i)%NNOD
        ifail = cluster(i)%IFAIL
        ilcluster(i) = 8 + 2 * (nel + nnod)
        rlcluster(i) = 1 
        IF (ifail > 0) rlcluster(i) = rlcluster(i) + 4 
        IF (ifail == 3) rlcluster(i) = rlcluster(i) + 8  
        IF ( rlcluster_max < rlcluster(i) ) THEN 
          rlcluster_max = rlcluster(i)
        ENDIF 
        IF ( ilcluster_max < ilcluster(i) ) THEN 
          ilcluster_max = ilcluster(i)
        ENDIF 
      ENDDO !NCLUSTER
 
      IF(ncluster > 0) THEN
        CALL write_i_c(ilcluster,ncluster)
        CALL write_i_c(rlcluster,ncluster)
        ALLOCATE (icltab(ilcluster_max)) ! Integer CLuster TABle
        ALLOCATE (rcltab(rlcluster_max)) ! Real CLuster TABle
      ENDIF
 
      DO i = 1, ncluster
        icltab(1:ilcluster(i)) = 0 
        rcltab(1:rlcluster(i)) = zero
        il = 0
        rl = 0
        icltab(il+1) = cluster(i)%ID
        icltab(il+2) = cluster(i)%TYPE
        icltab(il+3) = cluster(i)%IFAIL
        icltab(il+4) = cluster(i)%IGR
        icltab(il+5) = cluster(i)%NEL
        icltab(il+6) = cluster(i)%NNOD
        icltab(il+7) = cluster(i)%SKEW 
        icltab(il+8) = cluster(i)%OFF
        il = il + 8
        rcltab(rl+1) = cluster(i)%FAIL
        rl = rl + 1
        nel  = cluster(i)%NEL
        nnod = cluster(i)%NNOD
c
        DO j = 1,nel
          id = cluster(i)%ELEM(j)
          icltab(il + j)     = cluster(i)%NG(j) !element local group number
          icltab(il + j+nel) = id ! element index in the group
        ENDDO  ! J = 1,NEL
c
        il = il + nel*2      
        DO j = 1,nnod
          icltab(il + j)      = cluster(i)%NOD1(j)
          icltab(il + j+nnod) = cluster(i)%NOD2(j)
        ENDDO
 
        il = il + nnod*2      
        IF (cluster(i)%IFAIL > 0) THEN
          rcltab(rl + 1) = cluster(i)%FMAX(1)
          rcltab(rl + 2) = cluster(i)%FMAX(2)
          rcltab(rl + 3) = cluster(i)%MMAX(1)
          rcltab(rl + 4) = cluster(i)%MMAX(2)
          rl = rl + 4     
        ENDIF
 
        IF (cluster(i)%IFAIL == 3) THEN
          rcltab(rl + 1) = cluster(i)%AX(1)
          rcltab(rl + 2) = cluster(i)%AX(2)
          rcltab(rl + 3) = cluster(i)%AX(3)
          rcltab(rl + 4) = cluster(i)%AX(4)
          rcltab(rl + 5) = cluster(i)%NX(1)
          rcltab(rl + 6) = cluster(i)%NX(2)
          rcltab(rl + 7) = cluster(i)%NX(3)
          rcltab(rl + 8) = cluster(i)%NX(4)
        ENDIF
 
        CALL write_db(rcltab,rlcluster(i))
        CALL write_i_c(icltab,ilcluster(i))
 
      ENDDO  !  I = 1, NCLUSTER
 
      IF(ncluster > 0) THEN
        DEALLOCATE (rcltab)
        DEALLOCATE (icltab)
      ENDIF
 
 
C-----------
      RETURN