/[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.16 by jmc, Mon Dec 20 01:53:54 2004 UTC revision 1.18 by jmc, Mon Feb 7 03:07:49 2005 UTC
# Line 8  CBOP 0 Line 8  CBOP 0
8  C     !ROUTINE: GETDIAG  C     !ROUTINE: GETDIAG
9    
10  C     !INTERFACE:  C     !INTERFACE:
11        SUBROUTINE GETDIAG (levreal,ipoint,undef,qtmp,myThid)        SUBROUTINE GETDIAG(
12         I                    levreal, undef,
13         O                    qtmp,
14         I                    ipoint, mate, bi, bj, myThid )
15    
16  C     !DESCRIPTION:  C     !DESCRIPTION:
17  C     Retrieve averaged model diagnostic  C     Retrieve averaged model diagnostic
18    
19  C     !USES:  C     !USES:
20        implicit none        IMPLICIT NONE
21  #include "EEPARAMS.h"  #include "EEPARAMS.h"
22  #include "SIZE.h"  #include "SIZE.h"
23  #include "DIAGNOSTICS_SIZE.h"  #include "DIAGNOSTICS_SIZE.h"
24  #include "DIAGNOSTICS.h"  #include "DIAGNOSTICS.h"
 CEOP  
25    
26  #ifdef ALLOW_FIZHI  C     !INPUT PARAMETERS:
 #include "fizhi_SIZE.h"  
 #else  
       integer Nrphys  
       parameter (Nrphys=0)  
 #endif  
   
 C     INPUT:  
27  C     levreal .... Diagnostic LEVEL  C     levreal .... Diagnostic LEVEL
 C     ipoint ..... DIAGNOSTIC NUMBER FROM MENU  
28  C     undef  ..... UNDEFINED VALUE  C     undef  ..... UNDEFINED VALUE
29  C     bi     ..... X-direction process(or) number  C     ipoint ..... DIAGNOSTIC NUMBER FROM MENU
30  C     bj     ..... Y-direction process(or) number  C     mate   ..... counter DIAGNOSTIC NUMBER if any ; 0 otherwise
31    C     bi     ..... X-direction tile number
32    C     bj     ..... Y-direction tile number
33    C     myThid ..... my thread Id number
34        _RL levreal        _RL levreal
       integer myThid,ipoint  
35        _RL undef        _RL undef
36          INTEGER ipoint, mate
37          INTEGER bi,bj, myThid
38    
39  C     OUTPUT:  C     !OUTPUT PARAMETERS:
40  C     qtmp    ..... AVERAGED DIAGNOSTIC QUANTITY  C     qtmp    ..... AVERAGED DIAGNOSTIC QUANTITY
41        _RL qtmp(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+Nrphys,nSx,nSy)        _RL qtmp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
   
       _RL factor  
       integer i,j,ipnt,klev  
       integer bi,bj  
       integer lev  
   
       if (ipoint.ge.1) then  
        lev = NINT(levreal)  
   
        klev = kdiag(ipoint)  
        if (klev.ge.lev) then  
         ipnt = idiag(ipoint) + lev - 1  
         factor = 1.0  
         if (ndiag(ipoint).ne.0) factor = 1.0/ndiag(ipoint)  
   
         do bj=myByLo(myThid), myByHi(myThid)  
           do bi=myBxLo(myThid), myBxHi(myThid)  
   
             do j = 1,sNy  
               do i = 1,sNx  
                 if ( qdiag(i,j,ipnt,bi,bj) .le. undef ) then  
                   qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)*factor  
                 else  
                   qtmp(i,j,lev,bi,bj) = undef  
                 endif  
               enddo  
             enddo  
   
           enddo  
         enddo  
   
        endif  
       endif  
   
       RETURN  
       END  
   
 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  
 CBOP 0  
 C     !ROUTINE: GETDIAG2  
   
 C     !INTERFACE:  
       SUBROUTINE GETDIAG2 (levreal,ipoint,undef,qtmp,myThid)  
   
 C     !DESCRIPTION:  
 C***********************************************************************  
 C  PURPOSE  
 C     Retrieve averaged model diagnostic  
 C  INPUT:  
 C  levreal .... Diagnostic LEVEL  
 C  ipoint ..... DIAGNOSTIC NUMBER FROM MENU  
 C   undef ..... UNDEFINED VALUE  
 C  
 C  OUTPUT:  
 C    qtmp ..... AVERAGED DIAGNOSTIC QUANTITY  
 C  
 C***********************************************************************  
   
 C     !USES:  
       implicit none  
 #include "EEPARAMS.h"  
 #include "SIZE.h"  
 #include "DIAGNOSTICS_SIZE.h"  
 #include "DIAGNOSTICS.h"  
42  CEOP  CEOP
43    
44  #ifdef ALLOW_FIZHI  C     !LOCAL VARIABLES:
45  #include "fizhi_SIZE.h"        _RL factor
46  #else        INTEGER i, j, ipnt,ipCt
47         integer Nrphys        INTEGER lev, levCt, klev
        parameter (Nrphys=0)  
 #endif  
   
       _RL levreal  
       integer myThid,ipoint  
       _RL undef  
       _RL qtmp(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+Nrphys,nSx,nSy)  
   
       integer i,j,ipnt,klev  
       integer bi,bj  
       integer lev  
48    
49        if (ipoint.ge.1) then        IF (ipoint.GE.1) THEN
50         lev = NINT(levreal)         lev = NINT(levreal)
   
51         klev = kdiag(ipoint)         klev = kdiag(ipoint)
52         if (klev.ge.lev) then         IF (lev.LE.klev) THEN
         ipnt = idiag(ipoint) + lev - 1  
   
         do bj=myByLo(myThid), myByHi(myThid)  
           do bi=myBxLo(myThid), myBxHi(myThid)  
53    
54              do j = 1,sNy          IF ( mate.EQ.0 ) THEN
55                do i = 1,sNx  C-      No counter diagnostics => average = Sum / ndiag :
                 if ( qdiag(i,j,ipnt,bi,bj) .le. undef ) then  
                   qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)  
                 else  
                   qtmp(i,j,lev,bi,bj) = undef  
                 endif  
               enddo  
             enddo  
56    
57            enddo            ipnt = idiag(ipoint) + lev - 1
58          enddo  c         factor = 1.0
59    c         if (ndiag(ipoint).ne.0) factor = 1.0/ndiag(ipoint)
60              factor = FLOAT(ndiag(ipoint))
61              IF (ndiag(ipoint).NE.0) factor = 1. _d 0 / factor
62    
63              DO j = 1,sNy+1
64                DO i = 1,sNx+1
65                  IF ( qdiag(i,j,ipnt,bi,bj) .LE. undef ) THEN
66                    qtmp(i,j) = qdiag(i,j,ipnt,bi,bj)*factor
67                  ELSE
68                    qtmp(i,j) = undef
69                  ENDIF
70                ENDDO
71              ENDDO
72    
73            ELSE
74    C-      With counter diagnostics => average = Sum / counter:
75    
76              ipnt = idiag(ipoint) + lev - 1
77              levCt= MIN(lev,kdiag(mate))
78              ipCt = idiag(mate) + levCt - 1
79              DO j = 1,sNy+1
80                DO i = 1,sNx+1
81                  IF ( qdiag(i,j,ipCt,bi,bj) .NE. 0. ) THEN
82                    qtmp(i,j) = qdiag(i,j,ipnt,bi,bj)
83         &                    / qdiag(i,j,ipCt,bi,bj)
84                  ELSE
85                    qtmp(i,j) = undef
86                  ENDIF
87                ENDDO
88              ENDDO
89    
90         endif          ENDIF
91        endif         ENDIF
92          ENDIF
93    
94        RETURN        RETURN
95        END        END
# Line 281  C     !LOCAL VARIABLES: Line 223  C     !LOCAL VARIABLES:
223    
224        RETURN        RETURN
225        END        END
226    
227    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
228    
229    CBOP 0
230    C     !ROUTINE: DIAGS_MK_UNITS
231    
232    C     !INTERFACE:
233          CHARACTER*16 FUNCTION DIAGS_MK_UNITS(
234         I                            diagUnitsInPieces, myThid )
235    
236    C     !DESCRIPTION:
237    C     *==========================================================*
238    C     | FUNCTION DIAGS_MK_UNITS
239    C     | o Return the diagnostic units string (16c) removing
240    C     |   blanks from the input string
241    C     *==========================================================*
242    
243    C     !USES:
244          IMPLICIT NONE
245    #include "EEPARAMS.h"
246    
247    C     !INPUT PARAMETERS:
248    C     diagUnitsInPieces :: string for diagnostic units: in several
249    C                          pieces, with blanks in between
250    C     myThid            ::  my thread Id number
251          CHARACTER*(*) diagUnitsInPieces
252          INTEGER      myThid
253    CEOP
254    
255    C     !LOCAL VARIABLES:
256          CHARACTER*(MAX_LEN_MBUF) msgBuf
257          INTEGER i,j,n
258    
259          DIAGS_MK_UNITS = '          '
260          n = LEN(diagUnitsInPieces)
261          
262          j = 0
263          DO i=1,n
264           IF (diagUnitsInPieces(i:i) .NE. ' ' ) THEN
265             j = j+1
266             IF ( j.LE.16 ) DIAGS_MK_UNITS(j:j) = diagUnitsInPieces(i:i)
267           ENDIF
268          ENDDO
269    
270          IF ( j.GT.16 ) THEN
271             WRITE(msgBuf,'(2A,I4,A)') '**WARNING** ',
272         &   'DIAGS_MK_UNITS: too long (',j,' >16) input string'
273            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
274         &       SQUEEZE_RIGHT , myThid)
275             WRITE(msgBuf,'(3A)') '**WARNING** ',
276         &   'DIAGS_MK_UNITS: input=', diagUnitsInPieces
277            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
278         &       SQUEEZE_RIGHT , myThid)
279          ENDIF
280    
281          RETURN
282          END
Legend:
Removed from v.1.16  
changed lines
  Added in v.1.18
  ViewVC Help
Powered by ViewVC 1.1.22