pkg/monitor/mon_out.F

91672e10e3 Alis*0001 #include "MONITOR_OPTIONS.h"
1389d71047 Chri*0002
7633b97660 Ed H*0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP
                0005 C     !ROUTINE: MON_OUT_I
                0006
                0007 C     !INTERFACE:
2741539ec0 Ed H*0008       SUBROUTINE MON_OUT_I( pref, value, foot, myThid )
1389d71047 Chri*0009
7633b97660 Ed H*0010 C     !DESCRIPTION:
49aab2cab9 Jean*0011 C     Formatted integer I/O for monitor print out.
7633b97660 Ed H*0012
                0013 C     !INPUT PARAMETERS:
2741539ec0 Ed H*0014 C     pref   - Field prefix ( ignored if == mon_string_none )
                0015 C     value  - Value to print
                0016 C     foot   - Field suffix ( ignored if == mon_string_none )
1389d71047 Chri*0017       CHARACTER*(*) pref
                0018       INTEGER       value
                0019       CHARACTER*(*) foot
7633b97660 Ed H*0020       INTEGER  myThid
                0021 CEOP
1389d71047 Chri*0022
815d3bb6a3 Ed H*0023       CALL MON_OUT_ALL(pref, foot, 1, value, 0.0d0, myThid)
1389d71047 Chri*0024       RETURN
                0025       END
7633b97660 Ed H*0026
                0027 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
2741539ec0 Ed H*0028 CBOP
                0029 C     !ROUTINE: MON_OUT_RS
7633b97660 Ed H*0030
2741539ec0 Ed H*0031 C     !INTERFACE:
                0032       SUBROUTINE MON_OUT_RS( pref, value, foot, myThid )
1389d71047 Chri*0033
2741539ec0 Ed H*0034 C     !DESCRIPTION:
                0035 C     Formatted RS I/O for monitor print out.
1389d71047 Chri*0036
2741539ec0 Ed H*0037 C     !INPUT PARAMETERS:
                0038 C     pref   - Field prefix ( ignored if == mon_string_none )
                0039 C     value  - Value to print
                0040 C     foot   - Field suffix ( ignored if == mon_string_none )
1389d71047 Chri*0041       CHARACTER*(*) pref
                0042       _RS           value
                0043       CHARACTER*(*) foot
2741539ec0 Ed H*0044       INTEGER  myThid
                0045 CEOP
815d3bb6a3 Ed H*0046       REAL*8 dtmp
                0047       dtmp = value
1389d71047 Chri*0048
815d3bb6a3 Ed H*0049       CALL MON_OUT_ALL(pref, foot, 2, 0, dtmp, myThid)
2741539ec0 Ed H*0050       RETURN
                0051       END
1389d71047 Chri*0052
2741539ec0 Ed H*0053 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0054 CBOP
                0055 C     !ROUTINE: MON_OUT_RL
1389d71047 Chri*0056
2741539ec0 Ed H*0057 C     !INTERFACE:
815d3bb6a3 Ed H*0058       SUBROUTINE MON_OUT_RL( pref, value, foot, myThid )
1389d71047 Chri*0059
2741539ec0 Ed H*0060 C     !DESCRIPTION:
                0061 C     Formatted RL I/O for monitor print out.
1389d71047 Chri*0062
2741539ec0 Ed H*0063 C     !INPUT PARAMETERS:
                0064 C     pref   - Field prefix ( ignored if == mon_string_none )
                0065 C     value  - Value to print
                0066 C     foot   - Field suffix ( ignored if == mon_string_none )
                0067       CHARACTER*(*) pref
                0068       _RL           value
                0069       CHARACTER*(*) foot
                0070       INTEGER  myThid
                0071 CEOP
815d3bb6a3 Ed H*0072       REAL*8 dtmp
                0073       dtmp = value
1389d71047 Chri*0074
815d3bb6a3 Ed H*0075       CALL MON_OUT_ALL(pref, foot, 2, 0, dtmp, myThid)
2741539ec0 Ed H*0076       RETURN
                0077       END
1389d71047 Chri*0078
2741539ec0 Ed H*0079 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0080 CBOP 1
                0081 C     !ROUTINE: MON_OUT_ALL
1389d71047 Chri*0082
2741539ec0 Ed H*0083 C     !INTERFACE:
                0084       SUBROUTINE MON_OUT_ALL(
49aab2cab9 Jean*0085      I     pref, foot,
815d3bb6a3 Ed H*0086      I     itype, ival, dval,
2741539ec0 Ed H*0087      I     myThid )
67067d3ff1 Alis*0088
2741539ec0 Ed H*0089 C     !DESCRIPTION:
                0090 C     Formatted I/O for monitor output.
1389d71047 Chri*0091
2741539ec0 Ed H*0092 C     !USES:
                0093       IMPLICIT NONE
1389d71047 Chri*0094 #include "SIZE.h"
                0095 #include "EEPARAMS.h"
f02794c1c2 Dimi*0096 #include "PARAMS.h"
1389d71047 Chri*0097 #include "MONITOR.h"
                0098
2741539ec0 Ed H*0099 C     !INPUT PARAMETERS:
                0100 C     pref   - Field prefix ( ignored if == mon_string_none )
                0101 C     foot   - Field suffix ( ignored if == mon_string_none )
                0102       CHARACTER*(*) pref, foot
                0103       INTEGER itype
                0104       INTEGER ival
815d3bb6a3 Ed H*0105       REAL*8  dval
2741539ec0 Ed H*0106       INTEGER myThid
                0107 CEOP
1389d71047 Chri*0108
49aab2cab9 Jean*0109 C     === Functions ====
                0110       INTEGER IFNBLNK
                0111       INTEGER ILNBLNK
                0112       LOGICAL  MASTER_CPU_IO
                0113       EXTERNAL MASTER_CPU_IO
                0114
2741539ec0 Ed H*0115 C     !LOCAL VARIABLES:
                0116 C     msgBuf - Buffer for building output string
                0117 C     lBuf   - Buffer for length
                0118 C     I0     - Temps used in calculating string length
1389d71047 Chri*0119       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0120       INTEGER  lBuf
357126def9 Ed H*0121       INTEGER  i, I0,I1, IL
                0122       CHARACTER*(100) mon_vname
                0123       INTEGER  nvname
e0a17f1619 Ed H*0124       INTEGER  ivarr(1)
                0125       REAL*8   dvarr(1)
                0126
49aab2cab9 Jean*0127       IF ( MASTER_CPU_IO(myThid) ) THEN
1389d71047 Chri*0128
d53a42ca6b Ed H*0129         ivarr(1) = ival
                0130         dvarr(1) = dval
49aab2cab9 Jean*0131
d53a42ca6b Ed H*0132         msgBuf = ' '
                0133         lBuf   = 0
49aab2cab9 Jean*0134
d53a42ca6b Ed H*0135         DO i = 1,100
                0136           mon_vname(i:i) = ' '
                0137         ENDDO
49aab2cab9 Jean*0138
d53a42ca6b Ed H*0139         I0 = IFNBLNK(mon_head)
                0140         I1 = ILNBLNK(mon_head)
                0141         IL = I1-I0+1
                0142         IF ( IL .GT. 0 .AND. lBuf+IL+1 .LE. MAX_LEN_MBUF ) THEN
                0143           msgBuf(1:IL) = mon_head
                0144           lBuf = IL+1
                0145           msgBuf(lBuf:lBuf) = ' '
357126def9 Ed H*0146         ENDIF
49aab2cab9 Jean*0147
d53a42ca6b Ed H*0148         IF ( mon_pref(1:mon_prefL) .NE. mon_string_none .AND.
                0149      &       lBuf+mon_prefL+1      .LE. MAX_LEN_MBUF ) THEN
357126def9 Ed H*0150           lBuf = lBuf+1
d53a42ca6b Ed H*0151           msgBuf(lBuf:lBuf+mon_prefL-1) = mon_pref(1:mon_prefL)
                0152           lBuf = lBuf+mon_prefL-1
                0153           mon_vname(1:mon_prefL) = mon_pref(1:mon_prefL)
                0154           nvname = mon_prefL
                0155         ELSE
                0156           nvname = 0
357126def9 Ed H*0157         ENDIF
49aab2cab9 Jean*0158
d53a42ca6b Ed H*0159         I0 = IFNBLNK(pref)
                0160         I1 = ILNBLNK(pref)
                0161         IL = I1-I0+1
                0162         IF ( IL .GT. 0 ) THEN
49aab2cab9 Jean*0163           IF ( pref(I0:I1) .NE. mon_string_none .AND.
d53a42ca6b Ed H*0164      &         lBuf+IL+1   .LE. MAX_LEN_MBUF ) THEN
                0165             lBuf = lBuf+1
                0166             msgBuf(lBuf:lBuf+IL-1) = pref(I0:I1)
                0167             lBuf = lBuf+IL-1
                0168             mon_vname((nvname+1):(nvname+IL)) = pref(I0:I1)
                0169             nvname = nvname + IL
c815342335 Ed H*0170           ENDIF
d53a42ca6b Ed H*0171         ENDIF
49aab2cab9 Jean*0172
d53a42ca6b Ed H*0173         I0 = IFNBLNK(foot)
                0174         I1 = ILNBLNK(foot)
                0175         IL = I1-I0+1
                0176         IF ( IL .GT. 0 ) THEN
49aab2cab9 Jean*0177           IF ( foot(I0:I1) .NE. mon_string_none .AND.
d53a42ca6b Ed H*0178      &         lBuf+IL+1   .LE. MAX_LEN_MBUF ) THEN
                0179             lBuf = lBuf+1
                0180             msgBuf(lBuf:lBuf+IL-1) = foot(I0:I1)
                0181             lBuf = lBuf+IL-1
                0182             mon_vname((nvname+1):(nvname+IL)) = foot(I0:I1)
                0183             nvname = nvname + IL
                0184           ENDIF
                0185         ENDIF
357126def9 Ed H*0186
d53a42ca6b Ed H*0187 C       write(*,*) 'mon_vname = ''', mon_vname(1:nvname), ''''
                0188 C       write(*,*) 'mon_write_mnc = ''', mon_write_mnc, ''''
                0189 C       write(*,*) 'mon_write_stdout = ''', mon_write_stdout, ''''
49aab2cab9 Jean*0190
d53a42ca6b Ed H*0191         msgBuf(35:35) = '='
49aab2cab9 Jean*0192
d53a42ca6b Ed H*0193         IF (mon_write_stdout) THEN
                0194           IF (itype .EQ. 1)
                0195      &         WRITE(msgBuf(36:57),'(1X,I21)')       ival
                0196           IF (itype .EQ. 2)
                0197      &         WRITE(msgBuf(36:57),'(1X,1P1E21.13)') dval
                0198 C       &           WRITE(msgBuf(35:57),'(1X,1P1E22.13E3)') dval
49aab2cab9 Jean*0199
d53a42ca6b Ed H*0200 C         Note that the above call fixes problems where there is
                0201 C         insufficient space in the output format to handle variables
                0202 C         such as 1.234500000E107 which, although they are wildly large,
                0203 C         they may actually happen in some situations.  But, changing
                0204 C         the monitor output format also means changing the routines
                0205 C         that parse the monitor output for testreport.
                0206
                0207           CALL PRINT_MESSAGE(msgBuf, mon_ioUnit, SQUEEZE_RIGHT, 1)
                0208         ENDIF
49aab2cab9 Jean*0209
357126def9 Ed H*0210 #ifdef ALLOW_MNC
d53a42ca6b Ed H*0211         IF (useMNC .AND. mon_write_mnc) THEN
                0212           CALL MNC_CW_APPEND_VNAME(
                0213      &         mon_vname, '-_-_--__-__t', 0,0, myThid)
                0214           IF (itype .EQ. 1)
                0215      &         CALL MNC_CW_I_W(
                0216      &         'I',mon_fname,1,1,mon_vname, ivarr, myThid)
                0217           IF (itype .EQ. 2)
                0218      &         CALL MNC_CW_RL_W(
                0219      &         'D',mon_fname,1,1,mon_vname, dvarr, myThid)
                0220         ENDIF
357126def9 Ed H*0221 #endif /*  ALLOW_MNC  */
                0222
49aab2cab9 Jean*0223 C--   endif master cpu io
d53a42ca6b Ed H*0224       ENDIF
67067d3ff1 Alis*0225
1389d71047 Chri*0226       RETURN
                0227       END
2741539ec0 Ed H*0228
                0229 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|