/[MITgcm]/MITgcm/eesupp/src/print.F
ViewVC logotype

Annotation of /MITgcm/eesupp/src/print.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.9 - (hide annotations) (download)
Mon Jun 22 16:24:51 1998 UTC (25 years, 11 months ago) by adcroft
Branch: MAIN
CVS Tags: checkpoint11, checkpoint10, checkpoint9, checkpoint12
Changes since 1.8: +28 -7 lines 
o General tidy-up.
o MPI fix. Filename changes (meta/data). salbin*y stuff.
o SST.bin SSS.bin added to verification/exp2
1 adcroft 1.9 C $Header: /u/gcmpack/models/MITgcmUV/eesupp/src/print.F,v 1.8.2.1 1998/06/20 21:04:59 cnh Exp $
2 cnh 1.1
3     #include "CPP_EEOPTIONS.h"
4    
5     C-- File printf.F: Routines for performing formatted textual I/O
6     C-- in the MITgcm UV implementation environment.
7     C-- Contents
8     C-- o print_error Does IO with **ERROR** highlighted header
9 cnh 1.5 C-- o print_list_i Prints one-deimensional list of INTEGER
10     C-- numbers.
11     C-- o print_list_l Prints one-deimensional list of LOGICAL
12     C-- variables.
13 cnh 1.4 C-- o print_list_r8 Prints one-deimensional list of Real*8
14     C-- numbers.
15     C-- o print_mapr4 Formats ABCD... contour map of a Real*4 field
16     C-- Uses print_message for writing
17 cnh 1.1 C-- o print_mapr8 Formats ABCD... contour map of a Real*8 field
18     C-- Uses print_message for writing
19     C-- o print_message Does IO with unhighlighted header
20    
21     CStartOfInterface
22     SUBROUTINE PRINT_ERROR( message , myThid )
23     C /============================================================\
24     C | SUBROUTINE PRINT_ERROR |
25     C | o Write out error message using "standard" format. |
26     C | Notes |
27     C | ===== |
28     C | o Some system's I/O is not "thread-safe". For this reason |
29     C | without the FMTFTN_IO_THREAD_SAFE directive set a |
30     C | critical region is defined around the write here. In some|
31     C | cases BEGIN_CRIT() is approximated by only doing writes |
32     C | for thread number 1 - writes for other threads are |
33     C | ignored! |
34     C | o In a non-parallel form these routines can still be used. |
35     C | to produce pretty printed output! |
36     C \============================================================/
37     C == Global data ==
38     #include "SIZE.h"
39     #include "EEPARAMS.h"
40     #include "EESUPPORT.h"
41     C == Routine arguments ==
42     CHARACTER*(*) message
43     INTEGER myThid
44     CEndOfInterface
45     INTEGER IFNBLNK
46     EXTERNAL IFNBLNK
47     INTEGER ILNBLNK
48     EXTERNAL ILNBLNK
49     C == Local variables ==
50     INTEGER iStart
51     INTEGER iEnd
52     CHARACTER*9 idString
53     C-- Find beginning and end of message
54     iStart = IFNBLNK( message )
55     iEnd = ILNBLNK( message )
56     C-- Test to see if in multi-process ( or multi-threaded ) mode.
57     C If so include process or thread identifier.
58     IF ( numberOfProcs .EQ. 0 .AND. nThreads .EQ. 1 ) THEN
59     C-- Write single process format
60     IF ( message .EQ. ' ' ) THEN
61     WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' '
62     ELSE
63     WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, message(iStart:iEnd)
64     ENDIF
65     ELSEIF ( pidIO .EQ. myProcId ) THEN
66     C-- Write multi-process format
67     #ifndef FMTFTN_IO_THREAD_SAFE
68     _BEGIN_CRIT(myThid)
69     #endif
70     WRITE(idString,'(I4.4,A,I4.4)') myProcId,'.',myThid
71     #ifndef FMTFTN_IO_THREAD_SAFE
72     _END_CRIT(myThid)
73     #endif
74     IF ( message .EQ. ' ' ) THEN
75     C PRINT_ERROR can be called by several threads simulataneously.
76     C The write statement may need to be marked as a critical section.
77     #ifndef FMTFTN_IO_THREAD_SAFE
78     _BEGIN_CRIT(myThid)
79     #endif
80 cnh 1.6 WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)
81 cnh 1.1 & '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',
82     & ' '
83     #ifndef FMTFTN_IO_THREAD_SAFE
84     _END_CRIT(myThid)
85     #endif
86     ELSE
87     #ifndef FMTFTN_IO_THREAD_SAFE
88     _BEGIN_CRIT(myThid)
89     #endif
90 cnh 1.6 WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)
91 cnh 1.1 & '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',
92     & message(iStart:iEnd)
93     #ifndef FMTFTN_IO_THREAD_SAFE
94     _END_CRIT(myThid)
95     #endif
96     ENDIF
97     ENDIF
98     C
99 cnh 1.6 1000 CONTINUE
100 cnh 1.4 RETURN
101 cnh 1.6
102     999 CONTINUE
103     ioErrorCount(myThid) = ioErrorCount(myThid)+1
104     GOTO 1000
105 cnh 1.4 END
106    
107     CStartofinterface
108 adcroft 1.9 SUBROUTINE PRINT_LIST_I( fld, lFld, index_type, markEnd, compact, ioUnit )
109 cnh 1.5 C /==========================================================\
110     C | o SUBROUTINE PRINT_LIST_I |
111     C |==========================================================|
112     C | Routine for producing list of values for a field with |
113     C | duplicate values collected into |
114     C | n @ value |
115     C | record. |
116     C \==========================================================/
117    
118     C == Global data ==
119     #include "SIZE.h"
120     #include "EEPARAMS.h"
121    
122     C == Routine arguments ==
123     C fld - Data to be printed
124     C lFld - Number of elements to be printed
125     C index_type - Flag indicating which type of index to print
126     C INDEX_K => /* K = nnn */
127     C INDEX_I => /* I = nnn */
128     C INDEX_J => /* J = nnn */
129     C INDEX_NONE =>
130 adcroft 1.9 C compact - Flag to control use of repeat symbol for same valued
131     C fields.
132     C markEnd - Flag to control whether there is a separator after the
133     C last element
134 cnh 1.5 C ioUnit - Unit number for IO.
135     INTEGER lFld
136     INTEGER index_type
137     INTEGER fld(lFld)
138 adcroft 1.9 LOGICAL markEnd
139     LOGICAL compact
140 cnh 1.5 INTEGER ioUnit
141     CEndifinterface
142    
143     C == Local variables ==
144     C iLo - Range index holders for selecting elements with
145     C iHi with the same value
146     C nDup - Number of duplicates
147     C xNew, xOld - Hold current and previous values of field
148     C punc - Field separator
149     C msgBuf - IO buffer
150     C index_lab - Index for labelling elements
151     C K - Loop counter
152     INTEGER iLo
153     INTEGER iHi
154     INTEGER nDup
155     INTEGER xNew, xOld
156     CHARACTER punc
157 cnh 1.7 CHARACTER*(MAX_LEN_MBUF) msgBuf
158 cnh 1.5 CHARACTER*2 commOpen,commClose
159     CHARACTER*3 index_lab
160     INTEGER K
161    
162     IF ( index_type .EQ. INDEX_I ) THEN
163     index_lab = 'I ='
164     ELSEIF ( index_type .EQ. INDEX_J ) THEN
165     index_lab = 'J ='
166     ELSEIF ( index_type .EQ. INDEX_K ) THEN
167     index_lab = 'K ='
168     ELSE
169     index_lab = '?='
170     ENDIF
171     commOpen = '/*'
172     commClose = '*/'
173     iLo = 1
174     iHi = 1
175     punc = ','
176     xOld = fld(1)
177     DO K=2,lFld
178     xNew = fld(K )
179 adcroft 1.9 IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN
180 cnh 1.5 nDup = iHi-iLo+1
181     IF ( nDup .EQ. 1 ) THEN
182     WRITE(msgBuf,'(A,I5,A)') ' ',xOld,punc
183     IF ( index_type .NE. INDEX_NONE )
184     & WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose
185     ELSE
186     WRITE(msgBuf,'(I,'' '',A,I5,A)') nDup,'@',xOld,punc
187     IF ( index_type .NE. INDEX_NONE )
188     & WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
189     & commOpen,index_lab,iLo,':',iHi,commClose
190     ENDIF
191 cnh 1.6 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
192 cnh 1.5 iLo = K
193     iHi = K
194     xOld = xNew
195     ELSE
196     iHi = K
197     ENDIF
198     ENDDO
199     punc = ' '
200 adcroft 1.9 IF ( markEnd ) punc = ','
201 cnh 1.5 nDup = iHi-iLo+1
202     IF ( nDup .EQ. 1 ) THEN
203     WRITE(msgBuf,'(A,I5,A)') ' ',xOld,punc
204     IF ( index_type .NE. INDEX_NONE )
205     & WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose
206     ELSEIF( nDup .GT. 1 ) THEN
207     WRITE(msgBuf,'(I,'' '',A,I5,A)') nDup,'@',xOld,punc
208     IF ( index_type .NE. INDEX_NONE )
209     & WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
210     & commOpen,index_lab,iLo,':',iHi,commClose
211     ENDIF
212 cnh 1.6 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
213 cnh 1.5
214     RETURN
215     END
216    
217     CStartofinterface
218 adcroft 1.9 SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, markEnd, compact, ioUnit )
219 cnh 1.5 C /==========================================================\
220     C | o SUBROUTINE PRINT_LIST_L |
221     C |==========================================================|
222     C | Routine for producing list of values for a field with |
223     C | duplicate values collected into |
224     C | n @ value |
225     C | record. |
226     C \==========================================================/
227    
228     C == Global data ==
229     #include "SIZE.h"
230     #include "EEPARAMS.h"
231    
232     C == Routine arguments ==
233     C fld - Data to be printed
234     C lFld - Number of elements to be printed
235     C index_type - Flag indicating which type of index to print
236     C INDEX_K => /* K = nnn */
237     C INDEX_I => /* I = nnn */
238     C INDEX_J => /* J = nnn */
239     C INDEX_NONE =>
240 adcroft 1.9 C compact - Flag to control use of repeat symbol for same valued
241     C fields.
242     C markEnd - Flag to control whether there is a separator after the
243     C last element
244 cnh 1.5 C ioUnit - Unit number for IO.
245     INTEGER lFld
246     INTEGER index_type
247     LOGICAL fld(lFld)
248 adcroft 1.9 LOGICAL markEnd
249     LOGICAL compact
250 cnh 1.5 INTEGER ioUnit
251     CEndifinterface
252    
253     C == Local variables ==
254     C iLo - Range index holders for selecting elements with
255     C iHi with the same value
256     C nDup - Number of duplicates
257     C xNew, xOld - Hold current and previous values of field
258     C punc - Field separator
259     C msgBuf - IO buffer
260     C index_lab - Index for labelling elements
261     C K - Loop counter
262     INTEGER iLo
263     INTEGER iHi
264     INTEGER nDup
265     LOGICAL xNew, xOld
266     CHARACTER punc
267 cnh 1.7 CHARACTER*(MAX_LEN_MBUF) msgBuf
268 cnh 1.5 CHARACTER*2 commOpen,commClose
269     CHARACTER*3 index_lab
270     INTEGER K
271    
272     IF ( index_type .EQ. INDEX_I ) THEN
273     index_lab = 'I ='
274     ELSEIF ( index_type .EQ. INDEX_J ) THEN
275     index_lab = 'J ='
276     ELSEIF ( index_type .EQ. INDEX_K ) THEN
277     index_lab = 'K ='
278     ELSE
279     index_lab = '?='
280     ENDIF
281     commOpen = '/*'
282     commClose = '*/'
283     iLo = 1
284     iHi = 1
285     punc = ','
286     xOld = fld(1)
287     DO K=2,lFld
288     xNew = fld(K )
289 adcroft 1.9 IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN
290 cnh 1.5 nDup = iHi-iLo+1
291     IF ( nDup .EQ. 1 ) THEN
292     WRITE(msgBuf,'(A,L5,A)') ' ',xOld,punc
293     IF ( index_type .NE. INDEX_NONE )
294     & WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose
295     ELSE
296     WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc
297     IF ( index_type .NE. INDEX_NONE )
298     & WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)')
299     & commOpen,index_lab,iLo,':',iHi,commClose
300     ENDIF
301 cnh 1.6 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
302 cnh 1.5 iLo = K
303     iHi = K
304     xOld = xNew
305     ELSE
306     iHi = K
307     ENDIF
308     ENDDO
309     punc = ' '
310 adcroft 1.9 IF ( markEnd ) punc = ','
311 cnh 1.5 nDup = iHi-iLo+1
312     IF ( nDup .EQ. 1 ) THEN
313     WRITE(msgBuf,'(A,L5,A)') ' ',xOld,punc
314     IF ( index_type .NE. INDEX_NONE )
315     & WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose
316     ELSEIF( nDup .GT. 1 ) THEN
317     WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc
318     IF ( index_type .NE. INDEX_NONE )
319     & WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
320     & commOpen,index_lab,iLo,':',iHi,commClose
321     ENDIF
322 cnh 1.6 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
323 cnh 1.5
324     RETURN
325     END
326    
327     CStartofinterface
328 adcroft 1.9 SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type, markEnd, compact, ioUnit )
329 cnh 1.4 C /==========================================================\
330     C | o SUBROUTINE PRINT_LIST_R8 |
331     C |==========================================================|
332     C | Routine for producing list of values for a field with |
333     C | duplicate values collected into |
334     C | n @ value |
335     C | record. |
336     C \==========================================================/
337    
338     C == Global data ==
339     #include "SIZE.h"
340     #include "EEPARAMS.h"
341    
342     C == Routine arguments ==
343     C fld - Data to be printed
344     C lFld - Number of elements to be printed
345     C index_type - Flag indicating which type of index to print
346     C INDEX_K => /* K = nnn */
347     C INDEX_I => /* I = nnn */
348     C INDEX_J => /* J = nnn */
349     C INDEX_NONE =>
350 adcroft 1.9 C compact - Flag to control use of repeat symbol for same valued
351     C fields.
352     C markEnd - Flag to control whether there is a separator after the
353     C last element
354 cnh 1.4 C ioUnit - Unit number for IO.
355     INTEGER lFld
356     INTEGER index_type
357     Real*8 fld(lFld)
358 adcroft 1.9 LOGICAL markEnd
359     LOGICAL compact
360 cnh 1.4 INTEGER ioUnit
361 cnh 1.5 CEndifinterface
362 cnh 1.4
363     C == Local variables ==
364     C iLo - Range index holders for selecting elements with
365     C iHi with the same value
366     C nDup - Number of duplicates
367     C xNew, xOld - Hold current and previous values of field
368     C punc - Field separator
369     C msgBuf - IO buffer
370     C index_lab - Index for labelling elements
371     C K - Loop counter
372     INTEGER iLo
373     INTEGER iHi
374     INTEGER nDup
375     Real*8 xNew, xOld
376     CHARACTER punc
377 cnh 1.7 CHARACTER*(MAX_LEN_MBUF) msgBuf
378 cnh 1.4 CHARACTER*2 commOpen,commClose
379     CHARACTER*3 index_lab
380     INTEGER K
381    
382     IF ( index_type .EQ. INDEX_I ) THEN
383     index_lab = 'I ='
384     ELSEIF ( index_type .EQ. INDEX_J ) THEN
385     index_lab = 'J ='
386     ELSEIF ( index_type .EQ. INDEX_K ) THEN
387     index_lab = 'K ='
388     ELSE
389     index_lab = '?='
390     ENDIF
391     commOpen = '/*'
392     commClose = '*/'
393     iLo = 1
394     iHi = 1
395     punc = ','
396     xOld = fld(1)
397     DO K=2,lFld
398     xNew = fld(K )
399 adcroft 1.9 IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN
400 cnh 1.4 nDup = iHi-iLo+1
401     IF ( nDup .EQ. 1 ) THEN
402     WRITE(msgBuf,'(A,1PE23.15,A)') ' ',xOld,punc
403     IF ( index_type .NE. INDEX_NONE )
404     & WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose
405     ELSE
406     WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
407     IF ( index_type .NE. INDEX_NONE )
408     & WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
409     & commOpen,index_lab,iLo,':',iHi,commClose
410     ENDIF
411     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
412     iLo = K
413     iHi = K
414     xOld = xNew
415     ELSE
416     iHi = K
417     ENDIF
418     ENDDO
419     punc = ' '
420 adcroft 1.9 IF ( markEnd ) punc = ','
421 cnh 1.4 nDup = iHi-iLo+1
422     IF ( nDup .EQ. 1 ) THEN
423     WRITE(msgBuf,'(A,1PE23.15,A)') ' ',xOld,punc
424     IF ( index_type .NE. INDEX_NONE )
425     & WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose
426     ELSEIF( nDup .GT. 1 ) THEN
427     WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
428     IF ( index_type .NE. INDEX_NONE )
429     & WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
430     & commOpen,index_lab,iLo,':',iHi,commClose
431     ENDIF
432     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
433    
434 cnh 1.1 RETURN
435     END
436    
437     CStartOfInterface
438 cnh 1.8 SUBROUTINE PRINT_MAPRS ( fld, fldTitle, plotMode,
439 cnh 1.1 I iLo, iHi, jLo, jHi, kLo, kHi, nBx, nBy,
440     I iMin, iMax, iStr,
441     I jMin, jMax, jStr,
442     I kMin, kMax, kStr,
443     I bxMin, bxMax, bxStr,
444     I byMin, byMax, byStr )
445     C /==========================================================\
446     C | SUBROUTINE PRINT_MAPR4 |
447     C | o Does textual mapping printing of a field. |
448     C |==========================================================|
449     C | This routine does the actual formatting of the data |
450     C | and printing to a file. It assumes an array using the |
451     C | MITgcm UV indexing scheme and base index variables. |
452     C | User code should call an interface routine like |
453     C | PLOT_FIELD_XYR4( ... ) rather than this code directly. |
454     C | Text plots can be oriented XY, YZ, XZ. An orientation |
455     C | is specficied through the "plotMode" argument. All the |
456     C | plots made by a single call to this routine will use the |
457     C | same contour interval. The plot range (iMin,...,byStr) |
458     C | can be three-dimensional. A separate plot is made for |
459     C | each point in the plot range normal to the orientation. |
460     C | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY). |
461     C | kMin =1, kMax = 5 and kStr = 2 will produce three XY|
462     C | plots - one for K=1, one for K=3 and one for K=5. |
463     C | Each plot would have extents iMin:iMax step iStr |
464     C | and jMin:jMax step jStr. |
465     C \==========================================================/
466    
467     C == Global variables ==
468     #include "SIZE.h"
469     #include "EEPARAMS.h"
470     #include "EESUPPORT.h"
471    
472     C == Routine arguments ==
473     C fld - Real*4 array holding data to be plotted
474     C fldTitle - Name of field to be plotted
475     C plotMode - Text string indicating plot orientation
476     C ( see - EEPARAMS.h for valid values ).
477     C iLo, iHi, - Dimensions of array fld. fld is assumed to
478     C jLo, jHi be five-dimensional.
479     C kLo, kHi
480     C nBx, nBy
481     C iMin, iMax - Indexing for points to plot. Points from
482     C iStr iMin -> iMax in steps of iStr are plotted
483     C jMin. jMax and similarly for jMin, jMax, jStr and
484     C jStr kMin, kMax, kStr and bxMin, bxMax, bxStr
485     C kMin, kMax byMin, byMax, byStr.
486     C kStr
487     CHARACTER*(*) fldTitle
488     CHARACTER*(*) plotMode
489     INTEGER iLo, iHi
490     INTEGER jLo, jHi
491     INTEGER kLo, kHi
492     INTEGER nBx, nBy
493 cnh 1.8 _RS fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
494 cnh 1.1 INTEGER iMin, iMax, iStr
495     INTEGER jMin, jMax, jStr
496     INTEGER kMin, kMax, kStr
497     INTEGER bxMin, bxMax, bxStr
498     INTEGER byMin, byMax, byStr
499     CEndOfInterface
500     C == Local variables ==
501     INTEGER IFNBLNK
502     EXTERNAL IFNBLNK
503     INTEGER ILNBLNK
504     EXTERNAL ILNBLNK
505    
506     C == Local variables ==
507     C plotBuf - Buffer for building plot record
508     C chList - Character string used for plot
509     C fMin, fMax - Contour min, max and range
510     C fRange
511     C val - Value of element to be "plotted"
512     C small - Lowest range for which contours are plotted
513     C accXXX - Variables used in indexing accross page records.
514     C dwnXXX Variables used in indexing down the page.
515     C pltXXX Variables used in indexing multiple plots ( multiple
516     C plots use same contour range).
517     C Lab - Label
518     C Base - Base number for element indexing
519     C The process bottom, left coordinate in the
520     C global domain.
521     C Step - Block size
522     C Blo - Start block
523     C Bhi - End block
524     C Bstr - Block stride
525     C Min - Start index within block
526     C Max - End index within block
527     C Str - stride within block
528     INTEGER MAX_LEN_PLOTBUF
529     PARAMETER ( MAX_LEN_PLOTBUF = MAX_LEN_MBUF-4 )
530     CHARACTER*(MAX_LEN_PLOTBUF) plotBuf
531     CHARACTER*(MAX_LEN_MBUF) msgBuf
532     INTEGER lChList
533     PARAMETER ( lChList = 28 )
534     CHARACTER*(lChList) chList
535     REAL fMin
536     REAL fMax
537     REAL fRange
538     REAL val
539     REAL small
540     CHARACTER*2 accLab
541     CHARACTER*7 dwnLab
542     CHARACTER*3 pltLab
543     INTEGER accBase, dwnBase, pltBase
544     INTEGER accStep, dwnStep, pltStep
545     INTEGER accBlo, dwnBlo, pltBlo
546     INTEGER accBhi, dwnBhi, pltBhi
547     INTEGER accBstr, dwnBstr, pltBstr
548     INTEGER accMin, dwnMin, pltMin
549     INTEGER accMax, dwnMax, pltMax
550     INTEGER accStr, dwnStr, pltStr
551     INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx
552     INTEGER bi, bj, bk
553     LOGICAL validRange
554    
555     chList = '-abcdefghijklmnopqrstuvwxyz+'
556     small = 1. _d -15
557     fMin = 1. _d 32
558     fMax = -1. _d 32
559     validRange = .FALSE.
560    
561     C-- Calculate field range
562     DO bj=byMin, byMax, byStr
563     DO bi=bxMin, bxMax, bxStr
564     DO K=kMin, kMax, kStr
565     DO J=jMin, jMax, jStr
566     DO I=iMin, iMax, iStr
567     IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN
568     IF ( fld(I,J,K,bi,bj) .LT. fMin )
569     & fMin = fld(I,J,K,bi,bj)
570     IF ( fld(I,J,K,bi,bj) .GT. fMax )
571     & fMax = fld(I,J,K,bi,bj)
572     ENDIF
573     ENDDO
574     ENDDO
575     ENDDO
576     ENDDO
577     ENDDO
578     fRange = fMax-fMin
579     IF ( fRange .GT. small ) THEN
580     validRange = .TRUE.
581     ENDIF
582    
583     C-- Write field title and statistics
584     msgBuf = '// ======================================================='
585     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
586     & SQUEEZE_RIGHT, 1)
587     iStrngLo = IFNBLNK(fldTitle)
588     iStrngHi = ILNBLNK(fldTitle)
589     IF ( iStrngLo .LE. iStrngHi ) THEN
590     WRITE(msgBuf,'(A)') fldTitle(iStrngLo:iStrngHi)
591     ELSE
592     msgBuf = '// UNKNOWN FIELD'
593     ENDIF
594     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
595     & SQUEEZE_RIGHT, 1)
596     WRITE(msgBuf,'(A,1PE30.15)')
597     & '// CMIN = ', fMin
598     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
599     & SQUEEZE_RIGHT, 1)
600     WRITE(msgBuf,'(A,1PE30.15)')
601     & '// CMAX = ', fMax
602     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
603     & SQUEEZE_RIGHT, 1)
604     WRITE(msgBuf,'(A,1PE30.15)')
605     & '// CINT = ', fRange/FLOAT(lChlist-1)
606     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
607     & SQUEEZE_RIGHT, 1)
608     WRITE(msgBuf,'(A,1024A1)')
609     & '// SYMBOLS (CMIN->CMAX): ',(chList(I:I),I=1,lChList)
610     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
611     & SQUEEZE_RIGHT, 1)
612     WRITE(msgBuf,'(A,1024A1)')
613     & '// 0.0: ','.'
614     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
615     & SQUEEZE_RIGHT, 1)
616     WRITE(msgBuf,'(A,3(A,I4),A)')
617     & '// RANGE I (Lo:Hi:Step):',
618     & '(',myXGlobalLo-1+(bxMin-1)*sNx+iMin,
619     & ':',myXGlobalLo-1+(bxMax-1)*sNx+iMax,
620     & ':',iStr,')'
621     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
622     & SQUEEZE_RIGHT, 1)
623     WRITE(msgBuf,'(A,3(A,I4),A)')
624     & '// RANGE J (Lo:Hi:Step):',
625     & '(',myYGlobalLo-1+(byMin-1)*sNy+jMin,
626     & ':',myYGlobalLo-1+(byMax-1)*sNy+jMax,
627     & ':',jStr,')'
628     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
629     & SQUEEZE_RIGHT, 1)
630     WRITE(msgBuf,'(A,3(A,I4),A)')
631     & '// RANGE K (Lo:Hi:Step):',
632     & '(',kMin,
633     & ':',kMax,
634     & ':',kStr,')'
635     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
636     & SQUEEZE_RIGHT, 1)
637     msgBuf = '// ======================================================='
638     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
639     & SQUEEZE_RIGHT, 1)
640    
641     C-- Write field
642     C Figure out slice type and set plotting parameters appropriately
643     C acc = accross the page
644     C dwn = down the page
645     IF ( plotMode .EQ. PRINT_MAP_XY ) THEN
646     C X across, Y down slice
647     accLab = 'I='
648     accBase = myXGlobalLo
649     accStep = sNx
650     accBlo = bxMin
651     accBhi = bxMax
652     accBStr = bxStr
653     accMin = iMin
654     accMax = iMax
655     accStr = iStr
656     dwnLab = '|--J--|'
657     dwnBase = myYGlobalLo
658     dwnStep = sNy
659     dwnBlo = byMin
660     dwnBhi = byMax
661     dwnBStr = byStr
662     dwnMin = jMin
663     dwnMax = jMax
664     dwnStr = jStr
665     pltBlo = 1
666     pltBhi = 1
667     pltBstr = 1
668     pltMin = kMin
669     pltMax = kMax
670     pltStr = kStr
671     pltBase = 1
672     pltStep = 1
673     pltLab = 'K ='
674     ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
675     C Y across, Z down slice
676     accLab = 'J='
677     accBase = myYGlobalLo
678     accStep = sNy
679     accBlo = byMin
680     accBhi = byMax
681     accBStr = byStr
682     accMin = jMin
683     accMax = jMax
684     accStr = jStr
685     dwnLab = '|--K--|'
686     dwnBase = 1
687     dwnStep = 1
688     dwnBlo = 1
689     dwnBhi = 1
690     dwnBStr = 1
691     dwnMin = kMin
692     dwnMax = kMax
693     dwnStr = kStr
694     pltBlo = bxMin
695     pltBhi = bxMax
696     pltBstr = bxStr
697     pltMin = iMin
698     pltMax = iMax
699     pltStr = iStr
700     pltBase = myXGlobalLo
701     pltStep = sNx
702     pltLab = 'I ='
703     ELSEIF ( plotMode .EQ. PRINT_MAP_XZ ) THEN
704     C X across, Z down slice
705     accLab = 'I='
706     accBase = myXGlobalLo
707     accStep = sNx
708     accBlo = bxMin
709     accBhi = bxMax
710     accBStr = bxStr
711     accMin = iMin
712     accMax = iMax
713     accStr = iStr
714     dwnLab = '|--K--|'
715     dwnBase = 1
716     dwnStep = 1
717     dwnBlo = 1
718     dwnBhi = 1
719     dwnBStr = 1
720     dwnMin = kMin
721     dwnMax = kMax
722     dwnStr = kStr
723     pltBlo = byMin
724     pltBhi = byMax
725     pltBstr = byStr
726     pltMin = jMin
727     pltMax = jMax
728     pltStr = jStr
729     pltBase = myYGlobalLo
730     pltStep = sNy
731     pltLab = 'J ='
732     ENDIF
733     IF ( validRange ) THEN
734     C Header
735     C Data
736     DO bk=pltBlo, pltBhi, pltBstr
737     DO K=pltMin,pltMax,pltStr
738     WRITE(plotBuf,'(A,I,I,I,I)') pltLab,
739     & pltBase-1+(bk-1)*pltStep+K
740     CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
741     & SQUEEZE_RIGHT, 1)
742     plotBuf = ' '
743     iBuf = 6
744     DO bi=accBlo, accBhi, accBstr
745     DO I=accMin, accMax, accStr
746     iDx = accBase-1+(bi-1)*accStep+I
747     iBuf = iBuf + 1
748     IF ( 10*((iBuf-6)/10) .EQ. iBuf-6 ) THEN
749     IF ( iDx. LT. 10 ) THEN
750     WRITE(plotBuf(iBuf:),'(A,I1)') accLab,iDx
751     ELSEIF ( iDx. LT. 100 ) THEN
752     WRITE(plotBuf(iBuf:),'(A,I2)') accLab,iDx
753     ELSEIF ( iDx. LT. 1000 ) THEN
754     WRITE(plotBuf(iBuf:),'(A,I3)') accLab,iDx
755     ELSEIF ( iDx. LT. 10000 ) THEN
756     WRITE(plotBuf(iBuf:),'(A,I4)') accLab,iDx
757     ENDIF
758     ENDIF
759     ENDDO
760     ENDDO
761     WRITE(msgBuf,'(A,A)') '// ',plotBuf
762     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
763     & SQUEEZE_RIGHT, 1)
764     plotBuf = dwnLab
765     iBuf = 7
766     DO bi=accBlo, accBhi, accBstr
767     DO I=accMin, accMax, accStr
768     iDx = accBase-1+(bi-1)*accStep+I
769     iBuf = iBuf+1
770     IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN
771     WRITE(plotBuf(iBuf:),'(A)') '|'
772     ELSE
773     WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(iDx,10)
774     ENDIF
775     ENDDO
776     ENDDO
777     WRITE(msgBuf,'(A,A)') '// ',plotBuf
778     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
779     & SQUEEZE_RIGHT, 1)
780     DO bj=dwnBlo, dwnBhi, dwnBStr
781     DO J=dwnMin, dwnMax, dwnStr
782     WRITE(plotBuf,'(1X,I5,1X)')
783     & dwnBase-1+(bj-1)*dwnStep+J
784     iBuf = 7
785     DO bi=accBlo,accBhi,accBstr
786     DO I=accMin,accMax,accStr
787     iBuf = iBuf + 1
788     IF ( plotMode .EQ. PRINT_MAP_XY ) THEN
789     val = fld(I,J,K,bi,bj)
790     ELSEIF ( plotMode .EQ. PRINT_MAP_XZ ) THEN
791     val = fld(I,K,J,bi,bk)
792     ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
793     val = fld(K,I,J,bk,bi)
794     ENDIF
795     IDX = NINT(
796     & FLOAT( lChList-1 )*( val-fMin ) / (fRange)
797     & )+1
798     IF ( iBuf .LE. MAX_LEN_PLOTBUF )
799     & plotBuf(iBuf:iBuf) = chList(IDX:IDX)
800     IF ( val .EQ. 0. ) THEN
801     IF ( iBuf .LE. MAX_LEN_PLOTBUF )
802     & plotBuf(iBuf:iBuf) = '.'
803     ENDIF
804     ENDDO
805     ENDDO
806     WRITE(msgBuf,'(A,A)') '// ',plotBuf
807     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
808     & SQUEEZE_RIGHT, 1)
809     ENDDO
810     ENDDO
811     ENDDO
812     ENDDO
813     ENDIF
814     C-- Write delimiter
815     msgBuf = '// ======================================================='
816     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
817     & SQUEEZE_RIGHT, 1)
818     msgBuf = '// END OF FIELD ='
819     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
820     & SQUEEZE_RIGHT, 1)
821     msgBuf = '// ======================================================='
822     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
823     & SQUEEZE_RIGHT, 1)
824     msgBuf = ' '
825     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
826     & SQUEEZE_RIGHT, 1)
827    
828     RETURN
829     END
830    
831     CStartOfInterface
832 cnh 1.8 SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode,
833 cnh 1.1 I iLo, iHi, jLo, jHi, kLo, kHi, nBx, nBy,
834     I iMin, iMax, iStr,
835     I jMin, jMax, jStr,
836     I kMin, kMax, kStr,
837     I bxMin, bxMax, bxStr,
838     I byMin, byMax, byStr )
839     C /==========================================================\
840 cnh 1.8 C | SUBROUTINE PRINT_MAPRL |
841 cnh 1.1 C | o Does textual mapping printing of a field. |
842     C |==========================================================|
843     C | This routine does the actual formatting of the data |
844     C | and printing to a file. It assumes an array using the |
845     C | MITgcm UV indexing scheme and base index variables. |
846     C | User code should call an interface routine like |
847     C | PLOT_FIELD_XYR8( ... ) rather than this code directly. |
848     C | Text plots can be oriented XY, YZ, XZ. An orientation |
849     C | is specficied through the "plotMode" argument. All the |
850     C | plots made by a single call to this routine will use the |
851     C | same contour interval. The plot range (iMin,...,byStr) |
852     C | can be three-dimensional. A separate plot is made for |
853     C | each point in the plot range normal to the orientation. |
854     C | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY). |
855     C | kMin =1, kMax = 5 and kStr = 2 will produce three XY|
856     C | plots - one for K=1, one for K=3 and one for K=5. |
857     C | Each plot would have extents iMin:iMax step iStr |
858     C | and jMin:jMax step jStr. |
859     C \==========================================================/
860    
861     C == Global variables ==
862     #include "SIZE.h"
863     #include "EEPARAMS.h"
864     #include "EESUPPORT.h"
865    
866     C == Routine arguments ==
867     C fld - Real*8 array holding data to be plotted
868     C fldTitle - Name of field to be plotted
869     C plotMode - Text string indicating plot orientation
870     C ( see - EEPARAMS.h for valid values ).
871     C iLo, iHi, - Dimensions of array fld. fld is assumed to
872     C jLo, jHi be five-dimensional.
873     C kLo, kHi
874     C nBx, nBy
875     C iMin, iMax - Indexing for points to plot. Points from
876     C iStr iMin -> iMax in steps of iStr are plotted
877     C jMin. jMax and similarly for jMin, jMax, jStr and
878     C jStr kMin, kMax, kStr and bxMin, bxMax, bxStr
879     C kMin, kMax byMin, byMax, byStr.
880     C kStr
881     CHARACTER*(*) fldTitle
882     CHARACTER*(*) plotMode
883     INTEGER iLo, iHi
884     INTEGER jLo, jHi
885     INTEGER kLo, kHi
886     INTEGER nBx, nBy
887 cnh 1.8 _RL fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
888 cnh 1.1 INTEGER iMin, iMax, iStr
889     INTEGER jMin, jMax, jStr
890     INTEGER kMin, kMax, kStr
891     INTEGER bxMin, bxMax, bxStr
892     INTEGER byMin, byMax, byStr
893     CEndOfInterface
894     C == Local variables ==
895     INTEGER IFNBLNK
896     EXTERNAL IFNBLNK
897     INTEGER ILNBLNK
898     EXTERNAL ILNBLNK
899    
900     C == Local variables ==
901     C plotBuf - Buffer for building plot record
902     C chList - Character string used for plot
903     C fMin, fMax - Contour min, max and range
904     C fRange
905     C val - Value of element to be "plotted"
906     C small - Lowest range for which contours are plotted
907     C accXXX - Variables used in indexing accross page records.
908     C dwnXXX Variables used in indexing down the page.
909     C pltXXX Variables used in indexing multiple plots ( multiple
910     C plots use same contour range).
911     C Lab - Label
912     C Base - Base number for element indexing
913     C The process bottom, left coordinate in the
914     C global domain.
915     C Step - Block size
916     C Blo - Start block
917     C Bhi - End block
918     C Bstr - Block stride
919     C Min - Start index within block
920     C Max - End index within block
921     C Str - stride within block
922     INTEGER MAX_LEN_PLOTBUF
923     PARAMETER ( MAX_LEN_PLOTBUF = MAX_LEN_MBUF-4 )
924     CHARACTER*(MAX_LEN_PLOTBUF) plotBuf
925     CHARACTER*(MAX_LEN_MBUF) msgBuf
926     INTEGER lChList
927     PARAMETER ( lChList = 28 )
928     CHARACTER*(lChList) chList
929     REAL fMin
930     REAL fMax
931     REAL fRange
932     REAL val
933     REAL small
934     CHARACTER*2 accLab
935     CHARACTER*7 dwnLab
936     CHARACTER*3 pltLab
937     INTEGER accBase, dwnBase, pltBase
938     INTEGER accStep, dwnStep, pltStep
939     INTEGER accBlo, dwnBlo, pltBlo
940     INTEGER accBhi, dwnBhi, pltBhi
941     INTEGER accBstr, dwnBstr, pltBstr
942     INTEGER accMin, dwnMin, pltMin
943     INTEGER accMax, dwnMax, pltMax
944     INTEGER accStr, dwnStr, pltStr
945     INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx
946     INTEGER bi, bj, bk
947     LOGICAL validRange
948    
949     chList = '-abcdefghijklmnopqrstuvwxyz+'
950     small = 1. _d -15
951     fMin = 1. _d 32
952     fMax = -1. _d 32
953     validRange = .FALSE.
954    
955     C-- Calculate field range
956     DO bj=byMin, byMax, byStr
957     DO bi=bxMin, bxMax, bxStr
958     DO K=kMin, kMax, kStr
959     DO J=jMin, jMax, jStr
960     DO I=iMin, iMax, iStr
961     C IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN
962     IF ( fld(I,J,K,bi,bj) .LT. fMin )
963     & fMin = fld(I,J,K,bi,bj)
964     IF ( fld(I,J,K,bi,bj) .GT. fMax )
965     & fMax = fld(I,J,K,bi,bj)
966     C ENDIF
967     ENDDO
968     ENDDO
969     ENDDO
970     ENDDO
971     ENDDO
972     fRange = fMax-fMin
973     IF ( fRange .GT. small ) THEN
974     validRange = .TRUE.
975     ENDIF
976    
977     C-- Write field title and statistics
978     msgBuf = '// ======================================================='
979     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
980     & SQUEEZE_RIGHT, 1)
981     iStrngLo = IFNBLNK(fldTitle)
982     iStrngHi = ILNBLNK(fldTitle)
983     IF ( iStrngLo .LE. iStrngHi ) THEN
984     WRITE(msgBuf,'(A)') fldTitle(iStrngLo:iStrngHi)
985     ELSE
986     msgBuf = '// UNKNOWN FIELD'
987     ENDIF
988     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
989     & SQUEEZE_RIGHT, 1)
990     WRITE(msgBuf,'(A,1PE30.15)')
991     & '// CMIN = ', fMin
992     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
993     & SQUEEZE_RIGHT, 1)
994     WRITE(msgBuf,'(A,1PE30.15)')
995     & '// CMAX = ', fMax
996     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
997     & SQUEEZE_RIGHT, 1)
998     WRITE(msgBuf,'(A,1PE30.15)')
999     & '// CINT = ', fRange/FLOAT(lChlist-1)
1000     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1001     & SQUEEZE_RIGHT, 1)
1002     WRITE(msgBuf,'(A,1024A1)')
1003     & '// SYMBOLS (CMIN->CMAX): ',(chList(I:I),I=1,lChList)
1004     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1005     & SQUEEZE_RIGHT, 1)
1006     WRITE(msgBuf,'(A,1024A1)')
1007     & '// 0.0: ','.'
1008     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1009     & SQUEEZE_RIGHT, 1)
1010     WRITE(msgBuf,'(A,3(A,I4),A)')
1011     & '// RANGE I (Lo:Hi:Step):',
1012     & '(',myXGlobalLo-1+(bxMin-1)*sNx+iMin,
1013     & ':',myXGlobalLo-1+(bxMax-1)*sNx+iMax,
1014     & ':',iStr,')'
1015     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1016     & SQUEEZE_RIGHT, 1)
1017     WRITE(msgBuf,'(A,3(A,I4),A)')
1018     & '// RANGE J (Lo:Hi:Step):',
1019     & '(',myYGlobalLo-1+(byMin-1)*sNy+jMin,
1020     & ':',myYGlobalLo-1+(byMax-1)*sNy+jMax,
1021     & ':',jStr,')'
1022     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1023     & SQUEEZE_RIGHT, 1)
1024     WRITE(msgBuf,'(A,3(A,I4),A)')
1025     & '// RANGE K (Lo:Hi:Step):',
1026     & '(',kMin,
1027     & ':',kMax,
1028     & ':',kStr,')'
1029     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1030     & SQUEEZE_RIGHT, 1)
1031     msgBuf = '// ======================================================='
1032     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1033     & SQUEEZE_RIGHT, 1)
1034    
1035     C-- Write field
1036     C Figure out slice type and set plotting parameters appropriately
1037     C acc = accross the page
1038     C dwn = down the page
1039     IF ( plotMode .EQ. PRINT_MAP_XY ) THEN
1040     C X across, Y down slice
1041     accLab = 'I='
1042     accBase = myXGlobalLo
1043     accStep = sNx
1044     accBlo = bxMin
1045     accBhi = bxMax
1046     accBStr = bxStr
1047     accMin = iMin
1048     accMax = iMax
1049     accStr = iStr
1050     dwnLab = '|--J--|'
1051     dwnBase = myYGlobalLo
1052     dwnStep = sNy
1053     dwnBlo = byMin
1054     dwnBhi = byMax
1055     dwnBStr = byStr
1056     dwnMin = jMin
1057     dwnMax = jMax
1058     dwnStr = jStr
1059     pltBlo = 1
1060     pltBhi = 1
1061     pltBstr = 1
1062     pltMin = kMin
1063     pltMax = kMax
1064     pltStr = kStr
1065     pltBase = 1
1066     pltStep = 1
1067     pltLab = 'K ='
1068     ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
1069     C Y across, Z down slice
1070     accLab = 'J='
1071     accBase = myYGlobalLo
1072     accStep = sNy
1073     accBlo = byMin
1074     accBhi = byMax
1075     accBStr = byStr
1076     accMin = jMin
1077     accMax = jMax
1078     accStr = jStr
1079     dwnLab = '|--K--|'
1080     dwnBase = 1
1081     dwnStep = 1
1082     dwnBlo = 1
1083     dwnBhi = 1
1084     dwnBStr = 1
1085     dwnMin = kMin
1086     dwnMax = kMax
1087     dwnStr = kStr
1088     pltBlo = bxMin
1089     pltBhi = bxMax
1090     pltBstr = bxStr
1091     pltMin = iMin
1092     pltMax = iMax
1093     pltStr = iStr
1094     pltBase = myXGlobalLo
1095     pltStep = sNx
1096     pltLab = 'I ='
1097     ELSEIF ( plotMode .EQ. PRINT_MAP_XZ ) THEN
1098     C X across, Z down slice
1099     accLab = 'I='
1100     accBase = myXGlobalLo
1101     accStep = sNx
1102     accBlo = bxMin
1103     accBhi = bxMax
1104     accBStr = bxStr
1105     accMin = iMin
1106     accMax = iMax
1107     accStr = iStr
1108     dwnLab = '|--K--|'
1109     dwnBase = 1
1110     dwnStep = 1
1111     dwnBlo = 1
1112     dwnBhi = 1
1113     dwnBStr = 1
1114     dwnMin = kMin
1115     dwnMax = kMax
1116     dwnStr = kStr
1117     pltBlo = byMin
1118     pltBhi = byMax
1119     pltBstr = byStr
1120     pltMin = jMin
1121     pltMax = jMax
1122     pltStr = jStr
1123     pltBase = myYGlobalLo
1124     pltStep = sNy
1125     pltLab = 'J ='
1126     ENDIF
1127     IF ( validRange ) THEN
1128     C Header
1129     C Data
1130     DO bk=pltBlo, pltBhi, pltBstr
1131     DO K=pltMin,pltMax,pltStr
1132     WRITE(plotBuf,'(A,I,I,I,I)') pltLab,
1133     & pltBase-1+(bk-1)*pltStep+K
1134     CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1135     & SQUEEZE_RIGHT, 1)
1136     plotBuf = ' '
1137     iBuf = 6
1138     DO bi=accBlo, accBhi, accBstr
1139     DO I=accMin, accMax, accStr
1140     iDx = accBase-1+(bi-1)*accStep+I
1141     iBuf = iBuf + 1
1142     IF ( 10*((iBuf-6)/10) .EQ. iBuf-6 ) THEN
1143     IF ( iDx. LT. 10 ) THEN
1144     WRITE(plotBuf(iBuf:),'(A,I1)') accLab,iDx
1145     ELSEIF ( iDx. LT. 100 ) THEN
1146     WRITE(plotBuf(iBuf:),'(A,I2)') accLab,iDx
1147     ELSEIF ( iDx. LT. 1000 ) THEN
1148     WRITE(plotBuf(iBuf:),'(A,I3)') accLab,iDx
1149     ELSEIF ( iDx. LT. 10000 ) THEN
1150     WRITE(plotBuf(iBuf:),'(A,I4)') accLab,iDx
1151     ENDIF
1152     ENDIF
1153     ENDDO
1154     ENDDO
1155     CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1156     & SQUEEZE_RIGHT, 1)
1157     plotBuf = dwnLab
1158     iBuf = 7
1159     DO bi=accBlo, accBhi, accBstr
1160     DO I=accMin, accMax, accStr
1161     iDx = accBase-1+(bi-1)*accStep+I
1162     iBuf = iBuf+1
1163     IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN
1164     WRITE(plotBuf(iBuf:),'(A)') '|'
1165     ELSE
1166     WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(iDx,10)
1167     ENDIF
1168     ENDDO
1169     ENDDO
1170     CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1171     & SQUEEZE_RIGHT, 1)
1172     DO bj=dwnBlo, dwnBhi, dwnBStr
1173     DO J=dwnMin, dwnMax, dwnStr
1174     WRITE(plotBuf,'(1X,I5,1X)')
1175     & dwnBase-1+(bj-1)*dwnStep+J
1176     iBuf = 7
1177     DO bi=accBlo,accBhi,accBstr
1178     DO I=accMin,accMax,accStr
1179     iBuf = iBuf + 1
1180     IF ( plotMode .EQ. PRINT_MAP_XY ) THEN
1181     val = fld(I,J,K,bi,bj)
1182     ELSEIF ( plotMode .EQ. PRINT_MAP_XZ ) THEN
1183     val = fld(I,K,J,bi,bk)
1184     ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
1185     val = fld(K,I,J,bk,bi)
1186     ENDIF
1187     IDX = NINT(
1188     & FLOAT( lChList-1 )*( val-fMin ) / (fRange)
1189     & )+1
1190     IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1191     & plotBuf(iBuf:iBuf) = chList(IDX:IDX)
1192     IF ( val .EQ. 0. ) THEN
1193     IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1194     & plotBuf(iBuf:iBuf) = '.'
1195     ENDIF
1196     ENDDO
1197     ENDDO
1198     CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1199     & SQUEEZE_RIGHT, 1)
1200     ENDDO
1201     ENDDO
1202     ENDDO
1203     ENDDO
1204     ENDIF
1205     C-- Write delimiter
1206     msgBuf = '// ======================================================='
1207     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1208     & SQUEEZE_RIGHT, 1)
1209     msgBuf = '// END OF FIELD ='
1210     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1211     & SQUEEZE_RIGHT, 1)
1212     msgBuf = '// ======================================================='
1213     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1214     & SQUEEZE_RIGHT, 1)
1215     msgBuf = ' '
1216     CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1217     & SQUEEZE_RIGHT, 1)
1218    
1219     RETURN
1220     END
1221    
1222     CStartOfInterface
1223     SUBROUTINE PRINT_MESSAGE( message, unit, sq , myThid )
1224     C /============================================================\
1225     C | SUBROUTINE PRINT_MESSAGE |
1226     C | o Write out informational message using "standard" format. |
1227     C | Notes |
1228     C | ===== |
1229     C | o Some system's I/O is not "thread-safe". For this reason |
1230     C | without the FMTFTN_IO_THREAD_SAFE directive set a |
1231     C | critical region is defined around the write here. In some|
1232     C | cases BEGIN_CRIT() is approximated by only doing writes |
1233     C | for thread number 1 - writes for other threads are |
1234     C | ignored! |
1235     C | o In a non-parallel form these routines can still be used. |
1236     C | to produce pretty printed output! |
1237     C \============================================================/
1238     C == Global data ==
1239     #include "SIZE.h"
1240     #include "EEPARAMS.h"
1241     #include "EESUPPORT.h"
1242     C == Routine arguments ==
1243     C message - Message to write
1244     C unit - Unit number to write to
1245     C sq - Justification option
1246     CHARACTER*(*) message
1247     INTEGER unit
1248     CHARACTER*(*) sq
1249     INTEGER myThid
1250     CEndOfInterface
1251     INTEGER IFNBLNK
1252     EXTERNAL IFNBLNK
1253     INTEGER ILNBLNK
1254     EXTERNAL ILNBLNK
1255     C == Local variables ==
1256     INTEGER iStart
1257     INTEGER iEnd
1258     CHARACTER*9 idString
1259     C-- Find beginning and end of message
1260     IF ( sq .EQ. SQUEEZE_BOTH .OR.
1261     & sq .EQ. SQUEEZE_LEFT ) THEN
1262     iStart = IFNBLNK( message )
1263     ELSE
1264     iStart = 1
1265     ENDIF
1266     IF ( sq .EQ. SQUEEZE_BOTH .OR.
1267     & sq .EQ. SQUEEZE_RIGHT ) THEN
1268     iEnd = ILNBLNK( message )
1269     ELSE
1270     iEnd = LEN(message)
1271     ENDIF
1272     C-- Test to see if in multi-process ( or multi-threaded ) mode.
1273     C If so include process or thread identifier.
1274     IF ( numberOfProcs .EQ. 0 .AND. nThreads .EQ. 1 ) THEN
1275     C-- Write single process format
1276     IF ( message .EQ. ' ' ) THEN
1277     WRITE(unit,'(A)') ' '
1278     ELSE
1279     WRITE(unit,'(A)') message(iStart:iEnd)
1280     ENDIF
1281     ELSEIF ( pidIO .EQ. myProcId ) THEN
1282     C-- Write multi-process format
1283     #ifndef FMTFTN_IO_THREAD_SAFE
1284     _BEGIN_CRIT(myThid)
1285     #endif
1286     WRITE(idString,'(I4.4,A,I4.4)') myProcId,'.',myThid
1287     #ifndef FMTFTN_IO_THREAD_SAFE
1288     _END_CRIT(myThid)
1289     #endif
1290     IF ( message .EQ. ' ' ) THEN
1291     C PRINT can be called by several threads simultaneously.
1292     C The write statement may need to ne marked as a critical section.
1293     #ifndef FMTFTN_IO_THREAD_SAFE
1294     _BEGIN_CRIT(myThid)
1295     #endif
1296 cnh 1.6 WRITE(unit,'(A,A,A,A,A,A)',ERR=999)
1297 cnh 1.1 & '(',PROCESS_HEADER,' ',idString,')',' '
1298     #ifndef FMTFTN_IO_THREAD_SAFE
1299     _END_CRIT(myThid)
1300     #endif
1301     ELSE
1302     #ifndef FMTFTN_IO_THREAD_SAFE
1303     _BEGIN_CRIT(myThid)
1304     #endif
1305 cnh 1.6 WRITE(unit,'(A,A,A,A,A,A,A)',ERR=999)
1306 cnh 1.1 & '(',PROCESS_HEADER,' ',idString(1:ILNBLNK(idString)),')',' ',
1307     & message(iStart:iEnd)
1308     #ifndef FMTFTN_IO_THREAD_SAFE
1309     _END_CRIT(myThid)
1310     #endif
1311     ENDIF
1312     ENDIF
1313     C
1314 cnh 1.6 1000 CONTINUE
1315 cnh 1.1 RETURN
1316 cnh 1.6 999 CONTINUE
1317     ioErrorCount(myThid) = ioErrorCount(myThid)+1
1318     GOTO 1000
1319    
1320 cnh 1.1 END
  ViewVC Help
Powered by ViewVC 1.1.22