hm_read_merge_node.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    hm_read_merge_node     ../starter/source/elements/reader/hm_read_merge_node.F
!||--- called by ------------------------------------------------------
!||    lectur                 ../starter/source/starter/lectur.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../starter/source/output/message/message.F
!||    hm_get_floatv          ../starter/source/devtools/hm_reader/hm_get_floatv.F
!||    hm_get_intv            ../starter/source/devtools/hm_reader/hm_get_intv.F
!||    hm_option_read_key     ../starter/source/devtools/hm_reader/hm_option_read_key.F
!||    hm_option_start        ../starter/source/devtools/hm_reader/hm_option_start.F
!||    ngr2usr                ../starter/source/system/nintrr.F
!||--- uses       -----------------------------------------------------
!||    hm_option_read_mod     ../starter/share/modules1/hm_option_read_mod.F
!||    message_mod            ../starter/share/message_module/message_mod.F
!||    submodel_mod           ../starter/share/modules1/submodel_mod.F
!||====================================================================
      SUBROUTINE hm_read_merge_node(X,LSUBMODEL,UNITAB,IGRNOD,MERGE_NODE_TAB,
     .                              MERGE_NODE_TOL,NMERGE_NODE_CAND,NMERGE_NODE_DEST)
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)
      END 
C