read_cluster.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	read_cluster (cluster)

Function/Subroutine Documentation

read_cluster()

subroutine read_cluster

(

type (cluster_), dimension(ncluster)

cluster

)

Definition at line 33 of file read_cluster.F.

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