hm_read_inter_lagmul_type02.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_inter_lagmul_type02   ../starter/source/interfaces/int02/hm_read_inter_lagmul_type02.F
!||--- called by ------------------------------------------------------
!||    hm_read_inter_lagmul          ../starter/source/interfaces/reader/hm_read_inter_lagmul.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                        ../starter/source/output/message/message.f
!||    definter                      ../starter/source/interfaces/interf1/definter.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
!||    ngr2usr                       ../starter/source/system/nintrr.F
!||--- uses       -----------------------------------------------------
!||    message_mod                   ../starter/share/message_module/message_mod.F
!||    submodel_mod                  ../starter/share/modules1/submodel_mod.F
!||====================================================================
      SUBROUTINE hm_read_inter_lagmul_type02(
     1        IPARI      ,FRIGAP     ,NOINT      ,
     2        IGRNOD     ,IGRSURF    ,DEF_INTER  ,TITR      ,UNITAB   ,
     3        LSUBMODEL  ,NPARI      ,NPARIR)
C============================================================================
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE unitab_mod
      USE message_mod
      USE groupdef_mod
      USE submodel_mod , ONLY : submodel_data, nsubmod
      USE names_and_titles_mod , ONLY : nchartitle, ncharkey
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"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER,INTENT(IN) :: NPARI, NPARIR !< array sizes IPARI and FRIGAP
      INTEGER ISU1,ISU2,NOINT
      INTEGER IPARI(NPARI),DEF_INTER(100)
      my_real frigap(nparir) , stfac
      CHARACTER(LEN=NCHARTITLE)::TITR
C-----------------------------------------------
      TYPE (GROUP_)  ,TARGET, DIMENSION(NGRNOD)  :: IGRNOD
      TYPE (SURF_)   ,TARGET , DIMENSION(NSURF)   :: IGRSURF
      TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB 
      TYPE(submodel_data) LSUBMODEL(NSUBMOD)
C----------------------s-------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "units_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NTYP, ILEV, IPRINT,IASSIGN,IGNORE,
     .    IDEL2,IBUC,INTKG,IS1,IS2
      my_real
     .   startt,stopt,dsearch
      CHARACTER(LEN=NCHARKEY) ::  KEY1
      INTEGER, DIMENSION(:), POINTER :: INGR2USR
      LOGICAL IS_AVAILABLE
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER NGR2USR
C=======================================================================
C     READING LAGRANGE MULTIPLIER INTERFACES /INTER/LAGMUL/TYPE2
C=======================================================================
 
C Initializations
      is1=0
      is2=0
      ibuc=0
C
      ntyp = 2
      ipari(15)=noint
      ipari(7) =ntyp
C
      iprint = 0
C------------------------------------------------------------
C  Card1
C------------------------------------------------------------
      CALL hm_get_intv('secondaryentityids',isu1,is_available,lsubmodel)
      CALL hm_get_intv('mainentityids',isu2,is_available,lsubmodel)
      CALL hm_get_intv('Isearch',ibuc,is_available,lsubmodel)
      CALL hm_get_floatv('dsearch',dsearch,is_available,lsubmodel,unitab)
C
      key1='IBUC'
      iassign = 1
      CALL definter(key1     ,ibuc    ,iassign   ,iprint   ,
     .              ntyp     ,def_inter)
 
C
      IF(ibuc==0)ibuc=2
C------------------------------------------------------------
      IF (isu1==0) THEN
         CALL ancmsg(msgid=1001,
     .               anmode=aninfo_blind_1,
     .               msgtype=msgerror,
     .               i1=noint,
     .               c1=titr)
       END IF
       IF(isu2 == 0) THEN
         CALL ancmsg(msgid=119,
     .               anmode=aninfo_blind_1,
     .               msgtype=msgerror,
     .               i1=noint,
     .               c1=titr)
       END IF 
C
       is1=2
       is2=1
       ingr2usr => igrnod(1:ngrnod)%ID
       isu1=ngr2usr(isu1,ingr2usr,ngrnod)
       ingr2usr => igrsurf(1:nsurf)%ID
       isu2=ngr2usr(isu2,ingr2usr,nsurf)
       IF (igrnod(isu1)%NENTITY == 0) THEN
           CALL ancmsg(msgid=1131,
     .       anmode=aninfo_blind_1,
     .      msgtype=msgerror,
     .        i1=noint,
     .        c1=titr)
       END IF
 
C-------*STORAGE IN IPARI AND FRIGAP *-------------------
C
       ipari(12) = ibuc
 
       ipari(45) = isu1
       ipari(46) = isu2
       ipari(13) = is1*10+is2
 
       frigap(4) = dsearch
 
       idel2    = 0
       ipari(17)= idel2
C
C      IGNORE is working with /INTER/LAGMUL/TYPE2 but not documented
       ignore = 0
       ipari(34) = ignore
 
       intkg = 0
       ipari(65) = intkg
 
       ilev  = 0
       ipari(20) = ilev
 
       startt = zero
       stopt  = ep30
       frigap(3) = startt
       frigap(11)= stopt
C
C------------------------------------------------------------
C     PRINTOUT
C------------------------------------------------------------
C
      WRITE(iout,1602) ibuc,frigap(4)          
C
      IF(is1==0)THEN
        WRITE(iout,'(6X,A)')'NO SECONDARY SURFACE INPUT'
      ELSEIF(is1==1)THEN
        WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
      ELSEIF(is1==2)THEN
        WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY NODES'
      ELSEIF(is1==3)THEN
        WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
      ELSEIF(is1==4 )THEN
        WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY BRICKS'
      ELSEIF(is1==5 )THEN
        WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY SOLID ELEMENTS'        
      ENDIF
      IF(is2==0)THEN
        WRITE(iout,'(6X,A)')'NO MAIN SURFACE INPUT'
      ELSEIF(is2==1)THEN
        WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY SEGMENTS'
      ELSEIF(is2==2)THEN
        WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY NODES'
      ELSEIF(is2==3)THEN
        WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY SEGMENTS'
      ELSEIF(is2==4)THEN
        WRITE(iout,'(6X,A)')'MAIN SURFACE REFERS ',
     .                      'TO HYPER-ELLIPSOIDAL SURFACE'
      ENDIF
C  
C--------------------------------------------------------------
      RETURN
 
 1602 FORMAT(//
     .    '    type==2   tied sliding                  ' //
     .    '    LAGRANGE MULTIPLIER FORMULATION           '  /
     .    '    SEARCH FORMULATION. . . . . . . . . . . . ',i5/,
     .    '    SEARCH DISTANCE . . . . . . . . . . . . . ',1pg20.13/)
 
      END