create_h3d_parts.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	create_h3d_parts (h3d_data, id_input, ipart, igrpart)

Function/Subroutine Documentation

create_h3d_parts()

subroutine create_h3d_parts	(	type (h3d_database)	h3d_data,
		integer	id_input,
		integer, dimension(lipart1,*)	ipart,
		type(group_), dimension(ngrpart), intent(in)	igrpart )

Definition at line 34 of file create_h3d_parts.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE names_and_titles_mod, ONLY: ncharline100
      USE h3d_mod
      USE groupdef_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"
#include      "scr17_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE (H3D_DATABASE) :: H3D_DATA
      INTEGER ID_INPUT
      INTEGER IPART(LIPART1,*)
      TYPE(GROUP_)  ,DIMENSION(NGRPART) ,INTENT(IN) :: IGRPART
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER NVAR
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      CHARACTER(LEN=NCHARLINE100) :: CARTE
      CHARACTER(LEN=NCHARLINE100) :: CARTE1
      INTEGER I,J,K,L,M,N_H3D_PART,INDEX
C=========================================================================
 
      n_h3d_part = h3d_data%INPUT_LIST(id_input)%NB_PART
 
      
      IF (n_h3d_part /= 0 )
     .       ALLOCATE(h3d_data%PARTS(1)%PART_LIST(n_h3d_part))
c
      ALLOCATE(h3d_data%PARTS(1)%PART(npart))
c
      IF (n_h3d_part /= 0 ) THEN
        DO i=1,npart
          h3d_data%PARTS(1)%PART(i) = 0
        ENDDO
      ELSE
        DO i=1,npart
          h3d_data%PARTS(1)%PART(i) = 1
        ENDDO
      ENDIF
 
      DO j=1,n_h3d_part
        IF(h3d_data%INPUT_LIST(id_input)%PART_LIST(j) > 0) THEN
          ! Find the part with this ID
          DO i=1,npart
            IF(h3d_data%INPUT_LIST(id_input)%PART_LIST(j) == ipart(4,i)) THEN
                h3d_data%PARTS(1)%PART(i) = 1
            ENDIF
          ENDDO
        ELSE
          ! Negative value refers to a part group
          l = -h3d_data%INPUT_LIST(id_input)%PART_LIST(j)  ! Get positive index of part group
            index = 0
            DO i=1,ngrpart
              IF(igrpart(i)%ID == l) THEN
                index = i
                EXIT
              ENDIF
            ENDDO
            IF(index > 0) THEN
              DO i=1,igrpart(index)%NENTITY
                k = igrpart(index)%ENTITY(i)  ! Get the part ID from the group
                ! Find the part with this ID
                DO m=1,npart
                  IF (ipart(4,m) == k) THEN
                    h3d_data%PARTS(1)%PART(m) = 1
                    EXIT
                  ENDIF
                ENDDO
              ENDDO
            ENDIF
        ENDIF
      ENDDO
 
      RETURN
 999  print *,'error lecture'
      CALL arret(0)