hm_read_monvol_type2_mod Module Reference

Functions/Subroutines
subroutine	hm_read_monvol_type2 (t_monvoln, unitab, luid, npc, igrsurf, itab, x, pm, geo, ixc, ixtg, lsubmodel)

Function/Subroutine Documentation

hm_read_monvol_type2()

subroutine hm_read_monvol_type2_mod::hm_read_monvol_type2	(	type(monvol_struct_), intent(inout)	t_monvoln,
		type(unit_type_), intent(in)	unitab,
		integer, intent(in)	luid,
		integer, dimension(*), intent(in)	npc,
		type (surf_), dimension(nsurf), intent(inout)	igrsurf,
		integer, dimension(*), intent(in)	itab,
		dimension(3, *), intent(in)	x,
		dimension(npropm, *), intent(in)	pm,
		dimension(npropg, *), intent(in)	geo,
		integer, dimension(nixc, *), intent(in)	ixc,
		integer, dimension(nixtg, *), intent(in)	ixtg,
		type(submodel_data), dimension(nsubmod), intent(in)	lsubmodel )

Definition at line 48 of file hm_read_monvol_type2.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE unitab_mod
      USE groupdef_mod
      USE message_mod
      USE monvol_struct_mod
      USE submodel_mod
      USE unitab_mod
      use element_mod , only : nixc,nixtg
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-----------------------------------------------
C     NSURF, NFUNCT
#include      "com04_c.inc"
C     KMONVO, IREC
C     NIMV, NRVOLU
#include      "param_c.inc"
C     IIN
#include      "units_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(UNIT_TYPE_), INTENT(IN) :: UNITAB
      INTEGER, INTENT(IN) :: LUID
      INTEGER, INTENT(IN) :: NPC(*), ITAB(*), IXC(NIXC, *), IXTG(NIXTG, *)
      my_real, INTENT(IN) :: x(3, *), geo(npropg, *), pm(npropm, *)
      TYPE (SURF_), INTENT(INOUT), DIMENSION(NSURF) :: IGRSURF
      TYPE(MONVOL_STRUCT_), INTENT(INOUT) :: T_MONVOLN
      TYPE(SUBMODEL_DATA), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER :: II
      INTEGER :: SURFID, IFUNC, ITYPFUN, LOC_IFUNC
      my_real :: ffunc, fac_m, fac_l, fac_t, fac_c
      my_real :: scal_t, scal_p, scal_s, scal_a, scal_d
      LOGICAL :: FOUND
      my_real :: sa, rot, vol, vmin, veps, amu, sv
      LOGICAL :: IS_AVAILABLE
C-----------------------------------------------
C     B e g i n n i n g   o f   s o u r c e
C-----------------------------------------------
C     =======
C     Reading
C     =======
C     Line 1
      CALL hm_get_intv('entityiddisplayed', surfid, is_available, lsubmodel)
C     Line 2
      CALL hm_get_floatv('Scal_T', scal_t, is_available, lsubmodel, unitab)
C     Line 3
      CALL hm_get_intv('FUN_A1', ifunc, is_available, lsubmodel)
      CALL hm_get_floatv('Ffunc', ffunc, is_available, lsubmodel, unitab)
      CALL hm_get_intv('Itype', itypfun, is_available, lsubmodel)
C     ================
C     Check operations
C     ================
C     External surface check
      t_monvoln%IVOLU(4) = 0
      found = .false. 
      DO ii = 1, nsurf
         IF (surfid == igrsurf(ii)%ID) THEN
            t_monvoln%IVOLU(4) = ii
            t_monvoln%EXT_SURFID = ii
            found = .true.
            EXIT
         ENDIF
      ENDDO
      IF (.NOT. found) THEN
         CALL freerr(3)
      ELSEIF (igrsurf(t_monvoln%EXT_SURFID)%ISH4N3N == 0) THEN
         CALL ancmsg(msgid = 18, anmode = aninfo, msgtype = msgerror,
     .        i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, i2 = surfid)
         CALL freerr(3)
      ENDIF
      
C     Check surface closure
      CALL monvol_check_surfclose(t_monvoln, itab, igrsurf(t_monvoln%EXT_SURFID), x)
C     Set all normal on same side
      CALL monvol_orient_surf(t_monvoln, t_monvoln%TITLE, t_monvoln%IVOLU, itab, 
     .     igrsurf(t_monvoln%EXT_SURFID),ixc, ixtg, x, 2)
C     Compute Monvon volume
      CALL monvol_compute_volume(t_monvoln, t_monvoln%TITLE, t_monvoln%IVOLU, igrsurf(t_monvoln%EXT_SURFID), 
     .     itab, x, pm, geo, ixc, ixtg, 
     .     sa, rot, vol, vmin, veps, sv)
C     Reverse all normals to ensure positive volume
      CALL monvol_reverse_normals(t_monvoln, t_monvoln%TITLE, t_monvoln%IVOLU, itab, 
     .     igrsurf(t_monvoln%EXT_SURFID),ixc,ixtg,vol, x, 2)
     
C     Function id check
      found = .false.
      loc_ifunc = 0
      DO ii = 1, nfunct
         IF (ifunc == npc(ii)) THEN
            loc_ifunc = ii
            found = .true.
            EXIT
         ENDIF
      ENDDO
      IF (.NOT. found) THEN
         CALL ancmsg(msgid = 9, anmode = aninfo, msgtype = msgerror, 
     .        i2 = ifunc, i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, c2 = 'PRESSURE')      
      ENDIF
C     =====
C     Units
C     =====
      fac_m = unitab%FAC_M(luid)
      fac_l = unitab%FAC_L(luid)
      fac_t = unitab%FAC_T(luid)
      fac_c = fac_m / (fac_l * fac_t * fac_t)
C     Default value for time scale factor
      IF (scal_t == zero) THEN
         scal_t = one * fac_t
      ENDIF
      scal_p = one * fac_c
      scal_s = one * fac_l * fac_l
      scal_a = one 
      scal_d = one * fac_l
C     Default value for FFUNC
      IF (ffunc == zero) THEN
         ffunc = one * fac_c
      ENDIF
 
C     =====
C     Store
C     =====
      t_monvoln%RVOLU(15) = ffunc
C     Store in data structure
      t_monvoln%RVOLU(26) = one / scal_t
      t_monvoln%RVOLU(27) = one / scal_p
      t_monvoln%RVOLU(28) = one / scal_s
      t_monvoln%RVOLU(29) = one / scal_a
      t_monvoln%RVOLU(30) = one / scal_d   
C     
      t_monvoln%RVOLU(3) = zero
      veps = max(zero, vmin - vol)
      t_monvoln%RVOLU(4) = vol + veps
      t_monvoln%RVOLU(5) = zero
      t_monvoln%RVOLU(12) = zero
      t_monvoln%RVOLU(17) = veps
      t_monvoln%IVOLU(7) = loc_ifunc
      t_monvoln%IVOLU(19) = itypfun
C
      amu = zero
      t_monvoln%RVOLU(2) = amu
      t_monvoln%RVOLU(16) = vol + veps
      t_monvoln%RVOLU(18) = sa
      t_monvoln%RVOLU(21) = rot
      t_monvoln%RVOLU(22:24) = zero
 
C     =========
C     Print out
C     =========
      WRITE(iout, 1005) surfid
      WRITE(iout, 1003) scal_t, scal_p, scal_s, scal_a, scal_d
      WRITE(iout, 1002) sa, sv, vol
      WRITE(iout,1200) ifunc, itypfun
C-----------------------------------------------
C     E n d   o f   s o u r c e
C-----------------------------------------------
      
      RETURN
 1002 FORMAT(
     .     /5x,'INITIAL SURFACE OF MONITORED VOLUME . .=',1pg20.13,
     .     /5x,'SURFACE ERROR(NE.0 FOR NON CLOSED SURF)=',1pg20.13,
     .     /5x,'INITIAL VOLUME OF MONITORED VOLUME. . .=',1pg20.13)    
 1003 FORMAT(
     .     5x,'UNIT SCALE FOR TIME FUNCTIONS          =',1pg20.13,
     .     /5x,'UNIT SCALE FOR PRESSURE FUNCTIONS      =',1pg20.13,
     .     /5x,'UNIT SCALE FOR AREA FUNCTIONS          =',1pg20.13,
     .     /5x,'UNIT SCALE FOR ANGLE FUNCTIONS         =',1pg20.13,
     .     /5x,'UNIT SCALE FOR DISTANCE FUNCTIONS      =',1pg20.13)
 1005 FORMAT( 5x,'EXTERNAL SURFACE ID . . . . . . . . . .=',i10)
 1200 FORMAT( 5x,'LOAD CURVE NUMBER . . . . . . . . . . .=',i10,
     .     /5x,'CURVE TYPE  . . . . . . . . . . . . . .=',i10,
     .     /5x,'  0 : P=F(1/V)',
     .     /5x,'  1 : P=F(T)',
     .     /5x,'  2 : P=F(V)',
     .     /5x,'  3 : P=(1/V) F(T)'/)