OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_dfs_lasers.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_dfs_lasers ../starter/source/output/qaprint/st_qaprint_dfs_lasers.F
25!||--- called by ------------------------------------------------------
26!|| st_qaprint_driver ../starter/source/output/qaprint/st_qaprint_driver.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!||====================================================================
30 SUBROUTINE st_qaprint_dfs_lasers(XLAS,ILAS)
31C-----------------------------------------------
32C M o d u l e s
33C-----------------------------------------------
34 USE qa_out_mod
35 USE groupdef_mod
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C C o m m o n B l o c k s
42C-----------------------------------------------
43#include "com04_c.inc"
44C-----------------------------------------------
45C D u m m y A r g u m e n t s
46C-----------------------------------------------
47 my_real, INTENT(IN) :: xlas(*)
48 INTEGER, INTENT(IN) :: ILAS(*)
49C--------------------------------------------------
50C L o c a l V a r i a b l e s
51C-----------------------------------------------
52 LOGICAL :: OK_QA
53 CHARACTER (LEN=255) :: VARNAME
54 INTEGER K,J,DET_IID,I1,I2,I3,I4,I5,I6
55 DOUBLE PRECISION TEMP_DOUBLE
56 INTEGER :: NL,K1,K2,IFUNC,ITYP, IFK, MFK, IAFUNC, NCELL
57 DOUBLE PRECISION :: CHALEUR, FSI, XK0, HNUK, DAR_HNUK_2,ONE_TIMESCAL, FI, ALPHA
58C-----------------------------------------------
59C S o u r c e L i n e s
60C-----------------------------------------------
61
62 IF (myqakey('LASERS') ) THEN
63
64 k1 = 1
65 k2 = 1
66
67 DO k=1,nlaser
68
69 nl = ilas(k1)
70 ifunc = ilas(k1+3)
71 iafunc = ilas(k1+4)
72 ityp = ilas(k1+5)
73
74 chaleur = xlas(k2)
75 fi = xlas(k2+1)
76 alpha = xlas(k2+2)
77
78 xk0 = xlas(k2+3)
79 hnuk = xlas(k2+4)
80 dar_hnuk_2 = xlas(k2+5)
81 one_timescal = xlas(k2+6)
82
83
84 WRITE(varname,'(A,I0,A,I0,A)') 'laser(',K ,')%ILAS(',K1,')=nl :'
85 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),ILAS(K1),0.0_8)
86 WRITE(VARNAME,'(a,i0,a,i0,a)') 'laser(',K ,')%ILAS(',K1+3,')=ifunc :'
87 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),ILAS(K1+3),0.0_8)
88 WRITE(VARNAME,'(a,i0,a,i0,a)') 'laser(',K ,')%ILAS(',K1+4,')=iafunc :'
89 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),ILAS(K1+4),0.0_8)
90 WRITE(VARNAME,'(a,i0,a,i0,a)') 'laser(',K ,')%ILAS(',K1+5,')=ityp :'
91 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),ILAS(K1+5),0.0_8)
92
93 NCELL=0
94 DO J=1,2*NL,2
95 NCELL=NCELL+1
96 WRITE(VARNAME,'(a,i0,a,i0,a,i0,a)') 'laser(',K ,')%ILAS(',K1+5+J,')=elem(',NCELL,') :'
97 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),ILAS(K1+5+J),0.0_8)
98 WRITE(VARNAME,'(a,i0,a,i0,a)') 'laser(',K ,')%ILAS(',K1+5+J+1,')=ng :'
99 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),ILAS(K1+5+J+1),0.0_8)
100 ENDDO
101
102 WRITE(VARNAME,'(a,i0,a,i0,a,i0,a)') 'laser(',K ,')%XLAS(',K2,')=chaleur :'
103 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,CHALEUR)
104 WRITE(VARNAME,'(a,i0,a,i0,a,i0,a)') 'laser(',K ,')%XLAS(',K2+1,')=fi :'
105 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,FI)
106 WRITE(VARNAME,'(a,i0,a,i0,a,i0,a)') 'laser(',K ,')%XLAS(',K2+2,')=alpha :'
107 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,ALPHA)
108
109 WRITE(VARNAME,'(a,i0,a,i0,a,i0,a)') 'laser(',K ,')%XLAS(',K2+3,')=xk0 :'
110 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,XK0)
111 WRITE(VARNAME,'(a,i0,a,i0,a,i0,a)') 'laser(',K ,')%XLAS(',K2+4,')=hnuk :'
112 CALL qaprint(varname(1:len_trim(varname)),0,hnuk)
113 WRITE(varname,'(A,I0,A,I0,A,I0,A)') 'LASER(',k ,')%XLAS(',k2+5,')=DAR_HNUK_2 :'
114 CALL qaprint(varname(1:len_trim(varname)),0,dar_hnuk_2)
115 WRITE(varname,'(A,I0,A,I0,A,I0,A)') 'LASER(',k ,')%XLAS(',k2+6,')=UN_TIMESCAL :'
116 CALL qaprint(varname(1:len_trim(varname)),0,one_timescal)
117
118 ifk = 6 + 2*(nl+1)
119 mfk = 7
120 k1 = k1 + ifk
121 k2 = k2 + mfk
122
123 ENDDO !next K
124 ENDIF
125C-----------------------------------------------
126 RETURN
127 END
128
my_real
#define my_real
Definition cppsort.cpp:32
groupdef_mod
Definition groupdef_mod.F:668
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
st_qaprint_dfs_lasers
subroutine st_qaprint_dfs_lasers(xlas, ilas)
Definition st_qaprint_dfs_lasers.F:31