hm_read_monvol_type10_mod Module Reference

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

Function/Subroutine Documentation

hm_read_monvol_type10()

subroutine hm_read_monvol_type10_mod::hm_read_monvol_type10	(	type(monvol_struct_), intent(inout)	t_monvoln,
		type(unit_type_), intent(in)	unitab,
		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 50 of file hm_read_monvol_type10.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, 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) :: 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, IFUNCT_ID(6), IFBULK, IFMIN, IFMOUTT, IFMOUTP, IFP0, IFPMAX
      my_real :: fac_gen
      my_real :: scal_t, scal_p
      my_real :: sa, rot, vol, vmin, veps, amu, sv
      my_real :: rhoi, sfbulk, sfmin, sfmoutt, sfmoutp, sfp0, sfpmax
      LOGICAL :: FOUND
      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('surf_IDex', surfid, is_available, lsubmodel)
C     Line 2
      CALL hm_get_floatv('Ascalet', scal_t, is_available, lsubmodel, unitab)
      CALL hm_get_floatv('AscaleP', scal_p, is_available, lsubmodel, unitab)
C     Line 3
      CALL hm_get_floatv('Rho', rhoi, is_available, lsubmodel, unitab)
C     Line 4
      CALL hm_get_intv('fct_K', ifbulk, is_available, lsubmodel)
      CALL hm_get_intv('fct_Mtin', ifmin, is_available, lsubmodel)
      CALL hm_get_floatv('Fscale_K', sfbulk, is_available, lsubmodel, unitab)
      CALL hm_get_floatv('Fscale_Mtin', sfmin, is_available, lsubmodel, unitab)
C     Line 5 
      CALL hm_get_intv('fct_Mtout', ifmoutt, is_available, lsubmodel)
      CALL hm_get_intv('fct_Mpout', ifmoutp, is_available, lsubmodel)
      CALL hm_get_floatv('Fscale_Mtout', sfmoutt, is_available, lsubmodel, unitab)
      CALL hm_get_floatv('Fscale_Mpout', sfmoutp, is_available, lsubmodel, unitab)
C     Line 6
      CALL hm_get_intv('fct_Padd', ifp0, is_available, lsubmodel)
      CALL hm_get_intv('fct_Pmax', ifpmax, is_available, lsubmodel)
      CALL hm_get_floatv('Fscale_Padd', sfp0, is_available, lsubmodel, unitab)
      CALL hm_get_floatv('Fscale_Pmax', sfpmax, is_available, lsubmodel, unitab)
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, 10)
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, 10)
     
 
      ifunct_id(1:6) = 0
      IF (ifbulk > 0) THEN
         CALL check_function_id(npc, nfunct, ifbulk, ifunct_id(1), found)
         IF (.NOT. found) THEN
            CALL ancmsg(msgid = 9, anmode = aninfo, msgtype = msgerror,
     .           i2 = ifbulk, i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, c2 = 'BULK')
         ENDIF
      ENDIF
      IF (ifmin > 0) THEN
         CALL check_function_id(npc, nfunct, ifmin, ifunct_id(2), found)
         IF (.NOT. found) THEN
            CALL ancmsg(msgid = 9, anmode = aninfo, msgtype = msgerror,
     .           i2 = ifmin, i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, c2 = 'MASS FLOW')
         ENDIF
      ENDIF
      IF (ifmoutt > 0) THEN
         CALL check_function_id(npc, nfunct, ifmoutt, ifunct_id(3), found)
         IF (.NOT. found) THEN
            CALL ancmsg(msgid = 9, anmode = aninfo, msgtype = msgerror,
     .           i2 = ifmoutt, i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, c2 = 'MASS FLOW')
         ENDIF
      ENDIF
      IF (ifmoutp > 0) THEN
         CALL check_function_id(npc, nfunct, ifmoutp, ifunct_id(4), found)
         IF (.NOT. found) THEN
            CALL ancmsg(msgid = 9, anmode = aninfo, msgtype = msgerror,
     .           i2 = ifmoutp, i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, c2 = 'MASS FLOW')
         ENDIF
      ENDIF
      IF (ifp0 > 0) THEN
         CALL check_function_id(npc, nfunct, ifp0, ifunct_id(5), found)
         IF (.NOT. found) THEN
            CALL ancmsg(msgid = 9, anmode = aninfo, msgtype = msgerror,
     .           i2 = ifp0, i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, c2 = 'PRESSURE')
         ENDIF
      ENDIF
      IF (ifpmax > 0) THEN
         CALL check_function_id(npc, nfunct, ifpmax, ifunct_id(6), found)
         IF (.NOT. found) THEN
            CALL ancmsg(msgid = 9, anmode = aninfo, msgtype = msgerror,
     .           i2 = ifpmax, i1 = t_monvoln%ID, c1 = t_monvoln%TITLE, c2 = 'PRESSURE')
         ENDIF
      ENDIF
 
 
C     Default value for time scale factor
      IF (scal_t == zero) THEN
         CALL hm_get_floatv_dim('Ascalet', fac_gen, is_available, lsubmodel, unitab)     
         scal_t = one * fac_gen 
      ENDIF
      IF (scal_p == zero) THEN
         CALL hm_get_floatv_dim('AscaleP', fac_gen, is_available, lsubmodel, unitab)     
         scal_p = one * fac_gen 
      ENDIF
C     Default value
      IF (ifbulk > 0) THEN
         IF (sfbulk == zero) THEN
            CALL hm_get_floatv_dim('Fscale_K', fac_gen, is_available, lsubmodel, unitab)   
            sfbulk = one * fac_gen
         ENDIF
      ENDIF
      IF (ifmin > 0) THEN
         IF (sfmin == zero) THEN
            CALL hm_get_floatv_dim('Fscale_Mtin', fac_gen, is_available, lsubmodel, unitab)   
            sfmin = one * fac_gen
         ENDIF
      ENDIF
      IF (ifmoutt > 0) THEN
         IF (sfmoutt == zero) THEN
            CALL hm_get_floatv_dim('Fscale_Mtout', fac_gen, is_available, lsubmodel, unitab)   
            sfmoutt = one * fac_gen
         ENDIF
      ENDIF
      IF (ifmoutp > 0) THEN
         IF (sfmoutp == zero) THEN
            CALL hm_get_floatv_dim('Fscale_Mpout', fac_gen, is_available, lsubmodel, unitab)   
            sfmoutp = one * fac_gen
         ENDIF
      ENDIF
      IF (ifp0 > 0) THEN
         IF (sfp0 == zero) THEN
            CALL hm_get_floatv_dim('Fscale_Padd', fac_gen, is_available, lsubmodel, unitab)   
            sfp0 = one * fac_gen
         ENDIF
      ENDIF
      CALL hm_get_floatv_dim('Fscale_Pmax', fac_gen, is_available, lsubmodel, unitab)   
      IF (ifpmax > 0) THEN
         IF (sfpmax == zero) THEN
            sfpmax = one * fac_gen
         ENDIF
      ELSE
         sfpmax = infinity * fac_gen
      ENDIF
C     =====
C     Store
C     =====
C     Store in data structure
      t_monvoln%IVOLU(21) = ifunct_id(1)
      t_monvoln%RVOLU(35) = sfbulk
      t_monvoln%IVOLU(22) = ifunct_id(2)
      t_monvoln%RVOLU(36) = sfmin
      t_monvoln%IVOLU(23) = ifunct_id(3)
      t_monvoln%RVOLU(37) = sfmoutt
      t_monvoln%IVOLU(24) = ifunct_id(4)
      t_monvoln%RVOLU(38) = sfmoutp
      t_monvoln%IVOLU(25) = ifunct_id(5)
      t_monvoln%RVOLU(39) = sfp0
      t_monvoln%IVOLU(26) = ifunct_id(6)
      t_monvoln%RVOLU(40) = sfpmax
 
      t_monvoln%RVOLU(26) = one / scal_t
      t_monvoln%RVOLU(27) = one / scal_p
      t_monvoln%RVOLU(28) = one
      t_monvoln%RVOLU(29) = one
      t_monvoln%RVOLU(30) = one
 
      t_monvoln%RVOLU(34) = rhoi
C     
      veps = max(zero, vmin - vol)
      t_monvoln%RVOLU(4) = vol + veps 
      t_monvoln%RVOLU(17) = veps 
      t_monvoln%RVOLU(20)= rhoi*vol
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
      WRITE(iout, 1002) sa, sv, vol
      WRITE(iout,1800) rhoi, ifbulk, sfbulk, ifmin, sfmin, ifmoutt, sfmoutt, 
     .     ifmoutp, sfmoutp, ifp0, sfp0, ifpmax, sfpmax
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)
 1005 FORMAT( 5x,'EXTERNAL SURFACE ID . . . . . . . . . .=',i10)
 
 1800 FORMAT(
     .     5x,'FLUID DENSITY. . . . . . . . . . . . . . . . . . . . . =',1pg20.13,
     .     /5x,'BULK TIME FUNCTION. . . . . . . . . . . . . . . . . . .=',i10,
     .     /5x,'BULK TIME FUNCTION SCALE FACTOR. . . . . . . . . . . . =',1pg20.13,
     .     /5x,'INPUT MASS FLOW RATE TIME FUNCTION. . . . . . . . . . .=',i10,
     .     /5x,'INPUT MASS FLOW RATE TIME FUNCTION SCALE FACTOR. . . . =',1pg20.13,
     .     /5x,'OUTPUT MASS FLOW RATE TIME FUNCTION. . . . . . . . . . =',i10,
     .     /5x,'OUTPUT MASS FLOW RATE TIME FUNCTION SCALE FACTOR. . . .=',1pg20.13,
     .     /5x,'OUTPUT MASS FLOW RATE PRESSURE FUNCTION. . . . . . . . =',i10,
     .     /5x,'OUTPUT MASS FLOW RATE PRESSURE FUNCTION SCALE FACTOR. .=',1pg20.13,
     .     /5x,'ADDITIONAL PRESSURE TIME FUNCTION. . . . . . . . . . . =',i10,
     .     /5x,'ADDITIONAL PRESSURE TIME FUNCTION SCALE FACTOR. . . . .=',1pg20.13,
     .     /5x,'MAXIMUM PRESSURE TIME FUNCTION. . . . . . . . . . . . .=',i10,
     .     /5x,'MAXIMUM PRESSURE TIME FUNCTION SCALE FACTOR. . . . . . =',1pg20.13)