hm_read_spcnd.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_spcnd          ../starter/source/constraints/sph/hm_read_spcnd.F
!||--- called by ------------------------------------------------------
!||    lectur                 ../starter/source/starter/lectur.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../starter/source/output/message/message.F
!||    fretitl                ../starter/source/starter/freform.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
!||    hm_sz_r2r              ../starter/source/coupling/rad2rad/routines_r2r.F
!||    ngr2usr                ../starter/source/system/nintrr.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_spcnd(ISPCOND ,ISKEW  ,ITAB   ,ITABM1 ,IKINE  ,
     .                         IGRNOD  ,NOD2SP ,IFRAME ,NOM_OPT,LSUBMODEL)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE r2r_mod
      USE groupdef_mod
      USE submodel_mod        
      USE hm_option_read_mod
      USE names_and_titles_mod , ONLY : nchartitle, ncharkey, 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      "scr17_c.inc"
#include      "com04_c.inc"
#include      "sphcom.inc"
#include      "units_c.inc"
#include      "param_c.inc"
#include      "r2r_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ISPCOND(NISPCOND,*), ISKEW(*), ITAB(*), ITABM1(*),
     .        ikine(*),nod2sp(*),iframe(liskn,*)
      INTEGER NOM_OPT(LNOPT1,*)
      TYPE(submodel_data) 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,ID, IC, IS,
     .        nosys, j,igr,igrs,
     .        ncell,
     .        ilev, ny
      CHARACTER MESS*40
      CHARACTER(LEN=NCHARTITLE) :: TITR
      CHARACTER(LEN=NCHARKEY) :: KEY
      CHARACTER(LEN=NCHARFIELD) :: DIR
      LOGICAL IS_AVAILABLE
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER NGR2USR
      INTEGER, DIMENSION(:), POINTER :: INGR2USR
C-----------------------------------------------
      DATA mess/'SPECIFIC TO SPH SYMMETRY CONDITIONS      '/
C-----------------------------------------------
      WRITE(iout,1000)
      ny = 0
      CALL hm_option_start('/SPHBCS')
 
        DO i=1,nspcond
          ny=ny+1
C----------Multidomaines --> on ignore les BCS SPH non tagees-----------
          IF(nsubdom>0)THEN
              IF(tagsphbcs(ny)==0)CALL hm_sz_r2r(tagsphbcs,ny,lsubmodel)
          END IF
C--------------------------------------------------
C EXTRACT DATAS OF /SPHBCS/... LINE
C--------------------------------------------------
          CALL hm_option_read_key(lsubmodel,
     .                         option_id = id,
     .                         option_titr = titr,
     .                         keyword2 = key)
          nom_opt(1,i)=id
          CALL fretitl(titr,nom_opt(lnopt1-ltitr+1,i),ltitr)
          IF (key(1:5)=='SLIDE')THEN
           ispcond(5,i)=1
          ELSEIF (key(1:4)=='TIED')THEN
           ispcond(5,i)=0
          ELSE
             CALL ancmsg(msgid=398,
     .                   msgtype=msgerror,
     .                   anmode=aninfo_blind_1,
     .                   c1=key)
          ENDIF
          ispcond(nispcond,i)=id
C--------------------------------------------------
C EXTRACT DATAS (INTEGER VALUES)
C--------------------------------------------------
          CALL hm_get_intv('inputsystem',is,is_available,lsubmodel)
          CALL hm_get_intv('entityid',igr,is_available,lsubmodel)
          CALL hm_get_intv('rad_sphbcs_ilev',ilev,is_available,lsubmodel)
C--------------------------------------------------
C EXTRACT DATAS (STRING)
C--------------------------------------------------
          CALL hm_get_string('rad_dir',dir,ncharfield,is_available)
C
          IF(dir(1:1)=='X')THEN
            ic=1
          ELSEIF(dir(1:1)=='Y')THEN
            ic=2
          ELSEIF(dir(1:1)=='Z')THEN
            ic=3
          ENDIF
          IF(ilev/=0.AND.ilev/=1)THEN
             CALL ancmsg(msgid=399,
     .                   msgtype=msgerror,
     .                   anmode=aninfo_blind_1,
     .                   i1=ilev)
          ENDIF
          ispcond(1,i)=ilev
          ispcond(2,i)=ic
          IF (is==0)THEN
           ispcond(3,i)=1
           GOTO 111
          ELSE
           DO j=1,numfram
            IF (iframe(4,j+1)==is)THEN
             ispcond(3,i)=j+1
             GOTO 111
            ENDIF
           ENDDO
          ENDIF
             CALL ancmsg(msgid=400,
     .                   msgtype=msgerror,
     .                   anmode=aninfo_blind_1,
     .                   i1=is)
 111      CONTINUE
C
          ingr2usr => igrnod(1:ngrnod)%ID
          igrs=ngr2usr(igr,ingr2usr,ngrnod)
          ispcond(4,i)=igrs
C
          DO nosys=1,numnod
              ncell=nod2sp(nosys)
              IF (ncell==0) THEN
              ELSE
              ENDIF
          ENDDO
          WRITE(iout,1100)id,trim(titr),dir(1:1),is,igr,ilev
        ENDDO
C-------------------------------------
      RETURN
C
1000  FORMAT(
     . '      SPECIFIC TO SPH SYMMETRY CONDITIONS '/
     . '      ---------------------------------- '/)
1100  FORMAT(/5x,'CONDITION ID                               ',i10,1x,a
     .       /10x,'NORMAL DIRECTION TO SYMMETRY PLANE         ',a10,
     .       /10x,'REFERENCE FRAME ID                        ',i10,
     .       /10x,'NODES GROUP ID FOR KINEMATIC CONDITIONS   ',i10,
     .       /10x,'FORMULATION LEVEL                         ',i10)
      END