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

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

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

revision 1.9 by jmc, Tue Feb 5 15:31:19 2008 UTC revision 1.10 by jmc, Thu Aug 27 18:00:01 2009 UTC
# Line 39  C     myThid  :: Number of this instance Line 39  C     myThid  :: Number of this instance
39        INTEGER myIter        INTEGER myIter
40        INTEGER myThid        INTEGER myThid
41    
 #ifdef ALLOW_DIAGNOSTICS  
42  #ifdef DIAGNOSTICS_HAS_PICKUP  #ifdef DIAGNOSTICS_HAS_PICKUP
43    
44  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
45  C     fn      :: character buffer for creating filename  C     fn      :: character buffer for creating filename
46  C     prec    :: precision of pickup files  C     prec    :: precision of pickup files
47  c     INTEGER prec, iChar, lChar, k  c     INTEGER prec, iChar, lChar, k
48        INTEGER prec, lChar, i, sn        INTEGER prec, lChar, sn
49        CHARACTER*(MAX_LEN_FNAM) fn        CHARACTER*(MAX_LEN_FNAM) fn
50    
51        INTEGER  ILNBLNK        INTEGER  ILNBLNK
52        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
53    
 #ifdef ALLOW_MDSIO  
       LOGICAL lgf  
54        INTEGER dUnit, n, m        INTEGER dUnit, n, m
 #endif /* ALLOW_MDSIO */  
55    
56  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
57        INTEGER ii        INTEGER i, ii
58        CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn        CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn
59        INTEGER CW_DIMS, NLEN        INTEGER CW_DIMS, NLEN
60        PARAMETER ( CW_DIMS = 10 )        PARAMETER ( CW_DIMS = 10 )
# Line 173  C         Write the ndiag() array Line 169  C         Write the ndiag() array
169          ENDIF          ENDIF
170  #endif  #endif
171    
 #ifdef ALLOW_MDSIO  
172          IF (diag_pickup_write_mdsio) THEN          IF (diag_pickup_write_mdsio) THEN
           _BEGIN_MASTER( myThid )  
173    
174            sn = ILNBLNK(suff)            sn = ILNBLNK(suff)
175    
176  C         Write qdiag()  C         Write qdiag()
177            DO i = 1,80            WRITE(fn,'(a,a)') 'pickup_qdiag.', suff(1:sn)
             fn(i:i) = ' '  
           ENDDO  
           write(fn,'(a,a)') 'pickup_qdiag.', suff(1:sn)  
178            prec = precFloat64            prec = precFloat64
179            lgf = globalFiles            CALL WRITE_REC_3D_RL( fn, prec, numDiags, qdiag,
180            CALL MDSWRITEFIELD(fn,prec,lgf,'RL',numDiags,qdiag,       &                          1, myIter, myThid )
      &         1,myIter,myThid)  
181    
182  C         Write ndiag()  C         Write ndiag()
183            DO i = 1,80            _BARRIER
184              fn(i:i) = ' '            _BEGIN_MASTER( myThid )
           ENDDO  
185            WRITE(fn,'(a,a)') 'pickup_ndiag.', suff(1:sn)            WRITE(fn,'(a,a)') 'pickup_ndiag.', suff(1:sn)
186            CALL MDSFINDUNIT( dUnit, mythid )            CALL MDSFINDUNIT( dUnit, mythid )
187            OPEN( dUnit, file=fn )            OPEN( dUnit, file=fn )
188            DO n = 1,nlists            DO n = 1,nlists
189              DO m = 1,nfields(n)              DO m = 1,nfields(n)
190                WRITE(dUnit,'(I10)') ndiag(jdiag(m,n))                WRITE(dUnit,'(I10)') ndiag(jdiag(m,n),1,1)
191              ENDDO              ENDDO
192            ENDDO            ENDDO
193            CLOSE( dUnit )            CLOSE( dUnit )
194            _END_MASTER( myThid )            _END_MASTER( myThid )
195              _BARRIER
196          ENDIF          ENDIF
 #endif /* ALLOW_MDSIO */  
197    
198        ENDIF        ENDIF
199    
 #endif /* ALLOW_DIAGNOSTICS */  
200  #endif /* DIAGNOSTICS_HAS_PICKUP */  #endif /* DIAGNOSTICS_HAS_PICKUP */
201    
202        RETURN        RETURN
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22