File: /nfs/home/0/users/jenkins/mfix.git/model/error_manager_mod.f

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