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 42 of file hm_read_thgrsurf.F.

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