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

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

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

revision 1.15 by jmc, Tue Jun 21 18:00:15 2011 UTC revision 1.16 by jmc, Fri Jul 1 18:52:18 2011 UTC
# Line 42  C     == Local variables == Line 42  C     == Local variables ==
42    
43        _BEGIN_MASTER( myThid)        _BEGIN_MASTER( myThid)
44    
45    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
46    
47    C--   In case an output file contains 2 post-processed diags which are computed
48    C     together (mate of 2nd PP-diag one is 1rst PP-diag), move these 2 diags
49    C     next to each other (to only computate them once): 1rst one then 2nd one.
50          DO ld=1,nlists
51           found = .FALSE.
52           DO md=1,nfields(ld)
53    C        Search all possible model diagnostics
54             nd = 0
55             DO i=1,ndiagt
56              IF ( nd.EQ.0 .AND. flds(md,ld).EQ.cdiag(i) ) nd = i
57             ENDDO
58             j  = 0
59             IF ( nd.GE.1 ) THEN
60               IF ( gdiag(nd)(5:5).EQ.'P' ) THEN
61                 mate = hdiag(nd)
62                 IF ( gdiag(mate)(5:5).EQ.'P' ) THEN
63    C        Mate of Post-Processed diag "nd" is also Post-Processed
64                   DO i=1,nfields(ld)
65                     IF ( j.EQ.0 .AND. flds(i,ld).EQ.cdiag(mate) ) j = i
66                   ENDDO
67                 ENDIF
68               ENDIF
69             ENDIF
70    C        And is found in the same output stream "ld" (at rank "j")
71             IF ( j.GE.1 .AND. j.NE.md-1 ) THEN
72               IF ( .NOT.found ) THEN
73                 WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_SET_POINTERS: ',
74         &             'Re-Order Diags in Outp.Stream: ',fnames(ld)
75                 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
76         &                           SQUEEZE_RIGHT, myThid )
77               ENDIF
78               found  = .TRUE.
79               IF ( j.LT.md-1 ) THEN
80                 WRITE(msgBuf,'(2A,2(A,I4),2A)')
81         &         ' move ',flds(j,ld),' from ',j,' down to',md-1,
82         &         ' just before ',flds(md,ld)
83                 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
84         &                           SQUEEZE_RIGHT, myThid )
85                 DO i=j,md-2
86                   flds(i,ld) = flds(i+1,ld)
87                 ENDDO
88                 flds(md-1,ld) = cdiag(mate)
89               ELSEIF ( j.GT.md ) THEN
90                 WRITE(msgBuf,'(2A,2(A,I4),2A)')
91         &         ' move ',flds(j,ld),' from ',j,'  up to ',md,
92         &         ' just before ',flds(md,ld)
93                 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
94         &                           SQUEEZE_RIGHT, myThid )
95                 DO i=j,md+1,-1
96                   flds(i,ld) = flds(i-1,ld)
97                 ENDDO
98                 flds(md,ld) = cdiag(mate)
99               ENDIF
100             ENDIF
101           ENDDO
102           IF ( found ) THEN
103             WRITE(msgBuf,'(2A,I4,A)') 'DIAGNOSTICS_SET_POINTERS: ',
104         &             'Updated list in Outp.Stream #', ld, ' :'
105             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
106         &                       SQUEEZE_RIGHT, myThid )
107             DO md = 1,nfields(ld),10
108               j = MIN(nfields(ld),md+9)
109               WRITE(msgBuf,'(21A)') ' Fields:   ',(' ',flds(i,ld),i=md,j)
110               CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
111         &                         SQUEEZE_RIGHT, myThid )
112             ENDDO
113           ENDIF
114          ENDDO
115    
116    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
117    
118  C--   Initialize pointer arrays to zero:  C--   Initialize pointer arrays to zero:
119        DO ld=1,numLists        DO ld=1,numLists
120         DO md=1,numperList         DO md=1,numperList
# Line 91  C        Search all possible model diagn Line 164  C        Search all possible model diagn
164       &    '  space allocated for all diagnostics:',       &    '  space allocated for all diagnostics:',
165       &    ndiagcount, ' levels'       &    ndiagcount, ' levels'
166          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
167       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT, myThid )
168        ELSE        ELSE
169         IF ( ndiagcount.GT.numDiags ) THEN         IF ( ndiagcount.GT.numDiags ) THEN
170           WRITE(msgBuf,'(2A)')           WRITE(msgBuf,'(2A)')
# Line 143  C     and if it exists. Note: for now, o Line 216  C     and if it exists. Note: for now, o
216       &         nd, '  ', cdiag(nd), ' , Parms: ', gdiag(nd)(1:10),       &         nd, '  ', cdiag(nd), ' , Parms: ', gdiag(nd)(1:10),
217       &             ' , mate:', hdiag(nd)       &             ' , mate:', hdiag(nd)
218            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
219       &                        SQUEEZE_RIGHT , myThid)       &                        SQUEEZE_RIGHT, myThid )
220           ENDIF           ENDIF
221    
222          ENDIF          ENDIF
Legend:
Removed from v.1.15  
changed lines
  Added in v.1.16
  ViewVC Help
Powered by ViewVC 1.1.22