hm_read_inter_type09.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	hm_read_inter_type09 (ipari, stfac, frigap, noint, igrsurf, unitab, lsubmodel, npari, nparir)

Function/Subroutine Documentation

hm_read_inter_type09()

subroutine hm_read_inter_type09	(	integer, dimension(npari)	ipari,
			stfac,
			frigap,
		integer	noint,
		type (surf_), dimension(nsurf), target	igrsurf,
		type (unit_type_), intent(in)	unitab,
		type(submodel_data), dimension(nsubmod), intent(in)	lsubmodel,
		integer, intent(in)	npari,
		integer, intent(in)	nparir )

Definition at line 35 of file hm_read_inter_type09.F.

C============================================================================
C
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE unitab_mod , ONLY : unit_type_
      USE message_mod
      USE groupdef_mod , ONLY : surf_
      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   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER,INTENT(IN) :: NPARI,NPARIR
      INTEGER ISU1,ISU2,NOINT
      INTEGER IPARI(NPARI)
      my_real stfac
      my_real frigap(nparir)
      TYPE (UNIT_TYPE_),INTENT(IN) :: UNITAB
      TYPE(SUBMODEL_DATA), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
      TYPE (SURF_)   ,TARGET , DIMENSION(NSURF)   :: IGRSURF
C-----------------------------------------------
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 I,J,L, NTYP,IS1, IS2,IEULT,IGSTI,ILEV,IBUC,
     .   IBC1, IBC2, IBC3,IBC1M, IBC2M, IBC3M,INTKG
      my_real
     .   fric,gap,startt,stopt,fheat,stens,visc
      CHARACTER(LEN=40)::MESS
      CHARACTER(LEN=NCHARTITLE)::MSGTITL
      CHARACTER(LEN=NCHARKEY) ::  OPT,KEY,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=======================================================================
C     READING ALE INTERFACE /INTER/TYPE9
C=======================================================================
      ! Initializations of integer values
      is1   = 0
      is2   = 0
      ibc1  = 0
      ibc2  = 0
      ibc3  = 0
      ibc1m = 0
      ibc2m = 0
      ibc3m = 0
      igsti = 0
      ilev  = 0  
      intkg = 0
      ibuc  = 0
      ieult = 0
      ! Initializations of float values
      fric   = zero
      gap    = zero
      startt = zero
      stopt  = infinity
      visc   = zero
      fheat  = zero
      stens  = zero
      ! Type 
      ntyp      = 9
      ipari(15) = noint
      ipari(7)  = ntyp
C=======================================================================
C     CARD 1 : Surfaces ids
C=======================================================================
      ! Lagrangian surface
      CALL hm_get_intv('surf_IDA', isu1, is_available, lsubmodel)
      ! ALE surface
      CALL hm_get_intv('surf_IDL', isu2, is_available, lsubmodel)
      ! Checks
      is1=1
      ingr2usr => igrsurf(1:nsurf)%ID
      isu1=ngr2usr(isu1,ingr2usr,nsurf)
      IF(isu2==0)THEN
        is2=0
      ELSE
        is2=1
        isu2=ngr2usr(isu2,ingr2usr,nsurf)
      ENDIF
      ! Storage IPARI FRIGAP
      ipari(45) = isu1
      ipari(46) = isu2
      ipari(13) = is1*10+is2
      ipari(20) = ilev
C=======================================================================
C     CARD 2 : Thermal resistance + Friction coefficient + Init GAP
C=======================================================================
      ! Thermal resistance
      CALL hm_get_floatv('R_TH'  ,stfac    ,is_available, lsubmodel, unitab)
      ! Friction coefficient
      CALL hm_get_floatv('FRIC'  ,fric     ,is_available, lsubmodel, unitab)
      ! Initial Gap
      CALL hm_get_floatv('GAP'   ,gap      ,is_available, lsubmodel, unitab)
      ! Storage IPARI FRIGAP
      frigap(1)  = fric
      frigap(2)  = gap
      frigap(3)  = startt
      frigap(11) = stopt
C=======================================================================
C     CARD 3 : Thermal bridge + Euler + Upwind + Surface tension
C=======================================================================
      ! Thermal bridge flag
      CALL hm_get_intv('I_TH'      ,ibuc     ,is_available, lsubmodel)
      ! Euler flag
      CALL hm_get_intv('I_EUL'     ,ieult    ,is_available, lsubmodel)  
      ! Upwind value
      CALL hm_get_floatv('UPWIND'  ,visc     ,is_available, lsubmodel, unitab)
      ! Surface tension force
      CALL hm_get_floatv('Fs'      ,stens    ,is_available, lsubmodel, unitab) 
      ! Storage IPARI FRIGAP
      ipari(14)  = ieult
      frigap(4)  = fheat
      frigap(15) = stens 
      ipari(11)  = 4*ibc1+2*ibc2+ibc3 + 8 *(4*ibc1m+2*ibc2m+ibc3m)
      frigap(14) = visc
      ipari(12)  = ibuc
      ipari(65)  = intkg
C=======================================================================
C     PRINTOUT
C=======================================================================
C
      WRITE(iout,1509) ibuc,ipari(14),stfac,fric,gap,visc,stens
C
      IF(is1==0)THEN
        WRITE(iout,'(6X,A)')'NO ALE SURFACE INPUT'
      ELSEIF(is1==1)THEN
        WRITE(iout,'(6X,A)')'ALE SURFACE INPUT BY SEGMENTS'
      ELSEIF(is1==2)THEN
        WRITE(iout,'(6X,A)')'ALE SURFACE INPUT BY NODES'
      ELSEIF(is1==3)THEN
        WRITE(iout,'(6X,A)')'ALE SURFACE INPUT BY SEGMENTS'
      ELSEIF(is1==4 )THEN
        WRITE(iout,'(6X,A)')'ALE SIDE INPUT BY BRICKS'
      ELSEIF(is1==5 )THEN
        WRITE(iout,'(6X,A)')'ALE SIDE INPUT BY SOLID ELEMENTS'
      ENDIF
      IF(is2==0)THEN
        WRITE(iout,'(6X,A)')'NO LAGRANGIAN SURFACE INPUT'
      ELSEIF(is2==1)THEN
        WRITE(iout,'(6X,A)')'LAGRANGIAN SURFACE INPUT BY SEGMENTS'
      ELSEIF(is2==2)THEN
        WRITE(iout,'(6X,A)')'LAGRANGIAN SURFACE INPUT BY NODES'
      ELSEIF(is2==3)THEN
        WRITE(iout,'(6X,A)')'LAGRANGIAN SURFACE INPUT BY SEGMENTS'
      ELSEIF(is2==4)THEN
        WRITE(iout,'(6X,A)')'LAGRANGIAN SURFACE REFERS ',
     .                      'TO HYPER-ELLIPSOIDAL SURFACE'
      ENDIF
C
C--------------------------------------------------------------
 1000 FORMAT(/1x,'  INTERFACE NUMBER :',i10,1x,a)
C------------
 1509 FORMAT(//
     .    '    TYPE==9  ALE-THERMAL SLIDING AND VOIDS  ' //,
     .    '    THERMAL BRIDGE (1 YES 0 NO) . . . . . . . ',i10/,
     .    '    TANG. DIR. EULER.(FREE SURF.) (1 YES 0 NO)',i10/,
     .    '    THERMAL RESISTANCE. . . . . . . . . . . . ',1pg20.13/,
     .    '    FRICTION FACTOR . . . . . . . . . . . . . ',1pg20.13/,
     .    '    INITIAL GAP . . . . . . . . . . . . . . . ',1pg20.13/,
     .    '    FREE SURFACE UPWIND . . . . . . . . . . . ',1pg20.13/,
     .    '    SURFACE TENSION . . . . . . . . . . . . . ',1pg20.13//)
    
      RETURN