hm__read__impvel_8F_source.html

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_impvel       ../starter/source/constraints/general/impvel/hm_read_impvel.F

!||--- called by ------------------------------------------------------

!||    lectur               ../starter/source/starter/lectur.F

!||--- calls      -----------------------------------------------------

!||    hm_option_count      ../starter/source/devtools/hm_reader/hm_option_count.F

!||    read_impdisp         ../starter/source/constraints/general/impvel/read_impdisp.F

!||    read_impdisp_fgeo    ../starter/source/constraints/general/impvel/read_impdisp_fgeo.F

!||    read_impvel          ../starter/source/constraints/general/impvel/read_impvel.F

!||    read_impvel_fgeo     ../starter/source/constraints/general/impvel/read_impvel_fgeo.F

!||    read_impvel_lagmul   ../starter/source/constraints/general/impvel/read_impvel_lagmul.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_impvel(

     .           FBFVEL   ,IBFVEL   ,IKINE    ,IKINE1LAG,

     .           ITAB     ,ITABM1   ,IGRNOD   ,X0       ,IXR      ,

     .           IPART    ,IPARTR   ,ISKN     ,NOM_OPT  ,

     .           NIMPDISP ,NIMPVEL  ,UNITAB   ,LSUBMODEL)

C============================================================================

C   M o d u l e s

C-----------------------------------------------

      USE message_mod

      USE groupdef_mod

      USE submodel_mod

      USE hm_option_read_mod

      USE unitab_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"

C-----------------------------------------------

C   D u m m y   A r g u m e n t s

C-----------------------------------------------

      INTEGER :: NIMPDISP,NIMPVEL

      INTEGER ,DIMENSION(*)  :: ITAB,ITABM1,IKINE,IKINE1LAG,IPARTR

      INTEGER ,DIMENSION(LISKN,*)           ,INTENT(IN)  :: ISKN

      INTEGER ,DIMENSION(LIPART1,*)         ,INTENT(IN)  :: IPART

      INTEGER ,DIMENSION(NIXR,*)            ,INTENT(IN)  :: IXR

      INTEGER ,DIMENSION(LNOPT1,*)          ,INTENT(OUT) :: NOM_OPT

      INTEGER ,DIMENSION(NIFV,NFXVEL)       ,INTENT(OUT) :: IBFVEL

      my_real ,DIMENSION(LFXVELR,NFXVEL)    ,INTENT(OUT) :: fbfvel

      TYPE(UNIT_TYPE_),INTENT(IN)  :: UNITAB

      my_real ,DIMENSION(3,NUMNOD)          ,INTENT(IN)  :: x0

      TYPE (GROUP_)      ,DIMENSION(NGRNOD) ,INTENT(IN)  :: IGRNOD

      TYPE(submodel_data),DIMENSION(*)      ,INTENT(IN)  :: LSUBMODEL

C-----------------------------------------------

C   L o c a l   V a r i a b l e s

C-----------------------------------------------

      INTEGER IOPT,INUM,NOPT,NFDISP,NFVEL,FGEOD,FGEOV,NIMPDISP_0,LAGMULV

      INTEGER ,DIMENSION(:), ALLOCATABLE  :: OPTID

      CHARACTER(nchartitle)  :: MESS

C-----------------------------------------------

C   D a t a

C-----------------------------------------------

      DATA mess/'imposed velocity definition  '/

C======================================================================|

      INUM = 0  ! init index of IBFVEL,FBFVEL (imposed node counter)

      IOPT = 0  ! init counter of impdisp, impvel and impacc options

c--------------------------------------------------

c     READ /IMPDISP

c--------------------------------------------------

c

      CALL HM_OPTION_COUNT('/impdisp'     ,NIMPDISP )

      NIMPDISP_0 = NIMPDISP

      CALL HM_OPTION_COUNT('/impdisp/fgeo',FGEOD)

c

      CALL HM_OPTION_COUNT('/impvel'       ,NIMPVEL )

      CALL HM_OPTION_COUNT('/impvel/fgeo'  ,FGEOV)

      CALL HM_OPTION_COUNT('/impvel/lagmul',LAGMULV)

c

      NFDISP = NIMPDISP - FGEOD

      NFVEL  = NIMPVEL  - FGEOV - LAGMULV

      NOPT   = NFDISP + NFVEL

c

c--------------------------------------------------

      IF (NIMPDISP > 0) THEN


        IF (NFDISP > 0) THEN

          CALL READ_IMPDISP(

     .         NIMPDISP ,INUM     ,IOPT     ,FBFVEL   ,IBFVEL   ,

     .         ITAB     ,ITABM1   ,IKINE    ,IGRNOD   ,NOM_OPT  ,

     .         ISKN     ,UNITAB   ,LSUBMODEL)

        ENDIF

c

        IF (FGEOD > 0) THEN

          CALL READ_IMPDISP_FGEO(

     .         FGEOD    ,INUM     ,IOPT     ,FBFVEL   ,IBFVEL   ,

     .         ITAB     ,ITABM1   ,IGRNOD   ,NOM_OPT  ,X0       ,

     .         IXR      ,IPART    ,IPARTR   ,UNITAB   ,LSUBMODEL)

        ENDIF

c

c       TEST DOUBLE IDs of IMPDISP

c

        ALLOCATE( OPTID(NIMPDISP) )

        OPTID(1:NIMPDISP) = NOM_OPT(1,1:NIMPDISP)

        CALL UDOUBLE(OPTID,1,NIMPDISP,MESS,0,ZERO)

        DEALLOCATE( OPTID )

c

      END IF  ! NIMPDISP > 0

      NIMPDISP = INUM

c

c--------------------------------------------------

c     READ /IMPVEL

c--------------------------------------------------

      IF (NIMPVEL > 0) THEN


c

        IF (NFVEL > 0) THEN

          CALL READ_IMPVEL(

     .              NIMPVEL  ,INUM     ,IOPT     ,FBFVEL   ,IBFVEL   ,

     .              ITAB     ,ITABM1   ,IKINE    ,IKINE1LAG,NOM_OPT  ,

     .              IGRNOD   ,ISKN     ,UNITAB   ,LSUBMODEL)

        END IF

c

c       READ /IMPVEL/FGEO

c

        IF (FGEOV > 0) THEN

          CALL READ_IMPVEL_FGEO(

     .              FGEOV    ,INUM     ,IOPT     ,FBFVEL   ,IBFVEL   ,

     .              ITAB     ,ITABM1   ,IGRNOD   ,NOM_OPT  ,X0       ,

     .              IXR      ,IPART    ,IPARTR   ,UNITAB   ,LSUBMODEL)

        END IF

c

c       READ /IMPVEL/LAGMUL

c

        IF (LAGMULV > 0) THEN

          CALL READ_IMPVEL_LAGMUL(

     .              LAGMULV  ,INUM     ,IOPT     ,FBFVEL   ,IBFVEL   ,

     .              ITAB     ,ITABM1   ,IGRNOD   ,NOM_OPT  ,X0       ,

     .              IXR      ,IPART    ,IPARTR   ,ISKN     ,IKINE    ,

     .              UNITAB   ,LSUBMODEL)

        END IF

c

c       TEST DOUBLE IDs of IMPVEL

c

        ALLOCATE( OPTID(NIMPVEL) )

        OPTID(1:NIMPVEL) = NOM_OPT(1,NIMPDISP_0+1:NIMPVEL+NIMPDISP_0)

        CALL UDOUBLE(OPTID,1,NIMPVEL,MESS,0,ZERO)

        DEALLOCATE( OPTID )

c

      END IF  ! NIMPVEL > 0

c-----------

      NIMPVEL = INUM - NIMPDISP

      NFXVEL  = INUM

c--------------------------------------------------

      RETURN


      END

my_real
#define my_real
Definition cppsort.cpp:32

hm_read_impvel
subroutine hm_read_impvel(fbfvel, ibfvel, ikine, ikine1lag, itab, itabm1, igrnod, x0, ixr, ipart, ipartr, iskn, nom_opt, nimpdisp, nimpvel, unitab, lsubmodel)
Definition hm_read_impvel.F:45

groupdef_mod
Definition groupdef_mod.F:662

hm_option_read_mod
Definition hm_option_read_mod.F:408

message_mod
Definition message_mod.F:1249

submodel_mod
Definition submodel_mod.F:712

unitab_mod
Definition unitab_mod.F:513

udouble
subroutine udouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:589

starter
program starter
Definition starter.F:39

submodel_mod::submodel_data
Definition submodel_mod.F:723