OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
leclas.F File Reference
#include "implicit_f.inc"
#include "scr17_c.inc"
#include "units_c.inc"
#include "com04_c.inc"
#include "tabsiz_c.inc"
#include "titr_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine leclas (lsubmodel)

Function/Subroutine Documentation

◆ leclas()

subroutine leclas ( type(submodel_data), dimension(*), intent(in) lsubmodel)

Definition at line 40 of file leclas.F.

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
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
leclas1
subroutine leclas1(nl, las, nc, lsubmodel)
Definition leclas1.F:35
preleclas
subroutine preleclas(num, numr, lsubmodel)
Definition lpreleclas.F:36
id
initmumps id
Definition multiplerhs_example.m:4
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
nl
character *2 function nl()
Definition message.F:2354