OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_nbcs.F File Reference
#include "implicit_f.inc"
#include "scr17_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_nbcs (icode, iskew, itab, itabm1, ikine, igrnod, ibcslag, lag_ncf, lag_nkf, lag_nhf, ikine1lag, iskn, nom_opt, lsubmodel)

Function/Subroutine Documentation

◆ hm_read_nbcs()

subroutine hm_read_nbcs ( integer, dimension(*) icode,
integer, dimension(*) iskew,
integer, dimension(*) itab,
integer, dimension(*) itabm1,
integer, dimension(*) ikine,
type (group_), dimension(ngrnod), target igrnod,
integer, dimension(5,*) ibcslag,
integer lag_ncf,
integer lag_nkf,
integer lag_nhf,
integer, dimension(*) ikine1lag,
integer, dimension(liskn,*) iskn,
integer, dimension(lnopt1,*) nom_opt,
type(submodel_data), dimension(*) lsubmodel )

Definition at line 42 of file hm_read_nbcs.F.

45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE message_mod
49 USE submodel_mod
50 USE groupdef_mod
51 USE hm_option_read_mod
52 USE names_and_titles_mod , ONLY : nchartitle, ncharfield, ncharkey
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 "com01_c.inc"
62#include "com04_c.inc"
63#include "param_c.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 INTEGER ICODE(*), ISKEW(*), ITAB(*), ITABM1(*), IKINE(*),
68 . IBCSLAG(5,*),
69 . LAG_NCF,LAG_NKF,LAG_NHF,IKINE1LAG(*),ISKN(LISKN,*)
70 INTEGER NOM_OPT(LNOPT1,*)
71 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
72C-----------------------------------------------
73 TYPE (GROUP_) ,TARGET, DIMENSION(NGRNOD) :: IGRNOD
74C-----------------------------------------------
75C L o c a l V a r i a b l e s
76C-----------------------------------------------
77 INTEGER I,JJ(12), IC, NC, N, NUSR, IS, IC1, IC2, IC3, IC4,
78 . NOSYS, J,J10(10),IGR,IGRS,ISU,IBCALE,J6(6),K,
79 . IC0, IC01, IC02, IC03, IC04, ID ,ILAGM, NBCSLAG,
80 . FLAG_FMT,FLAG_FMT_TMP,IFIX_TMP,SUB_ID,
81 . CHKCOD,ISERR,NOD,SUB_INDEX,NNOD
82 INTEGER IUN
83 CHARACTER MESS*40
84 CHARACTER(LEN=NCHARKEY) :: KEY,KEY2
85 CHARACTER :: CODE*7
86 CHARACTER(LEN=NCHARFIELD) :: STRING
87 CHARACTER(LEN=NCHARTITLE) :: TITR
88 CHARACTER :: OPT*8
89 LOGICAL IS_AVAILABLE
90 INTEGER, DIMENSION(:), ALLOCATABLE :: IKINE1
91C-----------------------------------------------
92C E x t e r n a l F u n c t i o n s
93C-----------------------------------------------
94 INTEGER USR2SYS,MY_OR,CHECK_NEW,NGR2USR
95!
96 INTEGER, DIMENSION(:), POINTER :: INGR2USR
97C
98C-----------------------------------------------
99C D a t a
100C-----------------------------------------------
101 DATA iun/1/
102 DATA mess/'BOUNDARY CONDITIONS '/
103C======================================================================|
104C
105 is_available = .false.
106 flag_fmt = 0
107C
108 ALLOCATE(ikine1(3*numnod))
109 DO i=1,3*numnod
110 ikine1(i) = 0
111 ENDDO
112C
113C--------------------------------------------------
114C START BROWSING MODEL /BCS
115C--------------------------------------------------
116 CALL hm_option_start('/NBCS')
117C--------------------------------------------------
118C BROWSING MODEL PARTS 1->NBCS
119C--------------------------------------------------
120 DO i=1,numbcsn
121 titr = ''
122C--------------------------------------------------
123C EXTRACT DATAS OF /BCS/... LINE
124C--------------------------------------------------
125 CALL hm_option_read_key(lsubmodel,
126 . option_id = id,
127 . option_titr = titr,
128 . submodel_index = sub_index,
129 . keyword2 = key)
130C
131 nom_opt(1,numbcs+i)=id
132 CALL fretitl(titr,nom_opt(lnopt1-ltitr+1,numbcs+i),ltitr)
133C
134 CALL hm_get_intv('number_of_nodes',nnod,is_available,lsubmodel)
135C
136 DO k=1,nnod
137C
138 CALL hm_get_int_array_index('Tx',j6(1),k,is_available,lsubmodel)
139 CALL hm_get_int_array_index('Ty',j6(2),k,is_available,lsubmodel)
140 CALL hm_get_int_array_index('Tz',j6(3),k,is_available,lsubmodel)
141 CALL hm_get_int_array_index('OmegaX',j6(4),k,is_available,lsubmodel)
142 CALL hm_get_int_array_index('OmegaY',j6(5),k,is_available,lsubmodel)
143 CALL hm_get_int_array_index('OmegaZ',j6(6),k,is_available,lsubmodel)
144C
145 CALL hm_get_int_array_index('Skew_ID',is,k,is_available,lsubmodel)
146 IF(is == 0 .AND. sub_index /= 0 ) is = lsubmodel(sub_index)%SKEW
147C
148 CALL hm_get_int_array_index('node_ID',nod,k,is_available,lsubmodel)
149C
150 nosys=usr2sys(nod,itabm1,mess,id)
151 IF (nod == 0) THEN
152 CALL ancmsg(msgid=78,
153 . msgtype=msgerror,
154 . anmode=aninfo,
155 . c1='/NBCS/1',
156 . i1=id,
157 . i2=nod)
158 ENDIF
159C
160 iserr = 0
161 DO j=0,numskw+nsubmod
162 IF(is == iskn(4,j+1)) THEN
163 is=j+1
164 iserr = 1
165 ENDIF
166 ENDDO
167 IF(iserr == 0 ) THEN
168 CALL ancmsg(msgid=137,anmode=aninfo,msgtype=msgerror,
169 . c1='BOUNDARY CONDITION',
170 . c2='BOUNDARY CONDITION',
171 . i2=is,i1=id,c3=titr)
172 ENDIF
173C
174 chkcod = 0
175 DO j=1,6
176 IF (j6(j) >= 2) THEN
177 chkcod = 1
178 ENDIF
179 ENDDO
180 IF(chkcod == 1)
181 . CALL ancmsg(msgid=1051,anmode=aninfo_blind,
182 . msgtype=msgerror,i1=id,c1=titr,c2=code)
183c
184 ic1=j6(1)*4 +j6(2)*2 +j6(3)
185 ic2=j6(4)*4 +j6(5)*2 +j6(6)
186 ic =ic1*512+ic2*64
187c
188 IF(nosys /= 0) THEN
189 icode(nosys)=my_or(ic,icode(nosys))
190 IF(iskew(nosys)==-1.OR.iskew(nosys)==is)THEN
191 check_new=is
192 ELSE
193 CALL ancmsg(msgid=148,anmode=aninfo,msgtype=msgerror,
194 . i1=itab(nosys),prmod=msg_cumu)
195 ENDIF
196 iskew(nosys)=check_new
197
198 DO j=1,6
199 IF(j6(j)/=0)
200 . CALL kinset(1,itab(nosys),ikine(nosys),j,iskew(nosys)
201 . ,ikine1(nosys))
202 ENDDO
203 ENDIF
204C
205 ENDDO
206C
207 ENDDO
208
209 DEALLOCATE(ikine1)
210 RETURN
hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
kinset
subroutine kinset(ik, node, ikine, idir, isk, ikine1)
Definition kinset.F:57
id
initmumps id
Definition multiplerhs_example.m:4
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
submodel_mod
Definition submodel_mod.F:712
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
my_or
int my_or(int *a, int *b)
Definition precision.c:63
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
fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:620
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:160