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

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

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

revision 1.4 by edhill, Mon Feb 21 04:41:52 2005 UTC revision 1.11 by heimbach, Sat Nov 4 14:28:09 2006 UTC
# Line 2  C $Header$ Line 2  C $Header$
2  C $Name$  C $Name$
3    
4  #include "DIAG_OPTIONS.h"  #include "DIAG_OPTIONS.h"
5          
6  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7  CBOP 0  CBOP 0
8  C     !ROUTINE: DIAGNOSTICS_INIT_VARIA  C     !ROUTINE: DIAGNOSTICS_INIT_VARIA
# Line 13  C     !INTERFACE: Line 13  C     !INTERFACE:
13    
14  C     !DESCRIPTION:  C     !DESCRIPTION:
15  C     Initialize the qdiag array which accumulates during integration  C     Initialize the qdiag array which accumulates during integration
16          
17  C     !USES:  C     !USES:
18        IMPLICIT NONE        IMPLICIT NONE
19  #include "SIZE.h"  #include "SIZE.h"
# Line 27  C     !INPUT PARAMETERS: Line 27  C     !INPUT PARAMETERS:
27  CEOP  CEOP
28    
29  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
30        INTEGER i,j,n,bi,bj        INTEGER i,j,k,bi,bj
       CHARACTER*(80) fn  
   
 #ifdef ALLOW_MDSIO  
       LOGICAL glf  
       INTEGER dUnit  
 #endif /* ALLOW_MDSIO */  
   
 #ifdef ALLOW_MNC  
       INTEGER ii  
       CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn  
       INTEGER CW_DIMS, NLEN  
       PARAMETER ( CW_DIMS = 10 )  
       PARAMETER ( NLEN    = 80 )  
       INTEGER dim(CW_DIMS), ib(CW_DIMS), ie(CW_DIMS)  
       CHARACTER*(NLEN) dn(CW_DIMS)  
       CHARACTER*(NLEN) d_cw_name  
       CHARACTER*(NLEN) dn_blnk  
 #endif /*  ALLOW_MNC  */  
31    
32  C     Zero out the qdiag array which accumulates during integration  C     Zero out the qdiag array which accumulates during integration
33        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
34          DO bi = myBxLo(myThid), myBxHi(myThid)          DO bi = myBxLo(myThid), myBxHi(myThid)
35            DO n = 1,numdiags            DO k = 1,numdiags
36              DO j = 1-Oly,sNy+Oly              DO j = 1-Oly,sNy+Oly
37                DO i = 1-Olx,sNx+Olx                DO i = 1-Olx,sNx+Olx
38                  qdiag(i,j,n,bi,bj) = 0. _d 0                  qdiag(i,j,k,bi,bj) = 0. _d 0
39                ENDDO                ENDDO
40              ENDDO              ENDDO
41    C     Zero out the counters for the qdiag array
42                ndiag(k,bi,bj) = 0
43              ENDDO
44              DO k = 1,numlists
45    C     Zero out the index array for periodic averaging diagnostic
46                pdiag(k,bi,bj) = 0
47            ENDDO            ENDDO
48          ENDDO          ENDDO
49        ENDDO        ENDDO
50    
51    C     Zero out the qSdiag array (statistics) which accumulates during integration
52  C     Add pickup capability        DO bj = myByLo(myThid), myByHi(myThid)
53        IF (diag_pickup_read) THEN          DO bi = myBxLo(myThid), myBxHi(myThid)
54              DO k = 1,diagSt_size
55  #ifdef ALLOW_MNC              DO j = 0,nRegions
56          IF (diag_pickup_read_mnc) THEN                DO i = 0,nStats
57            DO i = 1,NLEN                  qSdiag(i,j,k,bi,bj) = 0. _d 0
58              dn_blnk(i:i) = ' '                ENDDO
59            ENDDO              ENDDO
           DO i = 1,MAX_LEN_FNAM  
             diag_mnc_bn(i:i) = ' '  
60            ENDDO            ENDDO
61            WRITE(diag_mnc_bn,'(A)') 'pickup_diagnostics'          ENDDO
62          ENDDO
63    
64  C         Update the record dimension by writing the iteration number        CALL DIAGNOSTICS_READ_PICKUP( myThid )
           CALL MNC_FILE_CLOSE_ALL_MATCHING(diag_mnc_bn, myThid)  
           CALL MNC_CW_SET_UDIM(diag_mnc_bn, 1, myThid)  
             
 C         Read the qdiag() array  
           d_cw_name(1:NLEN) = dn_blnk(1:NLEN)  
           DO ii = 1,CW_DIMS  
             dn(ii)(1:NLEN) = dn_blnk(1:NLEN)  
           ENDDO  
           d_cw_name(1:10) = 'diag_state'  
           dn(1)(1:3) = 'Xp1'  
           dim(1)     = sNx + 2*OLx  
           ib(1)      = OLx + 1  
           ie(1)      = OLx + sNx + 1  
           dn(2)(1:3) = 'Yp1'  
           dim(2)     = sNy + 2*OLy  
           ib(2)      = OLy + 1  
           ie(2)      = OLy + sNy + 1  
           dn(3)(1:2) = 'Zd'  
           dim(3)     = numdiags  
           ib(3)      = 1  
           ie(3)      = numdiags  
           dn(4)(1:1) = 'T'  
           dim(4)     = -1  
           ib(4)      = 1  
           ie(4)      = 1  
           CALL MNC_CW_ADD_GNAME(d_cw_name, 4,  
      &         dim, dn, ib, ie, myThid)  
           CALL MNC_CW_ADD_VNAME(d_cw_name, d_cw_name,  
      &         4,5, myThid)  
           CALL MNC_CW_RL_R('D',diag_mnc_bn,0,0,  
      &         d_cw_name, qdiag, myThid)  
           CALL MNC_CW_DEL_VNAME(d_cw_name, myThid)  
           CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)  
             
 C         Read the ndiag() array  
           d_cw_name(1:NLEN) = dn_blnk(1:NLEN)  
           DO ii = 1,CW_DIMS  
             dn(ii)(1:NLEN) = dn_blnk(1:NLEN)  
           ENDDO  
           d_cw_name(1:10) = 'diag_count'  
           dn(1)(1:2) = 'Nd'  
           dim(1)     = numdiags  
           ib(1)      = 1  
           ie(1)      = numdiags  
           dn(2)(1:1) = 'T'  
           dim(2)     = -1  
           ib(2)      = 1  
           ie(2)      = 1  
           CALL MNC_CW_ADD_GNAME(d_cw_name, 2,  
      &         dim, dn, ib, ie, myThid)  
           CALL MNC_CW_ADD_VNAME(d_cw_name, d_cw_name,  
      &         4,5, myThid)  
           CALL MNC_CW_ADD_VATTR_TEXT(d_cw_name,'description',  
      &         'diagnostics state',myThid)  
           CALL MNC_CW_RL_R('I',diag_mnc_bn,0,0,  
      &         d_cw_name, ndiag, myThid)  
           CALL MNC_CW_DEL_VNAME(d_cw_name, myThid)  
           CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)  
   
         ENDIF  
 #endif /* ALLOW_MNC */  
             
 #ifdef ALLOW_MDSIO  
         IF (diag_pickup_read_mdsio) THEN  
           _BEGIN_MASTER(myThid)  
   
 C         Read qdiag()  
           DO i = 1,80  
             fn(i:i) = ' '  
           ENDDO  
           write(fn,'(A,I10.10)') 'pickup_qdiag', nIter0  
           glf = globalFiles  
           CALL MDSREADFIELD(fn,readBinaryPrec,glf,'RL',  
      &         numdiags,qdiag,1,myThid)  
   
 C         Read ndiag()  
           DO i = 1,80  
             fn(i:i) = ' '  
           ENDDO  
           WRITE(fn,'(A,I10.10)') 'pickup_ndiag.', nIter0  
           CALL MDSFINDUNIT( dUnit, mythid )  
           OPEN( dUnit, file=fn )  
           DO i = 1,numdiags  
             READ(dUnit,'(I10)') ndiag(i)  
           ENDDO  
           CLOSE( dUnit )  
           _END_MASTER(myThid)  
         ENDIF  
 #endif /* ALLOW_MDSIO */  
65    
66        ENDIF        CALL DIAGNOSTICS_SUMMARY( startTime, nIter0, myThid )
67    
68        RETURN        RETURN
69        END        END
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22