OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_thgrns.F File Reference
#include "implicit_f.inc"
#include "scr23_c.inc"
#include "scr17_c.inc"
#include "scr03_c.inc"
#include "com04_c.inc"
#include "units_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_thgrns (ityp, key, itab, itabm1, kxx, ixx, iad, ifi, ithgrp, ithbuf, nv, vare, varg, nvg, ivarg, nsne, ivns2r, nv0, id, titr, ithvar, flagabf, nvarabf, lsubmodel)

Function/Subroutine Documentation

◆ hm_read_thgrns()

subroutine hm_read_thgrns ( integer ityp,
character*10 key,
integer, dimension(*) itab,
integer, dimension(*) itabm1,
integer, dimension(nixx,*) kxx,
integer, dimension(*) ixx,
integer iad,
integer ifi,
integer, dimension(nithgr) ithgrp,
integer, dimension(*) ithbuf,
integer nv,
character*10, dimension(nv) vare,
character*10, dimension(nvg) varg,
integer nvg,
integer, dimension(18,*) ivarg,
integer nsne,
integer, dimension(18,*) ivns2r,
integer nv0,
integer id,
character(len=nchartitle) titr,
integer, dimension(*) ithvar,
integer flagabf,
integer nvarabf,
type(submodel_data), dimension(nsubmod), intent(in) lsubmodel )

Definition at line 42 of file hm_read_thgrns.F.

48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE message_mod
52 USE submodel_mod
53 USE hm_option_read_mod
54 USE names_and_titles_mod , ONLY : nchartitle
55C-----------------------------------------------
56C I m p l i c i t T y p e s
57C-----------------------------------------------
58#include "implicit_f.inc"
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "scr23_c.inc"
63#include "scr17_c.inc"
64#include "scr03_c.inc"
65#include "com04_c.inc"
66#include "units_c.inc"
67#include "param_c.inc"
68C-----------------------------------------------
69C D u m m y A r g u m e n t s
70C-----------------------------------------------
71 INTEGER NIX,ITYP,ITABM1(*),KXX(NIXX,*),IXX(*),
72 . ITAB(*),ITHGRP(NITHGR),ITHBUF(*),
73 . IFI,IAD,NV,NVG,IVARG(18,*),NSNE,
74 . IVNS2R(18,*),NV0,ITHVAR(*),FLAGABF,NVARABF
75 CHARACTER*10 VARE(NV),KEY,VARG(NVG)
76 CHARACTER(LEN=NCHARTITLE)::TITR
77C-----------------------------------------------
78C L o c a l V a r i a b l e s
79C-----------------------------------------------
80 INTEGER J,JJ, I,ISU,ID,NNE,NOSYS,J10(10),NTOT,KK,IER,
81 . OK,IGS,IGRS,NSU,K,L,JREC,CONT,IAD0,IADV,NTRI,NL,
82 . IFITMP,IADFIN,NVAR,M,N,IAD1,IAD2,ISK,IPROC,
83 . IDNS, INS, IUN, IST, NST, IDST
84 CHARACTER(LEN=NCHARTITLE) :: TITLE
85 CHARACTER :: MESS*40,CSTRAND1*9,CSTRAND2*13
86 TYPE(SUBMODEL_DATA),INTENT(IN) :: LSUBMODEL(NSUBMOD)
87 LOGICAL IS_AVAILABLE
88 INTEGER LENTRIM
89C-----------------------------------------------
90C E x t e r n a l F u n c t i o n s
91C-----------------------------------------------
92 INTEGER NINTRN,THVARC,HM_THVARC
93 DATA mess/'TH GROUP DEFINITION '/
94 DATA iun/1/,
95 . cstrand1/'STRAND_ID'/,cstrand2/'STRAND_NUMBER'/
96C-----------------------------------------------
97 id=ithgrp(1)
98 CALL fretitl2(titr,ithgrp(nithgr-ltitr+1),ltitr)
99 ithgrp(2)=ityp
100 ithgrp(3)=0
101 ifitmp=ifi+1000
102 ! Number of variables indicated by the user
103 CALL hm_get_intv('Number_Of_Variables',nvar,is_available,lsubmodel)
104
105 ! Number of stored variables and reading the variables
106 IF (nvar>0) nvar = hm_thvarc(vare,nv,ithbuf(iad),varg,nvg,ivarg,nv0,id,titr ,lsubmodel)
107 IF(nvar == 0) CALL ancmsg(msgid=1109,
108 . msgtype=msgerror,
109 . anmode=aninfo_blind_1,
110 . i1=id,
111 . c1=titr )
112c
113 ithgrp(6)=nvar
114 ithgrp(7)=iad
115 iad=iad+nvar
116 ifi=ifi+nvar
117C
118 !JREC=IREC+1
119 !READ(IIN,REC=JREC,ERR=999,FMT='(A)')LINE
120 !READ(LINE,ERR=999,FMT=FMT_I)IDNS
121 !CALL FRETITL2(TITR,ITHGRP(NITHGR-LTITR+1),LTITR)
122 !INS =NINTRN(IDNS,KXX,NIXX,NUMELX,ITHGRP(1),TITR)
123 !NNE =KXX(3,INS)-1
124 CALL hm_get_intv('ids',idns,is_available,lsubmodel)
125 ins =nintrn(idns,kxx,nixx,numelx,ithgrp(1),titr)
126 nne =kxx(3,ins)-1
127C
128C
129 !NST=0
130 !DOWHILE(LINE(1:1)/='/')
131 ! READ(LINE,ERR=999,FMT=FMT_THGR)IST,IDST,TITR
132 ! IF (IST>NNE) THEN
133 ! CALL FRETITL2(TITR,ITHGRP(NITHGR-LTITR+1),LTITR)
134 ! CALL ANCMSG(MSGID=361,
135 . ! MSGTYPE=MSGERROR,
136 . ! ANMODE=ANINFO_BLIND_1,
137 . ! I1=ITHGRP(1),
138 . ! C1=TITR,
139 . ! I2=IST)
140 ! GOTO 999
141 ! ENDIF
142 ! NST=NST+1
143 ! JREC=JREC+1
144 ! READ(IIN,REC=JREC,ERR=999,FMT='(A)')LINE
145 !ENDDO
146
147 CALL hm_get_intv('Num_Cards',nst,is_available,lsubmodel)
148
149C
150 ithgrp(4)=nst
151 ithgrp(5)=iad
152 iad2=iad+4*nst
153 ithgrp(8)=iad2
154 ifi=ifi+4*nst+40*nst
155 CALL zeroin(iad,iad+44*nst-1,ithbuf)
156C
157 DO k=1,nst
158 !IREC=IREC+1
159 ithbuf(iad)=ins
160 !READ(IIN,REC=IREC,ERR=999,FMT='(A)')LINE
161 CALL hm_get_int_array_index('XELEM_NUM',ist,k,is_available,lsubmodel)
162 CALL hm_get_int_array_index('XELEM_USER',idst,k,is_available,lsubmodel)
163 CALL hm_get_string_index('NAME_ARRAY',title,k,80,is_available)
164 lentrim = len_trim(title)
165 title = title(1:lentrim)
166
167 IF (ist > nne) THEN
168 CALL fretitl2(titr,ithgrp(nithgr-ltitr+1),ltitr)
169 CALL ancmsg(msgid=361,
170 . msgtype=msgerror,
171 . anmode=aninfo_blind_1,
172 . i1=ithgrp(1),
173 . c1=titr,
174 . i2=ist)
175 GOTO 999
176 ENDIF
177
178 !READ(LINE,ERR=999,FMT=FMT_THGR)IST,IDST,TITLE
179 ithbuf(iad+2*nst)=idst
180 ithbuf(iad+3*nst)=ist
181 iproc=0
182 ithbuf(iad+nst)=iproc
183 CALL fretitl(title,ithbuf(iad2),40)
184 iad=iad+1
185 iad2=iad2+40
186 ENDDO
187C
188 iad = ithgrp(5)
189 iad2= ithgrp(8)
190 iad=iad2+40*nst
191C
192 nsne=nsne+nst
193
194C=======================================================================
195C ABF FILES
196C=======================================================================
197 nvar = ithgrp(6)
198 iad0 = ithgrp(7)
199 ithgrp(9) = nvarabf
200 DO j = iad0,iad0+nvar-1
201 DO k = 1,10
202 ithvar((ithgrp(9)+(j-iad0)-1)*10+k) = ichar(vare(ithbuf(j))(k:k))
203 ENDDO
204 ENDDO
205 nvarabf = nvarabf + nvar
206
207C=======================================================================
208C PRINTOUT
209C=======================================================================
210 IF(ipri >= 1) THEN
211 n=ithgrp(4)
212 iad1=ithgrp(5)
213 nvar=ithgrp(6)
214 iad0=ithgrp(7)
215 iad2=ithgrp(8)
216 WRITE(iout,'(//)')
217 CALL FRETITL2(TITR,ITHGRP(NITHGR-LTITR+1),LTITR)
218 WRITE(IOUT,'(a,i10,3a,i3,a,i2,2a,i10)')' th group:',ITHGRP(1),',',TRIM(TITR),',',NVAR,' var',IUN,KEY,':',IDNS
219 WRITE(IOUT,'(a)')' -------------------'
220 WRITE(IOUT,'(10a10)')(VARE(ITHBUF(J)),J=IAD0,IAD0+NVAR-1)
221 WRITE(IOUT,'(4a)')CSTRAND1,' ',CSTRAND2,' p_spmd name '
222 DO K=IAD1,IAD1+N-1
223 CALL FRETITL2(TITR,ITHBUF(IAD2),40)
224 WRITE(IOUT,'(3i10,2a)')ITHBUF(K+2*N),ITHBUF(K+3*N),ITHBUF(K+N),' ',TITR(1:40)
225 IAD2=IAD2+40
226 ENDDO
227 ENDIF
228
229 IAD1=ITHGRP(7)
230 DO I=1,NVAR
231 ITHBUF(IAD1+I-1)=IVNS2R(ITHBUF(IAD1+I-1),1)
232 ENDDO
233
234 RETURN
235 999 CALL FREERR(1)
236 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_get_string_index
subroutine hm_get_string_index(name, sval, index, size, is_available)
Definition hm_get_string_index.F:53
hm_thvarc
integer function hm_thvarc(vare, nv, ivar, varg, nvg, ivarg, nv0, id, titr, lsubmodel)
Definition hm_read_thvarc.F:46
id
initmumps id
Definition multiplerhs_example.m:4
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
submodel_mod
Definition submodel_mod.F:712
nvar
integer function nvar(text)
Definition nvar.F:32
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
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804
nintrn
integer function nintrn(iext, ntn, m, n, id, titr)
Definition nintrn.F:45
zeroin
subroutine zeroin(n1, n2, ma)
Definition zeroin.F:47