hm_read_monvol_type2.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    hm_read_monvol_type2_mod   ../starter/source/airbag/hm_read_monvol_type2.F
!||--- called by ------------------------------------------------------
!||    read_monvol                ../starter/source/airbag/read_monvol.F
!||====================================================================
      MODULE hm_read_monvol_type2_mod
      CONTAINS
!||====================================================================
!||    hm_read_monvol_type2     ../starter/source/airbag/hm_read_monvol_type2.F
!||--- called by ------------------------------------------------------
!||    read_monvol              ../starter/source/airbag/read_monvol.f
!||--- calls      -----------------------------------------------------
!||    ancmsg                   ../starter/source/output/message/message.F
!||    freerr                   ../starter/source/starter/freform.F
!||    hm_get_floatv            ../starter/source/devtools/hm_reader/hm_get_floatv.F
!||    hm_get_intv              ../starter/source/devtools/hm_reader/hm_get_intv.f
!||    monvol_check_surfclose   ../starter/share/modules1/monvol_struct_mod.F
!||    monvol_compute_volume    ../starter/share/modules1/monvol_struct_mod.F
!||    monvol_orient_surf       ../starter/share/modules1/monvol_struct_mod.F
!||    monvol_reverse_normals   ../starter/share/modules1/monvol_struct_mod.F
!||--- uses       -----------------------------------------------------
!||    message_mod              ../starter/share/message_module/message_mod.F
!||    monvol_struct_mod        ../starter/share/modules1/monvol_struct_mod.F
!||    submodel_mod             ../starter/share/modules1/submodel_mod.F
!||====================================================================
      SUBROUTINE hm_read_monvol_type2(T_MONVOLN,
     .     UNITAB, LUID, NPC, IGRSURF,
     .     ITAB, X, PM, GEO, IXC, IXTG,LSUBMODEL)
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)'/)
      END SUBROUTINE hm_read_monvol_type2
      END MODULE hm_read_monvol_type2_mod