hm_read_sms.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_sms          ../starter/source/general_controls/computation/hm_read_sms.F
!||--- called by ------------------------------------------------------
!||    contrl               ../starter/source/starter/contrl.F
!||--- calls      -----------------------------------------------------
!||    find_yield_engine    ../starter/source/general_controls/computation/hm_read_sms.F
!||    hm_get_intv          ../starter/source/devtools/hm_reader/hm_get_intv.F
!||    hm_option_count      ../starter/source/devtools/hm_reader/hm_option_count.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
!||--- uses       -----------------------------------------------------
!||    hm_option_read_mod   ../starter/share/modules1/hm_option_read_mod.F
!||    submodel_mod         ../starter/share/modules1/submodel_mod.F
!||====================================================================
      SUBROUTINE hm_read_sms(LSUBMODEL)
C-----------------------------------------------
C   ROUTINE DESCRIPTION :
C   ===================
C   READ /AMS USING HM_READER
C-----------------------------------------------
C   DUMMY ARGUMENTS DESCRIPTION:
C   ===================
C     NAME            DESCRIPTION                         
C     LSUBMODEL       SUBMODEL STRUCTURE     
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE hm_option_read_mod
      USE submodel_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      "com01_c.inc"
#include      "sms_c.inc"
#include      "units_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
C INPUT ARGUMENTS
      TYPE(submodel_data),INTENT(IN)::LSUBMODEL(*)
C OUTPUT ARGUMENTS
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,NB_AMS,SUB_ID
      LOGICAL IS_AVAILABLE
      CHARACTER MESS*40
      DATA mess /'SETTINGS FOR ADVANCED MASS SCALING      '/
C============================================================================
      is_available = .false.
C----------------------------------------------
C     ISMS_SELEC = 0 --> No AMS
C     ISMS_SELEC = 1 --> Full AMS
C     ISMS_SELEC = 2 --> AMS by parts
C     ISMS_SELEC = 3 --> AMS auto
C     ISMS_SELEC = 4 --> AMS auto + parts
 
      isms=0
      isms_selec = 0
C
      CALL hm_option_count('/AMS', nb_ams)
      CALL hm_option_start('/AMS')
      DO i=1,nb_ams
        CALL hm_option_read_key(lsubmodel,
     .                       submodel_id = sub_id)
        isms=1
        CALL hm_get_intv('GRPART_ID',idtgrs,is_available,lsubmodel)
      ENDDO
C
      IF(isms /= 0)THEN
C
        WRITE(iout,2000)
C
C       Engine file is checked for automatic element selection activation
        dt_sms_switch = zero
        CALL find_yield_engine(dt_sms_switch)
C
        IF (dt_sms_switch==zero) THEN
          IF (idtgrs==0) THEN
            WRITE(iout,2100)
            isms_selec = 1
          ELSE
            WRITE(iout,2200) idtgrs
            isms_selec = 2
          ENDIF
        ELSE
          IF (idtgrs==0) THEN
            isms_selec = 3
          ELSE
            WRITE(iout,2200) idtgrs
            isms_selec = 4
          ENDIF
          WRITE(iout,2300) dt_sms_switch    
        ENDIF
C
        idtgrs = -idtgrs
        irest_mselt=1
      END IF                            
C--------------------------------------------------
 2000 FORMAT(//
     .  '    ADVANCED MASS SCALING:                           ',/
     .  '    ---------------------                            ')
 2100 FORMAT(/
     .  '    SELECTIVE MASS SCALING APPLIED TO ALL PARTS')
 2200 FORMAT(/
     .  '    ADVANCED MASS SCALING APPLIED ON GROUP OF PARTS . . . .',i10)
 2300 FORMAT(/
     .  '    AUTOMATIC ELEMENT SELECTION ENABLED (/DT/CST_AMS DETECTED IN ENGINE INPUT FILE)',/
     .  '    TIME STEP CRITERIA FOR AMS ACTIVATION. . . . . .  . . .',1pg20.13)
C--------------------------------------------------
      RETURN
      END
!||====================================================================
!||    find_yield_engine   ../starter/source/general_controls/computation/hm_read_sms.F
!||--- called by ------------------------------------------------------
!||    hm_read_sms         ../starter/source/general_controls/computation/hm_read_sms.F
!||--- calls      -----------------------------------------------------
!||    ancmsg              ../starter/source/output/message/message.f
!||--- uses       -----------------------------------------------------
!||    message_mod         ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE find_yield_engine(DT_SMS_SWITCH)
      USE inoutfile_mod
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_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      "scr15_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      my_real
     .   dt_sms_switch
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER IO_ERR1
      CHARACTER FILNAM*109, KEYA*80, KEYA2*80
      my_real
     .   dtsca,dtmini
      INTEGER :: LEN_TMP_NAME
      CHARACTER(len=2148) :: TMP_NAME
C-----------------------------------------------
 
C-----------------------------------------------
C     Lecture des donnes dans le fichier engine
C-----------------------------------------------   
      filnam=rootnam(1:rootlen)//'_0001.rad'
 
      len_tmp_name = infile_name_len+rootlen+9
      tmp_name=infile_name(1:infile_name_len)//filnam(1:rootlen+9)
      OPEN(unit=71,file=tmp_name(1:len_tmp_name),
     .     access='SEQUENTIAL',status='OLD',iostat=io_err1)
C
      IF (io_err1/=0) THEN
         filnam=rootnam(1:rootlen)//'D01'
      len_tmp_name = infile_name_len+rootlen+9
      tmp_name=infile_name(1:infile_name_len)//filnam(1:rootlen+3)
         OPEN(unit=71,file=tmp_name(1:len_tmp_name),
     .        access='SEQUENTIAL',status='OLD',iostat=io_err1)
      ENDIF      
 
      IF (io_err1==0) THEN
C
 10     READ(71,'(A)',END=20) keya
C
        IF(keya(1:11)=='/DT/CST_AMS') THEN
 30       READ(71,'(A)',END=20) keya
          IF ((keya(1:1)=='#').OR.(keya(1:1)=='$')) THEN
            GOTO 30
          ELSE
            backspace(71)
          ENDIF
          READ(71,*,END=20) DTSCA,dtmini
          IF (dtsca == zero) dtsca = zep9
          dt_sms_switch = dtmini / dtsca      
        ENDIF
C
        GOTO 10
C
 20     CONTINUE
 
        CLOSE(71)
C
      ELSE
C
        CALL ancmsg(msgid=1570,
     .              msgtype=msgwarning,
     .              anmode=aninfo_blind_2,
     .              c1=rootnam(1:rootlen)//'_0001.rad',
     .              c2=rootnam(1:rootlen)//'D01')   
C
      ENDIF
                   
C------------------------------------------- 
      RETURN
      END
!||====================================================================
!||    inisms         ../starter/source/general_controls/computation/hm_read_sms.F
!||--- called by ------------------------------------------------------
!||    lectur         ../starter/source/starter/lectur.F
!||--- uses       -----------------------------------------------------
!||    message_mod    ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE inisms(
     .       IGRPART  ,IPARTS     ,IPARTQ   ,IPARTC  ,
     .       IPARTT   ,IPARTP     ,IPARTR   ,IPARTTG ,
     .       IPARTX   ,TAGPRT_SMS )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE groupdef_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      "sms_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
       INTEGER IPARTS(*),IPARTQ(*),IPARTC(*),IPARTT(*),
     .   IPARTP(*),IPARTR(*),IPARTTG(*),IPARTX(*),
     .   TAGPRT_SMS(*)
C-----------------------------------------------
      TYPE (GROUP_)  , DIMENSION(NGRPART)  :: IGRPART
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER KK, N, I, IAD, IP, 
     .        NG, J, ITY, NEL, NFT
C--------------------------------------------------
       IF(idtgrs/=0)THEN
C------
        IF(idtgrs < 0)THEN
          idtgrs=-idtgrs
 
          kk=ngrnod+
     +          ngrbric+ngrquad+ngrshel+ngrsh3n+ngrtrus+ngrbeam+ngrspri
          DO n=1,ngrpart
            IF (igrpart(n)%ID == idtgrs) THEN
              idtgrs=n
              GO TO 100
            END IF
          END DO
 200      CALL ancmsg(msgid=738,
     .                msgtype=msgerror,
     .                anmode=aninfo,
     .                i1=idtgrs)
 100      CONTINUE
          DO i=1,igrpart(idtgrs)%NENTITY
            ip=igrpart(idtgrs)%ENTITY(i)
            tagprt_sms(ip)=1
          END DO       
        END IF
C------
      ELSEIF (isms_selec/=3) THEN
C------
        DO ip=1,npart
          tagprt_sms(ip)=1
        END DO
C
      END IF
C--------------------------------------------------
      RETURN
      END