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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_thgrsurf (ityp, key, iad, ifi, ithgrp, ithbuf, nv, vare, num, varg, nvg, ivarg, nsne, nv0, ithvar, flagabf, nvarabf, igrsurf, igs, lsubmodel)

Function/Subroutine Documentation

◆ hm_read_thgrsurf()

subroutine hm_read_thgrsurf ( integer, intent(in) ityp,
character*10, intent(in) key,
integer, intent(inout) iad,
integer, intent(inout) ifi,
integer, dimension(nithgr), intent(inout) ithgrp,
integer, dimension(*), intent(inout) ithbuf,
integer, intent(in) nv,
character*10, dimension(nv), intent(in) vare,
integer, intent(in) num,
character*10, dimension(nvg), intent(in) varg,
integer, intent(in) nvg,
integer, dimension(18,*), intent(in) ivarg,
integer, intent(inout) nsne,
integer, intent(in) nv0,
integer, dimension(*), intent(inout) ithvar,
integer, intent(in) flagabf,
integer, intent(inout) nvarabf,
type (surf_), dimension(nsurf), intent(inout) igrsurf,
integer, intent(inout) igs,
type(submodel_data), dimension(nsubmod), intent(in) lsubmodel )

Definition at line 46 of file hm_read_thgrsurf.F.

52C-----------------------------------------------
53C D e s c r i p t i o n
54C-----------------------------------------------
55C Starter Reader for option /TH/SURF
56C-----------------------------------------------
57C M o d u l e s
58C-----------------------------------------------
59 USE groupdef_mod , only : surf_
60 USE message_mod , only : ancmsg, aninfo_blind_1, msgerror, msgwarning
61 USE submodel_mod , only : submodel_data, nsubmod
62 USE names_and_titles_mod , ONLY : nchartitle
63 USE format_mod , ONLY : fmw_i_a
64C-----------------------------------------------
65C I m p l i c i t T y p e s
66C-----------------------------------------------
67#include "implicit_f.inc"
68C-----------------------------------------------
69C C o m m o n B l o c k s
70C-----------------------------------------------
71#include "scr03_c.inc"
72#include "scr17_c.inc"
73#include "com04_c.inc"
74#include "units_c.inc"
75#include "param_c.inc"
76#include "r2r_c.inc"
77C-----------------------------------------------
78C D u m m y A r g u m e n t s
79C-----------------------------------------------
80 INTEGER,INTENT(IN) :: ITYP,NV,NUM,NVG,IVARG(18,*),NV0,FLAGABF
81 INTEGER,INTENT(INOUT) :: ITHGRP(NITHGR), IGS, IFI, IAD, NSNE, NVARABF, ITHVAR(*), ITHBUF(*)
82 CHARACTER*10,INTENT(IN) :: VARE(NV),KEY,VARG(NVG)
83 TYPE (SURF_),INTENT(INOUT), DIMENSION(NSURF) :: IGRSURF
84 TYPE(SUBMODEL_DATA),INTENT(IN) :: LSUBMODEL(NSUBMOD)
85C-----------------------------------------------
86C L o c a l V a r i a b l e s
87C-----------------------------------------------
88 INTEGER J,JJ, I,ISU,ID,NNE,NOSYS,NTOT,KK,IER,
89 . OK,IGRS,NSU,K,L,JREC,CONT,IAD0,IADV,NTRI,
90 . IFITMP,IADFIN,NVAR,M,N,IAD1,IAD2,ISK,IPROC,ITITLE(LTITR),
91 . IDS,IDSMAX,
92 . NUM_FOUND
93 CHARACTER(LEN=NCHARTITLE) :: TITR
94 CHARACTER MESS*40
95 LOGICAL IS_AVAILABLE
96C-----------------------------------------------
97C E x t e r n a l F u n c t i o n s
98C-----------------------------------------------
99 INTEGER USR2SYS,ULIST2S,LISTCNT,NINTRN,THVARC,HM_THVARC
100 INTEGER R2R_LISTCNT,R2R_EXIST
101 DATA mess/'TH GROUP DEFINITION '/
102C-----------------------------------------------
103C S o u r c e L i n e s
104C-----------------------------------------------
105 id=ithgrp(1)
106 CALL fretitl2(titr,ithgrp(nithgr-ltitr+1),ltitr)
107 ithgrp(2)=ityp
108 ithgrp(3)=0
109 ifitmp=ifi+1000
110 ! Number of variables indicated by the user
111 CALL hm_get_intv('Number_Of_Variables',nvar,is_available,lsubmodel)
112
113 ! Number of stored variables and reading the variables
114 IF (nvar>0) nvar = hm_thvarc(vare,nv,ithbuf(iad),varg,nvg,ivarg,nv0,id,titr ,lsubmodel)
115
116 IF(nvar == 0) THEN
117 IF(ityp /= 116)THEN
118 CALL ancmsg(msgid=1109,msgtype=msgerror,anmode=aninfo_blind_1,i1=id,c1=titr )
119 ENDIF
120 igs = igs - 1
121 ithgrp(1:nithgr)=0
122 ELSE
123 CALL hm_get_intv('idsmax',idsmax,is_available,lsubmodel)
124 ithgrp(6)=nvar
125 ithgrp(7)=iad
126 iad=iad+nvar
127 ifi=ifi+nvar
128 nne=idsmax
129 ithgrp(4)=nne
130 ithgrp(5)=iad
131 iad2=iad+3*nne
132 ithgrp(8)=iad2
133 ifi=ifi+3*nne+40*nne
134 CALL zeroin(iad,iad+43*nne-1,ithbuf)
135C
136 num_found=0
137 DO k = 1,idsmax
138 CALL hm_get_int_array_index('ids',ids,k,is_available,lsubmodel)
139 n=0
140 IF(ids/=0)THEN
141 IF (nsubdom>0) THEN
142 ! Multidomain : skip if entity does not exist---------------
143 IF(r2r_exist(ityp,ids)==0) cycle !next K
144 ENDIF
145 DO j=1,num
146 IF(ids == igrsurf(j)%ID)THEN
147 n=j
148 igrsurf(j)%TH_SURF=1
149 num_found=num_found+1
150 EXIT
151 ENDIF
152 ENDDO
153 nsne=nsne+1
154 ithbuf(iad)=n
155 iad=iad+1
156 ENDIF
157 IF(n == 0)THEN
158 CALL fretitl2(titr,ithgrp(nithgr-ltitr+1),ltitr)
159 CALL ancmsg(msgid=257, msgtype=msgwarning, anmode=aninfo_blind_1, i1=ithgrp(1), i2=ids, c1=titr, c2=key)
160 ENDIF
161 ENDDO !next K
162C
163 iad = ithgrp(5)
164 CALL hord(ithbuf(iad),num_found)
165C
166 DO i=1,nne
167 n=ithbuf(iad)
168 IF(n > 0)THEN
169 ithbuf(iad+2*nne)=igrsurf(n)%ID
170 DO j=1,40
171 CALL fretitl(igrsurf(n)%TITLE,ititle,ltitr)
172 ithbuf(iad2+j-1)=ititle(j)
173 ENDDO
174 iad=iad+1
175 iad2=iad2+40
176 ENDIF
177 ENDDO
178C
179 iad=iad2
180C
181C=======================================================================
182C ABF FILES
183C=======================================================================
184 nvar=ithgrp(6)
185 iad0=ithgrp(7)
186 ithgrp(9)=nvarabf
187 DO j=iad0,iad0+nvar-1
188 DO k=1,10
189 ithvar((ithgrp(9)+(j-iad0)-1)*10+k)=ichar(vare(ithbuf(j))(k:k))
190 ENDDO
191 ENDDO
192 nvarabf = nvarabf + nvar
193C=======================================================================
194C PRINTOUT
195C=======================================================================
196 IF(ipri<1)RETURN
197 n=ithgrp(4)
198 iad1=ithgrp(5)
199 nvar=ithgrp(6)
200 iad0=ithgrp(7)
201 iad2=ithgrp(8)
202 WRITE(iout,'(//)')
203 CALL fretitl2(titr,ithgrp(nithgr-ltitr+1),ltitr)
204 WRITE(iout,'(A,I10,3A,I3,A,I5,2A)')' TH GROUP:',ithgrp(1),',',trim(titr),',',nvar,' VAR',n, key,':'
205 WRITE(iout,'(A)')' -------------------'
206 WRITE(iout,'(10A10)')(vare(ithbuf(j)),j=iad0,iad0+nvar-1)
207 WRITE(iout,'(3A)')' ',key,' NAME '
208 DO k=iad1,iad1+n-1
209 CALL fretitl2(titr,ithbuf(iad2),40)
210 iad2=iad2+40
211 WRITE(iout,fmt=fmw_i_a)igrsurf(ithbuf(k))%ID,titr(1:40)
212 ENDDO
213C
214 ENDIF
215 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_thvarc
integer function hm_thvarc(vare, nv, ivar, varg, nvg, ivarg, nv0, id, titr, lsubmodel)
Definition hm_read_thvarc.F:46
hord
subroutine hord(nel, nsel)
Definition hord.F:35
id
initmumps id
Definition multiplerhs_example.m:4
groupdef_mod
Definition groupdef_mod.F:662
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
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
nvar
integer function nvar(text)
Definition nvar.F:32
r2r_exist
integer function r2r_exist(typ, id)
Definition routines_r2r.F:346
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
groupdef_mod::surf_
Definition groupdef_mod.F:745
submodel_mod::submodel_data
Definition submodel_mod.F:723
zeroin
subroutine zeroin(n1, n2, ma)
Definition zeroin.F:47