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

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

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

revision 1.31 by jmc, Fri Dec 29 05:43:56 2006 UTC revision 1.34 by jmc, Tue Nov 13 19:43:44 2007 UTC
# Line 27  C     !USES: Line 27  C     !USES:
27  #include "DIAGNOSTICS.h"  #include "DIAGNOSTICS.h"
28    
29        INTEGER NrMax        INTEGER NrMax
30  #ifdef ALLOW_FIZHI        PARAMETER( NrMax = numLevels )
 #include "fizhi_SIZE.h"  
       PARAMETER( NrMax = Nr+Nrphys )  
 #else  
       PARAMETER( NrMax = Nr )  
 #endif  
   
31    
32  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
33  C     listId  :: Diagnostics list number being written  C     listId  :: Diagnostics list number being written
# Line 52  C     ndId  :: diagnostics  Id number (i Line 46  C     ndId  :: diagnostics  Id number (i
46  C     mate  :: counter mate Id number (in available diagnostics list)  C     mate  :: counter mate Id number (in available diagnostics list)
47  C     ip    :: diagnostics  pointer to storage array  C     ip    :: diagnostics  pointer to storage array
48  C     im    :: counter-mate pointer to storage array  C     im    :: counter-mate pointer to storage array
49    C
50    C--   COMMON /LOCAL_DIAGNOSTICS_OUT/ local common block (for multi-threaded)
51    C     qtmp1 :: thread-shared temporary array (needs to be in common block):
52    C              to write a diagnostic field to file, copy it first from (big)
53    C              diagnostic storage qdiag into it.
54          COMMON /LOCAL_DIAGNOSTICS_OUT/ qtmp1
55          _RL qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy)
56    
57        INTEGER i, j, k, lm        INTEGER i, j, k, lm
58        INTEGER bi, bj        INTEGER bi, bj
59        INTEGER md, ndId, ip, im        INTEGER md, ndId, ip, im
60        INTEGER mate, mVec        INTEGER mate, mVec
61        CHARACTER*8 parms1        CHARACTER*8 parms1
       _RL qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy)  
62        _RL undef, getcon        _RL undef, getcon
63        _RL tmpLev        _RL tmpLev
64        EXTERNAL getcon        EXTERNAL getcon
# Line 69  C     im    :: counter-mate pointer to s Line 70  C     im    :: counter-mate pointer to s
70        CHARACTER*(MAX_LEN_FNAM) fn        CHARACTER*(MAX_LEN_FNAM) fn
71        CHARACTER*(MAX_LEN_MBUF) suff        CHARACTER*(MAX_LEN_MBUF) suff
72        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
73          INTEGER prec, nRec
74  #ifdef ALLOW_MDSIO  #ifdef ALLOW_MDSIO
75        LOGICAL glf        LOGICAL glf
       INTEGER nRec  
       INTEGER prec  
76  #endif  #endif
77  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
78        INTEGER ii        INTEGER ii
# Line 339  C jmc: for now, this can only work in an Line 339  C jmc: for now, this can only work in an
339    
340  C--    Ready to write field "md", element "lm" in averageCycle(listId)  C--    Ready to write field "md", element "lm" in averageCycle(listId)
341    
 #ifdef ALLOW_MDSIO  
342  C-        write to binary file, using MDSIO pkg:  C-        write to binary file, using MDSIO pkg:
343            IF (diag_mdsio) THEN            IF ( diag_mdsio ) THEN
             glf = globalFiles  
344              nRec = lm + (md-1)*averageCycle(listId)              nRec = lm + (md-1)*averageCycle(listId)
345  C           default precision for output files  C           default precision for output files
346              prec = writeBinaryPrec              prec = writeBinaryPrec
347  C           fFlag(1)=R(or D): force it to be 32-bit(or 64) precision  C           fFlag(1)=R(or D): force it to be 32-bit(or 64) precision
348              IF ( fflags(listId)(1:1).EQ.'R' ) prec = precFloat32              IF ( fflags(listId)(1:1).EQ.'R' ) prec = precFloat32
349              IF ( fflags(listId)(1:1).EQ.'D' ) prec = precFloat64              IF ( fflags(listId)(1:1).EQ.'D' ) prec = precFloat64
350  c           CALL MDS_WRITE_FIELD(fn,prec,glf,.FALSE.,'RL',  C         a hack not to write meta files now: pass -nRec < 0 to MDS_WRITE S/R
351  c    &              NrMax,nlevels(listId),qtmp1,nRec,myIter,myThid)              CALL WRITE_REC_LEV_RL(
352  C         a hack not to write meta files now:       I                            fn, prec,
353              CALL MDS_WRITE_FIELD(fn,prec,glf,.FALSE.,'RL',       I                            NrMax, 1, nlevels(listId),
354       &              NrMax,nlevels(listId),qtmp1,-nRec,myIter,myThid)       I                            qtmp1, -nRec, myIter, myThid )
355            ENDIF            ENDIF
 #endif /*  ALLOW_MDSIO  */  
356    
357  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
358            IF (useMNC .AND. diag_mnc) THEN            IF (useMNC .AND. diag_mnc) THEN
Legend:
Removed from v.1.31  
changed lines
  Added in v.1.34
  ViewVC Help
Powered by ViewVC 1.1.22