hm_read_perturb.F File Reference

#include "implicit_f.inc"
#include "com04_c.inc"
#include "scr17_c.inc"
#include "param_c.inc"
#include "sphcom.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	hm_read_perturb (mat_param, ipart, rnoise, ipartc, ipartg, ipartsp, igrpart, ipm, iparts, perturb, qp_iperturb, qp_rperturb, lsubmodel, unitab)

Function/Subroutine Documentation

hm_read_perturb()

subroutine hm_read_perturb	(	type (matparam_struct_), dimension(nummat), intent(inout)	mat_param,
		integer, dimension(lipart1,*)	ipart,
			rnoise,
		integer, dimension(*)	ipartc,
		integer, dimension(*)	ipartg,
		integer, dimension(*)	ipartsp,
		type (group_), dimension(ngrpart)	igrpart,
		integer, dimension(npropmi,*)	ipm,
		integer, dimension(*)	iparts,
		integer, dimension(nperturb)	perturb,
		integer, dimension(nperturb,6)	qp_iperturb,
			qp_rperturb,
		type(submodel_data), dimension(*)	lsubmodel,
		type (unit_type_), intent(in)	unitab )

Definition at line 38 of file hm_read_perturb.F.

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