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 | |
60 |
IF ( message .EQ. ' ' ) THEN |
IF ( message .EQ. ' ' ) THEN |
61 |
WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' ' |
WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' ' |
62 |
ELSE |
ELSE |
63 |
WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, message(iStart:iEnd) |
WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, |
64 |
|
& message(iStart:iEnd) |
65 |
ENDIF |
ENDIF |
66 |
ELSEIF ( pidIO .EQ. myProcId ) THEN |
ELSEIF ( pidIO .EQ. myProcId ) THEN |
67 |
C-- Write multi-process format |
C-- Write multi-process format |
106 |
END |
END |
107 |
|
|
108 |
CStartofinterface |
CStartofinterface |
109 |
SUBROUTINE PRINT_LIST_I( fld, lFld, index_type, markEnd, compact, ioUnit ) |
SUBROUTINE PRINT_LIST_I( fld, lFld, index_type, |
110 |
|
& markEnd, compact, ioUnit ) |
111 |
C /==========================================================\ |
C /==========================================================\ |
112 |
C | o SUBROUTINE PRINT_LIST_I | |
C | o SUBROUTINE PRINT_LIST_I | |
113 |
C |==========================================================| |
C |==========================================================| |
183 |
IF ( nDup .EQ. 1 ) THEN |
IF ( nDup .EQ. 1 ) THEN |
184 |
WRITE(msgBuf,'(A,I9,A)') ' ',xOld,punc |
WRITE(msgBuf,'(A,I9,A)') ' ',xOld,punc |
185 |
IF ( index_type .NE. INDEX_NONE ) |
IF ( index_type .NE. INDEX_NONE ) |
186 |
& WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose |
& WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') |
187 |
|
& commOpen,index_lab,iLo,commClose |
188 |
ELSE |
ELSE |
189 |
WRITE(msgBuf,'(I,'' '',A,I9,A)') nDup,'@',xOld,punc |
WRITE(msgBuf,'(I,'' '',A,I9,A)') nDup,'@',xOld,punc |
190 |
IF ( index_type .NE. INDEX_NONE ) |
IF ( index_type .NE. INDEX_NONE ) |
205 |
IF ( nDup .EQ. 1 ) THEN |
IF ( nDup .EQ. 1 ) THEN |
206 |
WRITE(msgBuf,'(A,I9,A)') ' ',xOld,punc |
WRITE(msgBuf,'(A,I9,A)') ' ',xOld,punc |
207 |
IF ( index_type .NE. INDEX_NONE ) |
IF ( index_type .NE. INDEX_NONE ) |
208 |
& WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose |
& WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') |
209 |
|
& commOpen,index_lab,iLo,commClose |
210 |
ELSEIF( nDup .GT. 1 ) THEN |
ELSEIF( nDup .GT. 1 ) THEN |
211 |
WRITE(msgBuf,'(I,'' '',A,I9,A)') nDup,'@',xOld,punc |
WRITE(msgBuf,'(I,'' '',A,I9,A)') nDup,'@',xOld,punc |
212 |
IF ( index_type .NE. INDEX_NONE ) |
IF ( index_type .NE. INDEX_NONE ) |
219 |
END |
END |
220 |
|
|
221 |
CStartofinterface |
CStartofinterface |
222 |
SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, markEnd, compact, ioUnit ) |
SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, markEnd, |
223 |
|
& compact, ioUnit ) |
224 |
C /==========================================================\ |
C /==========================================================\ |
225 |
C | o SUBROUTINE PRINT_LIST_L | |
C | o SUBROUTINE PRINT_LIST_L | |
226 |
C |==========================================================| |
C |==========================================================| |
291 |
xOld = fld(1) |
xOld = fld(1) |
292 |
DO K=2,lFld |
DO K=2,lFld |
293 |
xNew = fld(K ) |
xNew = fld(K ) |
294 |
IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN |
IF ( .NOT. compact .OR. xNew .NEQV. xOld ) THEN |
295 |
nDup = iHi-iLo+1 |
nDup = iHi-iLo+1 |
296 |
IF ( nDup .EQ. 1 ) THEN |
IF ( nDup .EQ. 1 ) THEN |
297 |
WRITE(msgBuf,'(A,L5,A)') ' ',xOld,punc |
WRITE(msgBuf,'(A,L5,A)') ' ',xOld,punc |
298 |
IF ( index_type .NE. INDEX_NONE ) |
IF ( index_type .NE. INDEX_NONE ) |
299 |
& WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose |
& WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') |
300 |
|
& commOpen,index_lab,iLo,commClose |
301 |
ELSE |
ELSE |
302 |
WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc |
WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc |
303 |
IF ( index_type .NE. INDEX_NONE ) |
IF ( index_type .NE. INDEX_NONE ) |
318 |
IF ( nDup .EQ. 1 ) THEN |
IF ( nDup .EQ. 1 ) THEN |
319 |
WRITE(msgBuf,'(A,L5,A)') ' ',xOld,punc |
WRITE(msgBuf,'(A,L5,A)') ' ',xOld,punc |
320 |
IF ( index_type .NE. INDEX_NONE ) |
IF ( index_type .NE. INDEX_NONE ) |
321 |
& WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose |
& WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') |
322 |
|
& commOpen,index_lab,iLo,commClose |
323 |
ELSEIF( nDup .GT. 1 ) THEN |
ELSEIF( nDup .GT. 1 ) THEN |
324 |
WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc |
WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc |
325 |
IF ( index_type .NE. INDEX_NONE ) |
IF ( index_type .NE. INDEX_NONE ) |
332 |
END |
END |
333 |
|
|
334 |
CStartofinterface |
CStartofinterface |
335 |
SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type, markEnd, compact, ioUnit ) |
SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type, |
336 |
|
& markEnd, compact, ioUnit ) |
337 |
C /==========================================================\ |
C /==========================================================\ |
338 |
C | o SUBROUTINE PRINT_LIST_R8 | |
C | o SUBROUTINE PRINT_LIST_R8 | |
339 |
C |==========================================================| |
C |==========================================================| |
409 |
IF ( nDup .EQ. 1 ) THEN |
IF ( nDup .EQ. 1 ) THEN |
410 |
WRITE(msgBuf,'(A,1PE23.15,A)') ' ',xOld,punc |
WRITE(msgBuf,'(A,1PE23.15,A)') ' ',xOld,punc |
411 |
IF ( index_type .NE. INDEX_NONE ) |
IF ( index_type .NE. INDEX_NONE ) |
412 |
& WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose |
& WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') |
413 |
|
& commOpen,index_lab,iLo,commClose |
414 |
ELSE |
ELSE |
415 |
WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc |
WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc |
416 |
IF ( index_type .NE. INDEX_NONE ) |
IF ( index_type .NE. INDEX_NONE ) |
417 |
& WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)') |
& WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)') |
418 |
& commOpen,index_lab,iLo,':',iHi,commClose |
& commOpen,index_lab,iLo,':',iHi,commClose |
419 |
ENDIF |
ENDIF |
420 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1) |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
421 |
|
& SQUEEZE_RIGHT , 1) |
422 |
iLo = K |
iLo = K |
423 |
iHi = K |
iHi = K |
424 |
xOld = xNew |
xOld = xNew |
432 |
IF ( nDup .EQ. 1 ) THEN |
IF ( nDup .EQ. 1 ) THEN |
433 |
WRITE(msgBuf,'(A,1PE23.15,A)') ' ',xOld,punc |
WRITE(msgBuf,'(A,1PE23.15,A)') ' ',xOld,punc |
434 |
IF ( index_type .NE. INDEX_NONE ) |
IF ( index_type .NE. INDEX_NONE ) |
435 |
& WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose |
& WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') |
436 |
|
& commOpen,index_lab,iLo,commClose |
437 |
ELSEIF( nDup .GT. 1 ) THEN |
ELSEIF( nDup .GT. 1 ) THEN |
438 |
WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc |
WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc |
439 |
IF ( index_type .NE. INDEX_NONE ) |
IF ( index_type .NE. INDEX_NONE ) |
440 |
& WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)') |
& WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)') |
441 |
& commOpen,index_lab,iLo,':',iHi,commClose |
& commOpen,index_lab,iLo,':',iHi,commClose |
442 |
ENDIF |
ENDIF |
443 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1) |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
444 |
|
& SQUEEZE_RIGHT , 1) |
445 |
|
|
446 |
RETURN |
RETURN |
447 |
END |
END |
593 |
ENDIF |
ENDIF |
594 |
|
|
595 |
C-- Write field title and statistics |
C-- Write field title and statistics |
596 |
msgBuf = '// =======================================================' |
msgBuf = |
597 |
|
& '// =======================================================' |
598 |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
599 |
& SQUEEZE_RIGHT, 1) |
& SQUEEZE_RIGHT, 1) |
600 |
iStrngLo = IFNBLNK(fldTitle) |
iStrngLo = IFNBLNK(fldTitle) |
652 |
& ':',kStr,')' |
& ':',kStr,')' |
653 |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
654 |
& SQUEEZE_RIGHT, 1) |
& SQUEEZE_RIGHT, 1) |
655 |
msgBuf = '// =======================================================' |
msgBuf = |
656 |
|
& '// =======================================================' |
657 |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
658 |
& SQUEEZE_RIGHT, 1) |
& SQUEEZE_RIGHT, 1) |
659 |
|
|
754 |
C Data |
C Data |
755 |
DO bk=pltBlo, pltBhi, pltBstr |
DO bk=pltBlo, pltBhi, pltBstr |
756 |
DO K=pltMin,pltMax,pltStr |
DO K=pltMin,pltMax,pltStr |
757 |
WRITE(plotBuf,'(A,I,I,I,I)') pltLab, |
WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab, |
758 |
& pltBase-1+(bk-1)*pltStep+K |
& pltBase-1+(bk-1)*pltStep+K |
759 |
CALL PRINT_MESSAGE(plotBuf, standardMessageUnit, |
CALL PRINT_MESSAGE(plotBuf, standardMessageUnit, |
760 |
& SQUEEZE_RIGHT, 1) |
& SQUEEZE_RIGHT, 1) |
835 |
ENDDO |
ENDDO |
836 |
C ENDIF |
C ENDIF |
837 |
C-- Write delimiter |
C-- Write delimiter |
838 |
msgBuf = '// =======================================================' |
msgBuf = |
839 |
|
& '// =======================================================' |
840 |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
841 |
& SQUEEZE_RIGHT, 1) |
& SQUEEZE_RIGHT, 1) |
842 |
msgBuf = '// END OF FIELD =' |
msgBuf = |
843 |
|
& '// END OF FIELD =' |
844 |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
845 |
& SQUEEZE_RIGHT, 1) |
& SQUEEZE_RIGHT, 1) |
846 |
msgBuf = '// =======================================================' |
msgBuf = |
847 |
|
& '// =======================================================' |
848 |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
849 |
& SQUEEZE_RIGHT, 1) |
& SQUEEZE_RIGHT, 1) |
850 |
msgBuf = ' ' |
msgBuf = ' ' |
984 |
DO K=kMin, kMax, kStr |
DO K=kMin, kMax, kStr |
985 |
DO J=jMin, jMax, jStr |
DO J=jMin, jMax, jStr |
986 |
DO I=iMin, iMax, iStr |
DO I=iMin, iMax, iStr |
987 |
IF ( printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0. ) THEN |
IF ( printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0. ) |
988 |
|
& THEN |
989 |
IF ( fld(I,J,K,bi,bj) .LT. fMin ) |
IF ( fld(I,J,K,bi,bj) .LT. fMin ) |
990 |
& fMin = fld(I,J,K,bi,bj) |
& fMin = fld(I,J,K,bi,bj) |
991 |
IF ( fld(I,J,K,bi,bj) .GT. fMax ) |
IF ( fld(I,J,K,bi,bj) .GT. fMax ) |
1002 |
ENDIF |
ENDIF |
1003 |
|
|
1004 |
C-- Write field title and statistics |
C-- Write field title and statistics |
1005 |
msgBuf = '// =======================================================' |
msgBuf = |
1006 |
|
& '// =======================================================' |
1007 |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
1008 |
& SQUEEZE_RIGHT, 1) |
& SQUEEZE_RIGHT, 1) |
1009 |
iStrngLo = IFNBLNK(fldTitle) |
iStrngLo = IFNBLNK(fldTitle) |
1061 |
& ':',kStr,')' |
& ':',kStr,')' |
1062 |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
1063 |
& SQUEEZE_RIGHT, 1) |
& SQUEEZE_RIGHT, 1) |
1064 |
msgBuf = '// =======================================================' |
msgBuf = |
1065 |
|
& '// =======================================================' |
1066 |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
1067 |
& SQUEEZE_RIGHT, 1) |
& SQUEEZE_RIGHT, 1) |
1068 |
|
|
1163 |
C Data |
C Data |
1164 |
DO bk=pltBlo, pltBhi, pltBstr |
DO bk=pltBlo, pltBhi, pltBstr |
1165 |
DO K=pltMin,pltMax,pltStr |
DO K=pltMin,pltMax,pltStr |
1166 |
WRITE(plotBuf,'(A,I,I,I,I)') pltLab, |
WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab, |
1167 |
& pltBase-1+(bk-1)*pltStep+K |
& pltBase-1+(bk-1)*pltStep+K |
1168 |
CALL PRINT_MESSAGE(plotBuf, standardMessageUnit, |
CALL PRINT_MESSAGE(plotBuf, standardMessageUnit, |
1169 |
& SQUEEZE_RIGHT, 1) |
& SQUEEZE_RIGHT, 1) |
1241 |
ENDDO |
ENDDO |
1242 |
C ENDIF |
C ENDIF |
1243 |
C-- Write delimiter |
C-- Write delimiter |
1244 |
msgBuf = '// =======================================================' |
msgBuf = |
1245 |
|
& '// =======================================================' |
1246 |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
1247 |
& SQUEEZE_RIGHT, 1) |
& SQUEEZE_RIGHT, 1) |
1248 |
msgBuf = '// END OF FIELD =' |
msgBuf = |
1249 |
|
& '// END OF FIELD =' |
1250 |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
1251 |
& SQUEEZE_RIGHT, 1) |
& SQUEEZE_RIGHT, 1) |
1252 |
msgBuf = '// =======================================================' |
msgBuf = |
1253 |
|
& '// =======================================================' |
1254 |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
1255 |
& SQUEEZE_RIGHT, 1) |
& SQUEEZE_RIGHT, 1) |
1256 |
msgBuf = ' ' |
msgBuf = ' ' |
1267 |
C | o Write out informational message using "standard" format. | |
C | o Write out informational message using "standard" format. | |
1268 |
C | Notes | |
C | Notes | |
1269 |
C | ===== | |
C | ===== | |
1270 |
C | o Some system's I/O is not "thread-safe". For this reason | |
C | o Some system I/O is not "thread-safe". For this reason | |
1271 |
C | without the FMTFTN_IO_THREAD_SAFE directive set a | |
C | without the FMTFTN_IO_THREAD_SAFE directive set a | |
1272 |
C | critical region is defined around the write here. In some| |
C | critical region is defined around the write here. In some| |
1273 |
C | cases BEGIN_CRIT() is approximated by only doing writes | |
C | cases BEGIN_CRIT() is approximated by only doing writes | |