hm_read_grav.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_grav           ../starter/source/loads/general/grav/hm_read_grav.F
!||--- called by ------------------------------------------------------
!||    lectur                 ../starter/source/starter/lectur.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../starter/source/output/message/message.F
!||    hm_get_floatv          ../starter/source/devtools/hm_reader/hm_get_floatv.F
!||    hm_get_floatv_dim      ../starter/source/devtools/hm_reader/hm_get_floatv_dim.F
!||    hm_get_intv            ../starter/source/devtools/hm_reader/hm_get_intv.F
!||    hm_get_string          ../starter/source/devtools/hm_reader/hm_get_string.F
!||    hm_option_read_key     ../starter/source/devtools/hm_reader/hm_option_read_key.F
!||    hm_option_start        ../starter/source/devtools/hm_reader/hm_option_start.F
!||    nodgrnr5               ../starter/source/starter/freform.F
!||    remove_nd              ../starter/source/elements/solid/solide10/dim_s10edg.F
!||    usr2sys                ../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
!||    reader_old_mod         ../starter/share/modules1/reader_old_mod.F90
!||    submodel_mod           ../starter/share/modules1/submodel_mod.F
!||====================================================================
      SUBROUTINE hm_read_grav(IGRV   ,LGRAV   ,GRAV      ,ITAB    ,ITABM1  ,
     .                        IGRNOD ,NPC     ,SENSORS   ,UNITAB  ,ISKN    ,
     .                        ITAGND ,LSUBMODEL)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE unitab_mod
      USE message_mod
      USE groupdef_mod
      USE submodel_mod , ONLY : nsubmod, submodel_data
      USE hm_option_read_mod
      USE sensor_mod
      USE names_and_titles_mod , ONLY : nchartitle, ncharfield
      USE reader_old_mod , ONLY : irec
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      "scr17_c.inc"
#include      "com04_c.inc"
#include      "units_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 
      INTEGER IGRV(NIGRV,NGRAV), LGRAV(*), ITAB(*), ITABM1(*),
     .        npc(*), iskn(liskn,*), itagnd(*)
      my_real
     .   grav(lfacgrv,ngrav)
      TYPE(submodel_data),INTENT(IN)::LSUBMODEL(NSUBMOD)
      TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
C-----------------------------------------------
C     IGRV(LIBRV,NGRAV) 
C-----------------------------------------------
C     IGRV(1,K) : NN Nb of Nodes
C     IGRV(2,K) : NS=10*NOSKEW+IDIR, IDIR=1 (X),2 (Y),3 (Z)
C     IGRV(3,K) : Function (internal) number
C     IGRV(4,K) : IAD Address of nodes in skyline vector LGRAV(IAD:IAD+NN-1)
C     IGRV(5,K) : Option ID
C     IGRV(6,K) : Sensor (internal) number
C-----------------------------------------------
C     LGRAV(1:SLGRAV) skyline vector of nodes numbers (one /GRAV option after the other)
C-----------------------------------------------
C     GRAV(LFACGRV,NGRAV)   
C     GRAV(1,K) : FCY
C     GRAV(2,K) : ONE/FCX
C-----------------------------------------------
      TYPE (GROUP_)  , DIMENSION(NGRNOD)  :: IGRNOD
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      my_real fcx,fcy,fac_fcx,fac_fcy
      INTEGER I, NCUR, NOSKEW,NSKW, ISENS,NN,IGU,IGS,UID,IAD,NS,J,K,ID,NCURS,TSENS, IFLAGUNIT, SUB_INDEX
      CHARACTER(LEN=NCHARFIELD) :: XYZ
      CHARACTER :: X*1, Y*1, Z*1, XX*2, YY*2, ZZ*2, MESS*40
      CHARACTER(LEN=NCHARTITLE)::TITR
      LOGICAL IS_AVAILABLE
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER  USR2SYS,NODGRNR5
      EXTERNAL USR2SYS,NODGRNR5
C-----------------------------------------------
      DATA x/'X'/
      DATA y/'Y'/
      DATA z/'Z'/
      DATA xx/'XX'/
      DATA yy/'YY'/
      DATA zz/'ZZ'/
      DATA mess/'GRAVITY LOADS DEFINITION                '/
C=======================================================================
      is_available = .false.
c
C
      iad=1
      IF(ngrav==0)RETURN   
C
      WRITE (iout,2000)
C--------------------------------------------------
C START BROWSING MODEL GRAV
C--------------------------------------------------
      CALL hm_option_start('/GRAV')
C--------------------------------------------------
C BROWSING MODEL PARTS 1->NGRAV
C--------------------------------------------------
      DO k=1,ngrav
        titr = ''
C--------------------------------------------------
C EXTRACT DATAS OF /PART/... LINE
C--------------------------------------------------
        CALL hm_option_read_key(lsubmodel,
     .                       option_id = id,
     .                       unit_id = uid,
     .                       submodel_index = sub_index,
     .                       option_titr = titr)
C--------------------------------------------------
C EXTRACT DATAS (STRING VALUES)
C--------------------------------------------------
        CALL hm_get_string('rad_dir',xyz,ncharfield,is_available)
C--------------------------------------------------
C EXTRACT DATAS (INTEGER VALUES)
C--------------------------------------------------
        CALL hm_get_intv('curveid',ncur,is_available,lsubmodel)
        CALL hm_get_intv('inputsystem',noskew,is_available,lsubmodel)
        IF(noskew == 0 .AND. sub_index /= 0 ) noskew = lsubmodel(sub_index)%SKEW
        CALL hm_get_intv('rad_sensor_id',isens,is_available,lsubmodel)
        CALL hm_get_intv('entityid',igu,is_available,lsubmodel)
C--------------------------------------------------
C EXTRACT DATAS (REAL VALUES)
C--------------------------------------------------
        CALL hm_get_floatv('xscale',fcx,is_available,lsubmodel,unitab)
        CALL hm_get_floatv_dim('xscale',fac_fcx,is_available,lsubmodel,unitab)
        CALL hm_get_floatv('magnitude',fcy,is_available,lsubmodel,unitab)
        CALL hm_get_floatv_dim('magnitude',fac_fcy,is_available,lsubmodel,unitab)
C--------------------------------------------------
        iflagunit = 0
        DO j=1,unitab%NUNITS
          IF (unitab%UNIT_ID(j) == uid) THEN
            iflagunit = 1
            EXIT
          ENDIF
        ENDDO
        IF (uid/=0.AND.iflagunit==0) THEN
          CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
     .                i2=uid,i1=id,c1='GRAVITY LOAD',
     .                 c2='GRAVITY LOAD',
     .                 c3=titr) 
        ENDIF
        DO j=0,numskw+min(1,nspcond)*numsph+nsubmod
          IF(noskew == iskn(4,j+1)) THEN
            noskew=j+1
            GO TO 100
          ENDIF
        ENDDO
        CALL ancmsg(msgid=137,anmode=aninfo,msgtype=msgerror,
     .              c1='GRAVITY LOAD',
     .              c2='GRAVITY LOAD',
     .              i2=noskew,i1=id,c3=titr)
 100  CONTINUE
 
        IF (fcx == zero) fcx = fac_fcx
        IF (fcy == zero) fcy = fac_fcy
 
        nskw=10*noskew
        ns=0
        IF (xyz(1:1)==x)   THEN
          ns=1+nskw
        ELSEIF(xyz(1:1)==y)THEN
          ns=2+nskw
        ELSEIF(xyz(1:1)==z)THEN
          ns=3+nskw
        ELSE
          xyz='Z'
          ns=3+nskw
c          CALL ANCMSG(MSGID=153,ANMODE=ANINFO,MSGTYPE=MSGERROR,
c     .                C2=XYZ,I1=ID,C1=TITR) 
        ENDIF
C
        IF (igu /= 0) THEN
          nn = nodgrnr5(igu,igs,lgrav(iad),igrnod,itabm1,mess)
        ELSE
          nn = numnod
          DO i=1,numnod
            lgrav(iad-1+i)=i
          ENDDO
        ENDIF
        IF (ns10e > 0 ) CALL remove_nd(nn,lgrav(iad),itagnd)
C
        irec = irec + 1
        igrv(1,k)=nn
        igrv(2,k)=ns
        ncurs=0
        IF(ncur/=0) THEN
          DO j=1,nfunct
            IF(npc(nfunct+j+1)==ncur)ncurs=j
          ENDDO
          IF(ncurs==0)THEN
            CALL ancmsg(msgid=154,anmode=aninfo,msgtype=msgerror,
     .                  i2=ncur,i1=id,c1=titr) 
          ENDIF
        ENDIF
        igrv(3,k)=ncurs
        igrv(4,k)=iad
                 igrv(5,k)=id
        igrv(6,k)=isens
        grav(1,k) = fcy
        grav(2,k) = one/fcx
        tsens=0
        DO j=1,sensors%NSENSOR
          IF(isens/=0) THEN
            IF (igrv(6,k) == sensors%SENSOR_TAB(j)%SENS_ID) tsens=j
          ENDIF
        ENDDO
        IF((tsens==0).AND.(igrv(6,k)/=0))THEN
          CALL ancmsg(msgid=521,anmode=aninfo,msgtype=msgerror,
     .               i2=igrv(6,k),i1=id,c1=titr) 
        ENDIF
        IF (noskew > 0)   noskew = iskn(4,noskew)
        WRITE (iout,3000) noskew,xyz(1:1),
     .                    ncur,isens,fcx,fcy
        WRITE (iout,'(10I10)') (itab(lgrav(j+iad-1)),j=1,nn)
        iad=iad+nn
      ENDDO
C-----------
      RETURN
C-----------
 2000 FORMAT(//
     .'     GRAVITY LOADS  '/
     .'     -------------  '/
     .'        SKEW   DIRECTION    LOAD CURVE',
     .'      SENSOR         SCALE_X             SCALE_Y     ')
 3000 FORMAT(2x,i10,10x,a2,4x,i10,2x,i10,2x,1p2g20.13)
C-----------
      RETURN
      END