create_node_clause.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	create_node_clause (clause, itabm1, jclause, opt_g, is_available, lsubmodel, opt_b, ibox, x, skew, set_title, keyset)
subroutine	create_node_list (clause, itabm1, jclause, is_available, lsubmodel)
subroutine	create_node_list_g (clause, itabm1, jclause, is_available, lsubmodel)

Function/Subroutine Documentation

create_node_clause()

subroutine create_node_clause	(	type (set_)	clause,
		integer, dimension(numnod,2), intent(in)	itabm1,
		integer	jclause,
		integer	opt_g,
		logical	is_available,
		type(submodel_data), dimension(*), intent(in)	lsubmodel,
		integer	opt_b,
		type (box_), dimension(nbbox)	ibox,
			x,
			skew,
		character(len=nchartitle)	set_title,
		character(len=ncharfield)	keyset )

Definition at line 36 of file create_node_clause.F.

C-----------------------------------------------
C   ROUTINE DESCRIPTION :
C   ===================
C   Treat the NODE Clause, read NODEs from HM_READER & fill clause
C   Calls CREATE_NODE_LIST (simple list)
C   Calls CREATE_NODE_LIST_G (NODE_G : All nodes from a MIN to MAX with increment)
C------------------------------------------------------------------
C   DUMMY ARGUMENTS DESCRIPTION:
C   ===================
C
C     NAME          DESCRIPTION                         
C
C     CLAUSE        (SET structure) Clause to be treated
C     ITABM1        MAP Table UID -> LocalID
C     JCLAUSE       parameter with HM_READER (current clause read)
C     Opt_G         Opt_G operator 1 if PART_G is set, 0 else
C     IS_AVAILABLE  Bool / Result of HM_interface
C     LSUBMODEL     SUBMODEL Structure.
C============================================================================
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE setdef_mod
      USE submodel_mod
      USE message_mod
      USE hm_option_read_mod
      USE optiondef_mod
      USE names_and_titles_mod , ONLY : ncharfield, nchartitle
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      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER JCLAUSE,OPT_G,OPT_B
      LOGICAL :: IS_AVAILABLE
      INTEGER, INTENT(IN), DIMENSION(NUMNOD,2) :: ITABM1
      my_real x(3,*),skew(lskew,*)
      CHARACTER(LEN=NCHARFIELD) :: KEYSET
      CHARACTER(LEN=NCHARTITLE) :: SET_TITLE
C-----------------------------------------------
      TYPE (SET_) ::  CLAUSE
      TYPE(SUBMODEL_DATA),INTENT(IN):: LSUBMODEL(*)
      TYPE (BOX_)  , DIMENSION(NBBOX)  :: IBOX
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
!
        IF ( opt_g == 1 ) THEN
 
             CALL create_node_list_g(clause,  itabm1  ,jclause ,is_available ,lsubmodel)
 
        ELSEIF ( opt_g == 0 .AND. opt_b == 0 ) THEN
 
             CALL create_node_list  (clause,  itabm1  ,jclause ,is_available ,lsubmodel)
 
        ELSEIF ( opt_b == 1 ) THEN
 
             CALL create_node_box   (clause  ,itabm1  ,jclause ,is_available ,lsubmodel,
     .                               ibox    ,x       ,skew    ,set_title    ,keyset   )
        ENDIF
C-----------------------------------------------

create_node_list()

subroutine create_node_list	(	type (set_)	clause,
		integer, dimension(numnod,2), intent(in)	itabm1,
		integer	jclause,
		logical	is_available,
		type(submodel_data), dimension(*), intent(in)	lsubmodel )

Definition at line 123 of file create_node_clause.F.

C-----------------------------------------------
C   ROUTINE DESCRIPTION :
C   ===================
C   Create NODE Clause from LIST
C------------------------------------------------------------------
C   DUMMY ARGUMENTS DESCRIPTION:
C   ===================
C
C     NAME          DESCRIPTION                         
C
C     CLAUSE        (SET structure) Clause to be treated
C     ITABM1        MAP Table UID -> LocalID
C     JCLAUSE       parameter with HM_READER (current clause read)
C     IS_AVAILABLE  Bool / Result of HM_interface
C     LSUBMODEL     SUBMODEL Structure.
C============================================================================
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE setdef_mod
      USE submodel_mod
      USE message_mod
      USE hm_option_read_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 JCLAUSE
      LOGICAL :: IS_AVAILABLE
      INTEGER, INTENT(IN), DIMENSION(NUMNOD,2) :: ITABM1
!
      TYPE (SET_) ::  CLAUSE
      TYPE(SUBMODEL_DATA),INTENT(IN):: LSUBMODEL(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,IDS,NINDX,LIST_SIZE,IDS_MAX,NODSYS
      INTEGER IWORK(70000)
!
      INTEGER, ALLOCATABLE, DIMENSION(:) :: NODE_READ_TMP,INDEX,SORT
C
      INTEGER SET_USRTOS
      EXTERNAL set_usrtos
C=======================================================================
 
      CALL hm_get_int_array_index('idsmax' ,ids_max ,jclause,is_available,lsubmodel)
 
      ALLOCATE(node_read_tmp(ids_max))
      node_read_tmp(1:ids_max) = 0
      ALLOCATE(index(2*ids_max))
      ALLOCATE(sort(ids_max))
 
      index = 0
 
      nindx = 0
      list_size = 0
 
      ! Read & convert Nodes
      ! ---------------------
      DO i=1,ids_max
         CALL hm_get_int_array_2indexes('ids',ids,jclause,i,is_available,lsubmodel)
 
         nodsys = set_usrtos(ids,itabm1,numnod)
         IF(nodsys == 0)THEN        
           ! Node was not found. Issue a Warning & Skip.
           CALL ancmsg(msgid=1902,anmode=aninfo,
     .                             msgtype=msgwarning,
     .                             i1 = clause%SET_ID,
     .                             i2=ids,
     .                             c1=trim(clause%TITLE),
     .                             c2='NODE')
         ELSE
 
           nodsys=itabm1(nodsys,2)
 
           nindx=nindx+1    !   nb of CLAUSE nodes
           node_read_tmp(nindx) = nodsys
         ENDIF
 
      ENDDO ! DO K=1,IDS_MAX
 
 
 
 
 
      ! Sort the Readed NODEs and remove eventual duplicates
      ! ---------------------------------------------------- 
 
      DO i=1,nindx
        index(i) = i
        sort(i) = node_read_tmp(i)
      ENDDO
      CALL my_orders(0,iwork,sort,index,nindx,1)
 
      DO i=1,nindx
         node_read_tmp(i) = sort(index(i))
      ENDDO
 
      CALL remove_duplicates(node_read_tmp,nindx,list_size)
 
      ! Copy in final SET
      ! ------------------
      clause%NB_NODE = list_size  
      ALLOCATE( clause%NODE( list_size ) )
 
      DO i=1,list_size
        clause%NODE(i) = node_read_tmp(i)
      ENDDO
C-------------------------
       DEALLOCATE(node_read_tmp)
       DEALLOCATE(sort)
       DEALLOCATE(index)
C-------------------------
      RETURN

create_node_list_g()

subroutine create_node_list_g	(	type (set_)	clause,
		integer, dimension(numnod,2), intent(in)	itabm1,
		integer	jclause,
		logical	is_available,
		type(submodel_data), dimension(*), intent(in)	lsubmodel )

Definition at line 261 of file create_node_clause.F.

C-----------------------------------------------
C   ROUTINE DESCRIPTION :
C   ===================
C   Create PART Clause from Generation All parts from Min to Max with Increment (Opt_G)
C--------------------------------------------------------------------------------------
C   DUMMY ARGUMENTS DESCRIPTION:
C   ===================
C
C     NAME          DESCRIPTION                         
C
C     CLAUSE        (SET structure) Clause to be treated
C     ITABM1        MAP Table UID -> LocalID
C     JCLAUSE       parameter with HM_READER (current clause read)
C     IS_AVAILABLE  Bool / Result of HM_interface
C     LSUBMODEL     SUBMODEL Structure.
C============================================================================
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE setdef_mod
      USE submodel_mod
      USE message_mod
      USE hm_option_read_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 JCLAUSE
      LOGICAL :: IS_AVAILABLE
      INTEGER, INTENT(IN), DIMENSION(NUMNOD,2) :: ITABM1
!
      TYPE (SET_) ::  CLAUSE
      TYPE(SUBMODEL_DATA),INTENT(IN):: LSUBMODEL(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,IDS,LIST_SIZE,IDS_MAX,GENE_MAX,K,N,N1
      INTEGER START_GENE,END_GENE,INCR_GENE,NSTART,NSTOP,STACK,STACK_ONE,NB_RESULT
!-
      INTEGER, ALLOCATABLE, DIMENSION(:) :: NODE_READ_TMP,
     .         NODE_READ_ONE,RESULT
C
      INTEGER  SET_USRTOS_NEAREST
      EXTERNAL set_usrtos_nearest
C=======================================================================
      CALL hm_get_int_array_index('genemax' ,gene_max ,jclause,is_available,lsubmodel)
 
      ALLOCATE(node_read_tmp(numnod))
      ALLOCATE(node_read_one(numnod))
 
 
      IF (gene_max > 1) THEN
          ALLOCATE(result(numnod))
      ENDIF
 
      stack=0
 
      DO k=1,gene_max
          CALL hm_get_int_array_2indexes('start'  ,start_gene,jclause,k,is_available,lsubmodel)
          CALL hm_get_int_array_2indexes('end'    ,end_gene  ,jclause,k,is_available,lsubmodel)
          CALL hm_get_int_array_2indexes('by'     ,incr_gene ,jclause,k,is_available,lsubmodel)
 
          ! set value by default for increment to 1
          IF (incr_gene == 0) incr_gene = 1
 
          nstart = set_usrtos_nearest(start_gene,itabm1,numnod,1)
          nstop  = set_usrtos_nearest(end_gene,itabm1,numnod,2)
 
          stack_one=0
          DO n=nstart, nstop
             n1 = itabm1(n,1)
             IF ( mod( n1-start_gene , incr_gene) == 0)THEN
                stack_one = stack_one+1
                node_read_one(stack_one) = itabm1(n,2)
             ENDIF
          ENDDO
 
          IF (stack==0) THEN
             node_read_tmp(1:stack_one) = node_read_one(1:stack_one)
             stack = stack_one
          ELSE
             ! This code will not go if  GENE_MAX == 1 / Result does not need to be allocated
             CALL union_2_sorted_sets( node_read_tmp, stack ,
     *                                 node_read_one, stack_one ,
     *                                 result,        nb_result )
 
            node_read_tmp(1:nb_result) = result(1:nb_result)
            stack = nb_result
          ENDIF
      ENDDO
 
      clause%NB_NODE = stack
      ALLOCATE(clause%NODE(stack))
      clause%NODE(1:stack) = node_read_tmp(1:stack)
C-------------------------
      DEALLOCATE (node_read_tmp)
      DEALLOCATE (node_read_one)
      IF (ALLOCATED(result)) DEALLOCATE (result)
C-------------------------