source: trunk/MESOSCALE_DEV/SRC/ARWpost/src/module_debug.f90 @ 897

Last change on this file since 897 was 207, checked in by aslmd, 14 years ago

MESOSCALE: A GENERAL CLEAN-UP FOLLOWING UPDATING THE USER MANUAL. EVERYTHING ESSENTIAL IS IN MESOSCALE (much lighter than before). EVERYTHING FOR DEVELOPPERS OR EXPERTS IS IN MESOSCALE_DEV.
File size: 4.6 KB
RevLine 
[207]1MODULE module_debug
2
3   integer, parameter :: STDOUT=-1, DEBUG=0, INFORM=1, WARN=2, ERROR=3
4
5   CONTAINS
6
7   SUBROUTINE mprintf(assertion, level, fmtstring, i1, i2, i3, f1, f2, f3, s1, s2, s3)
8
9      implicit none
10
11      ! Arguments
12      integer, intent(in)                     :: level
13      logical, intent(in)                     :: assertion
14      character (len=*), intent(in)           :: fmtstring
15      integer, intent(in), optional           :: i1, i2, i3
16      real, intent(in), optional              :: f1, f2, f3
17      character (len=*), intent(in), optional :: s1, s2, s3
18
19      ! Local variables
20      integer                                 :: idxi, idxf, idxs, istart, i, iend, ia
21      real                                    :: fa
22      character (len=128)                     :: sa
23
24      idxi = 1
25      idxf = 1
26      idxs = 1
27      istart = 1
28      iend = len_trim(fmtstring)
29
30      IF (assertion) THEN
31
32         IF (level == DEBUG) THEN
33            WRITE(6,'(a)',advance='no') 'DEBUG: '
34         ELSE IF (level == INFORM) THEN
35            WRITE(6,'(a)',advance='no') 'INFORM: '
36         ELSE IF (level == WARN) THEN
37            WRITE(6,'(a)',advance='no') 'WARNING: '
38         ELSE IF (level == ERROR) THEN
39            WRITE(6,'(a)',advance='no') 'ERROR: '
40         END IF
41     
42         i = index(fmtstring(istart:iend),'%')
43         DO WHILE (i > 0 .and. i < iend)
44            i = i + istart - 1
45            WRITE(6,'(a)',advance='no') fmtstring(istart:i-1)
46   
47            IF (fmtstring(i+1:i+1) == '%') THEN
48               WRITE(6,'(a1)',advance='no') '%'
49                           
50            ELSE IF (fmtstring(i+1:i+1) == 'i') THEN
51               IF (idxi == 1 .and. present(i1)) THEN
52                  ia = i1
53               ELSE IF (idxi == 2 .and. present(i2)) THEN
54                  ia = i2
55               ELSE IF (idxi == 3 .and. present(i3)) THEN
56                  ia = i3
57               END IF
58   
59               IF (ia < 10) THEN
60                  WRITE(6,'(i1)',advance='no') ia
61               ELSE IF (ia < 100) THEN
62                  WRITE(6,'(i2)',advance='no') ia
63               ELSE IF (ia < 1000) THEN
64                  WRITE(6,'(i3)',advance='no') ia
65               ELSE IF (ia < 10000) THEN
66                  WRITE(6,'(i4)',advance='no') ia
67               ELSE IF (ia < 100000) THEN
68                  WRITE(6,'(i5)',advance='no') ia
69               ELSE
70                  WRITE(6,'(i9)',advance='no') ia
71               END IF
72               idxi = idxi + 1
73   
74            ELSE IF (fmtstring(i+1:i+1) == 'f') THEN
75               IF (idxf == 1 .and. present(f1)) THEN
76                  fa = f1
77               ELSE IF (idxf == 2 .and. present(f2)) THEN
78                  fa = f2
79               ELSE IF (idxf == 3 .and. present(f3)) THEN
80                  fa = f3
81               END IF
82   
83               IF (fa < -100000.) THEN
84                  WRITE(6,'(f12.4)',advance='no') fa
85               ELSE IF (fa < -10000.) THEN
86                  WRITE(6,'(f11.4)',advance='no') fa
87               ELSE IF (fa < -1000.) THEN
88                  WRITE(6,'(f10.4)',advance='no') fa
89               ELSE IF (fa < -100.) THEN
90                  WRITE(6,'(f9.4)',advance='no') fa
91               ELSE IF (fa < -10.) THEN
92                  WRITE(6,'(f8.4)',advance='no') fa
93               ELSE IF (fa < 0.) THEN
94                  WRITE(6,'(f7.4)',advance='no') fa
95               ELSE IF (fa < 10.) THEN
96                  WRITE(6,'(f6.4)',advance='no') fa
97               ELSE IF (fa < 100.) THEN
98                  WRITE(6,'(f7.4)',advance='no') fa
99               ELSE IF (fa < 1000.) THEN
100                  WRITE(6,'(f8.4)',advance='no') fa
101               ELSE IF (fa < 10000.) THEN
102                  WRITE(6,'(f9.4)',advance='no') fa
103               ELSE IF (fa < 100000.) THEN
104                  WRITE(6,'(f10.4)',advance='no') fa
105               ELSE
106                  WRITE(6,'(f15.4)',advance='no') fa
107               END IF
108               idxf = idxf + 1
109   
110            ELSE IF (fmtstring(i+1:i+1) == 's') THEN
111               IF (idxs == 1 .and. present(s1)) THEN
112                  sa = s1
113               ELSE IF (idxs == 2 .and. present(s2)) THEN
114                  sa = s2
115               ELSE IF (idxs == 3 .and. present(s3)) THEN
116                  sa = s3
117               END IF
118   
119               WRITE(6,'(a)',advance='no') trim(sa)
120               idxs = idxs + 1
121   
122            END IF
123   
124            istart = i+2
125            i = index(fmtstring(istart:iend),'%')
126         END do
127   
128         WRITE(6,'(a)') fmtstring(istart:iend)
129
130         IF (level == ERROR) stop
131
132      END IF
133
134
135   END SUBROUTINE mprintf
136
137END MODULE module_debug
Note: See TracBrowser for help on using the repository browser.