46 USE output_mod
47 USE python_funct_mod
48
49
50
51#include "implicit_f.inc"
52
53
54
55#include "commandline.inc"
56#include "warn_c.inc"
57#include "execinp.inc"
58#include "userlib.inc"
59#include "tablen_c.inc"
60#include "ddspmd_c.inc"
61#include "debug_rst.inc"
62
63
64
65 TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT
66
67
68
69 INTEGER ARGN
70 INTEGER PHELPI,PEXECI,PINPUTI,PNCPUI, PNTHI, PTIMER, PUSERLNAMI,MDS_PATHI
71 INTEGER PCHECKSUMI
72 INTEGER :: MDS_DIRI
73 INTEGER I,STRL,STRLN,ERR,LENLIST,ISIN,STRLNA,BEGIN
74 INTEGER IDUM
75 LOGICAL :: CONDITION
76 CHARACTER C
77 INTEGER GLOBAL_ERROR
78 CHARACTER*2096 INPUTR,INPUTC,STRING,ARGP,ARGS
79 CHARACTER*2096 CHECKSUMR,CHECKSUMC
80 CHARACTER*4096 ULIBC
81 character(len=2096) ARGS2,ARGS_REDUCE
82 INTEGER :: LEN_DOMDEC_CPU_TYPE
83 CHARACTER(LEN=15) ::
84 INTEGER IARGC,IERRMSG,CDL_CASE
85 CHARACTER :: LAST_LETTER,SEPARATOR
86 INTEGER :: RANDM_SEED,RANDM_ALEA
87 REAL(kind=8) :: randm_seed_nbr,randm_alea_nbr
88 INTEGER :: GOT_GRP_SIZE
89 parameter(lenlist=33)
90 CHARACTER (LEN=20) :: ARGLIST(LENLIST)
91 EXTERNAL iargc
92 DATA arglist/
93 . '-VERSION', '-V',
94 . '-HELP' , '-H',
95 . '-INPUT' , '-I',
96 . '-NSPMD' , '-NP',
97 . '-NTHREAD' , '-NT',
98 . '-ERROR_MSG','-EM',
99 . '-NOTRAP' , '-TIMER',
100 . '-DYNAMIC_LIB', '-DYLIB',
101 . '-MDS_LIBPATH', '-MDSDIR',
102 . '-MEM-MAP' , '-INSPIRE', '-DD_TUNING',
103 . '-INSPIRE_ALM' , '-FLUSH_RST', '-CHECK',
104 . '-HSTP_READ' , '-HSTP_WRITE', '-RXALEA', '-RSEED',
105 . '-PREVIEW',
106 . '-GRP_SIZE' , '-PYTHON' , '-THNMS1','-CHECKSUM_READ'/
107 INTEGER :: RUNQA
108 CHARACTER (LEN=255) :: STR
109
110 idum=-1
111 itrace=1
112 ierrmsg=0
113 global_error = 0
114 python_error = 1
115 str = ' '
116
117 CALL getenv('RUN_QA',str)
118 runqa = 0
119 READ(str,'(I10)')runqa
120 IF(runqa == 1) python_error = 0
121
122 got_input = 0
123 got_ncpu = 0
124 got_nth = 0
125 got_timer = 0
126 got_userl_altname=0
127 got_mem_map=0
128 got_inspire=0
129 got_inspire_alm=0
130 got_hstp_read = 0
131 got_hstp_write = 0
132 mds_path_len = 0
133 flush_rst_to_txt = .false.
134
135 input=' '
136 leni=0
137
138 got_path=0
139 lenp=0
140 path=' '
141
142 phelpi = 0
143 pexeci = 0
144 pinputi = 0
145 pncpui= 0
146 pnthi = 0
147 ptimer = 0
148 puserlnami = 0
149 mds_pathi = 0
150 mds_diri = 0
151 pchecksumi = 0
152
153
154 domdec_tuning = 0
155 dd_optimization = 0
156
157
158
160
161
169#if CPP_mach == CPP_w95 || CPP_mach == CPP_win64_spmd || CPP_mach == CPP_p4win64_spmd || CPP_mach == CPP_wnt || CPP_mach == CPP_wmr || CPP_mach == CPP_p4win64 || CPP_mach == CPP_p4win32
170 separator='\'
171#elif 1
172 separator='/'
173#endif
174
175
181
182 randm_seed=0
183 randm_alea=0
184
185
187 got_grp_size = 0
189
190
191 output%TH%DUMP_THNMS1_FILE = 0
192 output%CHECKSUM%ST_CHECKSUM_READ = 0
193
194 args2(1:2096) = ''
195
196 argn = command_argument_count()
197
198 DO i=1,argn
199 CALL get_command_argument(i,args)
200 strl=len_trim(args)
201 args2(1:2096) = ''
202 args2(1:strl) = args(1:strl)
204
205 args_reduce(1:9) = args(1:9)
206 cdl_case = 0
207
208 IF(args_reduce(1:9)=='-OUTFILE=') cdl_case = 2
209 IF(args_reduce(1:8)=='-INFILE=') cdl_case = 3
210
211 IF(cdl_case==0) THEN
212
213 SELECT CASE (args)
214
215
216 CASE ( '-VERSION')
217 pexeci = 1
218 CASE ( '-V')
219 pexeci = 1
220
221
222 CASE ( '-HELP')
223 phelpi = 1
224 CASE ( '-H')
225 phelpi = 1
226
227
228 CASE ( '-NOTRAP')
229 itrace = 0
230
231
232 CASE ( '-ERROR_MSG')
233 ierrmsg = i
234 CASE ( '-EM')
235 ierrmsg = i
236
237
238 CASE ( '-INPUT')
239 IF (pinputi==0) pinputi = i
240 CASE ( '-I')
241 IF (pinputi==0) pinputi = i
242
243
244 CASE ( '-NSPMD')
245 IF (pncpui==0) pncpui = i
246 CASE ( '-NP')
247 IF (pncpui==0) pncpui = i
248
249
250 CASE ( '-NTHREAD')
251 IF (pnthi==0) pnthi = i
252 CASE ( '-NT')
253 IF (pnthi==0) pnthi = i
254
255
256 CASE ( '-TIMER')
257 IF (ptimer==0) ptimer = i
258
259
260 CASE ( '-DYNAMIC_LIB')
261 IF (puserlnami==0) puserlnami=i
262 CASE ( '-DYLIB')
263 IF (puserlnami==0) puserlnami=i
264
265
266 CASE ( '-MDS_LIBPATH')
267 IF (mds_pathi==0) mds_pathi=i
268
269
270 CASE ( '-MDSDIR')
271 IF (mds_diri==0) mds_diri=i
272
273
274 CASE ( '-MEM-MAP')
275 got_mem_map=1
276
277
278 CASE ( '-INSPIRE')
279 got_inspire=1
280
281
282 CASE('-DD_TUNING')
283 IF(domdec_tuning==0) domdec_tuning=i
284
285
286 CASE ( '-INSPIRE_ALM')
287 got_inspire_alm=1
288
289
290 CASE ( '-HSTP_READ')
291 got_hstp_read = 1
292
293
294 CASE ( '-HSTP_WRITE')
295 got_hstp_write = 1
296
297#ifdef DEBUG_RST
298 CASE ( '-FLUSH_RST')
299 flush_rst_to_txt = .true.
300#endif
301
302
303 CASE('-CHECK')
305 CASE('-RXALEA')
306 randm_alea = i
307 CASE('-RSEED')
308 randm_seed = i
309 CASE('-PYTHON')
310 python_error = 0
311 CASE('-PREVIEW')
312
313 CASE ( '-GRP_SIZE')
314 got_grp_size = i
315
316 CASE ( '-THNMS1')
317 output%TH%DUMP_THNMS1_FILE = 1
318 CASE ( '-CHECKSUM_READ')
319 output%CHECKSUM%ST_CHECKSUM_READ = 1
320 IF (pchecksumi==0) pchecksumi = i
321 CASE DEFAULT
322
323
324 err = 0
325
326 IF (i == 1)THEN
327 err = 1
328 ELSE
329 CALL get_command_argument(i-1,argp)
331 strln=len_trim(argp)
332
333
334 IF (argp == '-I' .OR. argp =='-INPUT' .OR.
335 * argp == '-NP' .OR. argp =='-NSPMD' .OR.
336 * argp == '-NT' .OR. argp =='-NTHREAD'.OR.
337 * argp == '-TIMER' .OR. argp =='-DYLIB'.OR.
338 * argp == '-DYNAMIC_LIB' .OR. argp == '-DD_TUNING'.OR.
339 * argp == '-RSEED' .OR. argp == '-RXALEA'.OR.
340 * argp == '-GRP_SIZE' .OR. argp == '-MDS_LIBPATH' .OR. argp == '-MDSDIR' .OR. argp == '-CHECKSUM_READ' )THEN
341 err = 0
342 ELSE
343 err = 1
344 ENDIF
345 ENDIF
346
347 IF (err == 1)THEN
348 CALL get_command_argument(i,argp)
349 strln=len_trim(argp)
350 WRITE(6,'(A,A)') ' '
351 WRITE(6,'(A,A)') '*** ERROR : Unknown command line argument: ',argp(1:strln)
352 WRITE(6,'(A,A)') ' '
355 ENDIF
356
357 END SELECT
358
359 ELSE
360
361 SELECT CASE (cdl_case)
362
363
364
365
366 CASE(1)
367 args2(:)=''
368 args2(1:len_trim(args)-7) = args(8:len_trim(args))
369 SELECT CASE ( args2(1:len_trim(args2)) )
370
371
372
373 CASE ( 'NORST')
374
376 END SELECT
377
378
379
380
381
382 CASE(2)
383
388 IF(last_letter/=separator) THEN
392 ENDIF
393
394
395
396
397 CASE(3)
398
399
404 IF(last_letter/=separator) THEN
408 ENDIF
409
410 END SELECT
411
412 ENDIF
413 ENDDO
414
415 global_error = 0
416
417
418
419 IF (pexeci==1) THEN
421 ENDIF
422
423
424
425
426 IF (phelpi==1) THEN
428 ENDIF
429
430
431
432
433 IF (ierrmsg /= 0)THEN
434 IF (ierrmsg+1 > argn) THEN
435
436
437
438 CALL get_command_argument(ierrmsg,argp)
439 strln=len_trim(argp)
440 WRITE(6,'(A)') ' '
441 WRITE(6,'(A,A)') '*** ERROR : Missing argument to ',
442 * argp(1:strln)
443
444
445
447 ELSE
448 CALL get_command_argument(ierrmsg+1,inputr)
449 leni=len_trim(inputr)
450
451
452
453 inputc = inputr
455 isin = 0
457 IF ( isin==1 )THEN
458 CALL get_command_argument(pinputi,argp)
459 strln=len_trim(argp)
460
461 WRITE(6,'(A)') ' '
462 WRITE(6,'(A,A)') '*** ERROR : Missing argument to ',
463 * argp(1:strln)
465 ENDIF
468 ENDIF
469 ENDIF
470
471
472
473
474 IF (pchecksumi /= 0)THEN
475
476 IF (pchecksumi + 1 > argn) THEN
477
478 CALL get_command_argument(pchecksumi,argp)
479 strln=len_trim(argp)
480 WRITE(6,'(A)') ' '
481 WRITE(6,'(A,A)') '*** ERROR : Missing argument to ',argp(1:strln)
483 global_error = 1
484
485 ELSE
486 CALL get_command_argument(pchecksumi+1,checksumr)
487 leni=len_trim(checksumr)
488 checksumc = checksumr
490
491
492 isin = 0
494
495 IF ( isin==1 )THEN
496 CALL get_command_argument(pinputi,argp)
497 strln=len_trim(argp)
498 WRITE(6,'(A)') ' '
499 WRITE(6,'(A,A)') '*** ERROR : Missing argument to ',argp(1:strln)
501 global_error = 1
502
503 ELSE
504 output%CHECKSUM%ROOTNAME = ''
505 output%CHECKSUM%ROOTNAME(1:leni) = checksumr(1:leni)
506 ENDIF
507 ENDIF
508 ENDIF
509
510
511
512
513 IF (pinputi /= 0)THEN
514 IF (pinputi+1 > argn) THEN
515
516
517
518 CALL get_command_argument(pinputi,argp)
519 strln=len_trim(argp)
520
521 WRITE(6,'(A)') ' '
522 WRITE(6,'(A,A)') '*** ERROR : Missing argument to ',
523 * argp(1:strln)
524 global_error = 1
525 GOTO 100
526
527 ELSE
528 CALL get_command_argument(pinputi+1,inputr)
529 leni=len_trim(inputr)
530 got_input = 1
531
532
533
534 inputc = inputr
536 isin = 0
538 IF ( isin==1 )THEN
539 CALL get_command_argument(pinputi,argp)
540 strln=len_trim(argp)
541
542 WRITE(6,'(A)') ' '
543 WRITE(6,'(A,A)') '*** error : missing argument to ',
544 * ARGP(1:STRLN)
545 GLOBAL_ERROR = 1
546 GOTO 100
547 ENDIF
548
549 BEGIN=LEN_TRIM(INPUTR)
550 CONDITION = .FALSE.
551.AND..NOT. DO WHILE (BEGIN > 0 CONDITION )
552 C = INPUTR(BEGIN:BEGIN)
553.OR. IF (ICHAR(C)==47 ichar(C)==92) THEN
554 CONDITION=.TRUE.
555 GOTO 150
556 ENDIF
557 BEGIN=BEGIN-1
558 ENDDO
559 150 CONTINUE
560 LENI = LEN_TRIM(INPUTR) - BEGIN
561 BEGIN=BEGIN+1
562 INPUT(1:LENI) = INPUTR(BEGIN:LEN_TRIM(INPUTR))
563
564 IF (BEGIN > 1)THEN
565 GOT_PATH=1
566 LENP=BEGIN-1
567 PATH(1:LENP)=INPUTR(1:LENP)
568 ENDIF
569 ENDIF
570 ELSE
571 ! PINPUTI is 0, which means -input/-i was not set
572 if (PCHECKSUMI == 0)THEN ! -checksum option is set, does not need -i
573 WRITE(6,'(a)') ' '
574 WRITE(6,'(a)
') '*** error : no input deck set.
Use -input [
starter input file]
'
575 WRITE(6,'(a)') ' '
576 CALL PHELPINFO()
577 endif
578 ENDIF
579 100 CONTINUE
580
581
582
583 IF (PNCPUI /= 0)THEN
584
585 IF (PNCPUI+1 > ARGN) THEN
586
587
588
589 CALL GET_COMMAND_ARGUMENT(PNCPUI,ARGP) !GETARG(PNCPUI,ARGP)
590 STRLN=LEN_TRIM(ARGP)
591
592 WRITE(6,'(a)') ' '
593 WRITE(6,'(a,a)') '*** error : missing argument to ',
594 * ARGP(1:STRLN)
595 GLOBAL_ERROR=1
596 GOTO 200
597
598 ELSE
599 CALL GET_COMMAND_ARGUMENT(PNCPUI+1,STRING) !GETARG(PNCPUI+1,STRING)
600
601
602 CALL UPCASE(STRING)
603 ISIN = 0
604 CALL ISANARGUMENT(ARGLIST,LENLIST,STRING,ISIN)
605 IF ( ISIN==1 )THEN
606 CALL GET_COMMAND_ARGUMENT(PNCPUI,ARGP) !GETARG(PNCPUI,ARGP)
607 STRLN=LEN_TRIM(ARGP)
608
609 WRITE(6,'(a)') ' '
610 WRITE(6,'(a,a)') '*** error : missing argument to ',
611 * ARGP(1:STRLN)
612 GLOBAL_ERROR=1
613 GOTO 200
614 ENDIF
615
616 GOT_NCPU = 1
617 CALL GET_COMMAND_ARGUMENT(PNCPUI+1,STRING) !GETARG(PNCPUI+1,STRING)
618 READ(STRING,'(i10)',ERR=999) NCPU
619
620 GOTO 1000
621
622
623 999 CONTINUE
624
625 STRLN=LEN_TRIM(STRING)
626 CALL GET_COMMAND_ARGUMENT(PNCPUI,ARGP) !GETARG(PNCPUI,ARGP)
627 STRLNA=LEN_TRIM(ARGP)
628 WRITE(6,'(a)') ' '
629 WRITE(6,'(a,a,a,a,a)')
630 * '*** error in "',ARGP(1:STRLNA),'" argument : "',
631 * STRING(1:STRLN),'" is not an integer value'
632 GLOBAL_ERROR=1
633 GOTO 200
634
635 1000 CONTINUE
636 ENDIF
637 ENDIF
638
639
640
641
642 IF (PNTHI /= 0)THEN
643
644 IF (PNTHI+1 > ARGN) THEN
645
646
647
648 CALL GET_COMMAND_ARGUMENT(PNTHI,ARGP) !GETARG(PNTHI,ARGP)
649 STRLN=LEN_TRIM(ARGP)
650
651 WRITE(6,'(a)') ' '
652 WRITE(6,'(a,a)') '*** error : missing argument to ',
653 * ARGP(1:STRLN)
654 GLOBAL_ERROR=1
655 GOTO 200
656
657 ELSE
658 CALL GET_COMMAND_ARGUMENT(PNTHI+1,STRING) !GETARG(PNTHI+1,STRING)
659
660
661 CALL UPCASE(STRING)
662 ISIN = 0
663 CALL ISANARGUMENT(ARGLIST,LENLIST,STRING,ISIN)
664 IF ( ISIN==1 )THEN
665 CALL GET_COMMAND_ARGUMENT(PNTHI,ARGP) !GETARG(PNTHI,ARGP)
666 STRLN=LEN_TRIM(ARGP)
667
668 WRITE(6,'(a)') ' '
669 WRITE(6,'(a,a)') '*** error : missing argument to ',
670 * ARGP(1:STRLN)
671 GLOBAL_ERROR=1
672 GOTO 200
673 ENDIF
674
675 GOT_NTH = 1
676 CALL GET_COMMAND_ARGUMENT(PNTHI+1,STRING) !GETARG(PNTHI+1,STRING)
677 READ(STRING,'(i10)',ERR=1999) NTH
678
679 GOTO 2000
680
681
682 1999 CONTINUE
683
684 STRLN=LEN_TRIM(STRING)
685 CALL GET_COMMAND_ARGUMENT(PNTHI,ARGP) !GETARG(PNTHI,ARGP)
686 STRLNA=LEN_TRIM(ARGP)
687 WRITE(6,'(a)') ' '
688 WRITE(6,'(a,a,a,a,a)')
689 * '*** error in "',ARGP(1:STRLNA),'" argument : "',
690 * STRING(1:STRLN),'" is not an integer value'
691 GLOBAL_ERROR=1
692 GOTO 200
693
694 2000 CONTINUE
695 ENDIF
696 ENDIF
697
698
699
700 IF (PUSERLNAMI /= 0)THEN
701 IF (PUSERLNAMI+1 > ARGN) THEN
702
703
704
705 CALL GET_COMMAND_ARGUMENT(PUSERLNAMI,ARGP) !GETARG(PUSERLNAMI,ARGP)
706 STRLN=LEN_TRIM(ARGP)
707
708 WRITE(6,'(a)') ' '
709 WRITE(6,'(a,a)') '*** error : missing argument to ',ARGP(1:STRLN)
710 GLOBAL_ERROR = 1
711
712 ELSE
713 CALL GET_COMMAND_ARGUMENT(PUSERLNAMI+1,USERL_ALTNAME) !GETARG(PUSERLNAMI+1,USERL_ALTNAME)
714 LEN_USERL_ALTNAME=LEN_TRIM(USERL_ALTNAME)
715 GOT_USERL_ALTNAME = 1
716
717
718 ULIBC=''
719 ULIBC(1:LEN_USERL_ALTNAME) = USERL_ALTNAME(1:LEN_USERL_ALTNAME)
720 CALL UPCASE(ULIBC)
721 ISIN = 0
722 CALL ISANARGUMENT(ARGLIST,LENLIST,ULIBC,ISIN)
723 IF ( ISIN==1 )THEN
724 CALL GET_COMMAND_ARGUMENT(PUSERLNAMI,ARGP) !GETARG(PUSERLNAMI,ARGP)
725 STRLN=LEN_TRIM(ARGP)
726
727 WRITE(6,'(a)') ' '
728 WRITE(6,'(a,a)') '*** error : missing argument to ',
729 * ARGP(1:STRLN)
730 GLOBAL_ERROR = 1
731 GOTO 3000
732 ENDIF
733
734 ENDIF ! IF (PUSERLNAMI+1 > ARGN) THEN
735 ENDIF
736 3000 CONTINUE
737
738
739
740 IF (MDS_PATHI /= 0)THEN
741
742 IF (MDS_PATHI+1 > ARGN) THEN
743
744
745
746 CALL GET_COMMAND_ARGUMENT(MDS_PATHI,ARGP)
747 STRLN=LEN_TRIM(ARGP)
748
749 WRITE(6,'(a)') ' '
750 WRITE(6,'(a,a)') '*** error : missing argument to ',ARGP(1:STRLN)
751 GLOBAL_ERROR = 1
752
753 ELSE
754 CALL GET_COMMAND_ARGUMENT(MDS_PATHI+1,MDS_PATH)
755 MDS_PATH_LEN=LEN_TRIM(MDS_PATH)
756
757
758 ULIBC=''
759 ULIBC(1:MDS_PATH_LEN) = MDS_PATH(1:MDS_PATH_LEN)
760 CALL UPCASE(ULIBC)
761 ISIN = 0
762 CALL ISANARGUMENT(ARGLIST,LENLIST,ULIBC,ISIN)
763 IF ( ISIN==1 )THEN
764 CALL GET_COMMAND_ARGUMENT(MDS_PATHI,ARGP) !GETARG(PUSERLNAMI,ARGP)
765 STRLN=LEN_TRIM(ARGP)
766
767 WRITE(6,'(a)') ' '
768 WRITE(6,'(a,a)') '*** error : missing argument to ',
769 * ARGP(1:STRLN)
770 GLOBAL_ERROR = 1
771 GOTO 4000
772 ENDIF
773
774 ENDIF ! IF (MDS_PATHI+1 > ARGN) THEN
775 ENDIF
776 4000 CONTINUE
777
778
779
780 IF (MDS_DIRI /= 0)THEN
781
782 IF (MDS_DIRI+1 > ARGN) THEN
783
784
785
786 CALL GET_COMMAND_ARGUMENT(MDS_DIRI,ARGP)
787 STRLN=LEN_TRIM(ARGP)
788
789 WRITE(6,'(a)') ' '
790 WRITE(6,'(a,a)') '*** error : missing argument to ',ARGP(1:STRLN)
791 GLOBAL_ERROR = 1
792
793 ELSE
794
795 CALL GET_COMMAND_ARGUMENT(MDS_DIRI+1,MDS_PATH)
796 MDS_PATH_LEN=LEN_TRIM(MDS_PATH)
797 ! check if -mdsdir has got an argument or if the next string is an input command
798 ULIBC=''
799 ULIBC(1:MDS_PATH_LEN) = MDS_PATH(1:MDS_PATH_LEN)
800 CALL UPCASE(ULIBC)
801 ISIN = 0
802 CALL ISANARGUMENT(ARGLIST,LENLIST,ULIBC,ISIN)
803 IF ( ISIN==1 )THEN
804 CALL GET_COMMAND_ARGUMENT(MDS_DIRI,ARGP) !GETARG(PUSERLNAMI,ARGP)
805 STRLN=LEN_TRIM(ARGP)
806 WRITE(6,'(a)') ' '
807 WRITE(6,'(a,a)') '*** error : missing argument to ',
808 * ARGP(1:STRLN)
809 GLOBAL_ERROR = 1
810
811 ENDIF
812
813 ENDIF
814 ENDIF
815
816
817
818
819 IF (PTIMER>0) THEN
820 GOT_TIMER = 1
821 ENDIF
822
823
824! ------------------------------------------------
825! Domain decomposition tuning : hidden option
826! ------------------------------------------------
827! DD_OPTIMIZATION = 0 --> default case, DD optimized for Broadwell processor - AVX-2
828! DD_OPTIMIZATION = 1 --> DD optimized for Skylake processor - AVX-512
829! DD_OPTIMIZATION = 2 --> DD optimized for Sandy Bridge processor - SSE3
830! DD_OPTIMIZATION = 3 --> DD optimized for ThunderX2 processor - ARM
831 IF (DOMDEC_TUNING /= 0)THEN
832 IF (DOMDEC_TUNING+1 > ARGN) THEN
833
834
835
836 CALL GET_COMMAND_ARGUMENT(DOMDEC_TUNING,ARGP) !GETARG(DOMDEC_TUNING,ARGP)
837 STRLN=LEN_TRIM(ARGP)
838
839 WRITE(6,'(a)') ' '
840 WRITE(6,'(a,a)') '*** error : missing argument to ',
841 * ARGP(1:STRLN)
842 GLOBAL_ERROR = 1
843
844 ELSE
845 CALL GET_COMMAND_ARGUMENT(DOMDEC_TUNING+1,DOMDEC_CPU_TYPE) !GETARG(DOMDEC_TUNING+1,DOMDEC_CPU_TYPE)
846 LEN_DOMDEC_CPU_TYPE=LEN_TRIM(DOMDEC_CPU_TYPE)
847
848
849 ULIBC(1:LEN_DOMDEC_CPU_TYPE) = DOMDEC_CPU_TYPE(1:LEN_DOMDEC_CPU_TYPE)
850 CALL UPCASE(ULIBC)
851 ISIN = 0
852 CALL ISANARGUMENT(ARGLIST,LENLIST,ULIBC,ISIN)
853 IF ( ISIN==1 )THEN
854 CALL GET_COMMAND_ARGUMENT(DOMDEC_TUNING,ARGP) !GETARG(DOMDEC_TUNING,ARGP)
855 STRLN=LEN_TRIM(ARGP)
856
857 WRITE(6,'(a)') ' '
858 WRITE(6,'(a,a)') '*** error : missing argument to ',
859 * ARGP(1:STRLN)
860 GLOBAL_ERROR = 1
861 GOTO 3010
862 ENDIF
863
864 IF(DOMDEC_CPU_TYPE(1:LEN_DOMDEC_CPU_TYPE)=='avx512') THEN
865 DD_OPTIMIZATION = 1
866 ELSEIF(DOMDEC_CPU_TYPE(1:LEN_DOMDEC_CPU_TYPE)=='sse3') THEN
867 DD_OPTIMIZATION = 2
868 ELSEIF(DOMDEC_CPU_TYPE(1:LEN_DOMDEC_CPU_TYPE)=='armv8.0') THEN
869 DD_OPTIMIZATION = 3
870 ELSEIF(DOMDEC_CPU_TYPE(1:LEN_DOMDEC_CPU_TYPE)=='avx2') THEN
871 DD_OPTIMIZATION = 0
872 ENDIF
873 ENDIF ! IF (DOMDEC_TUNING+1 > ARGN) THEN
874 ELSE
875! Default case : check the os/cpu in order to use the best choice of element costs
876 CALL GET_IBUILTIN_ARCH(DD_OPTIMIZATION)
877! in GET_IBUILTIN_ARCH :
878! 0 - X86-64 Linux AVX-2
879! 1 - X86-64 Linux AVX-512
880! 2 - X86-64 Linux SSE3
881! 3 - ARM64 Linux
882! 4 - X86-64 Windows AVX-2 --> default case AVX-2 ; DD_OPTIMIZATION is set to 0 in grid2mat
883 ENDIF
884! ------------------------------------------------
885! -RXALEA option
886! ------------------------------------------------
887 IF (RANDM_ALEA/=0)THEN
888 IF (RANDM_ALEA+1 > ARGN) THEN
889
890
891
892 CALL GET_COMMAND_ARGUMENT(RANDM_ALEA,ARGP) !GETARG(PNTHI,ARGP)
893 STRLN=LEN_TRIM(ARGP)
894
895 WRITE(6,'(a)') ' '
896 WRITE(6,'(a,a)') '*** error : missing argument to ',
897 * ARGP(1:STRLN)
898 GLOBAL_ERROR=1
899 GOTO 200
900
901 ELSE
902 CALL GET_COMMAND_ARGUMENT(RANDM_ALEA+1,STRING)
903
904
905 CALL UPCASE(STRING)
906 ISIN = 0
907 CALL ISANARGUMENT(ARGLIST,LENLIST,STRING,ISIN)
908 IF ( ISIN==1 )THEN
909 CALL GET_COMMAND_ARGUMENT(RANDM_ALEA,ARGP)
910 STRLN=LEN_TRIM(ARGP)
911
912 WRITE(6,'(a)') ' '
913 WRITE(6,'(a,a)') '*** error : missing argument to ',ARGP(1:STRLN)
914 GLOBAL_ERROR=1
915 GOTO 200
916 ENDIF
917
918
919 CALL GET_COMMAND_ARGUMENT(RANDM_ALEA+1,STRING)
920 READ(STRING,'(f20.0)',ERR=5999) RANDM_ALEA_NBR
921 RAND_STRUCT%CMD=.TRUE.
922 RAND_STRUCT%ALEA_NBR=RANDM_ALEA_NBR
923 RAND_STRUCT%ALEA=.TRUE.
924
925 GOTO 5000
926
927 5999 CONTINUE
928
929 STRLN=LEN_TRIM(STRING)
930 CALL GET_COMMAND_ARGUMENT(RANDM_ALEA,ARGP)
931 STRLNA=LEN_TRIM(ARGP)
932 WRITE(6,'(a)') ' '
933 WRITE(6,'(a,a,a,a,a)')
934 * '*** error in "',ARGP(1:STRLNA),'" argument : "',
935 * STRING(1:STRLN),'" is not an real value'
936 GLOBAL_ERROR=1
937 GOTO 200
938
939 5000 CONTINUE
940 ENDIF
941 ENDIF
942! ------------------------------------------------
943! -RSEED option
944! ------------------------------------------------
945 IF (RANDM_SEED/=0)THEN
946 IF (RANDM_SEED+1 > ARGN) THEN
947
948
949
950 CALL GET_COMMAND_ARGUMENT(RANDM_SEED,ARGP)
951 STRLN=LEN_TRIM(ARGP)
952
953 WRITE(6,'(a)') ' '
954 WRITE(6,'(a,a)') '*** error : missing argument to ',
955 * ARGP(1:STRLN)
956 GLOBAL_ERROR=1
957 GOTO 200
958
959 ELSE
960 CALL GET_COMMAND_ARGUMENT(RANDM_SEED+1,STRING)
961
962
963 CALL UPCASE(STRING)
964 ISIN = 0
965 CALL ISANARGUMENT(ARGLIST,LENLIST,STRING,ISIN)
966 IF ( ISIN==1 )THEN
967 CALL GET_COMMAND_ARGUMENT(RANDM_SEED,ARGP)
968 STRLN=LEN_TRIM(ARGP)
969
970 WRITE(6,'(a)') ' '
971 WRITE(6,'(a,a)') '*** error : missing argument to ',ARGP(1:STRLN)
972 GLOBAL_ERROR=1
973 GOTO 200
974 ENDIF
975
976
977 CALL GET_COMMAND_ARGUMENT(RANDM_SEED+1,STRING)
978 READ(STRING,'(f20.0)',ERR=6999) RANDM_SEED_NBR
979 RAND_STRUCT%CMD=.TRUE.
980 RAND_STRUCT%SEED_NBR=RANDM_SEED_NBR
981 RAND_STRUCT%SEED=.TRUE.
982
983 GOTO 6000
984
985 6999 CONTINUE
986
987 STRLN=LEN_TRIM(STRING)
988 CALL GET_COMMAND_ARGUMENT(RANDM_ALEA,ARGP)
989 STRLNA=LEN_TRIM(ARGP)
990 WRITE(6,'(a)') ' '
991 WRITE(6,'(a,a,a,a,a)')
992 * '*** error in "',ARGP(1:STRLNA),'" argument : "',
993 * STRING(1:STRLN),'" is not an real value'
994 GLOBAL_ERROR=1
995 GOTO 200
996
997 6000 CONTINUE
998 ENDIF
999 ENDIF
1000
1001
1002
1003
1004
1005 IF (GOT_GRP_SIZE /= 0)THEN
1006 IF (GOT_GRP_SIZE+1 > ARGN) THEN
1007
1008
1009 CALL GET_COMMAND_ARGUMENT(GOT_GRP_SIZE,ARGP)
1010 STRLN=LEN_TRIM(ARGP)
1011 WRITE(6,'(a)') ' '
1012 WRITE(6,'(a,a)') '*** error : missing argument to ',
1013 * argp(1:strln)
1014 global_error=1
1015 GOTO 200
1016 ELSE
1017 CALL get_command_argument(got_grp_size+1,string)
1018
1019
1021 isin = 0
1023 IF ( isin==1 )THEN
1024 CALL get_command_argument(got_grp_size,argp)
1025 strln=len_trim(argp)
1026
1027 WRITE(6,'(A)') ' '
1028 WRITE(6,'(A,A)') '*** ERROR : Missing argument to ',
1029 * argp(1:strln)
1030 global_error=1
1031 GOTO 200
1032 ENDIF
1033
1034 got_nth = 1
1035 CALL get_command_argument(got_grp_size+1,string)
1036 READ(string,
'(I10)',err=3999)
grp_size
1038
1039 GOTO 2123
1040
1041
1042 3999 CONTINUE
1043
1044 strln=len_trim(string)
1045 CALL get_command_argument(got_grp_size,argp)
1046 strlna=len_trim(argp)
1047 WRITE(6,'(A)') ' '
1048 WRITE(6,'(A,A,A,A,A)')
1049 * '*** ERROR in "',argp(1:strlna),'" argument : "',
1050 * string(1:strln),'" is not an integer value'
1051 global_error=1
1052 GOTO 200
1053
1054 2123 CONTINUE
1055 ENDIF
1056 ENDIF
1057
1058
1059
1060 3010 CONTINUE
1061
1062
1063
1064 200 CONTINUE
1065 IF (global_error ==1)THEN
1066 WRITE(6,'(A)') ' '
1069 ENDIF
1070
1072
1073
1074 RETURN
integer, parameter infile_char_len
character(len=outfile_char_len) outfile_name
character(len=infile_char_len) infile_name
integer, parameter outfile_char_len
type(random_struct) rand_struct
subroutine read_msgfile(leni, inputr)
subroutine isanargument(arglist, lenlist, arg, isin)
subroutine pexecinfo(idum)
subroutine upcase(string)