/[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.30 by jmc, Sun Dec 24 20:15:42 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 337  C jmc: for now, this can only work in an Line 337  C jmc: for now, this can only work in an
337             ENDIF             ENDIF
338            ENDIF            ENDIF
339    
340  #ifdef ALLOW_MDSIO  C--    Ready to write field "md", element "lm" in averageCycle(listId)
341  C         Prepare for mdsio optionality  
342            IF (diag_mdsio) THEN  C-        write to binary file, using MDSIO pkg:
343              glf = globalFiles            IF ( diag_mdsio ) THEN
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              CALL MDSWRITEFIELD_NEW(fn,prec,glf,.FALSE.,'RL',  C         a hack not to write meta files now: pass -nRec < 0 to MDS_WRITE S/R
351       &              NrMax,nlevels(listId),qtmp1,nRec,myIter,myThid)              CALL WRITE_REC_LEV_RL(
352         I                            fn, prec,
353         I                            NrMax, 1, nlevels(listId),
354         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
# Line 465  C--     end of Processing Fld # md Line 467  C--     end of Processing Fld # md
467          ENDIF          ENDIF
468        ENDDO        ENDDO
469    
470    #ifdef ALLOW_MDSIO
471          IF (diag_mdsio) THEN
472    C-    Note: temporary: since it's a pain to add more arguments to
473    C     all MDSIO S/R, uses instead this specific S/R to write only
474    C     meta files but with more informations in it.
475                glf = globalFiles
476                nRec = nfields(listId)*averageCycle(listId)
477                CALL MDS_WR_METAFILES(fn, prec, glf, .FALSE.,
478         &              0, 0, nlevels(listId), ' ',
479         &              nfields(listId), flds(1,listId), 1, myTime,
480         &              nRec, myIter, myThid)
481          ENDIF
482    #endif /*  ALLOW_MDSIO  */
483    
484        RETURN        RETURN
485        END        END
486    
Legend:
Removed from v.1.30  
changed lines
  Added in v.1.34
  ViewVC Help
Powered by ViewVC 1.1.22