OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
leclas.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!|| leclas ../starter/source/loads/laser/leclas.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
29!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
30!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
31!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
32!|| leclas1 ../starter/source/loads/laser/leclas1.F
33!|| preleclas ../starter/source/loads/laser/lpreleclas.F
34!||--- uses -----------------------------------------------------
35!|| format_mod ../starter/share/modules1/format_mod.F90
36!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
37!|| restmod ../starter/share/modules1/restart_mod.F
38!|| submodel_mod ../starter/share/modules1/submodel_mod.F
39!||====================================================================
40 SUBROUTINE leclas(LSUBMODEL)
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE restmod
45 USE submodel_mod
46 USE hm_option_read_mod
47 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
48 USE format_mod , ONLY : fmw_a_i
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "scr17_c.inc"
57#include "units_c.inc"
58#include "com04_c.inc"
59#include "tabsiz_c.inc"
60#include "titr_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 TYPE(submodel_data),INTENT(IN) ::LSUBMODEL(*)
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 my_real :: fi, alpha,chaleur,dar,tscale,xk0,rdk,hnuk,timescal
69 my_real :: fac_m, fac_l, fac_t
70 INTEGER :: K1, K2, I, J, MFK, IFK, NL, NC, IFUNC, IAFUNC, K, ID, ITYP
71 INTEGER :: UID, IFLAGUNIT, STAT
72 CHARACTER(LEN=NCHARKEY) :: KEY,KEY2
73 CHARACTER(LEN=NCHARTITLE) :: TITR
74 LOGICAL IS_AVAILABLE
75C-----------------------------------------------
76C P r e - C o n d i t i o n
77C-----------------------------------------------
78 CALL preleclas(silas,sxlas,lsubmodel)
79C-----------------------------------------------
80C S o u r c e L i n e s
81C-----------------------------------------------
82 IF(.NOT.ALLOCATED(ilas))ALLOCATE (ilas(silas) ,stat=stat)
83 IF(.NOT.ALLOCATED(xlas))ALLOCATE (xlas(sxlas) ,stat=stat)
84 IF(nlaser == 0)RETURN
85 WRITE(istdo,'(A)')titre(49)
86 IF (silas > 0) ilas = 0
87 IF (sxlas > 0) xlas = zero
88C-----------------------------------------------
89 i=0
90 timescal=zero
91 ityp=0
92 k1 = 1
93 k2 = 1
94 WRITE(iout,'(/,A)') ' LASER BEAM IMPACT'
95 WRITE(iout,'(A)') ' -----------------'
96
97 CALL hm_option_start('/DFS/LASER')
98
99
100 DO k=1,nlaser
101
102 titr = ''
103 key = ''
104
105 CALL hm_option_read_key(lsubmodel,
106 . option_id = id,
107 . option_titr = titr ,
108 . unit_id = uid ,
109 . keyword2 = key )
110
111 !---------------------------------!
112 ! UNITS !
113 !---------------------------------!
114 DO j=1,unitab%NUNITS
115 IF (unitab%UNIT_ID(j) == uid) THEN
116 fac_m = unitab%FAC_M(j)
117 fac_l = unitab%FAC_L(j)
118 fac_t = unitab%FAC_T(j)
119 iflagunit = 1
120 EXIT
121 ENDIF
122 ENDDO
123
124 !---------------------------------!
125 ! READING !
126 !---------------------------------!
127 i=i+1
128
129 CALL hm_get_floatv('SLAS' ,fi ,is_available, lsubmodel, unitab)
130 CALL hm_get_intv ('fct_IDLAS' ,ifunc ,is_available, lsubmodel)
131 CALL hm_get_floatv('STAR' ,alpha ,is_available, lsubmodel, unitab)
132 CALL hm_get_intv ('fct_IDTAR' ,iafunc ,is_available, lsubmodel)
133
134 CALL hm_get_floatv('Hn' ,hnuk ,is_available, lsubmodel, unitab)
135 CALL hm_get_floatv('VCp' ,chaleur ,is_available, lsubmodel, unitab)
136 CALL hm_get_floatv('K0' ,xk0 ,is_available, lsubmodel, unitab)
137 CALL hm_get_floatv('Rd' ,rdk ,is_available, lsubmodel, unitab)
138 CALL hm_get_floatv('Ks' ,dar ,is_available, lsubmodel, unitab)
139
140 CALL hm_get_intv ('Np' ,nl ,is_available, lsubmodel)
141 CALL hm_get_intv ('Nc' ,nc ,is_available, lsubmodel)
142
143 IF (timescal == zero) timescal = one
144 !---------------------------------!
145 ! LISTING PRINTOUT !
146 !---------------------------------!
147 IF(ityp==0)THEN
148 WRITE(iout,'(/,A,I10,/)')
149 . ' LASER COLUMN TYPE 0',i
150 WRITE(iout,'(A,1PG20.13)')
151 . ' LASER INTENSITY FACTOR. . . . . =',fi
152 WRITE(iout,fmt=fmw_a_i)
153 . ' LASER INTENSITY FUNCTION. . . . =',ifunc
154 WRITE(iout,'(A,1PG20.13)')
155 . ' TARGET REFLEXION FACTOR . . . . =',alpha
156 WRITE(iout,fmt=fmw_a_i)
157 . ' TARGET REFLEXION FUNCTION . . . =',iafunc
158 WRITE(iout,'(A,1PG20.13)')
159 . ' LASER FREQUENCY H*NU/K. . . . . =',hnuk
160 WRITE(iout,'(a,1pg20.13)')
161 . ' latent heat(melting+vapor.) . . =',CHALEUR
162 WRITE(IOUT,'(a,1pg20.13)')
163 . ' inverse bremsstrahlung xk0. . . =',XK0
164 WRITE(IOUT,'(a,1pg20.13)')
165 . ' inverse bremsstrahlung rd/k . . =',RDK
166 WRITE(IOUT,'(a,1pg20.13)')
167 . ' complement absorption in vapour =',DAR
168 WRITE(IOUT,FMT=FMW_A_I)
169 . ' TARGET element. . . . . . . . . =',NC
170 WRITE(IOUT,'(a,1pg20.13)')
171 . ' time scale factor . . . . . . . =',TIMESCAL
172 WRITE(IOUT,FMT=FMW_A_I)
173 . ' number of plasma element. . . . =',NL
174 WRITE(IOUT,'(a)')
175 . ' list of plasma element(from laser to TARGET) :'
176 ELSE
177 WRITE(IOUT,'(/,a,i10,/)')
178 . ' laser column TYPE 1',I
179 WRITE(IOUT,'(a,1pg20.13)')
180 . ' laser intensity factor. . . . . =',FI
181 WRITE(IOUT,'(a,i10)')
182 . ' laser intensity function. . . . =',IFUNC
183 WRITE(IOUT,'(a,1pg20.13)')
184 . ' full vapo. energy(/unit volume) =',CHALEUR
185 WRITE(IOUT,'(a,i10)')
186 . ' number of element. . . . . . . .=',NL
187 WRITE(IOUT,'(a)')
188 . ' list of plasma element(from laser to TARGET) :'
189 ENDIF
190
191 !------------------------------------!
192 ! UNITS !
193 !------------------------------------!
194 !CHALEUR = CHALEUR * FAC_L*FAC_L/FAC_T/FAC_T ! J/kg/K
195 !XK0 = XK0 * FAC_L**5 ! m**5
196 !DAR = DAR * FAC_L**5 ! m**5/mole**2
197
198 !------------------------------------!
199 ! STORAGE !
200 !------------------------------------!
201 XK0 = XK0 * RDK**3.5
202
203 ILAS(K1) = NL
204 ILAS(K1+3) = IFUNC
205 ILAS(K1+4) = IAFUNC
206 ILAS(K1+5) = ITYP
207
208 XLAS(K2) =CHALEUR
209 XLAS(K2+1)=FI
210 XLAS(K2+2)=ALPHA
211
212 XLAS(K2+3)=XK0
213 XLAS(K2+4)=HNUK
214 XLAS(K2+5)=DAR/(HNUK**2)
215 XLAS(K2+6) = ONE / TIMESCAL
216
217 CALL LECLAS1(NL,ILAS(K1+6),NC ,LSUBMODEL)
218 IFK = 6 + 2*(NL+1)
219 MFK = 7
220 K1 = K1 + IFK
221 K2 = K2 + MFK
222
223 ENDDO
224
225C-----------------------------------------------
226 RETURN
227 END
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
leclas
subroutine leclas(lsubmodel)
Definition leclas.F:41
preleclas
subroutine preleclas(num, numr, lsubmodel)
Definition lpreleclas.F:36
hm_option_read_mod
Definition hm_option_read_mod.F:408
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
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
restmod::unitab
type(unit_type_) unitab
Definition restart_mod.F:211
restmod::ilas
integer, dimension(:), allocatable ilas
Definition restart_mod.F:60
submodel_mod
Definition submodel_mod.F:712
submodel_mod::submodel_data
Definition submodel_mod.F:723