/[MITgcm]/MITgcm/eesupp/src/print.F
ViewVC logotype

Diff of /MITgcm/eesupp/src/print.F

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

revision 1.5 by cnh, Mon Apr 27 04:24:22 1998 UTC revision 1.13 by cnh, Fri Nov 6 22:44:42 1998 UTC
# Line 25  C     | SUBROUTINE PRINT_ERROR Line 25  C     | SUBROUTINE PRINT_ERROR
25  C     | o Write out error message using "standard" format.         |  C     | o Write out error message using "standard" format.         |
26  C     | Notes                                                      |  C     | Notes                                                      |
27  C     | =====                                                      |  C     | =====                                                      |
28  C     | o Some system's I/O is not "thread-safe". For this reason  |  C     | o Some system   I/O is not "thread-safe". For this reason  |
29  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |
30  C     |   critical region is defined around the write here. In some|  C     |   critical region is defined around the write here. In some|
31  C     |   cases  BEGIN_CRIT() is approximated by only doing writes |  C     |   cases  BEGIN_CRIT() is approximated by only doing writes |
# Line 60  C--    Write single process format Line 60  C--    Write single process format
60         IF ( message .EQ. ' ' ) THEN         IF ( message .EQ. ' ' ) THEN
61          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' '          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' '
62         ELSE         ELSE
63          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, message(iStart:iEnd)          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER,
64         &   message(iStart:iEnd)
65         ENDIF         ENDIF
66        ELSEIF ( pidIO .EQ. myProcId ) THEN        ELSEIF ( pidIO .EQ. myProcId ) THEN
67  C--    Write multi-process format  C--    Write multi-process format
# Line 77  C       The write statement may need to Line 78  C       The write statement may need to
78  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
79          _BEGIN_CRIT(myThid)          _BEGIN_CRIT(myThid)
80  #endif  #endif
81          WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)')          WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)
82       &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',       &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',
83       &  ' '       &  ' '
84  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
# Line 87  C       The write statement may need to Line 88  C       The write statement may need to
88  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
89          _BEGIN_CRIT(myThid)          _BEGIN_CRIT(myThid)
90  #endif  #endif
91          WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)')          WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)
92       &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',       &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',
93       &  message(iStart:iEnd)       &  message(iStart:iEnd)
94  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
# Line 96  C       The write statement may need to Line 97  C       The write statement may need to
97         ENDIF         ENDIF
98        ENDIF        ENDIF
99  C  C
100     1000 CONTINUE
101        RETURN        RETURN
102    
103      999 CONTINUE
104           ioErrorCount(myThid) = ioErrorCount(myThid)+1
105          GOTO 1000
106        END        END
107    
108  CStartofinterface  CStartofinterface
109        SUBROUTINE PRINT_LIST_I( fld, lFld, index_type, ioUnit )        SUBROUTINE PRINT_LIST_I( fld, lFld, index_type,
110         &                         markEnd, compact, ioUnit )
111  C     /==========================================================\  C     /==========================================================\
112  C     | o SUBROUTINE PRINT_LIST_I                                |  C     | o SUBROUTINE PRINT_LIST_I                                |
113  C     |==========================================================|  C     |==========================================================|
# Line 122  C                  INDEX_K    => /* K = Line 129  C                  INDEX_K    => /* K =
129  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
130  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
131  C                  INDEX_NONE =>  C                  INDEX_NONE =>
132    C     compact -  Flag to control use of repeat symbol for same valued
133    C                fields.
134    C     markEnd -  Flag to control whether there is a separator after the
135    C                last element
136  C     ioUnit -  Unit number for IO.  C     ioUnit -  Unit number for IO.
137        INTEGER lFld        INTEGER lFld
138        INTEGER index_type        INTEGER index_type
139        INTEGER fld(lFld)        INTEGER fld(lFld)
140          LOGICAL markEnd
141          LOGICAL compact
142        INTEGER ioUnit        INTEGER ioUnit
143  CEndifinterface  CEndifinterface
144    
# Line 143  C     K    - Loop counter Line 156  C     K    - Loop counter
156        INTEGER nDup        INTEGER nDup
157        INTEGER xNew, xOld        INTEGER xNew, xOld
158        CHARACTER punc        CHARACTER punc
159        CHARACTER(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
160        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
161        CHARACTER*3 index_lab        CHARACTER*3 index_lab
162        INTEGER K        INTEGER K
# Line 165  C     K    - Loop counter Line 178  C     K    - Loop counter
178        xOld = fld(1)        xOld = fld(1)
179        DO K=2,lFld        DO K=2,lFld
180         xNew = fld(K  )         xNew = fld(K  )
181         IF ( xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN
182          nDup = iHi-iLo+1          nDup = iHi-iLo+1
183          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
184           WRITE(msgBuf,'(A,I5,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
185           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
186       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
187         &    commOpen,index_lab,iLo,commClose
188          ELSE          ELSE
189           WRITE(msgBuf,'(I,'' '',A,I5,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I,'' '',A,I9,A)') nDup,'@',xOld,punc
190           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
191       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
192       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
193          ENDIF          ENDIF
194          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
195          iLo  = K          iLo  = K
196          iHi  = K          iHi  = K
197          xOld = xNew          xOld = xNew
# Line 186  C     K    - Loop counter Line 200  C     K    - Loop counter
200         ENDIF         ENDIF
201        ENDDO        ENDDO
202        punc = ' '        punc = ' '
203          IF ( markEnd ) punc = ','
204        nDup = iHi-iLo+1        nDup = iHi-iLo+1
205        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
206         WRITE(msgBuf,'(A,I5,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
207         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
208       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
209         &  commOpen,index_lab,iLo,commClose
210        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
211         WRITE(msgBuf,'(I,'' '',A,I5,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I,'' '',A,I9,A)') nDup,'@',xOld,punc
212         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
213       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
214       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
215        ENDIF        ENDIF
216        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
217    
218        RETURN        RETURN
219        END        END
220    
221  CStartofinterface  CStartofinterface
222        SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, ioUnit )        SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, markEnd,
223         &                         compact, ioUnit )
224  C     /==========================================================\  C     /==========================================================\
225  C     | o SUBROUTINE PRINT_LIST_L                                |  C     | o SUBROUTINE PRINT_LIST_L                                |
226  C     |==========================================================|  C     |==========================================================|
# Line 225  C                  INDEX_K    => /* K = Line 242  C                  INDEX_K    => /* K =
242  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
243  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
244  C                  INDEX_NONE =>  C                  INDEX_NONE =>
245    C     compact -  Flag to control use of repeat symbol for same valued
246    C                fields.
247    C     markEnd -  Flag to control whether there is a separator after the
248    C                last element
249  C     ioUnit -  Unit number for IO.  C     ioUnit -  Unit number for IO.
250        INTEGER lFld        INTEGER lFld
251        INTEGER index_type        INTEGER index_type
252        LOGICAL fld(lFld)        LOGICAL fld(lFld)
253          LOGICAL markEnd
254          LOGICAL compact
255        INTEGER ioUnit        INTEGER ioUnit
256  CEndifinterface  CEndifinterface
257    
# Line 246  C     K    - Loop counter Line 269  C     K    - Loop counter
269        INTEGER nDup        INTEGER nDup
270        LOGICAL xNew, xOld        LOGICAL xNew, xOld
271        CHARACTER punc        CHARACTER punc
272        CHARACTER(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
273        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
274        CHARACTER*3 index_lab        CHARACTER*3 index_lab
275        INTEGER K        INTEGER K
# Line 268  C     K    - Loop counter Line 291  C     K    - Loop counter
291        xOld = fld(1)        xOld = fld(1)
292        DO K=2,lFld        DO K=2,lFld
293         xNew = fld(K  )         xNew = fld(K  )
294         IF ( xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. xNew .NEQV. xOld ) THEN
295          nDup = iHi-iLo+1          nDup = iHi-iLo+1
296          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
297           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
298           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
299       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
300         &    commOpen,index_lab,iLo,commClose
301          ELSE          ELSE
302           WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc
303           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
304       &    WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)')
305       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
306          ENDIF          ENDIF
307          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
308          iLo  = K          iLo  = K
309          iHi  = K          iHi  = K
310          xOld = xNew          xOld = xNew
# Line 289  C     K    - Loop counter Line 313  C     K    - Loop counter
313         ENDIF         ENDIF
314        ENDDO        ENDDO
315        punc = ' '        punc = ' '
316          IF ( markEnd ) punc = ','
317        nDup = iHi-iLo+1        nDup = iHi-iLo+1
318        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
319         WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
320         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
321       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
322         &    commOpen,index_lab,iLo,commClose
323        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
324         WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc
325         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
326       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
327       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
328        ENDIF        ENDIF
329        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
330    
331        RETURN        RETURN
332        END        END
333    
334  CStartofinterface  CStartofinterface
335        SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type, ioUnit )        SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type,
336         &    markEnd, compact, ioUnit )
337  C     /==========================================================\  C     /==========================================================\
338  C     | o SUBROUTINE PRINT_LIST_R8                               |  C     | o SUBROUTINE PRINT_LIST_R8                               |
339  C     |==========================================================|  C     |==========================================================|
# Line 328  C                  INDEX_K    => /* K = Line 355  C                  INDEX_K    => /* K =
355  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
356  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
357  C                  INDEX_NONE =>  C                  INDEX_NONE =>
358    C     compact -  Flag to control use of repeat symbol for same valued
359    C                fields.
360    C     markEnd -  Flag to control whether there is a separator after the
361    C                last element
362  C     ioUnit -  Unit number for IO.  C     ioUnit -  Unit number for IO.
363        INTEGER lFld        INTEGER lFld
364        INTEGER index_type        INTEGER index_type
365        Real*8  fld(lFld)        Real*8  fld(lFld)
366          LOGICAL markEnd
367          LOGICAL compact
368        INTEGER ioUnit        INTEGER ioUnit
369  CEndifinterface  CEndifinterface
370    
# Line 349  C     K    - Loop counter Line 382  C     K    - Loop counter
382        INTEGER nDup        INTEGER nDup
383        Real*8 xNew, xOld        Real*8 xNew, xOld
384        CHARACTER punc        CHARACTER punc
385        CHARACTER(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
386        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
387        CHARACTER*3 index_lab        CHARACTER*3 index_lab
388        INTEGER K        INTEGER K
# Line 371  C     K    - Loop counter Line 404  C     K    - Loop counter
404        xOld = fld(1)        xOld = fld(1)
405        DO K=2,lFld        DO K=2,lFld
406         xNew = fld(K  )         xNew = fld(K  )
407         IF ( xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN
408          nDup = iHi-iLo+1          nDup = iHi-iLo+1
409          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
410           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
411           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
412       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
413         &    commOpen,index_lab,iLo,commClose
414          ELSE          ELSE
415           WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
416           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
417       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
418       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
419          ENDIF          ENDIF
420          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
421         &    SQUEEZE_RIGHT , 1)
422          iLo  = K          iLo  = K
423          iHi  = K          iHi  = K
424          xOld = xNew          xOld = xNew
# Line 392  C     K    - Loop counter Line 427  C     K    - Loop counter
427         ENDIF         ENDIF
428        ENDDO        ENDDO
429        punc = ' '        punc = ' '
430          IF ( markEnd ) punc = ','
431        nDup = iHi-iLo+1        nDup = iHi-iLo+1
432        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
433         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
434         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
435       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
436         &    commOpen,index_lab,iLo,commClose
437        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
438         WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
439         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
440       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
441       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
442        ENDIF        ENDIF
443        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
444         &    SQUEEZE_RIGHT , 1)
445    
446        RETURN        RETURN
447        END        END
448    
449  CStartOfInterface  CStartOfInterface
450        SUBROUTINE PRINT_MAPR4 ( fld, fldTitle, plotMode,        SUBROUTINE PRINT_MAPRS ( fld, fldTitle, plotMode,
451       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
452       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
453       I       jMin,  jMax,  jStr,       I       jMin,  jMax,  jStr,
# Line 464  C     kStr Line 502  C     kStr
502        INTEGER jLo, jHi        INTEGER jLo, jHi
503        INTEGER kLo, kHi        INTEGER kLo, kHi
504        INTEGER nBx, nBy        INTEGER nBx, nBy
505        Real*4 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)        _RS fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
506        INTEGER iMin, iMax, iStr        INTEGER iMin, iMax, iStr
507        INTEGER jMin, jMax, jStr        INTEGER jMin, jMax, jStr
508        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
# Line 506  C               Str  - stride within blo Line 544  C               Str  - stride within blo
544        INTEGER lChList        INTEGER lChList
545        PARAMETER ( lChList = 28 )        PARAMETER ( lChList = 28 )
546        CHARACTER*(lChList) chList        CHARACTER*(lChList) chList
547        REAL fMin        _RL  fMin
548        REAL fMax        _RL  fMax
549        REAL fRange        _RL  fRange
550        REAL val        _RL  val
551        REAL small        _RL  small
552        CHARACTER*2  accLab        CHARACTER*2  accLab
553        CHARACTER*7  dwnLab        CHARACTER*7  dwnLab
554        CHARACTER*3  pltLab        CHARACTER*3  pltLab
# Line 527  C               Str  - stride within blo Line 565  C               Str  - stride within blo
565        LOGICAL validRange        LOGICAL validRange
566    
567        chList = '-abcdefghijklmnopqrstuvwxyz+'        chList = '-abcdefghijklmnopqrstuvwxyz+'
568        small  = 1. _d -15        small  =  1. _d -15
569        fMin   =  1. _d 32        fMin   =  1. _d  32
570        fMax   = -1. _d 32        fMax   = -1. _d  32
571        validRange = .FALSE.        validRange = .FALSE.
572    
573  C--   Calculate field range  C--   Calculate field range
# Line 538  C--   Calculate field range Line 576  C--   Calculate field range
576          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
577           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
578            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
579             IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF (printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0.) THEN
580              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
581       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
582              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
# Line 555  C--   Calculate field range Line 593  C--   Calculate field range
593        ENDIF        ENDIF
594    
595  C--   Write field title and statistics  C--   Write field title and statistics
596        msgBuf = '// ======================================================='        msgBuf =
597         & '// ======================================================='
598        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
599       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
600        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 575  C--   Write field title and statistics Line 614  C--   Write field title and statistics
614       & '// CMAX = ', fMax       & '// CMAX = ', fMax
615        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
616       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
617        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
618       & '// CINT = ', fRange/FLOAT(lChlist-1)         WRITE(msgBuf,'(A,1PE30.15)')
619         &  '// CINT = ', fRange/FLOAT(lChlist-1)
620          ELSE
621           WRITE(msgBuf,'(A,1PE30.15)')
622         &  '// CINT = ', 0.
623          ENDIF
624        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
625       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
626        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 608  C--   Write field title and statistics Line 652  C--   Write field title and statistics
652       &  ':',kStr,')'       &  ':',kStr,')'
653        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
654       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
655        msgBuf = '// ======================================================='        msgBuf =
656         & '// ======================================================='
657        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
658       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
659    
# Line 704  C      X across, Z down slice Line 749  C      X across, Z down slice
749         pltStep = sNy         pltStep = sNy
750         pltLab  = 'J ='         pltLab  = 'J ='
751        ENDIF        ENDIF
752        IF ( validRange ) THEN  C     IF ( validRange ) THEN
753  C      Header  C      Header
754  C      Data  C      Data
755         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
756          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
757           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
758       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
759           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
760       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
# Line 766  C      Data Line 811  C      Data
811               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
812                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
813               ENDIF               ENDIF
814               IDX = NINT(               IF ( validRange .AND. val .NE. 0. ) THEN
815                  IDX = NINT(
816       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)
817       &             )+1       &             )+1
818                 ELSE
819                  IDX = 1
820                 ENDIF
821               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
822       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
823               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
# Line 784  C      Data Line 833  C      Data
833           ENDDO           ENDDO
834          ENDDO          ENDDO
835         ENDDO         ENDDO
836        ENDIF  C     ENDIF
837  C--   Write delimiter  C--   Write delimiter
838        msgBuf = '// ======================================================='        msgBuf =
839         & '// ======================================================='
840        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
841       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
842        msgBuf = '// END OF FIELD                                          ='        msgBuf =
843         & '// END OF FIELD                                          ='
844        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
845       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
846        msgBuf = '// ======================================================='        msgBuf =
847         & '// ======================================================='
848        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
849       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
850        msgBuf = ' '        msgBuf = ' '
# Line 803  C--   Write delimiter Line 855  C--   Write delimiter
855        END        END
856    
857  CStartOfInterface  CStartOfInterface
858        SUBROUTINE PRINT_MAPR8 ( fld, fldTitle, plotMode,        SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode,
859       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
860       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
861       I       jMin,  jMax,  jStr,       I       jMin,  jMax,  jStr,
# Line 811  CStartOfInterface Line 863  CStartOfInterface
863       I      bxMin, bxMax,  bxStr,       I      bxMin, bxMax,  bxStr,
864       I      byMin, byMax,  byStr )       I      byMin, byMax,  byStr )
865  C     /==========================================================\  C     /==========================================================\
866  C     | SUBROUTINE PRINT_MAPR8                                   |  C     | SUBROUTINE PRINT_MAPRL                                   |
867  C     | o Does textual mapping printing of a field.              |  C     | o Does textual mapping printing of a field.              |
868  C     |==========================================================|  C     |==========================================================|
869  C     | This routine does the actual formatting of the data      |  C     | This routine does the actual formatting of the data      |
# Line 858  C     kStr Line 910  C     kStr
910        INTEGER jLo, jHi        INTEGER jLo, jHi
911        INTEGER kLo, kHi        INTEGER kLo, kHi
912        INTEGER nBx, nBy        INTEGER nBx, nBy
913        Real*8 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)        _RL fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
914        INTEGER iMin, iMax, iStr        INTEGER iMin, iMax, iStr
915        INTEGER jMin, jMax, jStr        INTEGER jMin, jMax, jStr
916        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
# Line 900  C               Str  - stride within blo Line 952  C               Str  - stride within blo
952        INTEGER lChList        INTEGER lChList
953        PARAMETER ( lChList = 28 )        PARAMETER ( lChList = 28 )
954        CHARACTER*(lChList) chList        CHARACTER*(lChList) chList
955        REAL fMin        _RL  fMin
956        REAL fMax        _RL  fMax
957        REAL fRange        _RL  fRange
958        REAL val        _RL  val
959        REAL small        _RL  small
960        CHARACTER*2  accLab        CHARACTER*2  accLab
961        CHARACTER*7  dwnLab        CHARACTER*7  dwnLab
962        CHARACTER*3  pltLab        CHARACTER*3  pltLab
# Line 932  C--   Calculate field range Line 984  C--   Calculate field range
984          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
985           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
986            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
987  C          IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF ( printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0. )
988         &     THEN
989              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
990       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
991              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
992       &       fMax = fld(I,J,K,bi,bj)       &       fMax = fld(I,J,K,bi,bj)
993  C          ENDIF             ENDIF
994            ENDDO            ENDDO
995           ENDDO           ENDDO
996          ENDDO          ENDDO
# Line 949  C          ENDIF Line 1002  C          ENDIF
1002        ENDIF        ENDIF
1003    
1004  C--   Write field title and statistics  C--   Write field title and statistics
1005        msgBuf = '// ======================================================='        msgBuf =
1006         & '// ======================================================='
1007        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1008       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1009        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 969  C--   Write field title and statistics Line 1023  C--   Write field title and statistics
1023       & '// CMAX = ', fMax       & '// CMAX = ', fMax
1024        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1025       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1026        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
1027           WRITE(msgBuf,'(A,1PE30.15)')
1028       & '// CINT = ', fRange/FLOAT(lChlist-1)       & '// CINT = ', fRange/FLOAT(lChlist-1)
1029          ELSE
1030           WRITE(msgBuf,'(A,1PE30.15)')
1031         & '// CINT = ', 0.
1032          ENDIF
1033        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1034       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1035        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 1002  C--   Write field title and statistics Line 1061  C--   Write field title and statistics
1061       &  ':',kStr,')'       &  ':',kStr,')'
1062        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1063       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1064        msgBuf = '// ======================================================='        msgBuf =
1065         & '// ======================================================='
1066        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1067       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1068    
# Line 1098  C      X across, Z down slice Line 1158  C      X across, Z down slice
1158         pltStep = sNy         pltStep = sNy
1159         pltLab  = 'J ='         pltLab  = 'J ='
1160        ENDIF        ENDIF
1161        IF ( validRange ) THEN  C     IF ( validRange ) THEN
1162  C      Header  C      Header
1163  C      Data  C      Data
1164         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
1165          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
1166           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
1167       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
1168           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1169       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
# Line 1158  C      Data Line 1218  C      Data
1218               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
1219                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
1220               ENDIF               ENDIF
1221               IDX = NINT(               IF ( validRange .AND. val .NE. 0. ) THEN
1222       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)                IDX = NINT(
1223       &             )+1       &               FLOAT( lChList-1 )*( val-fMin ) / (fRange)
1224         &              )+1
1225                 ELSE
1226                  IDX = 1
1227                 ENDIF
1228               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1229       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
1230               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
# Line 1175  C      Data Line 1239  C      Data
1239           ENDDO           ENDDO
1240          ENDDO          ENDDO
1241         ENDDO         ENDDO
1242        ENDIF  C     ENDIF
1243  C--   Write delimiter  C--   Write delimiter
1244        msgBuf = '// ======================================================='        msgBuf =
1245         & '// ======================================================='
1246        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1247       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1248        msgBuf = '// END OF FIELD                                          ='        msgBuf =
1249         & '// END OF FIELD                                          ='
1250        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1251       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1252        msgBuf = '// ======================================================='        msgBuf =
1253         & '// ======================================================='
1254        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1255       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1256        msgBuf = ' '        msgBuf = ' '
# Line 1200  C     | SUBROUTINE PRINT_MESSAGE Line 1267  C     | SUBROUTINE PRINT_MESSAGE
1267  C     | o Write out informational message using "standard" format. |  C     | o Write out informational message using "standard" format. |
1268  C     | Notes                                                      |  C     | Notes                                                      |
1269  C     | =====                                                      |  C     | =====                                                      |
1270  C     | o Some system's I/O is not "thread-safe". For this reason  |  C     | o Some system   I/O is not "thread-safe". For this reason  |
1271  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |
1272  C     |   critical region is defined around the write here. In some|  C     |   critical region is defined around the write here. In some|
1273  C     |   cases  BEGIN_CRIT() is approximated by only doing writes |  C     |   cases  BEGIN_CRIT() is approximated by only doing writes |
# Line 1267  C       The write statement may need to Line 1334  C       The write statement may need to
1334  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
1335          _BEGIN_CRIT(myThid)          _BEGIN_CRIT(myThid)
1336  #endif  #endif
1337           WRITE(unit,'(A,A,A,A,A,A)')           WRITE(unit,'(A,A,A,A,A,A)',ERR=999)
1338       &   '(',PROCESS_HEADER,' ',idString,')',' '       &   '(',PROCESS_HEADER,' ',idString,')',' '
1339  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
1340          _END_CRIT(myThid)          _END_CRIT(myThid)
# Line 1276  C       The write statement may need to Line 1343  C       The write statement may need to
1343  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
1344          _BEGIN_CRIT(myThid)          _BEGIN_CRIT(myThid)
1345  #endif  #endif
1346           WRITE(unit,'(A,A,A,A,A,A,A)')           WRITE(unit,'(A,A,A,A,A,A,A)',ERR=999)
1347       &   '(',PROCESS_HEADER,' ',idString(1:ILNBLNK(idString)),')',' ',       &   '(',PROCESS_HEADER,' ',idString(1:ILNBLNK(idString)),')',' ',
1348       &   message(iStart:iEnd)       &   message(iStart:iEnd)
1349  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
# Line 1285  C       The write statement may need to Line 1352  C       The write statement may need to
1352         ENDIF         ENDIF
1353        ENDIF        ENDIF
1354  C  C
1355     1000 CONTINUE
1356        RETURN        RETURN
1357      999 CONTINUE
1358           ioErrorCount(myThid) = ioErrorCount(myThid)+1
1359          GOTO 1000
1360    
1361        END        END

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.13

  ViewVC Help
Powered by ViewVC 1.1.22