OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_ale_link_vel.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_ale_link (icode, iskew, itab, itabm1, ikine, igrnod, ibcslag, lag_ncf, lag_nkf, lag_nhf, ikine1lag, linale, lsubmodel, unitab)

Function/Subroutine Documentation

◆ hm_read_ale_link()

subroutine hm_read_ale_link ( integer, dimension(numnod), intent(in) icode,
integer, dimension(*), intent(in) iskew,
integer, dimension(numnod), intent(in) itab,
integer, dimension(*), intent(in) itabm1,
integer, dimension(*), intent(in) ikine,
type (group_), dimension(ngrnod), target igrnod,
integer, dimension(5,*), intent(in) ibcslag,
integer, intent(in) lag_ncf,
integer, intent(in) lag_nkf,
integer, intent(in) lag_nhf,
integer, dimension(*), intent(in) ikine1lag,
integer, dimension(*), intent(inout) linale,
type(submodel_data), dimension(nsubmod), intent(in) lsubmodel,
type(unit_type_), intent(in) unitab )

Definition at line 41 of file hm_read_ale_link_vel.F.

44C-----------------------------------------------
45C D e s c r i p t i o n
46C-----------------------------------------------
47C This subroutine is reading /ALE/LINK/VEL options in user input file
48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE message_mod
52 USE groupdef_mod
53 USE unitab_mod
54 USE hm_option_read_mod
55 USE submodel_mod
56 USE names_and_titles_mod , ONLY : nchartitle, ncharkey, ncharfield
57 USE format_mod , ONLY : lfield
58C-----------------------------------------------
59C I m p l i c i t T y p e s
60C-----------------------------------------------
61#include "implicit_f.inc"
62C-----------------------------------------------
63C C o m m o n B l o c k s
64C-----------------------------------------------
65#include "com04_c.inc"
66#include "units_c.inc"
67C-----------------------------------------------
68C D u m m y A r g u m e n t s
69C-----------------------------------------------
70 INTEGER,INTENT(IN) :: ICODE(NUMNOD), ISKEW(*), ITAB(NUMNOD), ITABM1(*), IKINE(*),IBCSLAG(5,*)
71 INTEGER,INTENT(IN) :: LAG_NCF,LAG_NKF,LAG_NHF,IKINE1LAG(*)
72 INTEGER,INTENT(INOUT) :: LINALE(*)
73 TYPE(SUBMODEL_DATA), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
74 TYPE(UNIT_TYPE_), INTENT(IN) :: UNITAB
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER GRID_DOF, BID, IFORM, NODE_ID1, NODE_ID2,POS,IAD0,NNOD
79 INTEGER I,JJ(12), IC, NC, N, NUSR, IS, IC1, IC2, IC3, IC4,
80 . NOSYS, J,J10(10),IGR,IGRS,ISU,IBCALE,J3(3),K,
81 . IC0, IC01, IC02, IC03, IC04, ID ,ILAGM, NBCSLAG,
82 . FLAG_FMT,FLAG_FMT_TMP,IFIX_TMP,IKINE1(3*NUMNOD),IGRNS
83 CHARACTER(LEN=NCHARKEY) :: KEY,KEY2
84 CHARACTER(LEN=NCHARFIELD) :: STRING, CHAR_XYZ
85 CHARACTER(LEN=NCHARTITLE) :: TITR
86 CHARACTER :: OPT*8,MESS*40
87 my_real tstart,tstop
88 LOGICAL :: IS_AVAILABLE
89 INTEGER :: WX, WY, WZ
90C-----------------------------------------------
91 TYPE (GROUP_) ,TARGET, DIMENSION(NGRNOD) :: IGRNOD
92C-----------------------------------------------
93C E x t e r n a l F u n c t i o n s
94C-----------------------------------------------
95 INTEGER USR2SYS,MY_OR,CHECK_NEW,NGR2USR
96!
97 INTEGER, DIMENSION(:), POINTER :: INGR2USR
98C-----------------------------------------------
99C S o u r c e L i n e s
100C-----------------------------------------------
101 pos=0
102 igrns=0
103 tstart=zero
104 tstop=zero
105
106 WRITE(iout,1000)
107 CALL hm_option_start('/ALE/LINK/VEL')
108
109 DO i = 1, nalelk
110 CALL hm_option_read_key(lsubmodel, option_id = n, option_titr = titr)
111 CALL hm_get_intv('node_ID1', node_id1, is_available, lsubmodel)
112 CALL hm_get_intv('node_ID2', node_id2, is_available, lsubmodel)
113 CALL hm_get_intv('grnod_ID', igr, is_available, lsubmodel)
114 CALL hm_get_intv('Wx', wx, is_available, lsubmodel)
115 CALL hm_get_intv('Wy', wy, is_available, lsubmodel)
116 CALL hm_get_intv('Wz', wz, is_available, lsubmodel)
117 CALL hm_get_intv('Iform', iform, is_available, lsubmodel)
118 CALL hm_get_floatv('Tstart', tstart, is_available, lsubmodel, unitab)
119 CALL hm_get_floatv('Tstop', tstop, is_available, lsubmodel, unitab)
120 IF (tstop == zero) tstop = ep30
121 ingr2usr => igrnod(1:ngrnod)%ID
122 igrs=ngr2usr(igr,ingr2usr,ngrnod)
123 IF(igrs==0)THEN
124 WRITE(iout,*) ' -- NODE GROUP',igr,' NOT FOUND'
125 WRITE(istdo,*) ' -- NODE GROUP',igr,' NOT FOUND'
126 ENDIF
127
128 j3(1) = wx
129 j3(2) = wy
130 j3(3) = wz
131 ic = j3(1) * 4 + j3(2) * 2 + j3(3)
132 char_xyz = ' '
133 k=lfield
134 IF(j3(3)==1 )THEN
135 char_xyz(k:k)='Z'
136 k=k-1
137 ENDIF
138 IF(j3(2)==1 )THEN
139 char_xyz(k:k)='Y'
140 k=k-1
141 ENDIF
142 IF(j3(1)==1 )THEN
143 char_xyz(k:k)='X'
144 ENDIF
145!
146 igrns = igrnod(igrs)%SORTED
147!
148 IF(iform==0.AND.igrns /= 1)THEN
149 CALL ancmsg(msgid=271,anmode=aninfo,msgtype=msgerror,i1=n,i2=iform)
150 ELSE
151 WRITE(iout,1100) n,trim(titr),node_id1,node_id2,igr,char_xyz,iform,tstart,tstop
152 ENDIF
153
154 linale(pos+1)=n
155 linale(pos+2)=node_id1
156 linale(pos+3)=node_id2
157 linale(pos+4)=-1
158 linale(pos+5)=ic
159 linale(pos+6)=iform
160 linale(pos+7)=igrs
161
162 pos = pos+1+6
163 mess=''
164 mess(1:10)='ALE LINKS'
165 bid=usr2sys(node_id1,itabm1,mess,n)
166 bid=usr2sys(node_id2,itabm1,mess,n)
167 ENDDO
168C-----------------------------------------------
1691000 FORMAT(/
170 . ' ALE LINKS DEFINITIONS '/
171 . ' ---------------------- '/)
172C-----------------------------------------------
1731100 FORMAT( /5x,'ALE LINK ID ',i10,': ',a,
174 . /10x,'MAIN NODE 1 . . . . . . . . . . . . . ',i10
175 . /10x,'main node 2 . . . . . . . . . . . . . ',I10
176 . /10X,'group identifier for secondary nodes. . . . ',I10
177 . /10X,'grid velocity directions to link. . . . ',A
178 . /10X,'formulation . . . . . . . . . . . . . . ',I10
179 . /10X,'start time. . . . . . . . . . . . . . . ',1PG20.13
180 . /10X,'stop time . . . . . . . . . . . . . . . ',1PG20.13/)
181C-----------------------------------------------
182 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
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
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
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
unitab_mod
Definition unitab_mod.F:513
ngr2usr
integer function ngr2usr(iu, igr, ngr)
Definition nintrr.F:325
main
int main(int argc, char *argv[])
Definition CMakeCCompilerId.c:841
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
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:160