hm_read_merge_node.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	hm_read_merge_node (x, lsubmodel, unitab, igrnod, merge_node_tab, merge_node_tol, nmerge_node_cand, nmerge_node_dest)

Function/Subroutine Documentation

hm_read_merge_node()

subroutine hm_read_merge_node	(		x,
		type(submodel_data), dimension(*), intent(in)	lsubmodel,
		type(unit_type_), intent(in)	unitab,
		type (group_), dimension(ngrnod), target	igrnod,
		integer, dimension(4,*)	merge_node_tab,
			merge_node_tol,
		integer	nmerge_node_cand,
		integer	nmerge_node_dest )

Definition at line 39 of file hm_read_merge_node.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE unitab_mod
      USE groupdef_mod
      USE message_mod
      USE submodel_mod
      USE hm_option_read_mod
      USE names_and_titles_mod , ONLY : 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      "units_c.inc"
#include      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER MERGE_NODE_TAB(4,*),NMERGE_NODE_CAND,NMERGE_NODE_DEST
      my_real
     .   x(3,*),merge_node_tol(*)
      TYPE(UNIT_TYPE_),INTENT(IN) ::UNITAB 
      TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
      TYPE (GROUP_)  ,TARGET, DIMENSION(NGRNOD)  :: IGRNOD
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,ID,UID,IDN,GR_ID,GR_IDS,MERGE_TYPE,FLAG_FULL_MERGE
      CHARACTER(LEN=NCHARTITLE) :: TITR
      INTEGER, DIMENSION(:),ALLOCATABLE :: TAGNOD1,TAGNOD2,TAGNOD_TEMP
      LOGICAL   IS_AVAILABLE
      my_real tol,xn,xmin,xmax,ymin,ymax,zmin,zmax,dx,dy,dz,tol_def
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER NGR2USR
      INTEGER, DIMENSION(:), POINTER :: INGR2USR
C=======================================================================
C
      WRITE(iout,1000)
C
      tol_def = zero
      flag_full_merge = 0
      ALLOCATE(tagnod1(numnod),tagnod2(numnod),tagnod_temp(numnod))
      tagnod1(1:numnod) = 0
      tagnod2(1:numnod) = 0
C
C--------------------------------------------------
C START BROWSING MODEL MERGE
C--------------------------------------------------
      is_available = .false.
      CALL hm_option_start('/MERGE/NODE')
C--------------------------------------------------
      DO i=1,nb_merge_node
C--------------------------------------------------
C EXTRACT DATAS OF /RBODY/... LINE
C--------------------------------------------------
        CALL hm_option_read_key(lsubmodel,
     .                       option_id = id,
     .                       unit_id = uid,
     .                       option_titr = titr)
C--------------------------------------------------
C EXTRACT DATAS
C--------------------------------------------------
        CALL hm_get_floatv('tol'      ,tol               ,is_available, lsubmodel, unitab)   
        CALL hm_get_intv  ('Type'     ,merge_type        ,is_available, lsubmodel)
        CALL hm_get_intv  ('grnod_id' ,gr_id             ,is_available, lsubmodel)
C
        gr_ids = 0
        IF (gr_id > 0) THEN
C--       Grnod 
          DO j=1,ngrnod
            IF (igrnod(j)%ID == gr_id) gr_ids = j
          ENDDO
          IF (gr_ids == 0) THEN
            CALL ancmsg(msgid=53,
     .                  msgtype=msgerror,
     .                  anmode=aninfo,
     .                  c1='IN /MERGE/NODE DEFINITION',
     .                  i1=gr_id)
          ENDIF
        ENDIF
C
        IF ((tol_def == zero).AND.(tol == zero)) THEN
C--     computation of default tolerance (only one time)
          xn=numnod
          xmin =  ep20
          xmax = -ep20
          ymin =  ep20
          ymax = -ep20
          zmin =  ep20
          zmax = -ep20
          DO j = 1,numnod
            xmin = min(xmin,x(1,j))       
            xmax = max(xmax,x(1,j))       
            ymin = min(ymin,x(2,j))       
            ymax = max(ymax,x(2,j))       
            zmin = min(zmin,x(3,j))       
            zmax = max(zmax,x(3,j))     
          END DO
          dx  = xmax-xmin
          dy  = ymax-ymin
          dz  = zmax-zmin
          tol_def = em05*(dx+dy+dz)/(three*exp(third*log(xn)))
        ENDIF        
C
        IF (gr_ids > 0) THEN
C--       Grnod id is defined
          IF (merge_type == 0) merge_type = 1
          IF (merge_type == 1) THEN 
C--       nodes of the group are candidates and destinations
            DO j=1,igrnod(gr_ids)%NENTITY
              tagnod1(igrnod(gr_ids)%ENTITY(j)) = 1
              tagnod2(igrnod(gr_ids)%ENTITY(j)) = 1
            ENDDO
          ELSEIF (merge_type == 2) THEN
C--       nodes of the group are candidates and nodes outside group are destinations
            tagnod_temp(1:numnod) = 0
            DO j=1,igrnod(gr_ids)%NENTITY
              tagnod1(igrnod(gr_ids)%ENTITY(j)) = 1
              tagnod_temp(igrnod(gr_ids)%ENTITY(j)) = 1
            ENDDO
            DO j=1,numnod
              IF (tagnod_temp(j)==0) tagnod2(j) = 1      
            ENDDO
          ENDIF   
        ELSE
C--       all nodes taken into account
          IF (flag_full_merge == 0) THEN
            flag_full_merge = id
          ELSE
            CALL ancmsg(msgid=2036,
     .                  msgtype=msgerror,
     .                  anmode=aninfo_blind_1,
     .                  i1=id,i2=flag_full_merge)
          ENDIF
          gr_ids=0
          tagnod1(1:numnod) = 1
          tagnod2(1:numnod) = 1
          merge_type = 1
        ENDIF
C
        IF (tol == zero) tol = tol_def
        nmerge_node_cand = 0
        nmerge_node_dest = 0
        DO j=1,numnod
          IF (tagnod1(j) == 1) nmerge_node_cand = nmerge_node_cand + 1
          IF (tagnod2(j) == 1) nmerge_node_dest = nmerge_node_dest + 1
        ENDDO
        merge_node_tab(1,i) = merge_type
        merge_node_tab(2,i) = gr_ids
        merge_node_tab(3,i) = gr_id
        merge_node_tab(4,i) = id
        merge_node_tol(i) = tol
C
        WRITE(iout,1100) id,trim(titr),tol,merge_type,gr_id    
C
      ENDDO
C
      DEALLOCATE(tagnod1,tagnod2,tagnod_temp)
C
C-----------
      RETURN
C
1000  FORMAT(/
     . '      MERGE/NODE DEFINITIONS '/
     . '      ---------------------- ')
1100  FORMAT(/5x,'MERGE NODE ID ',i10,1x,a
     .       /5x,'TOLERANCE. . . . . . . . . . . . . . . . .',1pg20.4
     .       /5x,'MERGING TYPE. . . . . . . . . . . . . . . ',i10
     .       /5x,'GROUP OF NODES. . . . . . . . . . . . . . ',i10)