diff --git a/CMakeLists.txt b/CMakeLists.txt index 3ecee197..2f698fb1 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -58,7 +58,7 @@ target_link_libraries(nemsio::nemsio INTERFACE w3emc::w3emc_d bacio::bacio_4) if(CMAKE_Fortran_COMPILER_ID MATCHES "^(Intel)$") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -g -traceback") set(CMAKE_Fortran_FLAGS_RELEASE "-O3") - set(CMAKE_Fortran_FLAGS_DEBUG "-O0 -check -check noarg_temp_created -check nopointer -fp-stack-check -fstack-protector-all -fpe0 -debug -ftrapuv") + set(CMAKE_Fortran_FLAGS_DEBUG "-O0 -check all -ftrapuv") elseif(CMAKE_Fortran_COMPILER_ID MATCHES "^(GNU)$") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -g -fbacktrace") set(CMAKE_Fortran_FLAGS_RELEASE "-O3") diff --git a/src/ocnicepost.fd/masking_mod.F90 b/src/ocnicepost.fd/masking_mod.F90 index a2999596..ae505545 100644 --- a/src/ocnicepost.fd/masking_mod.F90 +++ b/src/ocnicepost.fd/masking_mod.F90 @@ -6,7 +6,7 @@ module masking_mod use init_mod , only : wgtsdir, ftype, fsrc, fdst, input_file use init_mod , only : do_ocnpost, debug, logunit, maskvar use arrays_mod , only : dstlat, dstlon - use utils_mod , only : getfield, dumpnc, remap + use utils_mod , only : getfield, dumpnc, remap, nf90_err implicit none @@ -41,14 +41,14 @@ subroutine remap_masks(vfill) allocate(dstlat(nxr,nyr)); dstlat = 0.0 allocate(out1d(nxr*nyr)); out1d = 0.0 - rc = nf90_open(trim(wgtsfile), nf90_nowrite, ncid) - rc = nf90_inq_varid(ncid, 'xc_b', varid) - rc = nf90_get_var(ncid, varid, out1d) + call nf90_err(nf90_open(trim(wgtsfile), nf90_nowrite, ncid), 'open: '//wgtsfile) + call nf90_err(nf90_inq_varid(ncid, 'xc_b', varid), 'get variable Id: xc_b') + call nf90_err(nf90_get_var(ncid, varid, out1d), 'get variable: xc_b') dstlon = reshape(out1d,(/nxr,nyr/)) - rc = nf90_inq_varid(ncid, 'yc_b', varid) - rc = nf90_get_var(ncid, varid, out1d) + call nf90_err(nf90_inq_varid(ncid, 'yc_b', varid), 'get variable Id: yc_b') + call nf90_err(nf90_get_var(ncid, varid, out1d), 'get variable: yc_b') dstlat = reshape(out1d,(/nxr,nyr/)) - rc = nf90_close(ncid) + call nf90_err(nf90_close(ncid), 'close: '//wgtsfile) ! -------------------------------------------------------- ! mask is a 2d (ice) or 3d (ocn) array which contains 1's @@ -110,12 +110,12 @@ subroutine makemask3d(vfill) allocate(tmp3d(nxt,nyt,nlevs)); tmp3d = 0.0 - rc = nf90_open(trim(input_file), nf90_nowrite, ncid) + call nf90_err(nf90_open(trim(input_file), nf90_nowrite, ncid), 'open: '//trim(input_file)) ! Obtain maskvar directly from file to set fill value - rc = nf90_inq_varid(ncid, trim(maskvar), varid) - rc = nf90_get_att(ncid, varid, '_FillValue', vfill) - rc = nf90_get_var(ncid, varid, tmp3d) - rc = nf90_close(ncid) + call nf90_err(nf90_inq_varid(ncid, trim(maskvar), varid) , 'get variable Id: '// trim(maskvar)) + call nf90_err(nf90_get_att(ncid, varid, '_FillValue', vfill), 'get variable attribute: FillValue '// trim(maskvar)) + call nf90_err(nf90_get_var(ncid, varid, tmp3d) , 'get variable: '//trim(maskvar)) + call nf90_err(nf90_close(ncid), 'close: '//trim(input_file)) mask3d = reshape(tmp3d, (/nxt*nyt,nlevs/)) ! set mask3d to 0 on ocean, 1 on land on source grid @@ -139,12 +139,12 @@ subroutine makemask2d(vfill) allocate(tmp2d(nxt,nyt)); tmp2d = 0.0 - rc = nf90_open(trim(input_file), nf90_nowrite, ncid) + call nf90_err(nf90_open(trim(input_file), nf90_nowrite, ncid), 'open: '//trim(input_file)) ! Obtain maskvar directly from file to set fill value - rc = nf90_inq_varid(ncid, trim(maskvar), varid) - rc = nf90_get_att(ncid, varid, '_FillValue', vfill) - rc = nf90_get_var(ncid, varid, tmp2d) - rc = nf90_close(ncid) + call nf90_err(nf90_inq_varid(ncid, trim(maskvar), varid), 'get variable Id: '// trim(maskvar)) + call nf90_err(nf90_get_att(ncid, varid, '_FillValue', vfill), 'get variable attribute: FillValue '// trim(maskvar)) + call nf90_err(nf90_get_var(ncid, varid, tmp2d), 'get variable: '//trim(maskvar)) + call nf90_err(nf90_close(ncid), 'close: '//trim(input_file)) mask2d = reshape(tmp2d, (/nxt*nyt/)) ! set mask2d to 0 on ocean, 1 on land on source grid diff --git a/src/ocnicepost.fd/ocnicepost.F90 b/src/ocnicepost.fd/ocnicepost.F90 index 5669f5d0..3e3efcdd 100644 --- a/src/ocnicepost.fd/ocnicepost.F90 +++ b/src/ocnicepost.fd/ocnicepost.F90 @@ -31,7 +31,7 @@ program ocnicepost use arrays_mod , only : b2d, c2d, b3d, rgb2d, rgc2d, rgb3d, dstlon, dstlat, setup_packing use arrays_mod , only : nbilin2d, nbilin3d, nconsd2d, bilin2d, bilin3d, consd2d use masking_mod, only : mask2d, mask3d, rgmask2d, rgmask3d, remap_masks - use utils_mod , only : getfield, packarrays, remap, dumpnc + use utils_mod , only : getfield, packarrays, remap, dumpnc, nf90_err implicit none @@ -73,19 +73,19 @@ program ocnicepost ! rotation angles, vertical grid and time axis ! -------------------------------------------------------- - rc = nf90_open(trim(input_file), nf90_nowrite, ncid) + call nf90_err(nf90_open(trim(input_file), nf90_nowrite, ncid), 'open: '//trim(input_file)) do n = 1,nvalid - rc = nf90_inq_varid(ncid, trim(outvars(n)%var_name), varid) - rc = nf90_get_att(ncid, varid, 'long_name', outvars(n)%long_name) - rc = nf90_get_att(ncid, varid, 'units', outvars(n)%units) - rc = nf90_get_att(ncid, varid, '_FillValue', outvars(n)%var_fillvalue) + call nf90_err(nf90_inq_varid(ncid, trim(outvars(n)%var_name), varid), 'get variable Id: '//trim(outvars(n)%var_name)) + call nf90_err(nf90_get_att(ncid, varid, 'long_name', outvars(n)%long_name), 'get variable attribute: long_name '//trim(outvars(n)%var_name)) + call nf90_err(nf90_get_att(ncid, varid, 'units', outvars(n)%units), 'get variable attribute: units '//trim(outvars(n)%var_name) ) + call nf90_err(nf90_get_att(ncid, varid, '_FillValue', outvars(n)%var_fillvalue), 'get variable attribute: FillValue'//trim(outvars(n)%var_name)) end do ! timestamp - rc = nf90_inq_varid(ncid, 'time', varid) - rc = nf90_get_var(ncid, varid, timestamp) - rc = nf90_get_att(ncid, varid, 'units', timeunit) - rc = nf90_get_att(ncid, varid, 'calendar', timecal) + call nf90_err(nf90_inq_varid(ncid, 'time', varid), 'get variable Id: time'//trim(input_file)) + call nf90_err(nf90_get_var(ncid, varid, timestamp), 'get variable: time'//trim(input_file)) + call nf90_err(nf90_get_att(ncid, varid, 'units', timeunit), 'get variable attribute : units '//trim(input_file)) + call nf90_err(nf90_get_att(ncid, varid, 'calendar', timecal), 'get variable attribute : calendar '//trim(input_file)) if (do_ocnpost) then allocate(z_l(nlevs)) ; z_l = 0.0 allocate(z_i(0:nlevs)); z_i = 0.0 @@ -93,12 +93,12 @@ program ocnicepost allocate(sinrot(nxt*nyt)); sinrot = 0.0 ! cell centers - rc = nf90_inq_varid(ncid, 'z_l', varid) - rc = nf90_get_var(ncid, varid, z_l) + call nf90_err(nf90_inq_varid(ncid, 'z_l', varid), 'get variable Id: z_l '//trim(input_file)) + call nf90_err(nf90_get_var(ncid, varid, z_l), 'get variable: z_l '//trim(input_file)) ! cell edges - rc = nf90_inq_varid(ncid, 'z_i', varid) - rc = nf90_get_var(ncid, varid, z_i) - rc = nf90_close(ncid) + call nf90_err(nf90_inq_varid(ncid, 'z_i', varid), 'get variable Id: z_i '//trim(input_file)) + call nf90_err(nf90_get_var(ncid, varid, z_i), 'get variable: z_i '//trim(input_file)) + call nf90_err(nf90_close(ncid), 'close: '//trim(input_file)) ! rotation angles call getfield(trim(input_file), trim(cosvar), dims=(/nxt,nyt/), field=cosrot) call getfield(trim(input_file), trim(sinvar), dims=(/nxt,nyt/), field=sinrot) @@ -259,30 +259,30 @@ program ocnicepost fout = trim(ftype)//'.'//trim(fdst)//'.nc' if (debug) write(logunit, '(a)')'output file: '//trim(fout) - rc = nf90_create(trim(fout), nf90_clobber, ncid) - rc = nf90_def_dim(ncid, 'longitude', nxr, idimid) - rc = nf90_def_dim(ncid, 'latitude', nyr, jdimid) - rc = nf90_def_dim(ncid, 'time', nf90_unlimited, timid) + call nf90_err(nf90_create(trim(fout), nf90_clobber, ncid), 'create: '//trim(fout)) + call nf90_err(nf90_def_dim(ncid, 'longitude', nxr, idimid), 'define dimension: longitude') + call nf90_err(nf90_def_dim(ncid, 'latitude', nyr, jdimid), 'define dimension: latitude') + call nf90_err(nf90_def_dim(ncid, 'time', nf90_unlimited, timid), 'define dimension: time') ! define the time variable - rc = nf90_def_var(ncid, 'time', nf90_double, (/timid/), varid) - rc = nf90_put_att(ncid, varid, 'units', trim(timeunit)) - rc= nf90_put_att(ncid, varid, 'calendar', trim(timecal)) + call nf90_err(nf90_def_var(ncid, 'time', nf90_double, (/timid/), varid), 'define variable: time') + call nf90_err(nf90_put_att(ncid, varid, 'units', trim(timeunit)), 'put variable attribute: units') + call nf90_err(nf90_put_att(ncid, varid, 'calendar', trim(timecal)), 'put variable attribute: calendar') ! spatial grid - rc = nf90_def_var(ncid, 'longitude', nf90_float, (/idimid/), varid) - rc = nf90_put_att(ncid, varid, 'units', 'degrees_east') - rc = nf90_def_var(ncid, 'latitude', nf90_float, (/jdimid/), varid) - rc = nf90_put_att(ncid, varid, 'units', 'degrees_north') + call nf90_err(nf90_def_var(ncid, 'longitude', nf90_float, (/idimid/), varid), 'define variable: longitude') + call nf90_err(nf90_put_att(ncid, varid, 'units', 'degrees_east'), 'put variable attribute: units') + call nf90_err(nf90_def_var(ncid, 'latitude', nf90_float, (/jdimid/), varid), 'define variable: latitude' ) + call nf90_err(nf90_put_att(ncid, varid, 'units', 'degrees_north'), 'put variable attribute: units') ! vertical grid if (do_ocnpost) then - rc = nf90_def_dim(ncid, 'z_l', nlevs , kdimid) - rc = nf90_def_dim(ncid, 'z_i', nlevs+1, edimid) - rc = nf90_def_var(ncid, 'z_l', nf90_float, (/kdimid/), varid) - rc = nf90_put_att(ncid, varid, 'units', 'm') - rc = nf90_put_att(ncid, varid, 'positive', 'down') - rc = nf90_def_var(ncid, 'z_i', nf90_float, (/edimid/), varid) - rc = nf90_put_att(ncid, varid, 'units', 'm') - rc = nf90_put_att(ncid, varid, 'positive', 'down') + call nf90_err(nf90_def_dim(ncid, 'z_l', nlevs , kdimid), 'define dimension: z_l') + call nf90_err(nf90_def_dim(ncid, 'z_i', nlevs+1, edimid), 'define dimension: z_i') + call nf90_err(nf90_def_var(ncid, 'z_l', nf90_float, (/kdimid/), varid), 'define variable: z_l') + call nf90_err(nf90_put_att(ncid, varid, 'units', 'm'), 'put variable attribute: units') + call nf90_err(nf90_put_att(ncid, varid, 'positive', 'down'), 'put variable attribute: positive') + call nf90_err(nf90_def_var(ncid, 'z_i', nf90_float, (/edimid/), varid), 'define variable: z_i') + call nf90_err(nf90_put_att(ncid, varid, 'units', 'm'), 'put variable attribute: units') + call nf90_err(nf90_put_att(ncid, varid, 'positive', 'down'), 'put variable attribute: positive') end if if (allocated(b2d)) then @@ -291,10 +291,10 @@ program ocnicepost vunit = trim(b2d(n)%units) vlong = trim(b2d(n)%long_name) vfill = b2d(n)%var_fillvalue - rc = nf90_def_var(ncid, vname, nf90_float, (/idimid,jdimid,timid/), varid) - rc = nf90_put_att(ncid, varid, 'units', vunit) - rc = nf90_put_att(ncid, varid, 'long_name', vlong) - rc = nf90_put_att(ncid, varid, '_FillValue', vfill) + call nf90_err(nf90_def_var(ncid, vname, nf90_float, (/idimid,jdimid,timid/), varid), 'define variable: '// vname) + call nf90_err(nf90_put_att(ncid, varid, 'units', vunit), 'put variable attribute: units') + call nf90_err(nf90_put_att(ncid, varid, 'long_name', vlong), 'put variable attribute: long_name') + call nf90_err(nf90_put_att(ncid, varid, '_FillValue', vfill), 'put variable attribute: FillValue') enddo end if if (allocated(c2d)) then @@ -303,10 +303,10 @@ program ocnicepost vunit = trim(c2d(n)%units) vlong = trim(c2d(n)%long_name) vfill = c2d(n)%var_fillvalue - rc = nf90_def_var(ncid, vname, nf90_float, (/idimid,jdimid,timid/), varid) - rc = nf90_put_att(ncid, varid, 'units', vunit) - rc = nf90_put_att(ncid, varid, 'long_name', vlong) - rc = nf90_put_att(ncid, varid, '_FillValue', vfill) + call nf90_err(nf90_def_var(ncid, vname, nf90_float, (/idimid,jdimid,timid/), varid), 'define variable: '// vname) + call nf90_err(nf90_put_att(ncid, varid, 'units', vunit), 'put variable attribute: units' ) + call nf90_err(nf90_put_att(ncid, varid, 'long_name', vlong), 'put variable attribute: long_name' ) + call nf90_err(nf90_put_att(ncid, varid, '_FillValue', vfill), 'put variable attribute: FillValue' ) enddo end if if (allocated(b3d)) then @@ -315,36 +315,36 @@ program ocnicepost vunit = trim(b3d(n)%units) vlong = trim(b3d(n)%long_name) vfill = b3d(n)%var_fillvalue - rc = nf90_def_var(ncid, vname, nf90_float, (/idimid,jdimid,kdimid,timid/), varid) - rc = nf90_put_att(ncid, varid, 'units', vunit) - rc = nf90_put_att(ncid, varid, 'long_name', vlong) - rc = nf90_put_att(ncid, varid, '_FillValue', vfill) + call nf90_err(nf90_def_var(ncid, vname, nf90_float, (/idimid,jdimid,kdimid,timid/), varid), 'define variable: '// vname) + call nf90_err(nf90_put_att(ncid, varid, 'units', vunit), 'put variable attribute: units' ) + call nf90_err(nf90_put_att(ncid, varid, 'long_name', vlong), 'put variable attribute: long_name' ) + call nf90_err(nf90_put_att(ncid, varid, '_FillValue', vfill), 'put variable attribute: FillValue' ) enddo end if - rc = nf90_enddef(ncid) + call nf90_err(nf90_enddef(ncid), 'enddef: '// trim(fout)) ! dimensions - rc = nf90_inq_varid(ncid, 'longitude', varid) - rc = nf90_put_var(ncid, varid, dstlon(:,1)) - rc = nf90_inq_varid(ncid, 'latitude', varid) - rc = nf90_put_var(ncid, varid, dstlat(1,:)) + call nf90_err(nf90_inq_varid(ncid, 'longitude', varid), 'get variable Id: longitude') + call nf90_err(nf90_put_var(ncid, varid, dstlon(:,1)), 'put variable: longitude') + call nf90_err(nf90_inq_varid(ncid, 'latitude', varid), 'get variable Id: latitude') + call nf90_err(nf90_put_var(ncid, varid, dstlat(1,:)), 'put variable: latitude') ! time - rc = nf90_inq_varid(ncid, 'time', varid) - rc = nf90_put_var(ncid, varid, timestamp) + call nf90_err(nf90_inq_varid(ncid, 'time', varid), 'get variable Id: time') + call nf90_err(nf90_put_var(ncid, varid, timestamp), 'put variable: time') ! vertical if (do_ocnpost) then - rc = nf90_inq_varid(ncid, 'z_l', varid) - rc = nf90_put_var(ncid, varid, z_l) - rc = nf90_inq_varid(ncid, 'z_i', varid) - rc = nf90_put_var(ncid, varid, z_i) + call nf90_err(nf90_inq_varid(ncid, 'z_l', varid), 'get variable Id: z_l') + call nf90_err(nf90_put_var(ncid, varid, z_l) , 'put variable: z_l') + call nf90_err(nf90_inq_varid(ncid, 'z_i', varid), 'get variable Id: z_i') + call nf90_err(nf90_put_var(ncid, varid, z_i) , 'put variable: z_i') end if if (allocated(rgb2d)) then do n = 1,nbilin2d out2d(:,:) = reshape(rgb2d(:,n), (/nxr,nyr/)) out2d(:,nyr) = vfill vname = trim(b2d(n)%var_name) - rc = nf90_inq_varid(ncid, vname, varid) - rc = nf90_put_var(ncid, varid, out2d) + call nf90_err(nf90_inq_varid(ncid, vname, varid), 'get variable Id: '//vname) + call nf90_err(nf90_put_var(ncid, varid, out2d), 'put variable: '//vname) end do end if if (allocated(rgc2d)) then @@ -352,8 +352,8 @@ program ocnicepost out2d(:,:) = reshape(rgc2d(:,n), (/nxr,nyr/)) out2d(:,nyr) = vfill vname = trim(c2d(n)%var_name) - rc = nf90_inq_varid(ncid, vname, varid) - rc = nf90_put_var(ncid, varid, out2d) + call nf90_err(nf90_inq_varid(ncid, vname, varid), 'get variable Id: '//vname) + call nf90_err(nf90_put_var(ncid, varid, out2d), 'put variable: '//vname) end do end if if (allocated(rgb3d)) then @@ -361,11 +361,11 @@ program ocnicepost out3d(:,:,:) = reshape(rgb3d(:,:,n), (/nxr,nyr,nlevs/)) out3d(:,nyr,:) = vfill vname = trim(b3d(n)%var_name) - rc = nf90_inq_varid(ncid, vname, varid) - rc = nf90_put_var(ncid, varid, out3d) + call nf90_err(nf90_inq_varid(ncid, vname, varid), 'get variable Id: '//vname) + call nf90_err(nf90_put_var(ncid, varid, out3d), 'put variable: '//vname) end do end if - rc = nf90_close(ncid) + call nf90_err(nf90_close(ncid), 'close: '// trim(fout)) write(logunit,'(a)')trim(fout)//' done' end program ocnicepost diff --git a/src/ocnicepost.fd/utils_mod.F90 b/src/ocnicepost.fd/utils_mod.F90 index 82183c5e..1e3d9a4d 100644 --- a/src/ocnicepost.fd/utils_mod.F90 +++ b/src/ocnicepost.fd/utils_mod.F90 @@ -39,6 +39,7 @@ module utils_mod public packarrays public remap public dumpnc + public nf90_err contains @@ -242,14 +243,11 @@ subroutine getfield2d(fname, vname, dims, field, wgts) allocate(a2d(dims(1),dims(2))); a2d = 0.0 allocate(atmp(dims(1)*dims(2))); atmp = 0.0 - rc = nf90_open(fname, nf90_nowrite, ncid) - call handle_err(rc,' nf90_open '//fname) - rc = nf90_inq_varid(ncid, vname, varid) - call handle_err(rc,' get variable ID '// vname) - rc = nf90_get_var(ncid, varid, a2d) - call handle_err(rc,' get variable'// vname) - rc = nf90_get_att(ncid, varid, '_FillValue', fval) - rc = nf90_close(ncid) + call nf90_err(nf90_open(fname, nf90_nowrite, ncid), 'nf90_open: '//fname) + call nf90_err(nf90_inq_varid(ncid, vname, varid), 'get variable ID: '//vname) + call nf90_err(nf90_get_var(ncid, varid, a2d), 'get variable: '//vname) + call nf90_err(nf90_get_att(ncid, varid, '_FillValue', fval), 'get attribute FillValue: '//vname) + call nf90_err(nf90_close(ncid), 'close: '//fname) atmp(:) = reshape(a2d, (/dims(1)*dims(2)/)) where(atmp .eq. fval)atmp = 0.0 @@ -284,14 +282,11 @@ subroutine getfield3d(fname, vname, dims, field, wgts) allocate(a3d(dims(1),dims(2),dims(3))); a3d = 0.0 allocate(atmp(dims(1)*dims(2),dims(3))); atmp = 0.0 - rc = nf90_open(fname, nf90_nowrite, ncid) - call handle_err(rc,' nf90_open '//fname) - rc = nf90_inq_varid(ncid, vname, varid) - call handle_err(rc,' get variable ID '// vname) - rc = nf90_get_var(ncid, varid, a3d) - call handle_err(rc,' get variable'// vname) - rc = nf90_get_att(ncid, varid, '_FillValue', fval) - rc = nf90_close(ncid) + call nf90_err(nf90_open(fname, nf90_nowrite, ncid), 'nf90_open: '//fname) + call nf90_err(nf90_inq_varid(ncid, vname, varid), 'get variable ID: '//vname) + call nf90_err(nf90_get_var(ncid, varid, a3d), 'get variable: '//vname) + call nf90_err(nf90_get_att(ncid, varid, '_FillValue', fval), 'get attribute FillValue: '//vname) + call nf90_err(nf90_close(ncid), 'close: '//fname) atmp(:,:) = reshape(a3d, (/dims(1)*dims(2),dims(3)/)) where(atmp .eq. fval)atmp = 0.0 @@ -324,26 +319,25 @@ subroutine remap1d(fname, src_field, dst_field) if (debug)write(logunit,'(a)')'enter '//trim(subname) ! retrieve the weights - rc = nf90_open(trim(fname), nf90_nowrite, ncid) - call handle_err(rc,' nf90_open '//fname) - rc = nf90_inq_dimid(ncid, 'n_s', id) - rc = nf90_inquire_dimension(ncid, id, len=n_s) - rc = nf90_inq_dimid(ncid, 'n_a', id) - rc = nf90_inquire_dimension(ncid, id, len=n_a) - rc = nf90_inq_dimid(ncid, 'n_b', id) - rc = nf90_inquire_dimension(ncid, id, len=n_b) + call nf90_err(nf90_open(trim(fname), nf90_nowrite, ncid), 'open: '//fname) + call nf90_err(nf90_inq_dimid(ncid, 'n_s', id), 'get dimension Id: n_s') + call nf90_err(nf90_inquire_dimension(ncid, id, len=n_s), 'get dimension: n_s' ) + call nf90_err(nf90_inq_dimid(ncid, 'n_a', id), 'get dimension Id: n_a') + call nf90_err(nf90_inquire_dimension(ncid, id, len=n_a), 'get dimension: n_a' ) + call nf90_err(nf90_inq_dimid(ncid, 'n_b', id), 'get dimension Id: n_b') + call nf90_err(nf90_inquire_dimension(ncid, id, len=n_b), 'get dimension: n_b' ) allocate(col(1:n_s)); col = 0 allocate(row(1:n_s)); row = 0 allocate( S(1:n_s)); S = 0.0 - rc = nf90_inq_varid(ncid, 'col', id) - rc = nf90_get_var(ncid, id, col) - rc = nf90_inq_varid(ncid, 'row', id) - rc = nf90_get_var(ncid, id, row) - rc = nf90_inq_varid(ncid, 'S', id) - rc = nf90_get_var(ncid, id, S) - rc = nf90_close(ncid) + call nf90_err(nf90_inq_varid(ncid, 'col', id),'get variable Id: col') + call nf90_err(nf90_get_var(ncid, id, col),'get variable: col') + call nf90_err(nf90_inq_varid(ncid, 'row', id),'get variable Id: row') + call nf90_err(nf90_get_var(ncid, id, row),'get variable: row') + call nf90_err(nf90_inq_varid(ncid, 'S', id),'get variable Id: S') + call nf90_err(nf90_get_var(ncid, id, S),'get variable: S') + call nf90_err(nf90_close(ncid), 'close: '//fname) dst_field = 0.0 do i = 1,n_s @@ -375,26 +369,25 @@ subroutine remap2d(fname, dim2, src_field, dst_field) if (debug)write(logunit,'(a)')'enter '//trim(subname)//' weights = '//trim(fname) ! retrieve the weights - rc = nf90_open(trim(fname), nf90_nowrite, ncid) - call handle_err(rc,' nf90_open '//fname) - rc = nf90_inq_dimid(ncid, 'n_s', id) - rc = nf90_inquire_dimension(ncid, id, len=n_s) - rc = nf90_inq_dimid(ncid, 'n_a', id) - rc = nf90_inquire_dimension(ncid, id, len=n_a) - rc = nf90_inq_dimid(ncid, 'n_b', id) - rc = nf90_inquire_dimension(ncid, id, len=n_b) + call nf90_err(nf90_open(trim(fname), nf90_nowrite, ncid), 'open: '//fname) + call nf90_err(nf90_inq_dimid(ncid, 'n_s', id), 'get dimension Id: n_s') + call nf90_err(nf90_inquire_dimension(ncid, id, len=n_s), 'get dimension: n_s') + call nf90_err(nf90_inq_dimid(ncid, 'n_a', id), 'get dimension Id: n_a') + call nf90_err(nf90_inquire_dimension(ncid, id, len=n_a), 'get dimension: n_a') + call nf90_err(nf90_inq_dimid(ncid, 'n_b', id), 'get dimension Id: n_b') + call nf90_err(nf90_inquire_dimension(ncid, id, len=n_b), 'get dimension: n_b') allocate(col(1:n_s)); col = 0 allocate(row(1:n_s)); row = 0 allocate( S(1:n_s)); S = 0.0 - rc = nf90_inq_varid(ncid, 'col', id) - rc = nf90_get_var(ncid, id, col) - rc = nf90_inq_varid(ncid, 'row', id) - rc = nf90_get_var(ncid, id, row) - rc = nf90_inq_varid(ncid, 'S', id) - rc = nf90_get_var(ncid, id, S) - rc = nf90_close(ncid) + call nf90_err(nf90_inq_varid(ncid, 'col', id),'get variable Id: col') + call nf90_err(nf90_get_var(ncid, id, col),'get variable: col') + call nf90_err(nf90_inq_varid(ncid, 'row', id),'get variable Id: row') + call nf90_err(nf90_get_var(ncid, id, row),'get variable: row') + call nf90_err(nf90_inq_varid(ncid, 'S', id),'get variable Id: S') + call nf90_err(nf90_get_var(ncid, id, S),'get variable: S') + call nf90_err(nf90_close(ncid), 'close: '//fname) dst_field = 0.0 do i = 1,n_s @@ -426,26 +419,25 @@ subroutine remap3d(fname, nk, nflds, src_field, dst_field) if (debug)write(logunit,'(a)')'enter '//trim(subname)//' weights = '//trim(fname) ! retrieve the weights - rc = nf90_open(trim(fname), nf90_nowrite, ncid) - call handle_err(rc,' nf90_open '//fname) - rc = nf90_inq_dimid(ncid, 'n_s', id) - rc = nf90_inquire_dimension(ncid, id, len=n_s) - rc = nf90_inq_dimid(ncid, 'n_a', id) - rc = nf90_inquire_dimension(ncid, id, len=n_a) - rc = nf90_inq_dimid(ncid, 'n_b', id) - rc = nf90_inquire_dimension(ncid, id, len=n_b) + call nf90_err(nf90_open(trim(fname), nf90_nowrite, ncid), 'open: '//fname) + call nf90_err(nf90_inq_dimid(ncid, 'n_s', id), 'get dimension Id: n_s') + call nf90_err(nf90_inquire_dimension(ncid, id, len=n_s), 'get dimension: n_s') + call nf90_err(nf90_inq_dimid(ncid, 'n_a', id), 'get dimension Id: n_a') + call nf90_err(nf90_inquire_dimension(ncid, id, len=n_a), 'get dimension: n_a') + call nf90_err(nf90_inq_dimid(ncid, 'n_b', id), 'get dimension Id: n_b') + call nf90_err(nf90_inquire_dimension(ncid, id, len=n_b), 'get dimension: n_b') allocate(col(1:n_s)); col = 0 allocate(row(1:n_s)); row = 0 allocate( S(1:n_s)); S = 0.0 - rc = nf90_inq_varid(ncid, 'col', id) - rc = nf90_get_var(ncid, id, col) - rc = nf90_inq_varid(ncid, 'row', id) - rc = nf90_get_var(ncid, id, row) - rc = nf90_inq_varid(ncid, 'S', id) - rc = nf90_get_var(ncid, id, S) - rc = nf90_close(ncid) + call nf90_err(nf90_inq_varid(ncid, 'col', id),'get variable Id: col') + call nf90_err(nf90_get_var(ncid, id, col),'get variable: col') + call nf90_err(nf90_inq_varid(ncid, 'row', id),'get variable Id: row') + call nf90_err(nf90_get_var(ncid, id, row),'get variable: row') + call nf90_err(nf90_inq_varid(ncid, 'S', id),'get variable Id: S') + call nf90_err(nf90_get_var(ncid, id, S),'get variable: S') + call nf90_err(nf90_close(ncid), 'close: '//fname) dst_field = 0.0 do i = 1,n_s @@ -474,16 +466,16 @@ subroutine dumpnc2d(fname, vname, dims, nflds, field) if (debug)write(logunit,'(a)')'enter '//trim(subname)//' variable '//vname allocate(a3d(dims(1),dims(2),nflds)); a3d = 0.0 - rc = nf90_create(trim(fname), nf90_clobber, ncid) - rc = nf90_def_dim(ncid, 'nx', dims(1), idimid) - rc = nf90_def_dim(ncid, 'ny', dims(2), jdimid) - rc = nf90_def_dim(ncid, 'nf', nflds, fdimid) - rc = nf90_def_var(ncid, vname, nf90_float, (/idimid,jdimid,fdimid/), varid) - rc = nf90_enddef(ncid) + call nf90_err(nf90_create(trim(fname), nf90_clobber, ncid), 'create: '//fname) + call nf90_err(nf90_def_dim(ncid, 'nx', dims(1), idimid), 'define dimension: nx') + call nf90_err(nf90_def_dim(ncid, 'ny', dims(2), jdimid), 'define dimension: ny') + call nf90_err(nf90_def_dim(ncid, 'nf', nflds, fdimid), 'define dimension: nf') + call nf90_err(nf90_def_var(ncid, vname, nf90_float, (/idimid,jdimid,fdimid/), varid), 'define variable: '//vname) + call nf90_err(nf90_enddef(ncid), 'nf90_enddef: '//fname) a3d(:,:,:) = reshape(field(1:dims(1)*dims(2),1:nflds), (/dims(1),dims(2),nflds/)) - rc = nf90_put_var(ncid, varid, a3d) - rc = nf90_close(ncid) + call nf90_err(nf90_put_var(ncid, varid, a3d), 'put variable: '//vname) + call nf90_err(nf90_close(ncid), 'close: '//fname) if (debug)write(logunit,'(a)')'exit '//trim(subname)//' variable '//vname end subroutine dumpnc2d @@ -506,19 +498,19 @@ subroutine dumpnc3d(fname, vname, dims, nk, nflds, field) if (debug)write(logunit,'(a)')'enter '//trim(subname)//' variable '//vname allocate(a4d(dims(1),dims(2),dims(3),nflds)); a4d = 0.0 - rc = nf90_create(trim(fname), nf90_clobber, ncid) - rc = nf90_def_dim(ncid, 'nx', dims(1), idimid) - rc = nf90_def_dim(ncid, 'ny', dims(2), jdimid) - rc = nf90_def_dim(ncid, 'nk', dims(3), kdimid) - rc = nf90_def_dim(ncid, 'nf', nflds, fdimid) - rc = nf90_def_var(ncid, vname, nf90_float, (/idimid,jdimid,kdimid,fdimid/), varid) - rc = nf90_enddef(ncid) + call nf90_err(nf90_create(trim(fname), nf90_clobber, ncid), 'create: '//fname) + call nf90_err(nf90_def_dim(ncid, 'nx', dims(1), idimid), 'define dimension: nx') + call nf90_err(nf90_def_dim(ncid, 'ny', dims(2), jdimid), 'define dimension: ny') + call nf90_err(nf90_def_dim(ncid, 'nk', dims(3), kdimid), 'define dimension: nk') + call nf90_err(nf90_def_dim(ncid, 'nf', nflds, fdimid), 'define dimension: nf') + call nf90_err(nf90_def_var(ncid, vname, nf90_float, (/idimid,jdimid,kdimid,fdimid/), varid), 'define variable: '//vname) + call nf90_err(nf90_enddef(ncid), 'nf90_enddef: '//fname) do n = 1,nflds a4d(:,:,:,n) = reshape(field(1:dims(1)*dims(2),1:dims(3),n), (/dims(1),dims(2),dims(3)/)) end do - rc = nf90_put_var(ncid, varid, a4d) - rc = nf90_close(ncid) + call nf90_err(nf90_put_var(ncid, varid, a4d), 'put variable: '//vname) + call nf90_err(nf90_close(ncid), 'close: '//fname) if (debug)write(logunit,'(a)')'exit '//trim(subname)//' variable '//vname end subroutine dumpnc3d @@ -540,16 +532,16 @@ subroutine dumpnc3dk(fname, vname, dims, field) if (debug)write(logunit,'(a)')'enter '//trim(subname)//' variable '//vname allocate(a3d(dims(1),dims(2),dims(3))); a3d = 0.0 - rc = nf90_create(trim(fname), nf90_clobber, ncid) - rc = nf90_def_dim(ncid, 'nx', dims(1), idimid) - rc = nf90_def_dim(ncid, 'ny', dims(2), jdimid) - rc = nf90_def_dim(ncid, 'nk', dims(3), kdimid) - rc = nf90_def_var(ncid, vname, nf90_float, (/idimid,jdimid,kdimid/), varid) - rc = nf90_enddef(ncid) + call nf90_err(nf90_create(trim(fname), nf90_clobber, ncid), 'nf90_create: '//fname) + call nf90_err(nf90_def_dim(ncid, 'nx', dims(1), idimid), 'define dimension: nx') + call nf90_err(nf90_def_dim(ncid, 'ny', dims(2), jdimid), 'define dimension: ny') + call nf90_err(nf90_def_dim(ncid, 'nk', dims(3), kdimid), 'define dimension: nk') + call nf90_err(nf90_def_var(ncid, vname, nf90_float, (/idimid,jdimid,kdimid/), varid), 'define variable: '//vname) + call nf90_err(nf90_enddef(ncid), 'nf90_enddef: '//fname) a3d(:,:,:) = reshape(field(1:dims(1)*dims(2),1:dims(3)), (/dims(1),dims(2),dims(3)/)) - rc = nf90_put_var(ncid, varid, a3d) - rc = nf90_close(ncid) + call nf90_err(nf90_put_var(ncid, varid, a3d), 'put variable: '//vname) + call nf90_err(nf90_close(ncid), 'close: '//fname) if (debug)write(logunit,'(a)')'exit '//trim(subname)//' variable '//vname @@ -572,15 +564,15 @@ subroutine dumpnc1d(fname, vname, dims, field) if (debug)write(logunit,'(a)')'enter '//trim(subname)//' variable '//vname allocate(a2d(dims(1),dims(2))); a2d = 0.0 - rc = nf90_create(trim(fname), nf90_clobber, ncid) - rc = nf90_def_dim(ncid, 'nx', dims(1), idimid) - rc = nf90_def_dim(ncid, 'ny', dims(2), jdimid) - rc = nf90_def_var(ncid, vname, nf90_float, (/idimid,jdimid/), varid) - rc = nf90_enddef(ncid) + call nf90_err(nf90_create(trim(fname), nf90_clobber, ncid), 'nf90_create: '//fname) + call nf90_err(nf90_def_dim(ncid, 'nx', dims(1), idimid), 'define dimension: nx') + call nf90_err(nf90_def_dim(ncid, 'ny', dims(2), jdimid), 'define dimension: ny') + call nf90_err(nf90_def_var(ncid, vname, nf90_float, (/idimid,jdimid/), varid), 'define variable: '//vname) + call nf90_err(nf90_enddef(ncid), 'nf90_enddef:'//fname) a2d(:,:) = reshape(field(1:dims(1)*dims(2)), (/dims(1),dims(2)/)) - rc = nf90_put_var(ncid, varid, a2d) - rc = nf90_close(ncid) + call nf90_err(nf90_put_var(ncid, varid, a2d), 'put variable: '//vname) + call nf90_err(nf90_close(ncid), 'close: '//fname) if (debug)write(logunit,'(a)')'exit '//trim(subname)//' variable '//vname @@ -589,13 +581,13 @@ end subroutine dumpnc1d !---------------------------------------------------------- ! handle netcdf errors !---------------------------------------------------------- - subroutine handle_err(ierr,string) + subroutine nf90_err(ierr, string) integer , intent(in) :: ierr character(len=*), intent(in) :: string if (ierr /= nf90_noerr) then - write(logunit,'(a)') '*** ERROR ***: '//trim(string)//':'//trim(nf90_strerror(ierr)) + write(logunit,'(a)') '*** FATAL ERROR ***: '//trim(string)//':'//trim(nf90_strerror(ierr)) stop end if - end subroutine handle_err + end subroutine nf90_err end module utils_mod