--- MITgcm/pkg/mnc/mnc_cw_readwrite.template 2005/09/19 02:24:40 1.33 +++ MITgcm/pkg/mnc/mnc_cw_readwrite.template 2006/03/10 16:09:31 1.37 @@ -1,4 +1,4 @@ -C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/mnc/mnc_cw_readwrite.template,v 1.33 2005/09/19 02:24:40 edhill Exp $ +C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/mnc/mnc_cw_readwrite.template,v 1.37 2006/03/10 16:09:31 edhill Exp $ C $Name: $ #include "MNC_OPTIONS.h" @@ -108,19 +108,24 @@ C !LOCAL VARIABLES: integer i,j,k, indv,nvf,nvl, n1,n2, igrid, ntot, indu integer bis,bie, bjs,bje, uniq_tnum, uniq_fnum, nfname, iseq - integer fid, idv, indvids, ndim, indf, err + integer fid, idv, indvids, ndim, indf, err, nf integer lbi,lbj, bidim,bjdim, unlim_sz, kr integer p(9),s(9),e(9), dimnc(9) integer vstart(9),vcount(9), udo(9) integer j1,j2,j3,j4,j5,j6,j7, k1,k2,k3,k4,k5,k6,k7 integer indfg, fg1,fg2, npath character*(MAX_LEN_MBUF) msgbuf - character*(MNC_MAX_CHAR) fname - character*(MNC_MAX_CHAR) path_fname - character*(MNC_MAX_CHAR) tmpnm + character*(MNC_MAX_PATH) fname + character*(MNC_MAX_PATH) path_fname + character*(MNC_MAX_PATH) tmpnm + character*(MNC_MAX_PATH) bpath + REAL*8 dval, dvm(2) + REAL*4 rval, rvm(2) + INTEGER ival, ivm(2), irv REAL*8 resh_d( MNC_MAX_BUFF ) REAL*4 resh_r( MNC_MAX_BUFF ) INTEGER resh_i( MNC_MAX_BUFF ) + LOGICAL write_attributes, use_missing #ifdef HAVE_STAT integer ntotenc, ncenc, nbytes, fs_isdone character*(200) cenc @@ -134,6 +139,10 @@ C Only do I/O if I am the master thread _BEGIN_MASTER( myThid ) + DO i = 1,MNC_MAX_PATH + bpath(i:i) = ' ' + ENDDO + C Get the current index for the unlimited dimension from the file C group (or base) name fg1 = IFNBLNK(fbname) @@ -186,7 +195,7 @@ C Create the file name CALL MNC_CW_GET_TILE_NUM(lbi,lbj, uniq_tnum, myThid) - fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR) + fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH) n1 = IFNBLNK(fbname) n2 = ILNBLNK(fbname) @@ -213,9 +222,11 @@ CALL MNC_PSNCM(tmpnm, uniq_tnum, MNC_DEF_TMNC) k = ILNBLNK(tmpnm) IF ( mnc_cw_cit(1,mnc_cw_fgci(indfg)) .GT. -1 ) THEN + j = mnc_cw_cit(2,mnc_cw_fgci(indfg)) + IF ( mnc_cw_fgis(indfg) .GT. j ) + & j = mnc_cw_fgis(indfg) write(fname,'(a,a1,i10.10,a2,a,a3)') fbname(n1:n2), - & '.', mnc_cw_cit(2,mnc_cw_fgci(indfg)), - & '.t',tmpnm(1:k),'.nc' + & '.', j, '.t', tmpnm(1:k), '.nc' ELSEIF ( mnc_cw_cit(1,mnc_cw_fgci(indfg)) .EQ. -1 ) THEN C Leave off the myIter value entirely write(fname,'(a,a2,a,a3)') fbname(n1:n2), '.t', @@ -235,11 +246,11 @@ C Add the path to the file name IF (mnc_use_outdir) THEN - path_fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR) + path_fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH) npath = ILNBLNK(mnc_out_path) path_fname(1:npath) = mnc_out_path(1:npath) path_fname((npath+1):(npath+nfname)) = fname(1:nfname) - fname(1:MNC_MAX_CHAR) = path_fname(1:MNC_MAX_CHAR) + fname(1:MNC_MAX_PATH) = path_fname(1:MNC_MAX_PATH) nfname = npath + nfname ENDIF @@ -302,9 +313,14 @@ CALL print_error(msgbuf, mythid) STOP 'ABNORMAL END: S/R MNC_CW_RX_W' ENDIF - mnc_cw_cit(2,mnc_cw_fgci(indfg)) - & = mnc_cw_cit(3,mnc_cw_fgci(indfg)) - mnc_cw_cit(3,mnc_cw_fgci(indfg)) = -1 + mnc_cw_fgis(indfg) = mnc_cw_cit(3,mnc_cw_fgci(indfg)) +C DO NOT BUMP THE CURRENT ITER FOR ALL FILES IN THIS CITER +C GROUP SINCE THIS IS ONLY GROWTH TO AVOID FILE SIZE +C LIMITS FOR THIS ONE BASENAME GROUP, NOT GROWTH OF THE +C ENTIRE CITER GROUP !!! +C mnc_cw_cit(2,mnc_cw_fgci(indfg)) +C & = mnc_cw_cit(3,mnc_cw_fgci(indfg)) +C mnc_cw_cit(3,mnc_cw_fgci(indfg)) = -1 #endif fs_isdone = 1 GOTO 10 @@ -337,15 +353,24 @@ & mnc_cw_ndim(igrid), mnc_cw_dn(1,igrid), myThid) C Ensure that the variable is defined + irv = 0 IF (stype(1:1) .EQ. 'D') & CALL MNC_VAR_INIT_DBL( - & fname, mnc_cw_gname(igrid), vtype, myThid) + & fname, mnc_cw_gname(igrid), vtype, irv, myThid) IF (stype(1:1) .EQ. 'R') & CALL MNC_VAR_INIT_REAL( - & fname, mnc_cw_gname(igrid), vtype, myThid) + & fname, mnc_cw_gname(igrid), vtype, irv, myThid) IF (stype(1:1) .EQ. 'I') & CALL MNC_VAR_INIT_INT( - & fname, mnc_cw_gname(igrid), vtype, myThid) + & fname, mnc_cw_gname(igrid), vtype, irv, myThid) + + IF (irv .GT. 0) THEN +C Return value indicates that the variable did not previously +C exist in this file, so we need to write all the attributes + write_attributes = .TRUE. + ELSE + write_attributes = .FALSE. + ENDIF DO i = 1,mnc_fv_ids(indf,1) j = 2 + 3*(i - 1) @@ -438,19 +463,60 @@ ENDIF ENDDO -C Add the per-variable attributes - DO i = 1,mnc_cw_vnat(1,indv) - CALL MNC_VAR_ADD_ATTR_STR( fname, vtype, - & mnc_cw_vtnm(i,indv), mnc_cw_vtat(i,indv), myThid) - ENDDO - DO i = 1,mnc_cw_vnat(2,indv) - CALL MNC_VAR_ADD_ATTR_INT( fname, vtype, - & mnc_cw_vinm(i,indv), 1, mnc_cw_viat(i,indv), myThid) - ENDDO - DO i = 1,mnc_cw_vnat(3,indv) - CALL MNC_VAR_ADD_ATTR_DBL( fname, vtype, - & mnc_cw_vdnm(i,indv), 1, mnc_cw_vdat(i,indv), myThid) - ENDDO + IF (write_attributes) THEN +C Add the per-variable attributes + DO i = 1,mnc_cw_vnat(1,indv) + CALL MNC_VAR_ADD_ATTR_STR( fname, vtype, + & mnc_cw_vtnm(i,indv), mnc_cw_vtat(i,indv), myThid) + ENDDO + DO i = 1,mnc_cw_vnat(2,indv) + CALL MNC_VAR_ADD_ATTR_INT( fname, vtype, + & mnc_cw_vinm(i,indv), 1, mnc_cw_viat(i,indv), myThid) + ENDDO + DO i = 1,mnc_cw_vnat(3,indv) + CALL MNC_VAR_ADD_ATTR_DBL( fname, vtype, + & mnc_cw_vdnm(i,indv), 1, mnc_cw_vdat(i,indv), myThid) + ENDDO + ENDIF + +C Handle missing values + use_missing = .FALSE. + IF (mnc_cw_vfmv(indv) .EQ. 0) THEN + use_missing = .FALSE. + ELSE + IF (mnc_cw_vfmv(indv) .EQ. 1) THEN + use_missing = .TRUE. + dvm(1) = mnc_def_dmv(1) + dvm(2) = mnc_def_dmv(2) + rvm(1) = mnc_def_rmv(1) + rvm(2) = mnc_def_rmv(2) + ivm(1) = mnc_def_imv(1) + ivm(2) = mnc_def_imv(2) + ELSEIF (mnc_cw_vfmv(indv) .EQ. 2) THEN + use_missing = .TRUE. + dvm(1) = mnc_cw_vmvd(1,indv) + dvm(2) = mnc_cw_vmvd(2,indv) + rvm(1) = mnc_cw_vmvr(1,indv) + rvm(2) = mnc_cw_vmvr(2,indv) + ivm(1) = mnc_cw_vmvi(1,indv) + ivm(2) = mnc_cw_vmvi(2,indv) + ENDIF + ENDIF + IF (write_attributes .AND. use_missing) THEN + write(msgbuf,'(4a)') 'writing attribute ''missing_value''', + & ' within file ''', fname(1:nfname), '''' + IF (stype(1:1) .EQ. 'D') THEN + err = NF_PUT_ATT_DOUBLE(fid, idv, 'missing_value', + & NF_DOUBLE, 1, dvm(2)) + ELSEIF (stype(1:1) .EQ. 'R') THEN + err = NF_PUT_ATT_REAL(fid, idv, 'missing_value', + & NF_FLOAT, 1, dvm(2)) + ELSEIF (stype(1:1) .EQ. 'I') THEN + err = NF_PUT_ATT_INT(fid, idv, 'missing_value', + & NF_INT, 1, ivm(2)) + ENDIF + CALL MNC_HANDLE_ERR(err, msgbuf, myThid) + ENDIF CALL MNC_FILE_ENDDEF(fname, myThid) @@ -501,31 +567,72 @@ STOP 'ABNORMAL END: S/R MNC_CW_RX_W_OFFSET' ENDIF - IF (stype(1:1) .EQ. 'D') THEN - DO j1 = s(1),e(1) - k1 = k2 + j1 - kr = kr + 1 - resh_d(kr) = var(k1) - ENDDO - err = NF_PUT_VARA_DOUBLE(fid, idv, vstart, vcount, resh_d) - ENDIF - IF (stype(1:1) .EQ. 'R') THEN - DO j1 = s(1),e(1) - k1 = k2 + j1 - kr = kr + 1 - resh_r(kr) = var(k1) - ENDDO - err = NF_PUT_VARA_REAL(fid, idv, vstart, vcount, resh_r) - ENDIF - IF (stype(1:1) .EQ. 'I') THEN - DO j1 = s(1),e(1) - k1 = k2 + j1 - kr = kr + 1 - resh_i(kr) = MNC2I( var(k1) ) - ENDDO - err = NF_PUT_VARA_INT(fid, idv, vstart, vcount, resh_i) - ENDIF + IF (use_missing) THEN + IF (stype(1:1) .EQ. 'D') THEN + DO j1 = s(1),e(1) + k1 = k2 + j1 + kr = kr + 1 + dval = var(k1) + IF (dval .EQ. dvm(1)) THEN + resh_d(kr) = dvm(2) + ELSE + resh_d(kr) = dval + ENDIF + ENDDO + err = NF_PUT_VARA_DOUBLE(fid, idv, vstart, vcount, resh_d) + ELSEIF (stype(1:1) .EQ. 'R') THEN + DO j1 = s(1),e(1) + k1 = k2 + j1 + kr = kr + 1 + rval = var(k1) + IF (rval .EQ. rvm(1)) THEN + resh_r(kr) = rvm(2) + ELSE + resh_r(kr) = rval + ENDIF + ENDDO + err = NF_PUT_VARA_REAL(fid, idv, vstart, vcount, resh_r) + ELSEIF (stype(1:1) .EQ. 'I') THEN + DO j1 = s(1),e(1) + k1 = k2 + j1 + kr = kr + 1 + ival = MNC2I( var(k1) ) + IF (ival .EQ. ivm(1)) THEN + resh_i(kr) = ivm(2) + ELSE + resh_i(kr) = ival + ENDIF + ENDDO + err = NF_PUT_VARA_INT(fid, idv, vstart, vcount, resh_i) + ENDIF + + ELSE + + IF (stype(1:1) .EQ. 'D') THEN + DO j1 = s(1),e(1) + k1 = k2 + j1 + kr = kr + 1 + resh_d(kr) = var(k1) + ENDDO + err = NF_PUT_VARA_DOUBLE(fid, idv, vstart, vcount, resh_d) + ELSEIF (stype(1:1) .EQ. 'R') THEN + DO j1 = s(1),e(1) + k1 = k2 + j1 + kr = kr + 1 + resh_r(kr) = var(k1) + ENDDO + err = NF_PUT_VARA_REAL(fid, idv, vstart, vcount, resh_r) + ELSEIF (stype(1:1) .EQ. 'I') THEN + DO j1 = s(1),e(1) + k1 = k2 + j1 + kr = kr + 1 + resh_i(kr) = MNC2I( var(k1) ) + ENDDO + err = NF_PUT_VARA_INT(fid, idv, vstart, vcount, resh_i) + ENDIF + + ENDIF CALL MNC_HANDLE_ERR(err, msgbuf, myThid) ENDDO @@ -537,7 +644,8 @@ C Sync the file err = NF_SYNC(fid) - write(msgbuf,'(3a)') 'sync for file ''', fname, + nf = ILNBLNK( fname ) + write(msgbuf,'(3a)') 'sync for file ''', fname(1:nf), & ''' in S/R MNC_CW_RX_W' CALL MNC_HANDLE_ERR(err, msgbuf, myThid) @@ -624,10 +732,11 @@ integer p(9),s(9),e(9), vstart(9),vcount(9), udo(9) integer j1,j2,j3,j4,j5,j6,j7, k1,k2,k3,k4,k5,k6,k7 character*(MAX_LEN_MBUF) msgbuf - character*(MNC_MAX_CHAR) fname - character*(MNC_MAX_CHAR) fname_zs - character*(MNC_MAX_CHAR) tmpnm - character*(MNC_MAX_CHAR) path_fname + character*(MNC_MAX_PATH) fname + character*(MNC_MAX_PATH) fname_zs + character*(MNC_MAX_PATH) tmpnm + character*(MNC_MAX_PATH) path_fname + character*(MNC_MAX_PATH) bpath integer indfg, fg1,fg2 REAL*8 resh_d( MNC_MAX_BUFF ) REAL*4 resh_r( MNC_MAX_BUFF ) @@ -639,6 +748,10 @@ C Only do I/O if I am the master thread _BEGIN_MASTER( myThid ) + DO i = 1,MNC_MAX_PATH + bpath(i:i) = ' ' + ENDDO + C Get the current index for the unlimited dimension from the file C group (or base) name fg1 = IFNBLNK(fbname) @@ -688,7 +801,7 @@ C Create the file name CALL MNC_CW_GET_TILE_NUM( lbi,lbj, uniq_tnum, myThid) - fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR) + fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH) #ifdef MNC_READ_OLDNAMES @@ -703,11 +816,11 @@ C Add the path to the file name IF (mnc_use_indir) THEN - path_fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR) + path_fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH) npath = ILNBLNK(mnc_indir_str) path_fname(1:npath) = mnc_indir_str(1:npath) path_fname((npath+1):(npath+nfname)) = fname(1:nfname) - fname(1:MNC_MAX_CHAR) = path_fname(1:MNC_MAX_CHAR) + fname(1:MNC_MAX_PATH) = path_fname(1:MNC_MAX_PATH) nfname = npath + nfname ENDIF @@ -759,7 +872,7 @@ & mnc_cw_cit(2,mnc_cw_fgci(indfg)), '.' ENDIF ntot = ILNBLNK(fname) - path_fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR) + path_fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH) npath = ILNBLNK(mnc_indir_str) C Add the face index CALL MNC_CW_GET_FACE_NUM( lbi,lbj, uniq_fnum, myThid) @@ -785,7 +898,7 @@ C Create the PER-TILE file name CALL MNC_PSNCM(tmpnm, uniq_tnum, MNC_DEF_TMNC) k = ILNBLNK(tmpnm) - path_fname(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR) + path_fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH) WRITE(path_fname,'(2a,a1,a,a3)') & mnc_indir_str(1:npath), fname(1:ntot), 't', & tmpnm(1:k), '.nc'