hm_read_monvol_type1_mod Module Reference

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

Function/Subroutine Documentation

hm_read_monvol_type1()

subroutine hm_read_monvol_type1_mod::hm_read_monvol_type1	(	type(monvol_struct_), intent(inout)	t_monvoln,
		type(unit_type_), intent(in)	unitab,
		integer, intent(in)	luid,
		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 47 of file hm_read_monvol_type1.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
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
#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) :: 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
      my_real :: 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-----------------------------------------------
 
      is_available = .false.
C     =======
C     Reading
C     =======
C     Line 1
      CALL hm_get_intv('surf_IDex', surfid, 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%IVOLU(4))%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, 1)
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, 1)
     
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 values
      scal_t = one * fac_t
      scal_p = one * fac_c
      scal_s = one * fac_l * fac_l
      scal_a = one 
      scal_d = one * fac_l
 
C     =====
C     Store
C     ===== 
      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
      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
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)