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

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

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

revision 1.1 by jmc, Fri May 20 07:28:52 2005 UTC revision 1.2 by jmc, Sun Jun 26 16:51:49 2005 UTC
# Line 33  CEOP Line 33  CEOP
33  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
34  C     == Local variables ==  C     == Local variables ==
35        INTEGER ndiagcount        INTEGER ndiagcount
36        INTEGER m,mm,n        INTEGER md,ld,nd
37        INTEGER mate, nActiveMax        INTEGER mm, mate, nActiveMax
38        INTEGER i,j,l        INTEGER j, k, l
39        LOGICAL found, addMate2List, inList        LOGICAL found, addMate2List, inList
40        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
41    
# Line 43  C     == Local variables == Line 43  C     == Local variables ==
43        _BEGIN_MASTER( myThid)        _BEGIN_MASTER( myThid)
44    
45  C--   Initialize pointer arrays to zero:  C--   Initialize pointer arrays to zero:
46        DO n=1,ndiagMax        DO ld=1,numlists
47          iSdiag(n) = 0         DO md=1,numperlist
48            iSdiag(md,ld) = 0
49            jSdiag(md,ld) = 0
50            mSdiag(md,ld) = 0
51           ENDDO
52        ENDDO        ENDDO
53    
54  C--   Calculate pointers for diagnostics set to non-zero frequency  C--   Calculate pointers for diagnostics set to non-zero frequency
55    
56        ndiagcount = 0        ndiagcount = 0
57        nActiveMax = 0        nActiveMax = 0
58        DO n=1,diagSt_nbLists        DO ld=1,diagSt_nbLists
59         diagSt_nbActv(n) = diagSt_nbFlds(n)         diagSt_nbActv(ld) = diagSt_nbFlds(ld)
60         DO m=1,diagSt_nbFlds(n)         DO md=1,diagSt_nbFlds(ld)
61    
62           found = .FALSE.           found = .FALSE.
63  C        Search all possible model diagnostics  C        Search all possible model diagnostics
64           DO mm=1,ndiagt           DO nd=1,ndiagt
65            IF ( diagSt_Flds(m,n).EQ.cdiag(mm) ) THEN            IF ( diagSt_Flds(md,ld).EQ.cdiag(nd) ) THEN
66              CALL DIAGSTATS_SETDIAG (mate,ndiagcount,mm,myThid)              CALL DIAGSTATS_SETDIAG(mate,ndiagcount,md,ld,nd,myThid)
67              found = .TRUE.              found = .TRUE.
68              jSdiag(m,n) = mm              jSdiag(md,ld) = nd
69            ENDIF            ENDIF
70           ENDDO           ENDDO
71           IF ( .NOT.found ) THEN           IF ( .NOT.found ) THEN
72             WRITE(msgBuf,'(3A)') 'DIAGSTATS_SET_POINTERS: ',             WRITE(msgBuf,'(3A)') 'DIAGSTATS_SET_POINTERS: ',
73       &                      diagSt_Flds(m,n),' is not a Diagnostic'       &                     diagSt_Flds(md,ld),' is not a Diagnostic'
74             CALL PRINT_ERROR( msgBuf , myThid )             CALL PRINT_ERROR( msgBuf , myThid )
75             STOP 'ABNORMAL END: S/R DIAGSTATS_SET_POINTERS'             STOP 'ABNORMAL END: S/R DIAGSTATS_SET_POINTERS'
76           ENDIF           ENDIF
77           IF ( found .AND. mate.LE.-1 ) THEN           IF ( found .AND. mate.LE.-1 ) THEN
78  C-       add this fields to the active list in case regions are differents:  C-       add this fields to the active list in case regions are differents:
            mate = -mate  
79             addMate2List = .FALSE.             addMate2List = .FALSE.
80             DO l=1,n-1             DO l=1,ld-1
81              inList = .FALSE.              inList = .FALSE.
82              DO i=1,diagSt_nbActv(l)              DO k=1,diagSt_nbActv(l)
83                IF ( diagSt_Flds(i,l).EQ.cdiag(mate) ) inList=.TRUE.                IF ( diagSt_Flds(k,l).EQ.cdiag(-mate) ) inList=.TRUE.
84              ENDDO              ENDDO
85              IF ( inList ) THEN              IF ( inList ) THEN
86               DO j=0,nRegions               DO j=0,nRegions
87                addMate2List = addMate2List                addMate2List = addMate2List
88       &                 .OR. (diagSt_region(j,l).LT.diagSt_region(j,n))       &                 .OR. (diagSt_region(j,l).LT.diagSt_region(j,ld))
89               ENDDO               ENDDO
90              ENDIF              ENDIF
91             ENDDO             ENDDO
92             IF ( .NOT.addMate2List ) mate = 0             IF ( .NOT.addMate2List ) mate = 0
93           ENDIF           ENDIF
94           IF ( found .AND. mate.GE.1 ) THEN           IF ( found .AND. mate.NE.0 ) THEN
95              diagSt_nbActv(n) = diagSt_nbActv(n) + 1              mm = diagSt_nbActv(ld) + 1
96              IF ( diagSt_nbActv(n).LE.numperlist ) THEN              IF ( mm.LE.numperlist ) THEN
97               jSdiag( diagSt_nbActv(n), n ) = mate               iSdiag(mm,ld) = SIGN(mSdiag(md,ld),mate)
98               diagSt_Flds( diagSt_nbActv(n), n ) = cdiag(mate)               mate = ABS(mate)
99             ENDIF               jSdiag(mm,ld) = mate
100                 diagSt_Flds(mm,ld) = cdiag(mate)
101                ENDIF
102                diagSt_nbActv(ld) = mm
103           ENDIF           ENDIF
104    
105         ENDDO         ENDDO
106         nActiveMax = MAX(diagSt_nbActv(n),nActiveMax)         nActiveMax = MAX(diagSt_nbActv(ld),nActiveMax)
107        ENDDO        ENDDO
108    
109        IF (  ndiagcount.LE.diagSt_size .AND.        IF (  ndiagcount.LE.diagSt_size .AND.
110       &      nActiveMax.LE.numperlist ) THEN       &      nActiveMax.LE.numperlist ) THEN
111          WRITE(msgBuf,'(A,I6,A)')          WRITE(msgBuf,'(A,I6,A)')
112       &    '  space allocated for all stats-diags:',       &    '  space allocated for all stats-diags:',
113       &    ndiagcount, ' levels'       &    ndiagcount, ' levels'
114          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
115       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid)
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22