diff --git a/cicecore/cicedynB/analysis/ice_history_shared.F90 b/cicecore/cicedynB/analysis/ice_history_shared.F90 index 60740aea1..6c4d3acf3 100644 --- a/cicecore/cicedynB/analysis/ice_history_shared.F90 +++ b/cicecore/cicedynB/analysis/ice_history_shared.F90 @@ -33,6 +33,8 @@ module ice_history_shared private public :: define_hist_field, accum_hist_field, icefields_nml, construct_filename + integer (kind=int_kind), public :: history_precision + logical (kind=log_kind), public :: & hist_avg ! if true, write averaged data instead of snapshots diff --git a/cicecore/cicedynB/general/ice_init.F90 b/cicecore/cicedynB/general/ice_init.F90 index ffb070644..e96fc99d2 100644 --- a/cicecore/cicedynB/general/ice_init.F90 +++ b/cicecore/cicedynB/general/ice_init.F90 @@ -76,7 +76,8 @@ subroutine input_data restart, restart_ext, restart_dir, restart_file, pointer_file, & runid, runtype, use_restart_time, restart_format, lcdf64 use ice_history_shared, only: hist_avg, history_dir, history_file, & - incond_dir, incond_file, version_name + incond_dir, incond_file, version_name, & + history_precision use ice_flux, only: update_ocn_f, l_mpond_fresh use ice_flux, only: default_season use ice_flux_bgc, only: cpl_bgc @@ -152,7 +153,7 @@ subroutine input_data diagfreq, diag_type, diag_file, & print_global, print_points, latpnt, lonpnt, & dbug, histfreq, histfreq_n, hist_avg, & - history_dir, history_file, cpl_bgc, & + history_dir, history_file, history_precision, cpl_bgc, & write_ic, incond_dir, incond_file, version_name namelist /grid_nml/ & @@ -251,6 +252,7 @@ subroutine input_data hist_avg = .true. ! if true, write time-averages (not snapshots) history_dir = './' ! write to executable dir for default history_file = 'iceh' ! history file name prefix + history_precision = 4 ! precision of history files write_ic = .false. ! write out initial condition cpl_bgc = .false. ! history file name prefix incond_dir = history_dir ! write to history dir for default @@ -536,6 +538,7 @@ subroutine input_data call broadcast_scalar(hist_avg, master_task) call broadcast_scalar(history_dir, master_task) call broadcast_scalar(history_file, master_task) + call broadcast_scalar(history_precision, master_task) call broadcast_scalar(write_ic, master_task) call broadcast_scalar(cpl_bgc, master_task) call broadcast_scalar(incond_dir, master_task) @@ -935,6 +938,11 @@ subroutine input_data abort_flag = 19 endif + if(history_precision .ne. 4 .and. history_precision .ne. 8) then + write (nu_diag,*) 'ERROR: bad value for history_precision, allowed values: 4, 8' + abort_flag = 22 + endif + if (.not.(trim(dumpfreq) == 'y' .or. trim(dumpfreq) == 'Y' .or. & trim(dumpfreq) == 'm' .or. trim(dumpfreq) == 'M' .or. & trim(dumpfreq) == 'd' .or. trim(dumpfreq) == 'D' .or. & @@ -993,6 +1001,7 @@ subroutine input_data trim(history_dir) write(nu_diag,*) ' history_file = ', & trim(history_file) + write(nu_diag,1020) ' history_precision = ', history_precision if (write_ic) then write(nu_diag,*) 'Initial condition will be written in ', & trim(incond_dir) diff --git a/cicecore/cicedynB/infrastructure/io/io_binary/ice_history_write.F90 b/cicecore/cicedynB/infrastructure/io/io_binary/ice_history_write.F90 index dd525df6d..4154c59c1 100644 --- a/cicecore/cicedynB/infrastructure/io/io_binary/ice_history_write.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_binary/ice_history_write.F90 @@ -62,6 +62,10 @@ subroutine ice_write_hist(ns) integer (kind=int_kind) :: icategory,i_aice + character (len=4) :: & + atype ! format for output array + ! (real/integer, 4-byte/8-byte) + character (char_len) :: current_date,current_time character (len=16) :: c_aice logical (kind=log_kind) :: diag @@ -70,6 +74,9 @@ subroutine ice_write_hist(ns) diag = .false. + atype = 'rda4' + if (history_precision == 8) atype = 'rda8' + if (my_task == master_task) then call construct_filename(ncfile(ns),'da',ns) @@ -124,7 +131,7 @@ subroutine ice_write_hist(ns) write (nu_hdr, 996) nrec,'tarea','area of T grid cells','m^2' write (nu_hdr, * ) 'History variables: (left column = nrec)' endif ! my_task = master_task - call ice_write(nu_history, nrec, tarea, 'rda4', diag) + call ice_write(nu_history, nrec, tarea, atype, diag) do n=1,num_avail_hist_fields_2D if (avail_hist_fields(n)%vhistfreq == histfreq(ns)) then @@ -160,7 +167,7 @@ subroutine ice_write_hist(ns) endif endif - call ice_write(nu_history, nrec, a2D(:,:,n,:), 'rda4', diag) + call ice_write(nu_history, nrec, a2D(:,:,n,:), atype, diag) endif enddo ! num_avail_hist_fields_2D @@ -183,7 +190,7 @@ subroutine ice_write_hist(ns) endif endif - call ice_write(nu_history, nrec, a3Dc(:,:,nn,n-n2D,:), 'rda4', diag) + call ice_write(nu_history, nrec, a3Dc(:,:,nn,n-n2D,:), atype, diag) enddo ! ncat endif @@ -207,7 +214,7 @@ subroutine ice_write_hist(ns) endif endif - call ice_write(nu_history, nrec, a3Dz(:,:,k,n-n3Dccum,:), 'rda4', diag) + call ice_write(nu_history, nrec, a3Dz(:,:,k,n-n3Dccum,:), atype, diag) enddo ! nzilyr endif @@ -231,7 +238,7 @@ subroutine ice_write_hist(ns) endif endif - call ice_write(nu_history, nrec, a3Db(:,:,k,n-n3Dzcum,:), 'rda4', diag) + call ice_write(nu_history, nrec, a3Db(:,:,k,n-n3Dzcum,:), atype, diag) enddo ! nzilyr endif @@ -255,7 +262,7 @@ subroutine ice_write_hist(ns) endif endif - call ice_write(nu_history, nrec, a3Da(:,:,k,n-n3Dbcum,:), 'rda4', diag) + call ice_write(nu_history, nrec, a3Da(:,:,k,n-n3Dbcum,:), atype, diag) enddo ! nzilyr endif @@ -279,7 +286,7 @@ subroutine ice_write_hist(ns) endif endif - call ice_write(nu_history, nrec, a3Df(:,:,k,n-n3Dacum,:), 'rda4', diag) + call ice_write(nu_history, nrec, a3Df(:,:,k,n-n3Dacum,:), atype, diag) enddo ! nfsd_hist endif @@ -304,7 +311,7 @@ subroutine ice_write_hist(ns) endif endif - call ice_write(nu_history, nrec, a4Di(:,:,k,nn,n-n3Dfcum,:), 'rda4', diag) + call ice_write(nu_history, nrec, a4Di(:,:,k,nn,n-n3Dfcum,:), atype, diag) enddo ! nzilyr enddo ! ncat_hist @@ -330,7 +337,7 @@ subroutine ice_write_hist(ns) endif endif - call ice_write(nu_history, nrec, a4Ds(:,:,k,nn,n-n4Dicum,:), 'rda4', diag) + call ice_write(nu_history, nrec, a4Ds(:,:,k,nn,n-n4Dicum,:), atype, diag) enddo ! nzilyr enddo ! ncat_hist @@ -356,7 +363,7 @@ subroutine ice_write_hist(ns) endif endif - call ice_write(nu_history, nrec, a4Df(:,:,k,nn,n-n4Dscum,:), 'rda4', diag) + call ice_write(nu_history, nrec, a4Df(:,:,k,nn,n-n4Dscum,:), atype, diag) enddo ! nfsd_hist enddo ! ncat_hist diff --git a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 index ff16c637b..5b6aa0dd8 100644 --- a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 @@ -18,7 +18,7 @@ module ice_history_write - use ice_constants, only: c0, c360, spval + use ice_constants, only: c0, c360, spval, spval_dbl use ice_fileunits, only: nu_diag use ice_exit, only: abort_ice use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted @@ -86,6 +86,8 @@ subroutine ice_write_hist (ns) integer (kind=int_kind) :: ind,boundid + integer (kind=int_kind) :: lprecision + character (char_len) :: start_time,current_date,current_time character (len=8) :: cdate @@ -123,6 +125,9 @@ subroutine ice_write_hist (ns) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) + lprecision = nf90_float + if (history_precision == 8) lprecision = nf90_double + if (my_task == master_task) then ! ltime=time/int(secday) @@ -243,7 +248,7 @@ subroutine ice_write_hist (ns) if (hist_avg) then dimid(1) = boundid dimid(2) = timid - status = nf90_def_var(ncid,'time_bounds',nf90_float,dimid(1:2),varid) + status = nf90_def_var(ncid,'time_bounds',lprecision,dimid(1:2),varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining var time_bounds') status = nf90_put_att(ncid,varid,'long_name', & @@ -344,7 +349,7 @@ subroutine ice_write_hist (ns) dimid(3) = timid do i = 1, ncoord - status = nf90_def_var(ncid, coord_var(i)%short_name, nf90_float, & + status = nf90_def_var(ncid, coord_var(i)%short_name, lprecision, & dimid(1:2), varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining short_name for '//coord_var(i)%short_name) @@ -354,10 +359,18 @@ subroutine ice_write_hist (ns) status = nf90_put_att(ncid, varid, 'units', coord_var(i)%units) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining units for '//coord_var(i)%short_name) - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining missing_value for '//coord_var(i)%short_name) - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining _FillValue for '//coord_var(i)%short_name) if (coord_var(i)%short_name == 'ULAT') then @@ -384,7 +397,7 @@ subroutine ice_write_hist (ns) do i = 1, nvarz if (igrdz(i)) then status = nf90_def_var(ncid, var_nz(i)%short_name, & - nf90_float, dimidex(i), varid) + lprecision, dimidex(i), varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining short_name for '//var_nz(i)%short_name) status = nf90_put_att(ncid,varid,'long_name',var_nz(i)%long_name) @@ -398,7 +411,7 @@ subroutine ice_write_hist (ns) ! Attributes for tmask, blkmask defined separately, since they have no units if (igrd(n_tmask)) then - status = nf90_def_var(ncid, 'tmask', nf90_float, dimid(1:2), varid) + status = nf90_def_var(ncid, 'tmask', lprecision, dimid(1:2), varid) if (status /= nf90_noerr) call abort_ice(subname//'ERROR: defining var tmask') status = nf90_put_att(ncid,varid, 'long_name', 'ocean grid mask') if (status /= nf90_noerr) call abort_ice(subname//'ERROR: tmask long_name') @@ -406,14 +419,22 @@ subroutine ice_write_hist (ns) if (status /= nf90_noerr) call abort_ice(subname//'ERROR: tmask units') status = nf90_put_att(ncid,varid,'comment', '0 = land, 1 = ocean') if (status /= nf90_noerr) call abort_ice(subname//'ERROR: tmask comment') - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname//'ERROR: defining missing_value for tmask') - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname//'ERROR: defining _FillValue for tmask') endif if (igrd(n_blkmask)) then - status = nf90_def_var(ncid, 'blkmask', nf90_float, dimid(1:2), varid) + status = nf90_def_var(ncid, 'blkmask', lprecision, dimid(1:2), varid) if (status /= nf90_noerr) call abort_ice(subname//'ERROR: defining var blkmask') status = nf90_put_att(ncid,varid, 'long_name', 'ice grid block mask') if (status /= nf90_noerr) call abort_ice(subname//'ERROR: blkmask long_name') @@ -421,16 +442,24 @@ subroutine ice_write_hist (ns) if (status /= nf90_noerr) call abort_ice(subname//'ERROR: blkmask units') status = nf90_put_att(ncid,varid,'comment', 'mytask + iblk/100') if (status /= nf90_noerr) call abort_ice(subname//'ERROR: blkmask comment') - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname//'ERROR: defining missing_value for blkmask') - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname//'ERROR: defining _FillValue for blkmask') endif do i = 3, nvar ! note n_tmask=1, n_blkmask=2 if (igrd(i)) then status = nf90_def_var(ncid, var(i)%req%short_name, & - nf90_float, dimid(1:2), varid) + lprecision, dimid(1:2), varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining variable '//var(i)%req%short_name) status = nf90_put_att(ncid,varid, 'long_name', var(i)%req%long_name) @@ -442,10 +471,18 @@ subroutine ice_write_hist (ns) status = nf90_put_att(ncid, varid, 'coordinates', var(i)%coordinates) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining coordinates for '//var(i)%req%short_name) - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining missing_value for '//var(i)%req%short_name) - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining _FillValue for '//var(i)%req%short_name) endif @@ -458,7 +495,7 @@ subroutine ice_write_hist (ns) do i = 1, nvar_verts if (f_bounds) then status = nf90_def_var(ncid, var_nverts(i)%short_name, & - nf90_float,dimid_nverts, varid) + lprecision,dimid_nverts, varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining variable '//var_nverts(i)%short_name) status = nf90_put_att(ncid,varid, 'long_name', var_nverts(i)%long_name) @@ -467,10 +504,18 @@ subroutine ice_write_hist (ns) status = nf90_put_att(ncid, varid, 'units', var_nverts(i)%units) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining units for '//var_nverts(i)%short_name) - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining missing_value for '//var_nverts(i)%short_name) - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining _FillValue for '//var_nverts(i)%short_name) endif @@ -479,7 +524,7 @@ subroutine ice_write_hist (ns) do n=1,num_avail_hist_fields_2D if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - nf90_float, dimid, varid) + lprecision, dimid, varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining variable '//avail_hist_fields(n)%vname) status = nf90_put_att(ncid,varid,'units', & @@ -498,10 +543,18 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) @@ -542,7 +595,7 @@ subroutine ice_write_hist (ns) do n = n2D + 1, n3Dccum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - nf90_float, dimidz, varid) + lprecision, dimidz, varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining variable '//avail_hist_fields(n)%vname) status = nf90_put_att(ncid,varid,'units', & @@ -561,10 +614,18 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) @@ -593,7 +654,7 @@ subroutine ice_write_hist (ns) do n = n3Dccum + 1, n3Dzcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - nf90_float, dimidz, varid) + lprecision, dimidz, varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining variable '//avail_hist_fields(n)%vname) status = nf90_put_att(ncid,varid,'units', & @@ -612,10 +673,18 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) @@ -630,7 +699,7 @@ subroutine ice_write_hist (ns) do n = n3Dzcum + 1, n3Dbcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - nf90_float, dimidz, varid) + lprecision, dimidz, varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining variable '//avail_hist_fields(n)%vname) status = nf90_put_att(ncid,varid,'units', & @@ -649,10 +718,18 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) @@ -667,7 +744,7 @@ subroutine ice_write_hist (ns) do n = n3Dbcum + 1, n3Dacum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - nf90_float, dimidz, varid) + lprecision, dimidz, varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining variable '//avail_hist_fields(n)%vname) status = nf90_put_att(ncid,varid,'units', & @@ -686,10 +763,18 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) @@ -704,7 +789,7 @@ subroutine ice_write_hist (ns) do n = n3Dacum + 1, n3Dfcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - nf90_float, dimidz, varid) + lprecision, dimidz, varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining variable '//avail_hist_fields(n)%vname) status = nf90_put_att(ncid,varid,'units', & @@ -723,10 +808,18 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) @@ -742,8 +835,8 @@ subroutine ice_write_hist (ns) do n = n3Dfcum + 1, n4Dicum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & -! nf90_float, dimidcz, varid) - nf90_float, dimidcz(1:4), varid) ! ferret +! lprecision, dimidcz, varid) + lprecision, dimidcz(1:4), varid) ! ferret if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining variable '//avail_hist_fields(n)%vname) status = nf90_put_att(ncid,varid,'units', & @@ -762,10 +855,18 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) @@ -795,8 +896,8 @@ subroutine ice_write_hist (ns) do n = n4Dicum + 1, n4Dscum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & -! nf90_float, dimidcz, varid) - nf90_float, dimidcz(1:4), varid) ! ferret +! lprecision, dimidcz, varid) + lprecision, dimidcz(1:4), varid) ! ferret if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining variable '//avail_hist_fields(n)%vname) status = nf90_put_att(ncid,varid,'units', & @@ -815,10 +916,18 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) @@ -848,8 +957,8 @@ subroutine ice_write_hist (ns) do n = n4Dscum + 1, n4Dfcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & -! nf90_float, dimidcz, varid) - nf90_float, dimidcz(1:4), varid) ! ferret +! lprecision, dimidcz, varid) + lprecision, dimidcz(1:4), varid) ! ferret if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining variable '//avail_hist_fields(n)%vname) status = nf90_put_att(ncid,varid,'units', & @@ -868,10 +977,18 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'missing_value',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'missing_value',spval) + else + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - status = nf90_put_att(ncid,varid,'_FillValue',spval) + if (lprecision == nf90_float) then + status = nf90_put_att(ncid,varid,'_FillValue',spval) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + endif if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) diff --git a/cicecore/cicedynB/infrastructure/io/io_pio/ice_history_write.F90 b/cicecore/cicedynB/infrastructure/io/io_pio/ice_history_write.F90 index 23baeb40a..9c20daf20 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio/ice_history_write.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio/ice_history_write.F90 @@ -137,6 +137,8 @@ subroutine ice_write_hist (ns) real (kind=dbl_kind) :: secday real (kind=dbl_kind) :: rad_to_deg + integer (kind=int_kind) :: lprecision + character(len=*), parameter :: subname = '(ice_write_hist)' call icepack_query_parameters(secday_out=secday) @@ -178,6 +180,10 @@ subroutine ice_write_hist (ns) ltime2 = time/int(secday) ltime = real(time/int(secday),kind=real_kind) + ! option of turning on double precision history files + lprecision = pio_real + if (history_precision == 8) lprecision = pio_double + !----------------------------------------------------------------- ! define dimensions !----------------------------------------------------------------- @@ -332,12 +338,17 @@ subroutine ice_write_hist (ns) dimid2(2) = jmtid do i = 1, ncoord - status = pio_def_var(File, trim(coord_var(i)%short_name), pio_real, & + status = pio_def_var(File, trim(coord_var(i)%short_name), lprecision, & dimid2, varid) status = pio_put_att(File,varid,'long_name',trim(coord_var(i)%long_name)) status = pio_put_att(File, varid, 'units', trim(coord_var(i)%units)) - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif if (coord_var(i)%short_name == 'ULAT') then status = pio_put_att(File,varid,'comment', & trim('Latitude of NE corner of T grid cell')) @@ -357,7 +368,7 @@ subroutine ice_write_hist (ns) do i = 1, nvarz if (igrdz(i)) then - status = pio_def_var(File, trim(var_nz(i)%short_name), pio_real, & + status = pio_def_var(File, trim(var_nz(i)%short_name), lprecision, & (/dimidex(i)/), varid) status = pio_put_att(File, varid, 'long_name', var_nz(i)%long_name) status = pio_put_att(File, varid, 'units' , var_nz(i)%units) @@ -366,31 +377,46 @@ subroutine ice_write_hist (ns) ! Attributes for tmask defined separately, since it has no units if (igrd(n_tmask)) then - status = pio_def_var(File, 'tmask', pio_real, dimid2, varid) + status = pio_def_var(File, 'tmask', lprecision, dimid2, varid) status = pio_put_att(File,varid, 'long_name', 'ocean grid mask') status = pio_put_att(File, varid, 'coordinates', 'TLON TLAT') - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif status = pio_put_att(File,varid,'comment', '0 = land, 1 = ocean') endif if (igrd(n_blkmask)) then - status = pio_def_var(File, 'blkmask', pio_real, dimid2, varid) + status = pio_def_var(File, 'blkmask', lprecision, dimid2, varid) status = pio_put_att(File,varid, 'long_name', 'ice grid block mask') status = pio_put_att(File, varid, 'coordinates', 'TLON TLAT') status = pio_put_att(File,varid,'comment', 'mytask + iblk/100') - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif endif do i = 3, nvar ! note: n_tmask=1, n_blkmask=2 if (igrd(i)) then status = pio_def_var(File, trim(var(i)%req%short_name), & - pio_real, dimid2, varid) + lprecision, dimid2, varid) status = pio_put_att(File,varid, 'long_name', trim(var(i)%req%long_name)) status = pio_put_att(File, varid, 'units', trim(var(i)%req%units)) status = pio_put_att(File, varid, 'coordinates', trim(var(i)%coordinates)) - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif endif enddo @@ -401,13 +427,18 @@ subroutine ice_write_hist (ns) do i = 1, nvar_verts if (f_bounds) then status = pio_def_var(File, trim(var_nverts(i)%short_name), & - pio_real,dimid_nverts, varid) + lprecision,dimid_nverts, varid) status = & pio_put_att(File,varid, 'long_name', trim(var_nverts(i)%long_name)) status = & pio_put_att(File, varid, 'units', trim(var_nverts(i)%units)) - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif endif enddo @@ -426,7 +457,7 @@ subroutine ice_write_hist (ns) do n=1,num_avail_hist_fields_2D if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimid3, varid) + lprecision, dimid3, varid) status = pio_put_att(File,varid,'units', & trim(avail_hist_fields(n)%vunit)) status = pio_put_att(File,varid, 'long_name', & @@ -435,8 +466,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -475,7 +511,7 @@ subroutine ice_write_hist (ns) do n = n2D + 1, n3Dccum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidz, varid) + lprecision, dimidz, varid) status = pio_put_att(File,varid,'units', & trim(avail_hist_fields(n)%vunit)) status = pio_put_att(File,varid, 'long_name', & @@ -484,8 +520,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -512,7 +553,7 @@ subroutine ice_write_hist (ns) do n = n3Dccum + 1, n3Dzcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidz, varid) + lprecision, dimidz, varid) status = pio_put_att(File,varid,'units', & trim(avail_hist_fields(n)%vunit)) status = pio_put_att(File,varid, 'long_name', & @@ -521,8 +562,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -549,7 +595,7 @@ subroutine ice_write_hist (ns) do n = n3Dzcum + 1, n3Dbcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidz, varid) + lprecision, dimidz, varid) status = pio_put_att(File,varid,'units', & trim(avail_hist_fields(n)%vunit)) status = pio_put_att(File,varid, 'long_name', & @@ -558,8 +604,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -586,7 +637,7 @@ subroutine ice_write_hist (ns) do n = n3Dbcum + 1, n3Dacum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidz, varid) + lprecision, dimidz, varid) status = pio_put_att(File,varid,'units', & trim(avail_hist_fields(n)%vunit)) status = pio_put_att(File,varid, 'long_name', & @@ -595,8 +646,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -632,8 +688,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -666,7 +727,7 @@ subroutine ice_write_hist (ns) do n = n3Dfcum + 1, n4Dicum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidcz, varid) + lprecision, dimidcz, varid) status = pio_put_att(File,varid,'units', & trim(avail_hist_fields(n)%vunit)) status = pio_put_att(File,varid, 'long_name', & @@ -675,8 +736,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -704,7 +770,7 @@ subroutine ice_write_hist (ns) do n = n4Dicum + 1, n4Dscum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidcz, varid) + lprecision, dimidcz, varid) status = pio_put_att(File,varid,'units', & trim(avail_hist_fields(n)%vunit)) status = pio_put_att(File,varid, 'long_name', & @@ -713,8 +779,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -752,8 +823,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -1061,7 +1137,6 @@ subroutine ice_write_hist (ns) enddo enddo call pio_setframe(varid, int(1,kind=PIO_OFFSET)) -! call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) call pio_write_darray(File, varid, iodesc3da,& workr3, status, fillval=spval_dbl) endif @@ -1082,7 +1157,6 @@ subroutine ice_write_hist (ns) enddo enddo call pio_setframe(varid, int(1,kind=PIO_OFFSET)) -! call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) call pio_write_darray(File, varid, iodesc3df,& workr3, status, fillval=spval_dbl) endif @@ -1127,7 +1201,6 @@ subroutine ice_write_hist (ns) enddo ! i enddo ! j call pio_setframe(varid, int(1,kind=PIO_OFFSET)) -! call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) call pio_write_darray(File, varid, iodesc4ds,& workr4, status, fillval=spval_dbl) endif @@ -1150,7 +1223,6 @@ subroutine ice_write_hist (ns) enddo ! i enddo ! j call pio_setframe(varid, int(1,kind=PIO_OFFSET)) -! call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) call pio_write_darray(File, varid, iodesc4df,& workr4, status, fillval=spval_dbl) endif diff --git a/cicecore/cicedynB/infrastructure/io/io_pio/ice_pio.F90 b/cicecore/cicedynB/infrastructure/io/io_pio/ice_pio.F90 index 5fff64944..d6aa65ae1 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio/ice_pio.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio/ice_pio.F90 @@ -6,7 +6,6 @@ module ice_pio use shr_kind_mod, only: r8 => shr_kind_r8, in=>shr_kind_in use shr_kind_mod, only: cl => shr_kind_cl - use shr_sys_mod , only: shr_sys_flush use ice_kinds_mod use ice_blocks use ice_broadcast diff --git a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 index 229aa9e51..209aa47b7 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 @@ -137,6 +137,8 @@ subroutine ice_write_hist (ns) real (kind=dbl_kind) :: secday real (kind=dbl_kind) :: rad_to_deg + integer (kind=int_kind) :: lprecision + character(len=*), parameter :: subname = '(ice_write_hist)' call icepack_query_parameters(secday_out=secday) @@ -178,6 +180,10 @@ subroutine ice_write_hist (ns) ltime2 = time/int(secday) ltime = real(time/int(secday),kind=real_kind) + ! option of turning on double precision history files + lprecision = pio_real + if (history_precision == 8) lprecision = pio_double + !----------------------------------------------------------------- ! define dimensions !----------------------------------------------------------------- @@ -332,12 +338,17 @@ subroutine ice_write_hist (ns) dimid2(2) = jmtid do i = 1, ncoord - status = pio_def_var(File, trim(coord_var(i)%short_name), pio_real, & + status = pio_def_var(File, trim(coord_var(i)%short_name), lprecision, & dimid2, varid) status = pio_put_att(File,varid,'long_name',trim(coord_var(i)%long_name)) status = pio_put_att(File, varid, 'units', trim(coord_var(i)%units)) - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif if (coord_var(i)%short_name == 'ULAT') then status = pio_put_att(File,varid,'comment', & trim('Latitude of NE corner of T grid cell')) @@ -357,7 +368,7 @@ subroutine ice_write_hist (ns) do i = 1, nvarz if (igrdz(i)) then - status = pio_def_var(File, trim(var_nz(i)%short_name), pio_real, & + status = pio_def_var(File, trim(var_nz(i)%short_name), lprecision, & (/dimidex(i)/), varid) status = pio_put_att(File, varid, 'long_name', var_nz(i)%long_name) status = pio_put_att(File, varid, 'units' , var_nz(i)%units) @@ -366,31 +377,46 @@ subroutine ice_write_hist (ns) ! Attributes for tmask defined separately, since it has no units if (igrd(n_tmask)) then - status = pio_def_var(File, 'tmask', pio_real, dimid2, varid) + status = pio_def_var(File, 'tmask', lprecision, dimid2, varid) status = pio_put_att(File,varid, 'long_name', 'ocean grid mask') status = pio_put_att(File, varid, 'coordinates', 'TLON TLAT') - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif status = pio_put_att(File,varid,'comment', '0 = land, 1 = ocean') endif if (igrd(n_blkmask)) then - status = pio_def_var(File, 'blkmask', pio_real, dimid2, varid) + status = pio_def_var(File, 'blkmask', lprecision, dimid2, varid) status = pio_put_att(File,varid, 'long_name', 'ice grid block mask') status = pio_put_att(File, varid, 'coordinates', 'TLON TLAT') status = pio_put_att(File,varid,'comment', 'mytask + iblk/100') - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif endif do i = 3, nvar ! note: n_tmask=1, n_blkmask=2 if (igrd(i)) then status = pio_def_var(File, trim(var(i)%req%short_name), & - pio_real, dimid2, varid) + lprecision, dimid2, varid) status = pio_put_att(File,varid, 'long_name', trim(var(i)%req%long_name)) status = pio_put_att(File, varid, 'units', trim(var(i)%req%units)) status = pio_put_att(File, varid, 'coordinates', trim(var(i)%coordinates)) - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif endif enddo @@ -401,13 +427,18 @@ subroutine ice_write_hist (ns) do i = 1, nvar_verts if (f_bounds) then status = pio_def_var(File, trim(var_nverts(i)%short_name), & - pio_real,dimid_nverts, varid) + lprecision,dimid_nverts, varid) status = & pio_put_att(File,varid, 'long_name', trim(var_nverts(i)%long_name)) status = & pio_put_att(File, varid, 'units', trim(var_nverts(i)%units)) - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif endif enddo @@ -426,7 +457,7 @@ subroutine ice_write_hist (ns) do n=1,num_avail_hist_fields_2D if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimid3, varid) + lprecision, dimid3, varid) status = pio_put_att(File,varid,'units', & trim(avail_hist_fields(n)%vunit)) status = pio_put_att(File,varid, 'long_name', & @@ -435,8 +466,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -475,7 +511,7 @@ subroutine ice_write_hist (ns) do n = n2D + 1, n3Dccum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidz, varid) + lprecision, dimidz, varid) status = pio_put_att(File,varid,'units', & trim(avail_hist_fields(n)%vunit)) status = pio_put_att(File,varid, 'long_name', & @@ -484,8 +520,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -512,7 +553,7 @@ subroutine ice_write_hist (ns) do n = n3Dccum + 1, n3Dzcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidz, varid) + lprecision, dimidz, varid) status = pio_put_att(File,varid,'units', & trim(avail_hist_fields(n)%vunit)) status = pio_put_att(File,varid, 'long_name', & @@ -521,8 +562,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -549,7 +595,7 @@ subroutine ice_write_hist (ns) do n = n3Dzcum + 1, n3Dbcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidz, varid) + lprecision, dimidz, varid) status = pio_put_att(File,varid,'units', & trim(avail_hist_fields(n)%vunit)) status = pio_put_att(File,varid, 'long_name', & @@ -558,8 +604,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -586,7 +637,7 @@ subroutine ice_write_hist (ns) do n = n3Dbcum + 1, n3Dacum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidz, varid) + lprecision, dimidz, varid) status = pio_put_att(File,varid,'units', & trim(avail_hist_fields(n)%vunit)) status = pio_put_att(File,varid, 'long_name', & @@ -595,8 +646,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -632,8 +688,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -666,7 +727,7 @@ subroutine ice_write_hist (ns) do n = n3Dfcum + 1, n4Dicum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidcz, varid) + lprecision, dimidcz, varid) status = pio_put_att(File,varid,'units', & trim(avail_hist_fields(n)%vunit)) status = pio_put_att(File,varid, 'long_name', & @@ -675,8 +736,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -704,7 +770,7 @@ subroutine ice_write_hist (ns) do n = n4Dicum + 1, n4Dscum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - pio_real, dimidcz, varid) + lprecision, dimidcz, varid) status = pio_put_att(File,varid,'units', & trim(avail_hist_fields(n)%vunit)) status = pio_put_att(File,varid, 'long_name', & @@ -713,8 +779,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then @@ -752,8 +823,13 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - status = pio_put_att(File,varid,'missing_value',spval) - status = pio_put_att(File,varid,'_FillValue',spval) + if (lprecision == pio_real) then + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + else + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + endif ! Add cell_methods attribute to variables if averaged if (hist_avg .and. histfreq(ns) /= '1') then diff --git a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_pio.F90 b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_pio.F90 index 5fff64944..564c9cd3b 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_pio.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_pio.F90 @@ -4,9 +4,6 @@ module ice_pio - use shr_kind_mod, only: r8 => shr_kind_r8, in=>shr_kind_in - use shr_kind_mod, only: cl => shr_kind_cl - use shr_sys_mod , only: shr_sys_flush use ice_kinds_mod use ice_blocks use ice_broadcast diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index dcfedf772..bba1309b5 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -37,6 +37,7 @@ hist_avg = .true. history_dir = './history/' history_file = 'iceh' + history_precision = 4 write_ic = .true. incond_dir = './history/' incond_file = 'iceh_ic' diff --git a/configuration/scripts/options/set_nml.precision8 b/configuration/scripts/options/set_nml.precision8 new file mode 100644 index 000000000..5243ef8df --- /dev/null +++ b/configuration/scripts/options/set_nml.precision8 @@ -0,0 +1 @@ +history_precision = 8 diff --git a/configuration/scripts/tests/base_suite.ts b/configuration/scripts/tests/base_suite.ts index fad8b22f3..f2ac2b69b 100755 --- a/configuration/scripts/tests/base_suite.ts +++ b/configuration/scripts/tests/base_suite.ts @@ -12,6 +12,7 @@ restart gx1 40x4 droundrobin,medium restart tx1 40x4 dsectrobin,medium restart gx3 4x4 none restart gx3 4x4 iobinary +restart gx3 4x4 precision8 restart gx3 6x2 alt01 restart gx3 8x2 alt02 restart gx3 4x2 alt03 diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index 3f0aa482a..5111df406 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -274,6 +274,7 @@ either Celsius or Kelvin units). "histfreq_n", ":math:`\bullet` integer output frequency in histfreq units", "" "history_dir", ":math:`\bullet` path to history output files", "" "history_file", ":math:`\bullet` history output file prefix", "" + "history_precision", ":math:`\bullet` history output precision: 4 or 8 byte", "4" "hm", "land/boundary mask, thickness (T-cell)", "" "hmix", "ocean mixed layer depth", "20. m" "hour", "hour of the year", "" diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 033d4e8c2..4e185d151 100755 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -140,6 +140,7 @@ Table of namelist options "","", "false", "write snapshots of data", "" "","``history_dir``", "path/", "path to history output directory", "" "","``history_file``", "filename prefix", "output file for history", "‘iceh’" + "","``history_precision``", "integer", "history file precision: 4 or 8 byte", "4" "","``write_ic``", "true/false", "write initial condition", "" "","``incond_dir``", "path/", "path to initial condition directory", "" "","``incond_file``", "filename prefix", "output file for initial condition", "‘iceh’" diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index bba0b5f46..b144b32f2 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -807,6 +807,9 @@ Additionally, a new history output variable, ``f_CMIP``, has been added. When `` is added to the **icefields\_nml** section of **ice\_in** then all SIMIP variables will be turned on for output at the frequency specified by ``f_CMIP``. +It may also be helpful for debugging to increase the precision of the history file +output from 4 bytes to 8 bytes. This is changed through the ``history_precision`` +namelist flag. **************** Diagnostic files