OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_spcnd.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| hm_read_spcnd ../starter/source/constraints/sph/hm_read_spcnd.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.f
29!|| fretitl ../starter/source/starter/freform.F
30!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
31!|| hm_get_string ../starter/source/devtools/hm_reader/hm_get_string.F
32!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
33!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
34!|| hm_sz_r2r ../starter/source/coupling/rad2rad/routines_r2r.F
35!|| ngr2usr ../starter/source/system/nintrr.F
36!||--- uses -----------------------------------------------------
37!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
38!|| message_mod ../starter/share/message_module/message_mod.F
39!|| r2r_mod ../starter/share/modules1/r2r_mod.F
40!|| submodel_mod ../starter/share/modules1/submodel_mod.F
41!||====================================================================
42 SUBROUTINE hm_read_spcnd(ISPCOND ,ISKEW ,ITAB ,ITABM1 ,IKINE ,
43 . IGRNOD ,NOD2SP ,IFRAME ,NOM_OPT,LSUBMODEL)
44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE message_mod
48 USE r2r_mod
49 USE groupdef_mod
50 USE submodel_mod
51 USE hm_option_read_mod
52 USE names_and_titles_mod , ONLY : nchartitle, ncharkey, ncharfield
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "scr17_c.inc"
61#include "com04_c.inc"
62#include "sphcom.inc"
63#include "units_c.inc"
64#include "param_c.inc"
65#include "r2r_c.inc"
66C-----------------------------------------------
67C D u m m y A r g u m e n t s
68C-----------------------------------------------
69 INTEGER ISPCOND(NISPCOND,*), ISKEW(*), ITAB(*), ITABM1(*),
70 . IKINE(*),NOD2SP(*),IFRAME(LISKN,*)
71 INTEGER NOM_OPT(LNOPT1,*)
72 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
73C-----------------------------------------------
74 TYPE (GROUP_) ,TARGET, DIMENSION(NGRNOD) :: IGRNOD
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER I,ID, IC, N, IS, IC1, IC2, IC3, IC4,
79 . NOSYS, J,IGR,IGRS,K,
80 . NCELL,
81 . ILEV, NY
82 CHARACTER MESS*40
83 CHARACTER(LEN=NCHARTITLE) :: TITR
84 CHARACTER(LEN=NCHARKEY) :: KEY
85 CHARACTER(LEN=NCHARFIELD) :: DIR
86 LOGICAL IS_AVAILABLE
87C-----------------------------------------------
88C E x t e r n a l F u n c t i o n s
89C-----------------------------------------------
90 INTEGER NGR2USR
91 INTEGER, DIMENSION(:), POINTER :: INGR2USR
92C-----------------------------------------------
93 DATA MESS/'SPECIFIC TO SPH SYMMETRY CONDITIONS '/
94C-----------------------------------------------
95 WRITE(IOUT,1000)
96 NY = 0
97 CALL HM_OPTION_START('/SPHBCS')
98
99 DO I=1,NSPCOND
100 NY=NY+1
101C----------Multidomaines --> on ignore les BCS SPH non tagees-----------
102 IF(NSUBDOM>0)THEN
103 IF(TAGSPHBCS(NY)==0)CALL HM_SZ_R2R(TAGSPHBCS,NY,LSUBMODEL)
104 END IF
105C--------------------------------------------------
106C EXTRACT DATAS OF /SPHBCS/... LINE
107C--------------------------------------------------
108 CALL HM_OPTION_READ_KEY(LSUBMODEL,
109 . OPTION_ID = ID,
110 . OPTION_TITR = TITR,
111 . KEYWORD2 = KEY)
112 NOM_OPT(1,I)=ID
113 CALL FRETITL(TITR,NOM_OPT(LNOPT1-LTITR+1,I),LTITR)
114 IF (KEY(1:5)=='SLIDE')THEN
115 ISPCOND(5,I)=1
116 ELSEIF (KEY(1:4)=='TIED')THEN
117 ISPCOND(5,I)=0
118 ELSE
119 CALL ANCMSG(MSGID=398,
120 . MSGTYPE=MSGERROR,
121 . ANMODE=ANINFO_BLIND_1,
122 . C1=KEY)
123 ENDIF
124 ISPCOND(NISPCOND,I)=ID
125C--------------------------------------------------
126C EXTRACT DATAS (INTEGER VALUES)
127C--------------------------------------------------
128 CALL HM_GET_INTV('inputsystem',IS,IS_AVAILABLE,LSUBMODEL)
129 CALL HM_GET_INTV('entityid',IGR,IS_AVAILABLE,LSUBMODEL)
130 CALL HM_GET_INTV('rad_sphbcs_ilev',ILEV,IS_AVAILABLE,LSUBMODEL)
131C--------------------------------------------------
132C EXTRACT DATAS (STRING)
133C--------------------------------------------------
134 CALL HM_GET_STRING('rad_dir',DIR,ncharfield,IS_AVAILABLE)
135C
136 IF(DIR(1:1)=='X')THEN
137 IC=1
138 ELSEIF(DIR(1:1)=='Y')THEN
139 IC=2
140 ELSEIF(DIR(1:1)=='Z')THEN
141 IC=3
142 ENDIF
143.AND. IF(ILEV/=0ILEV/=1)THEN
144 CALL ANCMSG(MSGID=399,
145 . MSGTYPE=MSGERROR,
146 . ANMODE=ANINFO_BLIND_1,
147 . I1=ILEV)
148 ENDIF
149 ISPCOND(1,I)=ILEV
150 ISPCOND(2,I)=IC
151 IF (IS==0)THEN
152 ISPCOND(3,I)=1
153 GOTO 111
154 ELSE
155 DO J=1,NUMFRAM
156 IF (IFRAME(4,J+1)==IS)THEN
157 ISPCOND(3,I)=J+1
158 GOTO 111
159 ENDIF
160 ENDDO
161 ENDIF
162 CALL ANCMSG(MSGID=400,
163 . MSGTYPE=MSGERROR,
164 . ANMODE=ANINFO_BLIND_1,
165 . I1=IS)
166 111 CONTINUE
167C
168 INGR2USR => IGRNOD(1:NGRNOD)%ID
169 IGRS=NGR2USR(IGR,INGR2USR,NGRNOD)
170 ISPCOND(4,I)=IGRS
171C
172 DO NOSYS=1,NUMNOD
173 NCELL=NOD2SP(NOSYS)
174 IF (NCELL==0) THEN
175 ELSE
176 ENDIF
177 ENDDO
178 WRITE(IOUT,1100)ID,TRIM(TITR),DIR(1:1),IS,IGR,ILEV
179 ENDDO
180C-------------------------------------
181 RETURN
182C
1831000 FORMAT(
184 . ' SPECIFIC TO SPH SYMMETRY CONDITIONS '/
185 . ' ---------------------------------- '/)
1861100 FORMAT(/5X,'CONDITION ID ',I10,1X,A
187 . /10X,'NORMAL DIRECTION TO SYMMETRY PLANE ',A10,
188 . /10X,'REFERENCE FRAME ID ',I10,
189 . /10X,'NODES GROUP ID FOR KINEMATIC CONDITIONS ',I10,
190 . /10X,'FORMULATION LEVEL ',I10)
191 END
hm_read_spcnd
subroutine hm_read_spcnd(ispcond, iskew, itab, itabm1, ikine, igrnod, nod2sp, iframe, nom_opt, lsubmodel)
Definition hm_read_spcnd.F:44
groupdef_mod
Definition groupdef_mod.F:662
hm_option_read_mod
Definition hm_option_read_mod.F:408
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005
r2r_mod
Definition r2r_mod.F:125
submodel_mod
Definition submodel_mod.F:712
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
starter
program starter
Definition starter.F:39