OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
freform.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!|| freform ../engine/source/input/freform.F
25!||--- called by ------------------------------------------------------
26!|| lecinp ../engine/source/input/lecinp.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!|| connection_sock_init_c ../engine/source/coupling/rad2rad/rad2rad_c.c
31!|| errmsg ../engine/source/input/errmsg.F
32!|| fraleonoff ../engine/source/input/fraleonoff.F
33!|| fralnk ../engine/source/input/fralnk.F
34!|| fralnk2 ../engine/source/input/fralnk.F
35!|| freabf ../engine/source/input/freabf.F
36!|| freanim ../engine/source/output/anim/reader/freanim.F
37!|| frebcs ../engine/source/input/frebcs.F
38!|| frecpl ../engine/source/input/frecpl.F
39!|| fredamp ../engine/source/input/fredamp.F
40!|| fredebug ../engine/source/input/fredebug.F
41!|| fredli ../engine/source/input/fredli.F
42!|| fredli7 ../engine/source/input/fredli7.F
43!|| fredynain ../engine/source/input/fredynain.F
44!|| freeig ../engine/source/input/freeig.F
45!|| freflw ../engine/source/input/freflw.F
46!|| frefunc ../engine/source/input/frefunc.F
47!|| frefvbag ../engine/source/input/frefvbag.F
48!|| frefxinp ../engine/source/input/frefxinp.F
49!|| freimpl ../engine/source/input/freimpl.F
50!|| freiniv ../engine/source/input/freiniv.F
51!|| freint ../engine/source/input/freint.F
52!|| frelnk ../engine/source/input/frelnk.F
53!|| frenois ../engine/source/input/frenois.F
54!|| freoutp ../engine/source/input/freoutp.F
55!|| frerbo ../engine/source/input/frerbo.f
56!|| frestat ../engine/source/input/frestat.F
57!|| frethermal ../engine/source/constraints/thermic/frethermal.F
58!|| freupwind ../engine/source/input/freupwind.F
59!|| freupwm ../engine/source/input/freupwm.F
60!|| h3d_ini ../engine/source/output/h3d/h3d_build_fortran/h3d_ini.F
61!|| h3d_read ../engine/source/output/h3d/h3d_build_fortran/h3d_read.F
62!|| init_idel_brick ../engine/source/modules/dt_mod.F
63!|| open_f_scratch_file ../engine/source/system/open_tempfile.F
64!|| rdele ../engine/source/input/rdele.F
65!|| redkey0 ../engine/source/input/redkey0.F
66!|| redkey1 ../engine/source/input/redkey1.F
67!|| redkey1_h3d ../engine/source/input/redkey1_h3d.f
68!|| wriusc2 ../engine/source/input/wriusc2.F
69!||--- uses -----------------------------------------------------
70!|| ale_mod ../common_source/modules/ale/ale_mod.F
71!|| alemuscl_mod ../common_source/modules/ale/alemuscl_mod.F
72!|| check_mod ../common_source/modules/check_mod.F
73!|| dt_mod ../engine/source/modules/dt_mod.F
74!|| fvbag_mod ../engine/share/modules/fvbag_mod.F
75!|| glob_therm_mod ../common_source/modules/mat_elem/glob_therm_mod.F90
76!|| h3d_mod ../engine/share/modules/h3d_mod.F
77!|| message_mod ../engine/share/message_module/message_mod.F
78!|| metric_mod ../common_source/modules/interfaces/metric_mod.F
79!|| names_and_titles_mod ../common_source/modules/names_and_titles_mod.F
80!|| output_mod ../common_source/modules/output/output_mod.F90
81!|| sensor_mod ../common_source/modules/sensor_mod.F90
82!|| state_mod ../common_source/modules/state_mod.F
83!|| th_mod ../engine/share/modules/th_mod.F
84!|| viper_mod ../engine/source/coupling/viper/viper_interface_mod.F90
85!||====================================================================
86 SUBROUTINE freform(IRUNN,IRFL,IRFE,H3D_DATA,FLAG_CST_AMS,DYNAIN_DATA,
87 . SENSORS,DT,OUTPUT,GLOB_THERM)
88C-----------------------------------------------
89C D e s c r i p t i o n
90C-----------------------------------------------
91C This subroutine is Engine reader.
92C It reads all Engine options from user input file
93C-----------------------------------------------
94C M o d u l e s
95C-----------------------------------------------
96 USE message_mod
97 USE h3d_mod
98 USE metric_mod
99 USE check_mod
100 USE fvbag_mod
101 USE th_mod
102 USE state_mod
103 USE alemuscl_mod , only:alemuscl_param
104 USE ale_mod
105 USE sensor_mod
106 USE dt_mod
107 USE output_mod
108 USE names_and_titles_mod, ONLY: ncharline100,ncharkey
109 use glob_therm_mod
110 USE viper_mod
111C-----------------------------------------------
112C I m p l i c i t T y p e s
113C-----------------------------------------------
114#include "implicit_f.inc"
115C-----------------------------------------------
116C D u m m y A r g u m e n t s
117C-----------------------------------------------
118 INTEGER IRUNN, IRFL, IRFE, FLAG_CST_AMS
119 TYPE(h3d_database), INTENT(INOUT) :: H3D_DATA
120 TYPE (DYNAIN_DATABASE), INTENT(INOUT) :: DYNAIN_DATA
121 TYPE (SENSORS_), INTENT(INOUT) :: SENSORS
122 TYPE (DT_), INTENT(INOUT) :: DT
123 TYPE(output_), INTENT(INOUT) :: OUTPUT !< output structure
124 type (glob_therm_) ,intent(inout) :: glob_therm
125C-----------------------------------------------
126C C o m m o n B l o c k s
127C-----------------------------------------------
128#include "task_c.inc"
129#include "units_c.inc"
130#include "warn_c.inc"
131#include "scr02_c.inc"
132#include "scr03_c.inc"
133#include "scr05_c.inc"
134#include "scr06_c.inc"
135#include "scr07_c.inc"
136#include "scr17_c.inc"
137#include "scr18_c.inc"
138#include "stati_c.inc"
139#include "statr_c.inc"
140#include "cong1_c.inc"
141#include "cong2_c.inc"
142#include "chara_c.inc"
143#include "scrfs_c.inc"
144#include "parit_c.inc"
145#include "couple_c.inc"
146#include "rad2r_c.inc"
147#include "timeri_c.inc"
148#include "com01_c.inc"
149#include "com04_c.inc"
150#include "com08_c.inc"
151#include "check.inc"
152#include "scr19_c.inc"
153#include "ddspmd_c.inc"
154#include "sms_c.inc"
155C-----------------------------------------------
156C L o c a l P a r a m e t e r s
157C-----------------------------------------------
158 INTEGER NKEY, NUM_ALE_KEY2
159 parameter(nkey = 93)
160 parameter(num_ale_key2 = 25)
161C-----------------------------------------------
162C L o c a l V a r i a b l e s
163C-----------------------------------------------
164 INTEGER IKAD(0:NKEY+1),
165 . kdtix, kimpl, kflsec, kfunc, kkerel, kdyrel, krun, ktitle,
166 . kdt, ktfile, kprint, krfile, kvers, kale, kdel,
167 . kvel, kbcs, kbcsr, kdebug,koutp,kalesub,kproc,
168 . knoise,kdelin,kparit,kiniv,krbody,kanim,kinter,
169 . kupwm, kmon,kdt1,kincmp,kth, kstop, kkill,
170 . kmadym,kspmd,krad2r,kdamp,n_damp, katfil,kbtfil,kctfil,kdtfil,
171 . ketfil,kftfil,kgtfil,khtfil,kitfil, krerun, kfxinp,
172 . nfxinp,keig,neigoff,neoff,kfvbag,
173 . nfvmesh,kstatf,kshver,kabf,kdtsde,
174 . kaabf,kbabf,kcabf,kdabf,keabf,kfabf,kgabf,khabf,kiabf,nfvmodi,
175 . kupwind,kthermal,kh3d,kreport,knegvol,kadyrel,kdt1tet10,kperf,
176 . kdynain,kdttsh,kmass,ksensor,kviper
177 integer
178 . ikey,i,ii,i1,j,j1,j2,k,kk,m,n, nct, ikold, nbc, k3, k4,
179 . nubcs1,nubcs2, ir,idt,neltgof,irec,
180 . iale_grid_form, nintof, nelsof, ndel, nof,ittyp, ncpri0,ncpri_head0,
181 . nelqof, nelcof, neltof, nelpof, nelrof, num_bcs, nintch,
182 . nrbynf, nbcs1, nbcs2, nrbyon, nrbyof, niniv,ninivt,
183 . intch_ifop,iusc_tmp,intch_itop,nbtopfop,konoff,nintnof,nintsof,
184 . nsphof,naleof,neulerof,nthermof, idtgrx,ibid, m1, m2, iform,
185 . gr_id, nlinkoff,is_prevkeya_ncharkey,is_keya_ncharkey, iflag,
186 . dt_ctrl_compatibility(3), lowmach_opt,io_err, niterp, iok_read,
187 . id_bag, ierr1, id_dt_option, fvmbag_l_type, inum,intdt,nbsens,
188 . num_ale_grid,npartof
189 INTEGER :: BCS_SK_FR(10000),VEL_SK_FR(10000),NSLASH(NKEY)
190 INTEGER :: NBALEOFF, NBALEON, NBPARTALEON, NBPARTALEOFF
191 my_real
192 . tstop0,dtfac0, dtmin0, alp, gam,
193 . a1, a2, a3, vm, dtfaca,dtmina, vt, tmp,dtfac_ams,
194 . lambda,l_type
195 CHARACTER KEY(9)*5, TITLE*81, KEY1*5, KEY2*5,KEY3*5, CH4*4, KEY4*5, KEY5*5, StringALE*32
196 CHARACTER(LEN=NCHARLINE100) :: KEYA
197 CHARACTER(LEN=NCHARLINE100) :: CARTE,KEYW,MOT1,LINE
198 CHARACTER(LEN=NCHARKEY), DIMENSION(9) :: KEY_H3D
199 CHARACTER(LEN=5), DIMENSION(NKEY) :: KEY0
200 CHARACTER(LEN=5), DIMENSION(NUM_ALE_KEY2) :: KEYALE
201 CHARACTER(len=NCHARLINE100) :: STRING_RESTART
202 LOGICAL :: lFOUND
203 REAL(KIND=8) :: dthis0
204 REAL(KIND=8), dimension(9) :: dthis01
205C-----------------------------------------------
206 INTEGER LEN_IUSC1_FN,LEN_IUSC2_FN,LEN_IUSCTMP_FN
207 CHARACTER(LEN=10192) :: IUSC1_FN,IUSC2_FN,IUSCTMP_FN
208C-----------------------------------------------
209C E x t e r n a l F u n c t i o n s
210C-----------------------------------------------
211 INTEGER,EXTERNAL :: NVAR
212C-----------------------------------------------
213 DATA key0/
214 . 'RUN ' ,'TITLE' ,'DT ' ,'TFILE' ,'PRINT' ,
215 . 'RFILE' ,'VERS ' ,'' ,'' ,'ALE ' ,
216 . 'DEL ' ,'VEL ' ,'BCS ' ,'BCSR ' ,'INTER' ,
217 . 'DTIX ' ,'IMPL ' ,'FUNCT' ,'FLSEC' ,'DYREL' ,
218 . 'KEREL' ,'RBODY' ,'ANIM' ,'' ,'DEBUG' ,
219 . 'OUTP ' ,'' ,'ALESU' ,'PROC' ,'' ,
220 . '@TFIL' ,'delin' ,'' ,'parit' ,'iniv ' ,
221 . 'upwm ' ,'mon' ,'' ,'dt1' ,'incmp' ,
222 . '' ,'th' ,'stop' ,'kill' ,'madym' ,
223 . 'spmd ' ,'rad2r' ,'damp' ,'atfil' ,'btfil' ,
224 . 'ctfil' ,'dtfil' ,'etfil' ,'ftfil' ,'gtfil' ,
225 . 'htfil' ,'itfil' ,'rerun' ,'' ,'fxinp' ,
226 . '' ,'' ,'eig' ,'' ,'fvmba' ,
227 . '' ,'state' ,'shver' ,'' ,'abf' ,
228 . 'dtsde' ,'aabf' ,'babf' ,'cabf' ,'dabf' ,
229 . 'eabf ' ,'fabf' ,'gabf' ,'habf' ,'iabf' ,
230 . 'upwin' ,'therm' ,'h3d' ,'repor' ,'negvo' ,
231 . 'adyre' ,'dt1te' ,'perf' ,'dynai' ,'dttsh' ,
232 . 'mass ' ,'sens ' ,'viper' /
233
234 DATA KRUN/1/ ,KTITLE/2/ ,KDT/3/ ,KTFILE/4/ ,KPRINT/5/ ,
235 . KRFILE/6/ ,KVERS/7/ , KALE/10/ ,
236 . KDEL/11/ ,KVEL/12/ ,KBCS/13/ ,KBCSR/14/ ,KINTER/15/ ,
237 . KDTIX/16/ ,KIMPL/17/ ,KFUNC/18/ ,KFLSEC/19/ ,KDYREL/20/ ,
238 . KKEREL/21/ ,KRBODY/22/ ,KANIM/23/ ,KDEBUG/25/ ,
239 . KOUTP/26/ , KALESUB/28/ ,KPROC/29/ ,
240 . KNOISE/31/ ,KDELIN/32/ , KPARIT/34/ ,KINIV/35/ ,
241 . KUPWM/36/ ,KMON/37/ , KDT1/39/ ,KINCMP/40/ ,
242 . KTH/42/ ,KSTOP/43/ ,KKILL/44/ ,KMADYM/45/ ,
243 . KSPMD/46/ ,KRAD2R/47/ ,KDAMP/48/ ,KATFIL/49/ ,KBTFIL/50/ ,
244 . KCTFIL/51/ ,KDTFIL/52/ ,KETFIL/53/ ,KFTFIL/54/ ,KGTFIL/55/ ,
245 . KHTFIL/56/ ,KITFIL/57/ ,KRERUN/58/ ,KFXINP/60/,
246 . KEIG/63/ , KFVBAG/65/ ,
247 . KSTATF/67/ ,KSHVER/68/ ,KABF/70/ ,
248 . KDTSDE/71/ ,KAABF/72/ ,KBABF/73/ ,KCABF/74/ ,KDABF/75/ ,
249 . KEABF/76/ ,KFABF/77/ ,KGABF/78/ ,KHABF/79/ ,KIABF/80/ ,
250 . KUPWIND/81/,KTHERMAL/82/ ,KH3D/83/ ,KREPORT/84/ ,KNEGVOL/85/,
251 . KADYREL/86/,KDT1TET10/87/,KPERF/88/ ,KDYNAIN/89/ ,KDTTSH/90/ ,
252 . KMASS/91/ ,KSENSOR/92/ ,KVIPER/93/
253
254 DATA KEYALE/
255 . 'bcs ' ,'close' ,'grid ' ,'link ' ,'mat ' ,
256 . 'on ' ,'off ' ,'muscl' ,'solve' ,'zero ' ,
257 . 'donea' ,'stand' ,'sprin' ,'disp ' ,'supg ' ,
258 . '0 ' ,'1 ' ,'2 ' ,'3 ' ,'4 ' ,
259 . 'lowma' ,'lapla' ,'volum' ,'FLOW-' ,'LAGRA'/
260
261C-----------------------------------------------
262C S o u r c e L i n e s
263C-----------------------------------------------
264 key=" "
265 key2=" "
266 key3=" "
267 key4=" "
268
269 CALL open_f_scratch_file(iusc1,2,rootn,lenrootn,iusc1_fn)
270 len_iusc1_fn=len_trim(iusc1_fn)
271
272 CALL open_f_scratch_file(iusc2,1,rootn,lenrootn,iusc2_fn)
273 len_iusc2_fn=len_trim(iusc2_fn)
274
275C warning IBM/MPI does not support REWIND with STDIN !
276 iusc_tmp=60
277 CALL open_f_scratch_file(iusc_tmp,1,rootn,lenrootn,iusctmp_fn)
278 len_iusctmp_fn=len_trim(iusctmp_fn)
279C
280 rootnam=' '
281 rootlen = 0
282 ierr=0
283 nct=0
284 j1 = 0
285 j2 = 0
286 nbc = 0
287 ikad(0:nkey+1)=0
288 nslash(1:nkey) = 0
289 ikey = 0
290
291 dtfaca = ep30
292 dtmina = ep30
293 lambda = zero
294 l_type = zero
295 id_bag = 0
296
297 percent_addmass = zero
298 dt_stop_percent_addmass = zero
299 idt_percent_addmass = 0
300
301 th_titles = 0
302c
303 ierr1=0
304 IF(.NOT.ALLOCATED(fvmbag_input_options)) ALLOCATE(fvmbag_input_options(8192),stat=ierr1)
305 IF (ierr1/=0) GOTO 1000
306 DO ii=1,8192
307 fvmbag_input_options(ii)%LAMBDA = zero
308 fvmbag_input_options(ii)%ID_BAG = 0
309 fvmbag_input_options(ii)%L_type = 0
310 fvmbag_input_options(ii)%ID_DT_OPTION = -1
311 ENDDO
312 num_opt_dt_fvmbag = 0
313 num_opt_dt_fvmbag_0 = 0
314 num_opt_dt_fvmbag_1 = 0
315 num_opt_dt_fvmbag_2 = 0
316 num_opt_dt_fvmbag_3 = 0
317C
318C DT_CTRL_COMPATIBILITY(1) = 1 -> if /DT/NODA/CST is present
319C DT_CTRL_COMPATIBILITY(2) = 1 -> if /DT/AMS is present
320C DT_CTRL_COMPATIBILITY(3) = 1 -> if /DT/CST_AMS is present
321 dt_ctrl_compatibility = 0
322
323 !ALE TIME STEP
324 ale%GLOBAL%IDT_ALE = 0
325C FLAG for Hybrid CST + AMS
326 flag_cst_ams = 0
327
328C---------------------------------------------------
329C ENUMERATION OF CARDS BY OPTION
330C---------------------------------------------------
331 10 READ(istdi,'(A)',END=20) KEYA(1:NCHARLINE100)
332 WRITE(iusc_tmp,'(A)') keya(1:ncharline100)
333 IF(keya(1:4)=='/END')GOTO 20
334 nct=nct+1
335 IF(keya(1:1)=='#')GOTO 10
336 IF(keya(1:1)=='$')GOTO 10
337 IF(keya==' ') GOTO 10
338 IF(keya(1:1)=='/') CALL redkey0(key0,nkey,keya,ikey,nslash)
339 IF(ikey==0) GOTO 10
340 ikad(ikey)=ikad(ikey)+1
341 IF(keya(1:4)=='/BCS' .AND. keya(1:5)/='/BCSR') THEN
342 i=2
343 j1 = j1 +1
344 DO WHILE(keya(i:i)/='/'.AND.i<len_trim(keya))
345 i=i+1
346 ENDDO
347 i=i+1
348 DO WHILE(keya(i:i)/='/'.AND.i<len_trim(keya))
349 i=i+1
350 ENDDO
351 i=i+1
352 DO WHILE(keya(i:i)/='/'.AND.i<len_trim(keya))
353 i=i+1
354 ENDDO
355 i=i+1
356 i1=i
357 IF (j1>1000) THEN
358 CALL ancmsg(msgid=74,anmode=aninfo,c1=keya(1:i1-1),c2='/BCS OR /BCSR')
359 CALL arret(2)
360 END IF
361 IF(i < len_trim(keya)) THEN
362 DO WHILE(keya(i1:i1)/='/'.AND.i1<len_trim(keya))
363 i1=i1+1
364 ENDDO
365 mot1=keya(i:i1)
366 READ(mot1,fmt='(i10)')BCS_SK_FR(J1)
367 ELSE
368 BCS_SK_FR(J1) = 0
369 ENDIF
370 ENDIF
371C---
372 IF(KEYA(1:4)=='/vel') THEN
373 I=2
374 J2 = J2 +1
375 DO WHILE(KEYA(I:I)/='/.AND.'I<LEN_TRIM(KEYA))
376 I=I+1
377 ENDDO
378 I=I+1
379 DO WHILE(KEYA(I:I)/='/.AND.'I<LEN_TRIM(KEYA))
380 I=I+1
381 ENDDO
382 I=I+1
383 DO WHILE(KEYA(I:I)/='/.AND.'I<LEN_TRIM(KEYA))
384 I=I+1
385 ENDDO
386 I=I+1
387 I1=I
388 IF (J2>1000) THEN
389 CALL ANCMSG(MSGID=74,ANMODE=ANINFO,C1=KEYA(1:I1-1),C2='/vel')
390 CALL ARRET(2)
391 END IF
392 IF(I < LEN_TRIM(KEYA)) THEN
393 DO WHILE(KEYA(I1:I1)/='/.AND.'I1<LEN_TRIM(KEYA))
394 I1=I1+1
395 ENDDO
396 IF(KEYA(I1:I1)=='/')I1=I1-1 !set position to the first character before '/'
397 MOT1=KEYA(I:I1)
398 READ(MOT1,FMT='(i10)')VEL_SK_FR(J2)
399 ELSE
400 VEL_SK_FR(J2) = 0
401 ENDIF
402 ENDIF
403C---
404 GO TO 10
405 20 CONTINUE
406 ISTDI=IUSC_TMP
407 REWIND(ISTDI)
408C---------------------------------------------------
409C CURSORS INITIALIZATION
410C---------------------------------------------------
411 IKAD(0)=1
412 DO I=1,NKEY+1
413 IKAD(I)=IKAD(I)+IKAD(I-1)
414 ENDDO
415 DO I=NKEY+1,1,-1
416 IKAD(I)=IKAD(I-1)
417 ENDDO
418C---------------------------------------------------
419C KEYWORD CLASSIFYING / DIRECT ACCESS
420C---------------------------------------------------
421 IKOLD=0
422 IS_KEYA_NCHARKEY = 0
423 IS_PREVKEYA_NCHARKEY = 0
424 DO N=1,NCT
425 READ(ISTDI,'(a)') KEYA
426 IF(KEYA(1:1)=='#')CYCLE
427 IF(keya(1:1)=='$')cycle
428 IF(keya==' ') cycle
429 !---
430 IF(keya(1:4)=='/H3D' .OR. keya(1:6)=='/STATE'.OR. keya(1:7)=='/DYNAIN'.OR.keya(1:5)=='/ANIM'.OR.
431 . keya(1:5)=='/DAMP')THEN
432 is_keya_ncharkey = 1
433 ELSE
434 is_keya_ncharkey = 0
435 ENDIF
436 !---
437 IF(is_keya_ncharkey == 1)THEN
438 IF(is_prevkeya_ncharkey == 1 .AND. ikold /=0)THEN
439 WRITE(iusc1,rec=ikold,fmt='(A,I10)') keyw,nbc
440 ELSEIF(ikold/=0)THEN
441 WRITE(iusc1,rec=ikold,fmt='(17A,I10)')'/',(key(i),'/',i=1,8),nbc
442 ENDIF
443 keyw = keya
444 is_prevkeya_ncharkey = 1
445 CALL redkey1_h3d(key_h3d,key0,nkey,keya,ikey,ir)
446 IF(ir/=0) cycle
447 nbc=0
448 ikold=ikad(ikey)
449 ELSEIF(keya(1:1)=='/')THEN
450 IF(is_prevkeya_ncharkey == 1 .AND. ikold /=0)THEN
451 WRITE(iusc1,rec=ikold,fmt='(A,I10)') keyw,nbc
452 ELSEIF(ikold/=0)THEN
453 WRITE(iusc1,rec=ikold,fmt='(17A,I10)')'/',(key(i),'/',i=1,8),nbc
454 ENDIF
455 is_prevkeya_ncharkey = 0
456 CALL redkey1(key,key0,nkey,keya,ikey,ir)
457 IF(ir/=0) cycle
458 nbc=0
459 ikold=ikad(ikey)
460 ELSEIF( is_prevkeya_ncharkey == 1) THEN
461 nbc=nbc+1
462 WRITE(iusc1,rec=ikad(ikey),fmt='(A)')keya
463 ELSE
464 nbc=nbc+1
465 WRITE(iusc1,rec=ikad(ikey),fmt='(A)')keya
466 ENDIF
467 ikad(ikey)=ikad(ikey)+1
468 ENDDO !next N
469c
470 IF( is_prevkeya_ncharkey == 1) THEN
471 WRITE(iusc1,rec=ikold,fmt='(A,I10)') keyw,nbc
472 ELSE
473 WRITE(iusc1,rec=ikold,fmt='(17A,I10)')'/',(key(i),'/',i=1,8),nbc
474 ENDIF
475C
476 DO i=nkey+1,1,-1
477 ikad(i)=ikad(i-1)
478 ENDDO
479C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
480 CLOSE(unit=iusc_tmp)
481 CALL delete_user_file(iusctmp_fn,len_iusctmp_fn)
482 istdi = 5
483 IF (got_input==1) THEN
484 istdi=80
485 CLOSE(unit=istdi, status='DELETE', iostat=io_err)
486 ELSE
487 CLOSE (unit=istdi)
488 ENDIF
489C========================================================================
490C /RERUN/ROOTNAME/IRUN (RERUN OPTION)
491C---------------
492 ikey = krerun
493 irunn = 1
494 mcheck = 0
495 tstop0 = zero
496 IF(ikad(ikey)/=ikad(ikey+1))THEN
497 irunn=0
498 READ(iusc1,rec=ikad(ikey),fmt='(7X,A4,2X,I5)',err=9990)ch4,irunn
499
500 IF (got_input == 0)THEN
501C RUNN is -input run number,
502C if RUNN = 0 (common starter / engine input file) RUNN is set to 1 in Engine.
503 IF (runn==0 ) runn=1
504C IRUNN is the run number read from input.
505C If IRUNN was set in input and is different from -input run number,
506C than we print out a message.
507 IF (irunn /= 0)THEN
508 IF (irunn /= runn)THEN
509 WRITE(istdo,'(A,A)') ' ** WARNING ** : RUN NUMBER FOUND IN ','/RUN CARD FROM INPUT FILE'
510 WRITE(istdo,'(A)') ' RUN NUMBER IGNORED '
511 ENDIF
512 ENDIF
513 irunn = runn
514 ENDIF
515C
516 IF(rootlen==0) THEN
517 CALL ancmsg(msgid=194,anmode=aninfo)
518 ierr=ierr+1
519 ENDIF
520 IF(irunn<=0) THEN
521 CALL ancmsg(msgid=195,anmode=aninfo)
522 ierr=ierr+1
523 irunn=1
524 ENDIF
525 mcheck = 1
526 ENDIF
527c
528 IF (mcheck == 0) THEN
529 sensors%NSTOP = 0
530 sensors%NOUTP = 0
531 sensors%NSTAT = 0
532 sensors%NANIM = 0
533 ALLOCATE (sensors%STOP_TMP(mx_sens))
534 ALLOCATE (sensors%OUTP_TMP(mx_sens))
535 ALLOCATE (sensors%STAT_TMP(mx_sens))
536 ALLOCATE (sensors%ANIM_TMP(mx_sens))
537 sensors%STOP_TMP(:) = 0
538 sensors%OUTP_TMP(:) = 0
539 sensors%STAT_TMP(:) = 0
540 sensors%ANIM_TMP(:) = 0
541 END IF
542C--------------------
543C INPUT VERSION
544C--------------------
545 invers=0
546 ikey=kvers
547 IF (got_input/=0) THEN
548 invers=codvers
549 END IF
550 IF(ikad(ikey)/=ikad(ikey+1))THEN
551 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)invers
552 ENDIF
553 IF (got_input==0) THEN
554 IF(invers<18.AND.mcheck==0) THEN
555 CALL ancmsg(msgid=196,anmode=aninfo)
556 ierr=ierr+1
557 ENDIF
558 END IF
559C--------------------
560C /PARIT
561C--------------------
562 iparit = -1
563 ikey=kparit
564 IF(ikad(ikey)/=ikad(ikey+1))THEN
565 READ(iusc1,rec=ikad(ikey),fmt='(7X,A,1X,I5)',err=9990)key2,k4
566 IF(key2=='OFF')THEN
567 iparit = 0
568 ELSEIF(key2=='ON')THEN
569 iparit = k4 + 1
570 ENDIF
571 ENDIF
572C--------------------
573C /DTIX
574C--------------------
575 nodadt=0
576 ikey=kdtix
577 IF(ikad(ikey)/=ikad(ikey+1))THEN
578 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
579 READ(iusc2,*,err=9990,END=9990)DTIN,dtmx
580 IF(dtmx < zero)THEN
581 CALL ancmsg(msgid=316,anmode=aninfo,c1='/DTIX : PARAMETER DT_MAX MUST BE STRICTLY POSITIVE')
582 ierr=ierr+1
583 ENDIF
584 IF(dtmx == zero)dtmx=ep20
585 IF(dtmx /= ep20 )THEN
586 IF(dtin > dtmx)THEN
587 CALL ancmsg(msgid=316,anmode=aninfo,c1='/DTIX : PARAMETER DT_INI MUST BE LOWER THAN DT_MAX')
588 ierr=ierr+1
589 ENDIF
590 ENDIF
591 ELSE
592 dtin=zero
593 dtmx=ep20
594 ENDIF
595C--------------------
596C /FLSEC
597C--------------------
598 nsflsw=0
599 ikey=kflsec
600 IF(ikad(ikey)/=ikad(ikey+1))THEN
601 k=0
602 110 READ(iusc1,rec=ikad(ikey)+k,fmt='(49X,I10)',err=9990)nbc
603 k=k+nbc+1
604 nsflsw=nsflsw+1
605 IF(ikad(ikey)+k/=ikad(ikey+1))GO TO 110
606 ENDIF
607C--------------------
608C /FUNCT
609C--------------------
610 nfct=0
611 ikey=kfunc
612 IF(ikad(ikey)/=ikad(ikey+1))THEN
613 k=0
614 140 READ(iusc1,rec=ikad(ikey)+k,fmt='(49X,I10)',
615 . err=9990)nbc
616 k=k+nbc+1
617 nfct=nfct+1
618 IF(ikad(ikey)+k/=ikad(ikey+1))GO TO 140
619 ENDIF
620C-----------------------
621C //
622C-----------------------
623 ikey=kproc
624 IF(ikad(ikey)/=ikad(ikey+1))THEN
625 ENDIF
626C-----------------------
627C /KEREL (KINETIC ENERGY RELAXATION)
628C-----------------------
629 istat = 0
630 istatg = 0
631 ikey=kkerel
632c------- add T_START,T_STOP
633 tst_start = zero
634 tst_stop = zero
635 IF(ikad(ikey)/=ikad(ikey+1))THEN
636 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)k4
637 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
638 IF(k4==1)THEN
639 READ(iusc2,*)istatg
640 CALL wriusc2(ikad(ikey)+2,1,key0(ikey))
641 ENDIF
642 READ(iusc2,*,err=310,END=320)TST_START ,tst_stop
643 GOTO 320
644 310 READ(iusc2,*,err=320,END=320)tst_start
645 320 CONTINUE
646 beta = zero
647 period = zero
648 istat=2
649 ENDIF
650C-----------------------
651C /DYREL (DYNAMIC RELAXATION)
652C-----------------------
653 ikey=kdyrel
654 IF(ikad(ikey)/=ikad(ikey+1))THEN
655 IF(istat==0)istat=1
656 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
657 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)k4
658 IF(k4==1)THEN
659 READ(iusc2,*)istatg
660 CALL wriusc2(ikad(ikey)+2,1,key0(ikey))
661 ENDIF
662 READ(iusc2,*)beta,period
663 ENDIF
664 istatg = -iabs(istatg)
665 IF (beta==zero) beta=one
666 IF(period/=zero)THEN
667 betate = beta / period
668 ELSE
669 betate = zero
670 ENDIF
671C-----------------------
672C /ADYREL (ADAPTATIVE DYNAMIC RELAXATION)
673C-----------------------
674 ikey=kadyrel
675 IF(ikad(ikey)/=ikad(ikey+1))THEN
676 istatg = 0
677 freq_c =zero
678 tst_start = zero
679 tst_stop = zero
680 READ(iusc1,rec=ikad(ikey),fmt='(7X,A)',err=9990)key2
681 READ(iusc1,rec=ikad(ikey),fmt='(49X,I10)',err=9990) nbc
682 IF (nbc > 0) THEN
683 READ(iusc1,rec=ikad(ikey)+1,fmt='(A)',err=520)key3
684 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
685 IF (key2=='FREQ_') THEN
686 READ(iusc2,*)freq_c
687 READ(iusc1,rec=ikad(ikey)+2,fmt='(A)',err=520)key2
688 CALL wriusc2(ikad(ikey)+2,1,key0(ikey))
689 ELSE
690 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)k4
691 IF(k4==1)THEN
692 READ(iusc2,*)istatg
693 READ(iusc1,rec=ikad(ikey)+2,fmt='(A)',err=520)key2
694 CALL wriusc2(ikad(ikey)+2,1,key0(ikey))
695 ENDIF
696 END IF
697 READ(iusc2,*,err=510,END=520)TST_START ,tst_stop
698 GOTO 520
699 510 READ(iusc2,*,err=520,END=520)tst_start
700 520 CONTINUE
701 ENDIF ! NBC
702 beta=one
703 period = zero
704 betate = zero
705 istat=3
706 istatg = -iabs(istatg)
707 ENDIF
708C-----------------------
709C /ALESUB (ALE SUB-CYCLING, OBSOLETE)
710C-----------------------
711 ale%SUB%IALESUB = 0
712 ikey=kalesub
713 IF(ikad(ikey)/=ikad(ikey+1))THEN
714 ale%SUB%IALESUB=2
715 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
716 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)k4
717 IF(k4==1)ale%SUB%IALESUB=1
718 READ(iusc2,*)ale%SUB%DTFSUB,ale%SUB%DTMSUB
719 ENDIF
720 IF(ale%SUB%DTFSUB==zero)ale%SUB%DTFSUB=zep9
721 IF (ale%SUB%IALESUB==1) THEN
722 CALL ancmsg(msgid=197,anmode=aninfo)
723 ierr=ierr+1
724 ENDIF
725
726C-----------------------
727C /STOP
728C-----------------------
729 ! Initialize SENSORS Write variables
730 sensors%STOP_NSANIM = 0
731 sensors%STOP_NSTH= 0
732 sensors%STOP_NSSTAT = 0
733 sensors%STOP_NSOUTP = 0
734 sensors%STOP_NSABF = 0
735 sensors%STOP_NSH3D = 0
736
737 ikey=kstop
738c
739 IF (ikad(ikey)/=ikad(ikey+1))THEN
740 k=0
741 1150 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,37X,I10)',err=9990)key2,nbc
742 k=k+1
743 IF (key2=='LSENS')THEN ! IF STOP BASED ON SENSOR ACTIVATION
744c First line
745 DO i=1,nbc-1
746 READ(iusc1,rec=ikad(ikey)+k,fmt='(A)',err=9990)carte
747 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
748 k = k + 1
749 READ(iusc2,*,err=9990,END=9990) (SENSORS%STOP_TMP(N),N=1,NVAR(CARTE))
750 sensors%NSTOP = sensors%NSTOP + nvar(carte)
751 ENDDO
752c Second line
753 iok_read = 0
754 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
755 READ(iusc2,*,err=148,END=148)SENSORS%STOP_NSANIM,SENSORS%STOP_NSTH,SENSORS%STOP_NSSTAT,
756 . sensors%STOP_NSOUTP,sensors%STOP_NSABF,sensors%STOP_NSH3D,nsdynanin
757 iok_read = 1
758c Ensure Backward compatibility : without NSH3D
759148 IF (iok_read == 0) THEN
760 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
761 READ(iusc2,*,err=9990,END=9990)SENSORS%STOP_NSANIM,SENSORS%STOP_NSTH,SENSORS%STOP_NSSTAT,
762 . sensors%STOP_NSOUTP,sensors%STOP_NSABF
763 ENDIF
764 k=k+1
765 ELSE
766 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
767 READ(iusc2,*,err=150,END=149)DEMXS,DMTMXS,DMNMXS,NTH,NANIM,nerr_posit
768 GOTO 151
769 149 CONTINUE
770 READ(iusc2,*,err=150,END=150)DEMXS,DMTMXS,DMNMXS,NTH,nanim
771 GOTO 151
772 150 CONTINUE
773 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
774 READ(iusc2,*)demxs,dmtmxs,dmnmxs
775 151 CONTINUE
776 k=k+nbc
777 ENDIF
778 IF(ikad(ikey)+k/=ikad(ikey+1))GO TO 1150
779 ENDIF
780 IF(dmtmxs==zero)dmtmxs=ep30
781 IF(dmnmxs==zero)dmnmxs=ep30
782 IF(demxs==zero) demxs =ep30
783
784C-----------------------
785C /KILL
786C-----------------------
787 ikey=kkill
788 IF(ikad(ikey)/=ikad(ikey+1))THEN
789 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
790 READ(iusc2,*,err=155,END=154)
791 . demxk,dmtmxk,dmnmxk,nth,nanim,nerr_posit
792 GOTO 156
793 154 CONTINUE
794 READ(iusc2,*,err=155,END=155)DEMXK,DMTMXK,DMNMXK,NTH,nanim
795 GOTO 156
796 155 CONTINUE
797 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
798 READ(iusc2,*)demxk,dmtmxk,dmnmxk
799 156 CONTINUE
800 ENDIF
801 IF(dmtmxk==zero)dmtmxk=ep20
802 IF(dmnmxk==zero)dmnmxk=ep20
803 IF(demxk==zero) demxk =ep20
804
805C--------------------------
806C /RUN
807C--------------------------
808 IF (mcheck == 0) THEN
809 ikey=krun
810 irunn=1
811 chrun0=' '
812 IF(ikad(ikey)/=ikad(ikey+1))THEN
813 irunn=0
814 READ(iusc1,rec=ikad(ikey),fmt='(7X,A4,2X,I5,1X,A1)',err=9990)ch4,irunn,chrun0(2:2)
815 IF(chrun0(2:2)/=' ')chrun0(1:1)='_'
816 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
817 READ(iusc2,*)tstop0
818 ENDIF
819 IF (got_input == 1) THEN
820 !RUNN is -input run number,
821 !if RUNN = 0 (common starter / engine input file) RUNN is set to 1 in Engine.
822 IF (runn==0 ) runn=1
823 !IRUNN is the run number read from input.
824 !If IRUNN was set in input and is different from -input run number,than we print out a message.
825 IF (irunn /= 0)THEN
826 IF (irunn /= runn)THEN
827 WRITE(istdo,'(A,A)') ' ** WARNING ** : RUN NUMBER FOUND IN ', '/RUN CARD FROM INPUT FILE'
828 WRITE(istdo,'(A)') ' RUN NUMBER IGNORED '
829 ENDIF
830 ENDIF
831 irunn = runn
832 IF (irunn == 0) irunn = 1
833 ENDIF
834 IF(rootlen==0) THEN
835 CALL ancmsg(msgid=194,anmode=aninfo)
836 ierr=ierr+1
837 ENDIF
838 IF(irunn<=0) THEN
839 CALL ancmsg(msgid=195,anmode=aninfo)
840 ierr=ierr+1
841 irunn=1
842 ENDIF
843 ENDIF ! MCHECK == 0
844
845C--------------------------
846C /TITLE
847C--------------------------
848 ikey=ktitle
849 IF(ikad(ikey)/=ikad(ikey+1))THEN
850 READ(iusc1,rec=ikad(ikey)+1,fmt='(A)',err=9990)title
851 IF(title(1:1)=='/')title=' '
852 ELSE
853 title=' '
854 ENDIF
855 WRITE(iin,'(2A,I2.2,A)')rootnam(1:rootlen),'D',irunn,title
856 WRITE(chrun,'(I4.4)')irunn
857
858C-----------------------
859C /NEGVOL (SMSTR: INEG_V=1;STOP: INEG_V=0)
860C--------------------------------------------------------
861 ikey = knegvol
862 ineg_v = 1
863 IF(ikad(ikey)/=ikad(ikey+1))THEN
864 READ(iusc1,rec=ikad(ikey),fmt='(7X,A)',err=9990)key2
865 IF(key2(1:4)=='STOP') ineg_v = 0
866 END IF
867
868C-----------------------
869C /DTSDE
870C time step for degenerated solid element
871C----change to default; to return back use /DTSDE/OFF
872C----reput /DTSDE/OFF as default after instability issue; re-use /DTSDE if needed
873C--------------------------------------------------------
874 ikey = kdtsde
875 idts6 = 0
876 IF(ikad(ikey)/=ikad(ikey+1))THEN
877 idts6=1
878 READ(iusc1,rec=ikad(ikey),fmt='(7X,A)',err=9990)key2
879 IF(key2(1:3)=='OFF') idts6 = 0
880 END IF
881
882C--------------------
883C /DT
884C--------------------
885 ikey=kdt
886 dtfac0=zero
887 dtmin0=zero
888 intdt=0
889 idtgr(11)=0
890 kdtint=0
891 kdtsmstr=1
892C
893 tol_sms=zero
894 ncprisms=0
895 m_vs_sms=0
896C
897 idtmins_int=0
898 dtfacs_int=zero
899 dtmins_int=zero
900 glob_therm%IDT_THERM = 0
901 glob_therm%DTFACTHERM = zero
902 dt%BRICK_CST_DEFV_MIN = zero
903 dt%BRICK_CST_COL_MIN = zero
904 dt%BRICK_DEL_DEFV_MIN = zero
905 dt%BRICK_DEL_DEFV_MAX = zero
906 dt%BRICK_DEL_ASP_MAX = zero
907 dt%BRICK_DEL_COL_MIN = zero
908C
909 IF(ikad(ikey)/=ikad(ikey+1))THEN
910 k=0
911 160 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A)',err=9990)key2
912 IF(key2(1:4)=='NODA')THEN
913 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,A)', err=9990)key2,key3
914 IF(key3(1:4)/='STOP' .AND. key3(1:3)/='DEL' .AND.
915 . key3(1:3)/='CST' .AND. key3(1:3)/='SET' .AND.
916 . key3(1:4)/='KILL' .AND. key3(1:3)/='LAG' .AND.
917 . key3(1:3)/='AMS' .AND. key3(1:3)/='ALE' )THEN !ALEON hidden option to keep compatibility of DT NODA * with ALE
918 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,I5)',err=9990)key2,k4
919 ELSEIF(key3(1:3)=='DEL')THEN
920 CALL ancmsg(msgid=246,anmode=aninfo,c1='/DT/NODA/DEL')
921 ierr=ierr+1
922 ELSE
923 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,A,1X,I5)',err=9990)key2,key3,k4
924 ENDIF
925 ELSEIF(key2=='AMS')THEN
926 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,I5)',err=9990)key2,k4
927 ELSEIF(key2=='CST_A')THEN
928 ! /DT/CST_AMS -> hybride /DT/NODA/CST + /DT/AMS
929 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,I5)',err=9990)key2,k4
930 ELSEIF(key2=='GLOB')THEN
931 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,I5,1X,A)',err=9990)key2,k4,key5
932 ELSEIF(key2(1:4)=='NODE')THEN
933 CALL ancmsg(msgid=246,anmode=aninfo,c1='/DT/NODE')
934 ierr=ierr+1
935 ELSE
936 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,A,1X,I5)',err=9990)key2,key3,k4
937 END IF
938
939 k=k+1
940 IF(key2=='INTER'.AND.key3(1:2)=='V5')THEN
941 kdtint=1
942 ELSEIF(key2=='INTER'.AND.key3(1:2)=='V4')THEN
943 kdtint=0
944 ELSEIF(key2=='SMSTR'.AND.key3(1:2)=='V4') THEN
945 kdtsmstr=0
946 ELSE IF(key2=='THERM')THEN
947 glob_therm%IDT_THERM = 1
948 glob_therm%DTFACTHERM = zep9
949 IF(ikad(ikey)+k/=ikad(ikey+1))THEN
950 READ(iusc1,rec=ikad(ikey)+k,fmt='(1X,A)',err=9990)key4
951 IF(key4(1:2)/='DT') THEN
952 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
953 READ(iusc2,*,err=9990,END=9990) GLOB_THERM%dtfactherm
954 IF (glob_therm%DTFACTHERM == zero) dtfaca = zep9
955 k=k+1
956 ENDIF
957 ENDIF
958 ELSE IF(key2(1:4)=='IGEO')THEN
959 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
960 READ(iusc2,*,err=9990,END=9990)DTFACA,dtmina
961 k=k+1
962 IF(key3(1:4)=='ELEM')THEN
963 idt = 1
964 ELSEIF(key3(1:4)=='LCAR')THEN
965 idt = 2
966 ELSE
967 idt = 0
968 ENDIF
969 dtfac1(101) = dtfaca
970 dtmin1(101) = dtmina
971 idtmin(101) = idt
972
973 ELSEIF(key2(1:4)=='GLOB')THEN
974 WRITE(6,*) "/DT/GLOB is a deprecated feature"
975 CALL arret(5)
976 ELSE
977 IF(key3(1:3)=='ALE')THEN
978 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
979 iflag = 0
980 ale%GLOBAL%I_DT_NODA_ALE_ON_KEY = 0
981 READ(iusc2,*,err=9990,END=9990)iflag
982 IF(iflag==1)ale%GLOBAL%I_DT_NODA_ALE_ON_KEY = 1
983 k = k + 1
984 GOTO 2003
985 ELSEIF (key2(1:5)=='CST_A') THEN
986 dtfac_ams = zero
987 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
988 READ(iusc2,*,err=9001,END=9001) DTFACA,DTMINA,dtfac_ams
989 GOTO 9002
990 9001 CONTINUE
991 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
992 READ(iusc2,*,err=9990,END=9990) DTFACA,dtmina
993 9002 CONTINUE
994 IF (dtfaca == zero) dtfaca = zep9
995 IF (dtfac_ams == zero) dtfac_ams = zep67
996 ELSEIF(key2(1:5) == 'FVMBA')THEN
997 ! ---/DT/FVMBAG/. ---
998 ! dtfaca dtmina lambda l_type
999 ! fvbag_id
1000 ierr1=0
1001 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1002 READ(iusc2,'(A)',err=9990,END=9990)line
1003 READ(line,*,iostat=ierr1)dtfaca,dtmina,lambda,l_type
1004 IF(ierr1 /= 0)THEN
1005 !l_type left blank (default 0)
1006 l_type=zero
1007 ierr1=0
1008 READ(line,*,iostat=ierr1)dtfaca,dtmina,lambda
1009 IF(ierr1 /= 0)THEN
1010 !param 3 also left blank (default 0.0)
1011 lambda=zero
1012 ierr1=0
1013 ! this is minimanl input, goto to error message if reading fails
1014 READ(line,*,err=9990,END=9990)DTFACA,dtmina
1015 ENDIF
1016 ENDIF
1017 id_bag = 0
1018 IF(key3(1:1)=='2')THEN
1019 k=k+1
1020 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1021 READ(iusc2,'(A)',err=9990,END=9990)line
1022 READ(line,*,err=9990,END=9990)id_bag
1023 IF(id_bag <= 0)THEN
1024 CALL ancmsg(msgid=299,anmode=aninfo,i1=id_bag)
1025 CALL arret(0)
1026 ENDIF
1027 ENDIF
1028 ELSE
1029 ! --- /DT/NODA/CST, and others ... ---
1030 ! dtfaca dtmina percent_addmass
1031 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1032 READ(iusc2,*,err=9003,END=9003)DTFACA,DTMINA,percent_addmass
1033 ! Read of target % of added mass
1034 IF (percent_addmass > zero) idt_percent_addmass = 1
1035 GOTO 9004
1036 9003 CONTINUE
1037 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1038 READ(iusc2,*,err=9990,END=9990) DTFACA,dtmina
1039 9004 CONTINUE
1040 ENDIF
1041 k=k+1
1042C
1043 IF(key3(1:4)=='STOP')THEN
1044 idt = 1
1045 IF((key2(1:4)=='NODA').AND.(idt_percent_addmass == 1)) THEN
1046C-- case DT/NODA/STOP + % of added mass - IDTMIN set to 8
1047 idt = 8
1048 idt_percent_addmass = 2
1049 dt_stop_percent_addmass = dtmina
1050 ENDIF
1051 ELSEIF(key3(1:3)=='DEL')THEN
1052 idt = 2
1053 ELSEIF(key3(1:3)=='CST')THEN
1054 idt = 3
1055 IF((key2(1:4)=='NODA'.OR.key2(1:5)=='INTER').AND.key3(1:4)/='CST1')idt=8
1056 ELSEIF(key3(1:3)=='SET')THEN
1057 idt = 4
1058 ELSEIF(key3(1:4)=='KILL')THEN
1059 idt = 5
1060 ELSEIF(key3(1:3)=='LAG')THEN
1061 idt = 6
1062 ELSEIF(key3(1:3)=='AMS')THEN
1063 idt = 7
1064 ELSEIF(key3(1:3)=='COD')THEN
1065 idt = 3
1066 ELSE
1067 idt = 0
1068 ENDIF
1069C
1070 IF(key2=='BRICK')THEN
1071 dtfac1(1) = dtfaca
1072 dtmin1(1) = dtmina
1073 idtmin(1) = idt
1074 IF(key3(1:3)=='CST'.AND.k4==1)THEN
1075 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1076 READ(iusc2,*,err=1001,END=1001)DT%BRICK_CST_COL_MIN,
1077 . dt%BRICK_CST_DEFV_MIN
1078 GO TO 1002
1079 1001 CONTINUE
1080 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1081 READ(iusc2,*,err=9990,END=9990)DT%brick_cst_col_min
1082 1002 CONTINUE
1083 k=k+1
1084 ENDIF
1085 IF(key3(1:3)=='DEL'.AND.k4==1)THEN
1086 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1087 READ(iusc2,*,err=1003,END=1003)DT%BRICK_DEL_COL_MIN,
1088 . dt%BRICK_DEL_DEFV_MIN,
1089 . dt%BRICK_DEL_ASP_MAX,
1090 . dt%BRICK_DEL_DEFV_MAX
1091 GO TO 1004
1092 1003 CONTINUE
1093 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1094 READ(iusc2,*,err=9990,END=9990)DT%BRICK_DEL_COL_MIN,
1095 . dt%BRICK_DEL_DEFV_MIN
1096 1004 CONTINUE
1097 k=k+1
1098 ENDIF
1099 ELSEIF(key2(1:4)=='QUAD')THEN
1100 dtfac1(2) = dtfaca
1101 dtmin1(2) = dtmina
1102 idtmin(2) = idt
1103 ELSEIF(key2=='SHELL')THEN
1104 dtfac1(3) = dtfaca
1105 dtmin1(3) = dtmina
1106 idtmin(3) = idt
1107 ELSEIF(key2=='SH_3N'.OR.key2(1:4)=='SH3N')THEN
1108 dtfac1(7) = dtfaca
1109 dtmin1(7) = dtmina
1110 idtmin(7) = idt
1111 ELSEIF(key2=='TRUSS')THEN
1112 dtfac1(4) = dtfaca
1113 dtmin1(4) = dtmina
1114 idtmin(4) = idt
1115 ELSEIF(key2(1:4)=='BEAM')THEN
1116 dtfac1(5) = dtfaca
1117 dtmin1(5) = dtmina
1118 idtmin(5) = idt
1119 ELSEIF(key2=='SPRIN')THEN
1120 dtfac1(6) = dtfaca
1121 dtmin1(6) = dtmina
1122 idtmin(6) = idt
1123 ELSEIF(key2=='AIRBA')THEN
1124 dtfac1(9) = dtfaca
1125 dtmin1(9) = dtmina
1126 idtmin(9) = idt
1127 ELSEIF(key2=='INTER')THEN
1128 IF(intdt==0.and.(idt/=3.and.idt/=8.and.idt/=7))THEN
1129C if /DT/INTER/DEL is read later, then following definition can be erased
1130 dtfac1(10) = dtfaca
1131 dtmin1(10) = dtmina
1132 idtmin(10) = idt
1133 ENDIF
1134 IF(idt==2)intdt=1
1135 IF(nodadt==0.AND.(idt==3.OR.idt==8))THEN
1136C if /DT/NODA is read later, then following definition can be erased
1137 dtfac1(11) = dtfaca
1138 dtmin1(11) = dtmina
1139 idtmin(11) = idt
1140 ELSEIF(idt==7)THEN
1141 dtfacs_int = dtfaca
1142 dtmins_int = dtmina
1143 idtmins_int= 1
1144C if /DT/AMS is read later, then following definition can be erased
1145 IF(k4>=1)THEN
1146 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1147 READ(iusc2,*,err=3001,END=3001)TOL_SMS,m_vs_sms
1148 GO TO 3002
1149 3001 CONTINUE
1150 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1151 READ(iusc2,*,err=9990,END=9990)tol_sms
1152 3002 CONTINUE
1153 k=k+1
1154 ENDIF
1155 IF(k4>=2)THEN
1156 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1157 READ(iusc2,*,err=9990,END=9990)NSMSPCG,ncprisms
1158 k=k+1
1159 ENDIF
1160 ENDIF
1161 ELSEIF(key2(1:4)=='NODA' .AND. key3(1:3)/='ALE')THEN
1162 IF(idt/=7)THEN
1163 dtfac1(11) = dtfaca
1164 dtmin1(11) = dtmina
1165 idtmin(11) = idt
1166 idtgr(11) = 0
1167 IF ((idt == 8).OR.(idt == 3)) dt_ctrl_compatibility(1) = 1
1168 IF(k4==1)THEN
1169 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1170 READ(iusc2,*,err=9990,END=9990)IDTGR(11)
1171 idtgr(11) = -idtgr(11)
1172 k=k+1
1173 ENDIF
1174 ELSE
1175 dtfacs = dtfaca
1176 dtmins = dtmina
1177 idtmins= 1
1178 tol_sms = zero
1179 nsmspcg = 0
1180 ncprisms= 0
1181 IF(k4>=1)THEN
1182 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1183 READ(iusc2,*,err=100,END=100)IDTGRX,tol_sms
1184 idtgrs = -idtgrx
1185 GO TO 101
1186 100 CONTINUE
1187 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1188 READ(iusc2,*,err=9990,END=9990)tol_sms
1189 101 CONTINUE
1190 k=k+1
1191 ENDIF
1192 IF(k4>=2)THEN
1193 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1194 READ(iusc2,*,err=9990,END=9990)NSMSPCG,ncprisms
1195 k=k+1
1196 ENDIF
1197 END IF
1198 nodadt = 1
1199 ELSEIF(key2(1:5)=='SPCEL'.OR.key2(1:5)=='SPHCE')THEN
1200 dtfac1(51) = dtfaca
1201 dtmin1(51) = dtmina
1202 idtmin(51) = idt
1203 ELSEIF(key2(1:5)=='FVMBA') THEN
1204 IF(key3(1:1)=='0')THEN
1205 id_dt_option = 0
1206 dtfac1(52) = dtfaca
1207 dtmin1(52) = dtmina
1208 idtmin(52) = id_dt_option
1209 ELSEIF(key3(1:1)=='1')THEN
1210 id_dt_option = 1
1211 dtfac1(52) = dtfaca
1212 dtmin1(52) = dtmina
1213 idtmin(52) = id_dt_option
1214 ELSEIF(key3(1:1)=='2')THEN
1215 id_dt_option = 2
1216 !Option REQUIRS AIRBAG_ID.
1217 ELSE
1218 id_dt_option = 1
1219 dtfac1(52) = dtfaca
1220 dtmin1(52) = dtmina
1221 idtmin(52) = id_dt_option
1222 ENDIF
1223
1224 lambda = max(zero, lambda)
1225 fvmbag_l_type = int(l_type)
1226 fvmbag_l_type = min(fvmbag_l_type,2) !input check:upper bound
1227 fvmbag_l_type = max(0,fvmbag_l_type) !input check:lower bound
1228 !storing in temporary data structure. It will be used to fill the final data structure when restart file is read (not yet allocated)
1229 IF(id_dt_option == 0)num_opt_dt_fvmbag_0 = num_opt_dt_fvmbag_0 + 1
1230 IF(id_dt_option == 1)num_opt_dt_fvmbag_1 = num_opt_dt_fvmbag_1 + 1
1231 IF(id_dt_option == 2)num_opt_dt_fvmbag_2 = num_opt_dt_fvmbag_2 + 1
1232 IF(id_dt_option == 3)num_opt_dt_fvmbag_3 = num_opt_dt_fvmbag_3 + 1
1233 num_opt_dt_fvmbag = num_opt_dt_fvmbag + 1
1234 fvmbag_input_options(num_opt_dt_fvmbag)%CFL_COEF = dtfaca
1235 fvmbag_input_options(num_opt_dt_fvmbag)%DTMIN = dtmina
1236 fvmbag_input_options(num_opt_dt_fvmbag)%LAMBDA = lambda
1237 fvmbag_input_options(num_opt_dt_fvmbag)%ID_BAG = id_bag
1238 fvmbag_input_options(num_opt_dt_fvmbag)%L_type = fvmbag_l_type
1239 fvmbag_input_options(num_opt_dt_fvmbag)%ID_DT_OPTION = id_dt_option
1240 !Input check is done later in rdresb.F>FVRREST once all keywords are finished to be read & before deallocating (FVMBAG_INPUT_OPTIONS)
1241
1242 ELSEIF(key2(1:3)=='AMS')THEN
1243 dt_ctrl_compatibility(2) = 1
1244 dtfacs = dtfaca
1245 dtmins = dtmina
1246 idtmins = 2
1247 tol_sms = zero
1248 nsmspcg = 0
1249 ncprisms= 0
1250C
1251 IF(k4>=1)THEN
1252 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1253 READ(iusc2,*,err=2001,END=2001)TOL_SMS,m_vs_sms
1254 GO TO 2002
1255 2001 CONTINUE
1256 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1257 READ(iusc2,*,err=9990,END=9990)tol_sms
1258 2002 CONTINUE
1259 k=k+1
1260 ENDIF
1261 IF(k4>=2)THEN
1262 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1263 READ(iusc2,*,err=9990,END=9990)NSMSPCG,ncprisms
1264 k=k+1
1265 ENDIF
1266 ELSEIF(key2(1:5)=='CST_A')THEN
1267C-- hybrid case CST_AMS : /DT/NODA/CST + /DT/AMS
1268 dt_ctrl_compatibility(3) = 1
1269C Set of /DT/NODA/CST
1270 dtfac1(11) = dtfaca
1271 dtmin1(11) = dtmina
1272 idtmin(11) = 8
1273 idtgr(11) = 0
1274 nodadt = 1
1275C Set of /DT/AMS
1276 dtfacs = dtfac_ams
1277 dtmins = dtmina
1278 idtmins = 2
1279 tol_sms = zero
1280 nsmspcg = 0
1281 ncprisms= 0
1282C
1283 flag_cst_ams = 1
1284C
1285 IF(k4>=1)THEN
1286 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1287 READ(iusc2,*,err=2011,END=2011)TOL_SMS,m_vs_sms
1288 GO TO 2012
1289 2011 CONTINUE
1290 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1291 READ(iusc2,*,err=9990,END=9990)tol_sms
1292 2012 CONTINUE
1293 k=k+1
1294 ENDIF
1295 IF(k4>=2)THEN
1296 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1297 READ(iusc2,*,err=9990,END=9990)NSMSPCG,ncprisms
1298 k=k+1
1299 ENDIF
1300 ELSEIF(key2(1:3)=='ALE'.OR. key2(1:4)=='EULER')THEN
1301 dtfac1(102) = dtfaca
1302 dtmin1(102) = dtmina
1303 idtmin(102) = idt
1304 If(ale%GLOBAL%IDT_ALE==0)ale%GLOBAL%IDT_ALE = 1
1305 ELSE
1306 dtfac0=dtfaca
1307 dtmin0=dtmina
1308 ale%GLOBAL%IDT_ALE = -1
1309 ENDIF
1310 ENDIF
1311 2003 CONTINUE
1312 IF(ikad(ikey)+k/=ikad(ikey+1))GO TO 160
1313 ENDIF
1314C
1315C Check of compatibility of time step control options - /DT/CST_AMS can not be used with /DT/AMS or /DT/NODA/CST
1316 IF (dt_ctrl_compatibility(3) == 1) THEN
1317 IF ((dt_ctrl_compatibility(1)+dt_ctrl_compatibility(2)) > 0) THEN
1318 CALL ancmsg(msgid=279,anmode=aninfo,c1=key0(ikey))
1319 CALL arret(0)
1320 ENDIF
1321 ENDIF
1322C AMS is not compatible with thermal time step
1323 IF (glob_therm%IDT_THERM == 1.AND.idtmins/=0) THEN
1324 CALL ancmsg(msgid=301,anmode=aninfo,c1=key0(ikey))
1325 CALL arret(0)
1326 ENDIF
1327C
1328 ! Copy nodal timestep flag into DT data structure
1329 dt%NODADT = nodadt
1330C
1331C--------------------------
1332C /DT1
1333C--------------------------
1334 ikey=kdt1
1335 idt1sh = 0
1336 idt1sol= 0
1337 IF(ikad(ikey)/=ikad(ikey+1))THEN
1338 k=0
1339 161 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,A,1X,I5)', err=9990)key2,key3,k4
1340 k=k+1
1341 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1342 READ(iusc2,*,err=9990,END=9990)DTFACA,dtmina
1343 k=k+1
1344 IF(key3(1:4)=='STOP')THEN
1345 idt = 1
1346 ELSEIF(key3(1:3)=='DEL')THEN
1347 idt = 2
1348 ELSEIF(key3(1:3)=='CST')THEN
1349 idt = 3
1350 ELSEIF(key3(1:4)=='KILL')THEN
1351 idt = 5
1352 ELSE
1353 idt = 0
1354 ENDIF
1355 IF(key2=='SHELL')THEN
1356 idt1sh = 1
1357 dtfac1(3) = dtfaca
1358 dtmin1(3) = dtmina
1359 idtmin(3) = idt
1360 ELSEIF(key2=='BRICK')THEN
1361 idt1sol= 1
1362 dtfac1(1) = dtfaca
1363 dtmin1(1) = dtmina
1364 idtmin(1) = idt
1365 IF(key3(1:3)=='CST'.AND.k4==1)THEN
1366 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1367 READ(iusc2,*,err=1101,END=1101)DT%BRICK_CST_COL_MIN,
1368 . dt%BRICK_CST_DEFV_MIN
1369 GO TO 1102
1370 1101 CONTINUE
1371 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1372 READ(iusc2,*,err=9990,END=9990)DT%brick_cst_col_min
1373 1102 CONTINUE
1374 k=k+1
1375 ENDIF
1376 IF(key3(1:3)=='DEL'.AND.k4==1)THEN
1377 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1378 READ(iusc2,*,err=1103,END=1103)DT%BRICK_DEL_COL_MIN,
1379 . dt%BRICK_DEL_DEFV_MIN,
1380 . dt%BRICK_DEL_ASP_MAX,
1381 . dt%BRICK_DEL_DEFV_MAX
1382 GO TO 1104
1383 1103 CONTINUE
1384 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1385 READ(iusc2,*,err=9990,END=9990)DT%BRICK_DEL_COL_MIN,
1386 . dt%BRICK_DEL_DEFV_MIN
1387 1104 CONTINUE
1388 k=k+1
1389 ENDIF
1390 ELSE
1391 idt1sh = 1
1392 idt1sol= 1
1393 dtfac0=dtfaca
1394 dtmin0=dtmina
1395 ENDIF
1396 IF(ikad(ikey)+k/=ikad(ikey+1))GO TO 161
1397 ENDIF
1398 CALL init_idel_brick(dt)
1399C--------------------------
1400C /TFILE
1401C--------------------------
1402 ittyp = 0
1403 ikey=ktfile
1404 IF(ikad(ikey)/=ikad(ikey+1))THEN
1405 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)ittyp
1406 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
1407 READ(iusc2,*,err=9990,END=9990)dthis0
1408 ELSE
1409 ittyp=0
1410 dthis0=ep30
1411 ENDIF
1412
1413C--------------------------
1414C /ATFIL
1415C--------------------------
1416 ikey=katfil
1417 IF(ikad(ikey)/=ikad(ikey+1))THEN
1418 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)aform(1)
1419 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
1420 READ(iusc2,*,err=9990,END=9990)DTHIS01(1)
1421 ELSE
1422 dthis01(1)=ep30
1423 output%TH%THIS1(1)= ep30
1424 ENDIF
1425
1426C--------------------------
1427C /BTFIL
1428C--------------------------
1429 ikey=kbtfil
1430 IF(ikad(ikey)/=ikad(ikey+1))THEN
1431 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)aform(2)
1432 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
1433 READ(iusc2,*,err=9990,END=9990)DTHIS01(2)
1434 ELSE
1435 dthis01(2)=ep30
1436 output%TH%THIS1(2)=ep30
1437 ENDIF
1438
1439C--------------------------
1440C /CTFIL
1441C--------------------------
1442 ikey=kctfil
1443 IF(ikad(ikey)/=ikad(ikey+1))THEN
1444 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)aform(3)
1445 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
1446 READ(iusc2,*,err=9990,END=9990)DTHIS01(3)
1447 ELSE
1448 dthis01(3)=ep30
1449 output%TH%THIS1(3)=ep30
1450 ENDIF
1451
1452C--------------------------
1453C /DTFIL
1454C--------------------------
1455 ikey=kdtfil
1456 IF(ikad(ikey)/=ikad(ikey+1))THEN
1457 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)aform(4)
1458 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
1459 READ(iusc2,*,err=9990,END=9990)DTHIS01(4)
1460 ELSE
1461 dthis01(4)=ep30
1462 output%TH%THIS1(4)=ep30
1463 ENDIF
1464
1465C--------------------------
1466C /ETFIL
1467C--------------------------
1468 ikey=ketfil
1469 IF(ikad(ikey)/=ikad(ikey+1))THEN
1470 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)aform(5)
1471 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
1472 READ(iusc2,*,err=9990,END=9990)DTHIS01(5)
1473 ELSE
1474 dthis01(5)=ep30
1475 output%TH%THIS1(5)=ep30
1476 ENDIF
1477
1478C--------------------------
1479C /KTFIL
1480C--------------------------
1481 ikey=kftfil
1482 IF(ikad(ikey)/=ikad(ikey+1))THEN
1483 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)aform(6)
1484 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
1485 READ(iusc2,*,err=9990,END=9990)DTHIS01(6)
1486 ELSE
1487 dthis01(6)=ep30
1488 output%TH%THIS1(6)=ep30
1489 ENDIF
1490
1491C--------------------------
1492C /GTFIL
1493C--------------------------
1494 ikey=kgtfil
1495 IF(ikad(ikey)/=ikad(ikey+1))THEN
1496 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)aform(7)
1497 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
1498 READ(iusc2,*,err=9990,END=9990)DTHIS01(7)
1499 ELSE
1500 dthis01(7)=ep30
1501 output%TH%THIS1(7)=ep30
1502 ENDIF
1503
1504C--------------------------
1505C /HTFIL
1506C--------------------------
1507 ikey=khtfil
1508 IF(ikad(ikey)/=ikad(ikey+1))THEN
1509 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)aform(8)
1510 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
1511 READ(iusc2,*,err=9990,END=9990)DTHIS01(8)
1512 ELSE
1513 dthis01(8)=ep30
1514 output%TH%THIS1(8)=ep30
1515 ENDIF
1516
1517C--------------------------
1518C /ITFIL
1519C--------------------------
1520 ikey=kitfil
1521 IF(ikad(ikey)/=ikad(ikey+1))THEN
1522 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)aform(9)
1523 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
1524 READ(iusc2,*,err=9990,END=9990)DTHIS01(9)
1525 ELSE
1526 dthis01(9)=ep30
1527 output%TH%THIS1(9)=ep30
1528 ENDIF
1529
1530C--------------------------
1531C /TH
1532C--------------------------
1533 ikey=kth
1534 th_vers=40
1535 IF(ikad(ikey)/=ikad(ikey+1))THEN
1536 k=0
1537 1160 READ(iusc1,rec=ikad(ikey)+k, fmt='(7X,A,1X,A,1X,A,1X,A,19X,I10)', err=9990)key2,key3,key4,key5,nbc
1538 k=k+1
1539 IF(key2(1:4)=='VERS')THEN
1540 READ(key3,'(I4)')th_vers
1541 ELSEIF(key2(1:5)=='TITLE')THEN
1542 th_titles = 1
1543 ELSE
1544 GOTO 9990
1545 ENDIF
1546 IF (th_vers<40) THEN
1547 CALL ancmsg(msgid=198,anmode=aninfo)
1548 ierr=ierr+1
1549 ENDIF
1550 k=k+nbc
1551 IF(ikad(ikey)+k/=ikad(ikey+1))GO TO 1160
1552 ENDIF
1553
1554C--------------------------
1555C /PRINT
1556C--------------------------
1557 ikey=kprint
1558 IF(ikad(ikey)/=ikad(ikey+1))THEN
1559 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5,X,I5)',err=9990)ncpri0,ncpri_head0
1560 ELSE
1561 ncpri0=-100
1562 ncpri_head0=0
1563 ENDIF
1564
1565C--------------------------
1566C /RFILE
1567C--------------------------
1568 rf_check = 0
1569 ikey=krfile
1570 IF(ikad(ikey)/=ikad(ikey+1))THEN
1571 READ(iusc1,rec=ikad(ikey),fmt='(7X,A)',err=9990) key2
1572 ! /RFILE/OFF or -norst command line --> avoid to write restart files during a run
1573 ! default = write restart files
1574 IF(key2(1:3)=='OFF') THEN
1575 restart_file = 0
1576 multirest=0
1577 ncrst=0
1578 irltyp=0
1579 iretyp=0
1580 ELSEIF(restart_file==0) THEN
1581 ! /RFILE/NCYCLE is written in the *1.rad but the user
1582 ! uses the -NORST command line
1583 multirest=0
1584 ncrst=0
1585 irltyp=0
1586 iretyp=0
1587 ELSE
1588 ! /RFILE/
1589 ! NCYCLE
1590 restart_file = 1
1591 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)multirest
1592 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
1593 READ(iusc2,*,err=9990,END=9990)ncrst
1594 irltyp=0
1595 iretyp=0
1596 multirest=min(multirest,26)
1597 rf_check = 1
1598 ENDIF
1599 ELSE
1600 multirest=0
1601 ncrst=0
1602 irltyp=0
1603 iretyp=0
1604 ENDIF
1605
1606 WRITE(iin,'(1P4E16.9,I8,I10,2I8)')tstop0,dthis0,dtfac0,dtmin0,ncpri0,ncrst,multirest,ncpri_head0
1607 WRITE(iin,'(1P5E16.9)')(dthis01(i), i=1,5)
1608 WRITE(iin,'(1P4E16.9)')(dthis01(i+5), i=1,4)
1609
1610c ITTYP set to 4 by default (Binary IEEE 32 bits)
1611 IF(ittyp==0) ittyp=4
1612
1613 itform=ittyp-1
1614 DO i=1,9
1615 IF (aform(i)==0) aform(i)=4
1616 aform(i)=aform(i)-1
1617 END DO
1618
1619 irfe=irform/5
1620 irfl=irform-5*irfe
1621 irform=5*irfe+irfl
1622
1623C--------------------
1624C /ALE/GRID
1625C--------------------
1626 ikey=kale
1627 alp=zero
1628 gam=zero
1629 a1=zero
1630 a2=zero
1631 a3=zero
1632 vm=zero
1633 iale_grid_form=-1
1634 num_ale_grid = 0
1635 k = 0
1636 DO WHILE (ikad(ikey) + k /= ikad(ikey + 1))
1637 READ(iusc1,rec=ikad(ikey)+k,fmt='(1X,A,1X,A,1X,A)',err=9990)key1,key2,key3
1638 IF(key1(1:3) /= 'ALE')THEN
1639 ! read next line
1640 k = k + 1
1641 cycle
1642 ENDIF
1643 IF(key2(1:4)=='GRID')THEN
1644 ! case "/ALE /GRID /....."
1645 stringale(1:5)=key3(1:5)
1646 ELSE
1647 ! case "/ALE /....." (obsolete)
1648 stringale(1:5)=key2(1:5)
1649 ENDIF
1650 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
1651 !---------------------------------------!
1652 ! '/ALE/GRID/DONEA' !
1653 !---------------------------------------!
1654 IF(stringale(1:5)=='DONEA'.OR.stringale(1:1)=='0')THEN
1655 num_ale_grid = num_ale_grid + 1
1656 iale_grid_form=0
1657 READ(iusc2,*,err=9990,END=9990)ALP,GAM,A1,A2,A3,vm
1658 !---------------------------------------!
1659 ! '/ALE/GRID/DISP' !
1660 !---------------------------------------!
1661 ELSEIF(stringale(1:4)=='DISP'.OR.stringale(1:1)=='1')THEN
1662 num_ale_grid = num_ale_grid + 1
1663 iale_grid_form=1
1664 READ(iusc2,*,err=9990,END=9990)ALP,vm !new format scale factor removed (hidden flags)
1665 gam=zero
1666 a1=one; a2=one; a3=one;
1667 !---------------------------------------!
1668 ! '/ALE/GRID/SPRING' !
1669 !---------------------------------------!
1670 ELSEIF(stringale(1:5)=='SPRIN'.OR.stringale(1:1)=='2')THEN
1671 NUM_ALE_GRID = NUM_ALE_GRID + 1
1672 IALE_GRID_FORM=2
1673 READ(IUSC2,*,ERR=9990,END=9990)ALP,GAM,A1,A2,VM
1674 A3=ZERO
1675 !---------------------------------------!
1676 ! '/ale/grid/zero' !
1677 !---------------------------------------!
1678 ELSEIF(StringALE(1:4)=='zero.OR.'StringALE(1:1)=='3')THEN
1679 NUM_ALE_GRID = NUM_ALE_GRID + 1
1680 IALE_GRID_FORM=3
1681 !---------------------------------------!
1682 ! '/ale/grid/standard' !
1683 !---------------------------------------!
1684 ELSEIF(StringALE(1:5)=='stand.OR.'StringALE(1:1)=='4')THEN
1685 NUM_ALE_GRID = NUM_ALE_GRID + 1
1686 IALE_GRID_FORM=4
1687 READ(IUSC2,*,ERR=9990,END=9990)ALP,GAM,A1,A2
1688 A3=ZERO
1689 VM=ZERO
1690 !---------------------------------------!
1691 ! '/ale/grid/laplacian !
1692 !---------------------------------------!
1693 ELSEIF(stringale(1:5)=='LAPLA')THEN
1694 num_ale_grid = num_ale_grid + 1
1695 iale_grid_form=5
1696 READ(iusc2,*,err=9990,END=9990)ALP,a1
1697 IF(alp==zero)alp=one
1698 IF(nint(a1)<=zero)a1=one
1699 IF(a2/=one .AND. a2/=two)a2=one
1700 !---------------------------------------!
1701 ! '/ALE/GRID/VOLUME' !
1702 !---------------------------------------!
1703 ELSEIF(stringale(1:5)=='VOLUM')THEN
1704 num_ale_grid = num_ale_grid + 1
1705 iale_grid_form=6
1706 !---------------------------------------!
1707 ! '/ALE/GRID/MASS-WEIGHTED-VEL' !
1708 !---------------------------------------!
1709 ELSEIF(stringale(1:5)=='FLOW-')THEN
1710 num_ale_grid = num_ale_grid + 1
1711 iale_grid_form=7
1712 READ(iusc2,*,err=9990,END=9990)A1,alp
1713 CALL wriusc2(ikad(ikey)+2,1,key0(ikey))
1714 READ(iusc2,*,err=9990,END=9990)A2,gam
1715 IF(alp == zero)alp = one
1716 IF(gam == zero)gam = one
1717 IF(int(a1) == 0)a1 = 1
1718 IF(int(a1) /= 1 .AND. int(a1) /= -1)a1 = 1 !value different than expected values leads to default value
1719 IF(int(a2) == 0)a2 = 1
1720 IF(int(a2) /= 1 .AND. int(a2) /= -1)a2 = 1 !value different than expected values leads to default value
1721 !---------------------------------------!
1722 ! '/ALE/GRID/LAGRANGE' !
1723 !---------------------------------------!
1724 ELSEIF(stringale(1:5)=='LAGRA')THEN
1725 num_ale_grid = num_ale_grid + 1
1726 iale_grid_form=8
1727 ELSE
1728 !not a keyword related to grid formulation
1729 ENDIF
1730 k = k + 1
1731 ENDDO
1732 !---------------------------------------!
1733 WRITE(iin,'(1P6E10.3)')alp,gam,a1,a2,a3,vm
1734 !---------------------------------------!
1735 !defining new grid formulation
1736 IF(iale_grid_form /= -1)THEN
1737 ale%GRID%NWALE_ENGINE=iale_grid_form
1738 ELSE !nwale<0 nwale is unchanged. its value will be set to TABVINT(264) in rdcomm sub.
1739 ale%GRID%NWALE_ENGINE=-1
1740 ENDIF
1741 !---------------------------------------!
1742 IF(num_ale_grid > 1)THEN
1743 CALL ancmsg(msgid=263,anmode=aninfo)
1744 CALL arret(2)
1745 ENDIF
1746 !---------------------------------------!
1747
1748
1749
1750 !---------------------------------------!
1751 ! '/ALE/LOWMACH !
1752 !---------------------------------------!
1753 ikey = kale
1754 k = 0
1755 lowmach_opt = 0
1756 DO WHILE (ikad(ikey) + k /= ikad(ikey + 1))
1757 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,A,31X,I10)',err=9990)key2,key3,nbc
1758 !---------------------------------------!
1759 ! '/ALE/LOWMACH' !
1760 !---------------------------------------!
1761 IF (key2(1:5) == 'LOWMA') THEN
1762 lowmach_opt = 1
1763 EXIT
1764 ENDIF
1765 k = k + 1 + nbc
1766 ENDDO
1767 ale%GLOBAL%HLLC_LOWMACH = lowmach_opt
1768
1769C--------------------------
1770C /DEL
1771C--------------------------
1772 nintof=0
1773 nelsof=0
1774 nelqof=0
1775 nelcof=0
1776 neltgof=0
1777 neltof=0
1778 nelpof=0
1779 nelrof=0
1780 nsphof=0
1781 ikey=kdel
1782 ndel=0
1783 nintnof=0
1784 nintsof=0
1785 naleof=0
1786 neulerof=0
1787 nthermof=0
1788 npartof=0
1789 IF(ikad(ikey)/=ikad(ikey+1))THEN
1790 k=0
1791 200 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,A,31X,I10)',err=9990)key2,key3,nbc
1792 k3 = 0
1793 IF(key3(1:3)/='NOD'.AND.key3(1:3)/='SEG')READ(key3,fmt='(I5)',err=9990)k3
1794 k=k+1
1795 nof=0
1796 DO i=1,nbc
1797 READ(iusc1,rec=ikad(ikey)+k,fmt='(A)',err=9990)carte
1798 k=k+1
1799 nof=nof+nvar(carte)
1800 ENDDO
1801 ndel=ndel+1
1802 IF(k3==1)nof=nof/2
1803 IF(key2=='INTER'.AND.key3(1:3)=='NOD')THEN
1804 nintnof=nintnof+1
1805 ELSEIF(key2=='INTER'.AND.key3(1:3)=='SEG')THEN
1806 nintsof=nintsof+1
1807 ELSEIF(key2=='INTER')THEN
1808 nintof=nintof+nof
1809 ELSEIF(key2=='BRICK')THEN
1810 nelsof=nelsof+nof
1811 ELSEIF(key2=='QUAD ')THEN
1812 nelqof=nelqof+nof
1813 ELSEIF(key2=='SHELL')THEN
1814 nelcof=nelcof+nof
1815 ELSEIF(key2=='TRUSS')THEN
1816 neltof=neltof+nof
1817 ELSEIF(key2=='BEAM ')THEN
1818 nelpof=nelpof+nof
1819 ELSEIF(key2=='SPRIN')THEN
1820 nelrof=nelrof+nof
1821 ELSEIF(key2=='SH_3N'.OR.key2(1:4)=='SH3N')THEN
1822 neltgof=neltgof+nof
1823 ELSEIF(key2=='SPCEL'.OR.key2=='SPHCE')THEN
1824 nsphof=nsphof+nof
1825 ELSEIF(key2=='ALE ')THEN
1826 naleof=1
1827 ELSEIF(key2=='EULER')THEN
1828 neulerof=1
1829 ELSEIF(key2=='THERM')THEN
1830 nthermof=1
1831 ELSEIF(key2=='PART ')THEN
1832 npartof = npartof+nof
1833 ELSE
1834 CALL errmsg(key2)
1835 ENDIF
1836 IF(ikad(ikey)+k/=ikad(ikey+1))GO TO 200
1837 ENDIF
1838 WRITE(iin,'(10I8)')nintof,nelsof,nelqof,nelcof,neltof,nelpof,nelrof,neltgof,nintnof,nintsof
1839 WRITE(iin,'(I8)')nsphof
1840 WRITE(iin,'(4I8)')naleof,neulerof,nthermof,npartof
1841
1842C--------------------------
1843C /VEL
1844C--------------------------
1845 nrlink=0
1846 nalelk=0
1847 ikey=kvel
1848 k=0
1849 DO WHILE (ikad(ikey) + k /= ikad(ikey + 1))
1850 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,37X,I10)', err=9990)key2,nbc
1851 IF(key2=='TRA ')THEN
1852 nrlink=nrlink+1
1853 ELSEIF(key2=='ROT ')THEN
1854 nrlink=nrlink+1
1855 ELSEIF(key2=='ALE ')THEN
1856 ! /VEL/ALE (OBSOLETE, replaced with /ALE/LINK)
1857 nalelk=nalelk+1
1858 ELSE
1859 CALL errmsg(key2)
1860 ENDIF
1861 k=k+nbc+1
1862 ENDDO
1863 WRITE(iin,'(2I8)')nrlink,nalelk
1864
1865C-----------------------
1866C /ALE/LINK
1867C-----------------------
1868 ikey = kale
1869 nalelink = 0
1870 k=0
1871 DO WHILE (ikad(ikey) + k /= ikad(ikey + 1))
1872 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,A,31X,I10)',err=9990)key2,key3,nbc
1873 IF(key2(1:5)=='LINK ')THEN
1874 IF(key3(1:5)=='VEL ')THEN
1875 nalelink=nalelink+1
1876 ELSEIF(key3(1:5)=='OFF ')THEN
1877 nalelink=nalelink+1
1878 ELSEIF(key3(1:5)=='ON ')THEN
1879 nalelink=nalelink+1
1880 ELSE
1881 CALL errmsg('/ALE/LINK')
1882 ENDIF
1883 ENDIF
1884 k=k+nbc+1
1885 ENDDO
1886 WRITE(iin,'(I8)')nalelink
1887
1888C-----------------------
1889C /ALE/SUPG
1890C-----------------------
1891 ale%UPWIND%UPWM = 3
1892 ale%UPWIND%UPW_UPDATE = 0
1893 ale%UPWIND%UPWMG2 = zero
1894 ale%UPWIND%UPWOG2 = zero
1895 ale%UPWIND%UPWSM2 = zero
1896 ale%UPWIND%CUPWM = one !SUPG enabled
1897 ale%UPWIND%I_SUPG_ON_OFF = 0 !test if card is present to check user input in case of both /ALE/SUPG & /UPWM/SUPG
1898 ! 1 : ON
1899 ! 2 : OFF
1900 ikey = kale
1901 k = 0
1902 DO WHILE (ikad(ikey) + k /= ikad(ikey + 1))
1903 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,A,31X,I10)',err=9990)key2,key3,nbc
1904 !---------------------------------------!
1905 ! '/ALE/SUPG/OFF - ON !
1906 !---------------------------------------!
1907 IF(key2(1:4)=='SUPG')THEN
1908 IF(key3(1:3)=='OFF')THEN
1909 ale%UPWIND%UPWM = 0
1910 ale%UPWIND%UPW_UPDATE = 0
1911 ale%UPWIND%I_SUPG_ON_OFF = 2
1912 ELSEIF(key3(1:5)=='ON')THEN
1913 ale%UPWIND%UPWM = 3
1914 ale%UPWIND%UPW_UPDATE = 0
1915 ale%UPWIND%I_SUPG_ON_OFF = 1
1916 ELSE
1917 IF(n2d==1)THEN
1918 !axisymmetric case
1919 ale%UPWIND%UPWM = 0
1920 ale%UPWIND%UPW_UPDATE = 0
1921 ELSE
1922 !3D & 2D planar
1923 ale%UPWIND%UPWM = 3
1924 ENDIF
1925 ale%UPWIND%UPW_UPDATE = 0
1926 ale%UPWIND%I_SUPG_ON_OFF = 0
1927 ENDIF
1928 ENDIF
1929 k = k + 1 + nbc
1930 ENDDO
1931
1932C-----------------------
1933C /ALE/MUSCL
1934C-----------------------
1935 alemuscl_param%I_MUSCL_OFF = 0
1936 ikey = kale
1937 k = 0
1938 DO WHILE (ikad(ikey) + k /= ikad(ikey + 1))
1939 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,A,31X,I10)',err=9990)key2,key3,nbc
1940 !---------------------------------------!
1941 ! '/ALE/MUSCL/OFF' !
1942 !---------------------------------------!
1943 IF (key2(1:5) == 'MUSCL') THEN
1944 IF(key3(1:3)=='OFF')THEN
1945 alemuscl_param%I_MUSCL_OFF = 1
1946 ELSEIF(key3(1:2)=='ON')THEN
1947 alemuscl_param%I_MUSCL_OFF = 0
1948 alemuscl_param%IALEMUSCL = 1
1949 alemuscl_param%BETA = two
1950 ELSE
1951 GOTO 9990
1952 ENDIF
1953 ENDIF
1954 k = k + 1 + nbc
1955 ENDDO
1956
1957C--------------------
1958C /ALE/ON /ALE/OFF
1959C--------------------
1960 ikey = kale
1961 nbaleoff = 0
1962 nbaleon = 0
1963 nbpartaleon = 0
1964 nbpartaleoff = 0
1965 k = 0
1966 DO WHILE (ikad(ikey) + k /= ikad(ikey + 1))
1967 READ (iusc1, rec = ikad(ikey) + k, fmt = '(7X,A,37X,I10)') key2, nbc
1968 IF (key2(1:2) == 'ON') THEN
1969 nbaleon = nbaleon + 1
1970 nbpartaleon = nbpartaleon + nbc
1971 ENDIF
1972 IF (key2(1:3) == 'OFF') THEN
1973 nbaleoff = nbaleoff + 1
1974 nbpartaleoff = nbpartaleoff + nbc
1975 ENDIF
1976 k = k + 1 + nbc
1977 ENDDO
1978 WRITE (iin, '(I8, I8)') nbpartaleon, nbpartaleoff
1979
1980C-----------------------
1981C /ALE/SOLVER/FINT
1982C-----------------------
1983 ikey = kale
1984 k = 0
1985 ale%GLOBAL%ISFINT = 0 !not yet read communicated in engine
1986 DO WHILE (ikad(ikey) + k /= ikad(ikey + 1))
1987
1988 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A32)',err=9990)stringale
1989 IF(stringale(1:5)/='SOLVE')EXIT
1990 READ(iusc1,rec=ikad(ikey)+k,fmt='(13X,A32)',err=9990)stringale
1991 IF(stringale(1:4)/='FINT')EXIT
1992 READ(iusc1,rec=ikad(ikey)+k,fmt='(A)',err=9990)line
1993 READ(line,fmt='(7X,A5,1X,A5,1X,I5)',err=9990)key2,key3,iform
1994 IF(iform==2)THEN
1995 ale%GLOBAL%ISFINT = 2 !FEM INT : surface integration
1996 ELSEIF(iform==1)THEN
1997 ale%GLOBAL%ISFINT = 1 !FVM INT : volume integration
1998 ELSEIF(iform==3)THEN
1999 ale%GLOBAL%ISFINT = 3 !FVM INT : volume integration
2000 ELSE
2001 !default
2002 ale%GLOBAL%ISFINT = 1
2003 ENDIF
2004 k = k + 1
2005 ENDDO
2006
2007C--------------------
2008C /ALE : check for valid sub-keywords
2009C--------------------
2010 ikey = kale
2011 k = 0
2012 DO WHILE (ikad(ikey) + k /= ikad(ikey + 1))
2013 lfound=.false.
2014 READ (iusc1, rec = ikad(ikey) + k, fmt = '(A32)', err=998) keya
2015 READ (iusc1, rec = ikad(ikey) + k, fmt = '(X,A5,X,A5)', err=998) key1 ,key2
2016 IF(key2(1:5)==' ')key2(1:1)='0'
2017 IF(key1(1:5)=='ALE ')THEN
2018 DO inum=1,num_ale_key2
2019 IF (key2(1:5) == keyale(inum)) THEN
2020 lfound = .true.
2021 EXIT
2022 ENDIF
2023 ENDDO
2024 IF(lfound.EQV. .false.)THEN
2025 CALL ancmsg(msgid=51,anmode=aninfo,c1=keya(1:12))
2026 ierr = ierr + 1
2027 ENDIF
2028 ENDIF
2029 998 CONTINUE
2030 k = k + 1
2031 ENDDO
2032
2033C--------------------
2034C /BCS
2035C--------------------
2036 nubcs1=0
2037 nbcs1=0
2038 nbcs2=0
2039 ikey=kbcs
2040 IF(ikad(ikey)/=ikad(ikey+1))THEN
2041 k=0
2042 400 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,37X,I10)',err=9990)key2,nbc
2043 k=k+1
2044 DO i=1,nbc
2045 READ(iusc1,rec=ikad(ikey)+k,fmt='(A)',err=9990)carte
2046 k=k+1
2047 nubcs1=nubcs1+nvar(carte)
2048 ENDDO
2049 nbcs1 = nbcs1 + 1
2050 IF(ikad(ikey)+k/=ikad(ikey+1))GO TO 400
2051 ENDIF
2052 nubcs2=0
2053 ikey=kbcsr
2054 IF(ikad(ikey)/=ikad(ikey+1))THEN
2055 k=0
2056 420 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,37X,I10)',err=9990)key2,nbc
2057 k=k+1
2058 DO i=1,nbc
2059 READ(iusc1,rec=ikad(ikey)+k,fmt='(A)',err=9990)carte
2060 k=k+1
2061 nubcs2=nubcs2+nvar(carte)
2062 ENDDO
2063 nbcs2 = nbcs2 + 1
2064 IF(ikad(ikey)+k/=ikad(ikey+1))GO TO 420
2065 ENDIF
2066 num_bcs=nubcs1+nubcs2
2067
2068C--------------------
2069C /INIV
2070C--------------------
2071 niniv = 0
2072 ninivt= 0
2073 ikey=kiniv
2074 IF(ikad(ikey)/=ikad(ikey+1))THEN
2075 k=0
2076 440 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,7X,I5,25X,I10)',err=9990)key2,k3,nbc
2077 k=k+1
2078 IF (key2(1:4)=="AXIS") THEN
2079 m=2
2080 ELSE
2081 m=1
2082 ENDIF
2083 k=k+m
2084 IF (k3==2) THEN
2085 READ(iusc1,rec=ikad(ikey)+k,fmt='(A)',err=9990)carte
2086 ! nvar(carte) should be =1
2087 k=k+1
2088 ninivt=ninivt+(nbc-m)*2*nvar(carte)
2089 ELSE
2090 DO i=1,nbc-m
2091 READ(iusc1,rec=ikad(ikey)+k,fmt='(A)',err=9990)carte
2092 k=k+1
2093 ninivt=ninivt+(2-k3)*nvar(carte)
2094 ENDDO
2095 END IF
2096 niniv=niniv + 1
2097 IF(ikad(ikey)+k/=ikad(ikey+1))GO TO 440
2098 ENDIF
2099 WRITE(iin,'(2I8)')num_bcs,ninivt/2
2100
2101C--------------------
2102C /INTER
2103C--------------------
2104 nintch=0
2105 intch_ifop = 0
2106 ifop =1
2107 intch_itop = 0
2108 itop = 1
2109 nbtopfop = 0
2110 ikey=kinter
2111 IF(ikad(ikey)/=ikad(ikey+1))THEN
2112 k=0
2113 !options /inter/fop , /inter/top, /inter/nofop, /inter/notop
2114 500 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,37X,I10)',err=9990)key2,nbc
2115 k=k+nbc+1
2116 nintch=nintch+1
2117 IF(key2=='FOP') THEN
2118C IFOP = 1
2119 IF (intch_ifop/=0) THEN
2120 GO TO 9990
2121 ELSE
2122 intch_ifop=nintch
2123 nbtopfop = nbtopfop + 1
2124 ENDIF
2125 ELSEIF(key2=='NOFOP') THEN
2126C IFOP = 0
2127 IF (intch_ifop/=0) THEN
2128 GO TO 9990
2129 ELSE
2130 intch_ifop=nintch
2131 nbtopfop = nbtopfop + 1
2132 ENDIF
2133 ELSEIF(key2=='TOP') THEN
2134C ITOP = 1
2135 IF (intch_itop/=0) THEN
2136 GO TO 9990
2137 ELSE
2138 intch_itop=nintch
2139 nbtopfop = nbtopfop + 1
2140 ENDIF
2141 ELSEIF(key2=='NOTOP') THEN
2142C ITOP = 0
2143 IF (intch_itop/=0) THEN
2144 GO TO 9990
2145 ELSE
2146 intch_itop=nintch
2147 nbtopfop = nbtopfop + 1
2148 ENDIF
2149 ENDIF
2150 IF(ikad(ikey)+k/=ikad(ikey+1))GO TO 500
2151 ENDIF
2152
2153C--------------------
2154C /RBODY
2155C--------------------
2156 ikey=krbody
2157 nrbyon=0
2158 nrbyof=0
2159 nrbynf=0
2160 IF(ikad(ikey)/=ikad(ikey+1))THEN
2161 k=0
2162 550 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,37X,I10)',err=9990)key2,nbc
2163 k=k+1
2164 nof=0
2165 DO i=1,nbc
2166 READ(iusc1,rec=ikad(ikey)+k,fmt='(A)',err=9990)carte
2167 k=k+1
2168 nof=nof+nvar(carte)
2169 ENDDO
2170 nrbynf=nrbynf+1
2171 IF(key2=='ON')THEN
2172 nrbyon=nrbyon+nof
2173 ELSEIF(key2=='OFF')THEN
2174 nrbyof=nrbyof+nof
2175 ELSE
2176 CALL errmsg(key2)
2177 ENDIF
2178 IF(ikad(ikey)+k/=ikad(ikey+1))GO TO 550
2179 ENDIF
2180 ! cases /inter/fop and /inter/top
2181 WRITE(iin,'(10I8)')nintch-nbtopfop,nrbyon,nrbyof
2182
2183C--------------------
2184C /MADYMO (COUPLING)
2185C--------------------
2186 ikey=kmadym
2187 imadcpl = 0
2188 IF (ikad(ikey)/=ikad(ikey+1)) THEN
2189 k=0
2190 650 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,37X,I10)',err=9990) key2,nbc
2191 IF(key2/='ON' .AND. key2/='on2.AND.' KEY2/='mpp' )THEN
2192 CALL ERRMSG(KEY2)
2193 ELSEIF(KEY2=='on2')THEN
2194 IMADCPL = 1
2195 ELSEIF(KEY2=='mpp')THEN
2196 IMADCPL = 1
2197 ENDIF
2198 K=K+1
2199 DO I=1,NBC
2200 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(a)',ERR=9990) CARTE
2201 K=K+1
2202 ENDDO
2203 IF(IKAD(IKEY)+K/=IKAD(IKEY+1)) GO TO 650
2204 ENDIF
2205
2206C--------------------
2207C /RAD2RAD
2208C--------------------
2209 IKEY=KRAD2R
2210 IRAD2R=0
2211 IF (IKAD(IKEY)/=IKAD(IKEY+1)) THEN
2212 K=0
2213 670 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(7x,a,37x,i10)',ERR=9990) KEY2,NBC
2214 IF(KEY2/='on')THEN
2215 CALL ERRMSG(KEY2)
2216 ELSEIF(KEY2=='on')THEN
2217 IRAD2R = 1
2218 !initial connection with rad2rad
2219 IF (ISPMD==0) CALL CONNECTION_SOCK_INIT_C(SOCK0)
2220 ENDIF
2221 K=K+1
2222 DO I=1,NBC
2223 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(a)',ERR=9990) CARTE
2224 K=K+1
2225 ENDDO
2226 IF(IKAD(IKEY)+K/=IKAD(IKEY+1)) GO TO 670
2227 ENDIF
2228
2229C--------------------
2230C /VIPER
2231C--------------------
2232 IKEY=KVIPER
2233 ViperCoupling = .false.
2234 IF (IKAD(IKEY)/=IKAD(IKEY+1)) THEN
2235 K=0
2236 680 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(7x,a,37x,i10)',ERR=9990) KEY2,NBC
2237 IF(KEY2=='on')THEN
2238 ViperCoupling = .true.
2239 ENDIF
2240 K=K+1
2241 DO I=1,NBC
2242 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(a)',ERR=9990) CARTE
2243 K=K+1
2244 ENDDO
2245 IF(IKAD(IKEY)+K/=IKAD(IKEY+1)) GO TO 680
2246 ENDIF
2247
2248C--------------------------------------------------
2249C /PERF
2250C-------------------------------------------------
2251 IKEY=KPERF
2252 GLOBAL_INTERFACE_SORTING_ALGO = 1
2253 IF (IKAD(IKEY)/=IKAD(IKEY+1)) THEN
2254 K=0
2255 700 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(7x,a,37x,i10)',ERR=9990) KEY2,NBC
2256 IF(KEY2=='sort1') THEN
2257 GLOBAL_INTERFACE_SORTING_ALGO = 1
2258 ELSEIF(KEY2=='sort2') THEN
2259 GLOBAL_INTERFACE_SORTING_ALGO = 2
2260 ELSEIF(KEY2=='sort3') THEN
2261 GLOBAL_INTERFACE_SORTING_ALGO = 0
2262 ENDIF
2263 K = K +1
2264 IF(IKAD(IKEY)+K/=IKAD(IKEY+1)) GO TO 700
2265 ENDIF
2266
2267C--------------------
2268C /SPMD
2269C--------------------
2270 IKEY=KSPMD
2271 IDDW=0
2272 IPREAD=0
2273 IDDWSTAT=0
2274 IF (IKAD(IKEY)/=IKAD(IKEY+1)) THEN
2275 K=0
2276 750 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(7x,a,37x,i10)',ERR=9990) KEY2,NBC
2277 IF(KEY2=='ddw')THEN
2278 IDDW=1
2279 CALL WRIUSC2(IKAD(IKEY)+1,1,KEY0(IKEY))
2280 READ(IUSC2,*) TPSENG
2281 ELSEIF(KEY2=='pread')THEN
2282 IPREAD = 1
2283 ELSEIF(KEY2=='ddwst')THEN
2284 IDDW=1
2285 IDDWSTAT=1
2286 ELSE
2287 CALL ERRMSG(KEY2)
2288 ENDIF
2289 K=K+1
2290 DO I=1,NBC
2291 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(a)',ERR=9990) CARTE
2292 K=K+1
2293 ENDDO
2294 IF(IKAD(IKEY)+K/=IKAD(IKEY+1)) GO TO 750
2295 ENDIF
2296C
2297C--------------------
2298C /DAMP
2299C--------------------
2300 IDAMP0=0
2301 N_DAMP=0
2302 IKEY=KDAMP
2303 IF(IKAD(IKEY)/=IKAD(IKEY+1))THEN
2304 K=0
2305 770 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(101x,i10)',ERR=9990) NBC
2306 IF (NBC == 2) IDAMP0=1
2307 K=K+NBC+1
2308 N_DAMP=N_DAMP+1
2309 IF(IKAD(IKEY)+K/=IKAD(IKEY+1))GO TO 770
2310 ENDIF
2311 WRITE(IIN,'(i8)')N_DAMP
2312
2313C--------------------
2314C /FXINP (FLEXIBLE BODY INPUT FILES)
2315C--------------------
2316 IKEY=KFXINP
2317 NFXINP=0
2318 IF (IKAD(IKEY)/=IKAD(IKEY+1)) THEN
2319 K=0
2320 780 CALL WRIUSC2(IKAD(IKEY)+1,1,KEY0(IKEY))
2321 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(49x,i10)',ERR=9990) NBC
2322 K=K+NBC+1
2323 NFXINP=NFXINP+NBC
2324 IF (IKAD(IKEY)+K/=IKAD(IKEY+1)) GO TO 780
2325 ENDIF
2326 WRITE(IIN,'(i8)')NFXINP
2327
2328C--------------------
2329C /EIG (EIGENPROBLEM DEACTIVATION)
2330C--------------------
2331 IKEY=KEIG
2332 NEIGOFF=0
2333 NEOFF=0
2334 IF (IKAD(IKEY)/=IKAD(IKEY+1)) THEN
2335 K=0
2336 790 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(7x,a,37x,i10)',ERR=9990)KEY2,NBC
2337 K=K+1
2338 NOF=0
2339 DO I=1,NBC
2340 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(a)',ERR=9990)CARTE
2341 K=K+1
2342 NOF=NOF+NVAR(CARTE)
2343 ENDDO
2344 NEIGOFF=NEIGOFF+1
2345 NEOFF=NEOFF+NOF
2346 IF(KEY2/='off') CALL ERRMSG(KEY2)
2347 IF(IKAD(IKEY)+K/=IKAD(IKEY+1)) GOTO 790
2348 ENDIF
2349 WRITE(IIN,'(2i8)')NEIGOFF, NEOFF
2350
2351C-----------------------
2352C /FVMBAG (REMESH/MODIF)
2353C-----------------------
2354 IKEY=KFVBAG
2355 NFVMESH=0
2356 NFVMODI=0
2357 IF(IKAD(IKEY)/=IKAD(IKEY+1)) THEN
2358 K=0
2359 810 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(7x,a5,37x,i10)',ERR=9990)KEY2, NBC
2360 K=K+NBC+1
2361 IF (KEY2=='remes') NFVMESH=NFVMESH+1
2362 IF (KEY2=='modif') NFVMODI=NFVMODI+1
2363 IF (IKAD(IKEY)+K/=IKAD(IKEY+1)) GO TO 810
2364 ENDIF
2365 WRITE(IIN,'(2i8)')NFVMESH,NFVMODI
2366
2367C-----------------------
2368C /DT1TET10
2369C--------------------
2370 IKEY = KDT1TET10
2371 IDT1TET10=0
2372 IF(IKAD(IKEY)/=IKAD(IKEY+1))THEN
2373 NITERP=0
2374 READ(IUSC1,REC=IKAD(IKEY),FMT='(7x,i5)',ERR=9990)NITERP
2375 IF(NITERP == 0)NITERP=1
2376 IDT1TET10=1+NITERP
2377 END IF
2378
2379C-----------------------
2380C /DTTSH (full shell timestep for thick shells)
2381C--------------------
2382 IKEY = KDTTSH
2383 IDTTSH=0
2384 IF(IKAD(IKEY)/=IKAD(IKEY+1))THEN
2385 IDTTSH=1
2386 END IF
2387
2388C--------------------
2389C /MASS/RESET
2390C--------------------
2391 IKEY = KMASS
2392 IMASSI = 0
2393 IF(IKAD(IKEY)/=IKAD(IKEY+1))THEN
2394 READ(IUSC1,REC=IKAD(IKEY),FMT='(7x,a)',ERR=9990)KEY2
2395 IF(KEY2(1:5)=='reset.AND..AND.'IRUNN>1MCHECK==0) IMASSI = 1
2396 END IF
2397
2398C--------------------
2399C /SENS/RESET
2400C--------------------
2401 IKEY = KSENSOR
2402 SENSORS%NRESET = 0
2403 IREC = IKAD(IKEY)
2404 IF (IKAD(IKEY) /= IKAD(IKEY+1)) THEN
2405 READ(IUSC1,REC=IKAD(IKEY),FMT='(7x,a,37x,i10)',ERR=9990) KEY2,NBC
2406 IF (KEY2(1:5)=='reset') THEN
2407 IREC = IREC+1
2408 NBSENS = 0
2409 DO I=1,NBC
2410 READ(IUSC1,REC=IREC+I-1,FMT='(a)',ERR=9990)CARTE
2411 NBSENS = NBSENS + NVAR(CARTE)
2412 ENDDO
2413 IF (NBSENS == 0) THEN
2414 SENSORS%NRESET = SENSORS%NSENSOR
2415 ELSE
2416 SENSORS%NRESET = NBSENS
2417 ALLOCATE(SENSORS%RESET(NBSENS))
2418 NBSENS = 0
2419 DO I=1,NBC
2420 READ(IUSC1,REC=IREC+I-1,FMT='(a)',ERR=9990)CARTE
2421 CALL WRIUSC2(IREC+I-1,1,KEY0(IKEY))
2422 READ(IUSC2,*,ERR=9990,END=9990)
2423 . (SENSORS%RESET(J+NBSENS),J=1,NVAR(CARTE))
2424 NBSENS = NBSENS + NVAR(CARTE)
2425 ENDDO
2426 END IF
2427 END IF
2428 END IF
2429
2430C--------------------
2431C /DEL/INTER (TYPE7 SHELL DELETION)
2432C--------------------
2433 CALL FREDLI7(IKAD(0),KEY0,KDELIN)
2434
2435C--------------------
2436C /DEL/INTER (INTERFACE DELETION)
2437C--------------------
2438 CALL FREDLI(IKAD(0),KEY0,KDEL,NDEL)
2439
2440C--------------------
2441C /DEL (ELEMENT DELETION)
2442C--------------------
2443 CALL RDELE(NDEL,'brick',IKAD(KDEL),KEY0(IKEY))
2444 CALL RDELE(NDEL,'quad ',IKAD(KDEL),KEY0(IKEY))
2445 CALL RDELE(NDEL,'shell',IKAD(KDEL),KEY0(IKEY))
2446 CALL RDELE(NDEL,'truss',IKAD(KDEL),KEY0(IKEY))
2447 CALL RDELE(NDEL,'beam ',IKAD(KDEL),KEY0(IKEY))
2448 CALL RDELE(NDEL,'sprin',IKAD(KDEL),KEY0(IKEY))
2449 CALL RDELE(NDEL,'sh_3n',ikad(kdel),key0(ikey))
2450 CALL rdele(ndel,'SH3N ',ikad(kdel),key0(ikey))
2451 CALL rdele(ndel,'SPCEL',ikad(kdel),key0(ikey))
2452 CALL rdele(ndel,'SPHCE',ikad(kdel),key0(ikey))
2453 CALL rdele(ndel,'PART ',ikad(kdel),key0(ikey))
2454
2455C--------------------
2456C /ALE/LINK (and obsolete option /VEL/ALE)
2457C--------------------
2458 CALL frelnk(ikad(0),key0,kvel,nrlink,vel_sk_fr)
2459C--------------------
2460C ALE LINK
2461C--------------------
2462 llinal = 0
2463 IF(nalelk/=0) CALL fralnk (ikad(0),key0,kvel,nalelk) !format v5.1
2464 IF(nalelink/=0)CALL fralnk2(ikad(0),key0,kale,nalelink) !format v12
2465 !LLINAL is now LINALE() dimension for engine ALE links definitions.
2466
2467C--------------------
2468C /ALE (ON/OFF)
2469C--------------------
2470 IF (nbaleon + nbaleoff /= 0) CALL fraleonoff(ikad(0), key0, kale, nbaleon + nbaleoff)
2471
2472C--------------------
2473C /BCS
2474C--------------------
2475 CALL frebcs(ikad(0),key0,kbcs,kbcsr,nbcs1,nbcs2,bcs_sk_fr)
2476
2477C--------------------
2478C /INTER
2479C--------------------
2480 CALL freint(ikad(0),key0,kinter,nintch,invers,intch_ifop,intch_itop)
2481
2482C--------------------
2483C /RBODY (ON/OFF)
2484C--------------------
2485 CALL frerbo(ikad(0),key0,krbody,nrbynf)
2486
2487C--------------------
2488C /FLSEC (FLOW SECTIONS,OBSOLETE)
2489C--------------------
2490 ntflsw=0
2491 IF(nsflsw/=0)CALL freflw(ikad(0),key0,kflsec,nsflsw,ntflsw)
2492 !not compatible SPMD
2493 IF (nsflsw>0) THEN
2494 CALL ancmsg(msgid=201,anmode=aninfo)
2495 ierr=ierr+1
2496 ENDIF
2497
2498C--------------------
2499C /FUNCT (FUNCTION UPDATES)
2500C--------------------
2501 CALL frefunc(ikad(0),key0,kfunc,nfct)
2502
2503C--------------------
2504C /INIV (VELOCITY INITIALIZATIONS)
2505C--------------------
2506 CALL freiniv(ikad(0),key0,kiniv,niniv)
2507
2508C-----------------------
2509C /ANIM (ANIMATION FILES)
2510C-----------------------
2511 CALL freanim(output,ikad(0),key0,kanim,sensors)
2512C-----------------------
2513C /OUTP (OUTPUT FILES)
2514C-----------------------
2515 CALL freoutp(ikad(0),key0,koutp,sensors)
2516
2517C-----------------------
2518C /DEBUG
2519C-----------------------
2520 CALL fredebug(ikad(0),key0,kdebug)
2521
2522C--------------------
2523C /NOISE
2524C--------------------
2525 CALL frenois(ikad(0),key0,knoise)
2526C--------------------
2527C /UPWIND (PARAMETERS ETA1,ETA2,ETA3)
2528C--------------------
2529 CALL freupwind(ikad(0),key0,kupwind)
2530
2531C--------------------
2532C /UPWM (MOMENTUM ADVECTION METHOD)
2533C--------------------
2534 CALL freupwm(ikad(0),key0,kupwm)
2535
2536C--------------------
2537C /MON (MONITORING)
2538C--------------------
2539 ikey=kmon
2540 imon = 1
2541 imonm = 0
2542 imon_mat = 0
2543 IF(ikad(ikey)/=ikad(ikey+1))THEN
2544 READ(iusc1,rec=ikad(ikey),fmt='(7X,A,1X,I5)',err=9990)key2,k4
2545 IF(key2=='OFF')THEN
2546 imon = 0
2547 imonm = 0
2548 ELSEIF(key2=='ON')THEN
2549 imon = k4 + 1
2550 imonm = 0
2551 ELSEIF(key2=='FULL')THEN
2552 imon = k4 + 1
2553 imonm = 1
2554 ELSEIF(key2=='SYNC')THEN
2555 imon = k4 + 1
2556 imonm = 2
2557 ELSEIF(key2=='MAT')THEN
2558 imon = k4 + 1
2559 imon_mat = 1
2560c ELSEIF(KEY2=='GRAPH')THEN
2561c IMON = K4 + 1
2562c IMONM = 3
2563 ENDIF
2564 ENDIF
2565
2566C--------------------
2567C /INCMP (OBSOLETE OPTION, incompressible)
2568C--------------------
2569 ale%GLOBAL%INCOMP = 0
2570 ikey=kincmp
2571 IF(ikad(ikey)/=ikad(ikey+1))THEN
2572 ale%GLOBAL%INCOMP=1
2573 ENDIF
2574
2575C--------------------
2576C /MADYMO (COUPLING)
2577C--------------------
2578 IF(imadcpl/=0) CALL frecpl(ikad,key0,kmadym)
2579
2580C--------------------
2581C /DAMP
2582C--------------------
2583 CALL fredamp(ikad(0),key0,kdamp,n_damp)
2584
2585C-----------------------
2586C /IMPL
2587C-----------------------
2588 impl=0
2589 CALL freimpl(ikad(0),key0,kimpl)
2590
2591C--------------------
2592C /FXINP (OUTPUT FILES FOR FLEXIBLE BODIES)
2593C--------------------
2594 CALL frefxinp(ikad(0),key0,kfxinp,nfxinp)
2595
2596C--------------------
2597C /EIG (EIGENPROBLEM DEACTIVATION)
2598C--------------------
2599 CALL freeig(ikad(0),key0,keig,neigoff)
2600
2601C--------------------
2602C /FVMBAG (REMESH)
2603C--------------------
2604 CALL frefvbag(ikad(0),key0,kfvbag)
2605
2606C-----------------------
2607C /STATE
2608C-----------------------
2609 CALL frestat(ikad(0),key0,kstatf,sensors,output)
2610
2611C-----------------------
2612C /DYNAIN
2613C-----------------------
2614 CALL fredynain(ikad(0),key0,kdynain,dynain_data)
2615
2616C-----------------------
2617C /ABF (and /AABF, /BABF, /CABF, /DABF, /EABF, /FABF, /GABF, /HABF, /IABF)
2618C-----------------------
2619 abfile = 0
2620 nabfile = 0
2621#ifdef DNC
2622 CALL freabf(ikad(0),key0,kabf,abfile,nabfile,1)
2623 CALL freabf(ikad(0),key0,kaabf,abfile,nabfile,2)
2624 CALL freabf(ikad(0),key0,kbabf,abfile,nabfile,3)
2625 CALL freabf(ikad(0),key0,kcabf,abfile,nabfile,4)
2626 CALL freabf(ikad(0),key0,kdabf,abfile,nabfile,5)
2627 CALL freabf(ikad(0),key0,keabf,abfile,nabfile,6)
2628 CALL freabf(ikad(0),key0,kfabf,abfile,nabfile,7)
2629 CALL freabf(ikad(0),key0,kgabf,abfile,nabfile,8)
2630 CALL freabf(ikad(0),key0,khabf,abfile,nabfile,9)
2631 CALL freabf(ikad(0),key0,kiabf,abfile,nabfile,10)
2632 IF (nabfile/=0 .AND. abfile(1) == 0) THEN
2633 nabfile = nabfile + 1
2634 abfile(1) = abfile(1) + 1
2635 ENDIF
2636#endif
2637
2638C-----------------------
2639C /THERM
2640C-----------------------
2641 CALL frethermal(ikad(0),key0,kthermal,glob_therm)
2642
2643C-----------------------
2644C /H3D
2645C-----------------------
2646 CALL h3d_ini(h3d_data,kh3d,nslash)
2647 CALL h3d_read(ikad(0),key0,kh3d,nslash,h3d_data,sensors)
2648
2649C-----------------------
2650C /REPORT
2651C-----------------------
2652 ikey=kreport
2653 ireport = 0
2654 ih3dreader = 0
2655 imvw = 0
2656 imvw_ref = 0
2657 k = 0
2658 DO WHILE(ikad(ikey)+k/=ikad(ikey+1))
2659 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,A,1X,A,1X,A,19X,I10)',err=9990)key2,key3,key4,key5,nbc
2660 ireport=1
2661 IF(key2=='HTML')THEN
2662 ihtml = 1
2663 IF(key3=='H3D' .AND. nslash(kh3d) /= 0) THEN
2664 ih3dreader = 1
2665 IF(key4 =='EXT') ih3dreader = 2
2666 ENDIF
2667 ELSEIF(key2=='MVW')THEN
2668 imvw=1
2669 IF(key3=='REF')THEN
2670 imvw_ref = 1
2671 k = k + 1
2672 READ(iusc1,rec=ikad(ikey)+k,fmt='(5X,A)',err=9990)imvw_refpath
2673 ELSEIF(key3=='ANIM')THEN
2674 IF(key4=='TH')THEN
2675 imvw=1
2676 ELSEIF(key4=='ABF')THEN
2677 imvw=2
2678 ENDIF
2679 ELSEIF(key3=='H3D')THEN
2680 IF(key4=='TH')THEN
2681 imvw=3
2682 ELSEIF(key4=='ABF')THEN
2683 imvw=4
2684 ENDIF
2685 ELSE
2686 !autoselect of files format
2687 IF(nslash(kanim) /= 0)THEN
2688 IF(nslash(ktfile) /= 0)THEN
2689 imvw=1
2690 ELSEIF(nslash(kabf) /= 0)THEN
2691 imvw=2
2692 ENDIF
2693 ELSEIF(nslash(kh3d) /= 0) THEN
2694 IF(nslash(ktfile) /= 0)THEN
2695 imvw=3
2696 ELSEIF(nslash(kabf) /= 0)THEN
2697 imvw=4
2698 ENDIF
2699 ENDIF
2700 ENDIF
2701 ENDIF
2702 k = k + 1
2703 ENDDO
2704C========================================================================
2705 CLOSE(unit=iusc1)
2706 CLOSE(unit=iusc2)
2707 CALL delete_user_file(iusc1_fn,len_iusc1_fn)
2708 CALL delete_user_file(iusc2_fn,len_iusc2_fn)
2709
2710 IF(ierr==0) RETURN
2711 CALL arret(0)
2712C
2713 9990 CONTINUE
2714C
2715 CALL ancmsg(msgid=73,anmode=aninfo,c1=key0(ikey))
2716 CALL arret(0)
2717 RETURN
2718
2719C-----------------------------------------------
2720 1000 CONTINUE
2721 IF (ierr1/=0) THEN
2722 WRITE(iout,*)' ** ERROR IN MEMORY ALLOCATION WHILE READING ENGINE FILE'
2723 WRITE(istdo,*)' ** ERROR IN MEMORY ALLOCATION WHILE READING ENGINE FILE'
2724 CALL arret(2)
2725 END IF
2726C-----------------------------------------------
2727
2728 END
2729
2730!||====================================================================
2731!|| ngr2usr ../engine/source/input/freform.F
2732!||--- called by ------------------------------------------------------
2733!|| lecdamp ../engine/source/input/lecdamp.F
2734!|| lecinv ../engine/source/input/lecinv.F
2735!|| lectur ../engine/source/input/lectur.F
2736!|| s10cnistat ../engine/source/elements/solid/solide10/s10cndf.F
2737!|| sms_mass_scale_2 ../engine/source/ams/sms_mass_scale_2.F
2738!|| static ../engine/source/general_controls/damping/static.F
2739!||--- uses -----------------------------------------------------
2740!|| groupdef_mod ../common_source/modules/groupdef_mod.F
2741!||====================================================================
2742 INTEGER FUNCTION ngr2usr(IU,IGRNOD,NGRNOD)
2743C-----------------------------------------------
2744C M o d u l e s
2745C-----------------------------------------------
2746 USE groupdef_mod
2747C-----------------------------------------------
2748C I m p l i c i t T y p e s
2749C-----------------------------------------------
2750#include "implicit_f.inc"
2751#include "comlock.inc"
2752C-----------------------------------------------
2753C C o m m o n B l o c k s
2754C-----------------------------------------------
2755#include "units_c.inc"
2756#include "com08_c.inc"
2757C-----------------------------------------------
2758C D u m m y A r g u m e n t s
2759C-----------------------------------------------
2760 INTEGER iu,ngrnod
2761C-----------------------------------------------
2762 TYPE (group_) , DIMENSION(NGRNOD) :: igrnod
2763C-----------------------------------------------
2764C L o c a l V a r i a b l e s
2765C-----------------------------------------------
2766 INTEGER i, ie
2767C-----------------------------------------------
2768C S o u r c e L i n e s
2769C-----------------------------------------------
2770 IF(iu==0)THEN
2771 ngr2usr=0
2772 RETURN
2773 ENDIF
2774 DO i=1,ngrnod
2775 ie=igrnod(i)%ID
2776 IF(ie==iu)THEN
2777 ngr2usr=i
2778 RETURN
2779 ENDIF
2780 ENDDO
2781 tstop = tt
2782#include "lockon.inc"
2783 WRITE(iout,*) ' ** ERROR ** : NODE GROUP',iu,' NOT FOUND'
2784 WRITE(istdo,*) ' ** ERROR ** : NODE GROUP',iu,' NOT FOUND'
2785 ngr2usr=0
2786#include "lockoff.inc"
2787 RETURN
2788 END
2789C
2790!||====================================================================
2791!|| fretitl ../engine/source/input/freform.F
2792!||--- called by ------------------------------------------------------
2793!|| genh3d ../engine/source/output/h3d/h3d_results/genh3d.F
2794!|| w_gr_entity ../engine/source/output/restart/w_gr_entity.F
2795!|| w_line_str ../engine/source/output/restart/w_line_str.F
2796!|| w_subset_str ../engine/source/output/restart/w_subset_str.F
2797!|| w_surf_str ../engine/source/output/restart/w_surf_str.F
2798!|| write_sensors ../engine/source/output/restart/write_sensors.F
2799!||====================================================================
2800 SUBROUTINE fretitl(TITR,IASC,L)
2801C-----------------------------------------------
2802C I m p l i c i t T y p e s
2803C-----------------------------------------------
2804#include "implicit_f.inc"
2805C-----------------------------------------------
2806C D u m m y A r g u m e n t s
2807C-----------------------------------------------
2808 INTEGER,INTENT(INOUT) :: IASC(*)
2809 INTEGER,INTENT(IN) :: L
2810 CHARACTER,INTENT(IN) :: TITR*(*)
2811C-----------------------------------------------
2812C L o c a l V a r i a b l e s
2813C-----------------------------------------------
2814 INTEGER I,J,LTITR
2815C-----------------------------------------------
2816C S o u r c e L i n e s
2817C-----------------------------------------------
2818 j=1
2819 ltitr=len(titr)
2820 DO i=1,l
2821 iasc(i)= ichar(titr(j:j))*65536
2822 j = j+1
2823 IF(j>ltitr) EXIT
2824 iasc(i)= iasc(i) + ichar(titr(j:j))*256
2825 j = j+1
2826 IF(j>ltitr) EXIT
2827 iasc(i)= iasc(i) + ichar(titr(j:j))
2828 j = j+1
2829 IF(j>ltitr) EXIt
2830 ENDDO
2831C-----------------------------------------------
2832 RETURN
2833 END
2834!||====================================================================
2835!|| fretitl2 ../engine/source/input/freform.F
2836!||--- called by ------------------------------------------------------
2837!|| alloc_group_str ../engine/source/groups/alloc_group_str.F
2838!|| alloc_line_str ../engine/source/groups/alloc_line_str.F
2839!|| alloc_subset_str ../engine/source/groups/alloc_subset_str.F
2840!|| alloc_surf_str ../engine/source/groups/alloc_surf_str.F
2841!|| genani ../engine/source/output/anim/generate/genani.F
2842!|| hist1 ../engine/source/output/th/hist1.F
2843!|| outp_mt ../engine/source/output/sty/outp_mt.F
2844!|| read_sensors ../engine/source/output/restart/read_sensors.F
2845!|| thmonv ../engine/source/output/th/thmonv.F
2846!||====================================================================
2847 SUBROUTINE fretitl2(TITR,IASC,L)
2848C-----------------------------------------------
2849C I m p l i c i t T y p e s
2850C-----------------------------------------------
2851#include "implicit_f.inc"
2852C-----------------------------------------------
2853C D u m m y A r g u m e n t s
2854C-----------------------------------------------
2855 INTEGER,INTENT(IN) :: IASC(*)
2856 INTEGER,INTENT(IN) :: L
2857 CHARACTER,INTENT(INOUT) :: TITR*(*)
2858C-----------------------------------------------
2859C L o c a l V a r i a b l e s
2860C-----------------------------------------------
2861 INTEGER I,J,LTITR
2862C-----------------------------------------------
2863C S o u r c e L i n e s
2864C-----------------------------------------------
2865 j=1
2866 ltitr=len(titr)
2867 DO i=1,l
2868 titr(j:j)=char(iasc(i)/65536)
2869 j=j+1
2870 IF(j>ltitr) EXIT
2871 titr(j:j)=char(mod(iasc(i),65536)/256)
2872 j=j+1
2873 IF(j>ltitr) EXIT
2874 titr(j:j)=char(mod(iasc(i),256))
2875 j=j+1
2876 IF(j>ltitr) EXIT
2877 ENDDO
2878C-----------------------------------------------
2879 RETURN
2880 END
2881!||====================================================================
2882!|| fretitlr ../engine/source/input/freform.F
2883!||====================================================================
2884 SUBROUTINE fretitlr(TITR,ASC,L)
2885C-----------------------------------------------
2886C I m p l i c i t T y p e s
2887C-----------------------------------------------
2888#include "implicit_f.inc"
2889C-----------------------------------------------
2890C D u m m y A r g u m e n t s
2891C-----------------------------------------------
2892 my_real,INTENT(INOUT) :: asc(*)
2893 INTEGER,INTENT(IN) :: L
2894 CHARACTER,INTENT(IN) :: TITR*(*)
2895C-----------------------------------------------
2896C L o c a l V a r i a b l e s
2897C-----------------------------------------------
2898 INTEGER I,J,LTITR
2899C-----------------------------------------------
2900C S o u r c e L i n e s
2901C-----------------------------------------------
2902 j=1
2903 ltitr=len(titr)
2904 DO i=1,l
2905 asc(i)= ichar(titr(j:j))*65536
2906 j = j+1
2907 IF(j>ltitr) EXIT
2908 asc(i)= asc(i) + ichar(titr(j:j))*256
2909 j = j+1
2910 IF(j>ltitr) EXIT
2911 asc(i)= asc(i) + ichar(titr(j:j))
2912 j = j+1
2913 IF(j>ltitr) EXIT
2914 ENDDO
2915C-----------------------------------------------
2916 RETURN
2917 END
2918!||====================================================================
2919!|| fretitl2r ../engine/source/input/freform.F
2920!||====================================================================
2921 SUBROUTINE fretitl2r(TITR,ASC,L)
2922C-----------------------------------------------
2923C I m p l i c i t T y p e s
2924C-----------------------------------------------
2925#include "implicit_f.inc"
2926C-----------------------------------------------
2927C D u m m y A r g u m e n t s
2928C-----------------------------------------------
2929 my_real,INTENT(IN) :: asc(*)
2930 INTEGER,INTENT(IN) :: L
2931 CHARACTER,INTENT(INOUT) :: TITR*(*)
2932C-----------------------------------------------
2933C L o c a l V a r i a b l e s
2934C-----------------------------------------------
2935 INTEGER I,J,LTITR
2936C-----------------------------------------------
2937C S o u r c e L i n e s
2938C-----------------------------------------------
2939 j=1
2940 ltitr=len(titr)
2941 DO i=1,l
2942 titr(j:j)=char(nint(asc(i))/65536)
2943 j=j+1
2944 IF(j>ltitr) EXIT
2945 titr(j:j)=char(mod(nint(asc(i)),65536)/256)
2946 j=j+1
2947 IF(j>ltitr) EXIT
2948 titr(j:j)=char(mod(nint(asc(i)),256))
2949 j=j+1
2950 IF(j>ltitr) EXIT
2951 ENDDO
2952C-----------------------------------------------
2953 RETURN
2954 END
my_real
#define my_real
Definition cppsort.cpp:32
eig
subroutine eig(k_diag, k_lt, iadk, jdik, ms, in, nddl, ndof, nnzl, x, d, v, a, bufel, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, pm, geo, cont, icut, skew, xcut, fint, itab, fext, fopt, anin, lpby, npby, nstrf, rwbuf, nprw, tani, elbuf_tab, matparam_tab, dd_iad, fr_iad, dd_front, cluster, weight, eani, ipart, rby, nom_opt, igrsurf, bufsf, idata, rdata, bufmat, bufgeo, kxx, ixx, kxsp, ixsp, nod2sp, spbuf, ixs10, ixs20, ixs16, vr, monvol, volmon, ipm, igeo, iparg, eigipm, eigibuf, eigrpm, ldiag, ljdik, ljdik2, ikc, maxncv, thke, nms, nint2, iint2, ipari, intbuf_tab, nodglob, iad_elem, fr_elem, fr_sec, fr_rby2, iad_rby2, fr_wall, inloc, iddl, partsav, fncont, ftcont, temp, err_thk_sh4, err_thk_sh3, irbe2, irbe3, lrbe2, lrbe3, fr_rbe2, fr_rbe3m, iad_rbe2, weight_md, fcluster, mcluster, xfem_tab, w, nv46, nercvois, nesdvois, lercvois, lesdvois, crkedge, indx_crk, xedge4n, xedge3n, stack, sph2sol, stifn, stifr, drape_q4, drape_t3, h3d_data, subset, igrnod, fcont_max, fncontp2, ftcontp2, ale_connectivity, glob_therm)
Definition eig.F:73
fretitlr
subroutine fretitlr(titr, asc, l)
Definition freform.F:2885
fretitl2r
subroutine fretitl2r(titr, asc, l)
Definition freform.F:2922
fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:2801
freform
subroutine freform(irunn, irfl, irfe, h3d_data, flag_cst_ams, dynain_data, sensors, dt, output, glob_therm)
Definition freform.F:88
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:2848
ngr2usr
integer function ngr2usr(iu, igrnod, ngrnod)
Definition freform.F:2743
errmsg
subroutine errmsg(key)
Definition errmsg.F:40
fraleonoff
subroutine fraleonoff(ikad, key0, kaleonoff, nbaleonoff)
Definition fraleonoff.F:34
fralnk2
subroutine fralnk2(ikad, key0, kalelink, nalelk)
Definition fralnk.F:178
fralnk
subroutine fralnk(ikad, key0, kvel, nalelk)
Definition fralnk.F:38
freabf
subroutine freabf(ikad, key0, kabf, abfile, nabfile, cpt)
Definition freabf.F:36
freanim
subroutine freanim(output, ikad, key0, kanim, sensors)
Definition freanim.F:43
frebcs
subroutine frebcs(ikad, key0, kbcs, kbcsr, nbcs1, nbcs2, bcs_sk_fr)
Definition frebcs.F:37
frecpl
subroutine frecpl(ikad, key0, kcpl)
Definition frecpl.F:37
fredamp
subroutine fredamp(ikad, key0, kdamp, ndamp)
Definition fredamp.F:35
fredebug
subroutine fredebug(ikad, key0, kdebug)
Definition fredebug.F:35
fredynain
subroutine fredynain(ikad, key0, kdynain, dynain_data)
Definition fredynain.F:38
freeig
subroutine freeig(ikad, key0, keig, neigoff)
Definition freeig.F:35
freflw
subroutine freflw(ikad, key0, kflsec, nsflsw, ntflsw)
Definition freflw.F:35
frefunc
subroutine frefunc(ikad, key0, kfunc, nfct)
Definition frefunc.F:35
frefvbag
subroutine frefvbag(ikad, key0, kfvbag)
Definition frefvbag.F:35
frefxinp
subroutine frefxinp(ikad, key0, kfxinp, nfxinp)
Definition frefxinp.F:35
freimpl
subroutine freimpl(ikad, key0, kimpl)
Definition freimpl.F:41
freiniv
subroutine freiniv(ikad, key0, kiniv, niniv)
Definition freiniv.F:37
freint
subroutine freint(ikad, key0, kinter, nintch, invers, intch_ifop, intch_itop)
Definition freint.F:36
frelnk
subroutine frelnk(ikad, key0, kvel, nrlink, vel_sk_fr)
Definition frelnk.F:38
frenois
subroutine frenois(ikad, key0, knoise)
Definition frenois.F:37
freoutp
subroutine freoutp(ikad, key0, koutp, sensors)
Definition freoutp.F:38
frerbo
subroutine frerbo(ikad, key0, krbody, nrbynf)
Definition frerbo.F:35
frestat
subroutine frestat(ikad, key0, kstatf, sensors, output)
Definition frestat.F:41
frethermal
subroutine frethermal(ikad, key0, kthermal, glob_therm)
Definition frethermal.F:36
freupwind
subroutine freupwind(ikad, key0, kupwm)
Definition freupwind.F:36
freupwm
subroutine freupwm(ikad, key0, kupwm)
Definition freupwm.F:38
h3d_ini
subroutine h3d_ini(h3d_data, kh3d, nslash)
Definition h3d_ini.F:31
h3d_read
subroutine h3d_read(ikad, key0, kh3d, nslash, h3d_data, sensors)
Definition h3d_read.F:42
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
ale_mod
Definition ale_mod.F:150
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:253
alemuscl_mod
Definition alemuscl_mod.F:55
alemuscl_mod::alemuscl_param
type(alemuscl_param_) alemuscl_param
Definition alemuscl_mod.F:76
check_mod
Definition check_mod.F:34
dt_mod
Definition dt_mod.F:80
fvbag_mod
Definition fvbag_mod.F:44
fvbag_mod::num_opt_dt_fvmbag_2
integer num_opt_dt_fvmbag_2
Definition fvbag_mod.F:200
fvbag_mod::num_opt_dt_fvmbag_3
integer num_opt_dt_fvmbag_3
Definition fvbag_mod.F:201
fvbag_mod::fvmbag_input_options
type(fvmbag_input_options_), dimension(:), allocatable fvmbag_input_options
Definition fvbag_mod.F:196
fvbag_mod::num_opt_dt_fvmbag_1
integer num_opt_dt_fvmbag_1
Definition fvbag_mod.F:199
fvbag_mod::num_opt_dt_fvmbag
integer num_opt_dt_fvmbag
Definition fvbag_mod.F:197
fvbag_mod::num_opt_dt_fvmbag_0
integer num_opt_dt_fvmbag_0
Definition fvbag_mod.F:198
groupdef_mod
Definition groupdef_mod.F:668
h3d_mod
Definition h3d_mod.F:311
message_mod
Definition message_mod.F:1257
metric_mod
Definition metric_mod.F:42
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::ncharline100
integer, parameter ncharline100
Definition names_and_titles_mod.F:1007
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1005
state_mod
Definition state_mod.F:54
th_mod
Definition th_mod.F:42
th_mod::th_titles
integer th_titles
Definition th_mod.F:70
nvar
integer function nvar(text)
Definition nvar.F:32
open_f_scratch_file
subroutine open_f_scratch_file(fd, acces_type, rootn, lenrootn, filn)
Definition open_tempfile.F:33
rdele
subroutine rdele(nelof, key, irec, key0)
Definition rdele.F:36
redkey0
subroutine redkey0(key0, nkey, carte, ikey, nslash)
Definition redkey0.F:33
redkey1
subroutine redkey1(key, key0, nkey, carte, ikey, ir)
Definition redkey1.F:31
redkey1_h3d
subroutine redkey1_h3d(key, key0, nkey, carte, ikey, ir)
Definition redkey1_h3d.F:31
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
arret
subroutine arret(nn)
Definition arret.F:86
groupdef_mod::group_
Definition groupdef_mod.F:706
h3d_mod::h3d_database
Definition h3d_mod.F:438
wriusc2
subroutine wriusc2(irec, nbc, key0)
Definition wriusc2.F:60