/[MITgcm]/MITgcm/pkg/monitor/mon_out.F
ViewVC logotype

Diff of /MITgcm/pkg/monitor/mon_out.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.1 by cnh, Mon Jun 18 17:39:59 2001 UTC revision 1.9 by edhill, Tue Sep 7 21:32:10 2004 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4  #include "CPP_OPTIONS.h"  #include "MONITOR_OPTIONS.h"
5    
6        SUBROUTINE MON_OUT_I(pref, value, foot )  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7  C.sh  /==========================================================\  CBOP
8  C     | SUBROUTINE MON_OUT_I                                     |  C     !ROUTINE: MON_OUT_I
9  C     | o Formatted integer I/O for monitor print out.           |  
10  C.    \==========================================================/  C     !INTERFACE:
11        IMPLICIT NONE        SUBROUTINE MON_OUT_I( pref, value, foot, myThid )
12    
13  C.gd  === Global data ===  C     !DESCRIPTION:
14  #include "SIZE.h"  C     Formatted integer I/O for monitor print out.          
15  #include "EEPARAMS.h"  
16  #include "MONITOR.h"  C     !INPUT PARAMETERS:
17        EXTERNAL IFNBLNK  C     pref   - Field prefix ( ignored if == mon_string_none )
18        INTEGER  IFNBLNK  C     value  - Value to print
19        EXTERNAL ILNBLNK  C     foot   - Field suffix ( ignored if == mon_string_none )
       INTEGER  ILNBLNK  
 C.  
   
 C.ra  === Routine arguments ===  
 C.d   pref   - Field prefix ( ignored if == mon_string_none )  
 C.d   value  - Value to print  
 C.d   foot   - Field suffix ( ignored if == mon_string_none )  
20        CHARACTER*(*) pref        CHARACTER*(*) pref
21        INTEGER       value        INTEGER       value
22        CHARACTER*(*) foot        CHARACTER*(*) foot
23  C.        INTEGER  myThid
24    CEOP
 C.lv  === Local variables ===  
 C.d   msgBuf - Buffer for building output string  
 C.d   lBuf   - Buffer for length  
 C.d.  I0     - Temps used in calculating string length  
 C     I1  
 C.    IL  
       CHARACTER*(MAX_LEN_MBUF) msgBuf  
       INTEGER  lBuf  
       INTEGER  I0, I1, IL  
 C.  
   
       msgBuf = ' '  
       lBuf   = 0  
   
       I0 = IFNBLNK(mon_head)  
       I1 = ILNBLNK(mon_head)  
       IL = I1-I0+1  
       IF ( IL .GT. 0 .AND. lBuf+IL+1 .LE. MAX_LEN_MBUF ) THEN  
        msgBuf(1:IL) = mon_head  
        lBuf = IL+1  
        msgBuf(lBuf:lBuf) = ' '  
       ENDIF  
   
       IF ( mon_pref(1:mon_prefL) .NE. mon_string_none .AND.  
      &     lBuf+mon_prefL+1      .LE. MAX_LEN_MBUF ) THEN  
        lBuf = lBuf+1  
        msgBuf(lBuf:lBuf+mon_prefL-1) = mon_pref(1:mon_prefL)  
        lBuf = lBuf+mon_prefL-1  
       ENDIF  
   
       I0 = IFNBLNK(pref)  
       I1 = ILNBLNK(pref)  
       IL = I1-I0+1  
       IF ( IL .GT. 0 ) THEN  
        IF ( pref(I0:I1) .NE. mon_string_none .AND.  
      &      lBuf+IL+1   .LE. MAX_LEN_MBUF ) THEN  
         lBuf = lBuf+1  
         msgBuf(lBuf:lBuf+IL-1) = pref(I0:I1)  
         lBuf = lBuf+IL-1  
        ENDIF  
       ENDIF  
   
       I0 = IFNBLNK(foot)  
       I1 = ILNBLNK(foot)  
       IL = I1-I0+1  
       IF ( IL .GT. 0 ) THEN  
        IF ( foot(I0:I1) .NE. mon_string_none .AND.  
      &      lBuf+IL+1   .LE. MAX_LEN_MBUF ) THEN  
         lBuf = lBuf+1  
         msgBuf(lBuf:lBuf+IL-1) = foot(I0:I1)  
         lBuf = lBuf+IL-1  
        ENDIF  
       ENDIF  
   
       msgBuf(35:35) = '='  
   
       WRITE(msgBuf(36:57),'(1X,I21)') value  
   
       CALL PRINT_MESSAGE( msgBuf, mon_ioUnit, SQUEEZE_RIGHT, 1 )  
25    
26          CALL MON_OUT_ALL(pref, foot, 1, value, 0.0d0, myThid)
27        RETURN        RETURN
28        END        END
       SUBROUTINE MON_OUT_RS(pref, value, foot )  
 C.sh  /==========================================================\  
 C     | SUBROUTINE MON_OUT_RS                                    |  
 C     | o Formatted RS I/O for monitor print out.                |  
 C.    \==========================================================/  
       IMPLICIT NONE  
29    
30  C.gd  === Global data ===  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
31  #include "SIZE.h"  CBOP
32  #include "EEPARAMS.h"  C     !ROUTINE: MON_OUT_RS
33  #include "MONITOR.h"  
34        EXTERNAL IFNBLNK  C     !INTERFACE:
35        INTEGER  IFNBLNK        SUBROUTINE MON_OUT_RS( pref, value, foot, myThid )
36        EXTERNAL ILNBLNK  
37        INTEGER  ILNBLNK  C     !DESCRIPTION:
38  C.  C     Formatted RS I/O for monitor print out.
39    
40  C.ra  === Routine arguments ===  C     !INPUT PARAMETERS:
41  C.d   pref   - Field prefix ( ignored if == mon_string_none )  C     pref   - Field prefix ( ignored if == mon_string_none )
42  C.d   value  - Value to print  C     value  - Value to print
43  C.d   foot   - Field suffix ( ignored if == mon_string_none )  C     foot   - Field suffix ( ignored if == mon_string_none )
44        CHARACTER*(*) pref        CHARACTER*(*) pref
45        _RS           value        _RS           value
46        CHARACTER*(*) foot        CHARACTER*(*) foot
47  C.        INTEGER  myThid
48    CEOP
49  C.lv  === Local variables ===        REAL*8 dtmp
50  C.d   msgBuf - Buffer for building output string        dtmp = value
 C.d   lBuf   - Buffer for length  
 C.d.  I0     - Temps used in calculating string length  
 C     I1  
 C.    IL  
       CHARACTER*(MAX_LEN_MBUF) msgBuf  
       INTEGER  lBuf  
       INTEGER  I0, I1, IL  
 C.  
51    
52        msgBuf = ' '        CALL MON_OUT_ALL(pref, foot, 2, 0, dtmp, myThid)
53        lBuf   = 0        RETURN
54          END
       I0 = IFNBLNK(mon_head)  
       I1 = ILNBLNK(mon_head)  
       IL = I1-I0+1  
       IF ( IL .GT. 0 .AND. lBuf+IL+1 .LE. MAX_LEN_MBUF ) THEN  
        msgBuf(1:IL) = mon_head  
        lBuf = IL+1  
        msgBuf(lBuf:lBuf) = ' '  
       ENDIF  
   
       IF ( mon_pref(1:mon_prefL) .NE. mon_string_none .AND.  
      &     lBuf+mon_prefL+1      .LE. MAX_LEN_MBUF ) THEN  
        lBuf = lBuf+1  
        msgBuf(lBuf:lBuf+mon_prefL-1) = mon_pref(1:mon_prefL)  
        lBuf = lBuf+mon_prefL-1  
       ENDIF  
55    
56        I0 = IFNBLNK(pref)  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
57        I1 = ILNBLNK(pref)  CBOP
58        IL = I1-I0+1  C     !ROUTINE: MON_OUT_RL
59        IF ( IL .GT. 0 ) THEN  
60         IF ( pref(I0:I1) .NE. mon_string_none .AND.  C     !INTERFACE:
61       &      lBuf+IL+1   .LE. MAX_LEN_MBUF ) THEN        SUBROUTINE MON_OUT_RL( pref, value, foot, myThid )
62          lBuf = lBuf+1  
63          msgBuf(lBuf:lBuf+IL-1) = pref(I0:I1)  C     !DESCRIPTION:
64          lBuf = lBuf+IL-1  C     Formatted RL I/O for monitor print out.
65         ENDIF  
66        ENDIF  C     !INPUT PARAMETERS:
67    C     pref   - Field prefix ( ignored if == mon_string_none )
68    C     value  - Value to print
69    C     foot   - Field suffix ( ignored if == mon_string_none )
70          CHARACTER*(*) pref
71          _RL           value
72          CHARACTER*(*) foot
73          INTEGER  myThid
74    CEOP
75          REAL*8 dtmp
76          dtmp = value
77    
78        I0 = IFNBLNK(foot)        CALL MON_OUT_ALL(pref, foot, 2, 0, dtmp, myThid)
79        I1 = ILNBLNK(foot)        RETURN
80        IL = I1-I0+1        END
       IF ( IL .GT. 0 ) THEN  
        IF ( foot(I0:I1) .NE. mon_string_none .AND.  
      &      lBuf+IL+1   .LE. MAX_LEN_MBUF ) THEN  
         lBuf = lBuf+1  
         msgBuf(lBuf:lBuf+IL-1) = foot(I0:I1)  
         lBuf = lBuf+IL-1  
        ENDIF  
       ENDIF  
81    
82        msgBuf(35:35) = '='  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
83    CBOP 1
84    C     !ROUTINE: MON_OUT_ALL
85    
86    C     !INTERFACE:
87          SUBROUTINE MON_OUT_ALL(
88         I     pref, foot,
89         I     itype, ival, dval,
90         I     myThid )
91    
92        WRITE(msgBuf(36:57),'(1X,1P1E21.13)') value  C     !DESCRIPTION:
93    C     Formatted I/O for monitor output.
94    
95        CALL PRINT_MESSAGE( msgBuf, mon_ioUnit, SQUEEZE_RIGHT, 1 )  C     !USES:
       RETURN  
       END  
       SUBROUTINE MON_OUT_RL(pref, value, foot )  
 C.sh  /==========================================================\  
 C     | SUBROUTINE MON_OUT_RL                                    |  
 C     | o Formatted RL I/O for monitor print out.                |  
 C.    \==========================================================/  
96        IMPLICIT NONE        IMPLICIT NONE
   
 C.gd  === Global data ===  
97  #include "SIZE.h"  #include "SIZE.h"
98  #include "EEPARAMS.h"  #include "EEPARAMS.h"
99    #include "PARAMS.h"
100    #include "EESUPPORT.h"
101  #include "MONITOR.h"  #include "MONITOR.h"
102        EXTERNAL IFNBLNK        INTEGER IFNBLNK
103        INTEGER  IFNBLNK        INTEGER ILNBLNK
       EXTERNAL ILNBLNK  
       INTEGER  ILNBLNK  
 C.  
   
 C.ra  === Routine arguments ===  
 C.d   pref   - Field prefix ( ignored if == mon_string_none )  
 C.d   value  - Value to print  
 C.d   foot   - Field suffix ( ignored if == mon_string_none )  
       CHARACTER*(*) pref  
       _RL           value  
       CHARACTER*(*) foot  
 C.  
104    
105  C.lv  === Local variables ===  C     !INPUT PARAMETERS:
106  C.d   msgBuf - Buffer for building output string  C     pref   - Field prefix ( ignored if == mon_string_none )
107  C.d   lBuf   - Buffer for length  C     foot   - Field suffix ( ignored if == mon_string_none )
108  C.d.  I0     - Temps used in calculating string length        CHARACTER*(*) pref, foot
109  C     I1        INTEGER itype
110  C.    IL        INTEGER ival
111          REAL*8  dval
112          INTEGER myThid
113    CEOP
114    
115    C     !LOCAL VARIABLES:
116    C     msgBuf - Buffer for building output string
117    C     lBuf   - Buffer for length
118    C     I0     - Temps used in calculating string length
119        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
120        INTEGER  lBuf        INTEGER  lBuf
121        INTEGER  I0, I1, IL        INTEGER  i, I0,I1, IL
122  C.        CHARACTER*(100) mon_vname
123          INTEGER  nvname
124    
125        msgBuf = ' '        msgBuf = ' '
126        lBuf   = 0        lBuf   = 0
127    
128          DO i = 1,100
129            mon_vname(i:i) = ' '
130          ENDDO
131    
132        I0 = IFNBLNK(mon_head)        I0 = IFNBLNK(mon_head)
133        I1 = ILNBLNK(mon_head)        I1 = ILNBLNK(mon_head)
134        IL = I1-I0+1        IL = I1-I0+1
135        IF ( IL .GT. 0 .AND. lBuf+IL+1 .LE. MAX_LEN_MBUF ) THEN        IF ( IL .GT. 0 .AND. lBuf+IL+1 .LE. MAX_LEN_MBUF ) THEN
136         msgBuf(1:IL) = mon_head          msgBuf(1:IL) = mon_head
137         lBuf = IL+1          lBuf = IL+1
138         msgBuf(lBuf:lBuf) = ' '          msgBuf(lBuf:lBuf) = ' '
139        ENDIF        ENDIF
140          
141        IF ( mon_pref(1:mon_prefL) .NE. mon_string_none .AND.        IF ( mon_pref(1:mon_prefL) .NE. mon_string_none .AND.
142       &     lBuf+mon_prefL+1      .LE. MAX_LEN_MBUF ) THEN       &     lBuf+mon_prefL+1      .LE. MAX_LEN_MBUF ) THEN
143         lBuf = lBuf+1          lBuf = lBuf+1
144         msgBuf(lBuf:lBuf+mon_prefL-1) = mon_pref(1:mon_prefL)          msgBuf(lBuf:lBuf+mon_prefL-1) = mon_pref(1:mon_prefL)
145         lBuf = lBuf+mon_prefL-1          lBuf = lBuf+mon_prefL-1
146            mon_vname(1:mon_prefL) = mon_pref(1:mon_prefL)
147            nvname = mon_prefL
148          ELSE
149            nvname = 0
150        ENDIF        ENDIF
151    
152        I0 = IFNBLNK(pref)        I0 = IFNBLNK(pref)
153        I1 = ILNBLNK(pref)        I1 = ILNBLNK(pref)
154        IL = I1-I0+1        IL = I1-I0+1
155        IF ( IL .GT. 0 ) THEN        IF ( IL .GT. 0 ) THEN
156         IF ( pref(I0:I1) .NE. mon_string_none .AND.          IF ( pref(I0:I1) .NE. mon_string_none .AND.
157       &      lBuf+IL+1   .LE. MAX_LEN_MBUF ) THEN       &       lBuf+IL+1   .LE. MAX_LEN_MBUF ) THEN
158          lBuf = lBuf+1            lBuf = lBuf+1
159          msgBuf(lBuf:lBuf+IL-1) = pref(I0:I1)            msgBuf(lBuf:lBuf+IL-1) = pref(I0:I1)
160          lBuf = lBuf+IL-1            lBuf = lBuf+IL-1
161         ENDIF            mon_vname((nvname+1):(nvname+IL)) = pref(I0:I1)
162              nvname = nvname + IL
163            ENDIF
164        ENDIF        ENDIF
165    
166        I0 = IFNBLNK(foot)        I0 = IFNBLNK(foot)
167        I1 = ILNBLNK(foot)        I1 = ILNBLNK(foot)
168        IL = I1-I0+1        IL = I1-I0+1
169        IF ( IL .GT. 0 ) THEN        IF ( IL .GT. 0 ) THEN
170         IF ( foot(I0:I1) .NE. mon_string_none .AND.          IF ( foot(I0:I1) .NE. mon_string_none .AND.
171       &      lBuf+IL+1   .LE. MAX_LEN_MBUF ) THEN       &       lBuf+IL+1   .LE. MAX_LEN_MBUF ) THEN
172          lBuf = lBuf+1            lBuf = lBuf+1
173          msgBuf(lBuf:lBuf+IL-1) = foot(I0:I1)            msgBuf(lBuf:lBuf+IL-1) = foot(I0:I1)
174          lBuf = lBuf+IL-1            lBuf = lBuf+IL-1
175         ENDIF            mon_vname((nvname+1):(nvname+IL)) = foot(I0:I1)
176              nvname = nvname + IL
177            ENDIF
178        ENDIF        ENDIF
179    
180    C     write(*,*) 'mon_vname = ''', mon_vname(1:nvname), ''''
181    C     write(*,*) 'mon_write_mnc = ''', mon_write_mnc, ''''
182    C     write(*,*) 'mon_write_stdout = ''', mon_write_stdout, ''''
183    
184        msgBuf(35:35) = '='        msgBuf(35:35) = '='
185    
186        WRITE(msgBuf(36:57),'(1X,1P1E21.13)') value        _BEGIN_MASTER(myThid)
187    #ifdef ALLOW_USE_MPI
188            IF ( .NOT. useSingleCPUIO .OR. mpiMyId .EQ. 0 ) THEN
189    #endif /* ALLOW_USE_MPI */
190    
191              IF (mon_write_stdout) THEN
192                IF (itype .EQ. 1)
193         &           WRITE(msgBuf(36:57),'(1X,I21)')       ival
194                IF (itype .EQ. 2)
195         &           WRITE(msgBuf(36:57),'(1X,1P1E21.13)') dval
196                CALL PRINT_MESSAGE(msgBuf, mon_ioUnit, SQUEEZE_RIGHT, 1)
197              ENDIF
198    
199    #ifdef ALLOW_MNC
200              IF (useMNC .AND. mon_write_mnc) THEN
201                CALL MNC_CW_APPEND_VNAME(
202         &           mon_vname, '-_-_--__-__t', 0,0, myThid)
203                IF (itype .EQ. 1)
204         &           CALL MNC_CW_I_W(
205         &           'I','monitor',1,1,mon_vname, ival, myThid)
206                IF (itype .EQ. 2)
207         &           CALL MNC_CW_RL_W(
208         &           'D','monitor',1,1,mon_vname, dval, myThid)
209              ENDIF
210    #endif /*  ALLOW_MNC  */
211    
212    #ifdef ALLOW_USE_MPI
213            ENDIF
214    #endif /* ALLOW_USE_MPI */
215          _END_MASTER()
216    
       CALL PRINT_MESSAGE( msgBuf, mon_ioUnit, SQUEEZE_RIGHT, 1 )  
217        RETURN        RETURN
218        END        END
219    
220    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22