hm_read_inter_lagmul_type02.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	hm_read_inter_lagmul_type02 (ipari, frigap, noint, igrnod, igrsurf, def_inter, titr, unitab, lsubmodel, npari, nparir)

Function/Subroutine Documentation

hm_read_inter_lagmul_type02()

subroutine hm_read_inter_lagmul_type02	(	integer, dimension(npari)	ipari,
			frigap,
		integer	noint,
		type (group_), dimension(ngrnod), target	igrnod,
		type (surf_), dimension(nsurf), target	igrsurf,
		integer, dimension(100)	def_inter,
		character(len=nchartitle)	titr,
		type (unit_type_), intent(in)	unitab,
		type(submodel_data), dimension(nsubmod)	lsubmodel,
		integer, intent(in)	npari,
		integer, intent(in)	nparir )

Parameters

[in]

nparir

array sizes IPARI and FRIGAP

Definition at line 37 of file hm_read_inter_lagmul_type02.F.

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