--- MITgcm/pkg/mnc/mnc_cw_readwrite.template 2004/03/10 05:50:16 1.8 +++ MITgcm/pkg/mnc/mnc_cw_readwrite.template 2004/03/29 22:12:06 1.16 @@ -1,67 +1,82 @@ -C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/mnc/mnc_cw_readwrite.template,v 1.8 2004/03/10 05:50:16 edhill Exp $ +C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/mnc/mnc_cw_readwrite.template,v 1.16 2004/03/29 22:12:06 edhill Exp $ C $Name: $ #include "MNC_OPTIONS.h" C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| +CBOP +C !ROUTINE: MNC_CW_RX_W - SUBROUTINE MNC_CW_RX_W_YY( - I myThid, +C !INTERFACE: + SUBROUTINE MNC_CW_RX_W( + I stype, I fbname, bi,bj, I vtype, - I indu, - I var ) + I var, + I myThid ) +C !DESCRIPTION: +C This subroutine writes one variable to a file or a file group, +C depending upon the tile indicies. + +C !USES: implicit none - #include "netcdf.inc" #include "mnc_common.h" -#include "EEPARAMS.h" #include "SIZE.h" +#include "EEPARAMS.h" +#include "PARAMS.h" -#define mnc_rtype_YY - -C Arguments +C !INPUT PARAMETERS: integer myThid, bi,bj, indu - character*(*) fbname, vtype + character*(*) stype, fbname, vtype __V var(*) -C Functions - integer IFNBLNK, ILNBLNK - -C Local Variables +C !LOCAL VARIABLES: integer i,j,k, indv,nvf,nvl, n1,n2, igrid, ntot - integer bis,bie, bjs,bje, uniq_tnum, nfname, fid, idv, indvids - integer ndim, indf, err, lbi,lbj, bidim,bjdim, unlim_sz, kr - integer p(9),s(9),e(9), dimnc(9), vstart(9),vcount(9), udo(9) + integer bis,bie, bjs,bje, uniq_tnum, nfname + integer fid, idv, indvids, ndim, indf, err + 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 - -C Temporary storage for the simultaneous type conversion and -C re-shaping before passing to NetCDF -#ifdef mnc_rtype_D - REAL*8 resh( sNx + 2*OLx + sNy + 2*OLy ) -#endif -#ifdef mnc_rtype_R - REAL*4 resh( sNx + 2*OLx + sNy + 2*OLy ) -#endif -#ifdef mnc_rtype_I - INTEGER resh( sNx + 2*OLx + sNy + 2*OLy ) -#endif + character*(MNC_MAX_CHAR) path_fname + REAL*8 resh_d( sNx + 2*OLx + sNy + 2*OLy ) + REAL*4 resh_r( sNx + 2*OLx + sNy + 2*OLy ) + INTEGER resh_i( sNx + 2*OLx + sNy + 2*OLy ) +CEOP +C Functions + integer IFNBLNK, ILNBLNK C Only do I/O if I am the master thread _BEGIN_MASTER( myThid ) +C Get the current index for the unlimited dimension from the file +C group (or base) name + fg1 = IFNBLNK(fbname) + fg2 = ILNBLNK(fbname) + CALL MNC_GET_IND(MNC_MAX_ID, fbname, mnc_cw_fgnm, indfg, myThid) + IF (indfg .LT. 1) THEN + write(msgbuf,'(3a)') + & 'MNC_CW_RX_W ERROR: file group name ''', + & fbname(fg1:fg2), ''' is not defined' + CALL print_error(msgbuf, mythid) + STOP 'ABNORMAL END: S/R MNC_CW_RX_W' + ENDIF + indu = mnc_cw_fgud(indfg) + C Check that the Variable Type exists nvf = IFNBLNK(vtype) nvl = ILNBLNK(vtype) - CALL MNC_GET_IND(myThid, MNC_MAX_ID, vtype, mnc_cw_vname, indv) + CALL MNC_GET_IND(MNC_MAX_ID, vtype, mnc_cw_vname, indv, myThid) IF (indv .LT. 1) THEN - write(msgbuf,'(3a)') 'MNC_CW_RX_W_YY ERROR: vtype ''', + write(msgbuf,'(3a)') 'MNC_CW_RX_W ERROR: vtype ''', & vtype(nvf:nvl), ''' is not defined' CALL print_error(msgbuf, mythid) - STOP 'ABNORMAL END: S/R MNC_CW_RX_W_YY' + STOP 'ABNORMAL END: S/R MNC_CW_RX_W' ENDIF igrid = mnc_cw_vgind(indv) @@ -83,7 +98,7 @@ DO lbi = bis,bie C Create the file name - CALL MNC_CW_GET_TILE_NUM(myThid, lbi,lbj, uniq_tnum) + CALL MNC_CW_GET_TILE_NUM(lbi,lbj, uniq_tnum, myThid) fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR) n1 = IFNBLNK(fbname) n2 = ILNBLNK(fbname) @@ -94,8 +109,18 @@ write(fname((ntot+1):(ntot+9)),'(i6.6,a3)') uniq_tnum, '.nc' nfname = ntot+9 +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) + 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) + nfname = npath + nfname + ENDIF + C Append to an existing or create a new file - CALL MNC_CW_FILE_AORC(myThid, fname, indf) + CALL MNC_CW_FILE_AORC(fname, indf, myThid) fid = mnc_f_info(indf,2) C Ensure that all the NetCDF dimensions are defined and create a @@ -109,24 +134,25 @@ ELSE dimnc(i) = mnc_cw_ie(i,igrid) - mnc_cw_is(i,igrid) + 1 ENDIF - CALL MNC_DIM_INIT(myThid,fname, - & mnc_cw_dn(i,igrid), dimnc(i) ) + CALL MNC_DIM_INIT(fname, + & mnc_cw_dn(i,igrid), dimnc(i), myThid) ENDDO C Ensure that the "grid" is defined - CALL MNC_GRID_INIT(myThid,fname, mnc_cw_gname(igrid), - & mnc_cw_ndim(igrid), mnc_cw_dn(1,igrid)) + CALL MNC_GRID_INIT(fname, mnc_cw_gname(igrid), + & mnc_cw_ndim(igrid), mnc_cw_dn(1,igrid), myThid) C Ensure that the variable is defined -#ifdef mnc_rtype_D - CALL MNC_VAR_INIT_DBL(myThid,fname,mnc_cw_gname(igrid),vtype) -#endif -#ifdef mnc_rtype_R - CALL MNC_VAR_INIT_REAL(myThid,fname,mnc_cw_gname(igrid),vtype) -#endif -#ifdef mnc_rtype_I - CALL MNC_VAR_INIT_INT(myThid,fname,mnc_cw_gname(igrid),vtype) -#endif + IF (stype(1:1) .EQ. 'D') + & CALL MNC_VAR_INIT_DBL( + & fname, mnc_cw_gname(igrid), vtype, myThid) + IF (stype(1:1) .EQ. 'R') + & CALL MNC_VAR_INIT_REAL( + & fname, mnc_cw_gname(igrid), vtype, myThid) + IF (stype(1:1) .EQ. 'I') + & CALL MNC_VAR_INIT_INT( + & fname, mnc_cw_gname(igrid), vtype, myThid) + DO i = 1,mnc_fv_ids(indf,1) j = 2 + 3*(i - 1) IF (mnc_v_names(mnc_fv_ids(indf,j)) .EQ. vtype) THEN @@ -136,7 +162,7 @@ GOTO 10 ENDIF ENDDO - write(msgbuf,'(4a)') 'MNC_MNC_CW_RX_W_YY ERROR: ', + write(msgbuf,'(4a)') 'MNC_MNC_CW_RX_W ERROR: ', & 'cannot reference variable ''', vtype, '''' CALL print_error(msgbuf, mythid) STOP 'ABNORMAL END: package MNC' @@ -187,11 +213,11 @@ udo(i) = indu - 1 ELSEIF (indu .EQ. -1) THEN C Append one to the current unlimited dim size - CALL MNC_DIM_UNLIM_SIZE(myThid, fname, unlim_sz) + CALL MNC_DIM_UNLIM_SIZE( fname, unlim_sz, myThid) udo(i) = unlim_sz ELSE C Use the current unlimited dim size - CALL MNC_DIM_UNLIM_SIZE(myThid, fname, unlim_sz) + CALL MNC_DIM_UNLIM_SIZE( fname, unlim_sz, myThid) udo(i) = unlim_sz - 1 ENDIF ENDIF @@ -209,23 +235,23 @@ CEH3 ENDDO C Add the global attributes - CALL MNC_CW_SET_GATTR(myThid, fname, lbi,lbj, uniq_tnum) + CALL MNC_CW_SET_GATTR( fname, lbi,lbj, uniq_tnum, myThid) C Add the per-variable attributes DO i = 1,mnc_cw_vnat(1,indv) - CALL MNC_VAR_ADD_ATTR_STR(myThid, fname, vtype, - & mnc_cw_vtnm(i,indv), mnc_cw_vtat(i,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(myThid, fname, vtype, - & mnc_cw_vinm(i,indv), 1, mnc_cw_viat(i,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(myThid, fname, vtype, - & mnc_cw_vdnm(i,indv), 1, mnc_cw_vdat(i,indv)) + CALL MNC_VAR_ADD_ATTR_DBL( fname, vtype, + & mnc_cw_vdnm(i,indv), 1, mnc_cw_vdat(i,indv), myThid) ENDDO - CALL MNC_FILE_ENDDEF(myThid,fname) + CALL MNC_FILE_ENDDEF(fname, myThid) write(msgbuf,'(5a)') 'writing variable type ''', & vtype(nvf:nvl), ''' within file ''', @@ -258,26 +284,35 @@ vcount(2) = 1 kr = 0 - DO j1 = s(1),e(1) - k1 = k2 + j1 - kr = kr + 1 - resh(kr) = var(k1) - ENDDO - vstart(1) = udo(1) + 1 vcount(1) = e(1) - s(1) + 1 -#ifdef mnc_rtype_D - err = NF_PUT_VARA_DOUBLE(fid, idv, vstart, vcount, resh) -#endif -#ifdef mnc_rtype_R - err = NF_PUT_VARA_REAL(fid, idv, vstart, vcount, resh) -#endif -#ifdef mnc_rtype_I - err = NF_PUT_VARA_INT(fid, idv, vstart, vcount, resh) -#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) = var(k1) + ENDDO + err = NF_PUT_VARA_INT(fid, idv, vstart, vcount, resh_i) + ENDIF - CALL MNC_HANDLE_ERR(myThid, err, msgbuf) + CALL MNC_HANDLE_ERR(err, msgbuf, myThid) ENDDO ENDDO @@ -289,8 +324,8 @@ C Sync the file err = NF_SYNC(fid) write(msgbuf,'(3a)') 'sync for file ''', fname, - & ''' in S/R MNC_CW_RX_W_YY' - CALL MNC_HANDLE_ERR(myThid, err, msgbuf) + & ''' in S/R MNC_CW_RX_W' + CALL MNC_HANDLE_ERR(err, msgbuf, myThid) ENDDO ENDDO @@ -302,67 +337,80 @@ C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| +CBOP +C !ROUTINE: MNC_CW_RX_R - - SUBROUTINE MNC_CW_RX_R_YY( - I myThid, +C !INTERFACE: + SUBROUTINE MNC_CW_RX_R( + I stype, I fbname, bi,bj, I vtype, - I indu, - I var ) + I var, + I myThid ) implicit none +C !DESCRIPTION: +C This subroutine reads one variable from a file or a file group, +C depending upon the tile indicies. + +C !USES: #include "netcdf.inc" #include "mnc_common.h" -#include "EEPARAMS.h" #include "SIZE.h" +#include "EEPARAMS.h" +#include "PARAMS.h" -#define mnc_rtype_YY - -C Arguments +C !INPUT PARAMETERS: integer myThid, bi,bj, indu - character*(*) fbname, vtype + character*(*) stype, fbname, vtype __V var(*) -C Functions - integer IFNBLNK, ILNBLNK - -C Local Variables +C !LOCAL VARIABLES: integer i,k, nvf,nvl, n1,n2, igrid, ntot integer bis,bie, bjs,bje, uniq_tnum, nfname, fid, idv integer ndim, indf, err, lbi,lbj, bidim,bjdim, unlim_sz, kr integer ind_fv_ids, ind_vt, ierr, atype, alen - integer f_sNx,f_sNy, ires + integer f_sNx,f_sNy, npath 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 - -C Temporary storage for the simultaneous type conversion and -C re-shaping before passing to NetCDF -#ifdef mnc_rtype_D - REAL*8 resh( sNx + 2*OLx + sNy + 2*OLy ) -#endif -#ifdef mnc_rtype_R - REAL*4 resh( sNx + 2*OLx + sNy + 2*OLy ) -#endif -#ifdef mnc_rtype_I - INTEGER resh( sNx + 2*OLx + sNy + 2*OLy ) -#endif + character*(MNC_MAX_CHAR) path_fname + integer indfg, fg1,fg2 + REAL*8 resh_d( sNx + 2*OLx + sNy + 2*OLy ) + REAL*4 resh_r( sNx + 2*OLx + sNy + 2*OLy ) + INTEGER resh_i( sNx + 2*OLx + sNy + 2*OLy ) +CEOP +C Functions + integer IFNBLNK, ILNBLNK C Only do I/O if I am the master thread _BEGIN_MASTER( myThid ) +C Get the current index for the unlimited dimension from the file +C group (or base) name + fg1 = IFNBLNK(fbname) + fg2 = ILNBLNK(fbname) + CALL MNC_GET_IND(MNC_MAX_ID, fbname, mnc_cw_fgnm, indfg, myThid) + IF (indfg .LT. 1) THEN + write(msgbuf,'(3a)') + & 'MNC_CW_RX_W ERROR: file group name ''', + & fbname(fg1:fg2), ''' is not defined' + CALL print_error(msgbuf, mythid) + STOP 'ABNORMAL END: S/R MNC_CW_RX_W' + ENDIF + indu = mnc_cw_fgud(indfg) + C Check that the Variable Type exists nvf = IFNBLNK(vtype) nvl = ILNBLNK(vtype) - CALL MNC_GET_IND(myThid, MNC_MAX_ID, vtype, mnc_cw_vname, ind_vt) + CALL MNC_GET_IND( MNC_MAX_ID, vtype, mnc_cw_vname, ind_vt, myThid) IF (ind_vt .LT. 1) THEN - write(msgbuf,'(3a)') 'MNC_CW_RX_R_YY ERROR: vtype ''', + write(msgbuf,'(3a)') 'MNC_CW_RX_R ERROR: vtype ''', & vtype(nvf:nvl), ''' is not defined' CALL print_error(msgbuf, mythid) - STOP 'ABNORMAL END: S/R MNC_CW_RX_R_YY' + STOP 'ABNORMAL END: S/R MNC_CW_RX_R' ENDIF igrid = mnc_cw_vgind(ind_vt) @@ -388,7 +436,7 @@ DO lbi = bis,bie C Create the file name - CALL MNC_CW_GET_TILE_NUM(myThid, lbi,lbj, uniq_tnum) + CALL MNC_CW_GET_TILE_NUM( lbi,lbj, uniq_tnum, myThid) fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR) n1 = IFNBLNK(fbname) n2 = ILNBLNK(fbname) @@ -399,17 +447,27 @@ write(fname((ntot+1):(ntot+9)),'(i6.6,a3)') uniq_tnum, '.nc' nfname = ntot+9 +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) + 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) + nfname = npath + nfname + ENDIF + C Open the existing file - CALL MNC_FILE_TRY_READ(myThid, fname, ierr, indf) + CALL MNC_FILE_TRY_READ( fname, ierr, indf, myThid) C Check that the variable (VType) is defined within the file - CALL MNC_GET_FVINDS(myThid, fname, vtype, indf, ind_fv_ids) + CALL MNC_GET_FVINDS( fname, vtype, indf, ind_fv_ids, myThid) IF ((indf .LT. 1) .OR. (ind_fv_ids .LT. 1)) THEN - write(msgbuf,'(4a)') 'MNC_CW_RX_R_YY ERROR: vtype ''', + write(msgbuf,'(4a)') 'MNC_CW_RX_R ERROR: vtype ''', & vtype(nvf:nvl), ''' is not defined within file ''', & fname(1:nfname) CALL print_error(msgbuf, mythid) - STOP 'ABNORMAL END: S/R MNC_CW_RX_R_YY' + STOP 'ABNORMAL END: S/R MNC_CW_RX_R' ENDIF fid = mnc_f_info(indf,2) idv = mnc_fv_ids(indf,ind_fv_ids+1) @@ -421,17 +479,19 @@ err = NF_INQ_ATT(fid,NF_GLOBAL, 'sNx',atype,alen) IF ((err .EQ. NF_NOERR) .AND. (alen .EQ. 1)) THEN err = NF_GET_ATT_INT(fid, NF_GLOBAL, 'sNx', f_sNx) - CALL MNC_HANDLE_ERR(myThid, err, - & 'reading attribute ''sNx'' in S/R MNC_CW_RX_R_YY') + CALL MNC_HANDLE_ERR(err, + & 'reading attribute ''sNx'' in S/R MNC_CW_RX_R', + & myThid) ENDIF err = NF_INQ_ATT(fid,NF_GLOBAL, 'sNy',atype,alen) IF ((err .EQ. NF_NOERR) .AND. (alen .EQ. 1)) THEN err = NF_GET_ATT_INT(fid, NF_GLOBAL, 'sNy', f_sNy) - CALL MNC_HANDLE_ERR(myThid, err, - & 'reading attribute ''sNy'' in S/R MNC_CW_RX_R_YY') + CALL MNC_HANDLE_ERR(err, + & 'reading attribute ''sNy'' in S/R MNC_CW_RX_R', + & myThid) ENDIF IF ((f_sNx .NE. sNx) .OR. (f_sNy .NE. sNy)) THEN - write(msgbuf,'(5a)') 'MNC_CW_RX_R_YY WARNING: the ', + write(msgbuf,'(5a)') 'MNC_CW_RX_R WARNING: the ', & 'attributes ''sNx'' and ''sNy'' within the file ''', & fname(1:nfname), ''' do not exist or do not match ', & 'the current sizes within the model' @@ -441,16 +501,16 @@ C Check that the in-memory variable and the in-file variables C are of compatible sizes C ires = 1 -C CALL MNC_CHK_VTYP_R_NCVAR(myThid, ind_vt, +C CALL MNC_CHK_VTYP_R_NCVAR( ind_vt, C & indf, ind_fv_ids, indu, ires) C IF (ires .LT. 0) THEN -C write(msgbuf,'(7a)') 'MNC_CW_RX_R_YY WARNING: the sizes ', +C write(msgbuf,'(7a)') 'MNC_CW_RX_R WARNING: the sizes ', C & 'of the in-program variable ''', vtype(nvf:nvl), C & ''' and the corresponding variable within file ''', C & fname(1:nfname), ''' are not compatible -- please ', C & 'check the sizes' C CALL print_error(msgbuf, mythid) -C STOP 'ABNORMAL END: S/R MNC_CW_RX_R_YY' +C STOP 'ABNORMAL END: S/R MNC_CW_RX_R' C ENDIF C Check for bi,bj indicies @@ -497,11 +557,11 @@ udo(i) = indu - 1 ELSEIF (indu .EQ. -1) THEN C Append one to the current unlimited dim size - CALL MNC_DIM_UNLIM_SIZE(myThid, fname, unlim_sz) + CALL MNC_DIM_UNLIM_SIZE( fname, unlim_sz, myThid) udo(i) = unlim_sz ELSE C Use the current unlimited dim size - CALL MNC_DIM_UNLIM_SIZE(myThid, fname, unlim_sz) + CALL MNC_DIM_UNLIM_SIZE( fname, unlim_sz, myThid) udo(i) = unlim_sz - 1 ENDIF ENDIF @@ -519,7 +579,7 @@ C write(*,*) 'i,p(i),s(i),e(i) = ', i,': ',p(i),s(i),e(i) C ENDDO - CALL MNC_FILE_ENDDEF(myThid,fname) + CALL MNC_FILE_ENDDEF(fname, myThid) write(msgbuf,'(5a)') 'reading variable type ''', & vtype(nvf:nvl), ''' within file ''', @@ -551,27 +611,38 @@ vstart(2) = udo(2) + j2 - s(2) + 1 vcount(2) = 1 + kr = 0 vstart(1) = udo(1) + 1 vcount(1) = e(1) - s(1) + 1 -#ifdef mnc_rtype_D - err = NF_GET_VARA_DOUBLE(fid, idv, vstart, vcount, resh) -#endif -#ifdef mnc_rtype_R - err = NF_GET_VARA_REAL(fid, idv, vstart, vcount, resh) -#endif -#ifdef mnc_rtype_I - err = NF_GET_VARA_INT(fid, idv, vstart, vcount, resh) -#endif - - CALL MNC_HANDLE_ERR(myThid, err, msgbuf) + IF (stype(1:1) .EQ. 'D') THEN + err = NF_GET_VARA_DOUBLE(fid, idv, vstart, vcount, resh_d) + CALL MNC_HANDLE_ERR(err, msgbuf, myThid) + DO j1 = s(1),e(1) + k1 = k2 + j1 + kr = kr + 1 + var(k1) = resh_d(kr) + ENDDO + ENDIF + IF (stype(1:1) .EQ. 'R') THEN + err = NF_GET_VARA_REAL(fid, idv, vstart, vcount, resh_r) + CALL MNC_HANDLE_ERR(err, msgbuf, myThid) + DO j1 = s(1),e(1) + k1 = k2 + j1 + kr = kr + 1 + var(k1) = resh_r(kr) + ENDDO + ENDIF + IF (stype(1:1) .EQ. 'I') THEN + err = NF_GET_VARA_INT(fid, idv, vstart, vcount, resh_i) + CALL MNC_HANDLE_ERR(err, msgbuf, myThid) + DO j1 = s(1),e(1) + k1 = k2 + j1 + kr = kr + 1 + var(k1) = resh_i(kr) + ENDDO + ENDIF - kr = 0 - DO j1 = s(1),e(1) - k1 = k2 + j1 - kr = kr + 1 - var(k1) = resh(kr) - ENDDO ENDDO @@ -582,7 +653,7 @@ ENDDO C Close the file - CALL MNC_FILE_CLOSE(myThid, fname) + CALL MNC_FILE_CLOSE(fname, myThid) C End the lbj,lbi loops ENDDO