hm_read_load_centri.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_load_centri    ../starter/source/loads/general/load_centri/hm_read_load_centri.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
!||--- uses       -----------------------------------------------------
!||    hm_option_read_mod     ../starter/share/modules1/hm_option_read_mod.f
!||    message_mod            ../starter/share/message_module/message_mod.F
!||    r2r_mod                ../starter/share/modules1/r2r_mod.F
!||    submodel_mod           ../starter/share/modules1/submodel_mod.F
!||====================================================================
      SUBROUTINE hm_read_load_centri(ICFIELD,LCFIELD  ,CFIELD  ,ITAB     ,ITABM1 ,
     .                               IGRNOD ,NPC      ,SENSORS ,UNITAB   ,IFRAME ,
     .                               LSUBMODEL)
C
C-----------------------------------------------
C FAC_M FACL FAC_T : enable to convert (custom) input unit to working unit system
C FAC_MASS, FAC_LENGTH, FAC_TIME : enable to convert working unit system into International Unit system
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE unitab_mod
      USE r2r_mod
      USE message_mod
      USE groupdef_mod
      USE submodel_mod
      USE hm_option_read_mod
      USE sensor_mod
      USE names_and_titles_mod , ONLY : nchartitle, ncharfield
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      "param_c.inc"
#include      "com04_c.inc"
#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 ICFIELD(SIZFIELD,*), LCFIELD(*), ITAB(*), ITABM1(*), 
     .  npc(*),iframe(liskn,*)
      my_real cfield(lfacload,*)
C-----------------------------------------------
      TYPE (GROUP_)  , DIMENSION(NGRNOD)  :: IGRNOD
      TYPE (SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
      TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
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,J,K,K1,K2,NOD, NCUR, IFRA, ISENS,NN,IGU,IGS,
     .        UID,IAD,ID,IFLAGUNIT,NCURS,TSENS,IFRAS, IVAR, ISU, IDIR,
     .        sub_index, sub_id
      INTEGER FLAG_FMT,FLAG_FMT_TMP,IFIX_TMP
      CHARACTER MESS*40,char_X*1, char_Y*1, char_Z*1, char_XX*2, char_YY*2, char_ZZ*2
      CHARACTER(LEN=NCHARFIELD) :: XYZ
      CHARACTER(LEN=NCHARTITLE)::TITR
      LOGICAL IS_AVAILABLE
 
      DATA char_x/'X'/
      DATA char_y/'Y'/
      DATA char_z/'Z'/
      DATA char_xx/'XX'/
      DATA char_yy/'YY'/
      DATA char_zz/'ZZ'/
      DATA mess/'CENTRIFUGAL LOAD DEFINITION           '/
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER  NODGRNR5
      EXTERNAL NODGRNR5
C-----------------------------------------------
C   C o m m e n t s
C-----------------------------------------------      
C
C                         /LOAD/CENTRI              
C
C     ICFIELD(SIZFIELD,NLOADC)
C     ICFIELD(1,K) :   NN           Nb of nodes                                            
C     ICFIELD(2,K) :   IDIR         Direction of the load               
C     ICFIELD(3,K) :   NCURS        Velocity function internal number                              
C     ICFIELD(4,K) :   IAD          Address of nodes in skyline vector LCFIELD
C     ICFIELD(5,K) :   1            ! Type /LOAD/CENTRI   
C     ICFIELD(6,K) :   TSENS        Sensor internal number                                          
C     ICFIELD(7,K) :   IFRAS        Frame internal number                 
C     ICFIELD(8,K) :   IVAR         Flag for vel variation 
C     ICFIELD(9,K) :   ID           User ID of this /LOAD/CENTRI 
C     ICFIELD(10,K):                                                                               
C     ICFIELD(11,K):                                                     
C     ICFIELD(12,K):                                                     
C     ICFIELD(13,K):                                                        
C-----------------------------------------------
C     LCFIELD(SLCFIELD) skyline vector of nodes vs all /LOAD/CENTRI
C-----------------------------------------------
C     CFIELD(LFACLOAD,NLOADC)
C     CFIELD(1,K) : FCY
C     CFIELD(2,K) : ONE/FCX
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------      
      is_available = .false.
 
      iad          = 1
      nn           = 0 
      
C--------------------------------------------------
C START BROWSING MODEL CLOAD
C--------------------------------------------------
      CALL hm_option_start('/LOAD/CENTRI')
C--------------------------------------------------
C BROWSING MODEL 1..NLOADC
C--------------------------------------------------
      DO k=1,nloadc
C--------------------------------------------------
C EXTRACT DATAS OF /LOAD/CENTRI... LINE
C--------------------------------------------------
        CALL hm_option_read_key(lsubmodel,
     .                       option_id = id,
     .                       unit_id = uid,
     .                       submodel_id = sub_id,
     .                       submodel_index = sub_index,
     .                       option_titr = titr)
C--------------------------------------------------
C EXTRACT DATAS (STRING VALUES)
C--------------------------------------------------
        xyz = ''
        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',ifra,is_available,lsubmodel)
        IF(ifra == 0 .AND. sub_id /= 0 ) THEN
          CALL ancmsg(msgid   = 1712,
     .                anmode  = aninfo,
     .                msgtype = msgwarning,
     .                i1      = id,
     .                i2      = sub_id,
     .                c1      = '/LOAD/CENTRI - frame_ID=0',
     .                c2      = titr)  
        END IF
        CALL hm_get_intv('rad_sensor_id',isens,is_available,lsubmodel)
        CALL hm_get_intv('entityid',igu,is_available,lsubmodel)
        CALL hm_get_intv('rad_ivar_flag',ivar,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      = 'CENTRIFUGAL LOAD',
     .                c2      = 'CENTRIFUGAL LOAD',
     .                c3      = titr)  
        ENDIF
C----------- 
        idir=0       
        IF(xyz(1:1)==char_x) idir=1
        IF(xyz(1:1)==char_y) idir=2
        IF(xyz(1:1)==char_z) idir=3
        IF(xyz(1:2)==char_xx)idir=4
        IF(xyz(1:2)==char_yy)idir=5
        IF(xyz(1:2)==char_zz)idir=6
        IF(idir==0) THEN
           CALL ancmsg(msgid=881,
     .                 msgtype=msgerror,
     .                 anmode=aninfo_blind_1,
     .                 i1=id,
     .                 c1=xyz)
        ENDIF
C-----------        
        ncurs=0
        DO j=1,nfunct
          IF(npc(nfunct+j+1)==ncur)ncurs=j
        ENDDO
        IF(ncurs==0)THEN
          CALL ancmsg(msgid=883,
     .                msgtype=msgerror,
     .                anmode=aninfo_blind_1,
     .                i1=id,
     .                c1=titr,
     .                i2=ncur)
        ENDIF
C-----------        
        IF (fcx == zero) fcx = fac_fcx
        IF (fcy == zero) fcy = fac_fcy
C-----------        
        IF(ifra /=0)THEN
          DO j=0,numfram
            IF(ifra==iframe(4,j+1)) THEN
              ifras=j
              EXIT
            ENDIF
            IF (j==numfram) THEN
              CALL ancmsg(msgid=490,
     .             msgtype=msgerror,
     .             anmode=aninfo_blind_1,
     .             c1='/LOAD/CENTRI',
     .             i1=id,
     .             c2='/LOAD/CENTRI',
     .             c3=titr,
     .             i2=ifra)
            ENDIF
          ENDDO
        ELSE
          ifras=0
        ENDIF
C-----------        
        tsens = 0
                 IF (isens/=0) THEN
          DO j=1,sensors%NSENSOR
                     IF (isens == sensors%SENSOR_TAB(j)%SENS_ID) tsens=j
                   ENDDO
                   IF (tsens==0) THEN
             CALL ancmsg(msgid=884, msgtype=msgerror, anmode=aninfo_blind_1,
     .            i1=id,
     .            c1=titr,
     .            i2=isens)
                   ENDIF
                 ENDIF
C-----------        
        nn = nodgrnr5(igu,igs,lcfield(iad),igrnod,itabm1,mess)
C-----------        
        IF (ivar == 0) ivar = 1
C-----------        
                 icfield(1,k)  = nn
                 icfield(2,k)  = idir
        icfield(3,k)  = ncurs
        icfield(4,k)  = iad
        icfield(5,k)  = 1 ! Type /LOAD/CENTRI
        icfield(6,k)  = tsens
        icfield(7,k)  = ifras
        icfield(8,k)  = ivar
        icfield(9,k)  = id
        cfield(1,k)   = fcy
        cfield(2,k)   = one/fcx
C-----------
        IF (ivar == 1)THEN
          WRITE (iout,2000) id
        ELSE
          WRITE (iout,2001) id
        ENDIF
        WRITE (iout,'(I10,2X,I10,4X,A2,2X,I10,2X,I10,2X,
     .              1PG20.13,2X,1PG20.13)')
     .     igu,ifra,xyz(1:2),
     .     ncur,isens,fcx,fcy
C---------
        iad = iad + nn  !  NUMCENTRI
     
      ENDDO ! next K (next /LOAD/CENTRI)
C--------------------------------------------------------------------------------
      RETURN
C--------------------------------------------------------------------------------     
 2000 FORMAT(//
     .'     CENTRIFUGAL LOAD. . . . . . . . . . . . . . .  . . .',i10/
     .'     VARIATION OF VELOCITY FUNCTION NOT TAKEN INTO ACCOUNT'/
     .'     ------------------  '/
     .'NODE GROUP       FRAME   DIR  LOAD_CURVE      SENSOR',
     .'           SCALE_X               SCALE_Y')
 
 2001 FORMAT(//
     .'     CENTRIFUGAL LOAD. . . . . . . . . . . . . . .  . . .',i10/
     .'     VARIATION OF VELOCITY FUNCTION TAKEN INTO ACCOUNT'/
     .'     ------------------  '/
     .'NODE GROUP       FRAME   DIR  LOAD_CURVE      SENSOR',
     .'           SCALE_X               SCALE_Y')
C-----------------------------------------------
     
      END