/[MITgcm]/MITgcm/pkg/diagnostics/diagnostics_utils.F
ViewVC logotype

Diff of /MITgcm/pkg/diagnostics/diagnostics_utils.F

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

revision 1.19 by jmc, Thu Feb 17 00:00:47 2005 UTC revision 1.28 by jmc, Sun Jan 25 17:00:20 2009 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "DIAG_OPTIONS.h"  #include "DIAG_OPTIONS.h"
5    
6    C--   File diagnostics_utils.F: General purpose support routines
7    C--    Contents:
8    C--    o GETDIAG
9    C--    o DIAGNOSTICS_COUNT
10    C--    o DIAGNOSTICS_GET_POINTERS
11    C--    o DIAGS_GET_PARMS_I (Function)
12    C--    o DIAGS_MK_UNITS (Function)
13    C--    o DIAGS_MK_TITLE (Function)
14    
15  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
16  CBOP 0  CBOP 0
17  C     !ROUTINE: GETDIAG  C     !ROUTINE: GETDIAG
# Line 11  C     !INTERFACE: Line 20  C     !INTERFACE:
20        SUBROUTINE GETDIAG(        SUBROUTINE GETDIAG(
21       I                    levreal, undef,       I                    levreal, undef,
22       O                    qtmp,       O                    qtmp,
23       I                    ipoint, mate, bi, bj, myThid )       I                    ndId, mate, ip, im, bi, bj, myThid )
24    
25  C     !DESCRIPTION:  C     !DESCRIPTION:
26  C     Retrieve averaged model diagnostic  C     Retrieve averaged model diagnostic
# Line 24  C     !USES: Line 33  C     !USES:
33  #include "DIAGNOSTICS.h"  #include "DIAGNOSTICS.h"
34    
35  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
36  C     levreal .... Diagnostic LEVEL  C     levreal :: Diagnostic LEVEL
37  C     undef  ..... UNDEFINED VALUE  C     undef   :: UNDEFINED VALUE
38  C     ipoint ..... DIAGNOSTIC NUMBER FROM MENU  C     ndId    :: DIAGNOSTIC NUMBER FROM MENU
39  C     mate   ..... counter DIAGNOSTIC NUMBER if any ; 0 otherwise  C     mate    :: counter DIAGNOSTIC NUMBER if any ; 0 otherwise
40  C     bi     ..... X-direction tile number  C     ip      :: pointer to storage array location for diag.
41  C     bj     ..... Y-direction tile number  C     im      :: pointer to storage array location for mate
42  C     myThid ..... my thread Id number  C     bi      :: X-direction tile number
43    C     bj      :: Y-direction tile number
44    C     myThid  :: my thread Id number
45        _RL levreal        _RL levreal
46        _RL undef        _RL undef
47        INTEGER ipoint, mate        INTEGER ndId, mate, ip, im
48        INTEGER bi,bj, myThid        INTEGER bi,bj, myThid
49    
50  C     !OUTPUT PARAMETERS:  C     !OUTPUT PARAMETERS:
# Line 46  C     !LOCAL VARIABLES: Line 57  C     !LOCAL VARIABLES:
57        INTEGER i, j, ipnt,ipCt        INTEGER i, j, ipnt,ipCt
58        INTEGER lev, levCt, klev        INTEGER lev, levCt, klev
59    
60        IF (ipoint.GE.1) THEN        IF (ndId.GE.1) THEN
61         lev = NINT(levreal)         lev = NINT(levreal)
62         klev = kdiag(ipoint)         klev = kdiag(ndId)
63         IF (lev.LE.klev) THEN         IF (lev.LE.klev) THEN
64    
65          IF ( mate.EQ.0 ) THEN          IF ( mate.EQ.0 ) THEN
66  C-      No counter diagnostics => average = Sum / ndiag :  C-      No counter diagnostics => average = Sum / ndiag :
67    
68            ipnt = idiag(ipoint) + lev - 1            ipnt = ip + lev - 1
69  c         factor = 1.0            factor = FLOAT(ndiag(ip,bi,bj))
70  c         if (ndiag(ipoint).ne.0) factor = 1.0/ndiag(ipoint)            IF (ndiag(ip,bi,bj).NE.0) factor = 1. _d 0 / factor
           factor = FLOAT(ndiag(ipoint))  
           IF (ndiag(ipoint).NE.0) factor = 1. _d 0 / factor  
71    
72    #ifdef ALLOW_FIZHI
73            DO j = 1,sNy+1            DO j = 1,sNy+1
74              DO i = 1,sNx+1              DO i = 1,sNx+1
75                IF ( qdiag(i,j,ipnt,bi,bj) .LE. undef ) THEN                IF ( qdiag(i,j,ipnt,bi,bj) .LE. undef ) THEN
# Line 69  c         if (ndiag(ipoint).ne.0) factor Line 79  c         if (ndiag(ipoint).ne.0) factor
79                ENDIF                ENDIF
80              ENDDO              ENDDO
81            ENDDO            ENDDO
82    #else /* ALLOW_FIZHI */
83              DO j = 1,sNy+1
84                DO i = 1,sNx+1
85                  qtmp(i,j) = qdiag(i,j,ipnt,bi,bj)*factor
86                ENDDO
87              ENDDO
88    #endif /* ALLOW_FIZHI */
89    
90          ELSE          ELSE
91  C-      With counter diagnostics => average = Sum / counter:  C-      With counter diagnostics => average = Sum / counter:
92    
93            ipnt = idiag(ipoint) + lev - 1            ipnt = ip + lev - 1
94            levCt= MIN(lev,kdiag(mate))            levCt= MIN(lev,kdiag(mate))
95            ipCt = idiag(mate) + levCt - 1            ipCt = im + levCt - 1
96            DO j = 1,sNy+1            DO j = 1,sNy+1
97              DO i = 1,sNx+1              DO i = 1,sNx+1
98                IF ( qdiag(i,j,ipCt,bi,bj) .NE. 0. ) THEN                IF ( qdiag(i,j,ipCt,bi,bj) .NE. 0. ) THEN
# Line 96  C-      With counter diagnostics => aver Line 113  C-      With counter diagnostics => aver
113    
114  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
115    
       subroutine clrindx (listnum, myThid)  
 C***********************************************************************  
 C  
 C  PURPOSE  
 C     DRIVER TO CLEAR DIAGNOSTICS SPECIFIED IN DIAGNOSTIC INDEX LIST  
 C  
 C  ARGUMENT DESCRIPTION  
 C     listnum ....  diagnostics list number  
 C  
 C***********************************************************************  
   
       implicit none  
 #include "EEPARAMS.h"  
 #include "SIZE.h"  
 #include "DIAGNOSTICS_SIZE.h"  
 #include "DIAGNOSTICS.h"  
   
       integer myThid, listnum  
   
       integer m, n  
       character*8 parms1  
       character*3 mate_index  
       integer mate  
   
       do n=1,nfields(listnum)  
        do m=1,ndiagt  
         if( flds(n,listnum).eq.cdiag(m) .and. idiag(m).ne.0 ) then  
          call clrdiag (m, myThid)  
   
 c Check for Counter Diagnostic  
 c ----------------------------  
          parms1 =  gdiag(m)(1:8)  
          if ( parms1(5:5).eq.'C' ) then  
           mate_index = parms1(6:8)  
           read (mate_index,'(I3)') mate  
           call clrdiag (mate, myThid)  
          endif  
         endif  
        enddo  
       enddo  
   
       RETURN  
       END  
   
   
       subroutine clrdiag (index, myThid)  
 C***********************************************************************  
 C  PURPOSE  
 C     ZERO OUT MODEL DIAGNOSTIC ARRAY ELEMENTS  
 C***********************************************************************  
   
       implicit none  
 #include "EEPARAMS.h"  
 #include "SIZE.h"  
 #include "DIAGNOSTICS_SIZE.h"  
 #include "DIAGNOSTICS.h"  
   
       integer myThid, index  
   
       integer bi,bj  
       integer i,j,k  
   
 C **********************************************************************  
 C ****              SET DIAGNOSTIC AND COUNTER TO ZERO              ****  
 C **********************************************************************  
   
       do bj=myByLo(myThid), myByHi(myThid)  
        do bi=myBxLo(myThid), myBxHi(myThid)  
         do k = 1,kdiag(index)  
          do j = 1-OLy,sNy+OLy  
           do i = 1-OLx,sNx+OLx  
            qdiag(i,j,idiag(index)+k-1,bi,bj) = 0.0  
           enddo  
          enddo  
         enddo  
        enddo  
       enddo  
   
       ndiag(index) = 0  
   
       RETURN  
       END  
   
 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  
   
116  CBOP 0  CBOP 0
117  C     !ROUTINE: DIAGNOSTICS_COUNT  C     !ROUTINE: DIAGNOSTICS_COUNT
118  C     !INTERFACE:  C     !INTERFACE:
119        SUBROUTINE DIAGNOSTICS_COUNT (chardiag,        SUBROUTINE DIAGNOSTICS_COUNT (chardiag,
120       I                              biArg, bjArg, myThid)       I                              biArg, bjArg, myThid)
121    
122  C     !DESCRIPTION:  C     !DESCRIPTION:
123  C***********************************************************************  C***********************************************************************
# Line 216  CEOP Line 148  CEOP
148    
149  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
150  C ===============  C ===============
151        INTEGER m, n        INTEGER m, n
152        INTEGER ndiagnum, ipointer        INTEGER bi, bj
153  c     INTEGER bi, bj        INTEGER ipt, ndId
154  c     CHARACTER*(MAX_LEN_MBUF) msgBuf  c     CHARACTER*(MAX_LEN_MBUF) msgBuf
155    
156  C Run through list of active diagnostics to make sure        IF ( biArg.EQ.0 .AND. bjArg.EQ.0 ) THEN
157  C we are trying to increment a valid diagnostic-counter          bi = myBxLo(myThid)
158            bj = myByLo(myThid)
159          ELSE
160            bi = MIN(biArg,nSx)
161            bj = MIN(bjArg,nSy)
162          ENDIF
163    
164        ndiagnum = 0  C--   Run through list of active diagnostics to find which counter
165        ipointer = 0  C     to increment (needs to be a valid & active diagnostic-counter)
166        DO n=1,nlists        DO n=1,nlists
167         DO m=1,nActive(n)         DO m=1,nActive(n)
168          IF ( chardiag.EQ.flds(m,n) ) THEN          IF ( chardiag.EQ.flds(m,n) .AND. idiag(m,n).GT.0 ) THEN
169           ndiagnum = jdiag(m,n)           ipt = idiag(m,n)
170           IF (ndiag(ndiagnum).GE.0) ipointer = idiag(ndiagnum)           IF (ndiag(ipt,bi,bj).GE.0) THEN
171              ndId = jdiag(m,n)
172              ipt = ipt + pdiag(n,bi,bj)*kdiag(ndId)
173    C-    Increment the counter for the diagnostic
174              IF ( biArg.EQ.0 .AND. bjArg.EQ.0 ) THEN
175               DO bj=myByLo(myThid), myByHi(myThid)
176                DO bi=myBxLo(myThid), myBxHi(myThid)
177                 ndiag(ipt,bi,bj) = ndiag(ipt,bi,bj) + 1
178                ENDDO
179               ENDDO
180              ELSE
181                 ndiag(ipt,bi,bj) = ndiag(ipt,bi,bj) + 1
182              ENDIF
183    C-    Increment is done
184             ENDIF
185          ENDIF          ENDIF
186         ENDDO         ENDDO
187        ENDDO        ENDDO
188    
189  C If-sequence to see if we are a valid and an active diagnostic        RETURN
190          END
191    
192        IF ( ndiagnum.NE.0 .AND. ipointer.NE.0 ) THEN  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
193    
194  C Increment the counter for the diagnostic (if we are at bi=bj=myThid=1)  CBOP 0
195         _BEGIN_MASTER(myThid)  C     !ROUTINE: DIAGNOSTICS_GET_POINTERS
196          IF ( (biArg.EQ.1 .AND. bjArg.EQ.1) .OR.  C     !INTERFACE:
197       &       (biArg.EQ.0 .AND. bjArg.EQ.0) )        SUBROUTINE DIAGNOSTICS_GET_POINTERS(
198       &                     ndiag(ndiagnum) = ndiag(ndiagnum) + 1       I                       diagName, listId,
199         _END_MASTER(myThid)       O                       ndId, ip,
200         I                       myThid )
201    
202  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C     !DESCRIPTION:
203    C     *================================================================*
204    C     | o Returns the diagnostic Id number and diagnostic
205    C     |   pointer to storage array for a specified diagnostic.
206    C     *================================================================*
207    C     | Note: A diagnostics field can be stored multiple times
208    C     |       (for different output frequency,phase, ...).
209    C     | operates in 2 ways:
210    C     | o listId =0 => find 1 diagnostics Id & pointer which name matches.
211    C     | o listId >0 => find the unique diagnostic Id & pointer with
212    C     |      the right name and same output time as "listId" output-list
213    C     | o return ip=0 if did not find the right diagnostic;
214    C     |   (ndId <>0 if diagnostic exist but output time does not match)
215    C     *================================================================*
216    
217    C     !USES:
218          IMPLICIT NONE
219    #include "EEPARAMS.h"
220    #include "SIZE.h"
221    #include "DIAGNOSTICS_SIZE.h"
222    #include "DIAGNOSTICS.h"
223    
224    C     !INPUT PARAMETERS:
225    C     diagName :: diagnostic identificator name (8 characters long)
226    C     listId   :: list number that specify the output frequency
227    C     myThid   :: my Thread Id number
228    C     !OUTPUT PARAMETERS:
229    C     ndId     :: diagnostics  Id number (in available diagnostics list)
230    C     ip       :: diagnostics  pointer to storage array
231    
232    
233          CHARACTER*8 diagName
234          INTEGER listId
235          INTEGER ndId, ip
236          INTEGER myThid
237    CEOP
238    
239    C     !LOCAL VARIABLES:
240          INTEGER n,m
241    
242  C-- note: counter could become a tiled array, and then it would be:        ip   = 0
243  c       IF ( biArg.EQ.0 .AND. bjArg.EQ.0 ) THEN        ndId = 0
 c        DO bj=myByLo(myThid), myByHi(myThid)  
 c         DO bi=myBxLo(myThid), myBxHi(myThid)  
 c          ndiag(ndiagnum,bi,bj) = ndiag(ndiagnum,bi,bj) + 1  
 c         ENDDO  
 c        ENDDO  
 c       ELSE  
 c          bi = MIN(biArg,nSx)  
 c          bj = MIN(bjArg,nSy)  
 c          ndiag(ndiagnum,bi,bj) = ndiag(ndiagnum,bi,bj) + 1  
 c       ENDIF  
244    
245          IF ( listId.LE.0 ) THEN
246    C--   select the 1rst one which name matches:
247    
248    C-    search for this diag. in the active 2D/3D diagnostics list
249            DO n=1,nlists
250             DO m=1,nActive(n)
251               IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)
252         &                  .AND. idiag(m,n).NE.0 ) THEN
253                ip   = ABS(idiag(m,n))
254                ndId = jdiag(m,n)
255               ENDIF
256             ENDDO
257            ENDDO
258    
259          ELSEIF ( listId.LE.nlists ) THEN
260    C--   select the unique diagnostic with output-time identical to listId
261    
262    C-    search for this diag. in the active 2D/3D diagnostics list
263            DO n=1,nlists
264             IF ( ip.EQ.0
265         &        .AND. freq(n) .EQ. freq(listId)
266         &        .AND. phase(n).EQ.phase(listId)
267         &        .AND. averageFreq(n) .EQ.averageFreq(listId)
268         &        .AND. averagePhase(n).EQ.averagePhase(listId)
269         &        .AND. averageCycle(n).EQ.averageCycle(listId)
270         &      ) THEN
271              DO m=1,nActive(n)
272               IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)
273         &                  .AND. idiag(m,n).NE.0 ) THEN
274                ip   = ABS(idiag(m,n))
275                ndId = jdiag(m,n)
276               ENDIF
277              ENDDO
278             ELSEIF ( ip.EQ.0 ) THEN
279              DO m=1,nActive(n)
280               IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)
281         &                  .AND. idiag(m,n).NE.0 ) THEN
282                ndId = jdiag(m,n)
283               ENDIF
284              ENDDO
285             ENDIF
286            ENDDO
287    
288          ELSE
289            STOP 'DIAGNOSTICS_GET_POINTERS: invalid listId number'
290        ENDIF        ENDIF
291    
292        RETURN        RETURN
293        END        END
294    
295  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
296    
297  CBOP 0  CBOP 0
298  C     !ROUTINE: DIAGNOSTICS_IS_ON  C     !ROUTINE: DIAGS_GET_PARMS_I
299    
300  C     !INTERFACE:  C     !INTERFACE:
301        LOGICAL FUNCTION DIAGNOSTICS_IS_ON( diagName, myThid )        INTEGER FUNCTION DIAGS_GET_PARMS_I(
302         I                            parName, myThid )
303    
304  C     !DESCRIPTION:  C     !DESCRIPTION:
305  C     *==========================================================*  C     *==========================================================*
306  C     | FUNCTION DIAGNOSTIC_IS_ON  C     | FUNCTION DIAGS_GET_PARMS_I
307  C     | o Return TRUE if diagnostics "diagName" is Active  C     | o Return the value of integer parameter
308    C     |   from one of the DIAGNOSTICS.h common blocs
309  C     *==========================================================*  C     *==========================================================*
310    
311  C     !USES:  C     !USES:
# Line 288  C     !USES: Line 316  C     !USES:
316  #include "DIAGNOSTICS.h"  #include "DIAGNOSTICS.h"
317    
318  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
319  C     diagName   ::  diagnostic identificator name (8 characters long)  C     parName   :: string used to identify which parameter to get
320  C     myThid     ::  my thread Id number  C     myThid    :: my Thread Id number
321        CHARACTER*8  diagName        CHARACTER*(*) parName
322        INTEGER      myThid        INTEGER myThid
323  CEOP  CEOP
324    
325  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
326        INTEGER j,n,m        CHARACTER*(MAX_LEN_MBUF) msgBuf
327          INTEGER n
328    
329        DIAGNOSTICS_IS_ON = .FALSE.  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
330        DO n=1,nlists  
331         DO m=1,nActive(n)        n = LEN(parName)
332          IF ( diagName.EQ.flds(m,n) ) THEN  c     write(0,'(3A,I4)')
333            j = jdiag(m,n)      c    &  'DIAGS_GET_PARMS_I: parName="',parName,'" , length=',n
334            IF ( idiag(j).NE.0 .AND. ndiag(j).GE.0 )  
335       &         DIAGNOSTICS_IS_ON = .TRUE.        IF ( parName.EQ.'LAST_DIAG_ID' ) THEN
336          ENDIF           DIAGS_GET_PARMS_I = ndiagt
337         ENDDO        ELSE
338        ENDDO           WRITE(msgBuf,'(4A)') 'DIAGS_GET_PARMS_I: ',
339         &    ' parName="', parName, '" not known.'
340             CALL PRINT_ERROR( msgBuf, myThid )
341             STOP 'ABNORMAL END: S/R DIAGS_GET_PARMS_I'
342          ENDIF
343    
344        RETURN        RETURN
345        END        END
# Line 317  CBOP 0 Line 350  CBOP 0
350  C     !ROUTINE: DIAGS_MK_UNITS  C     !ROUTINE: DIAGS_MK_UNITS
351    
352  C     !INTERFACE:  C     !INTERFACE:
353        CHARACTER*16 FUNCTION DIAGS_MK_UNITS(        CHARACTER*16 FUNCTION DIAGS_MK_UNITS(
354       I                            diagUnitsInPieces, myThid )       I                            diagUnitsInPieces, myThid )
355    
356  C     !DESCRIPTION:  C     !DESCRIPTION:
357  C     *==========================================================*  C     *==========================================================*
358  C     | FUNCTION DIAGS_MK_UNITS  C     | FUNCTION DIAGS_MK_UNITS
359  C     | o Return the diagnostic units string (16c) removing  C     | o Return the diagnostic units string (16c) removing
360  C     |   blanks from the input string  C     |   blanks from the input string
361  C     *==========================================================*  C     *==========================================================*
362    
# Line 332  C     !USES: Line 365  C     !USES:
365  #include "EEPARAMS.h"  #include "EEPARAMS.h"
366    
367  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
368  C     diagUnitsInPieces :: string for diagnostic units: in several  C     diagUnitsInPieces :: string for diagnostic units: in several
369  C                          pieces, with blanks in between  C                          pieces, with blanks in between
370  C     myThid            ::  my thread Id number  C     myThid            ::  my thread Id number
371        CHARACTER*(*) diagUnitsInPieces        CHARACTER*(*) diagUnitsInPieces
# Line 343  C     !LOCAL VARIABLES: Line 376  C     !LOCAL VARIABLES:
376        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
377        INTEGER i,j,n        INTEGER i,j,n
378    
379        DIAGS_MK_UNITS = '          '        DIAGS_MK_UNITS = '          '
380        n = LEN(diagUnitsInPieces)        n = LEN(diagUnitsInPieces)
381          
382        j = 0        j = 0
383        DO i=1,n        DO i=1,n
384         IF (diagUnitsInPieces(i:i) .NE. ' ' ) THEN         IF (diagUnitsInPieces(i:i) .NE. ' ' ) THEN
# Line 364  C     !LOCAL VARIABLES: Line 397  C     !LOCAL VARIABLES:
397          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
398       &       SQUEEZE_RIGHT , myThid)       &       SQUEEZE_RIGHT , myThid)
399        ENDIF        ENDIF
400    
401          RETURN
402          END
403    
404    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
405    
406    CBOP 0
407    C     !ROUTINE: DIAGS_MK_TITLE
408    
409    C     !INTERFACE:
410          CHARACTER*80 FUNCTION DIAGS_MK_TITLE(
411         I                            diagTitleInPieces, myThid )
412    
413    C     !DESCRIPTION:
414    C     *==========================================================*
415    C     | FUNCTION DIAGS_MK_TITLE
416    C     | o Return the diagnostic title string (80c) removing
417    C     |   consecutive blanks from the input string
418    C     *==========================================================*
419    
420    C     !USES:
421          IMPLICIT NONE
422    #include "EEPARAMS.h"
423    
424    C     !INPUT PARAMETERS:
425    C     diagTitleInPieces :: string for diagnostic units: in several
426    C                          pieces, with blanks in between
427    C     myThid            ::  my Thread Id number
428          CHARACTER*(*) diagTitleInPieces
429          INTEGER      myThid
430    CEOP
431    
432    C     !LOCAL VARIABLES:
433          CHARACTER*(MAX_LEN_MBUF) msgBuf
434          LOGICAL flag
435          INTEGER i,j,n
436    
437    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
438    
439          DIAGS_MK_TITLE = '                                        '
440         &               //'                                        '
441          n = LEN(diagTitleInPieces)
442    
443          j = 0
444          flag = .FALSE.
445          DO i=1,n
446           IF (diagTitleInPieces(i:i) .NE. ' ' ) THEN
447             IF ( flag ) THEN
448               j = j+1
449               IF (j.LE.80) DIAGS_MK_TITLE(j:j) = ' '
450             ENDIF
451             j = j+1
452             IF ( j.LE.80 ) DIAGS_MK_TITLE(j:j) = diagTitleInPieces(i:i)
453             flag = .FALSE.
454           ELSE
455             flag = j.GE.1
456           ENDIF
457          ENDDO
458    
459          IF ( j.GT.80 ) THEN
460             WRITE(msgBuf,'(2A,I4,A)') '**WARNING** ',
461         &   'DIAGS_MK_TITLE: too long (',j,' >80) input string'
462            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
463         &       SQUEEZE_RIGHT , myThid)
464             WRITE(msgBuf,'(3A)') '**WARNING** ',
465         &   'DIAGS_MK_TITLE: input=', diagTitleInPieces
466            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
467         &       SQUEEZE_RIGHT , myThid)
468          ENDIF
469    
470        RETURN        RETURN
471        END        END
Legend:
Removed from v.1.19  
changed lines
  Added in v.1.28
  ViewVC Help
Powered by ViewVC 1.1.22