Line data Source code
1 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3 : !!!!
4 : !!!! MIT License
5 : !!!!
6 : !!!! ParaMonte: plain powerful parallel Monte Carlo library.
7 : !!!!
8 : !!!! Copyright (C) 2012-present, The Computational Data Science Lab
9 : !!!!
10 : !!!! This file is part of the ParaMonte library.
11 : !!!!
12 : !!!! Permission is hereby granted, free of charge, to any person obtaining a
13 : !!!! copy of this software and associated documentation files (the "Software"),
14 : !!!! to deal in the Software without restriction, including without limitation
15 : !!!! the rights to use, copy, modify, merge, publish, distribute, sublicense,
16 : !!!! and/or sell copies of the Software, and to permit persons to whom the
17 : !!!! Software is furnished to do so, subject to the following conditions:
18 : !!!!
19 : !!!! The above copyright notice and this permission notice shall be
20 : !!!! included in all copies or substantial portions of the Software.
21 : !!!!
22 : !!!! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
23 : !!!! EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
24 : !!!! MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
25 : !!!! IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
26 : !!!! DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
27 : !!!! OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE
28 : !!!! OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
29 : !!!!
30 : !!!! ACKNOWLEDGMENT
31 : !!!!
32 : !!!! ParaMonte is an honor-ware and its currency is acknowledgment and citations.
33 : !!!! As per the ParaMonte library license agreement terms, if you use any parts of
34 : !!!! this library for any purposes, kindly acknowledge the use of ParaMonte in your
35 : !!!! work (education/research/industry/development/...) by citing the ParaMonte
36 : !!!! library as described on this page:
37 : !!!!
38 : !!!! https://github.com/cdslaborg/paramonte/blob/main/ACKNOWLEDGMENT.md
39 : !!!!
40 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
41 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
42 :
43 : !> \brief This module contains classes and procedures for handling IO files.
44 : !> \author Amir Shahmoradi
45 :
46 : module File_mod
47 :
48 : use Path_mod, only: Path_type
49 : use Err_mod, only: Err_type
50 :
51 : implicit none
52 :
53 : character(*), parameter :: MODULE_NAME = "@File_mod"
54 :
55 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
56 :
57 : type :: Action_type
58 : character(:), allocatable :: value ! = read, write, readwrite, undefined. Default is processor-dependent.
59 : logical :: isRead = .false.
60 : logical :: isWrite = .false.
61 : logical :: isReadWrite = .false.
62 : logical :: isUndefined = .false.
63 : type(Err_type) :: Err
64 : end type Action_type
65 :
66 : interface Action_type
67 : module procedure :: constructAction
68 : end interface
69 :
70 : type :: Access_type
71 : character(:), allocatable :: value ! = sequential (default), direct, undefined
72 : logical :: isSequential = .false.
73 : logical :: isDirect = .false.
74 : logical :: isUndefined = .false.
75 : type(Err_type) :: Err
76 : end type Access_type
77 :
78 : interface Access_type
79 : module procedure :: constructAccess
80 : end interface
81 :
82 : type :: Form_type
83 : character(:), allocatable :: value ! = formatted, unformatted (default depends on ACCESS), undefined.
84 : logical :: isFormatted = .false.
85 : logical :: isUnformatted = .false.
86 : logical :: isUndefined = .false.
87 : type(Err_type) :: Err
88 : end type Form_type
89 :
90 : interface Form_type
91 : module procedure :: constructForm
92 : end interface
93 :
94 : type :: Blank_type
95 : character(:), allocatable :: value ! = null (default), zero, undefined.
96 : logical :: isNull = .false.
97 : logical :: isZero = .false.
98 : logical :: isUndefined = .false.
99 : type(Err_type) :: Err
100 : end type Blank_type
101 :
102 : interface Blank_type
103 : module procedure :: constructBlank
104 : end interface
105 :
106 : type :: Position_type
107 : character(:), allocatable :: value ! = asis (default), rewind, append, undefined. For ACCESS=sequential.
108 : logical :: isAsis = .false.
109 : logical :: isRewind = .false.
110 : logical :: isAppend = .false.
111 : logical :: isUndefined = .false.
112 : type(Err_type) :: Err
113 : end type Position_type
114 :
115 : interface Position_type
116 : module procedure :: constructPosition
117 : end interface
118 :
119 : type :: Delim_type
120 : character(:), allocatable :: value ! = quote, apostrophe, undefined, or none (default).
121 : logical :: isQuote = .false.
122 : logical :: isApostrophe = .false.
123 : logical :: isNone = .false.
124 : logical :: isUndefined = .false.
125 : type(Err_type) :: Err
126 : end type Delim_type
127 :
128 : interface Delim_type
129 : module procedure :: constructDelim
130 : end interface
131 :
132 : type :: Pad_type
133 : character(:), allocatable :: value ! = yes (default), no, undefined.
134 : logical :: isPadded = .false.
135 : logical :: isNotPadded = .false.
136 : logical :: isUndefined = .false.
137 : type(Err_type) :: Err
138 : end type Pad_type
139 :
140 : interface Pad_type
141 : module procedure :: constructPad
142 : end interface
143 :
144 : type :: Round_type
145 : character(:), allocatable :: value ! = up, down, zero, nearest, compatible, processor_defined, or undefined.
146 : logical :: isUp = .false.
147 : logical :: isDown = .false.
148 : logical :: isZero = .false.
149 : logical :: isNearest = .false.
150 : logical :: isCompatible = .false.
151 : logical :: isProcessDefined = .false.
152 : logical :: isUndefined = .false.
153 : type(Err_type) :: Err
154 : end type Round_type
155 :
156 : interface Round_type
157 : module procedure :: constructRound
158 : end interface
159 :
160 : type :: Sign_type
161 : character(:), allocatable :: value ! = suppress, plus, processor_defined, or undefined.
162 : logical :: isSuppress = .false.
163 : logical :: isPlus = .false.
164 : logical :: isProcessDefined = .false.
165 : logical :: isUndefined = .false.
166 : type(Err_type) :: Err
167 : end type Sign_type
168 :
169 : interface Sign_type
170 : module procedure :: constructSign
171 : end interface
172 :
173 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
174 :
175 : type :: File_type
176 : integer :: unit = -huge(0)
177 : integer :: number = -huge(0)
178 : integer :: recl = -huge(0)
179 : logical :: exists = .false.
180 : logical :: isOpen = .false.
181 : logical :: isNamed = .false.
182 : logical :: isInternal = .false.
183 : logical :: isNumbered = .false.
184 : character(:), allocatable :: status ! = old, new, replace, scratch, unknown (default).
185 : character(:), allocatable :: asynchronous ! = yes, no
186 : character(:), allocatable :: format ! the specific content format statement to be used with read/write statements.
187 : character(:), allocatable :: nameByCompiler
188 : type(Action_type) :: Action
189 : type(Access_type) :: Access
190 : type(Form_type) :: Form
191 : type(Blank_type) :: Blank
192 : type(Position_type) :: Position
193 : type(Delim_type) :: Delim
194 : type(Pad_type) :: Pad
195 : type(Round_type) :: Round
196 : type(Sign_type) :: Sign
197 : type(Path_type) :: Path
198 : type(Err_type) :: Err
199 : contains
200 : procedure, pass :: openFile
201 : procedure, pass :: closeFile
202 : procedure, nopass :: getNumber
203 : procedure, nopass :: getPosition
204 : procedure, nopass :: getAction
205 : procedure, nopass :: getDelim
206 : procedure, nopass :: getRecl
207 : procedure, nopass :: getBlank
208 : procedure, nopass :: getOpenStatus
209 : procedure, nopass :: getExistStatus
210 : procedure, nopass :: getInqErr
211 : procedure, nopass :: getReadErr
212 : procedure, nopass :: getOpenErr
213 : procedure, nopass :: getCloseErr
214 : procedure, nopass :: getWriteErr
215 : end type File_type
216 :
217 : interface File_type
218 : module procedure :: constructFile
219 : end interface
220 :
221 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
222 :
223 : contains
224 :
225 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
226 :
227 171 : function constructFile( unit, recl, path, status, position, access, form, action, delim &
228 : , round, sign,pad, blank, format, asynchronous &
229 : , OS &
230 : ) result(File)
231 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
232 : !DEC$ ATTRIBUTES DLLEXPORT :: constructFile
233 : #endif
234 :
235 : use String_mod, only: getLowerCase
236 : use System_mod, only: OS_type
237 : implicit none
238 : type(File_type) :: File
239 : integer , intent(in), optional :: unit
240 : integer , intent(in), optional :: recl
241 : character(*), intent(in), optional :: status
242 : character(*), intent(in), optional :: asynchronous
243 : character(*), intent(in), optional :: access
244 : character(*), intent(in), optional :: position
245 : character(*), intent(in), optional :: form
246 : character(*), intent(in), optional :: action
247 : character(*), intent(in), optional :: delim
248 : character(*), intent(in), optional :: round
249 : character(*), intent(in), optional :: sign
250 : character(*), intent(in), optional :: pad
251 : character(*), intent(in), optional :: blank
252 : character(*), intent(in), optional :: path
253 : character(*), intent(in), optional :: format
254 : type(OS_type), intent(in), optional :: OS
255 :
256 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@constructFile()"
257 :
258 171 : File%Err%occurred = .false.
259 171 : File%Err%stat = -huge(0)
260 171 : File%Err%msg = ""
261 :
262 171 : if (present(unit)) then
263 2 : File%unit = unit
264 : else
265 169 : File%unit = -huge(0)
266 : end if
267 :
268 171 : if (present(recl)) then
269 2 : File%recl = recl
270 : else
271 169 : File%recl = -huge(0)
272 : end if
273 :
274 : ! set up file path
275 :
276 171 : if (present(path)) then
277 : !write(*,*) OS%slash
278 : !write(*,*) OS%isWindows
279 : !write(*,*) path
280 170 : File%Path = path_type(inputPath=path,OS=OS)
281 : else
282 1 : File%Path = path_type(inputPath="",OS=OS)
283 : end if
284 : !write(*,*) File%Path%original
285 : !write(*,*) File%Path%modified
286 171 : if (File%Path%Err%occurred) then
287 : ! LCOV_EXCL_START
288 : File%Err = File%Path%Err
289 : File%Err%msg = PROCEDURE_NAME // File%Err%msg
290 : return
291 : end if
292 : ! LCOV_EXCL_STOP
293 :
294 : ! check if file exists
295 :
296 : call File%getExistStatus( exists = File%exists &
297 : , Err = File%err &
298 171 : , file = File%Path%modified )
299 171 : if (File%Err%occurred) then
300 : ! LCOV_EXCL_START
301 : File%Err%msg = PROCEDURE_NAME // File%Err%msg
302 : return
303 : end if
304 : ! LCOV_EXCL_STOP
305 :
306 : ! if it does not exist, try the original file path
307 :
308 171 : if (.not.File%exists) then
309 : call File%getExistStatus( exists = File%exists &
310 : , Err = File%err &
311 163 : , file = File%Path%original )
312 163 : if (File%exists) File%Path%modified = File%Path%original ! restore the original path, which is apparently the correct path
313 : end if
314 171 : if (File%Err%occurred) then
315 : ! LCOV_EXCL_START
316 : File%Err%msg = PROCEDURE_NAME // File%Err%msg
317 : return
318 : end if
319 : ! LCOV_EXCL_STOP
320 :
321 : ! set up the rest of attributes
322 :
323 171 : if (present(format)) then
324 2 : File%format = trim(adjustl(format))
325 : else
326 169 : File%format = ""
327 : end if
328 :
329 171 : if (present(status)) then
330 170 : File%status = getLowerCase(trim(adjustl(status)))
331 : else
332 1 : File%status = "unknown"
333 : end if
334 :
335 171 : if (present(asynchronous)) then
336 2 : File%asynchronous = getLowerCase(trim(adjustl(asynchronous)))
337 : else
338 169 : File%asynchronous = "no"
339 : end if
340 :
341 171 : File%Action = Action_type(action)
342 171 : If (File%Action%Err%occurred) then
343 : ! LCOV_EXCL_START
344 : File%Err = File%Action%Err
345 : File%Err%msg = PROCEDURE_NAME // File%Err%msg
346 : return
347 : end if
348 : ! LCOV_EXCL_STOP
349 :
350 171 : File%Delim = Delim_type(delim)
351 171 : If (File%Delim%Err%occurred) then
352 : ! LCOV_EXCL_START
353 : File%Err = File%Delim%Err
354 : File%Err%msg = PROCEDURE_NAME // File%Err%msg
355 : return
356 : end if
357 : ! LCOV_EXCL_STOP
358 :
359 171 : File%Access = Access_type(access)
360 171 : If (File%Access%Err%occurred) then
361 : ! LCOV_EXCL_START
362 : File%Err = File%Access%Err
363 : File%Err%msg = PROCEDURE_NAME // File%Err%msg
364 : return
365 : end if
366 : ! LCOV_EXCL_STOP
367 :
368 171 : File%Position = Position_type(position)
369 : ! LCOV_EXCL_START
370 : If (File%Position%Err%occurred) then
371 : File%Err = File%Position%Err
372 : File%Err%msg = PROCEDURE_NAME // File%Err%msg
373 : return
374 : end if
375 : ! LCOV_EXCL_STOP
376 :
377 171 : if (present(form)) then
378 1 : File%form = Form_type(form)
379 : else
380 170 : if ( File%Access%isDirect ) then
381 1 : File%Form = Form_type("unformatted")
382 : else ! if ( File%Access%isSequential ) then
383 169 : File%Form = Form_type("formatted")
384 : end if
385 : end if
386 : ! LCOV_EXCL_START
387 : If (File%Form%Err%occurred) then
388 : File%Err = File%Form%Err
389 : File%Err%msg = PROCEDURE_NAME // File%Err%msg
390 : return
391 : end if
392 : ! LCOV_EXCL_STOP
393 :
394 171 : File%Round = Round_type(round)
395 : ! LCOV_EXCL_START
396 : If (File%Round%Err%occurred) then
397 : File%Err = File%Round%Err
398 : File%Err%msg = PROCEDURE_NAME // File%Err%msg
399 : return
400 : end if
401 : ! LCOV_EXCL_STOP
402 :
403 171 : File%Sign = Sign_type(sign)
404 171 : If (File%Sign%Err%occurred) then
405 : ! LCOV_EXCL_START
406 : File%Err = File%Sign%Err
407 : File%Err%msg = PROCEDURE_NAME // File%Err%msg
408 : return
409 : end if
410 : ! LCOV_EXCL_STOP
411 :
412 171 : File%Pad = Pad_type(pad)
413 171 : If (File%Pad%Err%occurred) then
414 : ! LCOV_EXCL_START
415 : File%Err = File%Pad%Err
416 : File%Err%msg = PROCEDURE_NAME // File%Err%msg
417 : return
418 : end if
419 : ! LCOV_EXCL_STOP
420 :
421 171 : File%Blank = Blank_type(blank)
422 171 : If (File%Blank%Err%occurred) then
423 : ! LCOV_EXCL_START
424 : File%Err = File%Blank%Err
425 : File%Err%msg = PROCEDURE_NAME // File%Err%msg
426 : return
427 : end if
428 : ! LCOV_EXCL_STOP
429 :
430 171 : File%nameByCompiler = ""
431 :
432 171 : end function constructFile
433 :
434 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
435 :
436 : ! subroutine inquireFile(Self,unit,file)
437 : ! use Path_mod, only: MAX_FILE_PATH_LEN
438 : ! use String_mod, only: num2str
439 : ! implicit none
440 : ! class(File_type), intent(inout) :: Self
441 : ! integer , intent(in), optional :: unit
442 : ! character(*) , intent(in), optional :: file
443 : ! character(*) , parameter :: PROCEDURE_NAME = MODULE_NAME // "@inquireFile()"
444 :
445 : ! Self%Err%msg = ""
446 : ! Self%Err%occurred = .false.
447 :
448 : ! if (allocated(Self%nameByCompiler)) deallocate(Self%nameByCompiler)
449 : ! allocate( character(MAX_FILE_PATH_LEN) :: Self%nameByCompiler )
450 :
451 : ! if (allocated(Self%Access%value)) deallocate(Self%access)
452 : ! allocate( character(63) :: Self%access )
453 :
454 : ! if (allocated(Self%form)) deallocate(Self%form)
455 : ! allocate( character(63) :: Self%form )
456 :
457 :
458 : ! if (present(unit)) then
459 : ! inquire( unit = unit &
460 : ! , exist = Self%exists &
461 : ! , opened = Self%isOpen &
462 : ! , number = Self%number &
463 : ! , named = Self%isNamed &
464 : ! , name = Self%nameByCompiler &
465 : ! , access = Self%access &
466 : ! , iostat = Err%stat &
467 : ! )
468 :
469 : ! if (Err%stat>0) then
470 : ! Err%occurred = .true.
471 : ! Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file with unit=" // num2str(unit) // "."
472 : ! return
473 : ! end if
474 : ! if (present(file)) then
475 : ! inquire(file=file,exist=exists,iostat=Err%stat)
476 : ! if (Err%stat>0) then
477 : ! Err%occurred = .true.
478 : ! Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file with name=" // file // "."
479 : ! return
480 : ! end if
481 : ! else
482 : ! Err%occurred = .true.
483 : ! Err%msg = PROCEDURE_NAME // ": At least one of the two input arguments (unit,path) must be provided."
484 : ! return
485 : ! end if
486 : ! if (Self%number==-1) Self%isNumbered = .false.
487 : ! Self%nameByCompiler = trim(adjustl(Self%nameByCompiler))
488 : ! end subroutine inquireFile
489 :
490 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
491 :
492 671 : subroutine getExistStatus(exists,Err,unit,file)
493 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
494 : !DEC$ ATTRIBUTES DLLEXPORT :: getExistStatus
495 : #endif
496 171 : use String_mod, only: num2str
497 : use Err_mod, only: Err_type
498 : implicit none
499 : logical, intent(out) :: exists
500 : type(Err_type), intent(out) :: Err
501 : integer, intent(in), optional :: unit
502 : character(*), intent(in), optional :: file
503 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@getExistStatus()"
504 337 : Err%msg = ""
505 337 : Err%occurred = .false.
506 337 : if (present(unit) .and. present(file)) then
507 1 : Err%occurred = .true.
508 1 : Err%msg = PROCEDURE_NAME // ": Only one of the two optional arguments (unit, file) must be provided as input."
509 1 : return
510 336 : elseif (present(unit)) then
511 1 : inquire(unit=unit,exist=exists,iostat=Err%stat)
512 1 : if (Err%stat>0) then
513 : ! LCOV_EXCL_START
514 : Err%occurred = .true.
515 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file with unit=" // num2str(unit) // "."
516 : return
517 : end if
518 : ! LCOV_EXCL_STOP
519 335 : elseif (present(file)) then
520 334 : inquire(file=file,exist=exists,iostat=Err%stat)
521 334 : if (Err%stat>0) then
522 : ! LCOV_EXCL_START
523 : Err%occurred = .true.
524 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file with name=" // file // "."
525 : return
526 : end if
527 : ! LCOV_EXCL_STOP
528 : else
529 1 : Err%occurred = .true.
530 1 : Err%msg = PROCEDURE_NAME // ": At least one of the two input arguments (unit,path) must be provided."
531 1 : return
532 : end if
533 337 : end subroutine getExistStatus
534 :
535 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
536 :
537 4 : subroutine getOpenStatus(isOpen,Err,unit,file)
538 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
539 : !DEC$ ATTRIBUTES DLLEXPORT :: getOpenStatus
540 : #endif
541 337 : use String_mod, only: num2str
542 : use Err_mod, only: Err_type
543 : implicit none
544 : logical, intent(out) :: isOpen
545 : type(Err_type), intent(out) :: Err
546 : integer, intent(in), optional :: unit
547 : character(*), intent(in), optional :: file
548 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@getOpenStatus()"
549 4 : Err%msg = ""
550 4 : Err%occurred = .false.
551 4 : if (present(unit) .and. present(file)) then
552 1 : Err%occurred = .true.
553 1 : Err%msg = PROCEDURE_NAME // ": Only one of the two optional arguments (unit, file) must be provided as input."
554 1 : return
555 3 : elseif (present(unit)) then
556 1 : inquire(unit=unit,opened=isOpen,iostat=Err%stat)
557 1 : if (Err%stat>0) then
558 : ! LCOV_EXCL_START
559 : Err%occurred = .true.
560 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file with unit=" // num2str(unit) // "."
561 : return
562 : end if
563 : ! LCOV_EXCL_STOP
564 2 : elseif (present(file)) then
565 1 : inquire(file=file,opened=isOpen,iostat=Err%stat)
566 1 : if (Err%stat>0) then
567 : ! LCOV_EXCL_START
568 : Err%occurred = .true.
569 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file with name=" // file // "."
570 : return
571 : end if
572 : ! LCOV_EXCL_STOP
573 : else
574 1 : Err%occurred = .true.
575 1 : Err%msg = PROCEDURE_NAME // ": At least one of the two input arguments (unit,path) must be provided."
576 1 : return
577 : end if
578 4 : end subroutine getOpenStatus
579 :
580 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
581 :
582 4 : subroutine getNumber(isNumbered,number,Err,unit,file)
583 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
584 : !DEC$ ATTRIBUTES DLLEXPORT :: getNumber
585 : #endif
586 4 : use String_mod, only: num2str
587 : use Err_mod, only: Err_type
588 : implicit none
589 : logical, intent(out) :: isNumbered
590 : integer, intent(out) :: number
591 : type(Err_type), intent(out) :: Err
592 : integer, intent(in), optional :: unit
593 : character(*), intent(in), optional :: file
594 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@getNumber()"
595 4 : Err%msg = ""
596 4 : Err%occurred = .false.
597 4 : isNumbered = .true.
598 4 : if (present(unit) .and. present(file)) then
599 1 : Err%occurred = .true.
600 1 : Err%msg = PROCEDURE_NAME // ": Only one of the two optional arguments (unit, file) must be provided as input."
601 1 : return
602 3 : elseif (present(unit)) then
603 1 : inquire(unit=unit,number=number,iostat=Err%stat)
604 1 : if (Err%stat>0) then
605 : ! LCOV_EXCL_START
606 : Err%occurred = .true.
607 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file with unit=" // num2str(unit) // "."
608 : return
609 : end if
610 : ! LCOV_EXCL_STOP
611 2 : elseif (present(file)) then
612 1 : inquire(file=file,number=number,iostat=Err%stat)
613 1 : if (Err%stat>0) then
614 : ! LCOV_EXCL_START
615 : Err%occurred = .true.
616 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file with name=" // file // "."
617 : return
618 : end if
619 : ! LCOV_EXCL_STOP
620 : else
621 1 : Err%occurred = .true.
622 1 : Err%msg = PROCEDURE_NAME // ": At least one of the two input arguments (unit,path) must be provided."
623 1 : return
624 : end if
625 2 : if (number==-1) isNumbered = .false.
626 4 : end subroutine getNumber
627 :
628 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
629 :
630 4 : subroutine getName(isNamed,nameByCompiler,Err,unit,file)
631 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
632 : !DEC$ ATTRIBUTES DLLEXPORT :: getName
633 : #endif
634 4 : use String_mod, only: num2str
635 : use Path_mod, only: MAX_FILE_PATH_LEN
636 : use Err_mod, only: Err_type
637 : implicit none
638 : logical, intent(out) :: isNamed
639 : character(:), allocatable, intent(out) :: nameByCompiler
640 : type(Err_type), intent(out) :: Err
641 : integer, intent(in), optional :: unit
642 : character(*), intent(in), optional :: file
643 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@getName()"
644 4 : Err%msg = ""
645 4 : Err%occurred = .false.
646 4 : allocate( character(MAX_FILE_PATH_LEN) :: nameByCompiler )
647 4 : if (present(unit) .and. present(file)) then
648 1 : Err%occurred = .true.
649 1 : Err%msg = PROCEDURE_NAME // ": Only one of the two optional arguments (unit, file) must be provided as input."
650 1 : return
651 3 : elseif (present(unit)) then
652 1 : inquire(unit=unit,named=isNamed,name=nameByCompiler,iostat=Err%stat)
653 1 : if (Err%stat>0) then
654 : ! LCOV_EXCL_START
655 : Err%occurred = .true.
656 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file with unit=" // num2str(unit) // "."
657 : return
658 : end if
659 : ! LCOV_EXCL_STOP
660 2 : elseif (present(file)) then
661 1 : inquire(file=file,named=isNamed,name=nameByCompiler,iostat=Err%stat)
662 1 : if (Err%stat>0) then
663 : ! LCOV_EXCL_START
664 : Err%occurred = .true.
665 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file with name=" // file // "."
666 : return
667 : end if
668 : ! LCOV_EXCL_STOP
669 : else
670 1 : Err%occurred = .true.
671 1 : Err%msg = PROCEDURE_NAME // ": At least one of the two input arguments (unit,path) must be provided."
672 1 : return
673 : end if
674 2 : nameByCompiler = trim(adjustl(nameByCompiler))
675 4 : end subroutine getName
676 :
677 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
678 :
679 4 : subroutine getAccess(access,Err,unit,file)
680 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
681 : !DEC$ ATTRIBUTES DLLEXPORT :: getAccess
682 : #endif
683 4 : use String_mod, only: num2str, getLowerCase
684 : use Err_mod, only: Err_type
685 : implicit none
686 : character(:), allocatable, intent(out) :: access
687 : type(Err_type), intent(out) :: Err
688 : integer, intent(in), optional :: unit
689 : character(*), intent(in), optional :: file
690 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@getAccess()"
691 4 : Err%msg = ""
692 4 : Err%occurred = .false.
693 4 : allocate( character(63) :: access )
694 4 : if (present(unit) .and. present(file)) then
695 1 : Err%occurred = .true.
696 1 : Err%msg = PROCEDURE_NAME // ": Only one of the two optional arguments (unit, file) must be provided as input."
697 1 : return
698 3 : elseif (present(unit)) then
699 1 : inquire(unit=unit,access=access,iostat=Err%stat)
700 1 : if (Err%stat>0) then
701 : ! LCOV_EXCL_START
702 : Err%occurred = .true.
703 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file with unit=" // num2str(unit) // "."
704 : return
705 : end if
706 : ! LCOV_EXCL_STOP
707 2 : elseif (present(file)) then
708 1 : inquire(file=file,access=access,iostat=Err%stat)
709 1 : if (Err%stat>0) then
710 : ! LCOV_EXCL_START
711 : Err%occurred = .true.
712 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file with name=" // file // "."
713 : return
714 : end if
715 : ! LCOV_EXCL_STOP
716 : else
717 1 : Err%occurred = .true.
718 1 : Err%msg = PROCEDURE_NAME // ": At least one of the two input arguments (unit,path) must be provided."
719 1 : return
720 : end if
721 2 : access = getLowerCase( trim(adjustl(access)) )
722 4 : end subroutine getAccess
723 :
724 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
725 :
726 4 : subroutine getForm(form,Err,unit,file)
727 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
728 : !DEC$ ATTRIBUTES DLLEXPORT :: getForm
729 : #endif
730 4 : use String_mod, only: num2str, getLowerCase
731 : use Err_mod, only: Err_type
732 : implicit none
733 : character(:), allocatable, intent(out) :: form
734 : type(Err_type), intent(out) :: Err
735 : integer, intent(in), optional :: unit
736 : character(*), intent(in), optional :: file
737 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@getForm()"
738 4 : Err%msg = ""
739 4 : Err%occurred = .false.
740 4 : allocate( character(63) :: form )
741 4 : if (present(unit) .and. present(file)) then
742 1 : Err%occurred = .true.
743 1 : Err%msg = PROCEDURE_NAME // ": Only one of the two optional arguments (unit, file) must be provided as input."
744 1 : return
745 3 : elseif (present(unit)) then
746 1 : inquire(unit=unit,form=form,iostat=Err%stat)
747 1 : if (Err%stat>0) then
748 : ! LCOV_EXCL_START
749 : Err%occurred = .true.
750 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file with unit=" // num2str(unit) // "."
751 : return
752 : end if
753 : ! LCOV_EXCL_STOP
754 2 : elseif (present(file)) then
755 1 : inquire(file=file,form=form,iostat=Err%stat)
756 1 : if (Err%stat>0) then
757 : ! LCOV_EXCL_START
758 : Err%occurred = .true.
759 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file with name=" // file // "."
760 : return
761 : end if
762 : ! LCOV_EXCL_STOP
763 : else
764 1 : Err%occurred = .true.
765 1 : Err%msg = PROCEDURE_NAME // ": At least one of the two input arguments (unit,path) must be provided."
766 1 : return
767 : end if
768 2 : form = getLowerCase( trim(adjustl(form)) )
769 4 : end subroutine getForm
770 :
771 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
772 :
773 4 : subroutine getRecl(recl,Err,unit,file)
774 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
775 : !DEC$ ATTRIBUTES DLLEXPORT :: getRecl
776 : #endif
777 4 : use String_mod, only: num2str
778 : use Err_mod, only: Err_type
779 : implicit none
780 : integer, intent(out) :: recl
781 : type(Err_type), intent(out) :: Err
782 : integer, intent(in), optional :: unit
783 : character(*), intent(in), optional :: file
784 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@getRecl()"
785 4 : Err%msg = ""
786 4 : Err%occurred = .false.
787 4 : if (present(unit) .and. present(file)) then
788 1 : Err%occurred = .true.
789 1 : Err%msg = PROCEDURE_NAME // ": Only one of the two optional arguments (unit, file) must be provided as input."
790 1 : return
791 3 : elseif (present(unit)) then
792 1 : inquire(unit=unit,recl=recl,iostat=Err%stat)
793 1 : if (Err%stat>0) then
794 : ! LCOV_EXCL_START
795 : Err%occurred = .true.
796 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file with unit=" // num2str(unit) // "."
797 : return
798 : end if
799 : ! LCOV_EXCL_STOP
800 2 : elseif (present(file)) then
801 1 : inquire(file=file,recl=recl,iostat=Err%stat)
802 1 : if (Err%stat>0) then
803 : ! LCOV_EXCL_START
804 : Err%occurred = .true.
805 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file with name=" // file // "."
806 : return
807 : end if
808 : ! LCOV_EXCL_STOP
809 : else
810 1 : Err%occurred = .true.
811 1 : Err%msg = PROCEDURE_NAME // ": At least one of the two input arguments (unit,path) must be provided."
812 1 : return
813 : end if
814 4 : end subroutine getRecl
815 :
816 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
817 :
818 4 : subroutine getBlank(blank,Err,unit,file)
819 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
820 : !DEC$ ATTRIBUTES DLLEXPORT :: getBlank
821 : #endif
822 4 : use String_mod, only: num2str, getLowerCase
823 : use Err_mod, only: Err_type
824 : implicit none
825 : character(:), allocatable, intent(out) :: blank
826 : type(Err_type), intent(out) :: Err
827 : integer, intent(in), optional :: unit
828 : character(*), intent(in), optional :: file
829 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@getBlank()"
830 4 : Err%msg = ""
831 4 : Err%occurred = .false.
832 4 : allocate( character(63) :: blank )
833 4 : if (present(unit) .and. present(file)) then
834 1 : Err%occurred = .true.
835 1 : Err%msg = PROCEDURE_NAME // ": Only one of the two optional arguments (unit, file) must be provided as input."
836 1 : return
837 3 : elseif (present(unit)) then
838 1 : inquire(unit=unit,blank=blank,iostat=Err%stat)
839 1 : if (Err%stat>0) then
840 : ! LCOV_EXCL_START
841 : Err%occurred = .true.
842 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file with unit=" // num2str(unit) // "."
843 : return
844 : end if
845 : ! LCOV_EXCL_STOP
846 2 : elseif (present(file)) then
847 1 : inquire(file=file,blank=blank,iostat=Err%stat)
848 1 : if (Err%stat>0) then
849 : ! LCOV_EXCL_START
850 : Err%occurred = .true.
851 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file with name=" // file // "."
852 : return
853 : end if
854 : ! LCOV_EXCL_STOP
855 : else
856 1 : Err%occurred = .true.
857 1 : Err%msg = PROCEDURE_NAME // ": At least one of the two input arguments (unit,path) must be provided."
858 1 : return
859 : end if
860 4 : blank = getLowerCase( trim(adjustl(blank)) )
861 4 : end subroutine getBlank
862 :
863 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
864 :
865 4 : subroutine getPosition(position,Err,unit,file)
866 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
867 : !DEC$ ATTRIBUTES DLLEXPORT :: getPosition
868 : #endif
869 4 : use String_mod, only: num2str, getLowerCase
870 : use Err_mod, only: Err_type
871 : implicit none
872 : character(:), allocatable, intent(out) :: position
873 : type(Err_type), intent(out) :: Err
874 : integer, intent(in), optional :: unit
875 : character(*), intent(in), optional :: file
876 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@getPosition()"
877 4 : Err%msg = ""
878 4 : Err%occurred = .false.
879 4 : allocate( character(63) :: position )
880 4 : if (present(unit) .and. present(file)) then
881 1 : Err%occurred = .true.
882 1 : Err%msg = PROCEDURE_NAME // ": Only one of the two optional arguments (unit, file) must be provided as input."
883 1 : return
884 3 : elseif (present(unit)) then
885 1 : inquire(unit=unit,position=position,iostat=Err%stat)
886 1 : if (Err%stat>0) then
887 : ! LCOV_EXCL_START
888 : Err%occurred = .true.
889 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file with unit=" // num2str(unit) // "."
890 : return
891 : end if
892 : ! LCOV_EXCL_STOP
893 2 : elseif (present(file)) then
894 1 : inquire(file=file,position=position,iostat=Err%stat)
895 1 : if (Err%stat>0) then
896 : ! LCOV_EXCL_START
897 : Err%occurred = .true.
898 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file with name=" // file // "."
899 : return
900 : end if
901 : ! LCOV_EXCL_STOP
902 : else
903 1 : Err%occurred = .true.
904 1 : Err%msg = PROCEDURE_NAME // ": At least one of the two input arguments (unit,path) must be provided."
905 1 : return
906 : end if
907 4 : position = getLowerCase( trim(adjustl(position)) )
908 4 : end subroutine getPosition
909 :
910 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
911 :
912 4 : subroutine getAction(action,Err,unit,file)
913 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
914 : !DEC$ ATTRIBUTES DLLEXPORT :: getAction
915 : #endif
916 4 : use String_mod, only: num2str, getLowerCase
917 : use Err_mod, only: Err_type
918 : implicit none
919 : character(:), allocatable, intent(out) :: action
920 : type(Err_type), intent(out) :: Err
921 : integer, intent(in), optional :: unit
922 : character(*), intent(in), optional :: file
923 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@getAction()"
924 4 : Err%msg = ""
925 4 : Err%occurred = .false.
926 4 : allocate( character(63) :: action )
927 4 : if (present(unit) .and. present(file)) then
928 1 : Err%occurred = .true.
929 1 : Err%msg = PROCEDURE_NAME // ": Only one of the two optional arguments (unit, file) must be provided as input."
930 1 : return
931 3 : elseif (present(unit)) then
932 1 : inquire(unit=unit,action=action,iostat=Err%stat)
933 1 : if (Err%stat>0) then
934 : ! LCOV_EXCL_START
935 : Err%occurred = .true.
936 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file with unit=" // num2str(unit) // "."
937 : return
938 : end if
939 : ! LCOV_EXCL_STOP
940 2 : elseif (present(file)) then
941 1 : inquire(file=file,action=action,iostat=Err%stat)
942 1 : if (Err%stat>0) then
943 : ! LCOV_EXCL_START
944 : Err%occurred = .true.
945 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file with name=" // file // "."
946 : return
947 : end if
948 : ! LCOV_EXCL_STOP
949 : else
950 1 : Err%occurred = .true.
951 1 : Err%msg = PROCEDURE_NAME // ": At least one of the two input arguments (unit,path) must be provided."
952 1 : return
953 : end if
954 4 : action = getLowerCase( trim(adjustl(action)) )
955 4 : end subroutine getAction
956 :
957 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
958 :
959 4 : subroutine getDelim(delim,Err,unit,file)
960 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
961 : !DEC$ ATTRIBUTES DLLEXPORT :: getDelim
962 : #endif
963 4 : use String_mod, only: num2str, getLowerCase
964 : use Err_mod, only: Err_type
965 : implicit none
966 : character(:), allocatable, intent(out) :: delim
967 : type(Err_type), intent(out) :: Err
968 : integer, intent(in), optional :: unit
969 : character(*), intent(in), optional :: file
970 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@getDelim()"
971 4 : Err%msg = ""
972 4 : Err%occurred = .false.
973 4 : allocate( character(63) :: delim )
974 4 : if (present(unit) .and. present(file)) then
975 1 : Err%occurred = .true.
976 1 : Err%msg = PROCEDURE_NAME // ": Only one of the two optional arguments (unit, file) must be provided as input."
977 1 : return
978 3 : elseif (present(unit)) then
979 1 : inquire(unit=unit,delim=delim,iostat=Err%stat)
980 1 : if (Err%stat>0) then
981 : ! LCOV_EXCL_START
982 : Err%occurred = .true.
983 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file with unit=" // num2str(unit) // "."
984 : return
985 : end if
986 : ! LCOV_EXCL_STOP
987 2 : elseif (present(file)) then
988 1 : inquire(file=file,delim=delim,iostat=Err%stat)
989 1 : if (Err%stat>0) then
990 : ! LCOV_EXCL_START
991 : Err%occurred = .true.
992 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file with name=" // file // "."
993 : return
994 : end if
995 : ! LCOV_EXCL_STOP
996 : else
997 1 : Err%occurred = .true.
998 1 : Err%msg = PROCEDURE_NAME // ": At least one of the two input arguments (unit,path) must be provided."
999 1 : return
1000 : end if
1001 4 : delim = getLowerCase( trim(adjustl(delim)) )
1002 4 : end subroutine getDelim
1003 :
1004 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1005 :
1006 0 : subroutine closeFile( File )
1007 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
1008 : !DEC$ ATTRIBUTES DLLEXPORT :: closeFile
1009 : #endif
1010 : implicit none
1011 : class(File_type), intent(inout) :: File
1012 : character(*) , parameter :: PROCEDURE_NAME = "@close()"
1013 : inquire( file = File%Path%modified &
1014 : , exist = File%exists &
1015 : , opened = File%isOpen &
1016 : , number = File%number &
1017 : , iostat = File%Err%stat &
1018 0 : )
1019 0 : if (File%Err%stat/=0) then
1020 : ! LCOV_EXCL_START
1021 : File%Err%occurred = .true.
1022 : File%Err%msg = PROCEDURE_NAME // &
1023 : ": Error occurred while inquiring the open status and unit number of &
1024 : &file='" // File%Path%modified // "'."
1025 : return
1026 : end if
1027 : ! LCOV_EXCL_STOP
1028 0 : if (File%exists) then
1029 0 : if (File%isOpen) close(unit=File%number,iostat=File%Err%stat)
1030 0 : File%Err = File%getCloseErr(File%Err%stat)
1031 0 : if (File%Err%occurred) then
1032 : ! LCOV_EXCL_START
1033 : File%Err%msg = PROCEDURE_NAME // ": Error occurred while attempting to close the open file='" // File%Path%modified // "'."
1034 : return
1035 : end if
1036 : ! LCOV_EXCL_STOP
1037 : else
1038 : ! check if the file with the original filename is open, and if so, close it.
1039 : inquire( file = File%Path%original &
1040 : , exist = File%exists &
1041 : , opened = File%isOpen &
1042 : , number = File%number &
1043 : , iostat = File%Err%stat &
1044 0 : )
1045 0 : if (File%Err%stat/=0) then
1046 : ! LCOV_EXCL_START
1047 : File%Err%occurred = .true.
1048 : File%Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the open status and unit number of file='" // File%Path%original // "'."
1049 : return
1050 : end if
1051 : ! LCOV_EXCL_STOP
1052 0 : if (File%exists) then
1053 0 : if (File%isOpen) close(unit=File%number,iostat=File%Err%stat)
1054 0 : File%Err = File%getCloseErr(File%Err%stat)
1055 0 : if (File%Err%occurred) then
1056 : ! LCOV_EXCL_START
1057 : File%Err%msg = PROCEDURE_NAME // ": Error occurred while attempting to close the open file='" // File%Path%original // "'."
1058 : end if
1059 : ! LCOV_EXCL_STOP
1060 : end if
1061 : end if
1062 4 : end subroutine closeFile
1063 :
1064 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1065 :
1066 : ! sets values for File%unit, File%exists, File%isOpen, File%number, File%Err, and updates File%Path%modified (if needed)
1067 0 : subroutine openFile( File )
1068 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
1069 : !DEC$ ATTRIBUTES DLLEXPORT :: openFile
1070 : #endif
1071 :
1072 : implicit none
1073 : class(File_type), intent(inout) :: File
1074 : character(*) , parameter :: PROCEDURE_NAME = MODULE_NAME // "@openFile()"
1075 :
1076 : ! if file is already open, first close it:
1077 : inquire( file = File%Path%original &
1078 : , exist = File%exists &
1079 : , opened = File%isOpen &
1080 : , number = File%number &
1081 : , iostat = File%Err%stat &
1082 0 : )
1083 0 : if (File%Err%stat/=0) then
1084 : ! LCOV_EXCL_START
1085 : File%Err%occurred = .true.
1086 : File%Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the existence and open status, unit number of file='" // File%Path%original // "'."
1087 : return
1088 : ! LCOV_EXCL_STOP
1089 : end if
1090 0 : if (File%exists) then
1091 0 : File%Path%modified = File%Path%original
1092 0 : if (File%isOpen) then
1093 0 : File%unit = File%number
1094 0 : return
1095 : else
1096 : open( newunit = File%unit &
1097 : , file = File%Path%modified &
1098 : , form = File%Form%value &
1099 : , delim = File%Delim%value &
1100 : , status = File%status &
1101 : , action = File%Action%value &
1102 : , access = File%Access%value &
1103 : , iostat = File%Err%stat &
1104 : , position = File%Position%value &
1105 0 : )
1106 : end if
1107 : else
1108 : ! try the modified path file name
1109 : inquire( file = File%Path%modified &
1110 : , exist = File%exists &
1111 : , opened = File%isOpen &
1112 : , number = File%number &
1113 : , iostat = File%Err%stat &
1114 0 : )
1115 0 : if (File%Err%stat/=0) then
1116 : ! LCOV_EXCL_START
1117 : File%Err%occurred = .true.
1118 : File%Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the existence and open status, unit number of file='" // File%Path%modified // "'."
1119 : return
1120 : ! LCOV_EXCL_STOP
1121 : end if
1122 0 : if (File%exists) then
1123 0 : if (File%isOpen) then
1124 0 : File%unit = File%number
1125 0 : return
1126 : else
1127 : open( newunit = File%unit &
1128 : , form = File%Form%value &
1129 : , delim = File%Delim%value &
1130 : , status = File%status &
1131 : , action = File%Action%value &
1132 : , access = File%Access%value &
1133 : , file = File%Path%modified &
1134 : , iostat = File%Err%stat &
1135 : , position = File%Position%value &
1136 0 : )
1137 : end if
1138 : else
1139 0 : File%Err%occurred = .true.
1140 0 : File%Err%msg = PROCEDURE_NAME // ": The requested file to open with possible addresses '" // File%Path%original // "' or '" // File%Path%modified // "' does not exist."
1141 0 : return
1142 : end if
1143 : end if
1144 0 : end subroutine openFile
1145 :
1146 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1147 :
1148 3 : function getWriteErr(stat) result(Err)
1149 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
1150 : !DEC$ ATTRIBUTES DLLEXPORT :: getWriteErr
1151 : #endif
1152 : use Err_mod, only: Err_type ! LCOV_EXCL_LINE
1153 : implicit none
1154 : integer, intent(in) :: stat
1155 : type(Err_type) :: Err
1156 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@getWriteErr()"
1157 3 : Err%occurred = .false.
1158 3 : Err%stat = stat
1159 3 : Err%msg = ""
1160 3 : if ( is_iostat_eor(Err%stat) ) then
1161 : ! LCOV_EXCL_START
1162 : Err%occurred = .true.
1163 : Err%msg = PROCEDURE_NAME // ": End-Of-Record error condition occurred while attempting to write to file."
1164 : return
1165 : ! LCOV_EXCL_STOP
1166 3 : elseif ( is_iostat_end(Err%stat) ) then
1167 : ! LCOV_EXCL_START
1168 : Err%occurred = .true.
1169 : Err%msg = PROCEDURE_NAME // ": End-Of-File error condition occurred while attempting to write to file."
1170 : return
1171 : ! LCOV_EXCL_STOP
1172 2 : elseif ( Err%stat>0 ) then
1173 : ! LCOV_EXCL_START
1174 : Err%occurred = .true.
1175 : Err%msg = PROCEDURE_NAME // ": Unknown error condition occurred while attempting to write to file."
1176 : return
1177 : ! LCOV_EXCL_STOP
1178 : end if
1179 3 : end function getWriteErr
1180 :
1181 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1182 :
1183 182 : function getReadErr(stat,path) result(Err)
1184 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
1185 : !DEC$ ATTRIBUTES DLLEXPORT :: getReadErr
1186 : #endif
1187 3 : use Err_mod, only: Err_type
1188 : implicit none
1189 : integer, intent(in) :: stat
1190 : character(*), intent(in), optional :: path
1191 : type(Err_type) :: Err
1192 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@getReadErr()"
1193 182 : if (stat==0) then
1194 162 : Err%occurred = .false.
1195 162 : Err%stat = stat
1196 162 : Err%msg = ""
1197 162 : return
1198 : else
1199 20 : Err%occurred = .true.
1200 20 : Err%stat = stat
1201 20 : if ( is_iostat_eor(stat) ) then
1202 0 : Err%msg = PROCEDURE_NAME // ": End-Of-Record error condition occurred while attempting to read from file."
1203 20 : elseif ( is_iostat_end(stat) ) then
1204 18 : Err%msg = PROCEDURE_NAME // ": End-Of-File error condition occurred while attempting to read from file."
1205 2 : elseif ( stat>0 ) then
1206 2 : Err%msg = PROCEDURE_NAME // ": Unknown error condition occurred while attempting to read from file."
1207 : end if
1208 38 : if (present(path)) Err%msg = Err%msg(1:len(Err%msg)-1) // "='" // path // "'."
1209 : end if
1210 182 : end function getReadErr
1211 :
1212 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1213 :
1214 11 : function getCloseErr(stat) result(Err)
1215 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
1216 : !DEC$ ATTRIBUTES DLLEXPORT :: getCloseErr
1217 : #endif
1218 182 : use Err_mod, only: Err_type
1219 : implicit none
1220 : integer, intent(in) :: stat
1221 : type(Err_type) :: Err
1222 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@getCloseErr()"
1223 11 : Err%occurred = .false.
1224 11 : Err%stat = stat
1225 11 : Err%msg = ""
1226 11 : if (Err%stat>0) then
1227 1 : Err%occurred = .true.
1228 1 : Err%msg = PROCEDURE_NAME // ": Error occurred while attempting to close the open file."
1229 1 : return
1230 : end if
1231 11 : end function getCloseErr
1232 :
1233 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1234 :
1235 1636 : function getOpenErr(stat) result(Err)
1236 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
1237 : !DEC$ ATTRIBUTES DLLEXPORT :: getOpenErr
1238 : #endif
1239 11 : use Err_mod, only: Err_type
1240 : implicit none
1241 : integer, intent(in) :: stat
1242 : type(Err_type) :: Err
1243 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@getOpenErr()"
1244 1636 : Err%occurred = .false.
1245 1636 : Err%stat = stat
1246 1636 : Err%msg = ""
1247 1636 : if (Err%stat>0) then
1248 1 : Err%occurred = .true.
1249 1 : Err%msg = PROCEDURE_NAME // ": Unknown error occurred while opening file."
1250 1 : return
1251 : end if
1252 1636 : end function getOpenErr
1253 :
1254 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1255 :
1256 1738 : function getInqErr(stat) result(Err)
1257 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
1258 : !DEC$ ATTRIBUTES DLLEXPORT :: getInqErr
1259 : #endif
1260 1636 : use Err_mod, only: Err_type
1261 : implicit none
1262 : integer, intent(in) :: stat
1263 : type(Err_type) :: Err
1264 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@getInqErr()"
1265 1738 : Err%occurred = .false.
1266 1738 : Err%stat = stat
1267 1738 : Err%msg = ""
1268 1738 : if (Err%stat/=0) then
1269 2 : Err%occurred = .true.
1270 2 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file."
1271 2 : return
1272 : end if
1273 1738 : end function getInqErr
1274 :
1275 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1276 :
1277 200 : function constructAction(value) result(Action)
1278 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
1279 : !DEC$ ATTRIBUTES DLLEXPORT :: constructAction
1280 : #endif
1281 1738 : use String_mod, only: getLowerCase
1282 : character(*), intent(in), optional :: value
1283 : type(Action_type) :: Action
1284 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@constructAction()"
1285 176 : if (present(value)) then
1286 6 : Action%value = getLowerCase(trim(adjustl(value)))
1287 6 : if (Action%value=="read") then
1288 3 : Action%isRead = .true.
1289 3 : elseif (Action%value=="write") then
1290 1 : Action%isWrite = .true.
1291 2 : elseif (Action%value=="readwrite") then
1292 0 : Action%isReadWrite = .true.
1293 2 : elseif (Action%value=="undefined") then
1294 1 : Action%isUndefined = .true.
1295 : else
1296 1 : Action%value = ""
1297 1 : Action%Err%occurred = .true.
1298 1 : Action%Err%msg = PROCEDURE_NAME // ": Invalid requested Action%value='" // Action%value // "'."
1299 : end if
1300 : else
1301 170 : Action%value = "readwrite"
1302 170 : Action%isReadWrite = .true.
1303 : end if
1304 176 : end function constructAction
1305 :
1306 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1307 :
1308 176 : function constructAccess(value) result(Access)
1309 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
1310 : !DEC$ ATTRIBUTES DLLEXPORT :: constructAccess
1311 : #endif
1312 176 : use String_mod, only: getLowerCase
1313 : character(*), intent(in), optional :: value
1314 : type(Access_type) :: Access
1315 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@constructAccess()"
1316 176 : if (present(value)) then
1317 6 : Access%value = getLowerCase(trim(adjustl(value)))
1318 6 : if (Access%value=="sequential") then
1319 1 : Access%isSequential = .true.
1320 5 : elseif (Access%value=="direct") then
1321 3 : Access%isDirect = .true.
1322 2 : elseif (Access%value=="undefined") then
1323 1 : Access%isUndefined = .true.
1324 : else
1325 1 : Access%value = ""
1326 1 : Access%Err%occurred = .true.
1327 1 : Access%Err%msg = PROCEDURE_NAME // ": Invalid requested Access%value='" // Access%value // "'."
1328 : end if
1329 : else
1330 170 : Access%value = "sequential"
1331 170 : Access%isSequential = .true.
1332 : end if
1333 176 : end function constructAccess
1334 :
1335 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1336 :
1337 176 : function constructForm(value) result(Form)
1338 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
1339 : !DEC$ ATTRIBUTES DLLEXPORT :: constructForm
1340 : #endif
1341 176 : use String_mod, only: getLowerCase
1342 : character(*), intent(in), optional :: value
1343 : type(Form_type) :: Form
1344 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@constructForm()"
1345 176 : if (present(value)) then
1346 175 : Form%value = getLowerCase(trim(adjustl(value)))
1347 175 : if (Form%value=="formatted") then
1348 170 : Form%isFormatted = .true.
1349 5 : elseif (Form%value=="unformatted") then
1350 3 : Form%isUnformatted = .true.
1351 2 : elseif (Form%value=="undefined") then
1352 1 : Form%isUndefined = .true.
1353 : else
1354 1 : Form%value = ""
1355 1 : Form%Err%occurred = .true.
1356 1 : Form%Err%msg = PROCEDURE_NAME // ": Invalid requested Form%value='" // Form%value // "'."
1357 : end if
1358 : else
1359 1 : Form%value = "formatted"
1360 1 : Form%isFormatted = .true.
1361 : end if
1362 176 : end function constructForm
1363 :
1364 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1365 :
1366 176 : function constructBlank(value) result(Blank)
1367 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
1368 : !DEC$ ATTRIBUTES DLLEXPORT :: constructBlank
1369 : #endif
1370 176 : use String_mod, only: getLowerCase
1371 : character(*), intent(in), optional :: value
1372 : type(Blank_type) :: Blank
1373 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@constructBlank()"
1374 176 : if (present(value)) then
1375 6 : Blank%value = getLowerCase(trim(adjustl(value)))
1376 6 : if (Blank%value=="null") then
1377 1 : Blank%isNull = .true.
1378 5 : elseif (Blank%value=="zero") then
1379 1 : Blank%isZero = .true.
1380 4 : elseif (Blank%value=="undefined") then
1381 3 : Blank%isUndefined = .true.
1382 : else
1383 1 : Blank%value = ""
1384 1 : Blank%Err%occurred = .true.
1385 1 : Blank%Err%msg = PROCEDURE_NAME // ": Invalid requested Blank%value='" // Blank%value // "'."
1386 : end if
1387 : else
1388 170 : Blank%value = "null"
1389 170 : Blank%isNull = .true.
1390 : end if
1391 176 : end function constructBlank
1392 :
1393 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1394 :
1395 177 : function constructPosition(value) result(Position)
1396 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
1397 : !DEC$ ATTRIBUTES DLLEXPORT :: constructPosition
1398 : #endif
1399 176 : use String_mod, only: getLowerCase
1400 : character(*), intent(in), optional :: value
1401 : type(Position_type) :: Position
1402 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@constructPosition()"
1403 177 : if (present(value)) then
1404 7 : Position%value = getLowerCase(trim(adjustl(value)))
1405 7 : if (Position%value=="asis") then
1406 1 : Position%isAsis = .true.
1407 6 : elseif (Position%value=="rewind") then
1408 1 : Position%isRewind = .true.
1409 5 : elseif (Position%value=="append") then
1410 3 : Position%isAppend = .true.
1411 2 : elseif (Position%value=="undefined") then
1412 1 : Position%isUndefined = .true.
1413 : else
1414 1 : Position%value = ""
1415 1 : Position%Err%occurred = .true.
1416 1 : Position%Err%msg = PROCEDURE_NAME // ": Invalid requested Position%value='" // Position%value // "'."
1417 : end if
1418 : else
1419 170 : Position%value = "asis"
1420 170 : Position%isAsis = .true.
1421 : end if
1422 177 : end function constructPosition
1423 :
1424 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1425 :
1426 177 : function constructDelim(value) result(Delim)
1427 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
1428 : !DEC$ ATTRIBUTES DLLEXPORT :: constructDelim
1429 : #endif
1430 177 : use String_mod, only: getLowerCase
1431 : character(*), intent(in), optional :: value
1432 : type(Delim_type) :: Delim
1433 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@constructDelim()"
1434 177 : if (present(value)) then
1435 7 : Delim%value = getLowerCase(trim(adjustl(value)))
1436 7 : if (Delim%value=="quote") then
1437 3 : Delim%isQuote = .true.
1438 4 : elseif (Delim%value=="apostrophe") then
1439 1 : Delim%isApostrophe = .true.
1440 3 : elseif (Delim%value=="none") then
1441 1 : Delim%isNone = .true.
1442 2 : elseif (Delim%value=="undefined") then
1443 1 : Delim%isUndefined = .true.
1444 : else
1445 1 : Delim%value = ""
1446 1 : Delim%Err%occurred = .true.
1447 1 : Delim%Err%msg = PROCEDURE_NAME // ": Invalid requested Delim%value='" // Delim%value // "'."
1448 : end if
1449 : else
1450 170 : Delim%value = "none"
1451 170 : Delim%isNone = .true.
1452 : end if
1453 177 : end function constructDelim
1454 :
1455 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1456 :
1457 176 : function constructPad(value) result(Pad)
1458 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
1459 : !DEC$ ATTRIBUTES DLLEXPORT :: constructPad
1460 : #endif
1461 177 : use String_mod, only: getLowerCase
1462 : character(*), intent(in), optional :: value
1463 : type(Pad_type) :: Pad
1464 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@constructPad()"
1465 176 : if (present(value)) then
1466 6 : Pad%value = getLowerCase(trim(adjustl(value)))
1467 6 : if (Pad%value=="yes") then
1468 1 : Pad%isPadded = .true.
1469 5 : elseif (Pad%value=="no") then
1470 3 : Pad%isNotPadded = .true.
1471 2 : elseif (Pad%value=="undefined") then
1472 1 : Pad%isUndefined = .true.
1473 : else
1474 1 : Pad%value = ""
1475 1 : Pad%Err%occurred = .true.
1476 1 : Pad%Err%msg = PROCEDURE_NAME // ": Invalid requested Pad%value='" // Pad%value // "'."
1477 : end if
1478 : else
1479 170 : Pad%value = "yes"
1480 170 : Pad%isPadded = .true.
1481 : end if
1482 176 : end function constructPad
1483 :
1484 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1485 :
1486 180 : function constructRound(value) result(Round)
1487 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
1488 : !DEC$ ATTRIBUTES DLLEXPORT :: constructRound
1489 : #endif
1490 176 : use String_mod, only: getLowerCase
1491 : character(*), intent(in), optional :: value
1492 : type(Round_type) :: Round
1493 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@constructRound()"
1494 180 : if (present(value)) then
1495 10 : Round%value = getLowerCase(trim(adjustl(value)))
1496 10 : if (Round%value=="up") then
1497 3 : Round%isUp = .true.
1498 7 : elseif (Round%value=="down") then
1499 1 : Round%isDown = .true.
1500 6 : elseif (Round%value=="zero") then
1501 1 : Round%isZero = .true.
1502 5 : elseif (Round%value=="nearest") then
1503 2 : Round%isNearest = .true.
1504 3 : elseif (Round%value=="compatible") then
1505 1 : Round%isCompatible = .true.
1506 2 : elseif (Round%value=="processor_defined") then
1507 1 : Round%isProcessDefined = .true.
1508 1 : elseif (Round%value=="undefined") then
1509 0 : Round%isUndefined = .true.
1510 : else
1511 1 : Round%value = ""
1512 1 : Round%Err%occurred = .true.
1513 1 : Round%Err%msg = PROCEDURE_NAME // ": Invalid requested Round%value='" // Round%value // "'."
1514 : end if
1515 : else
1516 170 : Round%value = "processor_defined"
1517 170 : Round%isProcessDefined = .true.
1518 : end if
1519 180 : end function constructRound
1520 :
1521 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1522 :
1523 177 : function constructSign(value) result(Sign)
1524 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
1525 : !DEC$ ATTRIBUTES DLLEXPORT :: constructSign
1526 : #endif
1527 180 : use String_mod, only: getLowerCase
1528 : character(*), intent(in), optional :: value
1529 : type(Sign_type) :: Sign
1530 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@constructSign()"
1531 177 : if (present(value)) then
1532 7 : Sign%value = getLowerCase(trim(adjustl(value)))
1533 7 : if (Sign%value=="suppress") then
1534 1 : Sign%isSuppress = .true.
1535 6 : elseif (Sign%value=="plus") then
1536 1 : Sign%isPlus = .true.
1537 5 : elseif (Sign%value=="processor_defined") then
1538 1 : Sign%isProcessDefined = .true.
1539 4 : elseif (Sign%value=="undefined") then
1540 3 : Sign%isUndefined = .true.
1541 : else
1542 1 : Sign%value = ""
1543 1 : Sign%Err%occurred = .true.
1544 1 : Sign%Err%msg = PROCEDURE_NAME // ": Invalid requested Sign%value='" // Sign%value // "'."
1545 : end if
1546 : else
1547 170 : Sign%value = "processor_defined"
1548 170 : Sign%isProcessDefined = .true.
1549 : end if
1550 177 : end function constructSign
1551 :
1552 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1553 :
1554 : end module File_mod ! LCOV_EXCL_LINE
|
