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 513 : 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 513 : File%Err%occurred = .false.
259 513 : File%Err%stat = -huge(0)
260 513 : File%Err%msg = ""
261 :
262 513 : if (present(unit)) then
263 6 : File%unit = unit
264 : else
265 507 : File%unit = -huge(0)
266 : end if
267 :
268 513 : if (present(recl)) then
269 6 : File%recl = recl
270 : else
271 507 : File%recl = -huge(0)
272 : end if
273 :
274 : ! set up file path
275 :
276 513 : if (present(path)) then
277 : !write(*,*) OS%slash
278 : !write(*,*) OS%isWindows
279 : !write(*,*) path
280 510 : File%Path = path_type(inputPath=path,OS=OS)
281 : else
282 3 : File%Path = path_type(inputPath="",OS=OS)
283 : end if
284 : !write(*,*) File%Path%original
285 : !write(*,*) File%Path%modified
286 513 : 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 513 : , file = File%Path%modified )
299 513 : 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 513 : if (.not.File%exists) then
309 : call File%getExistStatus( exists = File%exists &
310 : , Err = File%err &
311 489 : , file = File%Path%original )
312 489 : if (File%exists) File%Path%modified = File%Path%original ! restore the original path, which is apparently the correct path
313 : end if
314 513 : 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 513 : if (present(format)) then
324 6 : File%format = trim(adjustl(format))
325 : else
326 507 : File%format = ""
327 : end if
328 :
329 513 : if (present(status)) then
330 510 : File%status = getLowerCase(trim(adjustl(status)))
331 : else
332 3 : File%status = "unknown"
333 : end if
334 :
335 513 : if (present(asynchronous)) then
336 6 : File%asynchronous = getLowerCase(trim(adjustl(asynchronous)))
337 : else
338 507 : File%asynchronous = "no"
339 : end if
340 :
341 513 : File%Action = Action_type(action)
342 513 : 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 513 : File%Delim = Delim_type(delim)
351 513 : 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 513 : File%Access = Access_type(access)
360 513 : 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 513 : 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 513 : if (present(form)) then
378 3 : File%form = Form_type(form)
379 : else
380 510 : if ( File%Access%isDirect ) then
381 3 : File%Form = Form_type("unformatted")
382 : else ! if ( File%Access%isSequential ) then
383 507 : 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 513 : 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 513 : File%Sign = Sign_type(sign)
404 513 : 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 513 : File%Pad = Pad_type(pad)
413 513 : 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 513 : File%Blank = Blank_type(blank)
422 513 : 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 513 : File%nameByCompiler = ""
431 :
432 513 : 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 2013 : 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 513 : 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 1011 : Err%msg = ""
505 1011 : Err%occurred = .false.
506 1011 : if (present(unit) .and. present(file)) then
507 3 : Err%occurred = .true.
508 3 : Err%msg = PROCEDURE_NAME // ": Only one of the two optional arguments (unit, file) must be provided as input."
509 3 : return
510 1008 : elseif (present(unit)) then
511 3 : inquire(unit=unit,exist=exists,iostat=Err%stat)
512 3 : 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 1005 : elseif (present(file)) then
520 1002 : inquire(file=file,exist=exists,iostat=Err%stat)
521 1002 : 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 3 : Err%occurred = .true.
530 3 : Err%msg = PROCEDURE_NAME // ": At least one of the two input arguments (unit,path) must be provided."
531 3 : return
532 : end if
533 1011 : end subroutine getExistStatus
534 :
535 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
536 :
537 12 : 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 1011 : 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 12 : Err%msg = ""
550 12 : Err%occurred = .false.
551 12 : if (present(unit) .and. present(file)) then
552 3 : Err%occurred = .true.
553 3 : Err%msg = PROCEDURE_NAME // ": Only one of the two optional arguments (unit, file) must be provided as input."
554 3 : return
555 9 : elseif (present(unit)) then
556 3 : inquire(unit=unit,opened=isOpen,iostat=Err%stat)
557 3 : 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 6 : elseif (present(file)) then
565 3 : inquire(file=file,opened=isOpen,iostat=Err%stat)
566 3 : 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 3 : Err%occurred = .true.
575 3 : Err%msg = PROCEDURE_NAME // ": At least one of the two input arguments (unit,path) must be provided."
576 3 : return
577 : end if
578 12 : end subroutine getOpenStatus
579 :
580 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
581 :
582 12 : 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 12 : 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 12 : Err%msg = ""
596 12 : Err%occurred = .false.
597 12 : isNumbered = .true.
598 12 : if (present(unit) .and. present(file)) then
599 3 : Err%occurred = .true.
600 3 : Err%msg = PROCEDURE_NAME // ": Only one of the two optional arguments (unit, file) must be provided as input."
601 3 : return
602 9 : elseif (present(unit)) then
603 3 : inquire(unit=unit,number=number,iostat=Err%stat)
604 3 : 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 6 : elseif (present(file)) then
612 3 : inquire(file=file,number=number,iostat=Err%stat)
613 3 : 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 3 : Err%occurred = .true.
622 3 : Err%msg = PROCEDURE_NAME // ": At least one of the two input arguments (unit,path) must be provided."
623 3 : return
624 : end if
625 6 : if (number==-1) isNumbered = .false.
626 12 : end subroutine getNumber
627 :
628 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
629 :
630 12 : 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 12 : 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 12 : Err%msg = ""
645 12 : Err%occurred = .false.
646 12 : allocate( character(MAX_FILE_PATH_LEN) :: nameByCompiler )
647 12 : if (present(unit) .and. present(file)) then
648 3 : Err%occurred = .true.
649 3 : Err%msg = PROCEDURE_NAME // ": Only one of the two optional arguments (unit, file) must be provided as input."
650 3 : return
651 9 : elseif (present(unit)) then
652 3 : inquire(unit=unit,named=isNamed,name=nameByCompiler,iostat=Err%stat)
653 3 : 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 6 : elseif (present(file)) then
661 3 : inquire(file=file,named=isNamed,name=nameByCompiler,iostat=Err%stat)
662 3 : 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 3 : Err%occurred = .true.
671 3 : Err%msg = PROCEDURE_NAME // ": At least one of the two input arguments (unit,path) must be provided."
672 3 : return
673 : end if
674 6 : nameByCompiler = trim(adjustl(nameByCompiler))
675 12 : end subroutine getName
676 :
677 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
678 :
679 12 : 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 12 : 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 12 : Err%msg = ""
692 12 : Err%occurred = .false.
693 12 : allocate( character(63) :: access )
694 12 : if (present(unit) .and. present(file)) then
695 3 : Err%occurred = .true.
696 3 : Err%msg = PROCEDURE_NAME // ": Only one of the two optional arguments (unit, file) must be provided as input."
697 3 : return
698 9 : elseif (present(unit)) then
699 3 : inquire(unit=unit,access=access,iostat=Err%stat)
700 3 : 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 6 : elseif (present(file)) then
708 3 : inquire(file=file,access=access,iostat=Err%stat)
709 3 : 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 3 : Err%occurred = .true.
718 3 : Err%msg = PROCEDURE_NAME // ": At least one of the two input arguments (unit,path) must be provided."
719 3 : return
720 : end if
721 6 : access = getLowerCase( trim(adjustl(access)) )
722 12 : end subroutine getAccess
723 :
724 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
725 :
726 12 : 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 12 : 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 12 : Err%msg = ""
739 12 : Err%occurred = .false.
740 12 : allocate( character(63) :: form )
741 12 : if (present(unit) .and. present(file)) then
742 3 : Err%occurred = .true.
743 3 : Err%msg = PROCEDURE_NAME // ": Only one of the two optional arguments (unit, file) must be provided as input."
744 3 : return
745 9 : elseif (present(unit)) then
746 3 : inquire(unit=unit,form=form,iostat=Err%stat)
747 3 : 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 6 : elseif (present(file)) then
755 3 : inquire(file=file,form=form,iostat=Err%stat)
756 3 : 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 3 : Err%occurred = .true.
765 3 : Err%msg = PROCEDURE_NAME // ": At least one of the two input arguments (unit,path) must be provided."
766 3 : return
767 : end if
768 6 : form = getLowerCase( trim(adjustl(form)) )
769 12 : end subroutine getForm
770 :
771 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
772 :
773 12 : 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 12 : 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 12 : Err%msg = ""
786 12 : Err%occurred = .false.
787 12 : if (present(unit) .and. present(file)) then
788 3 : Err%occurred = .true.
789 3 : Err%msg = PROCEDURE_NAME // ": Only one of the two optional arguments (unit, file) must be provided as input."
790 3 : return
791 9 : elseif (present(unit)) then
792 3 : inquire(unit=unit,recl=recl,iostat=Err%stat)
793 3 : 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 6 : elseif (present(file)) then
801 3 : inquire(file=file,recl=recl,iostat=Err%stat)
802 3 : 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 3 : Err%occurred = .true.
811 3 : Err%msg = PROCEDURE_NAME // ": At least one of the two input arguments (unit,path) must be provided."
812 3 : return
813 : end if
814 12 : end subroutine getRecl
815 :
816 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
817 :
818 12 : 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 12 : 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 12 : Err%msg = ""
831 12 : Err%occurred = .false.
832 12 : allocate( character(63) :: blank )
833 12 : if (present(unit) .and. present(file)) then
834 3 : Err%occurred = .true.
835 3 : Err%msg = PROCEDURE_NAME // ": Only one of the two optional arguments (unit, file) must be provided as input."
836 3 : return
837 9 : elseif (present(unit)) then
838 3 : inquire(unit=unit,blank=blank,iostat=Err%stat)
839 3 : 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 6 : elseif (present(file)) then
847 3 : inquire(file=file,blank=blank,iostat=Err%stat)
848 3 : 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 3 : Err%occurred = .true.
857 3 : Err%msg = PROCEDURE_NAME // ": At least one of the two input arguments (unit,path) must be provided."
858 3 : return
859 : end if
860 12 : blank = getLowerCase( trim(adjustl(blank)) )
861 12 : end subroutine getBlank
862 :
863 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
864 :
865 12 : 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 12 : 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 12 : Err%msg = ""
878 12 : Err%occurred = .false.
879 12 : allocate( character(63) :: position )
880 12 : if (present(unit) .and. present(file)) then
881 3 : Err%occurred = .true.
882 3 : Err%msg = PROCEDURE_NAME // ": Only one of the two optional arguments (unit, file) must be provided as input."
883 3 : return
884 9 : elseif (present(unit)) then
885 3 : inquire(unit=unit,position=position,iostat=Err%stat)
886 3 : 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 6 : elseif (present(file)) then
894 3 : inquire(file=file,position=position,iostat=Err%stat)
895 3 : 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 3 : Err%occurred = .true.
904 3 : Err%msg = PROCEDURE_NAME // ": At least one of the two input arguments (unit,path) must be provided."
905 3 : return
906 : end if
907 12 : position = getLowerCase( trim(adjustl(position)) )
908 12 : end subroutine getPosition
909 :
910 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
911 :
912 12 : 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 12 : 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 12 : Err%msg = ""
925 12 : Err%occurred = .false.
926 12 : allocate( character(63) :: action )
927 12 : if (present(unit) .and. present(file)) then
928 3 : Err%occurred = .true.
929 3 : Err%msg = PROCEDURE_NAME // ": Only one of the two optional arguments (unit, file) must be provided as input."
930 3 : return
931 9 : elseif (present(unit)) then
932 3 : inquire(unit=unit,action=action,iostat=Err%stat)
933 3 : 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 6 : elseif (present(file)) then
941 3 : inquire(file=file,action=action,iostat=Err%stat)
942 3 : 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 3 : Err%occurred = .true.
951 3 : Err%msg = PROCEDURE_NAME // ": At least one of the two input arguments (unit,path) must be provided."
952 3 : return
953 : end if
954 12 : action = getLowerCase( trim(adjustl(action)) )
955 12 : end subroutine getAction
956 :
957 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
958 :
959 12 : 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 12 : 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 12 : Err%msg = ""
972 12 : Err%occurred = .false.
973 12 : allocate( character(63) :: delim )
974 12 : if (present(unit) .and. present(file)) then
975 3 : Err%occurred = .true.
976 3 : Err%msg = PROCEDURE_NAME // ": Only one of the two optional arguments (unit, file) must be provided as input."
977 3 : return
978 9 : elseif (present(unit)) then
979 3 : inquire(unit=unit,delim=delim,iostat=Err%stat)
980 3 : 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 6 : elseif (present(file)) then
988 3 : inquire(file=file,delim=delim,iostat=Err%stat)
989 3 : 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 3 : Err%occurred = .true.
998 3 : Err%msg = PROCEDURE_NAME // ": At least one of the two input arguments (unit,path) must be provided."
999 3 : return
1000 : end if
1001 12 : delim = getLowerCase( trim(adjustl(delim)) )
1002 12 : 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 12 : 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 9 : 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 9 : Err%occurred = .false.
1158 9 : Err%stat = stat
1159 9 : Err%msg = ""
1160 9 : 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 9 : 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 6 : 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 9 : end function getWriteErr
1180 :
1181 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1182 :
1183 546 : 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 9 : 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 546 : if (stat==0) then
1194 486 : Err%occurred = .false.
1195 486 : Err%stat = stat
1196 486 : Err%msg = ""
1197 486 : return
1198 : else
1199 60 : Err%occurred = .true.
1200 60 : Err%stat = stat
1201 60 : 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 60 : elseif ( is_iostat_end(stat) ) then
1204 54 : Err%msg = PROCEDURE_NAME // ": End-Of-File error condition occurred while attempting to read from file."
1205 6 : elseif ( stat>0 ) then
1206 6 : Err%msg = PROCEDURE_NAME // ": Unknown error condition occurred while attempting to read from file."
1207 : end if
1208 114 : if (present(path)) Err%msg = Err%msg(1:len(Err%msg)-1) // "='" // path // "'."
1209 : end if
1210 546 : end function getReadErr
1211 :
1212 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1213 :
1214 33 : 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 546 : 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 33 : Err%occurred = .false.
1224 33 : Err%stat = stat
1225 33 : Err%msg = ""
1226 33 : if (Err%stat>0) then
1227 3 : Err%occurred = .true.
1228 3 : Err%msg = PROCEDURE_NAME // ": Error occurred while attempting to close the open file."
1229 3 : return
1230 : end if
1231 33 : end function getCloseErr
1232 :
1233 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1234 :
1235 1898 : 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 33 : 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 1898 : Err%occurred = .false.
1245 1898 : Err%stat = stat
1246 1898 : Err%msg = ""
1247 1898 : if (Err%stat>0) then
1248 3 : Err%occurred = .true.
1249 3 : Err%msg = PROCEDURE_NAME // ": Unknown error occurred while opening file."
1250 3 : return
1251 : end if
1252 1898 : end function getOpenErr
1253 :
1254 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1255 :
1256 5214 : 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 1898 : 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 5214 : Err%occurred = .false.
1266 5214 : Err%stat = stat
1267 5214 : Err%msg = ""
1268 5214 : if (Err%stat/=0) then
1269 6 : Err%occurred = .true.
1270 6 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the status of file."
1271 6 : return
1272 : end if
1273 5214 : end function getInqErr
1274 :
1275 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1276 :
1277 600 : 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 5214 : 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 528 : if (present(value)) then
1286 18 : Action%value = getLowerCase(trim(adjustl(value)))
1287 18 : if (Action%value=="read") then
1288 9 : Action%isRead = .true.
1289 9 : elseif (Action%value=="write") then
1290 3 : Action%isWrite = .true.
1291 6 : elseif (Action%value=="readwrite") then
1292 0 : Action%isReadWrite = .true.
1293 6 : elseif (Action%value=="undefined") then
1294 3 : Action%isUndefined = .true.
1295 : else
1296 3 : Action%value = ""
1297 3 : Action%Err%occurred = .true.
1298 3 : Action%Err%msg = PROCEDURE_NAME // ": Invalid requested Action%value='" // Action%value // "'."
1299 : end if
1300 : else
1301 510 : Action%value = "readwrite"
1302 510 : Action%isReadWrite = .true.
1303 : end if
1304 528 : end function constructAction
1305 :
1306 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1307 :
1308 528 : 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 528 : 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 528 : if (present(value)) then
1317 18 : Access%value = getLowerCase(trim(adjustl(value)))
1318 18 : if (Access%value=="sequential") then
1319 3 : Access%isSequential = .true.
1320 15 : elseif (Access%value=="direct") then
1321 9 : Access%isDirect = .true.
1322 6 : elseif (Access%value=="undefined") then
1323 3 : Access%isUndefined = .true.
1324 : else
1325 3 : Access%value = ""
1326 3 : Access%Err%occurred = .true.
1327 3 : Access%Err%msg = PROCEDURE_NAME // ": Invalid requested Access%value='" // Access%value // "'."
1328 : end if
1329 : else
1330 510 : Access%value = "sequential"
1331 510 : Access%isSequential = .true.
1332 : end if
1333 528 : end function constructAccess
1334 :
1335 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1336 :
1337 528 : 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 528 : 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 528 : if (present(value)) then
1346 525 : Form%value = getLowerCase(trim(adjustl(value)))
1347 525 : if (Form%value=="formatted") then
1348 510 : Form%isFormatted = .true.
1349 15 : elseif (Form%value=="unformatted") then
1350 9 : Form%isUnformatted = .true.
1351 6 : elseif (Form%value=="undefined") then
1352 3 : Form%isUndefined = .true.
1353 : else
1354 3 : Form%value = ""
1355 3 : Form%Err%occurred = .true.
1356 3 : Form%Err%msg = PROCEDURE_NAME // ": Invalid requested Form%value='" // Form%value // "'."
1357 : end if
1358 : else
1359 3 : Form%value = "formatted"
1360 3 : Form%isFormatted = .true.
1361 : end if
1362 528 : end function constructForm
1363 :
1364 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1365 :
1366 528 : 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 528 : 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 528 : if (present(value)) then
1375 18 : Blank%value = getLowerCase(trim(adjustl(value)))
1376 18 : if (Blank%value=="null") then
1377 3 : Blank%isNull = .true.
1378 15 : elseif (Blank%value=="zero") then
1379 3 : Blank%isZero = .true.
1380 12 : elseif (Blank%value=="undefined") then
1381 9 : Blank%isUndefined = .true.
1382 : else
1383 3 : Blank%value = ""
1384 3 : Blank%Err%occurred = .true.
1385 3 : Blank%Err%msg = PROCEDURE_NAME // ": Invalid requested Blank%value='" // Blank%value // "'."
1386 : end if
1387 : else
1388 510 : Blank%value = "null"
1389 510 : Blank%isNull = .true.
1390 : end if
1391 528 : end function constructBlank
1392 :
1393 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1394 :
1395 531 : 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 528 : 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 531 : if (present(value)) then
1404 21 : Position%value = getLowerCase(trim(adjustl(value)))
1405 21 : if (Position%value=="asis") then
1406 3 : Position%isAsis = .true.
1407 18 : elseif (Position%value=="rewind") then
1408 3 : Position%isRewind = .true.
1409 15 : elseif (Position%value=="append") then
1410 9 : Position%isAppend = .true.
1411 6 : elseif (Position%value=="undefined") then
1412 3 : Position%isUndefined = .true.
1413 : else
1414 3 : Position%value = ""
1415 3 : Position%Err%occurred = .true.
1416 3 : Position%Err%msg = PROCEDURE_NAME // ": Invalid requested Position%value='" // Position%value // "'."
1417 : end if
1418 : else
1419 510 : Position%value = "asis"
1420 510 : Position%isAsis = .true.
1421 : end if
1422 531 : end function constructPosition
1423 :
1424 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1425 :
1426 531 : 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 531 : 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 531 : if (present(value)) then
1435 21 : Delim%value = getLowerCase(trim(adjustl(value)))
1436 21 : if (Delim%value=="quote") then
1437 9 : Delim%isQuote = .true.
1438 12 : elseif (Delim%value=="apostrophe") then
1439 3 : Delim%isApostrophe = .true.
1440 9 : elseif (Delim%value=="none") then
1441 3 : Delim%isNone = .true.
1442 6 : elseif (Delim%value=="undefined") then
1443 3 : Delim%isUndefined = .true.
1444 : else
1445 3 : Delim%value = ""
1446 3 : Delim%Err%occurred = .true.
1447 3 : Delim%Err%msg = PROCEDURE_NAME // ": Invalid requested Delim%value='" // Delim%value // "'."
1448 : end if
1449 : else
1450 510 : Delim%value = "none"
1451 510 : Delim%isNone = .true.
1452 : end if
1453 531 : end function constructDelim
1454 :
1455 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1456 :
1457 528 : 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 531 : 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 528 : if (present(value)) then
1466 18 : Pad%value = getLowerCase(trim(adjustl(value)))
1467 18 : if (Pad%value=="yes") then
1468 3 : Pad%isPadded = .true.
1469 15 : elseif (Pad%value=="no") then
1470 9 : Pad%isNotPadded = .true.
1471 6 : elseif (Pad%value=="undefined") then
1472 3 : Pad%isUndefined = .true.
1473 : else
1474 3 : Pad%value = ""
1475 3 : Pad%Err%occurred = .true.
1476 3 : Pad%Err%msg = PROCEDURE_NAME // ": Invalid requested Pad%value='" // Pad%value // "'."
1477 : end if
1478 : else
1479 510 : Pad%value = "yes"
1480 510 : Pad%isPadded = .true.
1481 : end if
1482 528 : end function constructPad
1483 :
1484 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1485 :
1486 540 : 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 528 : 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 540 : if (present(value)) then
1495 30 : Round%value = getLowerCase(trim(adjustl(value)))
1496 30 : if (Round%value=="up") then
1497 9 : Round%isUp = .true.
1498 21 : elseif (Round%value=="down") then
1499 3 : Round%isDown = .true.
1500 18 : elseif (Round%value=="zero") then
1501 3 : Round%isZero = .true.
1502 15 : elseif (Round%value=="nearest") then
1503 6 : Round%isNearest = .true.
1504 9 : elseif (Round%value=="compatible") then
1505 3 : Round%isCompatible = .true.
1506 6 : elseif (Round%value=="processor_defined") then
1507 3 : Round%isProcessDefined = .true.
1508 3 : elseif (Round%value=="undefined") then
1509 0 : Round%isUndefined = .true.
1510 : else
1511 3 : Round%value = ""
1512 3 : Round%Err%occurred = .true.
1513 3 : Round%Err%msg = PROCEDURE_NAME // ": Invalid requested Round%value='" // Round%value // "'."
1514 : end if
1515 : else
1516 510 : Round%value = "processor_defined"
1517 510 : Round%isProcessDefined = .true.
1518 : end if
1519 540 : end function constructRound
1520 :
1521 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1522 :
1523 531 : 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 540 : 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 531 : if (present(value)) then
1532 21 : Sign%value = getLowerCase(trim(adjustl(value)))
1533 21 : if (Sign%value=="suppress") then
1534 3 : Sign%isSuppress = .true.
1535 18 : elseif (Sign%value=="plus") then
1536 3 : Sign%isPlus = .true.
1537 15 : elseif (Sign%value=="processor_defined") then
1538 3 : Sign%isProcessDefined = .true.
1539 12 : elseif (Sign%value=="undefined") then
1540 9 : Sign%isUndefined = .true.
1541 : else
1542 3 : Sign%value = ""
1543 3 : Sign%Err%occurred = .true.
1544 3 : Sign%Err%msg = PROCEDURE_NAME // ": Invalid requested Sign%value='" // Sign%value // "'."
1545 : end if
1546 : else
1547 510 : Sign%value = "processor_defined"
1548 510 : Sign%isProcessDefined = .true.
1549 : end if
1550 531 : end function constructSign
1551 :
1552 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1553 :
1554 : end module File_mod ! LCOV_EXCL_LINE
|
