48
49
50
51 USE spmd_comm_world_mod, ONLY : spmd_comm_world
52#include "implicit_f.inc"
53
54
55
56#include "warn_c.inc"
57#include "commandline.inc"
58#include "userlib.inc"
59
60
61
62 INTEGER GOT_INPUT,LENI,GOT_PATH,LENP
63 CHARACTER*256 INPUT
64 CHARACTER*2048 PATH
65
66
67
68 INTEGER ARGN
69 INTEGER PHELPI,PEXECI,PINPUTI, PNTHI,PUSERLNAMI,MDS_PATHI
70 INTEGER :: MDS_DIRI
71 INTEGER I,STRL,STRLN,ERR,LENLIST,ISIN,BEGIN,IERRMSG
72 INTEGER IDUM
73 CHARACTER*2096 ARGS,INPUTC,INPUTR,MSG,STRING
74 LOGICAL :: CONDITION
75 CHARACTER C
76 INTEGER IARGC,CDL_CASE,IJK
77 CHARACTER :: LAST_LETTER,SEPARATOR
78 CHARACTER(LEN=2096) ARGS2,ARGS_REDUCE,ARGP
79 CHARACTER(LEN=4096) ULIBC
80 parameter(lenlist=20)
81 CHARACTER(LEN=12):: ARGLIST(LENLIST)
82 EXTERNAL iargc
83 DATA arglist/
84 . '-VERSION', '-V',
85 . '-HELP' , '-H',
86 . '-INPUT' , '-I',
87 . '-NTHREAD' , '-NT',
88 . '-ERROR_MSG','-EM',
89 . '-NOTRAP',
90 . '-DYNAMIC_LIB',
91 . '-DYLIB',
92 . '-MEM-MAP' ,
93 . '-INSPIRE',
94 . '-PREVIEW',
95 . '-INSPIRE_ALM','-NORST',
96 . '-MDS_LIBPATH','-MDSDIR'/
97
98 idum=-1
99 got_input = 0
100 got_nth = 0
101 input=' '
102 leni=0
103 phelpi = 0
104 pexeci = 0
105 pinputi = 0
106 pnthi= 0
107 ierrmsg=0
108 puserlnami = 0
109 got_userl_altname=0
110 got_mem_map=0
111 got_inspire=0
112 got_inspire_alm=0
113 mds_path_len = 0
114 mds_pathi = 0
115 mds_diri = 0
117
118
119 mds_path=''
120
121
122
124
125
133
134#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
135 separator='\'
136#elif 1
137 separator='/'
138#endif
139
140 argn = command_argument_count()
141
142 DO i=1,argn
143 CALL getarg(i,args)
144 strl=len_trim(args)
145
146 args2(1:2096) = ''
147 args2(1:strl) = args(1:strl)
149
150 args_reduce(1:9) = args(1:9)
151 cdl_case = 0
152 IF(args_reduce(1:9)=='-OUTFILE=') cdl_case = 1
153 IF(args_reduce(1:8)=='-INFILE=') cdl_case = 2
154 IF(cdl_case==0) THEN
155 SELECT CASE (args)
156
157
158 CASE ( '-NOTRAP')
159 itrace = -1
160
161
162 CASE ( '-VERSION')
163 pexeci = 1
164 CASE ( '-V')
165 pexeci = 1
166
167
168 CASE ( '-HELP')
169 phelpi = 1
170 CASE ( '-H')
171 phelpi = 1
172
173
174 CASE ( '-ERROR_MSG')
175 ierrmsg = i
176 CASE ( '-EM')
177 ierrmsg = i
178
179
180 CASE ( '-INPUT')
181 IF (pinputi==0) pinputi = i
182 CASE ( '-I')
183 IF (pinputi==0) pinputi = i
184
185
186 CASE ( '-RST')
187 err = 0
188
189
190 CASE ( '--')
191 err = 0
192
193
194 CASE ( '-NTHREAD')
195 IF (pnthi==0) pnthi = i
196 CASE ( '-NT')
197 IF (pnthi==0) pnthi = i
198
199
200 CASE ( '-DYNAMIC_LIB')
201 IF (puserlnami==0) puserlnami=i
202 CASE ( '-DYLIB')
203 IF (puserlnami==0) puserlnami=i
204
205
206 CASE ( '-MDS_LIBPATH')
207 IF (mds_pathi==0) mds_pathi=i
208
209
210 CASE ( '-MDSDIR')
211 IF (mds_diri==0) mds_diri=i
212
213
214 CASE ( '-MEM-MAP')
215 got_mem_map=1
216 CASE ( '-PREVIEW')
218 CASE ( '-INSPIRE_ALM')
219 got_inspire_alm=1
220 CASE ( '-INSPIRE')
221 got_inspire=1
222
223
224 CASE ( '-NORST')
226
227
228 CASE DEFAULT
229 err = 0
230 IF (i == 1)THEN
231 err = 1
232 ELSE
233 CALL getarg(i-1,argp)
235 strln=len_trim(argp)
236
237 IF (argp == '-I' .OR. argp =='-INPUT' .OR.
238 * argp == '-RST' .OR. argp =='-NT' .OR.
239 * argp == '-NTHREAD' .OR.
240 * argp == '-DYLIB' .OR. argp =='-DYNAMIC_LIB'.OR.
241 * argp == '-MDS_LIBPATH' .OR. argp == '-MDSDIR' )THEN
242 err = 0
243 ELSE
244 err = 1
245 ENDIF
246 ENDIF
247
248
249 IF (err == 1.AND.strl>4)THEN
250 IF (args(strl-3:strl)=='.XML')THEN
251 err = 0
252 ENDIF
253 ENDIF
254 IF (err == 1)THEN
255 CALL getarg(i,argp)
256 strln=len_trim(argp)
259 ENDIF
260
261 END SELECT
262 ELSE
263
264 SELECT CASE(cdl_case)
265
266
267
268 CASE(1)
269
275 ENDDO
276 IF(last_letter/=separator) THEN
280 ENDIF
281
282
283
284 CASE(2)
290 ENDDO
291 IF(last_letter/=separator) THEN
295 ENDIF
296 END SELECT
297
298 ENDIF
299 ENDDO
300
301
302
303 IF (pexeci==1) THEN
305 ENDIF
306
307
308
309
310 IF (phelpi==1) THEN
311 msg= ' '
313 ENDIF
314
315
316
317
318 IF (ierrmsg /= 0)THEN
319 IF (ierrmsg+1 > argn) THEN
320
321
322
323 CALL getarg(ierrmsg,argp)
324 strln=len_trim(argp)
325 msg = argp
328 ELSE
329 CALL getarg(ierrmsg+1,inputr)
330 leni=len_trim(inputr)
331
332
333
334 inputc = inputr
336 isin = 0
338 IF ( isin==1 )THEN
339 CALL getarg(pinputi,argp)
340 strln=len_trim(argp)
341 msg=argp
344 ENDIF
347 ENDIF
348 ENDIF
349
350
351
352
353 IF (pinputi /= 0)THEN
354 IF (pinputi+1 > argn) THEN
355
356
357
358 CALL getarg(pinputi,argp)
359 strln=len_trim(argp)
360 msg = argp
363 ELSE
364 CALL getarg(pinputi+1,inputr)
365 leni=len_trim(inputr)
366 got_input = 1
367
368
369
370 inputc = inputr
372 isin = 0
374 IF ( isin==1 )THEN
375 CALL getarg(pinputi,argp)
376 strln=len_trim(argp)
377 msg=argp
380 ENDIF
381
382 begin=len_trim(inputr)
383 condition = .false.
384 DO WHILE (begin > 0 .AND. .NOT.condition)
385 c = inputr(begin:begin)
386 IF (ichar(c)==47 .OR. ichar(c)==92) THEN
387 condition=.true.
388 GOTO 150
389 ENDIF
390 begin=begin-1
391 ENDDO
392 150 CONTINUE
393 leni = len_trim(inputr) - begin
394 begin=begin+1
395 input(1:leni) = inputr(begin:len_trim(inputr))
396
397 IF (begin > 1)THEN
398 got_path=1
399 lenp=begin-1
400 path(1:lenp)=inputr(1:lenp)
401 ENDIF
402 ENDIF
403 ELSE
404
405 msg= ' '
408 ENDIF
409
410
411
412
413 IF (pnthi /= 0)THEN
414 IF (pnthi+1 > argn) THEN
415
416 CALL getarg(pnthi,argp)
417 strln=len_trim(argp)
418 msg = argp
421 ELSE
422 CALL getarg(pnthi+1,string)
423
425 isin = 0
427 IF ( isin==1 )THEN
428 CALL getarg(pnthi,argp)
429 strln=len_trim(argp)
430 msg=argp
433 END IF
434 got_nth = 1
435
436 CALL getarg(pnthi+1,string)
437 READ(string,'(I10)',err=1999) nth
438
439 GOTO 2000
440 1999 CONTINUE
441
442 strln=len_trim(string)
443
444 msg=string
447 2000 CONTINUE
448 ENDIF
449 ENDIF
450
451
452
453 IF (puserlnami /= 0)THEN
454 IF (puserlnami+1 > argn) THEN
455
456
457
458 CALL getarg(puserlnami,argp)
459 strln=len_trim(argp)
461
462 ELSE
463 CALL getarg(puserlnami+1,userl_altname)
464 len_userl_altname=len_trim(userl_altname)
465 got_userl_altname = 1
466
467 ulibc=''
468 ulibc(1:len_userl_altname) = userl_altname(1:len_userl_altname)
470 isin = 0
472 IF ( isin==1 )THEN
473 CALL getarg(puserlnami,argp)
474 strln=len_trim(argp)
477 ENDIF
478
479 ENDIF
480 ENDIF
481
482
483
484 IF (mds_pathi /= 0)THEN
485
486 IF (mds_pathi+1 > argn) THEN
487
488
489
490 CALL get_command_argument(mds_pathi,argp)
491 strln=len_trim(argp)
493
494 ELSE
495 CALL get_command_argument(mds_pathi+1,mds_path)
496 mds_path_len=len_trim(mds_path)
497
498
499 ulibc=''
500 ulibc(1:mds_path_len) = mds_path(1:mds_path_len)
502 isin = 0
504
505 IF ( isin==1 )THEN
506 CALL getarg(mds_pathi,argp)
507 strln=len_trim(argp)
510 ENDIF
511
512 ENDIF
513 ENDIF
514
515
516
517 IF (mds_diri /= 0)THEN
518
519 IF (mds_diri+1 > argn) THEN
520
521
522 CALL get_command_argument(mds_diri,argp)
523 strln=len_trim(argp)
525
526 ELSE
527
528 CALL get_command_argument(mds_diri+1,mds_path)
529 mds_path_len=len_trim(mds_path)
530
531
532 ulibc=''
533 ulibc(1:mds_path_len) = mds_path(1:mds_path_len)
535 isin = 0
537
538 IF ( isin==1 )THEN
539 CALL getarg(mds_diri,argp)
540 strln=len_trim(argp)
543 ENDIF
544
545 ENDIF
546 ENDIF
547
548
subroutine phelpinfo(errn, emsg, smsg)
subroutine isanargument(arglist, lenlist, arg, isin)
subroutine pexecinfo(idum)
subroutine upcase(string)
integer, parameter infile_char_len
character(len=outfile_char_len) outfile_name
character(len=infile_char_len) infile_name
integer, parameter outfile_char_len
subroutine read_msgfile(leni, inputr)