/[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.4 by dimitri, Sat Jan 10 00:48:49 2004 UTC revision 1.10 by edhill, Fri Sep 10 12:19:31 2004 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "MONITOR_OPTIONS.h"  #include "MONITOR_OPTIONS.h"
5    
6        SUBROUTINE MON_OUT_I(pref, value, foot, myThid )  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 "PARAMS.h"  C     !INPUT PARAMETERS:
17  #include "EESUPPORT.h"  C     pref   - Field prefix ( ignored if == mon_string_none )
18  #include "MONITOR.h"  C     value  - Value to print
19        EXTERNAL IFNBLNK  C     foot   - Field suffix ( ignored if == mon_string_none )
       INTEGER  IFNBLNK  
       EXTERNAL ILNBLNK  
       INTEGER  ILNBLNK  
       INTEGER  myThid  
 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) = '='  
   
       _BEGIN_MASTER(myThid)  
 #ifdef ALLOW_USE_MPI  
        IF ( .NOT. useSingleCPUIO .OR. mpiMyId .EQ. 0 ) THEN  
 #endif /* ALLOW_USE_MPI */  
         WRITE(msgBuf(36:57),'(1X,I21)') value  
         CALL PRINT_MESSAGE( msgBuf, mon_ioUnit, SQUEEZE_RIGHT, 1 )  
 #ifdef ALLOW_USE_MPI  
        ENDIF  
 #endif /* ALLOW_USE_MPI */  
       _END_MASTER()  
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, myThid )  
 C.sh  /==========================================================\  
 C     | SUBROUTINE MON_OUT_RS                                    |  
 C     | o Formatted RS I/O for monitor print out.                |  
 C.    \==========================================================/  
       IMPLICIT NONE  
   
 C.gd  === Global data ===  
 #include "SIZE.h"  
 #include "EEPARAMS.h"  
 #include "PARAMS.h"  
 #include "EESUPPORT.h"  
 #include "MONITOR.h"  
       EXTERNAL IFNBLNK  
       INTEGER  IFNBLNK  
       EXTERNAL ILNBLNK  
       INTEGER  ILNBLNK  
       INTEGER  myThid  
 C.  
29    
30  C.ra  === Routine arguments ===  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
31  C.d   pref   - Field prefix ( ignored if == mon_string_none )  CBOP
32  C.d   value  - Value to print  C     !ROUTINE: MON_OUT_RS
33  C.d   foot   - Field suffix ( ignored if == mon_string_none )  
34    C     !INTERFACE:
35          SUBROUTINE MON_OUT_RS( pref, value, foot, myThid )
36    
37    C     !DESCRIPTION:
38    C     Formatted RS I/O for monitor print out.
39    
40    C     !INPUT PARAMETERS:
41    C     pref   - Field prefix ( ignored if == mon_string_none )
42    C     value  - Value to print
43    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.  
   
       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  
51    
52        IF ( mon_pref(1:mon_prefL) .NE. mon_string_none .AND.        CALL MON_OUT_ALL(pref, foot, 2, 0, dtmp, myThid)
53       &     lBuf+mon_prefL+1      .LE. MAX_LEN_MBUF ) THEN        RETURN
54         lBuf = lBuf+1        END
        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        _BEGIN_MASTER(myThid)  C     !DESCRIPTION:
93  #ifdef ALLOW_USE_MPI  C     Formatted I/O for monitor output.
        IF ( .NOT. useSingleCPUIO .OR. mpiMyId .EQ. 0 ) THEN  
 #endif /* ALLOW_USE_MPI */  
         WRITE(msgBuf(36:57),'(1X,1P1E21.13)') value  
         CALL PRINT_MESSAGE( msgBuf, mon_ioUnit, SQUEEZE_RIGHT, 1 )  
 #ifdef ALLOW_USE_MPI  
        ENDIF  
 #endif /* ALLOW_USE_MPI */  
       _END_MASTER()  
94    
95        RETURN  C     !USES:
       END  
       SUBROUTINE MON_OUT_RL(pref, value, foot, myThid )  
 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"  #include "PARAMS.h"
100    #ifdef ALLOW_MNC
101    #include "MNC_PARAMS.h"
102    #endif
103  #include "EESUPPORT.h"  #include "EESUPPORT.h"
104  #include "MONITOR.h"  #include "MONITOR.h"
105        EXTERNAL IFNBLNK        INTEGER IFNBLNK
106        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  
       INTEGER  myThid  
 C.  
107    
108  C.lv  === Local variables ===  C     !INPUT PARAMETERS:
109  C.d   msgBuf - Buffer for building output string  C     pref   - Field prefix ( ignored if == mon_string_none )
110  C.d   lBuf   - Buffer for length  C     foot   - Field suffix ( ignored if == mon_string_none )
111  C.d.  I0     - Temps used in calculating string length        CHARACTER*(*) pref, foot
112  C     I1        INTEGER itype
113  C.    IL        INTEGER ival
114          REAL*8  dval
115          INTEGER myThid
116    CEOP
117    
118    C     !LOCAL VARIABLES:
119    C     msgBuf - Buffer for building output string
120    C     lBuf   - Buffer for length
121    C     I0     - Temps used in calculating string length
122        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
123        INTEGER  lBuf        INTEGER  lBuf
124        INTEGER  I0, I1, IL        INTEGER  i, I0,I1, IL
125  C.        CHARACTER*(100) mon_vname
126          INTEGER  nvname
127    
128        msgBuf = ' '        msgBuf = ' '
129        lBuf   = 0        lBuf   = 0
130    
131          DO i = 1,100
132            mon_vname(i:i) = ' '
133          ENDDO
134    
135        I0 = IFNBLNK(mon_head)        I0 = IFNBLNK(mon_head)
136        I1 = ILNBLNK(mon_head)        I1 = ILNBLNK(mon_head)
137        IL = I1-I0+1        IL = I1-I0+1
138        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
139         msgBuf(1:IL) = mon_head          msgBuf(1:IL) = mon_head
140         lBuf = IL+1          lBuf = IL+1
141         msgBuf(lBuf:lBuf) = ' '          msgBuf(lBuf:lBuf) = ' '
142        ENDIF        ENDIF
143          
144        IF ( mon_pref(1:mon_prefL) .NE. mon_string_none .AND.        IF ( mon_pref(1:mon_prefL) .NE. mon_string_none .AND.
145       &     lBuf+mon_prefL+1      .LE. MAX_LEN_MBUF ) THEN       &     lBuf+mon_prefL+1      .LE. MAX_LEN_MBUF ) THEN
146         lBuf = lBuf+1          lBuf = lBuf+1
147         msgBuf(lBuf:lBuf+mon_prefL-1) = mon_pref(1:mon_prefL)          msgBuf(lBuf:lBuf+mon_prefL-1) = mon_pref(1:mon_prefL)
148         lBuf = lBuf+mon_prefL-1          lBuf = lBuf+mon_prefL-1
149            mon_vname(1:mon_prefL) = mon_pref(1:mon_prefL)
150            nvname = mon_prefL
151          ELSE
152            nvname = 0
153        ENDIF        ENDIF
154    
155        I0 = IFNBLNK(pref)        I0 = IFNBLNK(pref)
156        I1 = ILNBLNK(pref)        I1 = ILNBLNK(pref)
157        IL = I1-I0+1        IL = I1-I0+1
158        IF ( IL .GT. 0 ) THEN        IF ( IL .GT. 0 ) THEN
159         IF ( pref(I0:I1) .NE. mon_string_none .AND.          IF ( pref(I0:I1) .NE. mon_string_none .AND.
160       &      lBuf+IL+1   .LE. MAX_LEN_MBUF ) THEN       &       lBuf+IL+1   .LE. MAX_LEN_MBUF ) THEN
161          lBuf = lBuf+1            lBuf = lBuf+1
162          msgBuf(lBuf:lBuf+IL-1) = pref(I0:I1)            msgBuf(lBuf:lBuf+IL-1) = pref(I0:I1)
163          lBuf = lBuf+IL-1            lBuf = lBuf+IL-1
164         ENDIF            mon_vname((nvname+1):(nvname+IL)) = pref(I0:I1)
165              nvname = nvname + IL
166            ENDIF
167        ENDIF        ENDIF
168    
169        I0 = IFNBLNK(foot)        I0 = IFNBLNK(foot)
170        I1 = ILNBLNK(foot)        I1 = ILNBLNK(foot)
171        IL = I1-I0+1        IL = I1-I0+1
172        IF ( IL .GT. 0 ) THEN        IF ( IL .GT. 0 ) THEN
173         IF ( foot(I0:I1) .NE. mon_string_none .AND.          IF ( foot(I0:I1) .NE. mon_string_none .AND.
174       &      lBuf+IL+1   .LE. MAX_LEN_MBUF ) THEN       &       lBuf+IL+1   .LE. MAX_LEN_MBUF ) THEN
175          lBuf = lBuf+1            lBuf = lBuf+1
176          msgBuf(lBuf:lBuf+IL-1) = foot(I0:I1)            msgBuf(lBuf:lBuf+IL-1) = foot(I0:I1)
177          lBuf = lBuf+IL-1            lBuf = lBuf+IL-1
178         ENDIF            mon_vname((nvname+1):(nvname+IL)) = foot(I0:I1)
179              nvname = nvname + IL
180            ENDIF
181        ENDIF        ENDIF
182    
183    C     write(*,*) 'mon_vname = ''', mon_vname(1:nvname), ''''
184    C     write(*,*) 'mon_write_mnc = ''', mon_write_mnc, ''''
185    C     write(*,*) 'mon_write_stdout = ''', mon_write_stdout, ''''
186    
187        msgBuf(35:35) = '='        msgBuf(35:35) = '='
188    
189        _BEGIN_MASTER(myThid)        _BEGIN_MASTER(myThid)
190  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
191         IF ( .NOT. useSingleCPUIO .OR. mpiMyId .EQ. 0 ) THEN          IF ( .NOT. useSingleCPUIO .OR. mpiMyId .EQ. 0 ) THEN
192  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
193          WRITE(msgBuf(36:57),'(1X,1P1E21.13)') value  
194          CALL PRINT_MESSAGE( msgBuf, mon_ioUnit, SQUEEZE_RIGHT, 1 )            IF (mon_write_stdout) THEN
195                IF (itype .EQ. 1)
196         &           WRITE(msgBuf(36:57),'(1X,I21)')       ival
197                IF (itype .EQ. 2)
198         &           WRITE(msgBuf(36:57),'(1X,1P1E21.13)') dval
199                CALL PRINT_MESSAGE(msgBuf, mon_ioUnit, SQUEEZE_RIGHT, 1)
200              ENDIF
201    
202    #ifdef ALLOW_MNC
203              IF (useMNC .AND. mon_write_mnc) THEN
204                CALL MNC_CW_APPEND_VNAME(
205         &           mon_vname, '-_-_--__-__t', 0,0, myThid)
206                IF (itype .EQ. 1)
207         &           CALL MNC_CW_I_W(
208         &           'I','monitor',1,1,mon_vname, ival, myThid)
209                IF (itype .EQ. 2)
210         &           CALL MNC_CW_RL_W(
211         &           'D','monitor',1,1,mon_vname, dval, myThid)
212              ENDIF
213    #endif /*  ALLOW_MNC  */
214    
215  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
216         ENDIF          ENDIF
217  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
218        _END_MASTER()        _END_MASTER()
219    
220        RETURN        RETURN
221        END        END
222    
223    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22