OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_clusters.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!|| st_qaprint_clusters ../starter/source/output/qaprint/st_qaprint_clusters.F
25!||--- called by ------------------------------------------------------
26!|| st_qaprint_driver ../starter/source/output/qaprint/st_qaprint_driver.F
27!||--- calls -----------------------------------------------------
28!|| fretitl2 ../starter/source/starter/freform.F
29!||--- uses -----------------------------------------------------
30!|| cluster_mod ../starter/share/modules1/cluster_mod.F
31!||====================================================================
32 SUBROUTINE st_qaprint_clusters(NOM_OPT ,INOM_OPT ,CLUSTERS )
33C============================================================================
34C M o d u l e s
35C-----------------------------------------------
36 USE qa_out_mod
37 USE cluster_mod
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C C o m m o n B l o c k s
45C-----------------------------------------------
46#include "com04_c.inc"
47#include "scr17_c.inc"
48#include "tabsiz_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER, INTENT(IN) :: NOM_OPT(LNOPT1,SNOM_OPT1), INOM_OPT(SINOM_OPT)
53 TYPE (CLUSTER_) ,DIMENSION(NCLUSTER) :: CLUSTERS
54C-----------------------------------------------
55C NOM_OPT(LNOPT1,SNOM_OPT1)
56C * Possibly, NOM_OPT(1) = ID
57C NOM_OPT(LNOPT1-LTITL+1:LTITL) <=> TITLES of the OPTIONS
58C--------------------------------------------------
59C SNOM_OPT1= NRBODY+NACCELM+NVOLU+NINTER+NINTSUB+
60C + NRWALL+NJOINT+NSECT+NLINK+
61C + NUMSKW+1+NUMFRAM+1+NFXBODY+NFLOW+NRBE2+
62C + NRBE3+NSUBMOD+NFXVEL+NUMBCS+NUMMPC+
63C + NGJOINT+NUNIT0+NFUNCT+NADMESH+
64C + NSPHIO+NSPCOND+NRBYKIN+NEBCS+
65C + NINICRACK+NODMAS+NBGAUGE+NCLUSTER+NINTERFRIC+
66C + NRBMERGE
67C-----------------------------------------------
68C INOM_OPT(SINOM_OPT)
69C--------------------------------------------------
70C INOM_OPT(1) = NRBODY
71C INOM_OPT(2) = INOM_OPT(1) + NACCELM
72C INOM_OPT(3) = INOM_OPT(2) + NVOLU
73C INOM_OPT(4) = INOM_OPT(3) + NINTER
74C INOM_OPT(5) = INOM_OPT(4) + NINTSUB
75C INOM_OPT(6) = INOM_OPT(5) + NRWALL
76C INOM_OPT(7) = INOM_OPT(6)
77C INOM_OPT(8) = INOM_OPT(7) + NJOINT
78C INOM_OPT(9) = INOM_OPT(8) + NSECT
79C INOM_OPT(10)= INOM_OPT(9) + NLINK
80C INOM_OPT(11)= INOM_OPT(10)+ NUMSKW+1+NUMFRAM+1+NSUBMOD
81C INOM_OPT(12)= INOM_OPT(11)+ NFXBODY
82C INOM_OPT(13)= INOM_OPT(12)+ NFLOW
83C INOM_OPT(14)= INOM_OPT(13)+ NRBE2
84C INOM_OPT(15)= INOM_OPT(14)+ NRBE3
85C INOM_OPT(16)= INOM_OPT(15)+ NFXVEL
86C INOM_OPT(17)= INOM_OPT(16)+ NUMBCS
87C INOM_OPT(18)= INOM_OPT(17)+ NUMMPC
88C INOM_OPT(19)= INOM_OPT(18)+ NGJOINT
89C INOM_OPT(20)= INOM_OPT(19)+ NUNIT0
90C INOM_OPT(21)= INOM_OPT(20)+ NFUNCT
91C INOM_OPT(22)= INOM_OPT(21)+ NADMESH
92C INOM_OPT(23)= INOM_OPT(22)+ NSPHIO
93C INOM_OPT(24)= INOM_OPT(23)+ NSPCOND
94C INOM_OPT(25)= INOM_OPT(24)+ NEBCS
95C INOM_OPT(26)= INOM_OPT(25)+ NINICRACK
96C INOM_OPT(27)= INOM_OPT(26)+ NODMAS
97C INOM_OPT(28)= INOM_OPT(27)+ NBGAUGE
98C INOM_OPT(29)= INOM_OPT(28)+ NCLUSTER
99C INOM_OPT(30)= INOM_OPT(29)+ NINTERFRIC
100C INOM_OPT(31)= INOM_OPT(30)+ NRBMERGE
101C .. TO BE MAINTAINED (cf doc/inom_opt.txt) ..
102C-----------------------------------------------
103C--------------------------------------------------
104C L o c a l V a r i a b l e s
105C-----------------------------------------------
106 INTEGER I, MY_ID, MY_CLUSTER, TEMP_INT
107 CHARACTER(LEN=NCHARTITLE) :: TITR
108 CHARACTER (LEN=255) :: VARNAME
109 DOUBLE PRECISION TEMP_DOUBLE
110C-----------------------------------------------
111C /CLUSTER
112C-----------------------------------------------
113 IF (myqakey('/CLUSTER')) THEN
114 DO my_cluster=1,ncluster
115C
116 titr(1:nchartitle)=''
117 my_id = clusters(my_cluster)%ID
118 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,inom_opt(28) + my_cluster),ltitr)
119 IF(len_trim(titr)/=0)THEN
120 CALL qaprint(titr(1:len_trim(titr)),my_id,0.0_8)
121 ELSE
122 CALL qaprint('A_CLUSTER_FAKE_NAME', my_id,0.0_8)
123 END IF
124C
125 WRITE(varname,'(A)') 'CLUSTER_ELGROUP'
126 temp_int = clusters(my_cluster)%IGR
127 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
128C
129 WRITE(varname,'(A)') 'CLUSTER_TYPE'
130 temp_int = clusters(my_cluster)%TYPE
131 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
132C
133 WRITE(varname,'(A)') 'CLUSTER_SKEW'
134 temp_int = clusters(my_cluster)%SKEW
135 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
136C
137 WRITE(varname,'(A)') 'CLUSTER_NEL'
138 temp_int = clusters(my_cluster)%NEL
139 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
140C
141 DO i = 1, clusters(my_cluster)%NEL
142 WRITE(varname,'(A,I0)') 'CLUSTER_ELEM_',i
143 temp_int = clusters(my_cluster)%ELEM(i)
144 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
145 ENDDO
146C
147 WRITE(varname,'(A)') 'CLUSTER_IFAIL'
148 temp_int = clusters(my_cluster)%IFAIL
149 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
150C
151 WRITE(varname,'(A)') 'CLUSTER_OFF'
152 temp_int = clusters(my_cluster)%OFF
153 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
154C
155 WRITE(varname,'(A)') 'CLUSTER_FAIL'
156 temp_double = clusters(my_cluster)%FAIL
157 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
158C
159 WRITE(varname,'(A)') 'CLUSTER_NNOD'
160 temp_int = clusters(my_cluster)%NNOD
161 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
162C
163 DO i = 1, clusters(my_cluster)%NNOD
164 WRITE(varname,'(A,I0)') 'CLUSTER_NNOD1_',i
165 temp_int = clusters(my_cluster)%NOD1(i)
166 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
167 ENDDO
168C
169 DO i = 1, clusters(my_cluster)%NNOD
170 WRITE(varname,'(A,I0)') 'CLUSTER_NNOD2_',i
171 temp_int = clusters(my_cluster)%NOD2(i)
172 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
173 ENDDO
174C
175 DO i = 1,2
176 WRITE(varname,'(A,I0)') 'CLUSTER_FMAX',i
177 temp_double = clusters(my_cluster)%FMAX(i)
178 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
179 ENDDO
180C
181 DO i = 1,2
182 WRITE(varname,'(A,I0)') 'CLUSTER_MMAX',i
183 temp_double = clusters(my_cluster)%MMAX(i)
184 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
185 ENDDO
186C
187 IF (clusters(my_cluster)%IFAIL == 3) THEN
188C
189 DO i = 1,4
190 WRITE(varname,'(A,I0)') 'CLUSTER_AX',i
191 temp_double = clusters(my_cluster)%AX(i)
192 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
193 ENDDO
194C
195 DO i = 1,4
196 WRITE(varname,'(A,I0)') 'CLUSTER_NX',i
197 temp_double = clusters(my_cluster)%NX(i)
198 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
199 ENDDO
200C
201 ENDIF
202C
203 END DO
204 END IF
205C-----------------------------------------------
206 RETURN
207 END
integer, parameter nchartitle
logical function myqakey(value)
@purpose Check if a given value is part of the values set by env variable Useful to make a condition ...
Definition qa_out_mod.F:694
subroutine qaprint(name, idin, value)
@purpose print one entry to QA extract file example of call for real print CALL QAPRINT('MY_LABEL',...
Definition qa_out_mod.F:390
subroutine st_qaprint_clusters(nom_opt, inom_opt, clusters)
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804