/[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.7 by cnh, Mon Jun 8 21:43:00 1998 UTC revision 1.17 by cnh, Sun Feb 4 14:38:44 2001 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "CPP_EEOPTIONS.h"  #include "CPP_EEOPTIONS.h"
5    
# Line 25  C     | SUBROUTINE PRINT_ERROR Line 26  C     | SUBROUTINE PRINT_ERROR
26  C     | o Write out error message using "standard" format.         |  C     | o Write out error message using "standard" format.         |
27  C     | Notes                                                      |  C     | Notes                                                      |
28  C     | =====                                                      |  C     | =====                                                      |
29  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  |
30  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |
31  C     |   critical region is defined around the write here. In some|  C     |   critical region is defined around the write here. In some|
32  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 35  C     |   ignored!
35  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. |
36  C     |   to produce pretty printed output!                        |  C     |   to produce pretty printed output!                        |
37  C     \============================================================/  C     \============================================================/
38          IMPLICIT NONE
39  C     == Global data ==  C     == Global data ==
40  #include "SIZE.h"  #include "SIZE.h"
41  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 60  C--    Write single process format Line 62  C--    Write single process format
62         IF ( message .EQ. ' ' ) THEN         IF ( message .EQ. ' ' ) THEN
63          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' '          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' '
64         ELSE         ELSE
65          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, message(iStart:iEnd)          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER,
66         &   message(iStart:iEnd)
67         ENDIF         ENDIF
68        ELSEIF ( pidIO .EQ. myProcId ) THEN        ELSEIF ( pidIO .EQ. myProcId ) THEN
69  C--    Write multi-process format  C--    Write multi-process format
# Line 105  C Line 108  C
108        END        END
109    
110  CStartofinterface  CStartofinterface
111        SUBROUTINE PRINT_LIST_I( fld, lFld, index_type, ioUnit )        SUBROUTINE PRINT_LIST_I( fld, lFld, index_type,
112         &                         markEnd, compact, ioUnit )
113  C     /==========================================================\  C     /==========================================================\
114  C     | o SUBROUTINE PRINT_LIST_I                                |  C     | o SUBROUTINE PRINT_LIST_I                                |
115  C     |==========================================================|  C     |==========================================================|
# Line 114  C     | duplicate values collected into Line 118  C     | duplicate values collected into
118  C     |    n @ value                                             |  C     |    n @ value                                             |
119  C     | record.                                                  |  C     | record.                                                  |
120  C     \==========================================================/  C     \==========================================================/
121          IMPLICIT NONE
122    
123  C     == Global data ==    C     == Global data ==  
124  #include "SIZE.h"  #include "SIZE.h"
# Line 127  C                  INDEX_K    => /* K = Line 132  C                  INDEX_K    => /* K =
132  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
133  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
134  C                  INDEX_NONE =>  C                  INDEX_NONE =>
135    C     compact -  Flag to control use of repeat symbol for same valued
136    C                fields.
137    C     markEnd -  Flag to control whether there is a separator after the
138    C                last element
139  C     ioUnit -  Unit number for IO.  C     ioUnit -  Unit number for IO.
140        INTEGER lFld        INTEGER lFld
141        INTEGER index_type        INTEGER index_type
142        INTEGER fld(lFld)        INTEGER fld(lFld)
143          LOGICAL markEnd
144          LOGICAL compact
145        INTEGER ioUnit        INTEGER ioUnit
146  CEndifinterface  CEndifinterface
147    
# Line 170  C     K    - Loop counter Line 181  C     K    - Loop counter
181        xOld = fld(1)        xOld = fld(1)
182        DO K=2,lFld        DO K=2,lFld
183         xNew = fld(K  )         xNew = fld(K  )
184         IF ( xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
185          nDup = iHi-iLo+1          nDup = iHi-iLo+1
186          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
187           WRITE(msgBuf,'(A,I5,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
188           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
189       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
190         &    commOpen,index_lab,iLo,commClose
191          ELSE          ELSE
192           WRITE(msgBuf,'(I,'' '',A,I5,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
193           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
194       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
195       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
# Line 191  C     K    - Loop counter Line 203  C     K    - Loop counter
203         ENDIF         ENDIF
204        ENDDO        ENDDO
205        punc = ' '        punc = ' '
206          IF ( markEnd ) punc = ','
207        nDup = iHi-iLo+1        nDup = iHi-iLo+1
208        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
209         WRITE(msgBuf,'(A,I5,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
210         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
211       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
212         &  commOpen,index_lab,iLo,commClose
213        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
214         WRITE(msgBuf,'(I,'' '',A,I5,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
215         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
216       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
217       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
# Line 208  C     K    - Loop counter Line 222  C     K    - Loop counter
222        END        END
223    
224  CStartofinterface  CStartofinterface
225        SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, ioUnit )        SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, markEnd,
226         &                         compact, ioUnit )
227  C     /==========================================================\  C     /==========================================================\
228  C     | o SUBROUTINE PRINT_LIST_L                                |  C     | o SUBROUTINE PRINT_LIST_L                                |
229  C     |==========================================================|  C     |==========================================================|
# Line 217  C     | duplicate values collected into Line 232  C     | duplicate values collected into
232  C     |    n @ value                                             |  C     |    n @ value                                             |
233  C     | record.                                                  |  C     | record.                                                  |
234  C     \==========================================================/  C     \==========================================================/
235          IMPLICIT NONE
236    
237  C     == Global data ==    C     == Global data ==  
238  #include "SIZE.h"  #include "SIZE.h"
# Line 230  C                  INDEX_K    => /* K = Line 246  C                  INDEX_K    => /* K =
246  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
247  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
248  C                  INDEX_NONE =>  C                  INDEX_NONE =>
249    C     compact -  Flag to control use of repeat symbol for same valued
250    C                fields.
251    C     markEnd -  Flag to control whether there is a separator after the
252    C                last element
253  C     ioUnit -  Unit number for IO.  C     ioUnit -  Unit number for IO.
254        INTEGER lFld        INTEGER lFld
255        INTEGER index_type        INTEGER index_type
256        LOGICAL fld(lFld)        LOGICAL fld(lFld)
257          LOGICAL markEnd
258          LOGICAL compact
259        INTEGER ioUnit        INTEGER ioUnit
260  CEndifinterface  CEndifinterface
261    
# Line 273  C     K    - Loop counter Line 295  C     K    - Loop counter
295        xOld = fld(1)        xOld = fld(1)
296        DO K=2,lFld        DO K=2,lFld
297         xNew = fld(K  )         xNew = fld(K  )
298         IF ( xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. (xNew .NEQV. xOld) ) THEN
299          nDup = iHi-iLo+1          nDup = iHi-iLo+1
300          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
301           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
302           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
303       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
304         &    commOpen,index_lab,iLo,commClose
305          ELSE          ELSE
306           WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
307           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
308       &    WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)')
309       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
# Line 294  C     K    - Loop counter Line 317  C     K    - Loop counter
317         ENDIF         ENDIF
318        ENDDO        ENDDO
319        punc = ' '        punc = ' '
320          IF ( markEnd ) punc = ','
321        nDup = iHi-iLo+1        nDup = iHi-iLo+1
322        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
323         WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
324         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
325       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
326         &    commOpen,index_lab,iLo,commClose
327        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
328         WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
329         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
330       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
331       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
# Line 311  C     K    - Loop counter Line 336  C     K    - Loop counter
336        END        END
337    
338  CStartofinterface  CStartofinterface
339        SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type, ioUnit )        SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type,
340         &    markEnd, compact, ioUnit )
341  C     /==========================================================\  C     /==========================================================\
342  C     | o SUBROUTINE PRINT_LIST_R8                               |  C     | o SUBROUTINE PRINT_LIST_R8                               |
343  C     |==========================================================|  C     |==========================================================|
# Line 320  C     | duplicate values collected into Line 346  C     | duplicate values collected into
346  C     |    n @ value                                             |  C     |    n @ value                                             |
347  C     | record.                                                  |  C     | record.                                                  |
348  C     \==========================================================/  C     \==========================================================/
349          IMPLICIT NONE
350    
351  C     == Global data ==    C     == Global data ==  
352  #include "SIZE.h"  #include "SIZE.h"
# Line 333  C                  INDEX_K    => /* K = Line 360  C                  INDEX_K    => /* K =
360  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
361  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
362  C                  INDEX_NONE =>  C                  INDEX_NONE =>
363    C     compact -  Flag to control use of repeat symbol for same valued
364    C                fields.
365    C     markEnd -  Flag to control whether there is a separator after the
366    C                last element
367  C     ioUnit -  Unit number for IO.  C     ioUnit -  Unit number for IO.
368        INTEGER lFld        INTEGER lFld
369        INTEGER index_type        INTEGER index_type
370        Real*8  fld(lFld)        Real*8  fld(lFld)
371          LOGICAL markEnd
372          LOGICAL compact
373        INTEGER ioUnit        INTEGER ioUnit
374  CEndifinterface  CEndifinterface
375    
# Line 376  C     K    - Loop counter Line 409  C     K    - Loop counter
409        xOld = fld(1)        xOld = fld(1)
410        DO K=2,lFld        DO K=2,lFld
411         xNew = fld(K  )         xNew = fld(K  )
412         IF ( xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
413          nDup = iHi-iLo+1          nDup = iHi-iLo+1
414          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
415           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
416           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
417       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
418         &    commOpen,index_lab,iLo,commClose
419          ELSE          ELSE
420           WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
421           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
422       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
423       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
424          ENDIF          ENDIF
425          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
426         &    SQUEEZE_RIGHT , 1)
427          iLo  = K          iLo  = K
428          iHi  = K          iHi  = K
429          xOld = xNew          xOld = xNew
# Line 397  C     K    - Loop counter Line 432  C     K    - Loop counter
432         ENDIF         ENDIF
433        ENDDO        ENDDO
434        punc = ' '        punc = ' '
435          IF ( markEnd ) punc = ','
436        nDup = iHi-iLo+1        nDup = iHi-iLo+1
437        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
438         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
439         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
440       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
441         &    commOpen,index_lab,iLo,commClose
442        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
443         WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
444         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
445       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
446       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
447        ENDIF        ENDIF
448        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
449         &    SQUEEZE_RIGHT , 1)
450    
451        RETURN        RETURN
452        END        END
453    
454  CStartOfInterface  CStartOfInterface
455        SUBROUTINE PRINT_MAPR4 ( fld, fldTitle, plotMode,        SUBROUTINE PRINT_MAPRS ( fld, fldTitle, plotMode,
456       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
457       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
458       I       jMin,  jMax,  jStr,       I       jMin,  jMax,  jStr,
# Line 442  C     |      plots - one for K=1, one fo Line 480  C     |      plots - one for K=1, one fo
480  C     |      Each plot would have extents iMin:iMax step iStr    |  C     |      Each plot would have extents iMin:iMax step iStr    |
481  C     |      and jMin:jMax step jStr.                            |  C     |      and jMin:jMax step jStr.                            |
482  C     \==========================================================/  C     \==========================================================/
483          IMPLICIT NONE
484    
485  C     == Global variables ==  C     == Global variables ==
486  #include "SIZE.h"  #include "SIZE.h"
# Line 469  C     kStr Line 508  C     kStr
508        INTEGER jLo, jHi        INTEGER jLo, jHi
509        INTEGER kLo, kHi        INTEGER kLo, kHi
510        INTEGER nBx, nBy        INTEGER nBx, nBy
511        Real*4 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)        _RS fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
512        INTEGER iMin, iMax, iStr        INTEGER iMin, iMax, iStr
513        INTEGER jMin, jMax, jStr        INTEGER jMin, jMax, jStr
514        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
# Line 511  C               Str  - stride within blo Line 550  C               Str  - stride within blo
550        INTEGER lChList        INTEGER lChList
551        PARAMETER ( lChList = 28 )        PARAMETER ( lChList = 28 )
552        CHARACTER*(lChList) chList        CHARACTER*(lChList) chList
553        REAL fMin        _RL  fMin
554        REAL fMax        _RL  fMax
555        REAL fRange        _RL  fRange
556        REAL val        _RL  val
557        REAL small        _RL  small
558        CHARACTER*2  accLab        CHARACTER*2  accLab
559        CHARACTER*7  dwnLab        CHARACTER*7  dwnLab
560        CHARACTER*3  pltLab        CHARACTER*3  pltLab
# Line 532  C               Str  - stride within blo Line 571  C               Str  - stride within blo
571        LOGICAL validRange        LOGICAL validRange
572    
573        chList = '-abcdefghijklmnopqrstuvwxyz+'        chList = '-abcdefghijklmnopqrstuvwxyz+'
574        small  = 1. _d -15        small  =  1. _d -15
575        fMin   =  1. _d 32        fMin   =  1. _d  32
576        fMax   = -1. _d 32        fMax   = -1. _d  32
577        validRange = .FALSE.        validRange = .FALSE.
578    
579  C--   Calculate field range  C--   Calculate field range
# Line 543  C--   Calculate field range Line 582  C--   Calculate field range
582          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
583           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
584            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
585             IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF (printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0.) THEN
586              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
587       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
588              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
# Line 560  C--   Calculate field range Line 599  C--   Calculate field range
599        ENDIF        ENDIF
600    
601  C--   Write field title and statistics  C--   Write field title and statistics
602        msgBuf = '// ======================================================='        msgBuf =
603         & '// ======================================================='
604        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
605       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
606        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 580  C--   Write field title and statistics Line 620  C--   Write field title and statistics
620       & '// CMAX = ', fMax       & '// CMAX = ', fMax
621        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
622       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
623        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
624       & '// CINT = ', fRange/FLOAT(lChlist-1)         WRITE(msgBuf,'(A,1PE30.15)')
625         &  '// CINT = ', fRange/FLOAT(lChlist-1)
626          ELSE
627           WRITE(msgBuf,'(A,1PE30.15)')
628         &  '// CINT = ', 0.
629          ENDIF
630        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
631       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
632        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 613  C--   Write field title and statistics Line 658  C--   Write field title and statistics
658       &  ':',kStr,')'       &  ':',kStr,')'
659        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
660       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
661        msgBuf = '// ======================================================='        msgBuf =
662         & '// ======================================================='
663        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
664       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
665    
# Line 709  C      X across, Z down slice Line 755  C      X across, Z down slice
755         pltStep = sNy         pltStep = sNy
756         pltLab  = 'J ='         pltLab  = 'J ='
757        ENDIF        ENDIF
758        IF ( validRange ) THEN  C     IF ( validRange ) THEN
759  C      Header  C      Header
760  C      Data  C      Data
761         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
762          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
763           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
764       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
765           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
766       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
# Line 771  C      Data Line 817  C      Data
817               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
818                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
819               ENDIF               ENDIF
820               IDX = NINT(               IF ( validRange .AND. val .NE. 0. ) THEN
821                  IDX = NINT(
822       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)
823       &             )+1       &             )+1
824                 ELSE
825                  IDX = 1
826                 ENDIF
827               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
828       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
829               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
# Line 789  C      Data Line 839  C      Data
839           ENDDO           ENDDO
840          ENDDO          ENDDO
841         ENDDO         ENDDO
842        ENDIF  C     ENDIF
843  C--   Write delimiter  C--   Write delimiter
844        msgBuf = '// ======================================================='        msgBuf =
845         & '// ======================================================='
846        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
847       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
848        msgBuf = '// END OF FIELD                                          ='        msgBuf =
849         & '// END OF FIELD                                          ='
850        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
851       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
852        msgBuf = '// ======================================================='        msgBuf =
853         & '// ======================================================='
854        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
855       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
856        msgBuf = ' '        msgBuf = ' '
# Line 808  C--   Write delimiter Line 861  C--   Write delimiter
861        END        END
862    
863  CStartOfInterface  CStartOfInterface
864        SUBROUTINE PRINT_MAPR8 ( fld, fldTitle, plotMode,        SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode,
865       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
866       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
867       I       jMin,  jMax,  jStr,       I       jMin,  jMax,  jStr,
# Line 816  CStartOfInterface Line 869  CStartOfInterface
869       I      bxMin, bxMax,  bxStr,       I      bxMin, bxMax,  bxStr,
870       I      byMin, byMax,  byStr )       I      byMin, byMax,  byStr )
871  C     /==========================================================\  C     /==========================================================\
872  C     | SUBROUTINE PRINT_MAPR8                                   |  C     | SUBROUTINE PRINT_MAPRL                                   |
873  C     | o Does textual mapping printing of a field.              |  C     | o Does textual mapping printing of a field.              |
874  C     |==========================================================|  C     |==========================================================|
875  C     | This routine does the actual formatting of the data      |  C     | This routine does the actual formatting of the data      |
# Line 836  C     |      plots - one for K=1, one fo Line 889  C     |      plots - one for K=1, one fo
889  C     |      Each plot would have extents iMin:iMax step iStr    |  C     |      Each plot would have extents iMin:iMax step iStr    |
890  C     |      and jMin:jMax step jStr.                            |  C     |      and jMin:jMax step jStr.                            |
891  C     \==========================================================/  C     \==========================================================/
892          IMPLICIT NONE
893    
894  C     == Global variables ==  C     == Global variables ==
895  #include "SIZE.h"  #include "SIZE.h"
# Line 863  C     kStr Line 917  C     kStr
917        INTEGER jLo, jHi        INTEGER jLo, jHi
918        INTEGER kLo, kHi        INTEGER kLo, kHi
919        INTEGER nBx, nBy        INTEGER nBx, nBy
920        Real*8 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)        _RL fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
921        INTEGER iMin, iMax, iStr        INTEGER iMin, iMax, iStr
922        INTEGER jMin, jMax, jStr        INTEGER jMin, jMax, jStr
923        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
# Line 905  C               Str  - stride within blo Line 959  C               Str  - stride within blo
959        INTEGER lChList        INTEGER lChList
960        PARAMETER ( lChList = 28 )        PARAMETER ( lChList = 28 )
961        CHARACTER*(lChList) chList        CHARACTER*(lChList) chList
962        REAL fMin        _RL  fMin
963        REAL fMax        _RL  fMax
964        REAL fRange        _RL  fRange
965        REAL val        _RL  val
966        REAL small        _RL  small
967        CHARACTER*2  accLab        CHARACTER*2  accLab
968        CHARACTER*7  dwnLab        CHARACTER*7  dwnLab
969        CHARACTER*3  pltLab        CHARACTER*3  pltLab
# Line 937  C--   Calculate field range Line 991  C--   Calculate field range
991          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
992           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
993            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
994  C          IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF ( printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0. )
995         &     THEN
996              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
997       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
998              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
999       &       fMax = fld(I,J,K,bi,bj)       &       fMax = fld(I,J,K,bi,bj)
1000  C          ENDIF             ENDIF
1001            ENDDO            ENDDO
1002           ENDDO           ENDDO
1003          ENDDO          ENDDO
# Line 954  C          ENDIF Line 1009  C          ENDIF
1009        ENDIF        ENDIF
1010    
1011  C--   Write field title and statistics  C--   Write field title and statistics
1012        msgBuf = '// ======================================================='        msgBuf =
1013         & '// ======================================================='
1014        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1015       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1016        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 974  C--   Write field title and statistics Line 1030  C--   Write field title and statistics
1030       & '// CMAX = ', fMax       & '// CMAX = ', fMax
1031        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1032       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1033        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
1034           WRITE(msgBuf,'(A,1PE30.15)')
1035       & '// CINT = ', fRange/FLOAT(lChlist-1)       & '// CINT = ', fRange/FLOAT(lChlist-1)
1036          ELSE
1037           WRITE(msgBuf,'(A,1PE30.15)')
1038         & '// CINT = ', 0.
1039          ENDIF
1040        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1041       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1042        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 1007  C--   Write field title and statistics Line 1068  C--   Write field title and statistics
1068       &  ':',kStr,')'       &  ':',kStr,')'
1069        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1070       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1071        msgBuf = '// ======================================================='        msgBuf =
1072         & '// ======================================================='
1073        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1074       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1075    
# Line 1103  C      X across, Z down slice Line 1165  C      X across, Z down slice
1165         pltStep = sNy         pltStep = sNy
1166         pltLab  = 'J ='         pltLab  = 'J ='
1167        ENDIF        ENDIF
1168        IF ( validRange ) THEN  C     IF ( validRange ) THEN
1169  C      Header  C      Header
1170  C      Data  C      Data
1171         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
1172          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
1173           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
1174       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
1175           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1176       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
# Line 1163  C      Data Line 1225  C      Data
1225               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
1226                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
1227               ENDIF               ENDIF
1228               IDX = NINT(               IF ( validRange .AND. val .NE. 0. ) THEN
1229       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)                IDX = NINT(
1230       &             )+1       &               FLOAT( lChList-1 )*( val-fMin ) / (fRange)
1231         &              )+1
1232                 ELSE
1233                  IDX = 1
1234                 ENDIF
1235               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1236       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
1237               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
# Line 1180  C      Data Line 1246  C      Data
1246           ENDDO           ENDDO
1247          ENDDO          ENDDO
1248         ENDDO         ENDDO
1249        ENDIF  C     ENDIF
1250  C--   Write delimiter  C--   Write delimiter
1251        msgBuf = '// ======================================================='        msgBuf =
1252         & '// ======================================================='
1253        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1254       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1255        msgBuf = '// END OF FIELD                                          ='        msgBuf =
1256         & '// END OF FIELD                                          ='
1257        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1258       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1259        msgBuf = '// ======================================================='        msgBuf =
1260         & '// ======================================================='
1261        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1262       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1263        msgBuf = ' '        msgBuf = ' '
# Line 1205  C     | SUBROUTINE PRINT_MESSAGE Line 1274  C     | SUBROUTINE PRINT_MESSAGE
1274  C     | o Write out informational message using "standard" format. |  C     | o Write out informational message using "standard" format. |
1275  C     | Notes                                                      |  C     | Notes                                                      |
1276  C     | =====                                                      |  C     | =====                                                      |
1277  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  |
1278  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |
1279  C     |   critical region is defined around the write here. In some|  C     |   critical region is defined around the write here. In some|
1280  C     |   cases  BEGIN_CRIT() is approximated by only doing writes |  C     |   cases  BEGIN_CRIT() is approximated by only doing writes |
# Line 1214  C     |   ignored! Line 1283  C     |   ignored!
1283  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. |
1284  C     |   to produce pretty printed output!                        |  C     |   to produce pretty printed output!                        |
1285  C     \============================================================/  C     \============================================================/
1286          IMPLICIT NONE
1287  C     == Global data ==  C     == Global data ==
1288  #include "SIZE.h"  #include "SIZE.h"
1289  #include "EEPARAMS.h"  #include "EEPARAMS.h"
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.17
  ViewVC Help
Powered by ViewVC 1.1.22