OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_loads.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_loads ../starter/source/output/qaprint/st_qaprint_loads.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!||====================================================================
31 SUBROUTINE st_qaprint_loads(NOM_OPT ,INOM_OPT ,NUMLOADP ,ILOADP ,LLOADP ,
32 2 LOADP ,IBCL ,FORC ,IPRES ,PRES ,
33 3 IBCR ,FRADIA ,IBCV ,FCONV , IGRV ,
34 4 LGRV ,AGRV ,ICFIELD ,LCFIELD ,CFIELD ,
35 5 IPRELOAD ,PRELOAD ,IFLAG_BPRELOAD,
36 6 LIFLOW, LRFLOW, IFLOW,RFLOW ,ISPHIO ,VSPHIO ,
37 7 GLOB_THERM,PBLAST)
38C============================================================================
39C M o d u l e s
40C-----------------------------------------------
41 USE qa_out_mod
42 USE names_and_titles_mod , ONLY : nchartitle
43 use glob_therm_mod
44 USE pblast_mod
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "com01_c.inc"
53#include "com04_c.inc"
54#include "param_c.inc"
55#include "scr03_c.inc"
56#include "scr17_c.inc"
57#include "tabsiz_c.inc"
58#include "boltpr_c.inc"
59#include "sphcom.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER, INTENT(IN) :: NOM_OPT(LNOPT1,SNOM_OPT1), INOM_OPT(SINOM_OPT)
64C-----------------------------------------------
65C NOM_OPT(LNOPT1,SNOM_OPT1)
66C * Possibly, NOM_OPT(1) = ID
67C NOM_OPT(LNOPT1-LTITL+1:LTITL) <=> TITLES of the OPTIONS
68C--------------------------------------------------
69C SNOM_OPT1= NRBODY+NACCELM+NVOLU+NINTER+NINTSUB+
70C + NRWALL+NJOINT+NSECT+NLINK+
71C + NUMSKW+1+NUMFRAM+1+NFXBODY+NFLOW+NRBE2+
72C + NRBE3+NSUBMOD+NFXVEL+NUMBCS+NUMMPC+
73C + NGJOINT+NUNIT0+NFUNCT+NADMESH+
74C + NSPHIO+NSPCOND+NRBYKIN+NEBCS+
75C + NINICRACK+NODMAS+NBGAUGE+NCLUSTER+NINTERFRIC+
76C + NRBMERGE
77C-----------------------------------------------
78C INOM_OPT(SINOM_OPT)
79C--------------------------------------------------
80C INOM_OPT(1) = NRBODY
81C INOM_OPT(2) = INOM_OPT(1) + NACCELM
82C INOM_OPT(3) = INOM_OPT(2) + NVOLU
83C INOM_OPT(4) = INOM_OPT(3) + NINTER
84C INOM_OPT(5) = INOM_OPT(4) + NINTSUB
85C INOM_OPT(6) = INOM_OPT(5) + NRWALL
86C INOM_OPT(7) = INOM_OPT(6)
87C INOM_OPT(8) = INOM_OPT(7) + NJOINT
88C INOM_OPT(9) = INOM_OPT(8) + NSECT
89C INOM_OPT(10)= INOM_OPT(9) + NLINK
90C INOM_OPT(11)= INOM_OPT(10)+ NUMSKW+1+NUMFRAM+1+NSUBMOD
91C INOM_OPT(12)= INOM_OPT(11)+ NFXBODY
92C INOM_OPT(13)= INOM_OPT(12)+ NFLOW
93C INOM_OPT(14)= INOM_OPT(13)+ NRBE2
94C INOM_OPT(15)= INOM_OPT(14)+ NRBE3
95C INOM_OPT(16)= INOM_OPT(15)+ NFXVEL
96C INOM_OPT(17)= INOM_OPT(16)+ NUMBCS
97C INOM_OPT(18)= INOM_OPT(17)+ NUMMPC
98C INOM_OPT(19)= INOM_OPT(18)+ NGJOINT
99C INOM_OPT(20)= INOM_OPT(19)+ NUNIT0
100C INOM_OPT(21)= INOM_OPT(20)+ NFUNCT
101C INOM_OPT(22)= INOM_OPT(21)+ NADMESH
102C INOM_OPT(23)= INOM_OPT(22)+ NSPHIO
103C INOM_OPT(24)= INOM_OPT(23)+ NSPCOND
104C INOM_OPT(25)= INOM_OPT(24)+ NEBCS
105C INOM_OPT(26)= INOM_OPT(25)+ NINICRACK
106C INOM_OPT(27)= INOM_OPT(26)+ NODMAS
107C INOM_OPT(28)= INOM_OPT(27)+ NBGAUGE
108C INOM_OPT(29)= INOM_OPT(28)+ NCLUSTER
109C INOM_OPT(30)= INOM_OPT(29)+ NINTERFRIC
110C INOM_OPT(31)= INOM_OPT(30)+ NRBMERGE
111C .. TO BE MAINTAINED (cf doc/inom_opt.txt) ..
112C-----------------------------------------------
113 TYPE (glob_therm_) ,intent(in) :: glob_therm
114 TYPE (PBLAST_) ,intent(in) :: PBLAST
115 INTEGER, INTENT(IN) :: NUMLOADP, ILOADP(SIZLOADP,NLOADP), LLOADP(NUMLOADP)
116 INTEGER, INTENT(IN) :: ICFIELD(SIZFIELD,NLOADC), LCFIELD(SLCFIELD)
117 INTEGER, INTENT(IN) :: IBCL(NIBCLD,NCONLD-NPRELD), IPRES(NIBCLD,NPRELD)
118 INTEGER, INTENT(IN) :: IBCR(GLOB_THERM%NIRADIA,GLOB_THERM%NUMRADIA)
119 INTEGER, INTENT(IN) :: IBCV(GLOB_THERM%NICONV,GLOB_THERM%NUMCONV)
120 INTEGER, INTENT(IN) :: IGRV(NIGRV,NGRAV), LGRV(*)
121 INTEGER, INTENT(IN) :: IPRELOAD(3,*), IFLAG_BPRELOAD(NUMELS)
122 my_real, INTENT(IN) ::
123 . loadp(lfacload,nloadp), cfield(lfacload,nloadc),
124 . forc(lfaccld,nconld-npreld), pres(lfaccld,npreld),
125 . agrv(lfacgrv,ngrav),preload(6,*)
126 my_real, INTENT(IN) :: fradia(glob_therm%LFACTHER,glob_therm%NUMRADIA)
127 my_real, INTENT(IN) :: fconv(glob_therm%LFACTHER,glob_therm%NUMCONV)
128 INTEGER, INTENT(IN) :: LIFLOW, LRFLOW
129 INTEGER, DIMENSION(LIFLOW), INTENT(IN) :: IFLOW
130 my_real, DIMENSION(LRFLOW), INTENT(IN) :: RFLOW
131 INTEGER ISPHIO(NISPHIO,NSPHIO)
132 my_real
133 . vsphio(svsphio)
134C--------------------------------------------------
135C L o c a l V a r i a b l e s
136C-----------------------------------------------
137 INTEGER I,IPRE, MY_ID, MY_LOAD,J,
138 . ids(nsphio),idx(nsphio),ii,my_sphio,lvad(nsphio),
139 . first,last
140 CHARACTER(LEN=NCHARTITLE) :: TITR
141 CHARACTER (LEN=255) :: VARNAME
142 DOUBLE PRECISION TEMP_DOUBLE
143 LOGICAL :: OK_QA
144 INTEGER :: COUNT,IOPT_FIRST,IOPT_LAST
145C-----------------------------------------------
146C /LOAD/CENTRI
147C-----------------------------------------------
148 IF (myqakey('/LOAD/CENTRI')) THEN
149 DO my_load=1,nloadc
150C
151C Title of the option was not stored in NOM_OPT ... TBD
152 titr(1:nchartitle)=''
153 IF(len_trim(titr)/=0)THEN
154 CALL qaprint(titr(1:len_trim(titr)),icfield(9,my_load),0.0_8)
155 ELSE
156 CALL qaprint('A_LOAD_CENTRI_FAKE_NAME',icfield(9,my_load),0.0_8)
157 END IF
158C
159 DO i=1,sizfield
160 IF(icfield(i,my_load) /=0)THEN
161C
162C VARNAME: variable name in ref.extract (without blanks)
163 WRITE(varname,'(A,I0)') 'ICFIELD_',i ! ICFIELD(11) => 'ICFIELD_11'
164 CALL qaprint(varname(1:len_trim(varname)),icfield(i,my_load),0.0_8)
165 END IF
166 END DO
167C
168 DO i=icfield(4,my_load),icfield(4,my_load)+icfield(1,my_load)-1
169C
170C VARNAME: variable name in ref.extract (without blanks)
171 WRITE(varname,'(A,I0)') 'LCFIELD_',i ! LCFIELD(11) => 'LCFIELD_11'
172 CALL qaprint(varname(1:len_trim(varname)),lcfield(i),0.0_8)
173 END DO
174C
175 DO i=1,lfacload
176 IF(cfield(i,my_load)/=zero)THEN
177C
178C VARNAME: variable name in ref.extract (without blanks)
179 WRITE(varname,'(A,I0)') 'CFIELD_',i
180 temp_double = cfield(i,my_load)
181 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
182 END IF
183 END DO
184C
185 END DO ! MY_LOAD=1,NLOADC
186 END IF
187C-----------------------------------------------
188C /LOAD/PFLUID & /LOAD/PBLAST & /LOAD/PRESSURE
189C-----------------------------------------------
190 ok_qa = myqakey('/LOAD/PFLUID') .OR. myqakey('/LOAD/PBLAST') .OR. myqakey('/LOAD/PRESSURE')
191
192 IF (ok_qa) THEN
193 !output pressure only
194 iopt_first = 0
195 iopt_last = 0
196 IF(myqakey('/LOAD/PFLUID'))THEN
197 !output pfluid only
198 iopt_first = 1
199 iopt_last = nloadp_f
200 ELSEIF(myqakey('/LOAD/PBLAST'))THEN
201 !output pblast only
202 iopt_first = 1+nloadp_f
203 iopt_last = nloadp_f+pblast%NLOADP_B
204 ELSEIF(myqakey('/LOAD/PRESSURE'))THEN
205 !output pressure only
206 iopt_first = 1+nloadp_f+pblast%NLOADP_B
207 iopt_last = nloadp_f+pblast%NLOADP_B+nloadp_hyd
208 ENDIF
209
210 !common procedure for /LOAD/PFLUID, /LOAD/PBLAST, /LOAD/PRESSURE options.
211 DO my_load=iopt_first,iopt_last
212C
213C Title of the option was not stored in NOM_OPT ... TBD
214 titr(1:nchartitle)=''
215 IF(len_trim(titr)/=0)THEN
216 CALL qaprint(titr(1:len_trim(titr)),iloadp(2,my_load),0.0_8)
217 ELSE
218 CALL qaprint('A_LOAD_PFLUID_FAKE_NAME',iloadp(2,my_load),0.0_8)
219 END IF
220C
221 DO i=1,sizloadp
222 IF(iloadp(i,my_load) /=0)THEN
223C
224C VARNAME: variable name in ref.extract (without blanks)
225 WRITE(varname,'(A,I0)') 'ILOADP_',i ! ILOADP(11) => 'ILOADP_11'
226 CALL qaprint(varname(1:len_trim(varname)),iloadp(i,my_load),0.0_8)
227 END IF
228 END DO
229
230 DO i=1,lfacload
231 IF(loadp(i,my_load)/=zero)THEN
232C
233C VARNAME: variable name in ref.extract (without blanks)
234 WRITE(varname,'(A,I0)') 'LOADP_',i
235 temp_double = loadp(i,my_load)
236 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
237 END IF
238 END DO
239
240 first=iloadp(4,my_load)
241 last=iloadp(4,my_load)+iloadp(1,my_load)-1
242
243 IF(last-first+1 <= 10 )THEN
244 !display all segments
245 DO i=first,last
246C VARNAME: variable name in ref.extract (without blanks)
247 WRITE(varname,'(A,I0)') 'LLOADP_',i ! LLOADP(11) => 'LLOADP_11'
248 CALL qaprint(varname(1:len_trim(varname)),lloadp(i),0.0_8)
249 END DO
250 ELSE
251 !display only 5 first ones and 5 last ones
252 !first 5 segments
253 first=iloadp(4,my_load)
254 last=first+5
255 DO i=first,last
256C VARNAME: variable name in ref.extract (without blanks)
257 WRITE(varname,'(A,I0)') 'LLOADP_',i ! LLOADP(11) => 'LLOADP_11'
258 CALL qaprint(varname(1:len_trim(varname)),lloadp(i),0.0_8)
259 END DO
260 !suspension points '...'
261 CALL qaprint('...',0,0.0_8)
262 !last 5 segments
263 last=iloadp(4,my_load)+iloadp(1,my_load)-1
264 first=last-5
265 DO i=first,last
266C VARNAME: variable name in ref.extract (without blanks)
267 WRITE(varname,'(a,i0)') 'lloadp_',I ! LLOADP(11) => 'lloadp_11'
268 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),LLOADP(I),0.0_8)
269 END DO
270 ENDIF
271C
272 END DO ! MY_LOAD=IOPT_FIRST, IOPT_LAST
273 END IF
274
275C-----------------------------------------------
276C /CLOAD
277C-----------------------------------------------
278 IF (MYQAKEY('/cload')) THEN
279 DO MY_LOAD=1,NCONLD-NPRELD
280C
281C Title of the option was not stored in NOM_OPT ... TBD
282C and Cload ID is not stored
283 TITR(1:nchartitle)=''
284 IF(LEN_TRIM(TITR)/=0)THEN
285 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_LOAD,0.0_8)
286 ELSE
287 CALL QAPRINT('a_cload_fake_name',MY_LOAD,0.0_8)
288 END IF
289C
290 DO I=1,NIBCLD
291 IF(IBCL(I,MY_LOAD) /=0)THEN
292C
293C VARNAME: variable name in ref.extract (without blanks)
294 WRITE(VARNAME,'(a,i0)') 'ibcl_',I ! IBCL(11) => 'ibcl_11'
295 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IBCL(I,MY_LOAD),0.0_8)
296 END IF
297 END DO
298C
299 DO I=1,LFACCLD
300 IF(FORC(I,MY_LOAD)/=ZERO)THEN
301C
302C VARNAME: variable name in ref.extract (without blanks)
303 WRITE(VARNAME,'(a,i0)') 'forc_',I
304 TEMP_DOUBLE = FORC(I,MY_LOAD)
305 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
306 END IF
307 END DO
308C
309 END DO ! MY_LOAD=1,NCONLD-NPRELD
310 END IF
311C-----------------------------------------------
312C /PLOAD
313C-----------------------------------------------
314 IF (MYQAKEY('/pload')) THEN
315 DO MY_LOAD=1,NPRELD
316C
317C Title of the option was not stored in NOM_OPT ... TBD
318C and Pload ID is not stored
319 TITR(1:nchartitle)=''
320 IF(LEN_TRIM(TITR)/=0)THEN
321 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_LOAD,0.0_8)
322 ELSE
323 CALL QAPRINT('a_pload_fake_name',MY_LOAD,0.0_8)
324 END IF
325C
326 DO I=1,NIBCLD
327 IF(IPRES(I,MY_LOAD) /=0)THEN
328C
329C VARNAME: variable name in ref.extract (without blanks)
330 WRITE(VARNAME,'(a,i0)') 'ipres_',I ! IPRES(11) => 'ipres_11'
331 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IPRES(I,MY_LOAD),0.0_8)
332 END IF
333 END DO
334C
335 DO I=1,LFACCLD
336 IF(PRES(I,MY_LOAD)/=ZERO)THEN
337C
338C VARNAME: variable name in ref.extract (without blanks)
339 WRITE(VARNAME,'(a,i0)') 'pres_',I
340 TEMP_DOUBLE = PRES(I,MY_LOAD)
341 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
342 END IF
343 END DO
344C
345 END DO ! MY_LOAD=1,NPRELD
346 END IF
347C-----------------------------------------------
348C /RADIATION
349C-----------------------------------------------
350 IF (MYQAKEY('/radiation')) THEN
351 DO MY_LOAD=1,GLOB_THERM%NUMRADIA
352C
353C Title of the option was not stored in NOM_OPT ... TBD
354C and Radiation ID is not stored
355 TITR(1:nchartitle)=''
356 IF(LEN_TRIM(TITR)/=0)THEN
357 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_LOAD,0.0_8)
358 ELSE
359 CALL QAPRINT('a_radiation_fake_name',MY_LOAD,0.0_8)
360 END IF
361C
362 DO I=1,GLOB_THERM%NIRADIA
363 IF(IBCR(I,MY_LOAD) /=0)THEN
364C
365C VARNAME: variable name in ref.extract (without blanks)
366 WRITE(VARNAME,'(a,i0)') 'ibcr_',I ! IBCR(11) => 'ibcr_11'
367 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IBCR(I,MY_LOAD),0.0_8)
368 END IF
369 END DO
370C
371 DO I=1,GLOB_THERM%LFACTHER
372 IF(FRADIA(I,MY_LOAD)/=ZERO)THEN
373C
374C VARNAME: variable name in ref.extract (without blanks)
375 WRITE(VARNAME,'(a,i0)') 'fradia_',I
376 TEMP_DOUBLE = FRADIA(I,MY_LOAD)
377 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
378 END IF
379 END DO
380C
381 END DO ! MY_LOAD=1,NUMRADIA
382 END IF
383C-----------------------------------------------
384C /CONVEC
385C-----------------------------------------------
386 IF (MYQAKEY('/convec')) THEN
387 DO MY_LOAD=1,GLOB_THERM%NUMCONV
388C
389C Title of the option was not stored in NOM_OPT ... TBD
390C and Convev ID is not stored
391 TITR(1:nchartitle)=''
392 IF(LEN_TRIM(TITR)/=0)THEN
393 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_LOAD,0.0_8)
394 ELSE
395 CALL QAPRINT('a_convec_fake_name',MY_LOAD,0.0_8)
396 END IF
397C
398 DO I=1,GLOB_THERM%NICONV
399 IF(IBCV(I,MY_LOAD) /=0)THEN
400C
401C VARNAME: variable name in ref.extract (without blanks)
402 WRITE(VARNAME,'(a,i0)') 'ibcv_',I ! IBCV(11) => 'ibcv_11'
403 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IBCV(I,MY_LOAD),0.0_8)
404 END IF
405 END DO
406C
407 DO I=1,GLOB_THERM%LFACTHER
408 IF(FCONV(I,MY_LOAD)/=ZERO)THEN
409C
410C VARNAME: variable name in ref.extract (without blanks)
411 WRITE(VARNAME,'(a,i0)') 'fconv_',I
412 TEMP_DOUBLE = FCONV(I,MY_LOAD)
413 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
414 END IF
415 END DO
416C
417 END DO ! MY_LOAD=1,NUMCONV
418 END IF
419C-----------------------------------------------
420C /GRAV
421C-----------------------------------------------
422 IF (MYQAKEY('/grav')) THEN
423 DO MY_LOAD=1,NGRAV
424C
425C Title of the option was not stored in NOM_OPT ... TBD
426 TITR(1:nchartitle)=''
427 MY_ID=IGRV(5,MY_LOAD)
428 IF(LEN_TRIM(TITR)/=0)THEN
429 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_ID,0.0_8)
430 ELSE
431 CALL QAPRINT('a_gravity_fake_name',MY_ID,0.0_8)
432 END IF
433C
434 DO I=1,NIGRV
435 IF(IGRV(I,MY_LOAD) /=0)THEN
436C
437C VARNAME: variable name in ref.extract (without blanks)
438 WRITE(VARNAME,'(a,i0)') 'igrv_',I ! IGRV(11) => 'igrv_11'
439 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IGRV(I,MY_LOAD),0.0_8)
440 END IF
441 END DO
442C
443 DO I=IGRV(4,MY_LOAD),IGRV(4,MY_LOAD)+IGRV(1,MY_LOAD)-1
444C
445C VARNAME: variable name in ref.extract (without blanks)
446 WRITE(VARNAME,'(a,i0)') 'lgrv_',I
447 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),LGRV(I),0.0_8)
448 END DO
449C
450 DO I=1,LFACGRV
451 IF(AGRV(I,MY_LOAD)/=ZERO)THEN
452C
453C VARNAME: variable name in ref.extract (without blanks)
454 WRITE(VARNAME,'(a,i0)') 'agrv_',I
455 TEMP_DOUBLE = AGRV(I,MY_LOAD)
456 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
457 END IF
458 END DO
459C
460 END DO ! MY_LOAD=1,NGRAV
461 END IF
462C-----------------------------------------------
463C /PRELOAD
464C-----------------------------------------------
465 IF (MYQAKEY('/preload')) THEN
466C
467 ! ID of /PRELOAD is not stored and so not retrieved
468 IF (NPRELOAD > 0) THEN
469
470 DO IPRE = 1,NUMPRELOAD
471c
472 TITR(1:nchartitle)=''
473 IF(LEN_TRIM(TITR)/=0)THEN
474 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),IPRE,0.0_8)
475 ELSE
476 CALL QAPRINT('preload_fake_name',IPRE,0.0_8)
477 END IF
478c
479 DO J = 1 , 3
480 IF(IPRELOAD(J,IPRE) /=0)THEN
481 WRITE(VARNAME,'(a,i0,i0)') 'IPRELOAD_',j,ipre
482 CALL qaprint(varname(1:len_trim(varname)),ipreload(j,ipre),0.0_8)
483 END IF
484 ENDDO
485c
486 IF(ipreload(1,ipre) /=0)THEN
487 j = ipreload(1,ipre)
488 IF(iflag_bpreload(j) /=0)THEN ! this table is used in PRELOAD but modified in sgrhead and SGRTAILS
489 WRITE(varname,'(A,I0)') 'IFLAG_BPRELOAD_',j
490 CALL qaprint(varname(1:len_trim(varname)),iflag_bpreload(j),0.0_8)
491 END IF
492 END IF
493c
494 DO j = 1 , 6
495 IF(preload(j,ipre)/=zero)THEN
496 WRITE(varname,'(A,I0,I0)') 'PRELOAD_',j,ipre
497 temp_double = preload(j,ipre)
498 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
499 END IF
500 ENDDO
501c
502 ENDDO
503 ENDIF
504 ENDIF
505
506C /BEM/DAA and /BEM/FLOW
507 ok_qa = myqakey('/BEM') .AND. nflow > 0
508 IF (ok_qa) THEN
509 WRITE(varname, '(A)') "LIFLOW_=_"
510 CALL qaprint(varname(1:len_trim(varname)), liflow, 0.0_8)
511 WRITE(varname, '(A)') "LRFLOW_=_"
512 CALL qaprint(varname(1:len_trim(varname)), lrflow, 0.0_8)
513 count = 0
514 DO i = 1, liflow
515 WRITE(varname, '(A, I0)') "IFLOW ", i
516 IF (iflow(i) /= 0) THEN
517 count = count + 1
518 CALL qaprint(varname(1:len_trim(varname)), iflow(i), 0.0_8)
519 ENDIF
520 IF (count == 100) EXIT
521 ENDDO
522 count = 0
523 DO i = liflow, 1, -1
524 WRITE(varname, '(A, I0)') "IFLOW ", i
525 IF (iflow(i) /= 0) THEN
526 count = count + 1
527 CALL qaprint(varname(1:len_trim(varname)), iflow(i), 0.0_8)
528 ENDIF
529 IF (count == 100) EXIT
530 ENDDO
531 count = 0
532 DO i = 1, lrflow
533 WRITE(varname, '(A, I0)') "RFLOW ", i
534 temp_double = rflow(i)
535 IF (temp_double /= 0.0_8) THEN
536 count = count + 1
537 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
538 ENDIF
539 IF (count == 100) EXIT
540 ENDDO
541 count = 0
542 DO i = lrflow, 1, -1
543 WRITE(varname, '(A, I0)') "RFLOW ", i
544 temp_double = rflow(i)
545 IF (temp_double /= 0.0_8) THEN
546 count = count + 1
547 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
548 ENDIF
549 IF (count == 100) EXIT
550 ENDDO
551 ENDIF
552C-----------------------------------------------
553C /SPH/INOUT
554C-----------------------------------------------
555 IF (myqakey('/SPH/INOUT')) THEN
556 IF (nsphio > 0) THEN
557C
558! sort by id to ensure internal order independent output
559 DO i = 1, nsphio
560 ids(i) = isphio(nisphio,i)
561 idx(i) = i
562 IF (i /= nsphio) THEN
563 lvad(i) = isphio(4,i+1) - isphio(4,i)
564 ELSE
565 lvad(i) = svsphio - isphio(4,i)
566 ENDIF
567 ENDDO
568 CALL quicksort_i2(ids, idx, 1, nsphio)
569C
570! Loop over /SPH/INOUT
571 DO ii = 1,nsphio
572C
573 my_sphio = idx(ii)
574 titr(1:nchartitle)=''
575 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,inom_opt(22) + my_sphio),ltitr)
576 my_id = nom_opt(1,inom_opt(22)+my_sphio)
577 IF (len_trim(titr) /= 0) THEN
578 CALL qaprint(titr(1:len_trim(titr)),my_id,0.0_8)
579 ELSE
580 CALL qaprint('A_SPH_INOUT_FAKE_NAME',my_id,0.0_8)
581 END IF
582C
583 DO i = 1,nisphio
584 IF (isphio(i,my_sphio) /= 0) THEN
585 WRITE(varname,'(A,I0)') 'ISPHIO_',i
586 CALL qaprint(varname(1:len_trim(varname)),isphio(i,my_sphio),0.0_8)
587 END IF
588 END DO
589C
590 DO i = isphio(4,my_sphio),isphio(4,my_sphio)+lvad(my_sphio)-1
591 IF ( vsphio(i) /= zero) THEN
592 WRITE(varname,'(A,I0)') 'VSPHIO_',i
593 temp_double = vsphio(i)
594 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
595 END IF
596 ENDDO
597C
598 END DO ! MY_LOAD=1,NGRAV
599 ENDIF
600 END IF
601
602C-----------------------------------------------
603
604C-----------------------------------------------
605
606 RETURN
607 END
convec
subroutine convec(ibcv, fconv, npc, tf, x, temp, nsensor, sensor_tab, fthe, iad, fthesky, python, glob_therm)
Definition convec.F:38
my_real
#define my_real
Definition cppsort.cpp:32
id
initmumps id
Definition multiplerhs_example.m:4
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
qa_out_mod
Definition qa_out_mod.F:78
qa_out_mod::myqakey
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
qa_out_mod::qaprint
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
quicksort_i2
recursive subroutine quicksort_i2(a, idx, first, last)
Definition quicksort.F:153
radiation
subroutine radiation(ibcr, fradia, npc, tf, x, temp, nsensor, sensor_tab, fthe, iad, fthesky, python, glob_therm)
Definition radiation.F:38
st_qaprint_loads
subroutine st_qaprint_loads(nom_opt, inom_opt, numloadp, iloadp, lloadp, loadp, ibcl, forc, ipres, pres, ibcr, fradia, ibcv, fconv, igrv, lgrv, agrv, icfield, lcfield, cfield, ipreload, preload, iflag_bpreload, liflow, lrflow, iflow, rflow, isphio, vsphio, glob_therm, pblast)
Definition st_qaprint_loads.F:38
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804