/[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.16 by adcroft, Mon May 24 15:26:08 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, 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 127  C                  INDEX_K    => /* K = Line 131  C                  INDEX_K    => /* K =
131  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
132  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
133  C                  INDEX_NONE =>  C                  INDEX_NONE =>
134    C     compact -  Flag to control use of repeat symbol for same valued
135    C                fields.
136    C     markEnd -  Flag to control whether there is a separator after the
137    C                last element
138  C     ioUnit -  Unit number for IO.  C     ioUnit -  Unit number for IO.
139        INTEGER lFld        INTEGER lFld
140        INTEGER index_type        INTEGER index_type
141        INTEGER fld(lFld)        INTEGER fld(lFld)
142          LOGICAL markEnd
143          LOGICAL compact
144        INTEGER ioUnit        INTEGER ioUnit
145  CEndifinterface  CEndifinterface
146    
# Line 170  C     K    - Loop counter Line 180  C     K    - Loop counter
180        xOld = fld(1)        xOld = fld(1)
181        DO K=2,lFld        DO K=2,lFld
182         xNew = fld(K  )         xNew = fld(K  )
183         IF ( 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 191  C     K    - Loop counter Line 202  C     K    - Loop counter
202         ENDIF         ENDIF
203        ENDDO        ENDDO
204        punc = ' '        punc = ' '
205          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 208  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, 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 217  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 230  C                  INDEX_K    => /* K = Line 245  C                  INDEX_K    => /* K =
245  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
246  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
247  C                  INDEX_NONE =>  C                  INDEX_NONE =>
248    C     compact -  Flag to control use of repeat symbol for same valued
249    C                fields.
250    C     markEnd -  Flag to control whether there is a separator after the
251    C                last element
252  C     ioUnit -  Unit number for IO.  C     ioUnit -  Unit number for IO.
253        INTEGER lFld        INTEGER lFld
254        INTEGER index_type        INTEGER index_type
255        LOGICAL fld(lFld)        LOGICAL fld(lFld)
256          LOGICAL markEnd
257          LOGICAL compact
258        INTEGER ioUnit        INTEGER ioUnit
259  CEndifinterface  CEndifinterface
260    
# Line 273  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 ( 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 294  C     K    - Loop counter Line 316  C     K    - Loop counter
316         ENDIF         ENDIF
317        ENDDO        ENDDO
318        punc = ' '        punc = ' '
319          IF ( markEnd ) punc = ','
320        nDup = iHi-iLo+1        nDup = iHi-iLo+1
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 311  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, 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 320  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 333  C                  INDEX_K    => /* K = Line 359  C                  INDEX_K    => /* K =
359  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
360  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
361  C                  INDEX_NONE =>  C                  INDEX_NONE =>
362    C     compact -  Flag to control use of repeat symbol for same valued
363    C                fields.
364    C     markEnd -  Flag to control whether there is a separator after the
365    C                last element
366  C     ioUnit -  Unit number for IO.  C     ioUnit -  Unit number for IO.
367        INTEGER lFld        INTEGER lFld
368        INTEGER index_type        INTEGER index_type
369        Real*8  fld(lFld)        Real*8  fld(lFld)
370          LOGICAL markEnd
371          LOGICAL compact
372        INTEGER ioUnit        INTEGER ioUnit
373  CEndifinterface  CEndifinterface
374    
# Line 376  C     K    - Loop counter Line 408  C     K    - Loop counter
408        xOld = fld(1)        xOld = fld(1)
409        DO K=2,lFld        DO K=2,lFld
410         xNew = fld(K  )         xNew = fld(K  )
411         IF ( xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
412          nDup = iHi-iLo+1          nDup = iHi-iLo+1
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 397  C     K    - Loop counter Line 431  C     K    - Loop counter
431         ENDIF         ENDIF
432        ENDDO        ENDDO
433        punc = ' '        punc = ' '
434          IF ( markEnd ) punc = ','
435        nDup = iHi-iLo+1        nDup = iHi-iLo+1
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
452    
453  CStartOfInterface  CStartOfInterface
454        SUBROUTINE PRINT_MAPR4 ( fld, fldTitle, plotMode,        SUBROUTINE PRINT_MAPRS ( fld, fldTitle, plotMode,
455       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
456       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
457       I       jMin,  jMax,  jStr,       I       jMin,  jMax,  jStr,
# Line 442  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 469  C     kStr Line 507  C     kStr
507        INTEGER jLo, jHi        INTEGER jLo, jHi
508        INTEGER kLo, kHi        INTEGER kLo, kHi
509        INTEGER nBx, nBy        INTEGER nBx, nBy
510        Real*4 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)        _RS fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
511        INTEGER iMin, iMax, iStr        INTEGER iMin, iMax, iStr
512        INTEGER jMin, jMax, jStr        INTEGER jMin, jMax, jStr
513        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
# Line 511  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 532  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 543  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 560  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 580  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 613  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 709  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 771  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 789  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 808  C--   Write delimiter Line 860  C--   Write delimiter
860        END        END
861    
862  CStartOfInterface  CStartOfInterface
863        SUBROUTINE PRINT_MAPR8 ( fld, fldTitle, plotMode,        SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode,
864       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
865       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
866       I       jMin,  jMax,  jStr,       I       jMin,  jMax,  jStr,
# Line 816  CStartOfInterface Line 868  CStartOfInterface
868       I      bxMin, bxMax,  bxStr,       I      bxMin, bxMax,  bxStr,
869       I      byMin, byMax,  byStr )       I      byMin, byMax,  byStr )
870  C     /==========================================================\  C     /==========================================================\
871  C     | SUBROUTINE PRINT_MAPR8                                   |  C     | SUBROUTINE PRINT_MAPRL                                   |
872  C     | o Does textual mapping printing of a field.              |  C     | o Does textual mapping printing of a field.              |
873  C     |==========================================================|  C     |==========================================================|
874  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 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 863  C     kStr Line 916  C     kStr
916        INTEGER jLo, jHi        INTEGER jLo, jHi
917        INTEGER kLo, kHi        INTEGER kLo, kHi
918        INTEGER nBx, nBy        INTEGER nBx, nBy
919        Real*8 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)        _RL fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
920        INTEGER iMin, iMax, iStr        INTEGER iMin, iMax, iStr
921        INTEGER jMin, jMax, jStr        INTEGER jMin, jMax, jStr
922        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
# Line 905  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 937  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 954  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 974  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 1007  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 1103  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 1163  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 1180  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 1205  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 1214  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.7  
changed lines
  Added in v.1.16
  ViewVC Help
Powered by ViewVC 1.1.22