hm_read_perturb.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_perturb              ../starter/source/general_controls/computation/hm_read_perturb.f
!||--- called by ------------------------------------------------------
!||    lectur                       ../starter/source/starter/lectur.F
!||--- calls      -----------------------------------------------------
!||    hm_option_count              ../starter/source/devtools/hm_reader/hm_option_count.F
!||    hm_read_perturb_fail         ../starter/source/general_controls/computation/hm_read_perturb_fail.F
!||    hm_read_perturb_part_shell   ../starter/source/general_controls/computation/hm_read_perturb_part_shell.F
!||    hm_read_perturb_part_solid   ../starter/source/general_controls/computation/hm_read_perturb_part_solid.F
!||    udouble                      ../starter/source/system/sysfus.F
!||--- uses       -----------------------------------------------------
!||    hm_option_read_mod           ../starter/share/modules1/hm_option_read_mod.F
!||    message_mod                  ../starter/share/message_module/message_mod.F
!||    submodel_mod                 ../starter/share/modules1/submodel_mod.F
!||====================================================================
      SUBROUTINE hm_read_perturb(MAT_PARAM,
     1      IPART   ,RNOISE  ,IPARTC   ,IPARTG    ,IPARTSP  ,
     2      IGRPART ,IPM     ,IPARTS   ,PERTURB   ,QP_IPERTURB,
     3      QP_RPERTURB      ,LSUBMODEL,UNITAB  )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE groupdef_mod
      USE unitab_mod
      USE submodel_mod
      USE hm_option_read_mod
      USE mat_elem_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-----------------------------------------------
#include      "com04_c.inc"
#include      "scr17_c.inc"
#include      "param_c.inc"
#include      "sphcom.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
      my_real
     .   RNOISE(NPERTURB,NUMELC+NUMELTG+NUMELS+NUMSPH),
     .   qp_rperturb(nperturb,4)
c     . RNOISE(*)
      INTEGER IPART(LIPART1,*),IPARTC(*),IPARTSP(*),IPARTG(*),IPARTS(*),
     .   IPM(NPROPMI,*),PERTURB(NPERTURB),QP_IPERTURB(NPERTURB,6)
      TYPE(SUBMODEL_DATA) LSUBMODEL(*)
      TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
C-----------------------------------------------
      TYPE (GROUP_)  , DIMENSION(NGRPART)  :: IGRPART
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER ITYP,IDPERTURB(NPERTURB),
     .   NPART_SHELL,NPART_SOLID,OFFS
      INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX,INDEX_ITYP
      my_real bid
      CHARACTER MESS*40
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      DATA mess/'PERTURBATION DEFINITION            '/
C=======================================================================
      ! Initialization and allocation of tables
      ityp     = 0
      offs     = 0
      bid = zero
      idperturb(1:nperturb) = 0
c
      ALLOCATE(index(numelc+numeltg+numels+numsph))
      ALLOCATE(index_ityp(numelc+numeltg+numels+numsph))
      index(:) = 0
      index_ityp(:) = 0
c
c     Counting PERTURB type
      CALL hm_option_count('/PERTURB/PART/SHELL',npart_shell)  
      CALL hm_option_count('/PERTURB/PART/SOLID',npart_solid)  
c
c     /PERTURB/PART/SHELL
c
      IF (npart_shell > 0) THEN 
        ! Reading routine
        CALL hm_read_perturb_part_shell(
     .      ipart   ,rnoise   ,ipartc ,ipartg    ,igrpart   ,
     .      ipm     ,perturb  ,lsubmodel,unitab  ,idperturb ,
     .      index   ,index_ityp,npart_shell,offs,qp_iperturb,
     .      qp_rperturb)
        ! Computing the offset
        offs = offs + npart_shell
      ENDIF
c
c     /PERTURB/PART/SOLID
c
      IF (npart_solid > 0) THEN 
        ! Reading routine
        CALL hm_read_perturb_part_solid(
     .      ipart   ,rnoise   ,igrpart ,ipm     ,iparts   ,
     .      perturb,lsubmodel ,unitab  ,idperturb,index   ,
     .      index_ityp,npart_solid     ,offs  ,qp_iperturb,
     .      qp_rperturb)
        ! Computing the offset
        offs = offs + npart_solid
      ENDIF
c
c     /PERTURB/FAIL/BIQUAD
c
      CALL hm_read_perturb_fail(mat_param,
     .     ipart    ,rnoise   ,ipartc ,ipartg    ,ipartsp  ,
     .     igrpart  ,iparts   ,perturb   ,idperturb,
     .     index   ,index_ityp,npart_shell,offs ,qp_iperturb,
     .     qp_rperturb,lsubmodel,unitab)
c
c-------------------------------------------------------------
      ! Checking for doubled IDs
      CALL udouble(idperturb,1,nperturb,mess,0,bid)
c-------------------------------------------------------------
      IF (ALLOCATED(index))      DEALLOCATE(index)
      IF (ALLOCATED(index_ityp)) DEALLOCATE(index_ityp)
c-----------
      RETURN
      END