/[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.6 by edhill, Sat Apr 3 21:17:10 2004 UTC revision 1.16 by edhill, Thu Jun 22 14:44:47 2006 UTC
# Line 23  C     foot   - Field suffix ( ignored if Line 23  C     foot   - Field suffix ( ignored if
23        INTEGER  myThid        INTEGER  myThid
24  CEOP  CEOP
25    
26        CALL MON_OUT_ALL(pref, foot, 1, value, 0.0, 0.0d0, myThid)        CALL MON_OUT_ALL(pref, foot, 1, value, 0.0d0, myThid)
27        RETURN        RETURN
28        END        END
29    
# Line 46  C     foot   - Field suffix ( ignored if Line 46  C     foot   - Field suffix ( ignored if
46        CHARACTER*(*) foot        CHARACTER*(*) foot
47        INTEGER  myThid        INTEGER  myThid
48  CEOP  CEOP
49          REAL*8 dtmp
50          dtmp = value
51    
52        CALL MON_OUT_ALL(pref, foot, 2, 0, value, 0.0d0, myThid)        CALL MON_OUT_ALL(pref, foot, 2, 0, dtmp, myThid)
53        RETURN        RETURN
54        END        END
55    
# Line 56  CBOP Line 58  CBOP
58  C     !ROUTINE: MON_OUT_RL  C     !ROUTINE: MON_OUT_RL
59    
60  C     !INTERFACE:  C     !INTERFACE:
61        SUBROUTINE MON_OUT_RL(pref, value, foot, myThid )        SUBROUTINE MON_OUT_RL( pref, value, foot, myThid )
62    
63  C     !DESCRIPTION:  C     !DESCRIPTION:
64  C     Formatted RL I/O for monitor print out.  C     Formatted RL I/O for monitor print out.
# Line 70  C     foot   - Field suffix ( ignored if Line 72  C     foot   - Field suffix ( ignored if
72        CHARACTER*(*) foot        CHARACTER*(*) foot
73        INTEGER  myThid        INTEGER  myThid
74  CEOP  CEOP
75          REAL*8 dtmp
76          dtmp = value
77    
78        CALL MON_OUT_ALL(pref, foot, 3, 0, 0.0, value, myThid)        CALL MON_OUT_ALL(pref, foot, 2, 0, dtmp, myThid)
79        RETURN        RETURN
80        END        END
81    
# Line 82  C     !ROUTINE: MON_OUT_ALL Line 86  C     !ROUTINE: MON_OUT_ALL
86  C     !INTERFACE:  C     !INTERFACE:
87        SUBROUTINE MON_OUT_ALL(        SUBROUTINE MON_OUT_ALL(
88       I     pref, foot,       I     pref, foot,
89       I     itype, ival, rval, dval,       I     itype, ival, dval,
90       I     myThid )       I     myThid )
91    
92  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 104  C     foot   - Field suffix ( ignored if Line 108  C     foot   - Field suffix ( ignored if
108        CHARACTER*(*) pref, foot        CHARACTER*(*) pref, foot
109        INTEGER itype        INTEGER itype
110        INTEGER ival        INTEGER ival
111        _RS     rval        REAL*8  dval
       _RL     dval  
112        INTEGER myThid        INTEGER myThid
113  CEOP  CEOP
114    
# Line 115  C     lBuf   - Buffer for length Line 118  C     lBuf   - Buffer for length
118  C     I0     - Temps used in calculating string length  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          CHARACTER*(100) mon_vname
123        msgBuf = ' '        INTEGER  nvname
124        lBuf   = 0        INTEGER  ivarr(1)
125          REAL*8   dvarr(1)
       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) = '='  
126    
127        _BEGIN_MASTER(myThid)        _BEGIN_MASTER(myThid)
128    
129  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
130          IF ( .NOT. useSingleCPUIO .OR. mpiMyId .EQ. 0 ) THEN        IF ( .NOT. useSingleCPUIO .OR. mpiMyId .EQ. 0 ) THEN
131  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
132    
133            ivarr(1) = ival
134            dvarr(1) = dval
135            
136            msgBuf = ' '
137            lBuf   = 0
138            
139            DO i = 1,100
140              mon_vname(i:i) = ' '
141            ENDDO
142            
143            I0 = IFNBLNK(mon_head)
144            I1 = ILNBLNK(mon_head)
145            IL = I1-I0+1
146            IF ( IL .GT. 0 .AND. lBuf+IL+1 .LE. MAX_LEN_MBUF ) THEN
147              msgBuf(1:IL) = mon_head
148              lBuf = IL+1
149              msgBuf(lBuf:lBuf) = ' '
150            ENDIF
151            
152            IF ( mon_pref(1:mon_prefL) .NE. mon_string_none .AND.
153         &       lBuf+mon_prefL+1      .LE. MAX_LEN_MBUF ) THEN
154              lBuf = lBuf+1
155              msgBuf(lBuf:lBuf+mon_prefL-1) = mon_pref(1:mon_prefL)
156              lBuf = lBuf+mon_prefL-1
157              mon_vname(1:mon_prefL) = mon_pref(1:mon_prefL)
158              nvname = mon_prefL
159            ELSE
160              nvname = 0
161            ENDIF
162            
163            I0 = IFNBLNK(pref)
164            I1 = ILNBLNK(pref)
165            IL = I1-I0+1
166            IF ( IL .GT. 0 ) THEN
167              IF ( pref(I0:I1) .NE. mon_string_none .AND.
168         &         lBuf+IL+1   .LE. MAX_LEN_MBUF ) THEN
169                lBuf = lBuf+1
170                msgBuf(lBuf:lBuf+IL-1) = pref(I0:I1)
171                lBuf = lBuf+IL-1
172                mon_vname((nvname+1):(nvname+IL)) = pref(I0:I1)
173                nvname = nvname + IL
174              ENDIF
175            ENDIF
176            
177            I0 = IFNBLNK(foot)
178            I1 = ILNBLNK(foot)
179            IL = I1-I0+1
180            IF ( IL .GT. 0 ) THEN
181              IF ( foot(I0:I1) .NE. mon_string_none .AND.
182         &         lBuf+IL+1   .LE. MAX_LEN_MBUF ) THEN
183                lBuf = lBuf+1
184                msgBuf(lBuf:lBuf+IL-1) = foot(I0:I1)
185                lBuf = lBuf+IL-1
186                mon_vname((nvname+1):(nvname+IL)) = foot(I0:I1)
187                nvname = nvname + IL
188              ENDIF
189            ENDIF
190    
191    C       write(*,*) 'mon_vname = ''', mon_vname(1:nvname), ''''
192    C       write(*,*) 'mon_write_mnc = ''', mon_write_mnc, ''''
193    C       write(*,*) 'mon_write_stdout = ''', mon_write_stdout, ''''
194            
195            msgBuf(35:35) = '='
196            
197            IF (mon_write_stdout) THEN
198            IF (itype .EQ. 1)            IF (itype .EQ. 1)
199       &         WRITE(msgBuf(36:57),'(1X,I21)')       ival       &         WRITE(msgBuf(36:57),'(1X,I21)')       ival
200            IF (itype .EQ. 2)            IF (itype .EQ. 2)
      &         WRITE(msgBuf(36:57),'(1X,1P1E21.13)') rval  
           IF (itype .EQ. 3)  
201       &         WRITE(msgBuf(36:57),'(1X,1P1E21.13)') dval       &         WRITE(msgBuf(36:57),'(1X,1P1E21.13)') dval
202            CALL PRINT_MESSAGE( msgBuf, mon_ioUnit, SQUEEZE_RIGHT, 1 )  C       &           WRITE(msgBuf(35:57),'(1X,1P1E22.13E3)') dval
203  #ifdef ALLOW_USE_MPI            
204    C         Note that the above call fixes problems where there is
205    C         insufficient space in the output format to handle variables
206    C         such as 1.234500000E107 which, although they are wildly large,
207    C         they may actually happen in some situations.  But, changing
208    C         the monitor output format also means changing the routines
209    C         that parse the monitor output for testreport.
210    
211              CALL PRINT_MESSAGE(msgBuf, mon_ioUnit, SQUEEZE_RIGHT, 1)
212          ENDIF          ENDIF
213            
214    #ifdef ALLOW_MNC
215            IF (useMNC .AND. mon_write_mnc) THEN
216              CALL MNC_CW_APPEND_VNAME(
217         &         mon_vname, '-_-_--__-__t', 0,0, myThid)
218              IF (itype .EQ. 1)
219         &         CALL MNC_CW_I_W(
220         &         'I',mon_fname,1,1,mon_vname, ivarr, myThid)
221              IF (itype .EQ. 2)
222         &         CALL MNC_CW_RL_W(
223         &         'D',mon_fname,1,1,mon_vname, dvarr, myThid)
224            ENDIF
225    #endif /*  ALLOW_MNC  */
226    
227    #ifdef ALLOW_USE_MPI
228          ENDIF
229  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
230        _END_MASTER()  
231          _END_MASTER(myThid)
232    
233        RETURN        RETURN
234        END        END
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.16
  ViewVC Help
Powered by ViewVC 1.1.22