OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
thsol_count.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| thsol_count ../engine/source/output/th/thsol_count.F
25!||--- called by ------------------------------------------------------
26!|| init_th ../engine/source/output/th/init_th.F
27!||====================================================================
28 SUBROUTINE thsol_count(NTHGRP2 , ITHGRP , WA_SIZE, INDEX_WA_SOL,
29 . IPARG ,ITHBUF ,SITHBUF)
30C-----------------------------------------------
31C M o d u l e s
32C-----------------------------------------------
33C-----------------------------------------------
34C I m p l i c i t T y p e s
35C-----------------------------------------------
36#include "implicit_f.inc"
37C-----------------------------------------------
38C C o m m o n B l o c k s
39C-----------------------------------------------
40#include "vect01_c.inc"
41#include "com01_c.inc"
42#include "task_c.inc"
43#include "param_c.inc"
44C-----------------------------------------------
45C D u m m y A r g u m e n t s
46C-----------------------------------------------
47 INTEGER,INTENT(IN) :: SITHBUF
48 INTEGER IPARG(NPARG,NGROUP),ITHBUF(*)
49 INTEGER, INTENT(inout) :: WA_SIZE,NTHGRP2
50 INTEGER, DIMENSION(2*NTHGRP2+1), INTENT(inout) :: INDEX_WA_SOL
51 INTEGER, DIMENSION(NITHGR,*), INTENT(in) :: ITHGRP
52C-----------------------------------------------
53C L o c a l V a r i a b l e s
54C-----------------------------------------------
55 LOGICAL :: BOOL
56 INTEGER II,I,J,JJ,K,L,N, IH, NG, MTE,LWA,NEL,
57 . nuvar, ip,ipt,isolnod,itens,ipwwa,ispau,iuwwa,
58 . it,ir,is,j1,j2,j3,nptg,nptr,nptt,npts,nlay,nfail,nvarf,
59 . nc1,nc2,nc3,nc4,nc5,nc6,nc7,nc8,khbe,kcvt,nuvarth,
60 . cpt,pid,isvis,tshell,tsh_ort,icsig,ivisc,nptl,il,kk(6)
61 INTEGER :: J_FIRST,NITER,IADB,NN,IADV,NVAR,ITYP,IJK
62 INTEGER, DIMENSION(NTHGRP2) :: INDEX_SOL
63
64C--------------------------------------------
65
66 ijk = 0
67 wa_size = 0
68 index_sol(1:nthgrp2) = 0
69 DO niter=1,nthgrp2
70 ityp=ithgrp(2,niter)
71 nn =ithgrp(4,niter)
72 iadb =ithgrp(5,niter)
73 nvar=ithgrp(6,niter)
74 iadv=ithgrp(7,niter)
75 ii=0
76 IF(ityp==1)THEN
77! -------------------------------
78 ih=iadb
79
80 DO WHILE((ithbuf(ih+nn) /= ispmd).AND.(ih < iadb+nn))
81 ih = ih + 1
82 ENDDO
83
84 IF (ih >= iadb+nn) GOTO 666
85
86 DO ng=1,ngroup
87 ity = iparg(5,ng)
88 isvis = iparg(60,ng)
89 ivisc = iparg(61,ng)
90 nft = iparg(3,ng)
91c
92 IF (ity == ityp) THEN
93 mte = iparg(1,ng)
94 nel = iparg(2,ng)
95 IF (mte /= 0 .AND. mte /= 13) THEN
96 DO i=1,nel
97 n =i+nft
98 k =ithbuf(ih)
99 ip=ithbuf(ih+nn)
100
101 IF (k == n)THEN
102 ih=ih+1
103 ii = ((ih-1) - iadb)*nvar
104 DO WHILE((ithbuf(ih+nn) /= ispmd).AND.(ih < iadb+nn))
105 ih = ih + 1
106 ENDDO
107 IF (ih > iadb+nn) GOTO 666
108 wa_size = wa_size + nvar + 1
109 ENDIF ! element = ITHBUF()
110 ENDDO ! NEL
111 ENDIF ! mte /= 13
112 ENDIF ! ITY
113 ENDDO ! groupe
114! -------------------------------
115 ENDIF
116 666 continue
117 index_sol(niter) = wa_size
118 ENDDO
119
120
121 j_first = 0
122 bool = .true.
123 DO i=1,nthgrp2
124 IF(bool.EQV..true.) THEN
125 IF( index_sol(i)/=0 ) THEN
126 bool = .false.
127 j_first = i
128 ENDIF
129 ENDIF
130 ENDDO
131
132 j = 0
133 IF(j_first>0) THEN
134 j=j+1
135 index_wa_sol(j) = index_sol(j_first)
136 j=j+1
137 index_wa_sol(j) = j_first
138 DO i=j_first+1,nthgrp2
139 IF( index_sol(i)-index_sol(i-1)>0 ) THEN
140 j=j+1
141 index_wa_sol(j) = index_sol(i)
142 j=j+1
143 index_wa_sol(j) = i
144 ENDIF
145 ENDDO
146 ENDIF
147 index_wa_sol(2*nthgrp2+1) = j ! number of non-zero index
148C-----------
149 RETURN
150 END SUBROUTINE thsol_count
thsol_count
subroutine thsol_count(nthgrp2, ithgrp, wa_size, index_wa_sol, iparg, ithbuf, sithbuf)
Definition thsol_count.F:30