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)
      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