hm_read_monvol_type1.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_type1_mod   ../starter/source/airbag/hm_read_monvol_type1.f
!||--- called by ------------------------------------------------------
!||    read_monvol                ../starter/source/airbag/read_monvol.f
!||====================================================================
      MODULE hm_read_monvol_type1_mod
      CONTAINS
!||====================================================================
!||    hm_read_monvol_type1     ../starter/source/airbag/hm_read_monvol_type1.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_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_type1(T_MONVOLN,
     .     UNITAB, LUID, 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 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
#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)
      END SUBROUTINE hm_read_monvol_type1
      END MODULE hm_read_monvol_type1_mod