File: N:\mfix\model\error_manager_mod.f

1     ! -*- f90 -*-
2     !----------------------------------------------------------------------!
3     ! Module: ERROR_MANAGER                                                !
4     !                                                                      !
5     ! Purpose: Unify error message handeling.                              !
6     !                                                                      !
7     !----------------------------------------------------------------------!
8           MODULE ERROR_MANAGER
9     
10           use, intrinsic :: ISO_C_BINDING
11           use exit, only: mfix_exit
12     
13           implicit none
14     
15     ! Interface
16     !---------------------------------------------------------------------//
17           interface iVal
18              module procedure iVal_int
19              module procedure iVal_dbl
20              module procedure iVal_log
21           end interface
22     
23     ! Maximum number of lines a message can have before a flush is needed.
24           INTEGER, PARAMETER :: LINE_COUNT  = 32
25     ! Maximum number of characters per line.
26           INTEGER, PARAMETER :: LINE_LENGTH = 256
27     
28     ! Character string for storing the error message.
29           CHARACTER(LEN=LINE_LENGTH), DIMENSION(LINE_COUNT) :: ERR_MSG
30     
31     ! Depth that the current call tree can go.
32           INTEGER, PARAMETER, PRIVATE :: MAX_CALL_DEPTH = 16
33     ! Current call depth.
34           INTEGER, PRIVATE :: CALL_DEPTH
35     
36     ! The name of the calling routine. Set by calling: INIT_ERR_MSG
37           CHARACTER(LEN=128), DIMENSION(MAX_CALL_DEPTH), PRIVATE :: CALLERS
38     
39     ! Flag for writing messages to the screen.
40           LOGICAL, PRIVATE :: SCR_LOG
41     
42     ! Error Flag.
43           INTEGER :: IER_EM
44     
45           contains
46     
47     !``````````````````````````````````````````````````````````````````````!
48     ! Subroutine: INIT_ERROR_MANAGER                                       !
49     !                                                                      !
50     ! Purpose: Initialize the error manager. This routine also opens the   !
51     ! .LOG file(s) based on user input settings.                           !
52     !......................................................................!
53           SUBROUTINE INIT_ERROR_MANAGER
54     
55     ! Global Variables:
56     !---------------------------------------------------------------------//
57     ! Name given to current run.
58           use run, only: RUN_NAME
59     ! Flag: All ranks report errors.
60           use output, only: ENABLE_DMP_LOG
61     ! Flag: My rank reports errors.
62           use funits, only: DMP_LOG
63     ! Flag: Provide the full log.
64           use output, only: FULL_LOG
65     ! Rank ID of process
66           use compar, only: myPE
67     ! Rank ID for IO handeling
68           use compar, only: PE_IO
69     ! Number of ranks in parallel run.
70           use compar, only: numPEs
71     ! File unit for LOG messages.
72           use funits, only: UNIT_LOG
73     ! Undefined character string.
74           use param1, only: UNDEFINED_C
75     
76     ! Global Routine Access:
77     !---------------------------------------------------------------------//
78           use mpi_utility, only: GLOBAL_ALL_SUM
79     
80           implicit none
81     
82     ! Local Variables:
83     !---------------------------------------------------------------------//
84     ! Log file name.
85           CHARACTER(len=255) :: LOGFILE
86           CHARACTER(len=255) :: FILE_NAME
87     ! First non-blank character in run_name.
88           INTEGER :: NB
89     ! Integer error flag
90           INTEGER :: IER(0:numPEs-1)
91     
92     ! Initialize the error flags.
93           IER = 0
94           IER_EM = 0
95     ! Initialize the call tree depth.
96           CALL_DEPTH = 0
97     ! Clear the error message storage container.
98           ERR_MSG = ''
99     ! Clear the caller routine information.
100           CALLERS = ''
101     
102     ! This turns on error messaging from all processes.
103           DMP_LOG = (myPE == PE_IO) .OR. ENABLE_DMP_LOG
104     ! Flag for printing screen messages.
105           SCR_LOG = (myPE == PE_IO) .AND. FULL_LOG
106     
107     ! Verify the length of user-provided name.
108           LOGFILE = ''
109           NB = INDEX(RUN_NAME,' ')
110     ! RUN_NAME length too short.
111           IF(RUN_NAME == UNDEFINED_C .OR. NB <= 1) THEN
112              IF(myPE  == PE_IO) WRITE (*, 1000) 'short'
113              CALL MFIX_EXIT(myPE)
114     ! RUN_NAME length too long.
115           ELSEIF(NB + 10 > LEN(LOGFILE)) THEN
116              IF(myPE == PE_IO) WRITE (*, 1000) 'long'
117              CALL MFIX_EXIT(myPE)
118     ! RUN_NAME legnth just right.
119           ELSE
120     ! Specify the .LOG file name based on MPI Rank extenion.
121              IF(numPEs == 1 .OR. .NOT.ENABLE_DMP_LOG) THEN
122                 WRITE(LOGFILE,"(A)")RUN_NAME(1:(NB-1))
123              ELSEIF(numPEs <    10) THEN
124                 WRITE(LOGFILE,"(A,'_',I1.1)") RUN_NAME(1:(NB-1)), myPE
125              ELSEIF(numPEs <   100) THEN
126                 WRITE(LOGFILE,"(A,'_',I2.2)") RUN_NAME(1:(NB-1)), myPE
127              ELSEIF(numPEs <  1000) THEN
128                 WRITE(LOGFILE,"(A,'_',I3.3)") RUN_NAME(1:(NB-1)), myPE
129              ELSEIF(numPEs < 10000) THEN
130                 WRITE(LOGFILE,"(A,'_',I4.4)") RUN_NAME(1:(NB-1)), myPE
131              ELSE
132                 WRITE(LOGFILE,"(A,'_',I8.8)") RUN_NAME(1:(NB-1)), myPE
133              ENDIF
134           ENDIF
135     
136     ! Open the .LOG file. From here forward, all routines should store
137     ! error messages (at a minimum) in the .LOG file.
138           IF(DMP_LOG) THEN
139              NB = len_trim(LOGFILE)+1
140              CALL OPEN_FILE(LOGFILE, NB, UNIT_LOG, '.LOG', FILE_NAME,      &
141                 'APPEND', 'SEQUENTIAL', 'FORMATTED', 132,  IER(myPE))
142           ENDIF
143     
144     ! Verify that the .LOG file was successfully opened. Otherwise, flag the
145     ! error and abort.
146           CALL GLOBAL_ALL_SUM(IER)
147           IF(sum(IER) /= 0) THEN
148              IF(myPE == PE_IO) WRITE(*,1001) trim(FILE_NAME)
149              CALL MFIX_EXIT(myPE)
150           ENDIF
151     
152           RETURN
153     
154      1000 FORMAT(2/,1X,70('*')/' From: INIT_ERROR_MANAGER',/               &
155              ' Error 1000: RUN_NAME too ',A,'. Please correct the',        &
156              ' mfix.dat file.',/1x,70('*'),2/)
157     
158      1001 FORMAT(2/,1X,70('*')/' From: INIT_ERROR_MANAGER',/               &
159              ' Error 1001: Failed to open log file: ',A,/' Aborting run.'/,&
160              1x,70('*'),2/)
161     
162           END SUBROUTINE INIT_ERROR_MANAGER
163     
164     !``````````````````````````````````````````````````````````````````````!
165     ! Subroutine: INIT_ERR_MSG                                             !
166     !                                                                      !
167     ! Purpose: Initialize the error manager for the local routine. This    !
168     ! call is needed to set the caller routines name for error messages.   !
169     !......................................................................!
170           SUBROUTINE INIT_ERR_MSG(CALLER)
171     
172     ! Rank ID of process
173           use compar, only: myPE
174     ! Flag: My rank reports errors.
175           use funits, only: DMP_LOG
176     ! File unit for LOG messages.
177           use funits, only: UNIT_LOG
178     
179           implicit none
180     
181           CHARACTER(LEN=*), intent(IN) :: CALLER
182     
183     ! Verify that the maximum call dept will not be exceeded.  If so, flag
184     ! the error and exit.
185           IF(CALL_DEPTH + 1 > MAX_CALL_DEPTH) THEN
186              IF(SCR_LOG) WRITE(*,1000) CALL_DEPTH
187              IF(DMP_LOG) WRITE(UNIT_LOG,1000) CALL_DEPTH
188              CALL SHOW_CALL_TREE
189              CALL MFIX_EXIT(myPE)
190           ELSE
191     ! Store the caller routines name.
192              CALL_DEPTH = CALL_DEPTH + 1
193              CALLERS(CALL_DEPTH) = trim(CALLER)
194           ENDIF
195     
196     ! Clear out the error manager.
197           ERR_MSG=''
198     
199           RETURN
200     
201      1000 FORMAT(/1X,70('*')/' From: ERROR_MANAGER --> INIT_ERR_MSG',/     &
202              ' Error 1000: Invalid ERROR_MANAGER usage. The maximum call', &
203              ' depth ',/' was exceeded. The calls to INIT_ERR_MSG should', &
204              ' have corresponding',/' calls to FINL_ERR_MSG. The current', &
205              ' CALL tree depth is: ',I4)
206     
207           END SUBROUTINE INIT_ERR_MSG
208     
209     !``````````````````````````````````````````````````````````````````````!
210     ! Subroutine: FINL_ERR_MSG                                             !
211     !                                                                      !
212     ! Purpose: Finalize the error manager. The call is needed to clear out !
213     ! old information and unset the lock.                                  !
214     !......................................................................!
215           SUBROUTINE FINL_ERR_MSG
216     
217     ! Rank ID of process
218           use compar, only: myPE
219     ! Flag: My rank reports errors.
220           use funits, only: DMP_LOG
221     ! File unit for LOG messages.
222           use funits, only: UNIT_LOG
223     
224           implicit none
225     
226     ! Single line.
227           CHARACTER(LEN=LINE_LENGTH) :: LINE
228     ! Line length with trailing space removed.
229           INTEGER :: LENGTH
230     ! Line Counter
231           INTEGER :: LC
232     ! Number of non-empty lines.
233           INTEGER :: COUNT
234     
235     ! The current calling routine.
236           CHARACTER(LEN=128) :: CALLER
237     
238     ! Verify that at the INIT routine was called.
239           IF(CALL_DEPTH < 1) THEN
240              IF(SCR_LOG) WRITE(*,1000)
241              IF(DMP_LOG) WRITE(UNIT_LOG,1000)
242              CALL MFIX_EXIT(myPE)
243           ELSE
244     ! Store the current caller, clear the array position, and decrement
245     ! the counter.
246              CALLER = CALLERS(CALL_DEPTH)
247              CALLERS(CALL_DEPTH) = ''
248              CALL_DEPTH = CALL_DEPTH - 1
249           ENDIF
250     
251     ! Verify that the error message container is empty.
252           COUNT = 0
253           DO LC = 1, LINE_COUNT
254              LINE = ERR_MSG(LC)
255              LENGTH = len_trim(LINE)
256              IF(0 < LENGTH .AND. LENGTH < 256 ) COUNT = COUNT + 1
257           ENDDO
258     
259     ! If the error message container is not empty, report the error, dump
260     ! the error message and abort MFIX.
261           IF(COUNT /= 0) THEN
262              IF(SCR_LOG) WRITE(*,1001) trim(CALLER)
263              IF(DMP_LOG) WRITE(UNIT_LOG,1001) trim(CALLER)
264     ! Write out the error message container contents.
265              DO LC = 1, LINE_COUNT
266                 LINE = ERR_MSG(LC)
267                 LENGTH = len_trim(LINE)
268                 IF(0 < LENGTH .AND. LENGTH < 256 ) THEN
269                    IF(SCR_LOG) WRITE(*,1002)LC, LENGTH, trim(LINE)
270                    IF(DMP_LOG) WRITE(UNIT_LOG,1002)LC, LENGTH, trim(LINE)
271                 ENDIF
272              ENDDO
273              IF(SCR_LOG) WRITE(*,1003)
274              IF(DMP_LOG) WRITE(UNIT_LOG, 1003)
275              CALL MFIX_EXIT(myPE)
276           ENDIF
277     
278     ! This shouldn't be needed, but it doesn't hurt.
279           ERR_MSG = ''
280     
281           RETURN
282     
283      1000 FORMAT(/1X,70('*')/' From: ERROR_MANAGER --> FINL_ERR_MSG',/     &
284              ' Error 1000: Ivalid ERROR_MANAGER usage. A call to FINL_ERR',&
285              '_MSG was',/' made while the call tree is empty. This can',   &
286              ' occur if a call to',/' FINL_ERR_MSG was made without a',    &
287              ' corresponding call to INIT_ERR_MSG.',/' Aborting MFIX.'/    &
288              1x,70('*'),2/)
289     
290      1001 FORMAT(/1X,70('*')/' From: ERROR_MANAGER --> FINL_ERR_MSG',/     &
291              ' Error 1001: Error container ERR_MSG not empty.',/           &
292              ' CALLERS: ',A,2/' Contents:')
293     
294      1002 FORMAT(' LC ',I2.2,': LEN: ',I3.3,1x,A)
295     
296      1003 FORMAT(/,1x,'Aborting MFIX.',1x,70('*'),2/)
297     
298           END SUBROUTINE FINL_ERR_MSG
299     
300     !``````````````````````````````````````````````````````````````````````!
301     !                                                                      !
302     !......................................................................!
303           SUBROUTINE FLUSH_ERR_MSG(DEBUG, HEADER, FOOTER, ABORT, LOG, &
304              CALL_TREE)
305     
306     ! Rank ID of process
307           use compar, only: myPE
308     ! Flag: My rank reports errors.
309           use funits, only: DMP_LOG
310     ! File unit for LOG messages.
311           use funits, only: UNIT_LOG
312     ! Flag to reinitialize the code.
313           use run, only: REINITIALIZING
314     
315     ! Dummy Arguments:
316     !---------------------------------------------------------------------//
317     ! Debug flag.
318           LOGICAL, INTENT(IN), OPTIONAL :: DEBUG
319     ! Flag to suppress the message header.
320           LOGICAL, INTENT(IN), OPTIONAL :: HEADER
321     ! Flag to suppress the message footer.
322           LOGICAL, INTENT(IN), OPTIONAL :: FOOTER
323     ! Flag to abort execution by invoking MFIX_EXIT.
324           LOGICAL, INTENT(IN), OPTIONAL :: ABORT
325     ! Flag to force (or override) writing data to the log file.
326           LOGICAL, INTENT(IN), OPTIONAL :: LOG
327     ! Provide the call tree in error message.
328           LOGICAL, INTENT(IN), OPTIONAL :: CALL_TREE
329     
330     ! Local Variables:
331     !---------------------------------------------------------------------//
332     ! Single line.
333           CHARACTER(LEN=LINE_LENGTH) :: LINE
334     ! Line length with trailing space removed.
335           INTEGER :: LENGTH
336     ! Index of last line in the message.
337           INTEGER :: LAST_LINE
338     ! Line Counter
339           INTEGER :: LC
340     ! Local debug flag.
341           LOGICAL :: D_FLAG
342     ! Local flag to suppress writing the header.
343           LOGICAL :: H_FLAG
344     ! Local flag to suppress writing the footer.
345           LOGICAL :: F_FLAG
346     ! Local abort flag.
347           LOGICAL :: A_FLAG
348     ! Local call tree flag.
349           LOGICAL :: CT_FLAG
350     ! Local flag to store output to UNIT_LOG
351           LOGICAL :: UNT_LOG
352     
353     ! The current calling routine.
354           CHARACTER(LEN=128) :: CALLER
355     
356     ! Set the abort flag. Continue running by default.
357           IF(PRESENT(ABORT))THEN
358              A_FLAG = ABORT
359           ELSE
360              A_FLAG = .FALSE.
361           ENDIF
362     
363     ! Set the local debug flag. Suppress debugging messages by default.
364           IF(PRESENT(DEBUG)) THEN
365              D_FLAG = DEBUG
366           ELSE
367              D_FLAG = .FALSE.
368           ENDIF
369     
370     ! Set the header flag. Write the header by default.
371           IF(PRESENT(HEADER)) THEN
372              H_FLAG = HEADER
373           ELSE
374              H_FLAG = .TRUE.
375           ENDIF
376     
377     ! Set the footer flag. Write the footer by default.
378           IF(PRESENT(FOOTER))THEN
379              F_FLAG = FOOTER
380           ELSE
381              F_FLAG = .TRUE.
382           ENDIF
383     
384     ! Set the call tree flag. Suppress the call tree by default.
385           IF(PRESENT(LOG)) THEN
386              UNT_LOG = DMP_LOG .AND. LOG
387           ELSE
388              UNT_LOG = DMP_LOG
389           ENDIF
390     
391     ! Set the call tree flag. Suppress the call tree by default.
392           IF(PRESENT(CALL_TREE)) THEN
393              CT_FLAG = CALL_TREE
394           ELSE
395              CT_FLAG = .FALSE.
396           ENDIF
397     
398     ! Write out header infomration.
399           IF(H_FLAG) THEN
400     ! Set the current caller.
401              CALLER = CALLERS(CALL_DEPTH)
402              IF(D_FLAG) THEN
403                 IF(SCR_LOG) WRITE(*,2000) trim(CALLER)
404                 IF(UNT_LOG) WRITE(UNIT_LOG,2000) trim(CALLER)
405              ELSE
406                 IF(SCR_LOG) WRITE(*,1000) trim(CALLER)
407                 IF(UNT_LOG) WRITE(UNIT_LOG,1000) trim(CALLER)
408              ENDIF
409           ENDIF
410     
411     ! Find the end of the message.
412           LAST_LINE = 0
413           DO LC = 1, LINE_COUNT
414              LINE = ERR_MSG(LC)
415              LENGTH = len_trim(LINE)
416              IF(0 < LENGTH .AND. LENGTH < 256 ) LAST_LINE = LC
417           ENDDO
418     
419     ! Write the message body.
420           IF(D_FLAG)THEN
421              DO LC = 1, LINE_COUNT
422                 LINE = ERR_MSG(LC)
423                 LENGTH = len_trim(LINE)
424                 IF(LENGTH == 0) THEN
425                    IF(SCR_LOG) WRITE(*,2001) LC, LENGTH, "EMPTY."
426                    IF(UNT_LOG) WRITE(UNIT_LOG,2001) LC, LENGTH, "EMPTY."
427                 ELSEIF(LENGTH >=  LINE_LENGTH)THEN
428                    IF(SCR_LOG) WRITE(*,2001) LC, LENGTH, "OVERFLOW."
429                    IF(UNT_LOG) WRITE(UNIT_LOG,2001) LC, LENGTH, "OVERFLOW."
430                 ELSE
431                    IF(SCR_LOG) WRITE(*,2001) LC, LENGTH, trim(LINE)
432                    IF(UNT_LOG) WRITE(UNIT_LOG,2001) LC, LENGTH, trim(LINE)
433                 ENDIF
434              ENDDO
435           ELSE
436              DO LC = 1, LAST_LINE
437                 LINE = ERR_MSG(LC)
438                 LENGTH = len_trim(LINE)
439                 IF(0 < LENGTH .AND. LENGTH < 256 ) THEN
440                    IF(SCR_LOG) WRITE(*,1001) trim(LINE)
441                    IF(UNT_LOG) WRITE(UNIT_LOG,1001) trim(LINE)
442                 ELSE
443                    IF(SCR_LOG) WRITE(*,"('  ')")
444                    IF(UNT_LOG) WRITE(UNIT_LOG,"('  ')")
445                 ENDIF
446              ENDDO
447              IF(LAST_LINE == 0) THEN
448                 IF(SCR_LOG) WRITE(*,"('  ')")
449                 IF(UNT_LOG) WRITE(UNIT_LOG,"('  ')")
450              ENDIF
451           ENDIF
452     
453     ! Print footer.
454           IF(F_FLAG) THEN
455              IF(D_FLAG) THEN
456                 IF(SCR_LOG) WRITE(*, 2002)
457                 IF(UNT_LOG) WRITE(UNIT_LOG, 2002)
458              ELSE
459                 IF(SCR_LOG) WRITE(*, 1002)
460                 IF(UNT_LOG) WRITE(UNIT_LOG, 1002)
461              ENDIF
462           ENDIF
463     
464     ! Clear the message array.
465           ERR_MSG=''
466     
467     ! Abort the run if specified.
468           IF(A_FLAG) THEN
469              IF(REINITIALIZING)THEN
470                 IER_EM = 1
471              ELSE
472                 IF(D_FLAG) WRITE(*,3000) myPE
473                 CALL MFIX_EXIT(myPE)
474              ENDIF
475           ENDIF
476     
477           RETURN
478     
479      1000 FORMAT(2/,1x,70('*'),/' From: ',A)
480      1001 FORMAT(1x,A)
481      1002 FORMAT(1x,70('*'))
482     
483      2000 FORMAT(2/,'--- HEADER ---> ',70('*'),/'--- HEADER ---> From: ',A)
484      2001 FORMAT('LC ',I2.2,': LEN: ',I3.3,1x,A)
485      2002 FORMAT('--- FOOTER --->',1x,70('*'))
486     
487      3000 FORMAT(2x,'Rank ',I5,' calling MFIX_EXIT from FLUSH_ERR_MSG.')
488     
489           END SUBROUTINE FLUSH_ERR_MSG
490     
491     
492     !``````````````````````````````````````````````````````````````````````!
493     !                                                                      !
494     !......................................................................!
495           SUBROUTINE SHOW_CALL_TREE(HEADER, FOOTER)
496     
497     ! Flag: My rank reports errors.
498           use funits, only: DMP_LOG
499     ! File unit for LOG messages.
500           use funits, only: UNIT_LOG
501     
502     ! Dummy Arguments:
503     !---------------------------------------------------------------------//
504     ! Flag to suppress the message header.
505           LOGICAL, INTENT(IN), OPTIONAL :: HEADER
506     ! Flag to suppress the message footer.
507           LOGICAL, INTENT(IN), OPTIONAL :: FOOTER
508     
509     ! Local Variables:
510     !---------------------------------------------------------------------//
511     ! Local flag to suppress writing the header.
512           LOGICAL :: H_FLAG
513     ! Local flag to suppress writing the footer.
514           LOGICAL :: F_FLAG
515     ! Generic loop counters.
516           INTEGER ::  LC, SL
517     
518     ! Set the header flag. Write the header by default.
519           H_FLAG = merge(HEADER, .TRUE., PRESENT(HEADER))
520     ! Set the footer flag. Write the footer by default.
521           F_FLAG = merge(FOOTER, .TRUE., PRESENT(FOOTER))
522     
523     ! Header
524           IF(H_FLAG) THEN
525              IF(SCR_LOG) WRITE(*,1000)
526              IF(DMP_LOG) WRITE(UNIT_LOG,1000)
527           ENDIF
528     
529     ! Call Tree
530           DO LC=1,MAX_CALL_DEPTH
531              DO SL=1,LC
532                 IF(SCR_LOG) WRITE(*,1001,ADVANCE='NO')
533                 IF(DMP_LOG) WRITE(UNIT_LOG,1001,ADVANCE='NO')
534              ENDDO
535              IF(SCR_LOG) WRITE(*,1002,ADVANCE='YES') CALLERS(LC)
536              IF(DMP_LOG) WRITE(UNIT_LOG,1002,ADVANCE='YES') CALLERS(LC)
537           ENDDO
538     
539     ! Footer.
540           IF(F_FLAG) THEN
541              IF(SCR_LOG) WRITE(*,1003)
542              IF(DMP_LOG) WRITE(UNIT_LOG,1003)
543           ENDIF
544     
545           RETURN
546     
547      1000 FORMAT(2/,1x,70('*'),' CALL TREE INFORMATION')
548      1001 FORMAT(' ')
549      1002 FORMAT('> ',A)
550      1003 FORMAT(/1x,70('*'))
551     
552           END SUBROUTINE SHOW_CALL_TREE
553     
554     !``````````````````````````````````````````````````````````````````````!
555     !                                                                      !
556     !......................................................................!
557           CHARACTER(len=32) FUNCTION iVar(VAR, i1, i2, i3)
558     
559           CHARACTER(len=*), intent(in) :: VAR
560     
561           INTEGER,  intent(in) :: i1
562           INTEGER, OPTIONAL, intent(in) :: i2
563           INTEGER, OPTIONAL, intent(in) :: i3
564     
565           CHARACTER(len=16) :: iASc
566           CHARACTER(len=64) :: tVAR
567     
568           iASc=''; WRITE(iASc,*)i1
569           tVar=''; WRITE(tVar,"(A,'(',A)") &
570              trim(adjustl(VAR)), trim(adjustl(iASc))
571     
572           IF(PRESENT(i2))THEN
573              iASc=''; WRITE(iASc,*)i2
574              WRITE(tVar,"(A,',',A)") trim(tVar), trim(adjustl(iASc))
575           ENDIF
576     
577           IF(PRESENT(i3))THEN
578              iASc=''; WRITE(iASc,*)i3
579              WRITE(tVar,"(A,',',A)") trim(tVar), trim(adjustl(iASc))
580           ENDIF
581     
582           WRITE(tVar,"(A,')')") trim(tVar)
583     
584           iVar = trim(adjustl(tVar))
585     
586           RETURN
587           END FUNCTION iVar
588     
589     !``````````````````````````````````````````````````````````````````````!
590     !                                                                      !
591     !......................................................................!
592           CHARACTER(len=32) FUNCTION iVal_int(VAL)
593           INTEGER, intent(in) :: VAL
594     
595           CHARACTER(len=32) :: iASc
596     
597           WRITE(iASc,*) VAL
598           iVal_int = trim(adjustl(iASc))
599     
600           END FUNCTION iVal_int
601     
602     !``````````````````````````````````````````````````````````````````````!
603     !                                                                      !
604     !......................................................................!
605           CHARACTER(len=32) FUNCTION iVal_dbl(VAL)
606           DOUBLE PRECISION, intent(in) :: VAL
607     
608           CHARACTER(len=32) :: dASc
609     
610           IF(abs(VAL) < 1.0d-2 .AND. abs(VAL) < 1.0d2) THEN
611              WRITE(dASc,"(F18.4)") VAL
612           ELSE
613              WRITE(dASc,"(G18.4)") VAL
614           ENDIF
615     
616           iVal_dbl = trim(adjustl(dASc))
617     
618           END FUNCTION iVal_dbl
619     
620     !``````````````````````````````````````````````````````````````````````!
621     !                                                                      !
622     !......................................................................!
623           CHARACTER(len=32) FUNCTION iVal_log(VAL)
624           LOGICAL, intent(in) :: VAL
625     
626           IF(VAL) THEN
627              iVal_log = ".TRUE."
628           ELSE
629              iVal_log = ".FALSE."
630           ENDIF
631     
632           RETURN
633           END FUNCTION iVal_log
634     
635     !``````````````````````````````````````````````````````````````````````!
636     ! Function: Reports TRUE if one or more processes set an ABORT flag.   !
637     !......................................................................!
638           LOGICAL FUNCTION REINIT_ERROR()
639     
640     ! Global Routine Access:
641     !---------------------------------------------------------------------//
642           use mpi_utility, only: GLOBAL_ALL_SUM
643     
644           CALL GLOBAL_ALL_SUM(IER_EM)
645           REINIT_ERROR = (IER_EM /= 0)
646           IER_EM = 0
647           RETURN
648           END FUNCTION REINIT_ERROR
649     
650           END MODULE ERROR_MANAGER
651