/[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.9 by adcroft, Mon Jun 22 16:24:51 1998 UTC revision 1.15 by adcroft, Mon May 24 15:22:00 1999 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 34  C     |   ignored! Line 34  C     |   ignored!
34  C     | o In a non-parallel form these routines can still be used. |  C     | o In a non-parallel form these routines can still be used. |
35  C     |   to produce pretty printed output!                        |  C     |   to produce pretty printed output!                        |
36  C     \============================================================/  C     \============================================================/
37          IMPLICIT NONE
38  C     == Global data ==  C     == Global data ==
39  #include "SIZE.h"  #include "SIZE.h"
40  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 60  C--    Write single process format Line 61  C--    Write single process format
61         IF ( message .EQ. ' ' ) THEN         IF ( message .EQ. ' ' ) THEN
62          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' '          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' '
63         ELSE         ELSE
64          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, message(iStart:iEnd)          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER,
65         &   message(iStart:iEnd)
66         ENDIF         ENDIF
67        ELSEIF ( pidIO .EQ. myProcId ) THEN        ELSEIF ( pidIO .EQ. myProcId ) THEN
68  C--    Write multi-process format  C--    Write multi-process format
# Line 105  C Line 107  C
107        END        END
108    
109  CStartofinterface  CStartofinterface
110        SUBROUTINE PRINT_LIST_I( fld, lFld, index_type, markEnd, compact, ioUnit )        SUBROUTINE PRINT_LIST_I( fld, lFld, index_type,
111         &                         markEnd, compact, ioUnit )
112  C     /==========================================================\  C     /==========================================================\
113  C     | o SUBROUTINE PRINT_LIST_I                                |  C     | o SUBROUTINE PRINT_LIST_I                                |
114  C     |==========================================================|  C     |==========================================================|
# Line 114  C     | duplicate values collected into Line 117  C     | duplicate values collected into
117  C     |    n @ value                                             |  C     |    n @ value                                             |
118  C     | record.                                                  |  C     | record.                                                  |
119  C     \==========================================================/  C     \==========================================================/
120          IMPLICIT NONE
121    
122  C     == Global data ==    C     == Global data ==  
123  #include "SIZE.h"  #include "SIZE.h"
# Line 179  C     K    - Loop counter Line 183  C     K    - Loop counter
183         IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN
184          nDup = iHi-iLo+1          nDup = iHi-iLo+1
185          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
186           WRITE(msgBuf,'(A,I5,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
187           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
188       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
189         &    commOpen,index_lab,iLo,commClose
190          ELSE          ELSE
191           WRITE(msgBuf,'(I,'' '',A,I5,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
192           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
193       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
194       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
# Line 200  C     K    - Loop counter Line 205  C     K    - Loop counter
205        IF ( markEnd ) punc = ','        IF ( markEnd ) punc = ','
206        nDup = iHi-iLo+1        nDup = iHi-iLo+1
207        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
208         WRITE(msgBuf,'(A,I5,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
209         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
210       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
211         &  commOpen,index_lab,iLo,commClose
212        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
213         WRITE(msgBuf,'(I,'' '',A,I5,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
214         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
215       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
216       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
# Line 215  C     K    - Loop counter Line 221  C     K    - Loop counter
221        END        END
222    
223  CStartofinterface  CStartofinterface
224        SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, markEnd, compact, ioUnit )        SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, markEnd,
225         &                         compact, ioUnit )
226  C     /==========================================================\  C     /==========================================================\
227  C     | o SUBROUTINE PRINT_LIST_L                                |  C     | o SUBROUTINE PRINT_LIST_L                                |
228  C     |==========================================================|  C     |==========================================================|
# Line 224  C     | duplicate values collected into Line 231  C     | duplicate values collected into
231  C     |    n @ value                                             |  C     |    n @ value                                             |
232  C     | record.                                                  |  C     | record.                                                  |
233  C     \==========================================================/  C     \==========================================================/
234          IMPLICIT NONE
235    
236  C     == Global data ==    C     == Global data ==  
237  #include "SIZE.h"  #include "SIZE.h"
# Line 286  C     K    - Loop counter Line 294  C     K    - Loop counter
294        xOld = fld(1)        xOld = fld(1)
295        DO K=2,lFld        DO K=2,lFld
296         xNew = fld(K  )         xNew = fld(K  )
297         IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. xNew .NEQV. xOld ) THEN
298          nDup = iHi-iLo+1          nDup = iHi-iLo+1
299          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
300           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
301           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
302       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
303         &    commOpen,index_lab,iLo,commClose
304          ELSE          ELSE
305           WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
306           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
307       &    WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)')
308       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
# Line 312  C     K    - Loop counter Line 321  C     K    - Loop counter
321        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
322         WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
323         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
324       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
325         &    commOpen,index_lab,iLo,commClose
326        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
327         WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
328         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
329       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
330       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
# Line 325  C     K    - Loop counter Line 335  C     K    - Loop counter
335        END        END
336    
337  CStartofinterface  CStartofinterface
338        SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type, markEnd, compact, ioUnit )        SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type,
339         &    markEnd, compact, ioUnit )
340  C     /==========================================================\  C     /==========================================================\
341  C     | o SUBROUTINE PRINT_LIST_R8                               |  C     | o SUBROUTINE PRINT_LIST_R8                               |
342  C     |==========================================================|  C     |==========================================================|
# Line 334  C     | duplicate values collected into Line 345  C     | duplicate values collected into
345  C     |    n @ value                                             |  C     |    n @ value                                             |
346  C     | record.                                                  |  C     | record.                                                  |
347  C     \==========================================================/  C     \==========================================================/
348          IMPLICIT NONE
349    
350  C     == Global data ==    C     == Global data ==  
351  #include "SIZE.h"  #include "SIZE.h"
# Line 401  C     K    - Loop counter Line 413  C     K    - Loop counter
413          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
414           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
415           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
416       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
417         &    commOpen,index_lab,iLo,commClose
418          ELSE          ELSE
419           WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
420           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
421       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
422       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
423          ENDIF          ENDIF
424          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
425         &    SQUEEZE_RIGHT , 1)
426          iLo  = K          iLo  = K
427          iHi  = K          iHi  = K
428          xOld = xNew          xOld = xNew
# Line 422  C     K    - Loop counter Line 436  C     K    - Loop counter
436        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
437         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
438         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
439       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
440         &    commOpen,index_lab,iLo,commClose
441        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
442         WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
443         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
444       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
445       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
446        ENDIF        ENDIF
447        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
448         &    SQUEEZE_RIGHT , 1)
449    
450        RETURN        RETURN
451        END        END
# Line 463  C     |      plots - one for K=1, one fo Line 479  C     |      plots - one for K=1, one fo
479  C     |      Each plot would have extents iMin:iMax step iStr    |  C     |      Each plot would have extents iMin:iMax step iStr    |
480  C     |      and jMin:jMax step jStr.                            |  C     |      and jMin:jMax step jStr.                            |
481  C     \==========================================================/  C     \==========================================================/
482          IMPLICIT NONE
483    
484  C     == Global variables ==  C     == Global variables ==
485  #include "SIZE.h"  #include "SIZE.h"
# Line 532  C               Str  - stride within blo Line 549  C               Str  - stride within blo
549        INTEGER lChList        INTEGER lChList
550        PARAMETER ( lChList = 28 )        PARAMETER ( lChList = 28 )
551        CHARACTER*(lChList) chList        CHARACTER*(lChList) chList
552        REAL fMin        _RL  fMin
553        REAL fMax        _RL  fMax
554        REAL fRange        _RL  fRange
555        REAL val        _RL  val
556        REAL small        _RL  small
557        CHARACTER*2  accLab        CHARACTER*2  accLab
558        CHARACTER*7  dwnLab        CHARACTER*7  dwnLab
559        CHARACTER*3  pltLab        CHARACTER*3  pltLab
# Line 553  C               Str  - stride within blo Line 570  C               Str  - stride within blo
570        LOGICAL validRange        LOGICAL validRange
571    
572        chList = '-abcdefghijklmnopqrstuvwxyz+'        chList = '-abcdefghijklmnopqrstuvwxyz+'
573        small  = 1. _d -15        small  =  1. _d -15
574        fMin   =  1. _d 32        fMin   =  1. _d  32
575        fMax   = -1. _d 32        fMax   = -1. _d  32
576        validRange = .FALSE.        validRange = .FALSE.
577    
578  C--   Calculate field range  C--   Calculate field range
# Line 564  C--   Calculate field range Line 581  C--   Calculate field range
581          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
582           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
583            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
584             IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF (printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0.) THEN
585              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
586       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
587              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
# Line 581  C--   Calculate field range Line 598  C--   Calculate field range
598        ENDIF        ENDIF
599    
600  C--   Write field title and statistics  C--   Write field title and statistics
601        msgBuf = '// ======================================================='        msgBuf =
602         & '// ======================================================='
603        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
604       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
605        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 601  C--   Write field title and statistics Line 619  C--   Write field title and statistics
619       & '// CMAX = ', fMax       & '// CMAX = ', fMax
620        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
621       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
622        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
623       & '// CINT = ', fRange/FLOAT(lChlist-1)         WRITE(msgBuf,'(A,1PE30.15)')
624         &  '// CINT = ', fRange/FLOAT(lChlist-1)
625          ELSE
626           WRITE(msgBuf,'(A,1PE30.15)')
627         &  '// CINT = ', 0.
628          ENDIF
629        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
630       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
631        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 634  C--   Write field title and statistics Line 657  C--   Write field title and statistics
657       &  ':',kStr,')'       &  ':',kStr,')'
658        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
659       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
660        msgBuf = '// ======================================================='        msgBuf =
661         & '// ======================================================='
662        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
663       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
664    
# Line 730  C      X across, Z down slice Line 754  C      X across, Z down slice
754         pltStep = sNy         pltStep = sNy
755         pltLab  = 'J ='         pltLab  = 'J ='
756        ENDIF        ENDIF
757        IF ( validRange ) THEN  C     IF ( validRange ) THEN
758  C      Header  C      Header
759  C      Data  C      Data
760         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
761          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
762           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
763       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
764           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
765       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
# Line 792  C      Data Line 816  C      Data
816               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
817                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
818               ENDIF               ENDIF
819               IDX = NINT(               IF ( validRange .AND. val .NE. 0. ) THEN
820                  IDX = NINT(
821       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)
822       &             )+1       &             )+1
823                 ELSE
824                  IDX = 1
825                 ENDIF
826               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
827       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
828               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
# Line 810  C      Data Line 838  C      Data
838           ENDDO           ENDDO
839          ENDDO          ENDDO
840         ENDDO         ENDDO
841        ENDIF  C     ENDIF
842  C--   Write delimiter  C--   Write delimiter
843        msgBuf = '// ======================================================='        msgBuf =
844         & '// ======================================================='
845        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
846       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
847        msgBuf = '// END OF FIELD                                          ='        msgBuf =
848         & '// END OF FIELD                                          ='
849        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
850       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
851        msgBuf = '// ======================================================='        msgBuf =
852         & '// ======================================================='
853        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
854       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
855        msgBuf = ' '        msgBuf = ' '
# Line 857  C     |      plots - one for K=1, one fo Line 888  C     |      plots - one for K=1, one fo
888  C     |      Each plot would have extents iMin:iMax step iStr    |  C     |      Each plot would have extents iMin:iMax step iStr    |
889  C     |      and jMin:jMax step jStr.                            |  C     |      and jMin:jMax step jStr.                            |
890  C     \==========================================================/  C     \==========================================================/
891          IMPLICIT NONE
892    
893  C     == Global variables ==  C     == Global variables ==
894  #include "SIZE.h"  #include "SIZE.h"
# Line 926  C               Str  - stride within blo Line 958  C               Str  - stride within blo
958        INTEGER lChList        INTEGER lChList
959        PARAMETER ( lChList = 28 )        PARAMETER ( lChList = 28 )
960        CHARACTER*(lChList) chList        CHARACTER*(lChList) chList
961        REAL fMin        _RL  fMin
962        REAL fMax        _RL  fMax
963        REAL fRange        _RL  fRange
964        REAL val        _RL  val
965        REAL small        _RL  small
966        CHARACTER*2  accLab        CHARACTER*2  accLab
967        CHARACTER*7  dwnLab        CHARACTER*7  dwnLab
968        CHARACTER*3  pltLab        CHARACTER*3  pltLab
# Line 958  C--   Calculate field range Line 990  C--   Calculate field range
990          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
991           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
992            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
993  C          IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF ( printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0. )
994         &     THEN
995              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
996       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
997              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
998       &       fMax = fld(I,J,K,bi,bj)       &       fMax = fld(I,J,K,bi,bj)
999  C          ENDIF             ENDIF
1000            ENDDO            ENDDO
1001           ENDDO           ENDDO
1002          ENDDO          ENDDO
# Line 975  C          ENDIF Line 1008  C          ENDIF
1008        ENDIF        ENDIF
1009    
1010  C--   Write field title and statistics  C--   Write field title and statistics
1011        msgBuf = '// ======================================================='        msgBuf =
1012         & '// ======================================================='
1013        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1014       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1015        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 995  C--   Write field title and statistics Line 1029  C--   Write field title and statistics
1029       & '// CMAX = ', fMax       & '// CMAX = ', fMax
1030        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1031       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1032        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
1033           WRITE(msgBuf,'(A,1PE30.15)')
1034       & '// CINT = ', fRange/FLOAT(lChlist-1)       & '// CINT = ', fRange/FLOAT(lChlist-1)
1035          ELSE
1036           WRITE(msgBuf,'(A,1PE30.15)')
1037         & '// CINT = ', 0.
1038          ENDIF
1039        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1040       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1041        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 1028  C--   Write field title and statistics Line 1067  C--   Write field title and statistics
1067       &  ':',kStr,')'       &  ':',kStr,')'
1068        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1069       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1070        msgBuf = '// ======================================================='        msgBuf =
1071         & '// ======================================================='
1072        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1073       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1074    
# Line 1124  C      X across, Z down slice Line 1164  C      X across, Z down slice
1164         pltStep = sNy         pltStep = sNy
1165         pltLab  = 'J ='         pltLab  = 'J ='
1166        ENDIF        ENDIF
1167        IF ( validRange ) THEN  C     IF ( validRange ) THEN
1168  C      Header  C      Header
1169  C      Data  C      Data
1170         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
1171          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
1172           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
1173       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
1174           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1175       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
# Line 1184  C      Data Line 1224  C      Data
1224               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
1225                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
1226               ENDIF               ENDIF
1227               IDX = NINT(               IF ( validRange .AND. val .NE. 0. ) THEN
1228       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)                IDX = NINT(
1229       &             )+1       &               FLOAT( lChList-1 )*( val-fMin ) / (fRange)
1230         &              )+1
1231                 ELSE
1232                  IDX = 1
1233                 ENDIF
1234               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1235       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
1236               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
# Line 1201  C      Data Line 1245  C      Data
1245           ENDDO           ENDDO
1246          ENDDO          ENDDO
1247         ENDDO         ENDDO
1248        ENDIF  C     ENDIF
1249  C--   Write delimiter  C--   Write delimiter
1250        msgBuf = '// ======================================================='        msgBuf =
1251         & '// ======================================================='
1252        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1253       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1254        msgBuf = '// END OF FIELD                                          ='        msgBuf =
1255         & '// END OF FIELD                                          ='
1256        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1257       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1258        msgBuf = '// ======================================================='        msgBuf =
1259         & '// ======================================================='
1260        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1261       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1262        msgBuf = ' '        msgBuf = ' '
# Line 1226  C     | SUBROUTINE PRINT_MESSAGE Line 1273  C     | SUBROUTINE PRINT_MESSAGE
1273  C     | o Write out informational message using "standard" format. |  C     | o Write out informational message using "standard" format. |
1274  C     | Notes                                                      |  C     | Notes                                                      |
1275  C     | =====                                                      |  C     | =====                                                      |
1276  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  |
1277  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |
1278  C     |   critical region is defined around the write here. In some|  C     |   critical region is defined around the write here. In some|
1279  C     |   cases  BEGIN_CRIT() is approximated by only doing writes |  C     |   cases  BEGIN_CRIT() is approximated by only doing writes |
# Line 1235  C     |   ignored! Line 1282  C     |   ignored!
1282  C     | o In a non-parallel form these routines can still be used. |  C     | o In a non-parallel form these routines can still be used. |
1283  C     |   to produce pretty printed output!                        |  C     |   to produce pretty printed output!                        |
1284  C     \============================================================/  C     \============================================================/
1285          IMPLICIT NONE
1286  C     == Global data ==  C     == Global data ==
1287  #include "SIZE.h"  #include "SIZE.h"
1288  #include "EEPARAMS.h"  #include "EEPARAMS.h"
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22