hm_submodpart.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_submodpart          ../starter/source/groups/hm_submodpart.F
!||--- called by ------------------------------------------------------
!||    hm_read_grpart         ../starter/source/groups/hm_read_grpart.F
!||    hm_read_lines          ../starter/source/groups/hm_read_lines.F
!||    hm_read_surf           ../starter/source/groups/hm_read_surf.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../starter/source/output/message/message.F
!||    groups_get_elem_list   ../starter/source/groups/groups_get_elem_list.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_submodpart(
     .           ISUBMOD  ,TAGBUF  ,IPART   ,ID      ,FLAG     ,
     .           MESS     ,TITR    ,TITR1   ,INDX    ,NINDX    ,
     .           LSUBMODEL)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE submodel_mod
      USE hm_option_read_mod
      USE names_and_titles_mod , ONLY : nchartitle, ncharkey, ncharline, ncharfield
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      "scr17_c.inc"
#include      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER   TAGBUF(*),ISUBMOD(*),IPART(LIPART1,*), INDX(*)
      INTEGER   ID,FLAG,NINDX
      CHARACTER MESS(*)
      CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1
      TYPE(submodel_data) LSUBMODEL(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K,ISU,JREC,PARTID,CUR_SUBMOD,ISELECT,IOK,
     .        ID_SUB,IDU,ID1,UID1,SUB_INDEX,KK,JJ
      INTEGER  TAGS(NSUBMOD)
      CHARACTER(LEN=NCHARKEY) :: KEY
      CHARACTER(LEN=NCHARFIELD) :: VERS_IN
      CHARACTER(LEN=NCHARLINE) :: TITR2,CART
      LOGICAL IS_AVAILABLE,IS_ENCRYPTED
      INTEGER,DIMENSION(:),ALLOCATABLE :: LIST_ELEM
      INTEGER :: NENTITY      
C-----------------------------------------------
      INTERFACE
       SUBROUTINE groups_get_elem_list(arg1,arg2,arg3)
        USE submodel_mod
        INTEGER,DIMENSION(:),ALLOCATABLE       :: arg1
        INTEGER,INTENT(INOUT)                  :: arg2
        TYPE(submodel_data)                    :: arg3(NSUBMOD)
       END SUBROUTINE  
      END INTERFACE     
C=======================================================================
C     Tag submodels
C-------------------------
      tags(1:nsubmod)   = 0
      
      CALL groups_get_elem_list(list_elem, nentity, lsubmodel)                                                               
      DO kk=1,nentity                                                                                                            
        jj=list_elem(kk)                                              
        IF(jj > 0)THEN                                                                                                          
          isu=0                                                                                                                  
          iselect = 0                                                                                                            
          iok = 0                                                                                                                
          DO k=1,nsubmod                                                                                                         
            cur_submod = k                                                                                                       
            iselect = 0                                                                                                          
            DO WHILE (cur_submod /= 0 .AND. iselect == 0)                                                                    
              IF (lsubmodel(cur_submod)%NOSUBMOD == jj) iselect = 1                                                              
              IF (lsubmodel(cur_submod)%NOSUBMOD == -jj) iselect = -1                                                            
              cur_submod = lsubmodel(cur_submod)%IFATHER                                                                         
            ENDDO                                                                                                                
            IF (iselect == 1) THEN                                                                                               
              isu=k                                                                                                              
              tags(k) = tags(k) + 1                                                                                              
              iok = 1                                                                                                            
            ELSEIF (iselect == -1) THEN                                                                                          
              isu=k                                                                                                              
              tags(k) = tags(k) - 1                                                                                              
              iok = 1                                                                                                            
            ENDIF                                                                                                                
          ENDDO                                                                                                                  
          IF (iok == 0) CALL ancmsg(msgid=194,                                                                                   
     .                   msgtype=msgwarning,                                                                                     
     .                   anmode=aninfo,                                                                                          
     .                   i1=id,                                                                                                  
     .                   c1=titr1,                                                                                               
     .                   c2=titr,                                                                                                
     .                   c3='SUBMODEL',                                                                                          
     .                   i2=jj)                                                                                                  
        ENDIF                                                                                                                    
      ENDDO      
      IF(ALLOCATED(list_elem))DEALLOCATE (list_elem) 
 
C-------------------------
C     Tag Parts
C-------------------------   
      DO k=1,nsubmod 
        IF (tags(k) > 1) tags(k) = 1
        IF (tags(k) < -1) tags(k) = -1
      ENDDO 
 
C--------------------------------------------------
C BROWSING MODEL PARTS 1->NPART
C--------------------------------------------------
      DO i=1,npart
        sub_index = ipart(9,i)
        cur_submod = sub_index
        IF(tagbuf(i)==0 .AND. cur_submod > 0)THEN
          IF(tags(cur_submod) /=0 )THEN
            tagbuf(i)=tags(cur_submod)
            nindx=nindx+1
            indx(nindx)=i
          END IF
        END IF                
      ENDDO
C-------------------------
      RETURN
      END