hm_read_alebcs.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_alebcs         ../starter/source/constraints/ale/hm_read_alebcs.F
!||--- called by ------------------------------------------------------
!||    lectur                 ../starter/source/starter/lectur.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../starter/source/output/message/message.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
!||    ngr2usr                ../starter/source/system/nintrr.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
!||    submodel_mod           ../starter/share/modules1/submodel_mod.F
!||====================================================================
      SUBROUTINE hm_read_alebcs(ICODE     ,ISKEW   ,ITAB    ,ITABM1   ,IKINE  ,
     .                          IGRNOD    ,IBCSLAG ,LAG_NCF ,LAG_NKF  ,LAG_NHF,
     .                          IKINE1LAG ,ISKN    ,NOM_OPT, LSUBMODEL)
C-----------------------------------------------
C   D e s c r i p t i o n
C-----------------------------------------------
C This subroutine is reading /ALE/BCS options in user input file
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 names_and_titles_mod , ONLY : ncharfield, nchartitle
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      "param_c.inc"
#include      "scr10_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER,INTENT(IN) ::  ITAB(NUMNOD), ITABM1(*), IKINE(*), IBCSLAG(5,*), LAG_NCF,LAG_NKF,LAG_NHF,IKINE1LAG(*),ISKN(LISKN,*)
      INTEGER,INTENT(IN) ::  NOM_OPT(LNOPT1,*)
      INTEGER,INTENt(INOUT) :: ISKEW(*),ICODE(NUMNOD)
      TYPE(submodel_data), INTENT(IN), DIMENSION(NSUBMOD) :: LSUBMODEL
C-----------------------------------------------
      TYPE (GROUP_)  ,TARGET, DIMENSION(NGRNOD)  :: IGRNOD
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, IC, NC, N, IS, IC1, IC2,
     .        NOSYS, J,IGR,IGRS,IBCALE,J6(6),
     .        ic0, ic01, ic02, ic03, ic04, id ,ilagm,
     .        chkcod,nod,sub_index
      INTEGER IUN
      CHARACTER MESS*40,CODE*7
      CHARACTER(LEN=NCHARFIELD) :: STRING
      CHARACTER(LEN=NCHARTITLE) :: TITR
      LOGICAL :: IS_AVAILABLE, FOUND
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER USR2SYS,MY_OR,CHECK_NEW,NGR2USR
      INTEGER, DIMENSION(:), POINTER :: INGR2USR
C-----------------------------------------------
C   D a t a
C-----------------------------------------------
      DATA iun/1/
      DATA mess/'BOUNDARY CONDITIONS                     '/
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
      is_available = .false.
      sub_index = 0
 
      CALL hm_option_start('/ALE/BCS')
 
      DO i = 1, nalebcs
         CALL hm_option_read_key(lsubmodel,
     .                       option_id = id,
     .                       option_titr = titr,
     .                       submodel_index = sub_index)
         CALL hm_get_string('dofstring', string, ncharfield, is_available)
         CALL hm_get_intv('inputsystem', is, is_available, lsubmodel)
         IF(is == 0 .AND. sub_index /= 0 ) is = lsubmodel(sub_index)%SKEW
         CALL hm_get_intv('entityid', igr, is_available, lsubmodel)
         found = .false.
         DO j = 0, numskw + nsubmod
            IF(is == iskn(4, j + 1)) THEN
               is = j + 1
               found = .true.
               EXIT
            ENDIF
         ENDDO
         IF (.NOT. found) THEN
            CALL ancmsg(msgid = 137, anmode = aninfo, msgtype = msgerror,
     .           c1 = 'BOUNDARY CONDITION', c2 = 'BOUNDARY CONDITION',
     .           i2 = is, i1 = n, c3 = titr)
         ENDIF
!         CODE = STRING(LFIELD - 6 : LFIELD)
         code = string(1:7)
         READ(code,fmt='(3I1,1X,3I1)') j6
         chkcod = 0
         DO j=1,6
            IF (j6(j) >= 2) THEN
               chkcod = 1
            ENDIF
         ENDDO
         IF (chkcod == 1) THEN
           CALL ancmsg(msgid = 1051, anmode = aninfo_blind,msgtype = msgerror, i1 = id, c1 = titr, c2 = code)
         ENDIF
         ic1=j6(1)*4 +j6(2)*2 +j6(3)
         ic2=j6(4)*4 +j6(5)*2 +j6(6)
         ic=ic1*8+ic2
         ingr2usr => igrnod(1:ngrnod)%ID
         igrs=ngr2usr(igr,ingr2usr,ngrnod)
         IF(igrs /= 0)THEN
            DO j=1,igrnod(igrs)%NENTITY
               nosys=igrnod(igrs)%ENTITY(j)
               icode(nosys)=my_or(ic,icode(nosys))
               IF(iskew(nosys) == -1.OR.iskew(nosys) == is)THEN
                  check_new=is
               ELSE
                  CALL ancmsg(msgid=148,anmode=aninfo,msgtype=msgerror,i1=itab(nosys),prmod=msg_cumu)
               ENDIF
               iskew(nosys)=check_new
            ENDDO
            CALL ancmsg(msgid=148,anmode=aninfo,msgtype=msgerror,i1=id,c1=titr,prmod=msg_print)
         ELSE
            CALL ancmsg(msgid=678,anmode=aninfo,msgtype=msgerror,i1=id,i2=igr,c1=titr)
         ENDIF
      ENDDO
C-----------------------------------------------      
      RETURN
      END