OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
freform.F File Reference
#include "implicit_f.inc"
#include "task_c.inc"
#include "units_c.inc"
#include "warn_c.inc"
#include "scr02_c.inc"
#include "scr03_c.inc"
#include "scr05_c.inc"
#include "scr06_c.inc"
#include "scr07_c.inc"
#include "scr17_c.inc"
#include "scr18_c.inc"
#include "stati_c.inc"
#include "statr_c.inc"
#include "cong1_c.inc"
#include "cong2_c.inc"
#include "chara_c.inc"
#include "scrfs_c.inc"
#include "parit_c.inc"
#include "couple_c.inc"
#include "rad2r_c.inc"
#include "timeri_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "check.inc"
#include "scr19_c.inc"
#include "ddspmd_c.inc"
#include "sms_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine freform (irunn, irfl, irfe, h3d_data, flag_cst_ams, dynain_data, sensors, dt, output, glob_therm)
integer function ngr2usr (iu, igrnod, ngrnod)
subroutine fretitl (titr, iasc, l)
subroutine fretitl2 (titr, iasc, l)
subroutine fretitlr (titr, asc, l)
subroutine fretitl2r (titr, asc, l)

Function/Subroutine Documentation

◆ freform()

subroutine freform ( integer irunn,
integer irfl,
integer irfe,
type(h3d_database), intent(inout) h3d_data,
integer flag_cst_ams,
type (dynain_database), intent(inout) dynain_data,
type (sensors_), intent(inout) sensors,
type (dt_), intent(inout) dt,
type(output_), intent(inout) output,
type (glob_therm_), intent(inout) glob_therm )
Parameters
[in,out]outputoutput structure

Definition at line 86 of file freform.F.

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 ELSE
581 dtin=zero
582 dtmx=ep30
583 ENDIF
584C--------------------
585C /FLSEC
586C--------------------
587 nsflsw=0
588 ikey=kflsec
589 IF(ikad(ikey)/=ikad(ikey+1))THEN
590 k=0
591 110 READ(iusc1,rec=ikad(ikey)+k,fmt='(49X,I10)',err=9990)nbc
592 k=k+nbc+1
593 nsflsw=nsflsw+1
594 IF(ikad(ikey)+k/=ikad(ikey+1))GO TO 110
595 ENDIF
596C--------------------
597C /FUNCT
598C--------------------
599 nfct=0
600 ikey=kfunc
601 IF(ikad(ikey)/=ikad(ikey+1))THEN
602 k=0
603 140 READ(iusc1,rec=ikad(ikey)+k,fmt='(49X,I10)',
604 . err=9990)nbc
605 k=k+nbc+1
606 nfct=nfct+1
607 IF(ikad(ikey)+k/=ikad(ikey+1))GO TO 140
608 ENDIF
609C-----------------------
610C //
611C-----------------------
612 ikey=kproc
613 IF(ikad(ikey)/=ikad(ikey+1))THEN
614 ENDIF
615C-----------------------
616C /KEREL (KINETIC ENERGY RELAXATION)
617C-----------------------
618 istat = 0
619 istatg = 0
620 ikey=kkerel
621c------- add T_START,T_STOP
622 tst_start = zero
623 tst_stop = zero
624 IF(ikad(ikey)/=ikad(ikey+1))THEN
625 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)k4
626 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
627 IF(k4==1)THEN
628 READ(iusc2,*)istatg
629 CALL wriusc2(ikad(ikey)+2,1,key0(ikey))
630 ENDIF
631 READ(iusc2,*,err=310,END=320)TST_START ,tst_stop
632 GOTO 320
633 310 READ(iusc2,*,err=320,END=320)tst_start
634 320 CONTINUE
635 beta = zero
636 period = zero
637 istat=2
638 ENDIF
639C-----------------------
640C /DYREL (DYNAMIC RELAXATION)
641C-----------------------
642 ikey=kdyrel
643 IF(ikad(ikey)/=ikad(ikey+1))THEN
644 IF(istat==0)istat=1
645 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
646 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)k4
647 IF(k4==1)THEN
648 READ(iusc2,*)istatg
649 CALL wriusc2(ikad(ikey)+2,1,key0(ikey))
650 ENDIF
651 READ(iusc2,*)beta,period
652 ENDIF
653 istatg = -iabs(istatg)
654 IF (beta==zero) beta=one
655 IF(period/=zero)THEN
656 betate = beta / period
657 ELSE
658 betate = zero
659 ENDIF
660C-----------------------
661C /ADYREL (ADAPTATIVE DYNAMIC RELAXATION)
662C-----------------------
663 ikey=kadyrel
664 IF(ikad(ikey)/=ikad(ikey+1))THEN
665 istatg = 0
666 freq_c =zero
667 tst_start = zero
668 tst_stop = zero
669 READ(iusc1,rec=ikad(ikey),fmt='(7X,A)',err=9990)key2
670 READ(iusc1,rec=ikad(ikey),fmt='(49X,I10)',err=9990) nbc
671 IF (nbc > 0) THEN
672 READ(iusc1,rec=ikad(ikey)+1,fmt='(A)',err=520)key3
673 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
674 IF (key2=='FREQ_') THEN
675 READ(iusc2,*)freq_c
676 READ(iusc1,rec=ikad(ikey)+2,fmt='(A)',err=520)key2
677 CALL wriusc2(ikad(ikey)+2,1,key0(ikey))
678 ELSE
679 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)k4
680 IF(k4==1)THEN
681 READ(iusc2,*)istatg
682 READ(iusc1,rec=ikad(ikey)+2,fmt='(A)',err=520)key2
683 CALL wriusc2(ikad(ikey)+2,1,key0(ikey))
684 ENDIF
685 END IF
686 READ(iusc2,*,err=510,END=520)TST_START ,tst_stop
687 GOTO 520
688 510 READ(iusc2,*,err=520,END=520)tst_start
689 520 CONTINUE
690 ENDIF ! NBC
691 beta=one
692 period = zero
693 betate = zero
694 istat=3
695 istatg = -iabs(istatg)
696 ENDIF
697C-----------------------
698C /ALESUB (ALE SUB-CYCLING, OBSOLETE)
699C-----------------------
700 ale%SUB%IALESUB = 0
701 ikey=kalesub
702 IF(ikad(ikey)/=ikad(ikey+1))THEN
703 ale%SUB%IALESUB=2
704 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
705 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)k4
706 IF(k4==1)ale%SUB%IALESUB=1
707 READ(iusc2,*)ale%SUB%DTFSUB,ale%SUB%DTMSUB
708 ENDIF
709 IF(ale%SUB%DTFSUB==zero)ale%SUB%DTFSUB=zep9
710 IF (ale%SUB%IALESUB==1) THEN
711 CALL ancmsg(msgid=197,anmode=aninfo)
712 ierr=ierr+1
713 ENDIF
714
715C-----------------------
716C /STOP
717C-----------------------
718 ! Initialize SENSORS Write variables
719 sensors%STOP_NSANIM = 0
720 sensors%STOP_NSTH= 0
721 sensors%STOP_NSSTAT = 0
722 sensors%STOP_NSOUTP = 0
723 sensors%STOP_NSABF = 0
724 sensors%STOP_NSH3D = 0
725
726 ikey=kstop
727c
728 IF (ikad(ikey)/=ikad(ikey+1))THEN
729 k=0
730 1150 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,37X,I10)',err=9990)key2,nbc
731 k=k+1
732 IF (key2=='LSENS')THEN ! IF STOP BASED ON SENSOR ACTIVATION
733c First line
734 DO i=1,nbc-1
735 READ(iusc1,rec=ikad(ikey)+k,fmt='(A)',err=9990)carte
736 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
737 k = k + 1
738 READ(iusc2,*,err=9990,END=9990) (SENSORS%STOP_TMP(N),N=1,NVAR(CARTE))
739 sensors%NSTOP = sensors%NSTOP + nvar(carte)
740 ENDDO
741c Second line
742 iok_read = 0
743 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
744 READ(iusc2,*,err=148,END=148)SENSORS%STOP_NSANIM,SENSORS%STOP_NSTH,SENSORS%STOP_NSSTAT,
745 . sensors%STOP_NSOUTP,sensors%STOP_NSABF,sensors%STOP_NSH3D,nsdynanin
746 iok_read = 1
747c Ensure Backward compatibility : without NSH3D
748148 IF (iok_read == 0) THEN
749 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
750 READ(iusc2,*,err=9990,END=9990)SENSORS%STOP_NSANIM,SENSORS%STOP_NSTH,SENSORS%STOP_NSSTAT,
751 . sensors%STOP_NSOUTP,sensors%STOP_NSABF
752 ENDIF
753 k=k+1
754 ELSE
755 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
756 READ(iusc2,*,err=150,END=149)DEMXS,DMTMXS,DMNMXS,NTH,NANIM,nerr_posit
757 GOTO 151
758 149 CONTINUE
759 READ(iusc2,*,err=150,END=150)DEMXS,DMTMXS,DMNMXS,NTH,nanim
760 GOTO 151
761 150 CONTINUE
762 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
763 READ(iusc2,*)demxs,dmtmxs,dmnmxs
764 151 CONTINUE
765 k=k+nbc
766 ENDIF
767 IF(ikad(ikey)+k/=ikad(ikey+1))GO TO 1150
768 ENDIF
769 IF(dmtmxs==zero)dmtmxs=ep30
770 IF(dmnmxs==zero)dmnmxs=ep30
771 IF(demxs==zero) demxs =ep30
772
773C-----------------------
774C /KILL
775C-----------------------
776 ikey=kkill
777 IF(ikad(ikey)/=ikad(ikey+1))THEN
778 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
779 READ(iusc2,*,err=155,END=154)
780 . demxk,dmtmxk,dmnmxk,nth,nanim,nerr_posit
781 GOTO 156
782 154 CONTINUE
783 READ(iusc2,*,err=155,END=155)DEMXK,DMTMXK,DMNMXK,NTH,nanim
784 GOTO 156
785 155 CONTINUE
786 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
787 READ(iusc2,*)demxk,dmtmxk,dmnmxk
788 156 CONTINUE
789 ENDIF
790 IF(dmtmxk==zero)dmtmxk=ep20
791 IF(dmnmxk==zero)dmnmxk=ep20
792 IF(demxk==zero) demxk =ep20
793
794C--------------------------
795C /RUN
796C--------------------------
797 IF (mcheck == 0) THEN
798 ikey=krun
799 irunn=1
800 chrun0=' '
801 IF(ikad(ikey)/=ikad(ikey+1))THEN
802 irunn=0
803 READ(iusc1,rec=ikad(ikey),fmt='(7X,A4,2X,I5,1X,A1)',err=9990)ch4,irunn,chrun0(2:2)
804 IF(chrun0(2:2)/=' ')chrun0(1:1)='_'
805 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
806 READ(iusc2,*)tstop0
807 ENDIF
808 IF (got_input == 1) THEN
809 !RUNN is -input run number,
810 !if RUNN = 0 (common starter / engine input file) RUNN is set to 1 in Engine.
811 IF (runn==0 ) runn=1
812 !IRUNN is the run number read from input.
813 !If IRUNN was set in input and is different from -input run number,than we print out a message.
814 IF (irunn /= 0)THEN
815 IF (irunn /= runn)THEN
816 WRITE(istdo,'(A,A)') ' ** WARNING ** : RUN NUMBER FOUND IN ', '/RUN CARD FROM INPUT FILE'
817 WRITE(istdo,'(A)') ' RUN NUMBER IGNORED '
818 ENDIF
819 ENDIF
820 irunn = runn
821 IF (irunn == 0) irunn = 1
822 ENDIF
823 IF(rootlen==0) THEN
824 CALL ancmsg(msgid=194,anmode=aninfo)
825 ierr=ierr+1
826 ENDIF
827 IF(irunn<=0) THEN
828 CALL ancmsg(msgid=195,anmode=aninfo)
829 ierr=ierr+1
830 irunn=1
831 ENDIF
832 ENDIF ! MCHECK == 0
833
834C--------------------------
835C /TITLE
836C--------------------------
837 ikey=ktitle
838 IF(ikad(ikey)/=ikad(ikey+1))THEN
839 READ(iusc1,rec=ikad(ikey)+1,fmt='(A)',err=9990)title
840 IF(title(1:1)=='/')title=' '
841 ELSE
842 title=' '
843 ENDIF
844 WRITE(iin,'(2A,I2.2,A)')rootnam(1:rootlen),'D',irunn,title
845 WRITE(chrun,'(I4.4)')irunn
846
847C-----------------------
848C /NEGVOL (SMSTR: INEG_V=1;STOP: INEG_V=0)
849C--------------------------------------------------------
850 ikey = knegvol
851 ineg_v = 1
852 IF(ikad(ikey)/=ikad(ikey+1))THEN
853 READ(iusc1,rec=ikad(ikey),fmt='(7X,A)',err=9990)key2
854 IF(key2(1:4)=='STOP') ineg_v = 0
855 END IF
856
857C-----------------------
858C /DTSDE
859C time step for degenerated solid element
860C----change to default; to return back use /DTSDE/OFF
861C----reput /DTSDE/OFF as default after instability issue; re-use /DTSDE if needed
862C--------------------------------------------------------
863 ikey = kdtsde
864 idts6 = 0
865 IF(ikad(ikey)/=ikad(ikey+1))THEN
866 idts6=1
867 READ(iusc1,rec=ikad(ikey),fmt='(7X,A)',err=9990)key2
868 IF(key2(1:3)=='OFF') idts6 = 0
869 END IF
870
871C--------------------
872C /DT
873C--------------------
874 ikey=kdt
875 dtfac0=zero
876 dtmin0=zero
877 intdt=0
878 idtgr(11)=0
879 kdtint=0
880 kdtsmstr=1
881C
882 tol_sms=zero
883 ncprisms=0
884 m_vs_sms=0
885C
886 idtmins_int=0
887 dtfacs_int=zero
888 dtmins_int=zero
889 glob_therm%IDT_THERM = 0
890 glob_therm%DTFACTHERM = zero
891 dt%BRICK_CST_DEFV_MIN = zero
892 dt%BRICK_CST_COL_MIN = zero
893 dt%BRICK_DEL_DEFV_MIN = zero
894 dt%BRICK_DEL_DEFV_MAX = zero
895 dt%BRICK_DEL_ASP_MAX = zero
896 dt%BRICK_DEL_COL_MIN = zero
897C
898 IF(ikad(ikey)/=ikad(ikey+1))THEN
899 k=0
900 160 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A)',err=9990)key2
901 IF(key2(1:4)=='NODA')THEN
902 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,A)', err=9990)key2,key3
903 IF(key3(1:4)/='STOP' .AND. key3(1:3)/='DEL' .AND.
904 . key3(1:3)/='CST' .AND. key3(1:3)/='SET' .AND.
905 . key3(1:4)/='KILL' .AND. key3(1:3)/='LAG' .AND.
906 . key3(1:3)/='AMS' .AND. key3(1:3)/='ALE' )THEN !ALEON hidden option to keep compatibility of DT NODA * with ALE
907 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,I5)',err=9990)key2,k4
908 ELSEIF(key3(1:3)=='DEL')THEN
909 CALL ancmsg(msgid=246,anmode=aninfo,c1='/DT/NODA/DEL')
910 ierr=ierr+1
911 ELSE
912 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,A,1X,I5)',err=9990)key2,key3,k4
913 ENDIF
914 ELSEIF(key2=='AMS')THEN
915 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,I5)',err=9990)key2,k4
916 ELSEIF(key2=='CST_A')THEN
917 ! /DT/CST_AMS -> hybride /DT/NODA/CST + /DT/AMS
918 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,I5)',err=9990)key2,k4
919 ELSEIF(key2=='GLOB')THEN
920 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,I5,1X,A)',err=9990)key2,k4,key5
921 ELSEIF(key2(1:4)=='NODE')THEN
922 CALL ancmsg(msgid=246,anmode=aninfo,c1='/DT/NODE')
923 ierr=ierr+1
924 ELSE
925 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,A,1X,I5)',err=9990)key2,key3,k4
926 END IF
927
928 k=k+1
929 IF(key2=='INTER'.AND.key3(1:2)=='V5')THEN
930 kdtint=1
931 ELSEIF(key2=='INTER'.AND.key3(1:2)=='V4')THEN
932 kdtint=0
933 ELSEIF(key2=='SMSTR'.AND.key3(1:2)=='V4') THEN
934 kdtsmstr=0
935 ELSE IF(key2=='THERM')THEN
936 glob_therm%IDT_THERM = 1
937 glob_therm%DTFACTHERM = zep9
938 IF(ikad(ikey)+k/=ikad(ikey+1))THEN
939 READ(iusc1,rec=ikad(ikey)+k,fmt='(1X,A)',err=9990)key4
940 IF(key4(1:2)/='DT') THEN
941 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
942 READ(iusc2,*,err=9990,END=9990) GLOB_THERM%dtfactherm
943 IF (glob_therm%DTFACTHERM == zero) dtfaca = zep9
944 k=k+1
945 ENDIF
946 ENDIF
947 ELSE IF(key2(1:4)=='IGEO')THEN
948 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
949 READ(iusc2,*,err=9990,END=9990)DTFACA,dtmina
950 k=k+1
951 IF(key3(1:4)=='ELEM')THEN
952 idt = 1
953 ELSEIF(key3(1:4)=='LCAR')THEN
954 idt = 2
955 ELSE
956 idt = 0
957 ENDIF
958 dtfac1(101) = dtfaca
959 dtmin1(101) = dtmina
960 idtmin(101) = idt
961
962 ELSEIF(key2(1:4)=='GLOB')THEN
963 WRITE(6,*) "/DT/GLOB is a deprecated feature"
964 CALL arret(5)
965 ELSE
966 IF(key3(1:3)=='ALE')THEN
967 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
968 iflag = 0
969 ale%GLOBAL%I_DT_NODA_ALE_ON_KEY = 0
970 READ(iusc2,*,err=9990,END=9990)iflag
971 IF(iflag==1)ale%GLOBAL%I_DT_NODA_ALE_ON_KEY = 1
972 k = k + 1
973 GOTO 2003
974 ELSEIF (key2(1:5)=='CST_A') THEN
975 dtfac_ams = zero
976 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
977 READ(iusc2,*,err=9001,END=9001) DTFACA,DTMINA,dtfac_ams
978 GOTO 9002
979 9001 CONTINUE
980 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
981 READ(iusc2,*,err=9990,END=9990) DTFACA,dtmina
982 9002 CONTINUE
983 IF (dtfaca == zero) dtfaca = zep9
984 IF (dtfac_ams == zero) dtfac_ams = zep67
985 ELSEIF(key2(1:5) == 'FVMBA')THEN
986 ! ---/DT/FVMBAG/. ---
987 ! dtfaca dtmina lambda l_type
988 ! fvbag_id
989 ierr1=0
990 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
991 READ(iusc2,'(A)',err=9990,END=9990)line
992 READ(line,*,iostat=ierr1)dtfaca,dtmina,lambda,l_type
993 IF(ierr1 /= 0)THEN
994 !l_type left blank (default 0)
995 l_type=zero
996 ierr1=0
997 READ(line,*,iostat=ierr1)dtfaca,dtmina,lambda
998 IF(ierr1 /= 0)THEN
999 !param 3 also left blank (default 0.0)
1000 lambda=zero
1001 ierr1=0
1002 ! this is minimanl input, goto to error message if reading fails
1003 READ(line,*,err=9990,END=9990)DTFACA,dtmina
1004 ENDIF
1005 ENDIF
1006 id_bag = 0
1007 IF(key3(1:1)=='2')THEN
1008 k=k+1
1009 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1010 READ(iusc2,'(A)',err=9990,END=9990)line
1011 READ(line,*,err=9990,END=9990)id_bag
1012 IF(id_bag <= 0)THEN
1013 CALL ancmsg(msgid=299,anmode=aninfo,i1=id_bag)
1014 CALL arret(0)
1015 ENDIF
1016 ENDIF
1017 ELSE
1018 ! --- /DT/NODA/CST, and others ... ---
1019 ! dtfaca dtmina percent_addmass
1020 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1021 READ(iusc2,*,err=9003,END=9003)DTFACA,DTMINA,percent_addmass
1022 ! Read of target % of added mass
1023 IF (percent_addmass > zero) idt_percent_addmass = 1
1024 GOTO 9004
1025 9003 CONTINUE
1026 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1027 READ(iusc2,*,err=9990,END=9990) DTFACA,dtmina
1028 9004 CONTINUE
1029 ENDIF
1030 k=k+1
1031C
1032 IF(key3(1:4)=='STOP')THEN
1033 idt = 1
1034 IF((key2(1:4)=='NODA').AND.(idt_percent_addmass == 1)) THEN
1035C-- case DT/NODA/STOP + % of added mass - IDTMIN set to 8
1036 idt = 8
1037 idt_percent_addmass = 2
1038 dt_stop_percent_addmass = dtmina
1039 ENDIF
1040 ELSEIF(key3(1:3)=='DEL')THEN
1041 idt = 2
1042 ELSEIF(key3(1:3)=='CST')THEN
1043 idt = 3
1044 IF((key2(1:4)=='NODA'.OR.key2(1:5)=='INTER').AND.key3(1:4)/='CST1')idt=8
1045 ELSEIF(key3(1:3)=='SET')THEN
1046 idt = 4
1047 ELSEIF(key3(1:4)=='KILL')THEN
1048 idt = 5
1049 ELSEIF(key3(1:3)=='LAG')THEN
1050 idt = 6
1051 ELSEIF(key3(1:3)=='AMS')THEN
1052 idt = 7
1053 ELSEIF(key3(1:3)=='COD')THEN
1054 idt = 3
1055 ELSE
1056 idt = 0
1057 ENDIF
1058C
1059 IF(key2=='BRICK')THEN
1060 dtfac1(1) = dtfaca
1061 dtmin1(1) = dtmina
1062 idtmin(1) = idt
1063 IF(key3(1:3)=='CST'.AND.k4==1)THEN
1064 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1065 READ(iusc2,*,err=1001,END=1001)DT%BRICK_CST_COL_MIN,
1066 . dt%BRICK_CST_DEFV_MIN
1067 GO TO 1002
1068 1001 CONTINUE
1069 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1070 READ(iusc2,*,err=9990,END=9990)DT%brick_cst_col_min
1071 1002 CONTINUE
1072 k=k+1
1073 ENDIF
1074 IF(key3(1:3)=='DEL'.AND.k4==1)THEN
1075 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1076 READ(iusc2,*,err=1003,END=1003)DT%BRICK_DEL_COL_MIN,
1077 . dt%BRICK_DEL_DEFV_MIN,
1078 . dt%BRICK_DEL_ASP_MAX,
1079 . dt%BRICK_DEL_DEFV_MAX
1080 GO TO 1004
1081 1003 CONTINUE
1082 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1083 READ(iusc2,*,err=9990,END=9990)DT%BRICK_DEL_COL_MIN,
1084 . dt%BRICK_DEL_DEFV_MIN
1085 1004 CONTINUE
1086 k=k+1
1087 ENDIF
1088 ELSEIF(key2(1:4)=='QUAD')THEN
1089 dtfac1(2) = dtfaca
1090 dtmin1(2) = dtmina
1091 idtmin(2) = idt
1092 ELSEIF(key2=='SHELL')THEN
1093 dtfac1(3) = dtfaca
1094 dtmin1(3) = dtmina
1095 idtmin(3) = idt
1096 ELSEIF(key2=='SH_3N'.OR.key2(1:4)=='SH3N')THEN
1097 dtfac1(7) = dtfaca
1098 dtmin1(7) = dtmina
1099 idtmin(7) = idt
1100 ELSEIF(key2=='TRUSS')THEN
1101 dtfac1(4) = dtfaca
1102 dtmin1(4) = dtmina
1103 idtmin(4) = idt
1104 ELSEIF(key2(1:4)=='BEAM')THEN
1105 dtfac1(5) = dtfaca
1106 dtmin1(5) = dtmina
1107 idtmin(5) = idt
1108 ELSEIF(key2=='SPRIN')THEN
1109 dtfac1(6) = dtfaca
1110 dtmin1(6) = dtmina
1111 idtmin(6) = idt
1112 ELSEIF(key2=='AIRBA')THEN
1113 dtfac1(9) = dtfaca
1114 dtmin1(9) = dtmina
1115 idtmin(9) = idt
1116 ELSEIF(key2=='INTER')THEN
1117 IF(intdt==0.and.(idt/=3.and.idt/=8.and.idt/=7))THEN
1118C if /DT/INTER/DEL is read later, then following definition can be erased
1119 dtfac1(10) = dtfaca
1120 dtmin1(10) = dtmina
1121 idtmin(10) = idt
1122 ENDIF
1123 IF(idt==2)intdt=1
1124 IF(nodadt==0.AND.(idt==3.OR.idt==8))THEN
1125C if /DT/NODA is read later, then following definition can be erased
1126 dtfac1(11) = dtfaca
1127 dtmin1(11) = dtmina
1128 idtmin(11) = idt
1129 ELSEIF(idt==7)THEN
1130 dtfacs_int = dtfaca
1131 dtmins_int = dtmina
1132 idtmins_int= 1
1133C if /DT/AMS is read later, then following definition can be erased
1134 IF(k4>=1)THEN
1135 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1136 READ(iusc2,*,err=3001,END=3001)TOL_SMS,m_vs_sms
1137 GO TO 3002
1138 3001 CONTINUE
1139 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1140 READ(iusc2,*,err=9990,END=9990)tol_sms
1141 3002 CONTINUE
1142 k=k+1
1143 ENDIF
1144 IF(k4>=2)THEN
1145 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1146 READ(iusc2,*,err=9990,END=9990)NSMSPCG,ncprisms
1147 k=k+1
1148 ENDIF
1149 ENDIF
1150 ELSEIF(key2(1:4)=='NODA' .AND. key3(1:3)/='ALE')THEN
1151 IF(idt/=7)THEN
1152 dtfac1(11) = dtfaca
1153 dtmin1(11) = dtmina
1154 idtmin(11) = idt
1155 idtgr(11) = 0
1156 IF ((idt == 8).OR.(idt == 3)) dt_ctrl_compatibility(1) = 1
1157 IF(k4==1)THEN
1158 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1159 READ(iusc2,*,err=9990,END=9990)IDTGR(11)
1160 idtgr(11) = -idtgr(11)
1161 k=k+1
1162 ENDIF
1163 ELSE
1164 dtfacs = dtfaca
1165 dtmins = dtmina
1166 idtmins= 1
1167 tol_sms = zero
1168 nsmspcg = 0
1169 ncprisms= 0
1170 IF(k4>=1)THEN
1171 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1172 READ(iusc2,*,err=100,END=100)IDTGRX,tol_sms
1173 idtgrs = -idtgrx
1174 GO TO 101
1175 100 CONTINUE
1176 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1177 READ(iusc2,*,err=9990,END=9990)tol_sms
1178 101 CONTINUE
1179 k=k+1
1180 ENDIF
1181 IF(k4>=2)THEN
1182 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1183 READ(iusc2,*,err=9990,END=9990)NSMSPCG,ncprisms
1184 k=k+1
1185 ENDIF
1186 END IF
1187 nodadt = 1
1188 ELSEIF(key2(1:5)=='SPCEL'.OR.key2(1:5)=='SPHCE')THEN
1189 dtfac1(51) = dtfaca
1190 dtmin1(51) = dtmina
1191 idtmin(51) = idt
1192 ELSEIF(key2(1:5)=='FVMBA') THEN
1193 IF(key3(1:1)=='0')THEN
1194 id_dt_option = 0
1195 dtfac1(52) = dtfaca
1196 dtmin1(52) = dtmina
1197 idtmin(52) = id_dt_option
1198 ELSEIF(key3(1:1)=='1')THEN
1199 id_dt_option = 1
1200 dtfac1(52) = dtfaca
1201 dtmin1(52) = dtmina
1202 idtmin(52) = id_dt_option
1203 ELSEIF(key3(1:1)=='2')THEN
1204 id_dt_option = 2
1205 !option requires an airbag_id.
1206 ELSE
1207 id_dt_option = 1
1208 dtfac1(52) = dtfaca
1209 dtmin1(52) = dtmina
1210 idtmin(52) = id_dt_option
1211 ENDIF
1212
1213 lambda = max(zero, lambda)
1214 fvmbag_l_type = int(l_type)
1215 fvmbag_l_type = min(fvmbag_l_type,2) !input check:upper bound
1216 fvmbag_l_type = max(0,fvmbag_l_type) !input check:lower bound
1217 !storing in temporary data structure. It will be used to fill the final data structure when restart file is read (not yet allocated)
1218 IF(id_dt_option == 0)num_opt_dt_fvmbag_0 = num_opt_dt_fvmbag_0 + 1
1219 IF(id_dt_option == 1)num_opt_dt_fvmbag_1 = num_opt_dt_fvmbag_1 + 1
1220 IF(id_dt_option == 2)num_opt_dt_fvmbag_2 = num_opt_dt_fvmbag_2 + 1
1221 IF(id_dt_option == 3)num_opt_dt_fvmbag_3 = num_opt_dt_fvmbag_3 + 1
1222 num_opt_dt_fvmbag = num_opt_dt_fvmbag + 1
1223 fvmbag_input_options(num_opt_dt_fvmbag)%CFL_COEF = dtfaca
1224 fvmbag_input_options(num_opt_dt_fvmbag)%DTMIN = dtmina
1225 fvmbag_input_options(num_opt_dt_fvmbag)%LAMBDA = lambda
1226 fvmbag_input_options(num_opt_dt_fvmbag)%ID_BAG = id_bag
1227 fvmbag_input_options(num_opt_dt_fvmbag)%L_type = fvmbag_l_type
1228 fvmbag_input_options(num_opt_dt_fvmbag)%ID_DT_OPTION = id_dt_option
1229 !Input check is done later in rdresb.F>FVRREST once all keywords are finished to be read & before deallocating (FVMBAG_INPUT_OPTIONS)
1230
1231 ELSEIF(key2(1:3)=='AMS')THEN
1232 dt_ctrl_compatibility(2) = 1
1233 dtfacs = dtfaca
1234 dtmins = dtmina
1235 idtmins = 2
1236 tol_sms = zero
1237 nsmspcg = 0
1238 ncprisms= 0
1239C
1240 IF(k4>=1)THEN
1241 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1242 READ(iusc2,*,err=2001,END=2001)TOL_SMS,m_vs_sms
1243 GO TO 2002
1244 2001 CONTINUE
1245 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1246 READ(iusc2,*,err=9990,END=9990)tol_sms
1247 2002 CONTINUE
1248 k=k+1
1249 ENDIF
1250 IF(k4>=2)THEN
1251 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1252 READ(iusc2,*,err=9990,END=9990)NSMSPCG,ncprisms
1253 k=k+1
1254 ENDIF
1255 ELSEIF(key2(1:5)=='CST_A')THEN
1256C-- hybrid case CST_AMS : /DT/NODA/CST + /DT/AMS
1257 dt_ctrl_compatibility(3) = 1
1258C Set of /DT/NODA/CST
1259 dtfac1(11) = dtfaca
1260 dtmin1(11) = dtmina
1261 idtmin(11) = 8
1262 idtgr(11) = 0
1263 nodadt = 1
1264C Set of /DT/AMS
1265 dtfacs = dtfac_ams
1266 dtmins = dtmina
1267 idtmins = 2
1268 tol_sms = zero
1269 nsmspcg = 0
1270 ncprisms= 0
1271C
1272 flag_cst_ams = 1
1273C
1274 IF(k4>=1)THEN
1275 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1276 READ(iusc2,*,err=2011,END=2011)TOL_SMS,m_vs_sms
1277 GO TO 2012
1278 2011 CONTINUE
1279 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1280 READ(iusc2,*,err=9990,END=9990)tol_sms
1281 2012 CONTINUE
1282 k=k+1
1283 ENDIF
1284 IF(k4>=2)THEN
1285 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1286 READ(iusc2,*,err=9990,END=9990)NSMSPCG,ncprisms
1287 k=k+1
1288 ENDIF
1289 ELSEIF(key2(1:3)=='ALE'.OR. key2(1:4)=='EULER')THEN
1290 dtfac1(102) = dtfaca
1291 dtmin1(102) = dtmina
1292 idtmin(102) = idt
1293 If(ale%GLOBAL%IDT_ALE==0)ale%GLOBAL%IDT_ALE = 1
1294 ELSE
1295 dtfac0=dtfaca
1296 dtmin0=dtmina
1297 ale%GLOBAL%IDT_ALE = -1
1298 ENDIF
1299 ENDIF
1300 2003 CONTINUE
1301 IF(ikad(ikey)+k/=ikad(ikey+1))GO TO 160
1302 ENDIF
1303C
1304C Check of compatibility of time step control options - /DT/CST_AMS can not be used with /DT/AMS or /DT/NODA/CST
1305 IF (dt_ctrl_compatibility(3) == 1) THEN
1306 IF ((dt_ctrl_compatibility(1)+dt_ctrl_compatibility(2)) > 0) THEN
1307 CALL ancmsg(msgid=279,anmode=aninfo,c1=key0(ikey))
1308 CALL arret(0)
1309 ENDIF
1310 ENDIF
1311C AMS is not compatible with thermal time step
1312 IF (glob_therm%IDT_THERM == 1.AND.idtmins/=0) THEN
1313 CALL ancmsg(msgid=301,anmode=aninfo,c1=key0(ikey))
1314 CALL arret(0)
1315 ENDIF
1316C
1317 ! Copy nodal timestep flag into DT data structure
1318 dt%NODADT = nodadt
1319C
1320C--------------------------
1321C /DT1
1322C--------------------------
1323 ikey=kdt1
1324 idt1sh = 0
1325 idt1sol= 0
1326 IF(ikad(ikey)/=ikad(ikey+1))THEN
1327 k=0
1328 161 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,A,1X,I5)', err=9990)key2,key3,k4
1329 k=k+1
1330 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1331 READ(iusc2,*,err=9990,END=9990)DTFACA,dtmina
1332 k=k+1
1333 IF(key3(1:4)=='STOP')THEN
1334 idt = 1
1335 ELSEIF(key3(1:3)=='DEL')THEN
1336 idt = 2
1337 ELSEIF(key3(1:3)=='CST')THEN
1338 idt = 3
1339 ELSEIF(key3(1:4)=='KILL')THEN
1340 idt = 5
1341 ELSE
1342 idt = 0
1343 ENDIF
1344 IF(key2=='SHELL')THEN
1345 idt1sh = 1
1346 dtfac1(3) = dtfaca
1347 dtmin1(3) = dtmina
1348 idtmin(3) = idt
1349 ELSEIF(key2=='BRICK')THEN
1350 idt1sol= 1
1351 dtfac1(1) = dtfaca
1352 dtmin1(1) = dtmina
1353 idtmin(1) = idt
1354 IF(key3(1:3)=='CST'.AND.k4==1)THEN
1355 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1356 READ(iusc2,*,err=1101,END=1101)DT%BRICK_CST_COL_MIN,
1357 . dt%BRICK_CST_DEFV_MIN
1358 GO TO 1102
1359 1101 CONTINUE
1360 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1361 READ(iusc2,*,err=9990,END=9990)DT%brick_cst_col_min
1362 1102 CONTINUE
1363 k=k+1
1364 ENDIF
1365 IF(key3(1:3)=='DEL'.AND.k4==1)THEN
1366 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1367 READ(iusc2,*,err=1103,END=1103)DT%BRICK_DEL_COL_MIN,
1368 . dt%BRICK_DEL_DEFV_MIN,
1369 . dt%BRICK_DEL_ASP_MAX,
1370 . dt%BRICK_DEL_DEFV_MAX
1371 GO TO 1104
1372 1103 CONTINUE
1373 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
1374 READ(iusc2,*,err=9990,END=9990)DT%BRICK_DEL_COL_MIN,
1375 . dt%BRICK_DEL_DEFV_MIN
1376 1104 CONTINUE
1377 k=k+1
1378 ENDIF
1379 ELSE
1380 idt1sh = 1
1381 idt1sol= 1
1382 dtfac0=dtfaca
1383 dtmin0=dtmina
1384 ENDIF
1385 IF(ikad(ikey)+k/=ikad(ikey+1))GO TO 161
1386 ENDIF
1387 CALL init_idel_brick(dt)
1388C--------------------------
1389C /TFILE
1390C--------------------------
1391 ittyp = 0
1392 ikey=ktfile
1393 IF(ikad(ikey)/=ikad(ikey+1))THEN
1394 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)ittyp
1395 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
1396 READ(iusc2,*,err=9990,END=9990)dthis0
1397 ELSE
1398 ittyp=0
1399 dthis0=ep30
1400 ENDIF
1401
1402C--------------------------
1403C /ATFIL
1404C--------------------------
1405 ikey=katfil
1406 IF(ikad(ikey)/=ikad(ikey+1))THEN
1407 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)aform(1)
1408 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
1409 READ(iusc2,*,err=9990,END=9990)DTHIS01(1)
1410 ELSE
1411 dthis01(1)=ep30
1412 output%TH%THIS1(1)= ep30
1413 ENDIF
1414
1415C--------------------------
1416C /BTFIL
1417C--------------------------
1418 ikey=kbtfil
1419 IF(ikad(ikey)/=ikad(ikey+1))THEN
1420 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)aform(2)
1421 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
1422 READ(iusc2,*,err=9990,END=9990)DTHIS01(2)
1423 ELSE
1424 dthis01(2)=ep30
1425 output%TH%THIS1(2)=ep30
1426 ENDIF
1427
1428C--------------------------
1429C /CTFIL
1430C--------------------------
1431 ikey=kctfil
1432 IF(ikad(ikey)/=ikad(ikey+1))THEN
1433 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)aform(3)
1434 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
1435 READ(iusc2,*,err=9990,END=9990)DTHIS01(3)
1436 ELSE
1437 dthis01(3)=ep30
1438 output%TH%THIS1(3)=ep30
1439 ENDIF
1440
1441C--------------------------
1442C /DTFIL
1443C--------------------------
1444 ikey=kdtfil
1445 IF(ikad(ikey)/=ikad(ikey+1))THEN
1446 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)aform(4)
1447 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
1448 READ(iusc2,*,err=9990,END=9990)DTHIS01(4)
1449 ELSE
1450 dthis01(4)=ep30
1451 output%TH%THIS1(4)=ep30
1452 ENDIF
1453
1454C--------------------------
1455C /ETFIL
1456C--------------------------
1457 ikey=ketfil
1458 IF(ikad(ikey)/=ikad(ikey+1))THEN
1459 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)aform(5)
1460 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
1461 READ(iusc2,*,err=9990,END=9990)DTHIS01(5)
1462 ELSE
1463 dthis01(5)=ep30
1464 output%TH%THIS1(5)=ep30
1465 ENDIF
1466
1467C--------------------------
1468C /KTFIL
1469C--------------------------
1470 ikey=kftfil
1471 IF(ikad(ikey)/=ikad(ikey+1))THEN
1472 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)aform(6)
1473 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
1474 READ(iusc2,*,err=9990,END=9990)DTHIS01(6)
1475 ELSE
1476 dthis01(6)=ep30
1477 output%TH%THIS1(6)=ep30
1478 ENDIF
1479
1480C--------------------------
1481C /GTFIL
1482C--------------------------
1483 ikey=kgtfil
1484 IF(ikad(ikey)/=ikad(ikey+1))THEN
1485 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)aform(7)
1486 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
1487 READ(iusc2,*,err=9990,END=9990)DTHIS01(7)
1488 ELSE
1489 dthis01(7)=ep30
1490 output%TH%THIS1(7)=ep30
1491 ENDIF
1492
1493C--------------------------
1494C /HTFIL
1495C--------------------------
1496 ikey=khtfil
1497 IF(ikad(ikey)/=ikad(ikey+1))THEN
1498 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)aform(8)
1499 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
1500 READ(iusc2,*,err=9990,END=9990)DTHIS01(8)
1501 ELSE
1502 dthis01(8)=ep30
1503 output%TH%THIS1(8)=ep30
1504 ENDIF
1505
1506C--------------------------
1507C /ITFIL
1508C--------------------------
1509 ikey=kitfil
1510 IF(ikad(ikey)/=ikad(ikey+1))THEN
1511 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)aform(9)
1512 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
1513 READ(iusc2,*,err=9990,END=9990)DTHIS01(9)
1514 ELSE
1515 dthis01(9)=ep30
1516 output%TH%THIS1(9)=ep30
1517 ENDIF
1518
1519C--------------------------
1520C /TH
1521C--------------------------
1522 ikey=kth
1523 th_vers=40
1524 IF(ikad(ikey)/=ikad(ikey+1))THEN
1525 k=0
1526 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
1527 k=k+1
1528 IF(key2(1:4)=='VERS')THEN
1529 READ(key3,'(I4)')th_vers
1530 ELSEIF(key2(1:5)=='TITLE')THEN
1531 th_titles = 1
1532 ELSE
1533 GOTO 9990
1534 ENDIF
1535 IF (th_vers<40) THEN
1536 CALL ancmsg(msgid=198,anmode=aninfo)
1537 ierr=ierr+1
1538 ENDIF
1539 k=k+nbc
1540 IF(ikad(ikey)+k/=ikad(ikey+1))GO TO 1160
1541 ENDIF
1542
1543C--------------------------
1544C /PRINT
1545C--------------------------
1546 ikey=kprint
1547 IF(ikad(ikey)/=ikad(ikey+1))THEN
1548 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5,X,I5)',err=9990)ncpri0,ncpri_head0
1549 ELSE
1550 ncpri0=-100
1551 ncpri_head0=0
1552 ENDIF
1553
1554C--------------------------
1555C /RFILE
1556C--------------------------
1557 rf_check = 0
1558 ikey=krfile
1559 IF(ikad(ikey)/=ikad(ikey+1))THEN
1560 READ(iusc1,rec=ikad(ikey),fmt='(7X,A)',err=9990) key2
1561 ! /RFILE/OFF or -norst command line --> avoid to write restart files during a run
1562 ! default = write restart files
1563 IF(key2(1:3)=='OFF') THEN
1564 restart_file = 0
1565 multirest=0
1566 ncrst=0
1567 irltyp=0
1568 iretyp=0
1569 ELSEIF(restart_file==0) THEN
1570 ! /RFILE/NCYCLE is written in the *1.rad but the user
1571 ! uses the -NORST command line
1572 multirest=0
1573 ncrst=0
1574 irltyp=0
1575 iretyp=0
1576 ELSE
1577 ! /RFILE/
1578 ! NCYCLE
1579 restart_file = 1
1580 READ(iusc1,rec=ikad(ikey),fmt='(7X,I5)',err=9990)multirest
1581 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
1582 READ(iusc2,*,err=9990,END=9990)ncrst
1583 irltyp=0
1584 iretyp=0
1585 multirest=min(multirest,26)
1586 rf_check = 1
1587 ENDIF
1588 ELSE
1589 multirest=0
1590 ncrst=0
1591 irltyp=0
1592 iretyp=0
1593 ENDIF
1594
1595 WRITE(iin,'(1P4E16.9,I8,I10,2I8)')tstop0,dthis0,dtfac0,dtmin0,ncpri0,ncrst,multirest,ncpri_head0
1596 WRITE(iin,'(1P5E16.9)')(dthis01(i), i=1,5)
1597 WRITE(iin,'(1P4E16.9)')(dthis01(i+5), i=1,4)
1598
1599c ITTYP set to 4 by default (Binary IEEE 32 bits)
1600 IF(ittyp==0) ittyp=4
1601
1602 itform=ittyp-1
1603 DO i=1,9
1604 IF (aform(i)==0) aform(i)=4
1605 aform(i)=aform(i)-1
1606 END DO
1607
1608 irfe=irform/5
1609 irfl=irform-5*irfe
1610 irform=5*irfe+irfl
1611
1612C--------------------
1613C /ALE/GRID
1614C--------------------
1615 ikey=kale
1616 alp=zero
1617 gam=zero
1618 a1=zero
1619 a2=zero
1620 a3=zero
1621 vm=zero
1622 iale_grid_form=-1
1623 num_ale_grid = 0
1624 k = 0
1625 DO WHILE (ikad(ikey) + k /= ikad(ikey + 1))
1626 READ(iusc1,rec=ikad(ikey)+k,fmt='(1X,A,1X,A,1X,A)',err=9990)key1,key2,key3
1627 IF(key1(1:3) /= 'ALE')THEN
1628 ! read next line
1629 k = k + 1
1630 cycle
1631 ENDIF
1632 IF(key2(1:4)=='GRID')THEN
1633 ! case "/ALE /GRID /....."
1634 stringale(1:5)=key3(1:5)
1635 ELSE
1636 ! case "/ALE /....." (obsolete)
1637 stringale(1:5)=key2(1:5)
1638 ENDIF
1639 CALL wriusc2(ikad(ikey)+1,1,key0(ikey))
1640 !---------------------------------------!
1641 ! '/ALE/GRID/DONEA' !
1642 !---------------------------------------!
1643 IF(stringale(1:5)=='DONEA'.OR.stringale(1:1)=='0')THEN
1644 num_ale_grid = num_ale_grid + 1
1645 iale_grid_form=0
1646 READ(iusc2,*,err=9990,END=9990)ALP,GAM,A1,A2,A3,vm
1647 !---------------------------------------!
1648 ! '/ALE/GRID/DISP' !
1649 !---------------------------------------!
1650 ELSEIF(stringale(1:4)=='DISP'.OR.stringale(1:1)=='1')THEN
1651 num_ale_grid = num_ale_grid + 1
1652 iale_grid_form=1
1653 READ(iusc2,*,err=9990,END=9990)ALP,vm !new format scale factor removed (hidden flags)
1654 gam=zero
1655 a1=one; a2=one; a3=one;
1656 !---------------------------------------!
1657 ! '/ALE/GRID/SPRING' !
1658 !---------------------------------------!
1659 ELSEIF(stringale(1:5)=='sprin.OR.'StringALE(1:1)=='2')THEN
1660 NUM_ALE_GRID = NUM_ALE_GRID + 1
1661 IALE_GRID_FORM=2
1662 READ(IUSC2,*,ERR=9990,END=9990)ALP,GAM,A1,A2,VM
1663 A3=ZERO
1664 !---------------------------------------!
1665 ! '/ale/grid/zero' !
1666 !---------------------------------------!
1667 ELSEIF(StringALE(1:4)=='zero.OR.'StringALE(1:1)=='3')THEN
1668 NUM_ALE_GRID = NUM_ALE_GRID + 1
1669 IALE_GRID_FORM=3
1670 !---------------------------------------!
1671 ! '/ale/grid/standard' !
1672 !---------------------------------------!
1673 ELSEIF(StringALE(1:5)=='stand.OR.'StringALE(1:1)=='4')THEN
1674 NUM_ALE_GRID = NUM_ALE_GRID + 1
1675 IALE_GRID_FORM=4
1676 READ(IUSC2,*,ERR=9990,END=9990)ALP,GAM,A1,A2
1677 A3=ZERO
1678 VM=ZERO
1679 !---------------------------------------!
1680 ! '/ale/grid/laplacian !
1681 !---------------------------------------!
1682 ELSEIF(stringale(1:5)=='LAPLA')THEN
1683 num_ale_grid = num_ale_grid + 1
1684 iale_grid_form=5
1685 READ(iusc2,*,err=9990,END=9990)ALP,a1
1686 IF(alp==zero)alp=one
1687 IF(nint(a1)<=zero)a1=one
1688 IF(a2/=one .AND. a2/=two)a2=one
1689 !---------------------------------------!
1690 ! '/ALE/GRID/VOLUME' !
1691 !---------------------------------------!
1692 ELSEIF(stringale(1:5)=='VOLUM')THEN
1693 num_ale_grid = num_ale_grid + 1
1694 iale_grid_form=6
1695 !---------------------------------------!
1696 ! '/ALE/GRID/MASS-WEIGHTED-VEL' !
1697 !---------------------------------------!
1698 ELSEIF(stringale(1:5)=='FLOW-')THEN
1699 num_ale_grid = num_ale_grid + 1
1700 iale_grid_form=7
1701 READ(iusc2,*,err=9990,END=9990)A1,alp
1702 CALL wriusc2(ikad(ikey)+2,1,key0(ikey))
1703 READ(iusc2,*,err=9990,END=9990)A2,gam
1704 IF(alp == zero)alp = one
1705 IF(gam == zero)gam = one
1706 IF(int(a1) == 0)a1 = 1
1707 IF(int(a1) /= 1 .AND. int(a1) /= -1)a1 = 1 !value different than expected values leads to default value
1708 IF(int(a2) == 0)a2 = 1
1709 IF(int(a2) /= 1 .AND. int(a2) /= -1)a2 = 1 !value different than expected values leads to default value
1710 !---------------------------------------!
1711 ! '/ALE/GRID/LAGRANGE' !
1712 !---------------------------------------!
1713 ELSEIF(stringale(1:5)=='LAGRA')THEN
1714 num_ale_grid = num_ale_grid + 1
1715 iale_grid_form=8
1716 ELSE
1717 !not a keyword related to grid formulation
1718 ENDIF
1719 k = k + 1
1720 ENDDO
1721 !---------------------------------------!
1722 WRITE(iin,'(1P6E10.3)')alp,gam,a1,a2,a3,vm
1723 !---------------------------------------!
1724 !defining new grid formulation
1725 IF(iale_grid_form /= -1)THEN
1726 ale%GRID%NWALE_ENGINE=iale_grid_form
1727 ELSE !nwale<0 nwale is unchanged. its value will be set to TABVINT(264) in rdcomm sub.
1728 ale%GRID%NWALE_ENGINE=-1
1729 ENDIF
1730 !---------------------------------------!
1731 IF(num_ale_grid > 1)THEN
1732 CALL ancmsg(msgid=263,anmode=aninfo)
1733 CALL arret(2)
1734 ENDIF
1735 !---------------------------------------!
1736
1737
1738
1739 !---------------------------------------!
1740 ! '/ALE/LOWMACH !
1741 !---------------------------------------!
1742 ikey = kale
1743 k = 0
1744 lowmach_opt = 0
1745 DO WHILE (ikad(ikey) + k /= ikad(ikey + 1))
1746 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,A,31X,I10)',err=9990)key2,key3,nbc
1747 !---------------------------------------!
1748 ! '/ALE/LOWMACH' !
1749 !---------------------------------------!
1750 IF (key2(1:5) == 'LOWMA') THEN
1751 lowmach_opt = 1
1752 EXIT
1753 ENDIF
1754 k = k + 1 + nbc
1755 ENDDO
1756 WRITE(iin,'(I8)') lowmach_opt
1757
1758C--------------------------
1759C /DEL
1760C--------------------------
1761 nintof=0
1762 nelsof=0
1763 nelqof=0
1764 nelcof=0
1765 neltgof=0
1766 neltof=0
1767 nelpof=0
1768 nelrof=0
1769 nsphof=0
1770 ikey=kdel
1771 ndel=0
1772 nintnof=0
1773 nintsof=0
1774 naleof=0
1775 neulerof=0
1776 nthermof=0
1777 npartof=0
1778 IF(ikad(ikey)/=ikad(ikey+1))THEN
1779 k=0
1780 200 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,A,31X,I10)',err=9990)key2,key3,nbc
1781 k3 = 0
1782 IF(key3(1:3)/='NOD'.AND.key3(1:3)/='SEG')READ(key3,fmt='(I5)',err=9990)k3
1783 k=k+1
1784 nof=0
1785 DO i=1,nbc
1786 READ(iusc1,rec=ikad(ikey)+k,fmt='(A)',err=9990)carte
1787 k=k+1
1788 nof=nof+nvar(carte)
1789 ENDDO
1790 ndel=ndel+1
1791 IF(k3==1)nof=nof/2
1792 IF(key2=='INTER'.AND.key3(1:3)=='NOD')THEN
1793 nintnof=nintnof+1
1794 ELSEIF(key2=='INTER'.AND.key3(1:3)=='SEG')THEN
1795 nintsof=nintsof+1
1796 ELSEIF(key2=='INTER')THEN
1797 nintof=nintof+nof
1798 ELSEIF(key2=='BRICK')THEN
1799 nelsof=nelsof+nof
1800 ELSEIF(key2=='QUAD ')THEN
1801 nelqof=nelqof+nof
1802 ELSEIF(key2=='SHELL')THEN
1803 nelcof=nelcof+nof
1804 ELSEIF(key2=='TRUSS')THEN
1805 neltof=neltof+nof
1806 ELSEIF(key2=='BEAM ')THEN
1807 nelpof=nelpof+nof
1808 ELSEIF(key2=='SPRIN')THEN
1809 nelrof=nelrof+nof
1810 ELSEIF(key2=='SH_3N'.OR.key2(1:4)=='SH3N')THEN
1811 neltgof=neltgof+nof
1812 ELSEIF(key2=='SPCEL'.OR.key2=='SPHCE')THEN
1813 nsphof=nsphof+nof
1814 ELSEIF(key2=='ALE ')THEN
1815 naleof=1
1816 ELSEIF(key2=='EULER')THEN
1817 neulerof=1
1818 ELSEIF(key2=='THERM')THEN
1819 nthermof=1
1820 ELSEIF(key2=='PART ')THEN
1821 npartof = npartof+nof
1822 ELSE
1823 CALL errmsg(key2)
1824 ENDIF
1825 IF(ikad(ikey)+k/=ikad(ikey+1))GO TO 200
1826 ENDIF
1827 WRITE(iin,'(10I8)')nintof,nelsof,nelqof,nelcof,neltof,nelpof,nelrof,neltgof,nintnof,nintsof
1828 WRITE(iin,'(I8)')nsphof
1829 WRITE(iin,'(4I8)')naleof,neulerof,nthermof,npartof
1830
1831C--------------------------
1832C /VEL
1833C--------------------------
1834 nrlink=0
1835 nalelk=0
1836 ikey=kvel
1837 k=0
1838 DO WHILE (ikad(ikey) + k /= ikad(ikey + 1))
1839 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,37X,I10)', err=9990)key2,nbc
1840 IF(key2=='TRA ')THEN
1841 nrlink=nrlink+1
1842 ELSEIF(key2=='ROT ')THEN
1843 nrlink=nrlink+1
1844 ELSEIF(key2=='ALE ')THEN
1845 ! /VEL/ALE (OBSOLETE, replaced with /ALE/LINK)
1846 nalelk=nalelk+1
1847 ELSE
1848 CALL errmsg(key2)
1849 ENDIF
1850 k=k+nbc+1
1851 ENDDO
1852 WRITE(iin,'(2I8)')nrlink,nalelk
1853
1854C-----------------------
1855C /ALE/LINK
1856C-----------------------
1857 ikey = kale
1858 nalelink = 0
1859 k=0
1860 DO WHILE (ikad(ikey) + k /= ikad(ikey + 1))
1861 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,A,31X,I10)',err=9990)key2,key3,nbc
1862 IF(key2(1:5)=='LINK ')THEN
1863 IF(key3(1:5)=='VEL ')THEN
1864 nalelink=nalelink+1
1865 ELSEIF(key3(1:5)=='OFF ')THEN
1866 nalelink=nalelink+1
1867 ELSEIF(key3(1:5)=='ON ')THEN
1868 nalelink=nalelink+1
1869 ELSE
1870 CALL errmsg('/ALE/LINK')
1871 ENDIF
1872 ENDIF
1873 k=k+nbc+1
1874 ENDDO
1875 WRITE(iin,'(I8)')nalelink
1876
1877C-----------------------
1878C /ALE/SUPG
1879C-----------------------
1880 ale%UPWIND%UPWM = 3
1881 ale%UPWIND%UPW_UPDATE = 0
1882 ale%UPWIND%UPWMG2 = zero
1883 ale%UPWIND%UPWOG2 = zero
1884 ale%UPWIND%UPWSM2 = zero
1885 ale%UPWIND%CUPWM = one !SUPG enabled
1886 ale%UPWIND%I_SUPG_ON_OFF = 0 !test if card is present to check user input in case of both /ALE/SUPG & /UPWM/SUPG
1887 ! 1 : ON
1888 ! 2 : OFF
1889 ikey = kale
1890 k = 0
1891 DO WHILE (ikad(ikey) + k /= ikad(ikey + 1))
1892 READ(iusc1,rec=ikad(ikey)+k,fmt='(7X,A,1X,A,31X,I10)',err=9990)key2,key3,nbc
1893 !---------------------------------------!
1894 ! '/ALE/SUPG/OFF - ON !
1895 !---------------------------------------!
1896 IF(key2(1:4)=='SUPG')THEN
1897 IF(key3(1:3)=='off')THEN
1898 ALE%UPWIND%UPWM = 0
1899 ALE%UPWIND%UPW_UPDATE = 0
1900 ALE%UPWIND%I_SUPG_ON_OFF = 2
1901 ELSEIF(KEY3(1:5)=='on')THEN
1902 ALE%UPWIND%UPWM = 3
1903 ALE%UPWIND%UPW_UPDATE = 0
1904 ALE%UPWIND%I_SUPG_ON_OFF = 1
1905 ELSE
1906 IF(N2D==1)THEN
1907 !axisymmetric case
1908 ALE%UPWIND%UPWM = 0
1909 ALE%UPWIND%UPW_UPDATE = 0
1910 ELSE
1911 !3D & 2D planar
1912 ALE%UPWIND%UPWM = 3
1913 ENDIF
1914 ALE%UPWIND%UPW_UPDATE = 0
1915 ALE%UPWIND%I_SUPG_ON_OFF = 0
1916 ENDIF
1917 ENDIF
1918 K = K + 1 + NBC
1919 ENDDO
1920
1921C-----------------------
1922C /ALE/MUSCL
1923C-----------------------
1924 ALEMUSCL_Param%I_MUSCL_OFF = 0
1925 IKEY = KALE
1926 K = 0
1927 DO WHILE (IKAD(IKEY) + K /= IKAD(IKEY + 1))
1928 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(7x,a,1x,a,31x,i10)',ERR=9990)KEY2,KEY3,NBC
1929 !---------------------------------------!
1930 ! '/ale/muscl/off' !
1931 !---------------------------------------!
1932 IF (KEY2(1:5) == 'muscl') THEN
1933 IF(KEY3(1:3)=='off')THEN
1934 ALEMUSCL_Param%I_MUSCL_OFF = 1
1935 ELSEIF(KEY3(1:2)=='on')THEN
1936 ALEMUSCL_Param%I_MUSCL_OFF = 0
1937 ALEMUSCL_Param%IALEMUSCL = 1
1938 ALEMUSCL_Param%BETA = TWO
1939 ELSE
1940 GOTO 9990
1941 ENDIF
1942 ENDIF
1943 K = K + 1 + NBC
1944 ENDDO
1945
1946C--------------------
1947C /ALE/ON /ALE/OFF
1948C--------------------
1949 IKEY = KALE
1950 NBALEOFF = 0
1951 NBALEON = 0
1952 NBPARTALEON = 0
1953 NBPARTALEOFF = 0
1954 K = 0
1955 DO WHILE (IKAD(IKEY) + K /= IKAD(IKEY + 1))
1956 READ (IUSC1, REC = IKAD(IKEY) + K, FMT = '(7x,a,37x,i10)') KEY2, NBC
1957 IF (KEY2(1:2) == 'on') THEN
1958 NBALEON = NBALEON + 1
1959 NBPARTALEON = NBPARTALEON + NBC
1960 ENDIF
1961 IF (KEY2(1:3) == 'off') THEN
1962 NBALEOFF = NBALEOFF + 1
1963 NBPARTALEOFF = NBPARTALEOFF + NBC
1964 ENDIF
1965 K = K + 1 + NBC
1966 ENDDO
1967 WRITE (IIN, '(i8, i8)') NBPARTALEON, NBPARTALEOFF
1968
1969C-----------------------
1970C /ALE/SOLVER/FINT
1971C-----------------------
1972 IKEY = KALE
1973 K = 0
1974 ALE%GLOBAL%ISFINT = 0 !not yet read communicated in engine
1975 DO WHILE (IKAD(IKEY) + K /= IKAD(IKEY + 1))
1976
1977 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(7x,a32)',ERR=9990)StringALE
1978 IF(StringALE(1:5)/='solve')EXIT
1979 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(13x,a32)',ERR=9990)StringALE
1980 IF(StringALE(1:4)/='fint')EXIT
1981 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(a)',ERR=9990)LINE
1982 READ(LINE,FMT='(7x,a5,1x,a5,1x,i5)',ERR=9990)KEY2,KEY3,IFORM
1983 IF(IFORM==2)THEN
1984 ALE%GLOBAL%ISFINT = 2 !FEM INT : surface integration
1985 ELSEIF(IFORM==1)THEN
1986 ALE%GLOBAL%ISFINT = 1 !FVM INT : volume integration
1987 ELSEIF(IFORM==3)THEN
1988 ALE%GLOBAL%ISFINT = 3 !FVM INT : volume integration
1989 ELSE
1990 !default
1991 ALE%GLOBAL%ISFINT = 1
1992 ENDIF
1993 K = K + 1
1994 ENDDO
1995
1996C--------------------
1997C /ALE : check for valid sub-keywords
1998C--------------------
1999 IKEY = KALE
2000 K = 0
2001 DO WHILE (IKAD(IKEY) + K /= IKAD(IKEY + 1))
2002 lFOUND=.FALSE.
2003 READ (IUSC1, REC = IKAD(IKEY) + K, FMT = '(a32)', ERR=998) KEYA
2004 READ (IUSC1, REC = IKAD(IKEY) + K, FMT = '(x,a5,x,a5)', ERR=998) KEY1 ,KEY2
2005 IF(KEY2(1:5)==' ')KEY2(1:1)='0'
2006 IF(KEY1(1:5)=='ale ')THEN
2007 DO INUM=1,NUM_ALE_KEY2
2008 IF (KEY2(1:5) == KEYALE(INUM)) THEN
2009 lFOUND = .TRUE.
2010 EXIT
2011 ENDIF
2012 ENDDO
2013.EQV. IF(lFOUND .FALSE.)THEN
2014 CALL ANCMSG(MSGID=51,ANMODE=ANINFO,C1=KEYA(1:12))
2015 IERR = IERR + 1
2016 ENDIF
2017 ENDIF
2018 998 CONTINUE
2019 K = K + 1
2020 ENDDO
2021
2022C--------------------
2023C /BCS
2024C--------------------
2025 NUBCS1=0
2026 NBCS1=0
2027 NBCS2=0
2028 IKEY=KBCS
2029 IF(IKAD(IKEY)/=IKAD(IKEY+1))THEN
2030 K=0
2031 400 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(7x,a,37x,i10)',ERR=9990)KEY2,NBC
2032 K=K+1
2033 DO I=1,NBC
2034 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(a)',ERR=9990)CARTE
2035 K=K+1
2036 NUBCS1=NUBCS1+NVAR(CARTE)
2037 ENDDO
2038 NBCS1 = NBCS1 + 1
2039 IF(IKAD(IKEY)+K/=IKAD(IKEY+1))GO TO 400
2040 ENDIF
2041 NUBCS2=0
2042 IKEY=KBCSR
2043 IF(IKAD(IKEY)/=IKAD(IKEY+1))THEN
2044 K=0
2045 420 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(7x,a,37x,i10)',ERR=9990)KEY2,NBC
2046 K=K+1
2047 DO I=1,NBC
2048 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(a)',ERR=9990)CARTE
2049 K=K+1
2050 NUBCS2=NUBCS2+NVAR(CARTE)
2051 ENDDO
2052 NBCS2 = NBCS2 + 1
2053 IF(IKAD(IKEY)+K/=IKAD(IKEY+1))GO TO 420
2054 ENDIF
2055 NUM_BCS=NUBCS1+NUBCS2
2056
2057C--------------------
2058C /INIV
2059C--------------------
2060 NINIV = 0
2061 NINIVT= 0
2062 IKEY=KINIV
2063 IF(IKAD(IKEY)/=IKAD(IKEY+1))THEN
2064 K=0
2065 440 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(7x,a,7x,i5,25x,i10)',ERR=9990)KEY2,K3,NBC
2066 K=K+1
2067 IF (KEY2(1:4)=="AXIS") THEN
2068 M=2
2069 ELSE
2070 M=1
2071 ENDIF
2072 K=K+M
2073 IF (K3==2) THEN
2074 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(a)',ERR=9990)CARTE
2075 ! NVAR(CARTE) should be =1
2076 K=K+1
2077 NINIVT=NINIVT+(NBC-M)*2*NVAR(CARTE)
2078 ELSE
2079 DO I=1,NBC-M
2080 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(a)',ERR=9990)CARTE
2081 K=K+1
2082 NINIVT=NINIVT+(2-K3)*NVAR(CARTE)
2083 ENDDO
2084 END IF
2085 NINIV=NINIV + 1
2086 IF(IKAD(IKEY)+K/=IKAD(IKEY+1))GO TO 440
2087 ENDIF
2088 WRITE(IIN,'(2i8)')NUM_BCS,NINIVT/2
2089
2090C--------------------
2091C /INTER
2092C--------------------
2093 NINTCH=0
2094 INTCH_IFOP = 0
2095 IFOP =1
2096 INTCH_ITOP = 0
2097 ITOP = 1
2098 NBTOPFOP = 0
2099 IKEY=KINTER
2100 IF(IKAD(IKEY)/=IKAD(IKEY+1))THEN
2101 K=0
2102 !options /inter/fop , /inter/top, /inter/nofop, /inter/notop
2103 500 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(7x,a,37x,i10)',ERR=9990)KEY2,NBC
2104 K=K+NBC+1
2105 NINTCH=NINTCH+1
2106 IF(KEY2=='fop') THEN
2107C IFOP = 1
2108 IF (INTCH_IFOP/=0) THEN
2109 GO TO 9990
2110 ELSE
2111 INTCH_IFOP=NINTCH
2112 NBTOPFOP = NBTOPFOP + 1
2113 ENDIF
2114 ELSEIF(KEY2=='nofop') THEN
2115C IFOP = 0
2116 IF (INTCH_IFOP/=0) THEN
2117 GO TO 9990
2118 ELSE
2119 INTCH_IFOP=NINTCH
2120 NBTOPFOP = NBTOPFOP + 1
2121 ENDIF
2122 ELSEIF(KEY2=='top') THEN
2123C ITOP = 1
2124 IF (INTCH_ITOP/=0) THEN
2125 GO TO 9990
2126 ELSE
2127 INTCH_ITOP=NINTCH
2128 NBTOPFOP = NBTOPFOP + 1
2129 ENDIF
2130 ELSEIF(KEY2=='notop') THEN
2131C ITOP = 0
2132 IF (INTCH_ITOP/=0) THEN
2133 GO TO 9990
2134 ELSE
2135 INTCH_ITOP=NINTCH
2136 NBTOPFOP = NBTOPFOP + 1
2137 ENDIF
2138 ENDIF
2139 IF(IKAD(IKEY)+K/=IKAD(IKEY+1))GO TO 500
2140 ENDIF
2141
2142C--------------------
2143C /RBODY
2144C--------------------
2145 IKEY=KRBODY
2146 NRBYON=0
2147 NRBYOF=0
2148 NRBYNF=0
2149 IF(IKAD(IKEY)/=IKAD(IKEY+1))THEN
2150 K=0
2151 550 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(7x,a,37x,i10)',ERR=9990)KEY2,NBC
2152 K=K+1
2153 NOF=0
2154 DO I=1,NBC
2155 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(a)',ERR=9990)CARTE
2156 K=K+1
2157 NOF=NOF+NVAR(CARTE)
2158 ENDDO
2159 NRBYNF=NRBYNF+1
2160 IF(KEY2=='on')THEN
2161 NRBYON=NRBYON+NOF
2162 ELSEIF(KEY2=='off')THEN
2163 NRBYOF=NRBYOF+NOF
2164 ELSE
2165 CALL ERRMSG(KEY2)
2166 ENDIF
2167 IF(IKAD(IKEY)+K/=IKAD(IKEY+1))GO TO 550
2168 ENDIF
2169 ! cases /inter/fop and /inter/top
2170 WRITE(IIN,'(10i8)')NINTCH-NBTOPFOP,NRBYON,NRBYOF
2171
2172C--------------------
2173C /MADYMO (COUPLING)
2174C--------------------
2175 IKEY=KMADYM
2176 IMADCPL = 0
2177 IF (IKAD(IKEY)/=IKAD(IKEY+1)) THEN
2178 K=0
2179 650 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(7x,a,37x,i10)',ERR=9990) KEY2,NBC
2180 IF(KEY2/='on.AND.' KEY2/='on2.AND.' KEY2/='mpp' )THEN
2181 CALL ERRMSG(KEY2)
2182 ELSEIF(KEY2=='on2')THEN
2183 IMADCPL = 1
2184 ELSEIF(KEY2=='mpp')THEN
2185 IMADCPL = 1
2186 ENDIF
2187 K=K+1
2188 DO I=1,NBC
2189 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(a)',ERR=9990) CARTE
2190 K=K+1
2191 ENDDO
2192 IF(IKAD(IKEY)+K/=IKAD(IKEY+1)) GO TO 650
2193 ENDIF
2194
2195C--------------------
2196C /RAD2RAD
2197C--------------------
2198 IKEY=KRAD2R
2199 IRAD2R=0
2200 IF (IKAD(IKEY)/=IKAD(IKEY+1)) THEN
2201 K=0
2202 670 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(7x,a,37x,i10)',ERR=9990) KEY2,NBC
2203 IF(KEY2/='on')THEN
2204 CALL ERRMSG(KEY2)
2205 ELSEIF(KEY2=='on')THEN
2206 IRAD2R = 1
2207 !initial connection with rad2rad
2208 IF (ISPMD==0) CALL CONNECTION_SOCK_INIT_C(SOCK0)
2209 ENDIF
2210 K=K+1
2211 DO I=1,NBC
2212 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(a)',ERR=9990) CARTE
2213 K=K+1
2214 ENDDO
2215 IF(IKAD(IKEY)+K/=IKAD(IKEY+1)) GO TO 670
2216 ENDIF
2217
2218C--------------------
2219C /VIPER
2220C--------------------
2221 IKEY=KVIPER
2222 ViperCoupling = .false.
2223 IF (IKAD(IKEY)/=IKAD(IKEY+1)) THEN
2224 K=0
2225 680 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(7x,a,37x,i10)',ERR=9990) KEY2,NBC
2226 IF(KEY2=='on')THEN
2227 ViperCoupling = .true.
2228 ENDIF
2229 K=K+1
2230 DO I=1,NBC
2231 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(a)',ERR=9990) CARTE
2232 K=K+1
2233 ENDDO
2234 IF(IKAD(IKEY)+K/=IKAD(IKEY+1)) GO TO 680
2235 ENDIF
2236
2237C--------------------------------------------------
2238C /PERF
2239C-------------------------------------------------
2240 IKEY=KPERF
2241 GLOBAL_INTERFACE_SORTING_ALGO = 1
2242 IF (IKAD(IKEY)/=IKAD(IKEY+1)) THEN
2243 K=0
2244 700 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(7x,a,37x,i10)',ERR=9990) KEY2,NBC
2245 IF(KEY2=='sort1') THEN
2246 GLOBAL_INTERFACE_SORTING_ALGO = 1
2247 ELSEIF(KEY2=='sort2') THEN
2248 GLOBAL_INTERFACE_SORTING_ALGO = 2
2249 ELSEIF(KEY2=='sort3') THEN
2250 GLOBAL_INTERFACE_SORTING_ALGO = 0
2251 ENDIF
2252 K = K +1
2253 IF(IKAD(IKEY)+K/=IKAD(IKEY+1)) GO TO 700
2254 ENDIF
2255
2256C--------------------
2257C /SPMD
2258C--------------------
2259 IKEY=KSPMD
2260 IDDW=0
2261 IPREAD=0
2262 IDDWSTAT=0
2263 IF (IKAD(IKEY)/=IKAD(IKEY+1)) THEN
2264 K=0
2265 750 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(7x,a,37x,i10)',ERR=9990) KEY2,NBC
2266 IF(KEY2=='ddw')THEN
2267 IDDW=1
2268 CALL WRIUSC2(IKAD(IKEY)+1,1,KEY0(IKEY))
2269 READ(IUSC2,*) TPSENG
2270 ELSEIF(KEY2=='pread')THEN
2271 IPREAD = 1
2272 ELSEIF(KEY2=='ddwst')THEN
2273 IDDW=1
2274 IDDWSTAT=1
2275 ELSE
2276 CALL ERRMSG(KEY2)
2277 ENDIF
2278 K=K+1
2279 DO I=1,NBC
2280 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(a)',ERR=9990) CARTE
2281 K=K+1
2282 ENDDO
2283 IF(IKAD(IKEY)+K/=IKAD(IKEY+1)) GO TO 750
2284 ENDIF
2285C
2286C--------------------
2287C /DAMP
2288C--------------------
2289 IDAMP0=0
2290 N_DAMP=0
2291 IKEY=KDAMP
2292 IF(IKAD(IKEY)/=IKAD(IKEY+1))THEN
2293 K=0
2294 770 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(101x,i10)',ERR=9990) NBC
2295 IF (NBC == 2) IDAMP0=1
2296 K=K+NBC+1
2297 N_DAMP=N_DAMP+1
2298 IF(IKAD(IKEY)+K/=IKAD(IKEY+1))GO TO 770
2299 ENDIF
2300 WRITE(IIN,'(i8)')N_DAMP
2301
2302C--------------------
2303C /FXINP (FLEXIBLE BODY INPUT FILES)
2304C--------------------
2305 IKEY=KFXINP
2306 NFXINP=0
2307 IF (IKAD(IKEY)/=IKAD(IKEY+1)) THEN
2308 K=0
2309 780 CALL WRIUSC2(IKAD(IKEY)+1,1,KEY0(IKEY))
2310 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(49x,i10)',ERR=9990) NBC
2311 K=K+NBC+1
2312 NFXINP=NFXINP+NBC
2313 IF (IKAD(IKEY)+K/=IKAD(IKEY+1)) GO TO 780
2314 ENDIF
2315 WRITE(IIN,'(i8)')NFXINP
2316
2317C--------------------
2318C /EIG (EIGENPROBLEM DEACTIVATION)
2319C--------------------
2320 IKEY=KEIG
2321 NEIGOFF=0
2322 NEOFF=0
2323 IF (IKAD(IKEY)/=IKAD(IKEY+1)) THEN
2324 K=0
2325 790 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(7x,a,37x,i10)',ERR=9990)KEY2,NBC
2326 K=K+1
2327 NOF=0
2328 DO I=1,NBC
2329 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(a)',ERR=9990)CARTE
2330 K=K+1
2331 NOF=NOF+NVAR(CARTE)
2332 ENDDO
2333 NEIGOFF=NEIGOFF+1
2334 NEOFF=NEOFF+NOF
2335 IF(KEY2/='off') CALL ERRMSG(KEY2)
2336 IF(IKAD(IKEY)+K/=IKAD(IKEY+1)) GOTO 790
2337 ENDIF
2338 WRITE(IIN,'(2i8)')NEIGOFF, NEOFF
2339
2340C-----------------------
2341C /FVMBAG (REMESH/MODIF)
2342C-----------------------
2343 IKEY=KFVBAG
2344 NFVMESH=0
2345 NFVMODI=0
2346 IF(IKAD(IKEY)/=IKAD(IKEY+1)) THEN
2347 K=0
2348 810 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(7x,a5,37x,i10)',ERR=9990)KEY2, NBC
2349 K=K+NBC+1
2350 IF (KEY2=='remes') NFVMESH=NFVMESH+1
2351 IF (KEY2=='modif') NFVMODI=NFVMODI+1
2352 IF (IKAD(IKEY)+K/=IKAD(IKEY+1)) GO TO 810
2353 ENDIF
2354 WRITE(IIN,'(2i8)')NFVMESH,NFVMODI
2355
2356C-----------------------
2357C /DT1TET10
2358C--------------------
2359 IKEY = KDT1TET10
2360 IDT1TET10=0
2361 IF(IKAD(IKEY)/=IKAD(IKEY+1))THEN
2362 NITERP=0
2363 READ(IUSC1,REC=IKAD(IKEY),FMT='(7x,i5)',ERR=9990)NITERP
2364 IF(NITERP == 0)NITERP=1
2365 IDT1TET10=1+NITERP
2366 END IF
2367
2368C-----------------------
2369C /DTTSH (full shell timestep for thick shells)
2370C--------------------
2371 IKEY = KDTTSH
2372 IDTTSH=0
2373 IF(IKAD(IKEY)/=IKAD(IKEY+1))THEN
2374 IDTTSH=1
2375 END IF
2376
2377C--------------------
2378C /MASS/RESET
2379C--------------------
2380 IKEY = KMASS
2381 IMASSI = 0
2382 IF(IKAD(IKEY)/=IKAD(IKEY+1))THEN
2383 READ(IUSC1,REC=IKAD(IKEY),FMT='(7x,a)',ERR=9990)KEY2
2384 IF(KEY2(1:5)=='reset.AND..AND.'IRUNN>1MCHECK==0) IMASSI = 1
2385 END IF
2386
2387C--------------------
2388C /SENS/RESET
2389C--------------------
2390 IKEY = KSENSOR
2391 SENSORS%NRESET = 0
2392 IREC = IKAD(IKEY)
2393 IF (IKAD(IKEY) /= IKAD(IKEY+1)) THEN
2394 READ(IUSC1,REC=IKAD(IKEY),FMT='(7x,a,37x,i10)',ERR=9990) KEY2,NBC
2395 IF (KEY2(1:5)=='reset') THEN
2396 IREC = IREC+1
2397 NBSENS = 0
2398 DO I=1,NBC
2399 READ(IUSC1,REC=IREC+I-1,FMT='(a)',ERR=9990)CARTE
2400 NBSENS = NBSENS + NVAR(CARTE)
2401 ENDDO
2402 IF (NBSENS == 0) THEN
2403 SENSORS%NRESET = SENSORS%NSENSOR
2404 ELSE
2405 SENSORS%NRESET = NBSENS
2406 ALLOCATE(SENSORS%RESET(NBSENS))
2407 NBSENS = 0
2408 DO I=1,NBC
2409 READ(IUSC1,REC=IREC+I-1,FMT='(a)',ERR=9990)CARTE
2410 CALL WRIUSC2(IREC+I-1,1,KEY0(IKEY))
2411 READ(IUSC2,*,ERR=9990,END=9990)
2412 . (SENSORS%RESET(J+NBSENS),J=1,NVAR(CARTE))
2413 NBSENS = NBSENS + NVAR(CARTE)
2414 ENDDO
2415 END IF
2416 END IF
2417 END IF
2418
2419C--------------------
2420C /DEL/INTER (TYPE7 SHELL DELETION)
2421C--------------------
2422 CALL FREDLI7(IKAD(0),KEY0,KDELIN)
2423
2424C--------------------
2425C /DEL/INTER (INTERFACE DELETION)
2426C--------------------
2427 CALL FREDLI(IKAD(0),KEY0,KDEL,NDEL)
2428
2429C--------------------
2430C /DEL (ELEMENT DELETION)
2431C--------------------
2432 CALL RDELE(NDEL,'brick',IKAD(KDEL),KEY0(IKEY))
2433 CALL RDELE(NDEL,'quad ',IKAD(KDEL),KEY0(IKEY))
2434 CALL RDELE(NDEL,'shell',IKAD(KDEL),KEY0(IKEY))
2435 CALL RDELE(NDEL,'truss',IKAD(KDEL),KEY0(IKEY))
2436 CALL RDELE(NDEL,'beam ',IKAD(KDEL),KEY0(IKEY))
2437 CALL RDELE(NDEL,'sprin',IKAD(KDEL),KEY0(IKEY))
2438 CALL RDELE(NDEL,'sh_3n',IKAD(KDEL),KEY0(IKEY))
2439 CALL RDELE(NDEL,'sh3n ',IKAD(KDEL),KEY0(IKEY))
2440 CALL RDELE(NDEL,'spcel',IKAD(KDEL),KEY0(IKEY))
2441 CALL RDELE(NDEL,'sphce',IKAD(KDEL),KEY0(IKEY))
2442 CALL RDELE(NDEL,'part ',IKAD(KDEL),KEY0(IKEY))
2443
2444C--------------------
2445C /ALE/LINK (and obsolete option /VEL/ALE)
2446C--------------------
2447 CALL FRELNK(IKAD(0),KEY0,KVEL,NRLINK,VEL_SK_FR)
2448C--------------------
2449C ALE LINK
2450C--------------------
2451 LLINAL = 0
2452 IF(NALELK/=0) CALL FRALNK (IKAD(0),KEY0,KVEL,NALELK) !format v5.1
2453 IF(NALELINK/=0)CALL FRALNK2(IKAD(0),KEY0,KALE,NALELINK) !format v12
2454 !LLINAL is now LINALE() dimension for engine ALE links definitions.
2455
2456C--------------------
2457C /ALE (ON/OFF)
2458C--------------------
2459 IF (NBALEON + NBALEOFF /= 0) CALL FRALEONOFF(IKAD(0), KEY0, KALE, NBALEON + NBALEOFF)
2460
2461C--------------------
2462C /BCS
2463C--------------------
2464 CALL FREBCS(IKAD(0),KEY0,KBCS,KBCSR,NBCS1,NBCS2,BCS_SK_FR)
2465
2466C--------------------
2467C /INTER
2468C--------------------
2469 CALL FREINT(IKAD(0),KEY0,KINTER,NINTCH,INVERS,INTCH_IFOP,INTCH_ITOP)
2470
2471C--------------------
2472C /RBODY (ON/OFF)
2473C--------------------
2474 CALL FRERBO(IKAD(0),KEY0,KRBODY,NRBYNF)
2475
2476C--------------------
2477C /FLSEC (FLOW SECTIONS,OBSOLETE)
2478C--------------------
2479 NTFLSW=0
2480 IF(NSFLSW/=0)CALL FREFLW(IKAD(0),KEY0,KFLSEC,NSFLSW,NTFLSW)
2481 !not compatible SPMD
2482 IF (NSFLSW>0) THEN
2483 CALL ANCMSG(MSGID=201,ANMODE=ANINFO)
2484 IERR=IERR+1
2485 ENDIF
2486
2487C--------------------
2488C /FUNCT (FUNCTION UPDATES)
2489C--------------------
2490 CALL FREFUNC(IKAD(0),KEY0,KFUNC,NFCT)
2491
2492C--------------------
2493C /INIV (VELOCITY INITIALIZATIONS)
2494C--------------------
2495 CALL FREINIV(IKAD(0),KEY0,KINIV,NINIV)
2496
2497C-----------------------
2498C /ANIM (ANIMATION FILES)
2499C-----------------------
2500 CALL FREANIM(IKAD(0),KEY0,KANIM,SENSORS)
2501C-----------------------
2502C /OUTP (OUTPUT FILES)
2503C-----------------------
2504 CALL FREOUTP(IKAD(0),KEY0,KOUTP,SENSORS)
2505
2506C-----------------------
2507C /DEBUG
2508C-----------------------
2509 CALL FREDEBUG(IKAD(0),KEY0,KDEBUG)
2510
2511C--------------------
2512C /NOISE
2513C--------------------
2514 CALL FRENOIS(IKAD(0),KEY0,KNOISE)
2515C--------------------
2516C /UPWIND (PARAMETERS ETA1,ETA2,ETA3)
2517C--------------------
2518 CALL FREUPWIND(IKAD(0),KEY0,KUPWIND)
2519
2520C--------------------
2521C /UPWM (MOMENTUM ADVECTION METHOD)
2522C--------------------
2523 CALL FREUPWM(IKAD(0),KEY0,KUPWM)
2524
2525C--------------------
2526C /MON (MONITORING)
2527C--------------------
2528 IKEY=KMON
2529 IMON = 1
2530 IMONM = 0
2531 IMON_MAT = 0
2532 IF(IKAD(IKEY)/=IKAD(IKEY+1))THEN
2533 READ(IUSC1,REC=IKAD(IKEY),FMT='(7x,a,1x,i5)',ERR=9990)KEY2,K4
2534 IF(KEY2=='off')THEN
2535 IMON = 0
2536 IMONM = 0
2537 ELSEIF(KEY2=='on')THEN
2538 IMON = K4 + 1
2539 IMONM = 0
2540 ELSEIF(KEY2=='full')THEN
2541 IMON = K4 + 1
2542 IMONM = 1
2543 ELSEIF(KEY2=='sync')THEN
2544 IMON = K4 + 1
2545 IMONM = 2
2546 ELSEIF(KEY2=='mat')THEN
2547 IMON = K4 + 1
2548 IMON_MAT = 1
2549c ELSEIF(KEY2=='GRAPH')THEN
2550c IMON = K4 + 1
2551c IMONM = 3
2552 ENDIF
2553 ENDIF
2554
2555C--------------------
2556C /INCMP (OBSOLETE OPTION, incompressible)
2557C--------------------
2558 ALE%GLOBAL%INCOMP = 0
2559 IKEY=KINCMP
2560 IF(IKAD(IKEY)/=IKAD(IKEY+1))THEN
2561 ALE%GLOBAL%INCOMP=1
2562 ENDIF
2563
2564C--------------------
2565C /MADYMO (COUPLING)
2566C--------------------
2567 IF(IMADCPL/=0) CALL FRECPL(IKAD,KEY0,KMADYM)
2568
2569C--------------------
2570C /DAMP
2571C--------------------
2572 CALL FREDAMP(IKAD(0),KEY0,KDAMP,N_DAMP)
2573
2574C-----------------------
2575C /IMPL
2576C-----------------------
2577 IMPL=0
2578 CALL FREIMPL(IKAD(0),KEY0,KIMPL)
2579
2580C--------------------
2581C /FXINP (OUTPUT FILES FOR FLEXIBLE BODIES)
2582C--------------------
2583 CALL FREFXINP(IKAD(0),KEY0,KFXINP,NFXINP)
2584
2585C--------------------
2586C /EIG (EIGENPROBLEM DEACTIVATION)
2587C--------------------
2588 CALL FREEIG(IKAD(0),KEY0,KEIG,NEIGOFF)
2589
2590C--------------------
2591C /FVMBAG (REMESH)
2592C--------------------
2593 CALL FREFVBAG(IKAD(0),KEY0,KFVBAG)
2594
2595C-----------------------
2596C /STATE
2597C-----------------------
2598 CALL FRESTAT(IKAD(0),KEY0,KSTATF,SENSORS,OUTPUT)
2599
2600C-----------------------
2601C /DYNAIN
2602C-----------------------
2603 CALL FREDYNAIN(IKAD(0),KEY0,KDYNAIN,DYNAIN_DATA)
2604
2605C-----------------------
2606C /ABF (and /AABF, /BABF, /CABF, /DABF, /EABF, /FABF, /GABF, /HABF, /IABF)
2607C-----------------------
2608 ABFILE = 0
2609 NABFILE = 0
2610#ifdef DNC
2611 CALL FREABF(IKAD(0),KEY0,KABF,ABFILE,NABFILE,1)
2612 CALL FREABF(IKAD(0),KEY0,KAABF,ABFILE,NABFILE,2)
2613 CALL FREABF(IKAD(0),KEY0,KBABF,ABFILE,NABFILE,3)
2614 CALL FREABF(IKAD(0),KEY0,KCABF,ABFILE,NABFILE,4)
2615 CALL FREABF(IKAD(0),KEY0,KDABF,ABFILE,NABFILE,5)
2616 CALL FREABF(IKAD(0),KEY0,KEABF,ABFILE,NABFILE,6)
2617 CALL FREABF(IKAD(0),KEY0,KFABF,ABFILE,NABFILE,7)
2618 CALL FREABF(IKAD(0),KEY0,KGABF,ABFILE,NABFILE,8)
2619 CALL FREABF(IKAD(0),KEY0,KHABF,ABFILE,NABFILE,9)
2620 CALL FREABF(IKAD(0),KEY0,KIABF,ABFILE,NABFILE,10)
2621.AND. IF (NABFILE/=0 ABFILE(1) == 0) THEN
2622 NABFILE = NABFILE + 1
2623 ABFILE(1) = ABFILE(1) + 1
2624 ENDIF
2625#endif
2626
2627C-----------------------
2628C /THERM
2629C-----------------------
2630 CALL FRETHERMAL(IKAD(0),KEY0,KTHERMAL,GLOB_THERM)
2631
2632C-----------------------
2633C /H3D
2634C-----------------------
2635 CALL H3D_INI(H3D_DATA,KH3D,NSLASH)
2636 CALL H3D_READ(IKAD(0),KEY0,KH3D,NSLASH,H3D_DATA,SENSORS)
2637
2638C-----------------------
2639C /REPORT
2640C-----------------------
2641 IKEY=KREPORT
2642 IREPORT = 0
2643 IH3DREADER = 0
2644 IMVW = 0
2645 IMVW_REF = 0
2646 K = 0
2647 DO WHILE(IKAD(IKEY)+K/=IKAD(IKEY+1))
2648 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(7x,a,1x,a,1x,a,1x,a,19x,i10)',ERR=9990)KEY2,KEY3,KEY4,KEY5,NBC
2649 IREPORT=1
2650 IF(KEY2=='html')THEN
2651 IHTML = 1
2652 IF(KEY3=='h3d.AND.' NSLASH(KH3D) /= 0) THEN
2653 IH3DREADER = 1
2654 IF(KEY4 =='ext') IH3DREADER = 2
2655 ENDIF
2656 ELSEIF(KEY2=='mvw')THEN
2657 IMVW=1
2658 IF(KEY3=='ref')THEN
2659 IMVW_REF = 1
2660 K = K + 1
2661 READ(IUSC1,REC=IKAD(IKEY)+K,FMT='(5x,a)',ERR=9990)IMVW_REFPATH
2662 ELSEIF(KEY3=='anim')THEN
2663 IF(KEY4=='th')THEN
2664 IMVW=1
2665 ELSEIF(KEY4=='abf')THEN
2666 IMVW=2
2667 ENDIF
2668 ELSEIF(KEY3=='h3d')THEN
2669 IF(KEY4=='th')THEN
2670 IMVW=3
2671 ELSEIF(KEY4=='abf')THEN
2672 IMVW=4
2673 ENDIF
2674 ELSE
2675 !autoselect of files format
2676 IF(NSLASH(KANIM) /= 0)THEN
2677 IF(NSLASH(KTFILE) /= 0)THEN
2678 IMVW=1
2679 ELSEIF(NSLASH(KABF) /= 0)THEN
2680 IMVW=2
2681 ENDIF
2682 ELSEIF(NSLASH(KH3D) /= 0) THEN
2683 IF(NSLASH(KTFILE) /= 0)THEN
2684 IMVW=3
2685 ELSEIF(NSLASH(KABF) /= 0)THEN
2686 IMVW=4
2687 ENDIF
2688 ENDIF
2689 ENDIF
2690 ENDIF
2691 K = K + 1
2692 ENDDO
2693C========================================================================
2694 CLOSE(UNIT=IUSC1)
2695 CLOSE(UNIT=IUSC2)
2696 CALL DELETE_USER_FILE(IUSC1_FN,LEN_IUSC1_FN)
2697 CALL DELETE_USER_FILE(IUSC2_FN,LEN_IUSC2_FN)
2698
2699 IF(IERR==0) RETURN
2700 CALL ARRET(0)
2701C
2702 9990 CONTINUE
2703C
2704 CALL ANCMSG(MSGID=73,ANMODE=ANINFO,C1=KEY0(IKEY))
2705 CALL ARRET(0)
2706 RETURN
2707
2708C-----------------------------------------------
2709 1000 CONTINUE
2710 IF (IERR1/=0) THEN
2711 WRITE(IOUT,*)' ** error in memory allocation WHILE reading engine file'
2712 WRITE(ISTDO,*)' ** error in memory allocation WHILE reading engine file'
2713 CALL ARRET(2)
2714 END IF
2715C-----------------------------------------------
2716
my_real
#define my_real
Definition cppsort.cpp:32
errmsg
subroutine errmsg(key)
Definition errmsg.F:40
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
ale_mod
Definition ale_mod.F:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249
alemuscl_mod
Definition alemuscl_mod.F:54
alemuscl_mod::alemuscl_param
type(alemuscl_param_) alemuscl_param
Definition alemuscl_mod.F:75
check_mod
Definition check_mod.F:34
check_mod::restart_file
integer restart_file
Definition check_mod.F:52
dt_mod
Definition dt_mod.F:79
dt_mod::init_idel_brick
subroutine init_idel_brick(this)
Definition dt_mod.F:102
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
h3d_mod
Definition h3d_mod.F:308
message_mod
Definition message_mod.F:1249
metric_mod
Definition metric_mod.F:42
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharline100
integer, parameter ncharline100
Definition names_and_titles_mod.F:1002
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
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
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:889
arret
subroutine arret(nn)
Definition arret.F:87
wriusc2
subroutine wriusc2(irec, nbc, key0)
Definition wriusc2.F:60

◆ fretitl()

subroutine fretitl ( character, dimension(*), intent(in) titr,
integer, dimension(*), intent(inout) iasc,
integer, intent(in) l )

Definition at line 2789 of file freform.F.

2790C-----------------------------------------------
2791C I m p l i c i t T y p e s
2792C-----------------------------------------------
2793#include "implicit_f.inc"
2794C-----------------------------------------------
2795C D u m m y A r g u m e n t s
2796C-----------------------------------------------
2797 INTEGER,INTENT(INOUT) :: IASC(*)
2798 INTEGER,INTENT(IN) :: L
2799 CHARACTER,INTENT(IN) :: TITR*(*)
2800C-----------------------------------------------
2801C L o c a l V a r i a b l e s
2802C-----------------------------------------------
2803 INTEGER I,J,LTITR
2804C-----------------------------------------------
2805C S o u r c e L i n e s
2806C-----------------------------------------------
2807 j=1
2808 ltitr=len(titr)
2809 DO i=1,l
2810 iasc(i)= ichar(titr(j:j))*65536
2811 j = j+1
2812 IF(j>ltitr) EXIT
2813 iasc(i)= iasc(i) + ichar(titr(j:j))*256
2814 j = j+1
2815 IF(j>ltitr) EXIT
2816 iasc(i)= iasc(i) + ichar(titr(j:j))
2817 j = j+1
2818 IF(j>ltitr) EXIt
2819 ENDDO
2820C-----------------------------------------------
2821 RETURN

◆ fretitl2()

subroutine fretitl2 ( character, dimension(*), intent(inout) titr,
integer, dimension(*), intent(in) iasc,
integer, intent(in) l )

Definition at line 2836 of file freform.F.

2837C-----------------------------------------------
2838C I m p l i c i t T y p e s
2839C-----------------------------------------------
2840#include "implicit_f.inc"
2841C-----------------------------------------------
2842C D u m m y A r g u m e n t s
2843C-----------------------------------------------
2844 INTEGER,INTENT(IN) :: IASC(*)
2845 INTEGER,INTENT(IN) :: L
2846 CHARACTER,INTENT(INOUT) :: TITR*(*)
2847C-----------------------------------------------
2848C L o c a l V a r i a b l e s
2849C-----------------------------------------------
2850 INTEGER I,J,LTITR
2851C-----------------------------------------------
2852C S o u r c e L i n e s
2853C-----------------------------------------------
2854 j=1
2855 ltitr=len(titr)
2856 DO i=1,l
2857 titr(j:j)=char(iasc(i)/65536)
2858 j=j+1
2859 IF(j>ltitr) EXIT
2860 titr(j:j)=char(mod(iasc(i),65536)/256)
2861 j=j+1
2862 IF(j>ltitr) EXIT
2863 titr(j:j)=char(mod(iasc(i),256))
2864 j=j+1
2865 IF(j>ltitr) EXIT
2866 ENDDO
2867C-----------------------------------------------
2868 RETURN

◆ fretitl2r()

subroutine fretitl2r ( character, dimension(*), intent(inout) titr,
dimension(*), intent(in) asc,
integer, intent(in) l )

Definition at line 2910 of file freform.F.

2911C-----------------------------------------------
2912C I m p l i c i t T y p e s
2913C-----------------------------------------------
2914#include "implicit_f.inc"
2915C-----------------------------------------------
2916C D u m m y A r g u m e n t s
2917C-----------------------------------------------
2918 my_real,INTENT(IN) :: asc(*)
2919 INTEGER,INTENT(IN) :: L
2920 CHARACTER,INTENT(INOUT) :: TITR*(*)
2921C-----------------------------------------------
2922C L o c a l V a r i a b l e s
2923C-----------------------------------------------
2924 INTEGER I,J,LTITR
2925C-----------------------------------------------
2926C S o u r c e L i n e s
2927C-----------------------------------------------
2928 j=1
2929 ltitr=len(titr)
2930 DO i=1,l
2931 titr(j:j)=char(nint(asc(i))/65536)
2932 j=j+1
2933 IF(j>ltitr) EXIT
2934 titr(j:j)=char(mod(nint(asc(i)),65536)/256)
2935 j=j+1
2936 IF(j>ltitr) EXIT
2937 titr(j:j)=char(mod(nint(asc(i)),256))
2938 j=j+1
2939 IF(j>ltitr) EXIT
2940 ENDDO
2941C-----------------------------------------------
2942 RETURN

◆ fretitlr()

subroutine fretitlr ( character, dimension(*), intent(in) titr,
dimension(*), intent(inout) asc,
integer, intent(in) l )

Definition at line 2873 of file freform.F.

2874C-----------------------------------------------
2875C I m p l i c i t T y p e s
2876C-----------------------------------------------
2877#include "implicit_f.inc"
2878C-----------------------------------------------
2879C D u m m y A r g u m e n t s
2880C-----------------------------------------------
2881 my_real,INTENT(INOUT) :: asc(*)
2882 INTEGER,INTENT(IN) :: L
2883 CHARACTER,INTENT(IN) :: TITR*(*)
2884C-----------------------------------------------
2885C L o c a l V a r i a b l e s
2886C-----------------------------------------------
2887 INTEGER I,J,LTITR
2888C-----------------------------------------------
2889C S o u r c e L i n e s
2890C-----------------------------------------------
2891 j=1
2892 ltitr=len(titr)
2893 DO i=1,l
2894 asc(i)= ichar(titr(j:j))*65536
2895 j = j+1
2896 IF(j>ltitr) EXIT
2897 asc(i)= asc(i) + ichar(titr(j:j))*256
2898 j = j+1
2899 IF(j>ltitr) EXIT
2900 asc(i)= asc(i) + ichar(titr(j:j))
2901 j = j+1
2902 IF(j>ltitr) EXIT
2903 ENDDO
2904C-----------------------------------------------
2905 RETURN

◆ ngr2usr()

integer function ngr2usr ( integer iu,
type (group_), dimension(ngrnod) igrnod,
integer ngrnod )

Definition at line 2731 of file freform.F.

2732C-----------------------------------------------
2733C M o d u l e s
2734C-----------------------------------------------
2735 USE groupdef_mod
2736C-----------------------------------------------
2737C I m p l i c i t T y p e s
2738C-----------------------------------------------
2739#include "implicit_f.inc"
2740#include "comlock.inc"
2741C-----------------------------------------------
2742C C o m m o n B l o c k s
2743C-----------------------------------------------
2744#include "units_c.inc"
2745#include "com08_c.inc"
2746C-----------------------------------------------
2747C D u m m y A r g u m e n t s
2748C-----------------------------------------------
2749 INTEGER IU,NGRNOD
2750C-----------------------------------------------
2751 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
2752C-----------------------------------------------
2753C L o c a l V a r i a b l e s
2754C-----------------------------------------------
2755 INTEGER I, IE
2756C-----------------------------------------------
2757C S o u r c e L i n e s
2758C-----------------------------------------------
2759 IF(iu==0)THEN
2760 ngr2usr=0
2761 RETURN
2762 ENDIF
2763 DO i=1,ngrnod
2764 ie=igrnod(i)%ID
2765 IF(ie==iu)THEN
2766 ngr2usr=i
2767 RETURN
2768 ENDIF
2769 ENDDO
2770 tstop = tt
2771#include "lockon.inc"
2772 WRITE(iout,*) ' ** ERROR ** : NODE GROUP',iu,' NOT FOUND'
2773 WRITE(istdo,*) ' ** ERROR ** : NODE GROUP',iu,' NOT FOUND'
2774 ngr2usr=0
2775#include "lockoff.inc"
2776 RETURN
ngr2usr
integer function ngr2usr(iu, igrnod, ngrnod)
Definition freform.F:2732
groupdef_mod
Definition groupdef_mod.F:662