--- MITgcm/eesupp/src/print.F 1998/04/23 20:56:54 1.3 +++ MITgcm/eesupp/src/print.F 2006/09/02 22:47:10 1.25 @@ -1,4 +1,5 @@ -C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/eesupp/src/print.F,v 1.3 1998/04/23 20:56:54 cnh Exp $ +C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/eesupp/src/print.F,v 1.25 2006/09/02 22:47:10 jmc Exp $ +C $Name: $ #include "CPP_EEOPTIONS.h" @@ -6,42 +7,70 @@ C-- in the MITgcm UV implementation environment. C-- Contents C-- o print_error Does IO with **ERROR** highlighted header +C-- o print_list_i Prints one-deimensional list of INTEGER +C-- numbers. +C-- o print_list_l Prints one-deimensional list of LOGICAL +C-- variables. +C-- o print_list_r8 Prints one-deimensional list of Real*8 +C-- numbers. +C-- o print_mapr4 Formats ABCD... contour map of a Real*4 field +C-- Uses print_message for writing C-- o print_mapr8 Formats ABCD... contour map of a Real*8 field C-- Uses print_message for writing C-- o print_message Does IO with unhighlighted header -CStartOfInterface +CBOP + +C !ROUTINE: PRINT_ERROR + +C !INTERFACE: SUBROUTINE PRINT_ERROR( message , myThid ) -C /============================================================\ -C | SUBROUTINE PRINT_ERROR | -C | o Write out error message using "standard" format. | -C | Notes | -C | ===== | -C | o Some system's I/O is not "thread-safe". For this reason | -C | without the FMTFTN_IO_THREAD_SAFE directive set a | -C | critical region is defined around the write here. In some| -C | cases BEGIN_CRIT() is approximated by only doing writes | -C | for thread number 1 - writes for other threads are | -C | ignored! | -C | o In a non-parallel form these routines can still be used. | -C | to produce pretty printed output! | -C \============================================================/ + IMPLICIT NONE + +C !DESCRIPTION: +C *============================================================* +C | SUBROUTINE PRINT\_ERROR +C | o Write out error message using "standard" format. +C *============================================================* +C | Notes +C | ===== +C | o Some system I/O is not "thread-safe". For this reason +C | without the FMTFTN\_IO\_THREAD\_SAFE directive set a +C | critical region is defined around the write here. In some +C | cases BEGIN\_CRIT() is approximated by only doing writes +C | for thread number 1 - writes for other threads are +C | ignored! +C | o In a non-parallel form these routines are still used +C | to produce pretty printed output. The process and thread +C | id prefix is omitted in this case. +C *============================================================* + +C !USES: C == Global data == #include "SIZE.h" #include "EEPARAMS.h" #include "EESUPPORT.h" -C == Routine arguments == - CHARACTER*(*) message - INTEGER myThid -CEndOfInterface INTEGER IFNBLNK EXTERNAL IFNBLNK INTEGER ILNBLNK EXTERNAL ILNBLNK + +C !INPUT/OUTPUT PARAMETERS: +C == Routine arguments == +C message :: Text string to print +C myThid :: Thread number of this instance + CHARACTER*(*) message + INTEGER myThid + +C !LOCAL VARIABLES: C == Local variables == +C iStart, iEnd :: Temps. for string indexing +C idString :: Temp. for building message prefix INTEGER iStart INTEGER iEnd CHARACTER*9 idString +CEOP + C-- Find beginning and end of message iStart = IFNBLNK( message ) iEnd = ILNBLNK( message ) @@ -52,80 +81,474 @@ IF ( message .EQ. ' ' ) THEN WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' ' ELSE - WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, message(iStart:iEnd) + WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, + & message(iStart:iEnd) ENDIF - ELSEIF ( pidIO .EQ. myProcId ) THEN -C-- Write multi-process format -#ifndef FMTFTN_IO_THREAD_SAFE - _BEGIN_CRIT(myThid) -#endif - WRITE(idString,'(I4.4,A,I4.4)') myProcId,'.',myThid -#ifndef FMTFTN_IO_THREAD_SAFE - _END_CRIT(myThid) -#endif - IF ( message .EQ. ' ' ) THEN + ELSE C PRINT_ERROR can be called by several threads simulataneously. C The write statement may need to be marked as a critical section. #ifndef FMTFTN_IO_THREAD_SAFE - _BEGIN_CRIT(myThid) -#endif - WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)') - & '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ', - & ' ' -#ifndef FMTFTN_IO_THREAD_SAFE - _END_CRIT(myThid) +# ifdef USE_OMP_THREADING +C$OMP CRITICAL +# else + _BEGIN_CRIT(myThid) +# endif #endif - ELSE -#ifndef FMTFTN_IO_THREAD_SAFE - _BEGIN_CRIT(myThid) + IF ( pidIO .EQ. myProcId ) THEN +C-- Write multi-process format + WRITE(idString,'(I4.4,A,I4.4)') myProcId,'.',myThid + + IF ( iEnd.EQ.0 ) THEN +c WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999) + WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)') + & '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ', + & ' ' + ELSE +c WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999) + WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)') + & '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ', + & message(iStart:iEnd) + ENDIF + ENDIF + +#ifndef DISABLE_WRITE_TO_UNIT_ZERO +C-- also write directly to unit 0 : + IF ( numberOfProcs.EQ.1 .AND. iEnd.NE.0 ) THEN + IF ( nThreads.LE.1 ) THEN + WRITE(0,'(A)') message(1:iEnd) + ELSE + WRITE(0,'(A,I4.4,A,A)') '(TID ', myThid, ') ', + & message(1:iEnd) + ENDIF + ENDIF #endif - WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)') - & '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ', - & message(iStart:iEnd) + #ifndef FMTFTN_IO_THREAD_SAFE +# ifdef USE_OMP_THREADING +C$OMP END CRITICAL +# else _END_CRIT(myThid) +# endif #endif + ENDIF + + 1000 CONTINUE + RETURN + +c 999 CONTINUE +c ioErrorCount(myThid) = ioErrorCount(myThid)+1 +c GOTO 1000 + END + +CBOP +C !ROUTINE: PRINT_LIST_I + +C !INTERFACE: + SUBROUTINE PRINT_LIST_I( fld, lFld, index_type, + & markEnd, compact, ioUnit ) + IMPLICIT NONE +C !DESCRIPTION: +C *==========================================================* +C | o SUBROUTINE PRINT\_LIST\_I +C *==========================================================* +C | Routine for producing list of values for a field with +C | duplicate values collected into +C | n \@ value +C | record. +C *==========================================================* + +C !USES: +C == Global data == +#include "SIZE.h" +#include "EEPARAMS.h" + +C !INPUT/OUTPUT PARAMETERS: +C == Routine arguments == +C fld :: Data to be printed +C lFld :: Number of elements to be printed +C index_type :: Flag indicating which type of index to print +C INDEX_K => /* K = nnn */ +C INDEX_I => /* I = nnn */ +C INDEX_J => /* J = nnn */ +C INDEX_NONE => +C compact :: Flag to control use of repeat symbol for same valued +C fields. +C markEnd :: Flag to control whether there is a separator after the +C last element +C ioUnit :: Unit number for IO. + INTEGER lFld + INTEGER index_type + INTEGER fld(lFld) + LOGICAL markEnd + LOGICAL compact + INTEGER ioUnit + +C !LOCAL VARIABLES: +C == Local variables == +C iLo - Range index holders for selecting elements with +C iHi with the same value +C nDup - Number of duplicates +C xNew, xOld - Hold current and previous values of field +C punc - Field separator +C msgBuf - IO buffer +C index_lab - Index for labelling elements +C K - Loop counter + INTEGER iLo + INTEGER iHi + INTEGER nDup + INTEGER xNew, xOld + CHARACTER punc + CHARACTER*(MAX_LEN_MBUF) msgBuf + CHARACTER*2 commOpen,commClose + CHARACTER*3 index_lab + INTEGER K +CEOP + + IF ( index_type .EQ. INDEX_I ) THEN + index_lab = 'I =' + ELSEIF ( index_type .EQ. INDEX_J ) THEN + index_lab = 'J =' + ELSEIF ( index_type .EQ. INDEX_K ) THEN + index_lab = 'K =' + ELSE + index_lab = '?=' + ENDIF + commOpen = '/*' + commClose = '*/' + iLo = 1 + iHi = 1 + punc = ',' + xOld = fld(1) + DO K=2,lFld + xNew = fld(K ) + IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN + nDup = iHi-iLo+1 + IF ( nDup .EQ. 1 ) THEN + WRITE(msgBuf,'(A,I9,A)') ' ',xOld,punc + IF ( index_type .NE. INDEX_NONE ) + & WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') + & commOpen,index_lab,iLo,commClose + ELSE + WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc + IF ( index_type .NE. INDEX_NONE ) + & WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)') + & commOpen,index_lab,iLo,':',iHi,commClose + ENDIF + CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1) + iLo = K + iHi = K + xOld = xNew + ELSE + iHi = K ENDIF + ENDDO + punc = ' ' + IF ( markEnd ) punc = ',' + nDup = iHi-iLo+1 + IF ( nDup .EQ. 1 ) THEN + WRITE(msgBuf,'(A,I9,A)') ' ',xOld,punc + IF ( index_type .NE. INDEX_NONE ) + & WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') + & commOpen,index_lab,iLo,commClose + ELSEIF( nDup .GT. 1 ) THEN + WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc + IF ( index_type .NE. INDEX_NONE ) + & WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)') + & commOpen,index_lab,iLo,':',iHi,commClose ENDIF -C + CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1) + + RETURN + END + +CBOP +C !ROUTINE: PRINT_LIST_L + +C !INTERFACE: + SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, markEnd, + & compact, ioUnit ) + IMPLICIT NONE +C !DESCRIPTION: +C *==========================================================* +C | o SUBROUTINE PRINT\_LIST\_L +C *==========================================================* +C | Routine for producing list of values for a field with +C | duplicate values collected into +C | n \@ value +C | record. +C *==========================================================* + +C !USES: +C == Global data == +#include "SIZE.h" +#include "EEPARAMS.h" + +C !INPUT/OUTPUT PARAMETERS: +C == Routine arguments == +C fld - Data to be printed +C lFld - Number of elements to be printed +C index_type - Flag indicating which type of index to print +C INDEX_K => /* K = nnn */ +C INDEX_I => /* I = nnn */ +C INDEX_J => /* J = nnn */ +C INDEX_NONE => +C compact - Flag to control use of repeat symbol for same valued +C fields. +C markEnd - Flag to control whether there is a separator after the +C last element +C ioUnit - Unit number for IO. + INTEGER lFld + INTEGER index_type + LOGICAL fld(lFld) + LOGICAL markEnd + LOGICAL compact + INTEGER ioUnit + +C !LOCAL VARIABLES: +C == Local variables == +C iLo - Range index holders for selecting elements with +C iHi with the same value +C nDup - Number of duplicates +C xNew, xOld - Hold current and previous values of field +C punc - Field separator +C msgBuf - IO buffer +C index_lab - Index for labelling elements +C K - Loop counter + INTEGER iLo + INTEGER iHi + INTEGER nDup + LOGICAL xNew, xOld + CHARACTER punc + CHARACTER*(MAX_LEN_MBUF) msgBuf + CHARACTER*2 commOpen,commClose + CHARACTER*3 index_lab + INTEGER K +CEOP + + IF ( index_type .EQ. INDEX_I ) THEN + index_lab = 'I =' + ELSEIF ( index_type .EQ. INDEX_J ) THEN + index_lab = 'J =' + ELSEIF ( index_type .EQ. INDEX_K ) THEN + index_lab = 'K =' + ELSE + index_lab = '?=' + ENDIF + commOpen = '/*' + commClose = '*/' + iLo = 1 + iHi = 1 + punc = ',' + xOld = fld(1) + DO K=2,lFld + xNew = fld(K ) + IF ( .NOT. compact .OR. (xNew .NEQV. xOld) ) THEN + nDup = iHi-iLo+1 + IF ( nDup .EQ. 1 ) THEN + WRITE(msgBuf,'(A,L5,A)') ' ',xOld,punc + IF ( index_type .NE. INDEX_NONE ) + & WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') + & commOpen,index_lab,iLo,commClose + ELSE + WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc + IF ( index_type .NE. INDEX_NONE ) + & WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)') + & commOpen,index_lab,iLo,':',iHi,commClose + ENDIF + CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1) + iLo = K + iHi = K + xOld = xNew + ELSE + iHi = K + ENDIF + ENDDO + punc = ' ' + IF ( markEnd ) punc = ',' + nDup = iHi-iLo+1 + IF ( nDup .EQ. 1 ) THEN + WRITE(msgBuf,'(A,L5,A)') ' ',xOld,punc + IF ( index_type .NE. INDEX_NONE ) + & WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') + & commOpen,index_lab,iLo,commClose + ELSEIF( nDup .GT. 1 ) THEN + WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc + IF ( index_type .NE. INDEX_NONE ) + & WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)') + & commOpen,index_lab,iLo,':',iHi,commClose + ENDIF + CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1) + RETURN END -CStartOfInterface - SUBROUTINE PRINT_MAPR4 ( fld, fldTitle, plotMode, +CBOP +C !ROUTINE: PRINT_LIST_R8 +C !INTERFACE: + SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type, + & markEnd, compact, ioUnit ) + IMPLICIT NONE +C !DESCRIPTION: +C *==========================================================* +C | o SUBROUTINE PRINT\_LIST\_R8 +C *==========================================================* +C | Routine for producing list of values for a field with +C | duplicate values collected into +C | n \@ value +C | record. +C *==========================================================* + +C !USES: +C == Global data == +#include "SIZE.h" +#include "EEPARAMS.h" + +C !INPUT/OUTPUT PARAMETERS: +C == Routine arguments == +C fld - Data to be printed +C lFld - Number of elements to be printed +C index_type - Flag indicating which type of index to print +C INDEX_K => /* K = nnn */ +C INDEX_I => /* I = nnn */ +C INDEX_J => /* J = nnn */ +C INDEX_NONE => +C compact - Flag to control use of repeat symbol for same valued +C fields. +C markEnd - Flag to control whether there is a separator after the +C last element +C ioUnit - Unit number for IO. + INTEGER lFld + INTEGER index_type + Real*8 fld(lFld) + LOGICAL markEnd + LOGICAL compact + INTEGER ioUnit + +C !LOCA VARIABLES: +C == Local variables == +C iLo - Range index holders for selecting elements with +C iHi with the same value +C nDup - Number of duplicates +C xNew, xOld - Hold current and previous values of field +C punc - Field separator +C msgBuf - IO buffer +C index_lab - Index for labelling elements +C K - Loop counter + INTEGER iLo + INTEGER iHi + INTEGER nDup + Real*8 xNew, xOld + CHARACTER punc + CHARACTER*(MAX_LEN_MBUF) msgBuf + CHARACTER*2 commOpen,commClose + CHARACTER*3 index_lab + INTEGER K +CEOP + + IF ( index_type .EQ. INDEX_I ) THEN + index_lab = 'I =' + ELSEIF ( index_type .EQ. INDEX_J ) THEN + index_lab = 'J =' + ELSEIF ( index_type .EQ. INDEX_K ) THEN + index_lab = 'K =' + ELSE + index_lab = '?=' + ENDIF + commOpen = '/*' + commClose = '*/' + iLo = 1 + iHi = 1 + punc = ',' + xOld = fld(1) + DO K=2,lFld + xNew = fld(K ) + IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN + nDup = iHi-iLo+1 + IF ( nDup .EQ. 1 ) THEN + WRITE(msgBuf,'(A,1PE23.15,A)') ' ',xOld,punc + IF ( index_type .NE. INDEX_NONE ) + & WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') + & commOpen,index_lab,iLo,commClose + ELSE + WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc + IF ( index_type .NE. INDEX_NONE ) + & WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)') + & commOpen,index_lab,iLo,':',iHi,commClose + ENDIF + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT , 1) + iLo = K + iHi = K + xOld = xNew + ELSE + iHi = K + ENDIF + ENDDO + punc = ' ' + IF ( markEnd ) punc = ',' + nDup = iHi-iLo+1 + IF ( nDup .EQ. 1 ) THEN + WRITE(msgBuf,'(A,1PE23.15,A)') ' ',xOld,punc + IF ( index_type .NE. INDEX_NONE ) + & WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') + & commOpen,index_lab,iLo,commClose + ELSEIF( nDup .GT. 1 ) THEN + WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc + IF ( index_type .NE. INDEX_NONE ) + & WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)') + & commOpen,index_lab,iLo,':',iHi,commClose + ENDIF + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT , 1) + + RETURN + END + +CBOP +C !ROUTINE: PRINT_MAPRS +C !INTERFACE: + SUBROUTINE PRINT_MAPRS ( fld, fldTitle, plotMode, I iLo, iHi, jLo, jHi, kLo, kHi, nBx, nBy, I iMin, iMax, iStr, I jMin, jMax, jStr, I kMin, kMax, kStr, I bxMin, bxMax, bxStr, I byMin, byMax, byStr ) -C /==========================================================\ -C | SUBROUTINE PRINT_MAPR4 | -C | o Does textual mapping printing of a field. | -C |==========================================================| -C | This routine does the actual formatting of the data | -C | and printing to a file. It assumes an array using the | -C | MITgcm UV indexing scheme and base index variables. | -C | User code should call an interface routine like | -C | PLOT_FIELD_XYR4( ... ) rather than this code directly. | -C | Text plots can be oriented XY, YZ, XZ. An orientation | -C | is specficied through the "plotMode" argument. All the | -C | plots made by a single call to this routine will use the | -C | same contour interval. The plot range (iMin,...,byStr) | -C | can be three-dimensional. A separate plot is made for | -C | each point in the plot range normal to the orientation. | -C | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY). | -C | kMin =1, kMax = 5 and kStr = 2 will produce three XY| -C | plots - one for K=1, one for K=3 and one for K=5. | -C | Each plot would have extents iMin:iMax step iStr | -C | and jMin:jMax step jStr. | -C \==========================================================/ + IMPLICIT NONE +C !DESCRIPTION: +C *==========================================================* +C | SUBROUTINE PRINT\_MAPR4 +C | o Does textual mapping printing of a field. +C *==========================================================* +C | This routine does the actual formatting of the data +C | and printing to a file. It assumes an array using the +C | MITgcm UV indexing scheme and base index variables. +C | User code should call an interface routine like +C | PLOT\_FIELD\_XYR4( ... ) rather than this code directly. +C | Text plots can be oriented XY, YZ, XZ. An orientation +C | is specficied through the "plotMode" argument. All the +C | plots made by a single call to this routine will use the +C | same contour interval. The plot range (iMin,...,byStr) +C | can be three-dimensional. A separate plot is made for +C | each point in the plot range normal to the orientation. +C | e.g. if the orientation is XY (plotMode = PRINT\_MAP\_XY). +C | kMin =1, kMax = 5 and kStr = 2 will produce three XY +C | plots - one for K=1, one for K=3 and one for K=5. +C | Each plot would have extents iMin:iMax step iStr +C | and jMin:jMax step jStr. +C *==========================================================* +C !USES: C == Global variables == #include "SIZE.h" #include "EEPARAMS.h" #include "EESUPPORT.h" + INTEGER IFNBLNK + EXTERNAL IFNBLNK + INTEGER ILNBLNK + EXTERNAL ILNBLNK +C !INPUT/OUTPUT PARAMETERS: C == Routine arguments == C fld - Real*4 array holding data to be plotted C fldTitle - Name of field to be plotted @@ -147,19 +570,14 @@ INTEGER jLo, jHi INTEGER kLo, kHi INTEGER nBx, nBy - Real*4 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy) + _RS fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy) INTEGER iMin, iMax, iStr INTEGER jMin, jMax, jStr INTEGER kMin, kMax, kStr INTEGER bxMin, bxMax, bxStr INTEGER byMin, byMax, byStr -CEndOfInterface -C == Local variables == - INTEGER IFNBLNK - EXTERNAL IFNBLNK - INTEGER ILNBLNK - EXTERNAL ILNBLNK +C !LOCAL VARIABLES: C == Local variables == C plotBuf - Buffer for building plot record C chList - Character string used for plot @@ -189,11 +607,11 @@ INTEGER lChList PARAMETER ( lChList = 28 ) CHARACTER*(lChList) chList - REAL fMin - REAL fMax - REAL fRange - REAL val - REAL small + _RL fMin + _RL fMax + _RL fRange + _RL val + _RL small CHARACTER*2 accLab CHARACTER*7 dwnLab CHARACTER*3 pltLab @@ -208,11 +626,12 @@ INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx INTEGER bi, bj, bk LOGICAL validRange +CEOP chList = '-abcdefghijklmnopqrstuvwxyz+' - small = 1. _d -15 - fMin = 1. _d 32 - fMax = -1. _d 32 + small = 1. _d -15 + fMin = 1. _d 32 + fMax = -1. _d 32 validRange = .FALSE. C-- Calculate field range @@ -221,7 +640,7 @@ DO K=kMin, kMax, kStr DO J=jMin, jMax, jStr DO I=iMin, iMax, iStr - IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN + IF (printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0.) THEN IF ( fld(I,J,K,bi,bj) .LT. fMin ) & fMin = fld(I,J,K,bi,bj) IF ( fld(I,J,K,bi,bj) .GT. fMax ) @@ -233,12 +652,13 @@ ENDDO ENDDO fRange = fMax-fMin - IF ( fRange .GT. small ) THEN - validRange = .TRUE. - ENDIF + IF ( fRange .GT. small .AND. + & (MAX_LEN_PLOTBUF-35) .GT. sNx*nSx .AND. + & (MAX_LEN_PLOTBUF-35) .GT. sNy*nSy ) validRange = .TRUE. C-- Write field title and statistics - msgBuf = '// =======================================================' + msgBuf = + & '// =======================================================' CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, & SQUEEZE_RIGHT, 1) iStrngLo = IFNBLNK(fldTitle) @@ -258,8 +678,13 @@ & '// CMAX = ', fMax CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, & SQUEEZE_RIGHT, 1) - WRITE(msgBuf,'(A,1PE30.15)') - & '// CINT = ', fRange/FLOAT(lChlist-1) + IF ( validRange ) THEN + WRITE(msgBuf,'(A,1PE30.15)') + & '// CINT = ', fRange/FLOAT(lChlist-1) + ELSE + WRITE(msgBuf,'(A,1PE30.15)') + & '// CINT = ', 0. + ENDIF CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, & SQUEEZE_RIGHT, 1) WRITE(msgBuf,'(A,1024A1)') @@ -291,10 +716,19 @@ & ':',kStr,')' CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, & SQUEEZE_RIGHT, 1) - msgBuf = '// =======================================================' + msgBuf = + & '// =======================================================' CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, & SQUEEZE_RIGHT, 1) + if (Nx.gt.MAX_LEN_PLOTBUF-20) THEN + msgBuf = + & 'Model domain too big to print to terminal - skipping I/O' + CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT, 1) + RETURN + endif + C-- Write field C Figure out slice type and set plotting parameters appropriately C acc = accross the page @@ -392,7 +826,7 @@ C Data DO bk=pltBlo, pltBhi, pltBstr DO K=pltMin,pltMax,pltStr - WRITE(plotBuf,'(A,I,I,I,I)') pltLab, + WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab, & pltBase-1+(bk-1)*pltStep+K CALL PRINT_MESSAGE(plotBuf, standardMessageUnit, & SQUEEZE_RIGHT, 1) @@ -427,7 +861,7 @@ IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN WRITE(plotBuf(iBuf:),'(A)') '|' ELSE - WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(iDx,10) + WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(ABS(iDx),10) ENDIF ENDDO ENDDO @@ -449,9 +883,13 @@ ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN val = fld(K,I,J,bk,bi) ENDIF - IDX = NINT( + IF ( validRange .AND. val .NE. 0. ) THEN + IDX = NINT( & FLOAT( lChList-1 )*( val-fMin ) / (fRange) & )+1 + ELSE + IDX = 1 + ENDIF IF ( iBuf .LE. MAX_LEN_PLOTBUF ) & plotBuf(iBuf:iBuf) = chList(IDX:IDX) IF ( val .EQ. 0. ) THEN @@ -469,13 +907,16 @@ ENDDO ENDIF C-- Write delimiter - msgBuf = '// =======================================================' + msgBuf = + & '// =======================================================' CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, & SQUEEZE_RIGHT, 1) - msgBuf = '// END OF FIELD =' + msgBuf = + & '// END OF FIELD =' CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, & SQUEEZE_RIGHT, 1) - msgBuf = '// =======================================================' + msgBuf = + & '// =======================================================' CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, & SQUEEZE_RIGHT, 1) msgBuf = ' ' @@ -485,41 +926,53 @@ RETURN END -CStartOfInterface - SUBROUTINE PRINT_MAPR8 ( fld, fldTitle, plotMode, +CBOP +C !ROUTINE: PRINT_MAPRL + +C !INTERFACE: + SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode, I iLo, iHi, jLo, jHi, kLo, kHi, nBx, nBy, I iMin, iMax, iStr, I jMin, jMax, jStr, I kMin, kMax, kStr, I bxMin, bxMax, bxStr, I byMin, byMax, byStr ) -C /==========================================================\ -C | SUBROUTINE PRINT_MAPR8 | -C | o Does textual mapping printing of a field. | -C |==========================================================| -C | This routine does the actual formatting of the data | -C | and printing to a file. It assumes an array using the | -C | MITgcm UV indexing scheme and base index variables. | -C | User code should call an interface routine like | -C | PLOT_FIELD_XYR8( ... ) rather than this code directly. | -C | Text plots can be oriented XY, YZ, XZ. An orientation | -C | is specficied through the "plotMode" argument. All the | -C | plots made by a single call to this routine will use the | -C | same contour interval. The plot range (iMin,...,byStr) | -C | can be three-dimensional. A separate plot is made for | -C | each point in the plot range normal to the orientation. | -C | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY). | -C | kMin =1, kMax = 5 and kStr = 2 will produce three XY| -C | plots - one for K=1, one for K=3 and one for K=5. | -C | Each plot would have extents iMin:iMax step iStr | -C | and jMin:jMax step jStr. | -C \==========================================================/ + IMPLICIT NONE + +C !DESCRIPTION: +C *==========================================================* +C | SUBROUTINE PRINT\_MAPRL +C | o Does textual mapping printing of a field. +C *==========================================================* +C | This routine does the actual formatting of the data +C | and printing to a file. It assumes an array using the +C | MITgcm UV indexing scheme and base index variables. +C | User code should call an interface routine like +C | PLOT\_FIELD\_XYR8( ... ) rather than this code directly. +C | Text plots can be oriented XY, YZ, XZ. An orientation +C | is specficied through the "plotMode" argument. All the +C | plots made by a single call to this routine will use the +C | same contour interval. The plot range (iMin,...,byStr) +C | can be three-dimensional. A separate plot is made for +C | each point in the plot range normal to the orientation. +C | e.g. if the orientation is XY (plotMode = PRINT\_MAP\_XY). +C | kMin =1, kMax = 5 and kStr = 2 will produce three XY +C | plots - one for K=1, one for K=3 and one for K=5. +C | Each plot would have extents iMin:iMax step iStr +C | and jMin:jMax step jStr. +C *==========================================================* +C !USES: C == Global variables == #include "SIZE.h" #include "EEPARAMS.h" #include "EESUPPORT.h" + INTEGER IFNBLNK + EXTERNAL IFNBLNK + INTEGER ILNBLNK + EXTERNAL ILNBLNK +C !INPUT/OUTPUT PARAMETERS: C == Routine arguments == C fld - Real*8 array holding data to be plotted C fldTitle - Name of field to be plotted @@ -541,19 +994,14 @@ INTEGER jLo, jHi INTEGER kLo, kHi INTEGER nBx, nBy - Real*8 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy) + _RL fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy) INTEGER iMin, iMax, iStr INTEGER jMin, jMax, jStr INTEGER kMin, kMax, kStr INTEGER bxMin, bxMax, bxStr INTEGER byMin, byMax, byStr -CEndOfInterface -C == Local variables == - INTEGER IFNBLNK - EXTERNAL IFNBLNK - INTEGER ILNBLNK - EXTERNAL ILNBLNK +C !LOCAL VARIABLES: C == Local variables == C plotBuf - Buffer for building plot record C chList - Character string used for plot @@ -583,11 +1031,11 @@ INTEGER lChList PARAMETER ( lChList = 28 ) CHARACTER*(lChList) chList - REAL fMin - REAL fMax - REAL fRange - REAL val - REAL small + _RL fMin + _RL fMax + _RL fRange + _RL val + _RL small CHARACTER*2 accLab CHARACTER*7 dwnLab CHARACTER*3 pltLab @@ -602,6 +1050,7 @@ INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx INTEGER bi, bj, bk LOGICAL validRange +CEOP chList = '-abcdefghijklmnopqrstuvwxyz+' small = 1. _d -15 @@ -615,24 +1064,26 @@ DO K=kMin, kMax, kStr DO J=jMin, jMax, jStr DO I=iMin, iMax, iStr -C IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN + IF ( printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0. ) + & THEN IF ( fld(I,J,K,bi,bj) .LT. fMin ) & fMin = fld(I,J,K,bi,bj) IF ( fld(I,J,K,bi,bj) .GT. fMax ) & fMax = fld(I,J,K,bi,bj) -C ENDIF + ENDIF ENDDO ENDDO ENDDO ENDDO ENDDO fRange = fMax-fMin - IF ( fRange .GT. small ) THEN - validRange = .TRUE. - ENDIF + IF ( fRange .GT. small .AND. + & (MAX_LEN_PLOTBUF-35) .GT. sNx*nSx .AND. + & (MAX_LEN_PLOTBUF-35) .GT. sNy*nSy ) validRange = .TRUE. C-- Write field title and statistics - msgBuf = '// =======================================================' + msgBuf = + & '// =======================================================' CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, & SQUEEZE_RIGHT, 1) iStrngLo = IFNBLNK(fldTitle) @@ -652,8 +1103,13 @@ & '// CMAX = ', fMax CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, & SQUEEZE_RIGHT, 1) - WRITE(msgBuf,'(A,1PE30.15)') + IF ( validRange ) THEN + WRITE(msgBuf,'(A,1PE30.15)') & '// CINT = ', fRange/FLOAT(lChlist-1) + ELSE + WRITE(msgBuf,'(A,1PE30.15)') + & '// CINT = ', 0. + ENDIF CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, & SQUEEZE_RIGHT, 1) WRITE(msgBuf,'(A,1024A1)') @@ -685,10 +1141,19 @@ & ':',kStr,')' CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, & SQUEEZE_RIGHT, 1) - msgBuf = '// =======================================================' + msgBuf = + & '// =======================================================' CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, & SQUEEZE_RIGHT, 1) + if (Nx.gt.MAX_LEN_PLOTBUF-20) THEN + msgBuf = + & 'Model domain too big to print to terminal - skipping I/O' + CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT, 1) + RETURN + endif + C-- Write field C Figure out slice type and set plotting parameters appropriately C acc = accross the page @@ -786,7 +1251,7 @@ C Data DO bk=pltBlo, pltBhi, pltBstr DO K=pltMin,pltMax,pltStr - WRITE(plotBuf,'(A,I,I,I,I)') pltLab, + WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab, & pltBase-1+(bk-1)*pltStep+K CALL PRINT_MESSAGE(plotBuf, standardMessageUnit, & SQUEEZE_RIGHT, 1) @@ -841,9 +1306,13 @@ ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN val = fld(K,I,J,bk,bi) ENDIF - IDX = NINT( - & FLOAT( lChList-1 )*( val-fMin ) / (fRange) - & )+1 + IF ( validRange .AND. val .NE. 0. ) THEN + IDX = NINT( + & FLOAT( lChList-1 )*( val-fMin ) / (fRange) + & )+1 + ELSE + IDX = 1 + ENDIF IF ( iBuf .LE. MAX_LEN_PLOTBUF ) & plotBuf(iBuf:iBuf) = chList(IDX:IDX) IF ( val .EQ. 0. ) THEN @@ -860,13 +1329,16 @@ ENDDO ENDIF C-- Write delimiter - msgBuf = '// =======================================================' + msgBuf = + & '// =======================================================' CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, & SQUEEZE_RIGHT, 1) - msgBuf = '// END OF FIELD =' + msgBuf = + & '// END OF FIELD =' CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, & SQUEEZE_RIGHT, 1) - msgBuf = '// =======================================================' + msgBuf = + & '// =======================================================' CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, & SQUEEZE_RIGHT, 1) msgBuf = ' ' @@ -876,43 +1348,58 @@ RETURN END -CStartOfInterface +CBOP +C !ROUTINE: PRINT_MESSAGE + +C !INTERFACE: SUBROUTINE PRINT_MESSAGE( message, unit, sq , myThid ) -C /============================================================\ -C | SUBROUTINE PRINT_MESSAGE | -C | o Write out informational message using "standard" format. | -C | Notes | -C | ===== | -C | o Some system's I/O is not "thread-safe". For this reason | -C | without the FMTFTN_IO_THREAD_SAFE directive set a | -C | critical region is defined around the write here. In some| -C | cases BEGIN_CRIT() is approximated by only doing writes | -C | for thread number 1 - writes for other threads are | -C | ignored! | -C | o In a non-parallel form these routines can still be used. | -C | to produce pretty printed output! | -C \============================================================/ + IMPLICIT NONE +C !DESCRIPTION: +C *============================================================* +C | SUBROUTINE PRINT\_MESSAGE +C | o Write out informational message using "standard" format. +C *============================================================* +C | Notes +C | ===== +C | o Some system I/O is not "thread-safe". For this reason +C | without the FMTFTN\_IO\_THREAD\_SAFE directive set a +C | critical region is defined around the write here. In some +C | cases BEGIN\_CRIT() is approximated by only doing writes +C | for thread number 1 - writes for other threads are +C | ignored! +C | o In a non-parallel form these routines can still be used. +C | to produce pretty printed output! +C *============================================================* + +C !USES: C == Global data == #include "SIZE.h" #include "EEPARAMS.h" #include "EESUPPORT.h" + INTEGER IFNBLNK + EXTERNAL IFNBLNK + INTEGER ILNBLNK + EXTERNAL ILNBLNK + +C !INPUT/OUTPUT PARAMETERS: C == Routine arguments == -C message - Message to write -C unit - Unit number to write to -C sq - Justification option +C message :: Message to write +C unit :: Unit number to write to +C sq :: Justification option CHARACTER*(*) message INTEGER unit CHARACTER*(*) sq INTEGER myThid -CEndOfInterface - INTEGER IFNBLNK - EXTERNAL IFNBLNK - INTEGER ILNBLNK - EXTERNAL ILNBLNK + +C !LOCAL VARIABLES: C == Local variables == +C iStart, iEnd :: String indexing variables +C idString :: Temp. for building prefix. INTEGER iStart INTEGER iEnd CHARACTER*9 idString +CEOP + C-- Find beginning and end of message IF ( sq .EQ. SQUEEZE_BOTH .OR. & sq .EQ. SQUEEZE_LEFT ) THEN @@ -950,7 +1437,7 @@ #ifndef FMTFTN_IO_THREAD_SAFE _BEGIN_CRIT(myThid) #endif - WRITE(unit,'(A,A,A,A,A,A)') + WRITE(unit,'(A,A,A,A,A,A)',ERR=999) & '(',PROCESS_HEADER,' ',idString,')',' ' #ifndef FMTFTN_IO_THREAD_SAFE _END_CRIT(myThid) @@ -959,7 +1446,7 @@ #ifndef FMTFTN_IO_THREAD_SAFE _BEGIN_CRIT(myThid) #endif - WRITE(unit,'(A,A,A,A,A,A,A)') + WRITE(unit,'(A,A,A,A,A,A,A)',ERR=999) & '(',PROCESS_HEADER,' ',idString(1:ILNBLNK(idString)),')',' ', & message(iStart:iEnd) #ifndef FMTFTN_IO_THREAD_SAFE @@ -967,6 +1454,20 @@ #endif ENDIF ENDIF + +#ifndef DISABLE_WRITE_TO_UNIT_ZERO +C-- if error message, also write directly to unit 0 : + IF ( numberOfProcs .EQ. 1 .AND. nThreads .EQ. 1 + & .AND. unit.EQ.errorMessageUnit ) THEN + iEnd = ILNBLNK( message ) + IF (iEnd.NE.0) WRITE(0,'(A)') message(1:iEnd) + ENDIF +#endif C + 1000 CONTINUE RETURN + 999 CONTINUE + ioErrorCount(myThid) = ioErrorCount(myThid)+1 + GOTO 1000 + END