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 |
78 |
#ifndef FMTFTN_IO_THREAD_SAFE |
#ifndef FMTFTN_IO_THREAD_SAFE |
79 |
_BEGIN_CRIT(myThid) |
_BEGIN_CRIT(myThid) |
80 |
#endif |
#endif |
81 |
WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)') |
WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999) |
82 |
& '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ', |
& '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ', |
83 |
& ' ' |
& ' ' |
84 |
#ifndef FMTFTN_IO_THREAD_SAFE |
#ifndef FMTFTN_IO_THREAD_SAFE |
88 |
#ifndef FMTFTN_IO_THREAD_SAFE |
#ifndef FMTFTN_IO_THREAD_SAFE |
89 |
_BEGIN_CRIT(myThid) |
_BEGIN_CRIT(myThid) |
90 |
#endif |
#endif |
91 |
WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)') |
WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999) |
92 |
& '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ', |
& '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ', |
93 |
& message(iStart:iEnd) |
& message(iStart:iEnd) |
94 |
#ifndef FMTFTN_IO_THREAD_SAFE |
#ifndef FMTFTN_IO_THREAD_SAFE |
97 |
ENDIF |
ENDIF |
98 |
ENDIF |
ENDIF |
99 |
C |
C |
100 |
|
1000 CONTINUE |
101 |
RETURN |
RETURN |
102 |
|
|
103 |
|
999 CONTINUE |
104 |
|
ioErrorCount(myThid) = ioErrorCount(myThid)+1 |
105 |
|
GOTO 1000 |
106 |
END |
END |
107 |
|
|
108 |
CStartofinterface |
CStartofinterface |
109 |
SUBROUTINE PRINT_LIST_I( fld, lFld, index_type, 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 |==========================================================| |
129 |
C INDEX_I => /* I = nnn */ |
C INDEX_I => /* I = nnn */ |
130 |
C INDEX_J => /* J = nnn */ |
C INDEX_J => /* J = nnn */ |
131 |
C INDEX_NONE => |
C INDEX_NONE => |
132 |
|
C compact - Flag to control use of repeat symbol for same valued |
133 |
|
C fields. |
134 |
|
C markEnd - Flag to control whether there is a separator after the |
135 |
|
C last element |
136 |
C ioUnit - Unit number for IO. |
C ioUnit - Unit number for IO. |
137 |
INTEGER lFld |
INTEGER lFld |
138 |
INTEGER index_type |
INTEGER index_type |
139 |
INTEGER fld(lFld) |
INTEGER fld(lFld) |
140 |
|
LOGICAL markEnd |
141 |
|
LOGICAL compact |
142 |
INTEGER ioUnit |
INTEGER ioUnit |
143 |
CEndifinterface |
CEndifinterface |
144 |
|
|
156 |
INTEGER nDup |
INTEGER nDup |
157 |
INTEGER xNew, xOld |
INTEGER xNew, xOld |
158 |
CHARACTER punc |
CHARACTER punc |
159 |
CHARACTER(MAX_LEN_MBUF) msgBuf |
CHARACTER*(MAX_LEN_MBUF) msgBuf |
160 |
CHARACTER*2 commOpen,commClose |
CHARACTER*2 commOpen,commClose |
161 |
CHARACTER*3 index_lab |
CHARACTER*3 index_lab |
162 |
INTEGER K |
INTEGER K |
178 |
xOld = fld(1) |
xOld = fld(1) |
179 |
DO K=2,lFld |
DO K=2,lFld |
180 |
xNew = fld(K ) |
xNew = fld(K ) |
181 |
IF ( xNew .NE. xOld ) THEN |
IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN |
182 |
nDup = iHi-iLo+1 |
nDup = iHi-iLo+1 |
183 |
IF ( nDup .EQ. 1 ) THEN |
IF ( nDup .EQ. 1 ) THEN |
184 |
WRITE(msgBuf,'(A,I5,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,I5,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 ) |
191 |
& WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)') |
& WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)') |
192 |
& commOpen,index_lab,iLo,':',iHi,commClose |
& commOpen,index_lab,iLo,':',iHi,commClose |
193 |
ENDIF |
ENDIF |
194 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1) |
CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1) |
195 |
iLo = K |
iLo = K |
196 |
iHi = K |
iHi = K |
197 |
xOld = xNew |
xOld = xNew |
200 |
ENDIF |
ENDIF |
201 |
ENDDO |
ENDDO |
202 |
punc = ' ' |
punc = ' ' |
203 |
|
IF ( markEnd ) punc = ',' |
204 |
nDup = iHi-iLo+1 |
nDup = iHi-iLo+1 |
205 |
IF ( nDup .EQ. 1 ) THEN |
IF ( nDup .EQ. 1 ) THEN |
206 |
WRITE(msgBuf,'(A,I5,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,I5,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 ) |
213 |
& WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)') |
& WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)') |
214 |
& commOpen,index_lab,iLo,':',iHi,commClose |
& commOpen,index_lab,iLo,':',iHi,commClose |
215 |
ENDIF |
ENDIF |
216 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1) |
CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1) |
217 |
|
|
218 |
RETURN |
RETURN |
219 |
END |
END |
220 |
|
|
221 |
CStartofinterface |
CStartofinterface |
222 |
SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, 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 |==========================================================| |
242 |
C INDEX_I => /* I = nnn */ |
C INDEX_I => /* I = nnn */ |
243 |
C INDEX_J => /* J = nnn */ |
C INDEX_J => /* J = nnn */ |
244 |
C INDEX_NONE => |
C INDEX_NONE => |
245 |
|
C compact - Flag to control use of repeat symbol for same valued |
246 |
|
C fields. |
247 |
|
C markEnd - Flag to control whether there is a separator after the |
248 |
|
C last element |
249 |
C ioUnit - Unit number for IO. |
C ioUnit - Unit number for IO. |
250 |
INTEGER lFld |
INTEGER lFld |
251 |
INTEGER index_type |
INTEGER index_type |
252 |
LOGICAL fld(lFld) |
LOGICAL fld(lFld) |
253 |
|
LOGICAL markEnd |
254 |
|
LOGICAL compact |
255 |
INTEGER ioUnit |
INTEGER ioUnit |
256 |
CEndifinterface |
CEndifinterface |
257 |
|
|
269 |
INTEGER nDup |
INTEGER nDup |
270 |
LOGICAL xNew, xOld |
LOGICAL xNew, xOld |
271 |
CHARACTER punc |
CHARACTER punc |
272 |
CHARACTER(MAX_LEN_MBUF) msgBuf |
CHARACTER*(MAX_LEN_MBUF) msgBuf |
273 |
CHARACTER*2 commOpen,commClose |
CHARACTER*2 commOpen,commClose |
274 |
CHARACTER*3 index_lab |
CHARACTER*3 index_lab |
275 |
INTEGER K |
INTEGER K |
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 ( 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 ) |
304 |
& WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)') |
& WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)') |
305 |
& commOpen,index_lab,iLo,':',iHi,commClose |
& commOpen,index_lab,iLo,':',iHi,commClose |
306 |
ENDIF |
ENDIF |
307 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1) |
CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1) |
308 |
iLo = K |
iLo = K |
309 |
iHi = K |
iHi = K |
310 |
xOld = xNew |
xOld = xNew |
313 |
ENDIF |
ENDIF |
314 |
ENDDO |
ENDDO |
315 |
punc = ' ' |
punc = ' ' |
316 |
|
IF ( markEnd ) punc = ',' |
317 |
nDup = iHi-iLo+1 |
nDup = iHi-iLo+1 |
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 ) |
326 |
& WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)') |
& WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)') |
327 |
& commOpen,index_lab,iLo,':',iHi,commClose |
& commOpen,index_lab,iLo,':',iHi,commClose |
328 |
ENDIF |
ENDIF |
329 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1) |
CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1) |
330 |
|
|
331 |
RETURN |
RETURN |
332 |
END |
END |
333 |
|
|
334 |
CStartofinterface |
CStartofinterface |
335 |
SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type, 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 |==========================================================| |
355 |
C INDEX_I => /* I = nnn */ |
C INDEX_I => /* I = nnn */ |
356 |
C INDEX_J => /* J = nnn */ |
C INDEX_J => /* J = nnn */ |
357 |
C INDEX_NONE => |
C INDEX_NONE => |
358 |
|
C compact - Flag to control use of repeat symbol for same valued |
359 |
|
C fields. |
360 |
|
C markEnd - Flag to control whether there is a separator after the |
361 |
|
C last element |
362 |
C ioUnit - Unit number for IO. |
C ioUnit - Unit number for IO. |
363 |
INTEGER lFld |
INTEGER lFld |
364 |
INTEGER index_type |
INTEGER index_type |
365 |
Real*8 fld(lFld) |
Real*8 fld(lFld) |
366 |
|
LOGICAL markEnd |
367 |
|
LOGICAL compact |
368 |
INTEGER ioUnit |
INTEGER ioUnit |
369 |
CEndifinterface |
CEndifinterface |
370 |
|
|
382 |
INTEGER nDup |
INTEGER nDup |
383 |
Real*8 xNew, xOld |
Real*8 xNew, xOld |
384 |
CHARACTER punc |
CHARACTER punc |
385 |
CHARACTER(MAX_LEN_MBUF) msgBuf |
CHARACTER*(MAX_LEN_MBUF) msgBuf |
386 |
CHARACTER*2 commOpen,commClose |
CHARACTER*2 commOpen,commClose |
387 |
CHARACTER*3 index_lab |
CHARACTER*3 index_lab |
388 |
INTEGER K |
INTEGER K |
404 |
xOld = fld(1) |
xOld = fld(1) |
405 |
DO K=2,lFld |
DO K=2,lFld |
406 |
xNew = fld(K ) |
xNew = fld(K ) |
407 |
IF ( xNew .NE. xOld ) THEN |
IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN |
408 |
nDup = iHi-iLo+1 |
nDup = iHi-iLo+1 |
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 |
427 |
ENDIF |
ENDIF |
428 |
ENDDO |
ENDDO |
429 |
punc = ' ' |
punc = ' ' |
430 |
|
IF ( markEnd ) punc = ',' |
431 |
nDup = iHi-iLo+1 |
nDup = iHi-iLo+1 |
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 |
448 |
|
|
449 |
CStartOfInterface |
CStartOfInterface |
450 |
SUBROUTINE PRINT_MAPR4 ( fld, fldTitle, plotMode, |
SUBROUTINE PRINT_MAPRS ( fld, fldTitle, plotMode, |
451 |
I iLo, iHi, jLo, jHi, kLo, kHi, nBx, nBy, |
I iLo, iHi, jLo, jHi, kLo, kHi, nBx, nBy, |
452 |
I iMin, iMax, iStr, |
I iMin, iMax, iStr, |
453 |
I jMin, jMax, jStr, |
I jMin, jMax, jStr, |
502 |
INTEGER jLo, jHi |
INTEGER jLo, jHi |
503 |
INTEGER kLo, kHi |
INTEGER kLo, kHi |
504 |
INTEGER nBx, nBy |
INTEGER nBx, nBy |
505 |
Real*4 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy) |
_RS fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy) |
506 |
INTEGER iMin, iMax, iStr |
INTEGER iMin, iMax, iStr |
507 |
INTEGER jMin, jMax, jStr |
INTEGER jMin, jMax, jStr |
508 |
INTEGER kMin, kMax, kStr |
INTEGER kMin, kMax, kStr |
544 |
INTEGER lChList |
INTEGER lChList |
545 |
PARAMETER ( lChList = 28 ) |
PARAMETER ( lChList = 28 ) |
546 |
CHARACTER*(lChList) chList |
CHARACTER*(lChList) chList |
547 |
REAL fMin |
_RL fMin |
548 |
REAL fMax |
_RL fMax |
549 |
REAL fRange |
_RL fRange |
550 |
REAL val |
_RL val |
551 |
REAL small |
_RL small |
552 |
CHARACTER*2 accLab |
CHARACTER*2 accLab |
553 |
CHARACTER*7 dwnLab |
CHARACTER*7 dwnLab |
554 |
CHARACTER*3 pltLab |
CHARACTER*3 pltLab |
565 |
LOGICAL validRange |
LOGICAL validRange |
566 |
|
|
567 |
chList = '-abcdefghijklmnopqrstuvwxyz+' |
chList = '-abcdefghijklmnopqrstuvwxyz+' |
568 |
small = 1. _d -15 |
small = 1. _d -15 |
569 |
fMin = 1. _d 32 |
fMin = 1. _d 32 |
570 |
fMax = -1. _d 32 |
fMax = -1. _d 32 |
571 |
validRange = .FALSE. |
validRange = .FALSE. |
572 |
|
|
573 |
C-- Calculate field range |
C-- Calculate field range |
576 |
DO K=kMin, kMax, kStr |
DO K=kMin, kMax, kStr |
577 |
DO J=jMin, jMax, jStr |
DO J=jMin, jMax, jStr |
578 |
DO I=iMin, iMax, iStr |
DO I=iMin, iMax, iStr |
579 |
IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN |
IF (printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0.) THEN |
580 |
IF ( fld(I,J,K,bi,bj) .LT. fMin ) |
IF ( fld(I,J,K,bi,bj) .LT. fMin ) |
581 |
& fMin = fld(I,J,K,bi,bj) |
& fMin = fld(I,J,K,bi,bj) |
582 |
IF ( fld(I,J,K,bi,bj) .GT. fMax ) |
IF ( fld(I,J,K,bi,bj) .GT. fMax ) |
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) |
614 |
& '// CMAX = ', fMax |
& '// CMAX = ', fMax |
615 |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
616 |
& SQUEEZE_RIGHT, 1) |
& SQUEEZE_RIGHT, 1) |
617 |
WRITE(msgBuf,'(A,1PE30.15)') |
IF ( validRange ) THEN |
618 |
& '// CINT = ', fRange/FLOAT(lChlist-1) |
WRITE(msgBuf,'(A,1PE30.15)') |
619 |
|
& '// CINT = ', fRange/FLOAT(lChlist-1) |
620 |
|
ELSE |
621 |
|
WRITE(msgBuf,'(A,1PE30.15)') |
622 |
|
& '// CINT = ', 0. |
623 |
|
ENDIF |
624 |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
625 |
& SQUEEZE_RIGHT, 1) |
& SQUEEZE_RIGHT, 1) |
626 |
WRITE(msgBuf,'(A,1024A1)') |
WRITE(msgBuf,'(A,1024A1)') |
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 |
|
|
749 |
pltStep = sNy |
pltStep = sNy |
750 |
pltLab = 'J =' |
pltLab = 'J =' |
751 |
ENDIF |
ENDIF |
752 |
IF ( validRange ) THEN |
C IF ( validRange ) THEN |
753 |
C Header |
C Header |
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) |
811 |
ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN |
ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN |
812 |
val = fld(K,I,J,bk,bi) |
val = fld(K,I,J,bk,bi) |
813 |
ENDIF |
ENDIF |
814 |
IDX = NINT( |
IF ( validRange .AND. val .NE. 0. ) THEN |
815 |
|
IDX = NINT( |
816 |
& FLOAT( lChList-1 )*( val-fMin ) / (fRange) |
& FLOAT( lChList-1 )*( val-fMin ) / (fRange) |
817 |
& )+1 |
& )+1 |
818 |
|
ELSE |
819 |
|
IDX = 1 |
820 |
|
ENDIF |
821 |
IF ( iBuf .LE. MAX_LEN_PLOTBUF ) |
IF ( iBuf .LE. MAX_LEN_PLOTBUF ) |
822 |
& plotBuf(iBuf:iBuf) = chList(IDX:IDX) |
& plotBuf(iBuf:iBuf) = chList(IDX:IDX) |
823 |
IF ( val .EQ. 0. ) THEN |
IF ( val .EQ. 0. ) THEN |
833 |
ENDDO |
ENDDO |
834 |
ENDDO |
ENDDO |
835 |
ENDDO |
ENDDO |
836 |
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 = ' ' |
855 |
END |
END |
856 |
|
|
857 |
CStartOfInterface |
CStartOfInterface |
858 |
SUBROUTINE PRINT_MAPR8 ( fld, fldTitle, plotMode, |
SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode, |
859 |
I iLo, iHi, jLo, jHi, kLo, kHi, nBx, nBy, |
I iLo, iHi, jLo, jHi, kLo, kHi, nBx, nBy, |
860 |
I iMin, iMax, iStr, |
I iMin, iMax, iStr, |
861 |
I jMin, jMax, jStr, |
I jMin, jMax, jStr, |
863 |
I bxMin, bxMax, bxStr, |
I bxMin, bxMax, bxStr, |
864 |
I byMin, byMax, byStr ) |
I byMin, byMax, byStr ) |
865 |
C /==========================================================\ |
C /==========================================================\ |
866 |
C | SUBROUTINE PRINT_MAPR8 | |
C | SUBROUTINE PRINT_MAPRL | |
867 |
C | o Does textual mapping printing of a field. | |
C | o Does textual mapping printing of a field. | |
868 |
C |==========================================================| |
C |==========================================================| |
869 |
C | This routine does the actual formatting of the data | |
C | This routine does the actual formatting of the data | |
910 |
INTEGER jLo, jHi |
INTEGER jLo, jHi |
911 |
INTEGER kLo, kHi |
INTEGER kLo, kHi |
912 |
INTEGER nBx, nBy |
INTEGER nBx, nBy |
913 |
Real*8 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy) |
_RL fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy) |
914 |
INTEGER iMin, iMax, iStr |
INTEGER iMin, iMax, iStr |
915 |
INTEGER jMin, jMax, jStr |
INTEGER jMin, jMax, jStr |
916 |
INTEGER kMin, kMax, kStr |
INTEGER kMin, kMax, kStr |
952 |
INTEGER lChList |
INTEGER lChList |
953 |
PARAMETER ( lChList = 28 ) |
PARAMETER ( lChList = 28 ) |
954 |
CHARACTER*(lChList) chList |
CHARACTER*(lChList) chList |
955 |
REAL fMin |
_RL fMin |
956 |
REAL fMax |
_RL fMax |
957 |
REAL fRange |
_RL fRange |
958 |
REAL val |
_RL val |
959 |
REAL small |
_RL small |
960 |
CHARACTER*2 accLab |
CHARACTER*2 accLab |
961 |
CHARACTER*7 dwnLab |
CHARACTER*7 dwnLab |
962 |
CHARACTER*3 pltLab |
CHARACTER*3 pltLab |
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 |
C IF ( 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 ) |
992 |
& fMax = fld(I,J,K,bi,bj) |
& fMax = fld(I,J,K,bi,bj) |
993 |
C ENDIF |
ENDIF |
994 |
ENDDO |
ENDDO |
995 |
ENDDO |
ENDDO |
996 |
ENDDO |
ENDDO |
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) |
1023 |
& '// CMAX = ', fMax |
& '// CMAX = ', fMax |
1024 |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
1025 |
& SQUEEZE_RIGHT, 1) |
& SQUEEZE_RIGHT, 1) |
1026 |
WRITE(msgBuf,'(A,1PE30.15)') |
IF ( validRange ) THEN |
1027 |
|
WRITE(msgBuf,'(A,1PE30.15)') |
1028 |
& '// CINT = ', fRange/FLOAT(lChlist-1) |
& '// CINT = ', fRange/FLOAT(lChlist-1) |
1029 |
|
ELSE |
1030 |
|
WRITE(msgBuf,'(A,1PE30.15)') |
1031 |
|
& '// CINT = ', 0. |
1032 |
|
ENDIF |
1033 |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, |
1034 |
& SQUEEZE_RIGHT, 1) |
& SQUEEZE_RIGHT, 1) |
1035 |
WRITE(msgBuf,'(A,1024A1)') |
WRITE(msgBuf,'(A,1024A1)') |
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 |
|
|
1158 |
pltStep = sNy |
pltStep = sNy |
1159 |
pltLab = 'J =' |
pltLab = 'J =' |
1160 |
ENDIF |
ENDIF |
1161 |
IF ( validRange ) THEN |
C IF ( validRange ) THEN |
1162 |
C Header |
C Header |
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) |
1218 |
ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN |
ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN |
1219 |
val = fld(K,I,J,bk,bi) |
val = fld(K,I,J,bk,bi) |
1220 |
ENDIF |
ENDIF |
1221 |
IDX = NINT( |
IF ( validRange .AND. val .NE. 0. ) THEN |
1222 |
& FLOAT( lChList-1 )*( val-fMin ) / (fRange) |
IDX = NINT( |
1223 |
& )+1 |
& FLOAT( lChList-1 )*( val-fMin ) / (fRange) |
1224 |
|
& )+1 |
1225 |
|
ELSE |
1226 |
|
IDX = 1 |
1227 |
|
ENDIF |
1228 |
IF ( iBuf .LE. MAX_LEN_PLOTBUF ) |
IF ( iBuf .LE. MAX_LEN_PLOTBUF ) |
1229 |
& plotBuf(iBuf:iBuf) = chList(IDX:IDX) |
& plotBuf(iBuf:iBuf) = chList(IDX:IDX) |
1230 |
IF ( val .EQ. 0. ) THEN |
IF ( val .EQ. 0. ) THEN |
1239 |
ENDDO |
ENDDO |
1240 |
ENDDO |
ENDDO |
1241 |
ENDDO |
ENDDO |
1242 |
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 | |
1334 |
#ifndef FMTFTN_IO_THREAD_SAFE |
#ifndef FMTFTN_IO_THREAD_SAFE |
1335 |
_BEGIN_CRIT(myThid) |
_BEGIN_CRIT(myThid) |
1336 |
#endif |
#endif |
1337 |
WRITE(unit,'(A,A,A,A,A,A)') |
WRITE(unit,'(A,A,A,A,A,A)',ERR=999) |
1338 |
& '(',PROCESS_HEADER,' ',idString,')',' ' |
& '(',PROCESS_HEADER,' ',idString,')',' ' |
1339 |
#ifndef FMTFTN_IO_THREAD_SAFE |
#ifndef FMTFTN_IO_THREAD_SAFE |
1340 |
_END_CRIT(myThid) |
_END_CRIT(myThid) |
1343 |
#ifndef FMTFTN_IO_THREAD_SAFE |
#ifndef FMTFTN_IO_THREAD_SAFE |
1344 |
_BEGIN_CRIT(myThid) |
_BEGIN_CRIT(myThid) |
1345 |
#endif |
#endif |
1346 |
WRITE(unit,'(A,A,A,A,A,A,A)') |
WRITE(unit,'(A,A,A,A,A,A,A)',ERR=999) |
1347 |
& '(',PROCESS_HEADER,' ',idString(1:ILNBLNK(idString)),')',' ', |
& '(',PROCESS_HEADER,' ',idString(1:ILNBLNK(idString)),')',' ', |
1348 |
& message(iStart:iEnd) |
& message(iStart:iEnd) |
1349 |
#ifndef FMTFTN_IO_THREAD_SAFE |
#ifndef FMTFTN_IO_THREAD_SAFE |
1352 |
ENDIF |
ENDIF |
1353 |
ENDIF |
ENDIF |
1354 |
C |
C |
1355 |
|
1000 CONTINUE |
1356 |
RETURN |
RETURN |
1357 |
|
999 CONTINUE |
1358 |
|
ioErrorCount(myThid) = ioErrorCount(myThid)+1 |
1359 |
|
GOTO 1000 |
1360 |
|
|
1361 |
END |
END |