--- MITgcm/pkg/diagnostics/diagnostics_out.F 2004/12/14 20:19:30 1.3 +++ MITgcm/pkg/diagnostics/diagnostics_out.F 2006/12/29 23:57:15 1.32 @@ -1,4 +1,4 @@ -C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/diagnostics/diagnostics_out.F,v 1.3 2004/12/14 20:19:30 jmc Exp $ +C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/diagnostics/diagnostics_out.F,v 1.32 2006/12/29 23:57:15 jmc Exp $ C $Name: $ #include "DIAG_OPTIONS.h" @@ -9,74 +9,100 @@ C !INTERFACE: SUBROUTINE DIAGNOSTICS_OUT( - I listnum, + I listId, I myIter, + I myTime, I myThid ) C !DESCRIPTION: C Write output for diagnostics fields. - + C !USES: IMPLICIT NONE #include "SIZE.h" #include "EEPARAMS.h" #include "PARAMS.h" +#include "GRID.h" #include "DIAGNOSTICS_SIZE.h" #include "DIAGNOSTICS.h" + INTEGER NrMax #ifdef ALLOW_FIZHI #include "fizhi_SIZE.h" + PARAMETER( NrMax = Nr+Nrphys ) #else - INTEGER Nrphys - PARAMETER (Nrphys=0) + PARAMETER( NrMax = Nr ) #endif - C !INPUT PARAMETERS: -C listnum :: Diagnostics list number being written +C listId :: Diagnostics list number being written C myIter :: current iteration number +C myTime :: current time of simulation (s) C myThid :: my Thread Id number - INTEGER listnum, myIter, myThid + _RL myTime + INTEGER listId, myIter, myThid CEOP C !LOCAL VARIABLES: - INTEGER i, j, k, m, n, bi, bj +C i,j,k :: loop indices +C lm :: loop index (averageCycle) +C md :: field number in the list "listId". +C ndId :: diagnostics Id number (in available diagnostics list) +C mate :: counter mate Id number (in available diagnostics list) +C ip :: diagnostics pointer to storage array +C im :: counter-mate pointer to storage array +C +C-- COMMON /LOCAL_DIAGNOSTICS_OUT/ local common block (for multi-threaded) +C qtmp1 :: thread-shared temporary array (needs to be in common block): +C to write a diagnostic field to file, copy it first from (big) +C diagnostic storage qdiag into it. + COMMON /LOCAL_DIAGNOSTICS_OUT/ qtmp1 + _RL qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy) + + INTEGER i, j, k, lm + INTEGER bi, bj + INTEGER md, ndId, ip, im + INTEGER mate, mVec CHARACTER*8 parms1 - CHARACTER*3 mate_index - INTEGER mate - _RL qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+Nrphys,nSx,nSy) - _RL qtmp2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+Nrphys,nSx,nSy) _RL undef, getcon + _RL tmpLev EXTERNAL getcon INTEGER ILNBLNK EXTERNAL ILNBLNK INTEGER ilen - CHARACTER*(MAX_LEN_FNAM) pref + INTEGER ioUnit + CHARACTER*(MAX_LEN_FNAM) fn CHARACTER*(MAX_LEN_MBUF) suff CHARACTER*(MAX_LEN_MBUF) msgBuf - CHARACTER*(80) fn +#ifdef ALLOW_MDSIO LOGICAL glf + INTEGER nRec + INTEGER prec +#endif #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 +#ifdef DIAG_MNC_COORD_NEEDSWORK + CHARACTER*(5) ctmp + _RS ztmp(NrMax) +#endif #endif /* ALLOW_MNC */ C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| + ioUnit= standardMessageUnit undef = getcon('UNDEF') - glf = globalFiles WRITE(suff,'(I10.10)') myIter - pref = fnames(listnum) - ilen=ILNBLNK( pref ) - WRITE( fn, '(A,A,A)' ) pref(1:ilen),'.',suff(1:10) + ilen = ILNBLNK(fnames(listId)) + WRITE( fn, '(A,A,A)' ) fnames(listId)(1:ilen),'.',suff(1:10) #ifdef ALLOW_MNC IF (useMNC .AND. diag_mnc) THEN @@ -86,67 +112,153 @@ DO i = 1,NLEN dn_blnk(i:i) = ' ' ENDDO -c WRITE( diag_mnc_bn, '(A,A)' ) 'diag.', pref(1:ilen) - WRITE( diag_mnc_bn, '(A)' ) pref(1:ilen) + WRITE( diag_mnc_bn, '(A)' ) fnames(listId)(1:ilen) C Update the record dimension by writing the iteration number CALL MNC_CW_SET_UDIM(diag_mnc_bn, -1, myThid) - CALL MNC_CW_I_W_S('I',diag_mnc_bn,0,0,'iter',myIter,myThid) + CALL MNC_CW_RL_W_S('D',diag_mnc_bn,0,0,'T',myTime,myThid) CALL MNC_CW_SET_UDIM(diag_mnc_bn, 0, myThid) + CALL MNC_CW_I_W_S('I',diag_mnc_bn,0,0,'iter',myIter,myThid) + +C NOTE: at some point it would be a good idea to add a time_bounds +C variable that has dimension (2,T) and clearly denotes the +C beginning and ending times for each diagnostics period dn(1)(1:NLEN) = dn_blnk(1:NLEN) - WRITE(dn(1),'(a,i6.6)') 'Zd', nlevels(listnum) - dim(1) = nlevels(listnum) + WRITE(dn(1),'(a,i6.6)') 'Zmd', nlevels(listId) + dim(1) = nlevels(listId) ib(1) = 1 - ie(1) = nlevels(listnum) + ie(1) = nlevels(listId) - CALL MNC_CW_ADD_GNAME('diag_levels', 1, + CALL MNC_CW_ADD_GNAME('diag_levels', 1, & dim, dn, ib, ie, myThid) - CALL MNC_CW_ADD_VNAME('level_indicies', 'diag_levels', + CALL MNC_CW_ADD_VNAME('diag_levels', 'diag_levels', & 0,0, myThid) - CALL MNC_CW_ADD_VATTR_TEXT('level_indicies','description', - & 'Idicies of vertical levels within the data source arrays', + CALL MNC_CW_ADD_VATTR_TEXT('diag_levels','description', + & 'Idicies of vertical levels within the source arrays', & myThid) - - CALL MNC_CW_RL_W('I',diag_mnc_bn,0,0, - & 'level_indicies', levs(1,listnum), myThid) - CALL MNC_CW_DEL_VNAME('level_indicies', myThid) + CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0, + & 'diag_levels', levs(1,listId), myThid) + + CALL MNC_CW_DEL_VNAME('diag_levels', myThid) CALL MNC_CW_DEL_GNAME('diag_levels', myThid) + +#ifdef DIAG_MNC_COORD_NEEDSWORK +C This part has been placed in an #ifdef because, as its currently +C written, it will only work with variables defined on a dynamics +C grid. As we start using diagnostics for physics grids, ice +C levels, land levels, etc. the different vertical coordinate +C dimensions will have to be taken into account. + +C 20051021 JMC & EH3 : We need to extend this so that a few +C variables each defined on different grids do not have the same +C vertical dimension names so we should be using a pattern such +C as: Z[uml]td000000 where the 't' is the type as specified by +C gdiag(10) + +C Now define: Zmdxxxxxx, Zudxxxxxx, Zldxxxxxx + ctmp(1:5) = 'mul ' + DO i = 1,3 + dn(1)(1:NLEN) = dn_blnk(1:NLEN) + WRITE(dn(1),'(3a,i6.6)') 'Z',ctmp(i:i),'d',nlevels(listId) + CALL MNC_CW_ADD_GNAME(dn(1), 1, dim, dn, ib, ie, myThid) + CALL MNC_CW_ADD_VNAME(dn(1), dn(1), 0,0, myThid) + +C The following three ztmp() loops should eventually be modified +C to reflect the fractional nature of levs(j,l) -- they should +C do something like: +C ztmp(j) = rC(INT(FLOOR(levs(j,l)))) +C + ( rC(INT(FLOOR(levs(j,l)))) +C + rC(INT(CEIL(levs(j,l)))) ) +C / ( levs(j,l) - FLOOR(levs(j,l)) ) +C for averaged levels. + IF (i .EQ. 1) THEN + DO j = 1,nlevels(listId) + ztmp(j) = rC(NINT(levs(j,listId))) + ENDDO + CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description', + & 'Dimensional coordinate value at the mid point', + & myThid) + ELSEIF (i .EQ. 2) THEN + DO j = 1,nlevels(listId) + ztmp(j) = rF(NINT(levs(j,listId)) + 1) + ENDDO + CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description', + & 'Dimensional coordinate value at the upper point', + & myThid) + ELSEIF (i .EQ. 3) THEN + DO j = 1,nlevels(listId) + ztmp(j) = rF(NINT(levs(j,listId))) + ENDDO + CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description', + & 'Dimensional coordinate value at the lower point', + & myThid) + ENDIF + CALL MNC_CW_RS_W('D',diag_mnc_bn,0,0, dn(1), ztmp, myThid) + CALL MNC_CW_DEL_VNAME(dn(1), myThid) + CALL MNC_CW_DEL_GNAME(dn(1), myThid) + ENDDO +#endif /* DIAG_MNC_COORD_NEEDSWORK */ + ENDIF #endif /* ALLOW_MNC */ - DO n = 1,nfields(listnum) - m = jdiag(n,listnum) - parms1 = gdiag(m)(1:8) - IF ( idiag(m).NE.0 .AND. parms1(5:5).NE.'D' ) THEN +C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| + + DO md = 1,nfields(listId) + ndId = jdiag(md,listId) + parms1 = gdiag(ndId)(1:8) + mate = 0 + mVec = 0 + IF ( parms1(5:5).EQ.'C' ) THEN +C- Check for Mate of a Counter Diagnostic + READ(parms1,'(5X,I3)') mate + ELSEIF ( parms1(1:1).EQ.'U' .OR. parms1(1:1).EQ.'V' ) THEN +C- Check for Mate of a Vector Diagnostic + READ(parms1,'(5X,I3)') mVec + ENDIF + IF ( idiag(md,listId).NE.0 .AND. parms1(5:5).NE.'D' ) THEN C-- Start processing 1 Fld : + DO lm=1,averageCycle(listId) + + ip = ABS(idiag(md,listId)) + kdiag(ndId)*(lm-1) + im = mdiag(md,listId) + IF (mate.GT.0) im = im + kdiag(mate)*(lm-1) + IF (mVec.GT.0) im = im + kdiag(mVec)*(lm-1) - IF ( ndiag(m).EQ.0 ) THEN + IF ( ndiag(ip,1,1).EQ.0 ) THEN C- Empty diagnostics case : _BEGIN_MASTER( myThid ) WRITE(msgBuf,'(A,I10)') & '- WARNING - from DIAGNOSTICS_OUT at iter=', myIter - CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, + CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, & SQUEEZE_RIGHT, myThid) WRITE(msgBuf,'(A,I4,3A,I3,2A)') - & '- WARNING - diag.#',m, ' : ',flds(n,listnum), - & ' (#',n,' ) in outp.Stream: ',fnames(listnum) - CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, + & '- WARNING - diag.#',ndId, ' : ',flds(md,listId), + & ' (#',md,' ) in outp.Stream: ',fnames(listId) + CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, & SQUEEZE_RIGHT, myThid) - WRITE(msgBuf,'(A,I2,A)') - & '- WARNING - has not been filled (ndiag=',ndiag(m),' )' - CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, + IF ( averageCycle(listId).GT.1 ) THEN + WRITE(msgBuf,'(A,2(I2,A))') + & '- WARNING - has not been filled (ndiag(lm=',lm,')=', + & ndiag(ip,1,1), ' )' + ELSE + WRITE(msgBuf,'(A,2(I2,A))') + & '- WARNING - has not been filled (ndiag=', + & ndiag(ip,1,1), ' )' + ENDIF + CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, & SQUEEZE_RIGHT, myThid) WRITE(msgBuf,'(A)') & 'WARNING DIAGNOSTICS_OUT => write ZEROS instead' - CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, + CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, & SQUEEZE_RIGHT, myThid) _END_MASTER( myThid ) DO bj = myByLo(myThid), myByHi(myThid) DO bi = myBxLo(myThid), myBxHi(myThid) - DO k = 1,nlevels(listnum) + DO k = 1,nlevels(listId) DO j = 1-OLy,sNy+OLy DO i = 1-OLx,sNx+OLx qtmp1(i,j,k,bi,bj) = 0. _d 0 @@ -159,65 +271,95 @@ ELSE C- diagnostics is not empty : - IF ( myThid.EQ.1 ) - & WRITE(6,2000) m,cdiag(m),ndiag(m),gdiag(m) - IF ( parms1(5:5).NE.'C' ) THEN - - DO k = 1,nlevels(listnum) - CALL GETDIAG (levs(k,listnum),m,undef,qtmp1,myThid) - ENDDO - -C Check for Mate of a Vector Diagnostic -C ------------------------------------- - IF ( parms1(1:1).EQ.'U' .OR. parms1(1:1).EQ.'V' ) THEN - mate_index = parms1(6:8) - READ (mate_index,'(I3)') mate - IF ( idiag(mate).NE.0 ) THEN - IF ( myThid.EQ.1 ) - & WRITE(6,2001) cdiag(m),mate,cdiag(mate) + IF ( debugLevel.GE.debLevA .AND. myThid.EQ.1 ) THEN + WRITE(ioUnit,'(A,I3,3A,I8,2A)') + & ' Computing Diagnostic # ', ndId, ' ', cdiag(ndId), + & ' Counter:',ndiag(ip,1,1),' Parms: ',gdiag(ndId) + IF ( mate.GT.0 ) THEN + WRITE(ioUnit,'(3A,I3,2A)') + & ' use Counter Mate for ', cdiag(ndId), + & ' Diagnostic # ',mate, ' ', cdiag(mate) + ELSEIF ( mVec.GT.0 ) THEN + IF ( im.GT.0 .AND. ndiag(MAX(1,im),1,1).GT.0 ) THEN + WRITE(ioUnit,'(3A,I3,3A)') + & ' Vector Mate for ', cdiag(ndId), + & ' Diagnostic # ',mVec, ' ', cdiag(mVec), + & ' exists ' ELSE - IF ( myThid.EQ.1 ) - & WRITE(6,2002) cdiag(m),mate,cdiag(mate) + WRITE(ioUnit,'(3A,I3,3A)') + & ' Vector Mate for ', cdiag(ndId), + & ' Diagnostic # ',mVec, ' ', cdiag(mVec), + & ' not enabled' ENDIF ENDIF - - ELSE + ENDIF -C Check for Mate of a Counter Diagnostic -C -------------------------------------- - mate_index = parms1(6:8) - READ (mate_index,'(I3)') mate - IF ( myThid.EQ.1 ) - & WRITE(6,2003) cdiag(m),mate,cdiag(mate) - DO k = 1,nlevels(listnum) - CALL getdiag2(levs(k,listnum),m,undef,qtmp1,myThid) - CALL getdiag2(levs(k,listnum),mate,undef,qtmp2,myThid) - DO bj = myByLo(myThid), myByHi(myThid) - DO bi = myBxLo(myThid), myBxHi(myThid) - DO j = 1,sNy - DO i = 1,sNx - IF (qtmp2(i,j,k,bi,bj).NE.0.) THEN - qtmp1(i,j,k,bi,bj) = - & qtmp1(i,j,k,bi,bj) / qtmp2(i,j,k,bi,bj) - ELSE - qtmp1(i,j,k,bi,bj) = undef - ENDIF - ENDDO - ENDDO - ENDDO + IF ( fflags(listId)(2:2).EQ.'P' ) THEN +C- get all the levels (for vertical interpolation) + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) + DO k = 1,kdiag(ndId) + tmpLev = k + CALL GETDIAG( + I tmpLev,undef, + O qtmp1(1-OLx,1-OLy,k,bi,bj), + I ndId,mate,ip,im,bi,bj,myThid) ENDDO + ENDDO + ENDDO + ELSE +C- get only selected levels: + DO bj = myByLo(myThid), myByHi(myThid) + DO bi = myBxLo(myThid), myBxHi(myThid) + DO k = 1,nlevels(listId) + CALL GETDIAG( + I levs(k,listId),undef, + O qtmp1(1-OLx,1-OLy,k,bi,bj), + I ndId,mate,ip,im,bi,bj,myThid) + ENDDO + ENDDO ENDDO - ENDIF C- end of empty diag / not empty block ENDIF +C----------------------------------------------------------------------- +C Check to see if we need to interpolate before output +C----------------------------------------------------------------------- + IF ( fflags(listId)(2:2).EQ.'P' ) THEN +C- Do vertical interpolation: + IF ( fluidIsAir ) THEN +C jmc: for now, this can only work in an atmospheric set-up (fluidIsAir); + CALL DIAGNOSTICS_INTERP_VERT( + I listId, md, ndId, ip, im, lm, + U qtmp1, + I undef, myTime, myIter, myThid ) + ELSE + WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_OUT: ', + & 'INTERP_VERT not allowed in this config' + CALL PRINT_ERROR( msgBuf , myThid ) + STOP 'ABNORMAL END: S/R DIAGNOSTICS_OUT' + ENDIF + ENDIF + +C-- Ready to write field "md", element "lm" in averageCycle(listId) + #ifdef ALLOW_MDSIO -C Prepare for mdsio optionality +C- write to binary file, using MDSIO pkg: IF (diag_mdsio) THEN - CALL mdswritefield_new(fn,writeBinaryPrec,glf,'RL', - & Nr+Nrphys,nlevels(listnum),qtmp1,n,myIter,myThid) + glf = globalFiles + nRec = lm + (md-1)*averageCycle(listId) +C default precision for output files + prec = writeBinaryPrec +C fFlag(1)=R(or D): force it to be 32-bit(or 64) precision + IF ( fflags(listId)(1:1).EQ.'R' ) prec = precFloat32 + IF ( fflags(listId)(1:1).EQ.'D' ) prec = precFloat64 +c CALL MDS_WRITE_FIELD(fn,prec,glf,.FALSE.,'RL', +c & NrMax,nlevels(listId),qtmp1,nRec,myIter,myThid) +C a hack not to write meta files now: + CALL MDS_WRITE_FIELD(fn,prec,glf,.FALSE.,'RL', + & NrMax,nlevels(listId),qtmp1,-nRec,myIter,myThid) ENDIF #endif /* ALLOW_MDSIO */ @@ -227,58 +369,127 @@ _BEGIN_MASTER( myThid ) DO ii = 1,CW_DIMS + d_cw_name(1:NLEN) = dn_blnk(1:NLEN) dn(ii)(1:NLEN) = dn_blnk(1:NLEN) ENDDO - dn(1)(1:2) = 'Xd' - dim(1) = sNx + 2*OLx - ib(1) = OLx + 1 - ie(1) = OLx + sNx - dn(2)(1:2) = 'Yd' - dim(2) = sNy + 2*OLy - ib(2) = OLy + 1 - ie(2) = OLy + sNy +C Note that the "d_cw_name" variable is a hack that hides a +C subtlety within MNC. Basically, each MNC-wrapped file is +C caching its own concept of what each "grid name" (that is, a +C dimension group name) means. So one cannot re-use the same +C "grid" name for different collections of dimensions within a +C given file. By appending the "ndId" values to each name, we +C guarantee uniqueness within each MNC-produced file. + WRITE(d_cw_name,'(a,i6.6)') 'd_cw_',ndId + +C XY dimensions + dim(1) = sNx + 2*OLx + dim(2) = sNy + 2*OLy + ib(1) = OLx + 1 + ib(2) = OLy + 1 + IF (gdiag(ndId)(2:2) .EQ. 'M') THEN + dn(1)(1:2) = 'X' + ie(1) = OLx + sNx + dn(2)(1:2) = 'Y' + ie(2) = OLy + sNy + ELSEIF (gdiag(ndId)(2:2) .EQ. 'U') THEN + dn(1)(1:3) = 'Xp1' + ie(1) = OLx + sNx + 1 + dn(2)(1:2) = 'Y' + ie(2) = OLy + sNy + ELSEIF (gdiag(ndId)(2:2) .EQ. 'V') THEN + dn(1)(1:2) = 'X' + ie(1) = OLx + sNx + dn(2)(1:3) = 'Yp1' + ie(2) = OLy + sNy + 1 + ELSEIF (gdiag(ndId)(2:2) .EQ. 'Z') THEN + dn(1)(1:3) = 'Xp1' + ie(1) = OLx + sNx + 1 + dn(2)(1:3) = 'Yp1' + ie(2) = OLy + sNy + 1 + ENDIF C Z is special since it varies - WRITE(dn(3),'(a,i6.6)') 'Zd', nlevels(listnum) - dim(3) = Nr+Nrphys + WRITE(dn(3),'(a,i6.6)') 'Zd', nlevels(listId) + IF ( (gdiag(ndId)(10:10) .EQ. 'R') + & .AND. (gdiag(ndId)(9:9) .EQ. 'M') ) THEN + WRITE(dn(3),'(a,i6.6)') 'Zmd', nlevels(listId) + ENDIF + IF ( (gdiag(ndId)(10:10) .EQ. 'R') + & .AND. (gdiag(ndId)(9:9) .EQ. 'L') ) THEN + WRITE(dn(3),'(a,i6.6)') 'Zld', nlevels(listId) + ENDIF + IF ( (gdiag(ndId)(10:10) .EQ. 'R') + & .AND. (gdiag(ndId)(9:9) .EQ. 'U') ) THEN + WRITE(dn(3),'(a,i6.6)') 'Zud', nlevels(listId) + ENDIF + dim(3) = NrMax ib(3) = 1 - ie(3) = nlevels(listnum) + ie(3) = nlevels(listId) + +C Time dimension + dn(4)(1:1) = 'T' + dim(4) = -1 + ib(4) = 1 + ie(4) = 1 - CALL MNC_CW_ADD_GNAME('diag_cw_temp', 3, + CALL MNC_CW_ADD_GNAME(d_cw_name, 4, & dim, dn, ib, ie, myThid) - CALL MNC_CW_ADD_VNAME(cdiag(m), 'diag_cw_temp', + CALL MNC_CW_ADD_VNAME(cdiag(ndId), d_cw_name, & 4,5, myThid) - CALL MNC_CW_ADD_VATTR_TEXT(cdiag(m),'description', - & tdiag(m),myThid) - CALL MNC_CW_ADD_VATTR_TEXT(cdiag(m),'units', - & udiag(m),myThid) - - CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0, - & cdiag(m), qtmp1, myThid) + CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'description', + & tdiag(ndId),myThid) + CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'units', + & udiag(ndId),myThid) + +C Per the observations of Baylor, this has been commented out +C until we have code that can write missing_value attributes +C in a way thats compatible with most of the more popular +C netCDF tools including ferret. Using all-zeros completely +C breaks ferret. + +C CALL MNC_CW_ADD_VATTR_DBL(cdiag(ndId),'missing_value', +C & 0.0 _d 0,myThid) + + IF ( ( (writeBinaryPrec .EQ. precFloat32) + & .AND. (fflags(listId)(1:1) .NE. 'D') + & .AND. (fflags(listId)(1:1) .NE. 'R') ) + & .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN + CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0, + & cdiag(ndId), qtmp1, myThid) + ELSEIF ( (writeBinaryPrec .EQ. precFloat64) + & .OR. (fflags(listId)(1:1) .EQ. 'D') ) THEN + CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0, + & cdiag(ndId), qtmp1, myThid) + ENDIF - CALL MNC_CW_DEL_VNAME(cdiag(m), myThid) - CALL MNC_CW_DEL_GNAME('diag_cw_temp', myThid) + CALL MNC_CW_DEL_VNAME(cdiag(ndId), myThid) + CALL MNC_CW_DEL_GNAME(d_cw_name, myThid) _END_MASTER( myThid ) ENDIF #endif /* ALLOW_MNC */ -C-- end of Processing Fld # n + ENDDO +C-- end of Processing Fld # md ENDIF ENDDO - 2000 format(1x,'Computing Diagnostic # ',i3,2x,a8,5x,'Counter: ', - & i4,6x,'Parms: ',a16) - 2001 format(1x,' Vector Mate for ',a8,5x, - & 'Diagnostic # ',i3,2x,a8,' exists ') - 2002 format(1x,' Vector Mate for ',a8,5x, - & 'Diagnostic # ',i3,2x,a8,' not enabled') - 2003 format(1x,' use Counter Mate for ',a8,5x, - & 'Diagnostic # ',i3,2x,a8) - - RETURN +#ifdef ALLOW_MDSIO + IF (diag_mdsio) THEN +C- Note: temporary: since it's a pain to add more arguments to +C all MDSIO S/R, uses instead this specific S/R to write only +C meta files but with more informations in it. + nRec = nfields(listId)*averageCycle(listId) + CALL MDS_WR_METAFILES(fn, prec, glf, .FALSE., + & 0, 0, nlevels(listId), ' ', + & nfields(listId), flds(1,listId), 1, myTime, + & nRec, myIter, myThid) + ENDIF +#endif /* ALLOW_MDSIO */ + + RETURN END - + C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|