diff --git a/.github/workflows/test-cice.yml b/.github/workflows/test-cice.yml index 1fdd8188d..32e784564 100644 --- a/.github/workflows/test-cice.yml +++ b/.github/workflows/test-cice.yml @@ -17,7 +17,7 @@ on: defaults: run: - shell: /bin/csh {0} + shell: /bin/csh -e {0} jobs: build: @@ -104,9 +104,9 @@ jobs: - name: download input data run: | cd $HOME/cice-dirs/input - wget https://zenodo.org/record/3728358/files/CICE_data_gx3_grid_ic-20200320.tar.gz && tar xvfz CICE_data_gx3_grid_ic-20200320.tar.gz - wget https://zenodo.org/record/3728362/files/CICE_data_gx3_forcing_NCAR_bulk-20200320.tar.gz && tar xvfz CICE_data_gx3_forcing_NCAR_bulk-20200320.tar.gz - wget https://zenodo.org/record/3728364/files/CICE_data_gx3_forcing_JRA55-20200320.tar.gz && tar xvfz CICE_data_gx3_forcing_JRA55-20200320.tar.gz + wget --progress=dot:giga https://zenodo.org/record/3728358/files/CICE_data_gx3_grid_ic-20200320.tar.gz && tar xvfz CICE_data_gx3_grid_ic-20200320.tar.gz + wget --progress=dot:giga https://zenodo.org/record/3728362/files/CICE_data_gx3_forcing_NCAR_bulk-20200320.tar.gz && tar xvfz CICE_data_gx3_forcing_NCAR_bulk-20200320.tar.gz + wget --progress=dot:giga https://zenodo.org/record/3728364/files/CICE_data_gx3_forcing_JRA55-20200320.tar.gz && tar xvfz CICE_data_gx3_forcing_JRA55-20200320.tar.gz pwd ls -alR # - name: run case diff --git a/cice.setup b/cice.setup index 3efe94827..8dc46005a 100755 --- a/cice.setup +++ b/cice.setup @@ -390,6 +390,18 @@ if ((${dosuite} == 1 || ${dotest} == 1) && ${testid} == ${spval}) then exit -1 endif +# This creates a new sandbox and modifies the source code for "improved" lcov analysis +# Turn this if block off if you don't want coverage to do that +if ($coverage == 1) then + set sandbox_lcov = ${ICE_SANDBOX}/../cice_lcov_${sdate}-${stime} + cp -p -r ${ICE_SANDBOX} ${sandbox_lcov} + echo "shifting to sandbox = ${sandbox_lcov}" + set ICE_SANDBOX = ${sandbox_lcov} + set ICE_SCRIPTS = "${ICE_SANDBOX}/configuration/scripts" + cd ${ICE_SANDBOX} + ${ICE_SCRIPTS}/tests/lcov_modify_source.sh +endif + #--------------------------------------------------------------------- # Setup tsfile and test suite support stuff @@ -1094,7 +1106,7 @@ cd ${testname_base} source ./cice.settings if (\${dobuild} == true) then if (\${doreuse} == true) then - set ciceexe = "../ciceexe.\${ICE_ENVNAME}.\${ICE_COMMDIR}.\${ICE_BLDDEBUG}.\${ICE_THREADED}.\${ICE_IOTYPE}" + set ciceexe = "../ciceexe.\${ICE_TARGET}.\${ICE_ENVNAME}.\${ICE_COMMDIR}.\${ICE_BLDDEBUG}.\${ICE_THREADED}.\${ICE_IOTYPE}" ./cice.build --exe \${ciceexe} if !(-e \${ciceexe}) cp -p \${ICE_RUNDIR}/cice \${ciceexe} else diff --git a/cicecore/cicedynB/analysis/ice_diagnostics.F90 b/cicecore/cicedynB/analysis/ice_diagnostics.F90 index cff544cd4..3eaf9d057 100644 --- a/cicecore/cicedynB/analysis/ice_diagnostics.F90 +++ b/cicecore/cicedynB/analysis/ice_diagnostics.F90 @@ -25,9 +25,8 @@ module ice_diagnostics implicit none private - public :: runtime_diags, init_mass_diags, init_diags, & - print_state, print_points_state, diagnostic_abort - + public :: runtime_diags, init_mass_diags, init_diags, debug_ice, & + print_state, diagnostic_abort ! diagnostic output file character (len=char_len), public :: diag_file @@ -35,9 +34,13 @@ module ice_diagnostics ! point print data logical (kind=log_kind), public :: & + debug_model , & ! if true, debug model at high level print_points , & ! if true, print point data print_global ! if true, print global data + integer (kind=int_kind), public :: & + debug_model_step = 999999999 ! begin printing at istep1=debug_model_step + integer (kind=int_kind), parameter, public :: & npnt = 2 ! total number of points to be printed @@ -87,16 +90,6 @@ module ice_diagnostics totaeron , & ! total aerosol mass totaeros ! total aerosol mass - ! printing info for routine print_state - ! iblkp, ip, jp, mtask identify the grid cell to print -! character (char_len) :: plabel - integer (kind=int_kind), parameter, public :: & - check_step = 999999999, & ! begin printing at istep1=check_step - iblkp = 1, & ! block number - ip = 72, & ! i index - jp = 11, & ! j index - mtask = 0 ! my_task - !======================================================================= contains @@ -1525,20 +1518,39 @@ end subroutine init_diags !======================================================================= -! This routine is useful for debugging. -! Calls to it should be inserted in the form (after thermo, for example) -! do iblk = 1, nblocks -! do j=jlo,jhi -! do i=ilo,ihi -! plabel = 'post thermo' -! if (istep1 >= check_step .and. iblk==iblkp .and i==ip & -! .and. j==jp .and. my_task == mtask) & -! call print_state(plabel,i,j,iblk) -! enddo -! enddo +! This routine is useful for debugging +! author Elizabeth C. Hunke, LANL + + subroutine debug_ice(iblk, plabeld) + + use ice_kinds_mod + use ice_calendar, only: istep1 + use ice_communicate, only: my_task + use ice_blocks, only: nx_block, ny_block + + character (char_len), intent(in) :: plabeld + integer (kind=int_kind), intent(in) :: iblk + + ! local + integer (kind=int_kind) :: i, j, m + character(len=*), parameter :: subname='(debug_ice)' + +! tcraig, do this only on one point, the first point +! do m = 1, npnt + m = 1 + if (istep1 >= debug_model_step .and. & + iblk == pbloc(m) .and. my_task == pmloc(m)) then + i = piloc(m) + j = pjloc(m) + call print_state(plabeld,i,j,iblk) + endif ! enddo -! -! 'use ice_diagnostics' may need to be inserted also + + end subroutine debug_ice + +!======================================================================= + +! This routine is useful for debugging. ! author: Elizabeth C. Hunke, LANL subroutine print_state(plabel,i,j,iblk) @@ -1587,7 +1599,7 @@ subroutine print_state(plabel,i,j,iblk) this_block = get_block(blocks_ice(iblk),iblk) - write(nu_diag,*) plabel + write(nu_diag,*) subname,plabel write(nu_diag,*) 'istep1, my_task, i, j, iblk:', & istep1, my_task, i, j, iblk write(nu_diag,*) 'Global i and j:', & @@ -1699,16 +1711,14 @@ subroutine print_state(plabel,i,j,iblk) write(nu_diag,*) ' evap = ',evap (i,j,iblk) write(nu_diag,*) ' flwout = ',flwout(i,j,iblk) write(nu_diag,*) ' ' + call flush_fileunit(nu_diag) end subroutine print_state !======================================================================= +#ifdef UNDEPRECATE_print_points_state ! This routine is useful for debugging. -! Calls can be inserted anywhere and it will print info on print_points points -! call print_points_state(plabel) -! -! 'use ice_diagnostics' may need to be inserted also subroutine print_points_state(plabel,ilabel) @@ -1764,6 +1774,7 @@ subroutine print_points_state(plabel,ilabel) write(llabel,'(a)') 'pps:'//trim(llabel) endif + write(nu_diag,*) subname write(nu_diag,*) trim(llabel),'istep1, my_task, i, j, iblk=', & istep1, my_task, i, j, iblk write(nu_diag,*) trim(llabel),'Global i and j=', & @@ -1842,12 +1853,13 @@ subroutine print_points_state(plabel,ilabel) write(nu_diag,*) ' evap = ',evap (i,j,iblk) write(nu_diag,*) ' flwout = ',flwout(i,j,iblk) write(nu_diag,*) ' ' + call flush_fileunit(nu_diag) endif ! my_task enddo ! ncnt end subroutine print_points_state - +#endif !======================================================================= ! prints error information prior to aborting diff --git a/cicecore/cicedynB/analysis/ice_history.F90 b/cicecore/cicedynB/analysis/ice_history.F90 index 1aa2515a4..f91562449 100644 --- a/cicecore/cicedynB/analysis/ice_history.F90 +++ b/cicecore/cicedynB/analysis/ice_history.F90 @@ -1713,7 +1713,7 @@ subroutine accum_hist (dt) use ice_domain_size, only: nfsd use ice_grid, only: tmask, lmask_n, lmask_s, dxu, dyu use ice_calendar, only: new_year, write_history, & - write_ic, time, histfreq, nstreams, month, & + write_ic, timesecs, histfreq, nstreams, mmonth, & new_month use ice_dyn_eap, only: a11, a12, e11, e12, e22, s11, s12, s22, & yieldstress11, yieldstress12, yieldstress22 @@ -1864,7 +1864,7 @@ subroutine accum_hist (dt) avgct(ns) = avgct(ns) + c1 ! if (avgct(ns) == c1) time_beg(ns) = (time-dt)/int(secday) if (avgct(ns) == c1) then - time_beg(ns) = (time-dt)/int(secday) + time_beg(ns) = (timesecs-dt)/int(secday) time_beg(ns) = real(time_beg(ns),kind=real_kind) endif endif @@ -3966,7 +3966,7 @@ subroutine accum_hist (dt) enddo ! iblk !$OMP END PARALLEL DO - time_end(ns) = time/int(secday) + time_end(ns) = timesecs/int(secday) time_end(ns) = real(time_end(ns),kind=real_kind) !--------------------------------------------------------------- @@ -4057,7 +4057,7 @@ subroutine accum_hist (dt) enddo endif ! new_year - if ( (month .eq. 7) .and. new_month ) then + if ( (mmonth .eq. 7) .and. new_month ) then do j=jlo,jhi do i=ilo,ihi ! reset SH Jul 1 diff --git a/cicecore/cicedynB/analysis/ice_history_shared.F90 b/cicecore/cicedynB/analysis/ice_history_shared.F90 index ce177ad1e..52d268990 100644 --- a/cicecore/cicedynB/analysis/ice_history_shared.F90 +++ b/cicecore/cicedynB/analysis/ice_history_shared.F90 @@ -653,9 +653,9 @@ module ice_history_shared subroutine construct_filename(ncfile,suffix,ns) - use ice_calendar, only: sec, nyr, month, daymo, & + use ice_calendar, only: msec, myear, mmonth, daymo, & mday, write_ic, histfreq, histfreq_n, & - year_init, new_year, new_month, new_day, & + new_year, new_month, new_day, & dt use ice_restart_shared, only: lenstr @@ -667,12 +667,12 @@ subroutine construct_filename(ncfile,suffix,ns) character (len=1) :: cstream character(len=*), parameter :: subname = '(construct_filename)' - iyear = nyr + year_init - 1 ! set year_init=1 in ice_in to get iyear=nyr - imonth = month + iyear = myear + imonth = mmonth iday = mday - isec = sec - dt + isec = msec - dt - if (write_ic) isec = sec + if (write_ic) isec = msec ! construct filename if (write_ic) then write(ncfile,'(a,a,i4.4,a,i2.2,a,i2.2,a,i5.5,a,a)') & @@ -688,7 +688,7 @@ subroutine construct_filename(ncfile,suffix,ns) imonth = 12 iday = daymo(imonth) elseif (new_month) then - imonth = month - 1 + imonth = mmonth - 1 iday = daymo(imonth) elseif (new_day) then iday = iday - 1 @@ -703,7 +703,7 @@ subroutine construct_filename(ncfile,suffix,ns) if (histfreq(ns) == '1') then ! instantaneous, write every dt write(ncfile,'(a,a,i4.4,a,i2.2,a,i2.2,a,i5.5,a,a)') & history_file(1:lenstr(history_file))//trim(cstream),'_inst.', & - iyear,'-',imonth,'-',iday,'-',sec,'.',suffix + iyear,'-',imonth,'-',iday,'-',msec,'.',suffix elseif (hist_avg) then ! write averaged data @@ -714,7 +714,7 @@ subroutine construct_filename(ncfile,suffix,ns) elseif (histfreq(ns) == 'h'.or.histfreq(ns) == 'H') then ! hourly write(ncfile,'(a,a,i2.2,a,i4.4,a,i2.2,a,i2.2,a,i5.5,a,a)') & history_file(1:lenstr(history_file))//trim(cstream),'_', & - histfreq_n(ns),'h.',iyear,'-',imonth,'-',iday,'-',sec,'.',suffix + histfreq_n(ns),'h.',iyear,'-',imonth,'-',iday,'-',msec,'.',suffix elseif (histfreq(ns) == 'm'.or.histfreq(ns) == 'M') then ! monthly write(ncfile,'(a,a,i4.4,a,i2.2,a,a)') & history_file(1:lenstr(history_file))//trim(cstream),'.', & @@ -728,7 +728,7 @@ subroutine construct_filename(ncfile,suffix,ns) else ! instantaneous with histfreq > dt write(ncfile,'(a,a,i4.4,a,i2.2,a,i2.2,a,i5.5,a,a)') & history_file(1:lenstr(history_file)),'_inst.', & - iyear,'-',imonth,'-',iday,'-',sec,'.',suffix + iyear,'-',imonth,'-',iday,'-',msec,'.',suffix endif endif diff --git a/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 b/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 index d8ce42681..2206e0de7 100644 --- a/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 +++ b/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 @@ -361,8 +361,7 @@ subroutine evp (dt) first_time = .false. endif if (trim(grid_type) == 'tripole') then - call abort_ice(trim(subname)//' & - & Kernel not tested on tripole grid. Set kevp_kernel=0') + call abort_ice(trim(subname)//' Kernel not tested on tripole grid. Set kevp_kernel=0') endif call ice_dyn_evp_1d_copyin( & nx_block,ny_block,nblocks,nx_global+2*nghost,ny_global+2*nghost, & diff --git a/cicecore/cicedynB/dynamics/ice_transport_driver.F90 b/cicecore/cicedynB/dynamics/ice_transport_driver.F90 index c500e1631..e3da6390b 100644 --- a/cicecore/cicedynB/dynamics/ice_transport_driver.F90 +++ b/cicecore/cicedynB/dynamics/ice_transport_driver.F90 @@ -272,7 +272,7 @@ subroutine transport_remap (dt) trmask ! = 1. if tracer is present, = 0. otherwise logical (kind=log_kind) :: & - l_stop ! if true, abort the model + ckflag ! if true, abort the model integer (kind=int_kind) :: & istop, jstop ! indices of grid cell where model aborts @@ -327,7 +327,7 @@ subroutine transport_remap (dt) !---! Initialize, update ghost cells, fill tracer arrays. !---!------------------------------------------------------------------- - l_stop = .false. + ckflag = .false. istop = 0 jstop = 0 @@ -605,10 +605,10 @@ subroutine transport_remap (dt) if (my_task == master_task) then fieldid = subname//':000' - call global_conservation (l_stop, fieldid, & + call global_conservation (ckflag, fieldid, & asum_init(0), asum_final(0)) - if (l_stop) then + if (ckflag) then write (nu_diag,*) 'istep1, my_task =', & istep1, my_task write (nu_diag,*) 'transport: conservation error, cat 0' @@ -618,11 +618,11 @@ subroutine transport_remap (dt) do n = 1, ncat write(fieldid,'(a,i3.3)') subname,n call global_conservation & - (l_stop, fieldid, & + (ckflag, fieldid, & asum_init(n), asum_final(n), & atsum_init(:,n), atsum_final(:,n)) - if (l_stop) then + if (ckflag) then write (nu_diag,*) 'istep1, my_task, cat =', & istep1, my_task, n write (nu_diag,*) 'transport: conservation error, cat ',n @@ -639,7 +639,7 @@ subroutine transport_remap (dt) !------------------------------------------------------------------- if (l_monotonicity_check) then - !$OMP PARALLEL DO PRIVATE(iblk,ilo,ihi,jlo,jhi,this_block,n,l_stop,istop,jstop) + !$OMP PARALLEL DO PRIVATE(iblk,ilo,ihi,jlo,jhi,this_block,n,ckflag,istop,jstop) do iblk = 1, nblocks this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo @@ -647,7 +647,7 @@ subroutine transport_remap (dt) jlo = this_block%jlo jhi = this_block%jhi - l_stop = .false. + ckflag = .false. istop = 0 jstop = 0 @@ -657,10 +657,10 @@ subroutine transport_remap (dt) ilo, ihi, jlo, jhi, & tmin(:,:,:,n,iblk), tmax(:,:,:,n,iblk), & aim (:,:, n,iblk), trm (:,:,:,n,iblk), & - l_stop, & + ckflag, & istop, jstop) - if (l_stop) then + if (ckflag) then write (nu_diag,*) 'istep1, my_task, iblk, cat =', & istep1, my_task, iblk, n call abort_ice(subname//'ERROR: monotonicity error') @@ -1083,7 +1083,7 @@ end subroutine tracers_to_state ! ! author William H. Lipscomb, LANL - subroutine global_conservation (l_stop, fieldid, & + subroutine global_conservation (ckflag, fieldid, & asum_init, asum_final, & atsum_init, atsum_final) @@ -1099,7 +1099,7 @@ subroutine global_conservation (l_stop, fieldid, & atsum_final ! final global ice area*tracer logical (kind=log_kind), intent(inout) :: & - l_stop ! if true, abort on return + ckflag ! if true, abort on return ! local variables @@ -1120,7 +1120,7 @@ subroutine global_conservation (l_stop, fieldid, & if (asum_init > puny) then diff = asum_final - asum_init if (abs(diff/asum_init) > puny) then - l_stop = .true. + ckflag = .true. write (nu_diag,*) write (nu_diag,*) subname,'Ice area conserv error ', trim(fieldid) write (nu_diag,*) subname,' Initial global area =', asum_init @@ -1135,7 +1135,7 @@ subroutine global_conservation (l_stop, fieldid, & if (abs(atsum_init(nt)) > puny) then diff = atsum_final(nt) - atsum_init(nt) if (abs(diff/atsum_init(nt)) > puny) then - l_stop = .true. + ckflag = .true. write (nu_diag,*) write (nu_diag,*) subname,'Ice area*tracer conserv error ', trim(fieldid),nt write (nu_diag,*) subname,' Tracer index =', nt @@ -1323,7 +1323,7 @@ subroutine check_monotonicity (nx_block, ny_block, & ilo, ihi, jlo, jhi, & tmin, tmax, & aim, trm, & - l_stop, & + ckflag, & istop, jstop) integer (kind=int_kind), intent(in) :: & @@ -1341,7 +1341,7 @@ subroutine check_monotonicity (nx_block, ny_block, & tmax ! local max tracer logical (kind=log_kind), intent(inout) :: & - l_stop ! if true, abort on return + ckflag ! if true, abort on return integer (kind=int_kind), intent(inout) :: & istop, jstop ! indices of grid cell where model aborts @@ -1425,7 +1425,7 @@ subroutine check_monotonicity (nx_block, ny_block, & w1 = max(c1, abs(tmin(i,j,nt))) w2 = max(c1, abs(tmax(i,j,nt))) if (trm(i,j,nt) < tmin(i,j,nt)-w1*puny) then - l_stop = .true. + ckflag = .true. istop = i jstop = j write (nu_diag,*) ' ' @@ -1435,7 +1435,7 @@ subroutine check_monotonicity (nx_block, ny_block, & write (nu_diag,*) 'tmin =' , tmin(i,j,nt) write (nu_diag,*) 'ice area =' , aim(i,j) elseif (trm(i,j,nt) > tmax(i,j,nt)+w2*puny) then - l_stop = .true. + ckflag = .true. istop = i jstop = j write (nu_diag,*) ' ' diff --git a/cicecore/cicedynB/general/ice_flux.F90 b/cicecore/cicedynB/general/ice_flux.F90 index 71253a4b1..06b371c3c 100644 --- a/cicecore/cicedynB/general/ice_flux.F90 +++ b/cicecore/cicedynB/general/ice_flux.F90 @@ -547,7 +547,8 @@ subroutine init_coupler_flux integer (kind=int_kind) :: n - real (kind=dbl_kind) :: fcondtopn_d(6), fsurfn_d(6) + integer (kind=int_kind), parameter :: max_d = 6 + real (kind=dbl_kind) :: fcondtopn_d(max_d), fsurfn_d(max_d) real (kind=dbl_kind) :: stefan_boltzmann, Tffresh real (kind=dbl_kind) :: vonkar, zref, iceruf @@ -589,7 +590,7 @@ subroutine init_coupler_flux flw (:,:,:) = c180 ! incoming longwave rad (W/m^2) frain (:,:,:) = c0 ! rainfall rate (kg/m2/s) do n = 1, ncat ! conductive heat flux (W/m^2) - fcondtopn_f(:,:,n,:) = fcondtopn_d(n) + fcondtopn_f(:,:,n,:) = fcondtopn_d(min(n,max_d)) enddo fsurfn_f = fcondtopn_f ! surface heat flux (W/m^2) flatn_f (:,:,:,:) = c0 ! latent heat flux (kg/m2/s) @@ -606,7 +607,7 @@ subroutine init_coupler_flux flw (:,:,:) = 280.0_dbl_kind ! incoming longwave rad (W/m^2) frain (:,:,:) = c0 ! rainfall rate (kg/m2/s) do n = 1, ncat ! surface heat flux (W/m^2) - fsurfn_f(:,:,n,:) = fsurfn_d(n) + fsurfn_f(:,:,n,:) = fsurfn_d(min(n,max_d)) enddo fcondtopn_f(:,:,:,:) = 0.0_dbl_kind ! conductive heat flux (W/m^2) flatn_f (:,:,:,:) = -2.0_dbl_kind ! latent heat flux (W/m^2) @@ -623,7 +624,7 @@ subroutine init_coupler_flux flw (:,:,:) = 230.0_dbl_kind ! incoming longwave rad (W/m^2) frain (:,:,:) = c0 ! rainfall rate (kg/m2/s) do n = 1, ncat ! surface heat flux (W/m^2) - fsurfn_f(:,:,n,:) = fsurfn_d(n) + fsurfn_f(:,:,n,:) = fsurfn_d(min(n,max_d)) enddo fcondtopn_f(:,:,:,:) = c0 ! conductive heat flux (W/m^2) flatn_f (:,:,:,:) = -1.0_dbl_kind ! latent heat flux (W/m^2) @@ -654,9 +655,7 @@ subroutine init_coupler_flux enddo enddo -#ifndef CICE_IN_NEMO sst (:,:,:) = Tf(:,:,:) ! sea surface temp (C) -#endif qdp (:,:,:) = c0 ! deep ocean heat flux (W/m^2) hmix (:,:,:) = c20 ! ocean mixed layer depth (m) hwater(:,:,:) = bathymetry(:,:,:) ! ocean water depth (m) diff --git a/cicecore/cicedynB/general/ice_forcing.F90 b/cicecore/cicedynB/general/ice_forcing.F90 old mode 100644 new mode 100755 index edbba8101..200b3d00b --- a/cicecore/cicedynB/general/ice_forcing.F90 +++ b/cicecore/cicedynB/general/ice_forcing.F90 @@ -22,16 +22,16 @@ module ice_forcing use ice_blocks, only: nx_block, ny_block use ice_domain_size, only: ncat, max_blocks, nx_global, ny_global use ice_communicate, only: my_task, master_task - use ice_calendar, only: istep, istep1, time, time_forc, & - sec, mday, month, nyr, yday, daycal, dayyr, & - daymo, days_per_year, hc_jday + use ice_calendar, only: istep, istep1, & + msec, mday, mmonth, myear, yday, daycal, & + daymo, days_per_year, compute_days_between use ice_fileunits, only: nu_diag, nu_forcing use ice_exit, only: abort_ice use ice_read_write, only: ice_open, ice_read, & ice_get_ncvarsize, ice_read_vec_nc, & ice_open_nc, ice_read_nc, ice_close_nc use ice_timers, only: ice_timer_start, ice_timer_stop, timer_readwrite, & - timer_bound + timer_bound, timer_forcing use ice_arrays_column, only: oceanmixed_ice, restore_bgc use ice_constants, only: c0, c1, c2, c3, c4, c5, c8, c10, c12, c15, c20, & c180, c360, c365, c1000, c3600 @@ -53,10 +53,10 @@ module ice_forcing read_data_nc_point, interp_coeff integer (kind=int_kind), public :: & - ycycle , & ! number of years in forcing cycle - fyear_init , & ! first year of data in forcing cycle - fyear , & ! current year in forcing cycle - fyear_final ! last year in cycle + ycycle , & ! number of years in forcing cycle, set by namelist + fyear_init , & ! first year of data in forcing cycle, set by namelist + fyear , & ! current year in forcing cycle, varying during the run + fyear_final ! last year in cycle, computed at init character (char_len_long) :: & ! input data file names uwind_file, & @@ -80,8 +80,7 @@ module ice_forcing botmelt_file real (kind=dbl_kind), public :: & - c1intp, c2intp , & ! interpolation coefficients - ftime ! forcing time (for restart) + c1intp, c2intp ! interpolation coefficients integer (kind=int_kind) :: & oldrecnum = 0 , & ! old record number (save between steps) @@ -159,7 +158,7 @@ module ice_forcing trest ! restoring time scale (sec) logical (kind=log_kind), public :: & - dbug ! prints debugging output if true + forcing_diag ! prints forcing debugging output if true real (dbl_kind), dimension(:), allocatable, public :: & jday_atm ! jday time vector from atm forcing files @@ -167,6 +166,15 @@ module ice_forcing integer (kind=int_kind), public :: & Njday_atm ! Number of atm forcing timesteps + + ! PRIVATE: + + real (dbl_kind), parameter :: & + mixed_layer_depth_default = c20 ! default mixed layer depth in m + + logical (kind=log_kind), parameter :: & + forcing_debug = .false. ! local debug flag + !======================================================================= contains @@ -177,6 +185,9 @@ module ice_forcing ! subroutine alloc_forcing integer (int_kind) :: ierr + character(len=*), parameter :: subname = '(alloc_forcing)' + + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' allocate ( & cldf(nx_block,ny_block, max_blocks), & ! cloud fraction @@ -221,14 +232,20 @@ subroutine init_forcing_atmo use ice_calendar, only: use_leap_years + integer (kind=int_kind) :: modadj ! adjustment for mod function character(len=*), parameter :: subname = '(init_forcing_atmo)' - ! Allocate forcing arrays - call alloc_forcing() + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' - fyear = fyear_init + mod(nyr-1,ycycle) ! current year + modadj = abs((min(0,myear-fyear_init)/ycycle+1)*ycycle) + fyear = fyear_init + mod(myear-fyear_init+modadj,ycycle) fyear_final = fyear_init + ycycle - 1 ! last year in forcing cycle + if (forcing_debug .and. my_task == master_task) then + write(nu_diag,*) subname,'fdbg fyear = ',fyear,fyear_init,fyear_final + write(nu_diag,*) subname,'fdbg atm_data_type = ',trim(atm_data_type) + endif + if (trim(atm_data_type) /= 'default' .and. & my_task == master_task) then write (nu_diag,*) ' Initial forcing data year = ',fyear_init @@ -327,15 +344,19 @@ subroutine init_forcing_ocn(dt) character(len=*), parameter :: subname = '(init_forcing_ocn)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(secday_out=secday) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) -! sst_data(:,:,:,:) = c0 -! sss_data(:,:,:,:) = c0 -! uocn_data(:,:,:,:) = c0 -! vocn_data(:,:,:,:) = c0 + call alloc_forcing() + + sst_data(:,:,:,:) = c0 + sss_data(:,:,:,:) = c0 + uocn_data(:,:,:,:) = c0 + vocn_data(:,:,:,:) = c0 nbits = 64 ! double precision data @@ -368,7 +389,7 @@ subroutine init_forcing_ocn(dt) sss(:,:,:) = c0 do k = 1,12 ! loop over 12 months - call ice_read (nu_forcing, k, work1, 'rda8', dbug, & + call ice_read (nu_forcing, k, work1, 'rda8', forcing_diag, & field_loc_center, field_type_scalar) !$OMP PARALLEL DO PRIVATE(iblk,i,j) do iblk = 1, nblocks @@ -415,7 +436,7 @@ subroutine init_forcing_ocn(dt) if (my_task == master_task) & call ice_open (nu_forcing, sst_file, nbits) - call ice_read (nu_forcing, month, sst, 'rda8', dbug, & + call ice_read (nu_forcing, mmonth, sst, 'rda8', forcing_diag, & field_loc_center, field_type_scalar) if (my_task == master_task) close(nu_forcing) @@ -451,7 +472,7 @@ subroutine init_forcing_ocn(dt) endif fieldname='sst' - call ice_read_nc(fid,month,fieldname,sst,diag) + call ice_read_nc(fid,mmonth,fieldname,sst,diag) if (my_task == master_task) call ice_close_nc(fid) @@ -469,8 +490,8 @@ subroutine init_forcing_ocn(dt) endif ! ocn_data_type if (trim(ocn_data_type) == 'ncar') then -! call ocn_data_ncar_init - call ocn_data_ncar_init_3D + call ocn_data_ncar_init +! call ocn_data_ncar_init_3D endif if (trim(ocn_data_type) == 'hycom') then @@ -499,6 +520,8 @@ subroutine ocn_freezing_temperature character(len=*), parameter :: subname = '(ocn_freezing_temperature)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + !$OMP PARALLEL DO PRIVATE(iblk,i,j) do iblk = 1, nblocks do j = 1, ny_block @@ -533,7 +556,8 @@ subroutine get_forcing_atmo integer (kind=int_kind) :: & iblk, & ! block index ilo,ihi,jlo,jhi, & ! beginning and end of physical domain - fyear_old, & ! prior fyear value + modadj, & ! adjustment to make mod a postive number + fyear_old, & ! fyear setting on last timestep nt_Tsfc type (block) :: & @@ -541,12 +565,17 @@ subroutine get_forcing_atmo character(len=*), parameter :: subname = '(get_forcing_atmo)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + + call ice_timer_start(timer_forcing) + fyear_old = fyear - fyear = fyear_init + mod(nyr-1,ycycle) ! current year + modadj = abs((min(0,myear-fyear_init)/ycycle+1)*ycycle) + fyear = fyear_init + mod(myear-fyear_init+modadj,ycycle) if (trim(atm_data_type) /= 'default' .and. & (istep <= 1 .or. fyear /= fyear_old)) then if (my_task == master_task) then - write (nu_diag,*) ' Current forcing data year = ',fyear + write (nu_diag,*) ' Set current forcing data year = ',fyear endif endif @@ -555,23 +584,25 @@ subroutine get_forcing_atmo if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - ftime = time ! forcing time - time_forc = ftime ! for restarting + !------------------------------------------------------------------- + ! Read and interpolate atmospheric data + !------------------------------------------------------------------- - !------------------------------------------------------------------- - ! Read and interpolate atmospheric data - !------------------------------------------------------------------- + if (forcing_debug .and. my_task == master_task) then + write(nu_diag,*) subname,'fdbg fyear = ',fyear + write(nu_diag,*) subname,'fdbg atm_data_type = ',trim(atm_data_type) + endif if (trim(atm_data_type) == 'ncar') then call ncar_data elseif (trim(atm_data_type) == 'LYq') then call LY_data elseif (trim(atm_data_type) == 'JRA55_gx1') then - call JRA55_data(fyear) + call JRA55_data elseif (trim(atm_data_type) == 'JRA55_gx3') then - call JRA55_data(fyear) + call JRA55_data elseif (trim(atm_data_type) == 'JRA55_tx1') then - call JRA55_data(fyear) + call JRA55_data elseif (trim(atm_data_type) == 'hadgem') then call hadgem_data elseif (trim(atm_data_type) == 'monthly') then @@ -586,9 +617,9 @@ subroutine get_forcing_atmo return endif - !------------------------------------------------------------------- - ! Convert forcing data to fields needed by ice model - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Convert forcing data to fields needed by ice model + !------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblk,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks @@ -640,6 +671,8 @@ subroutine get_forcing_atmo field_loc_center, field_type_scalar) call ice_timer_stop(timer_bound) + call ice_timer_stop(timer_forcing) + end subroutine get_forcing_atmo !======================================================================= @@ -655,6 +688,15 @@ subroutine get_forcing_ocn (dt) character(len=*), parameter :: subname = '(get_forcing_ocn)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + + call ice_timer_start(timer_forcing) + + if (forcing_debug .and. my_task == master_task) then + write(nu_diag,*) subname,'fdbg fyear = ',fyear + write(nu_diag,*) subname,'fdbg ocn_data_type = ',trim(ocn_data_type) + endif + if (trim(ocn_data_type) == 'clim') then call ocn_data_clim(dt) elseif (trim(ocn_data_type) == 'ncar' .or. & @@ -670,6 +712,8 @@ subroutine get_forcing_ocn (dt) !MHRI: NOT IMPLEMENTED YET endif + call ice_timer_stop(timer_forcing) + end subroutine get_forcing_ocn !======================================================================= @@ -694,7 +738,7 @@ subroutine read_data (flag, recd, yr, ixm, ixx, ixp, & ! data is missing, and we assume periodicity when monthly data ! is missing. - use ice_diagnostics, only: check_step + use ice_diagnostics, only: debug_model_step logical (kind=log_kind), intent(in) :: flag @@ -726,13 +770,15 @@ subroutine read_data (flag, recd, yr, ixm, ixx, ixp, & character(len=*), parameter :: subname = '(read_data)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call ice_timer_start(timer_readwrite) ! reading/writing nbits = 64 ! double precision data - if (istep1 > check_step) dbug = .true. !! debugging + if (istep1 > debug_model_step) forcing_diag = .true. !! debugging - if (my_task==master_task .and. (dbug)) then + if (my_task==master_task .and. (forcing_diag)) then write(nu_diag,*) ' ', trim(data_file) endif @@ -770,7 +816,7 @@ subroutine read_data (flag, recd, yr, ixm, ixx, ixp, & arg = 1 nrec = recd + n2 call ice_read (nu_forcing, nrec, field_data(:,:,arg,:), & - 'rda8', dbug, field_loc, field_type) + 'rda8', forcing_diag, field_loc, field_type) if (ixx==1 .and. my_task == master_task) close(nu_forcing) endif ! ixm ne -99 @@ -782,7 +828,7 @@ subroutine read_data (flag, recd, yr, ixm, ixx, ixp, & arg = arg + 1 nrec = recd + ixx call ice_read (nu_forcing, nrec, field_data(:,:,arg,:), & - 'rda8', dbug, field_loc, field_type) + 'rda8', forcing_diag, field_loc, field_type) if (ixp /= -99) then ! currently in latter half of data interval @@ -807,7 +853,7 @@ subroutine read_data (flag, recd, yr, ixm, ixx, ixp, & arg = arg + 1 nrec = recd + n4 call ice_read (nu_forcing, nrec, field_data(:,:,arg,:), & - 'rda8', dbug, field_loc, field_type) + 'rda8', forcing_diag, field_loc, field_type) endif ! ixp /= -99 if (my_task == master_task) close(nu_forcing) @@ -842,7 +888,7 @@ subroutine read_data_nc (flag, recd, yr, ixm, ixx, ixp, & ! ! Adapted by Alison McLaren, Met Office from read_data - use ice_diagnostics, only: check_step + use ice_diagnostics, only: debug_model_step logical (kind=log_kind), intent(in) :: flag @@ -860,16 +906,14 @@ subroutine read_data_nc (flag, recd, yr, ixm, ixx, ixp, & fieldname ! field name in netCDF file integer (kind=int_kind), intent(in) :: & - field_loc, & ! location of field on staggered grid - field_type ! type of field (scalar, vector, angle) + field_loc, & ! location of field on staggered grid + field_type ! type of field (scalar, vector, angle) real (kind=dbl_kind), dimension(nx_block,ny_block,2,max_blocks), intent(out) :: & field_data ! 2 values needed for interpolation ! local variables - character(len=*), parameter :: subname = '(read_data_nc)' - integer (kind=int_kind) :: & nrec , & ! record number to read n2, n4 , & ! like ixm and ixp, but @@ -877,11 +921,15 @@ subroutine read_data_nc (flag, recd, yr, ixm, ixx, ixp, & arg , & ! value of time argument in field_data fid ! file id for netCDF routines + character(len=*), parameter :: subname = '(read_data_nc)' + + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call ice_timer_start(timer_readwrite) ! reading/writing - if (istep1 > check_step) dbug = .true. !! debugging + if (istep1 > debug_model_step) forcing_diag = .true. !! debugging - if (my_task==master_task .and. (dbug)) then + if (my_task==master_task .and. (forcing_diag)) then write(nu_diag,*) ' ', trim(data_file) endif @@ -920,7 +968,7 @@ subroutine read_data_nc (flag, recd, yr, ixm, ixx, ixp, & nrec = recd + n2 call ice_read_nc & - (fid, nrec, fieldname, field_data(:,:,arg,:), dbug, & + (fid, nrec, fieldname, field_data(:,:,arg,:), forcing_diag, & field_loc, field_type) if (ixx==1) call ice_close_nc(fid) @@ -934,7 +982,7 @@ subroutine read_data_nc (flag, recd, yr, ixm, ixx, ixp, & nrec = recd + ixx call ice_read_nc & - (fid, nrec, fieldname, field_data(:,:,arg,:), dbug, & + (fid, nrec, fieldname, field_data(:,:,arg,:), forcing_diag, & field_loc, field_type) if (ixp /= -99) then @@ -960,7 +1008,7 @@ subroutine read_data_nc (flag, recd, yr, ixm, ixx, ixp, & nrec = recd + n4 call ice_read_nc & - (fid, nrec, fieldname, field_data(:,:,arg,:), dbug, & + (fid, nrec, fieldname, field_data(:,:,arg,:), forcing_diag, & field_loc, field_type) endif ! ixp /= -99 @@ -986,7 +1034,7 @@ subroutine read_data_nc_hycom (flag, recd, & ! ! Adapted by Mads Hvid Ribergaard, DMI from read_data_nc - use ice_diagnostics, only: check_step + use ice_diagnostics, only: debug_model_step use ice_timers, only: ice_timer_start, ice_timer_stop, timer_readwrite logical (kind=log_kind), intent(in) :: flag @@ -1011,11 +1059,15 @@ subroutine read_data_nc_hycom (flag, recd, & integer (kind=int_kind) :: & fid ! file id for netCDF routines + character(len=*), parameter :: subname = '(read_data_nc_hycom)' + + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call ice_timer_start(timer_readwrite) ! reading/writing - if (istep1 > check_step) dbug = .true. !! debugging + if (istep1 > debug_model_step) forcing_diag = .true. !! debugging - if (my_task==master_task .and. (dbug)) then + if (my_task==master_task .and. (forcing_diag)) then write(nu_diag,*) ' ', trim(data_file) endif @@ -1026,11 +1078,11 @@ subroutine read_data_nc_hycom (flag, recd, & ! read data !----------------------------------------------------------------- call ice_read_nc & - (fid, recd , fieldname, field_data(:,:,1,:), dbug, & + (fid, recd , fieldname, field_data(:,:,1,:), forcing_diag, & field_loc, field_type) call ice_read_nc & - (fid, recd+1, fieldname, field_data(:,:,2,:), dbug, & + (fid, recd+1, fieldname, field_data(:,:,2,:), forcing_diag, & field_loc, field_type) call ice_close_nc(fid) @@ -1052,7 +1104,7 @@ subroutine read_clim_data (readflag, recd, ixm, ixx, ixp, & ! no need to get data from other years or to extrapolate data beyond ! the forcing time period. - use ice_diagnostics, only: check_step + use ice_diagnostics, only: debug_model_step logical (kind=log_kind),intent(in) :: readflag @@ -1079,13 +1131,15 @@ subroutine read_clim_data (readflag, recd, ixm, ixx, ixp, & character(len=*), parameter :: subname = '(read_clim_data)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call ice_timer_start(timer_readwrite) ! reading/writing nbits = 64 ! double precision data - if (istep1 > check_step) dbug = .true. !! debugging + if (istep1 > debug_model_step) forcing_diag = .true. !! debugging - if (my_task==master_task .and. (dbug)) & + if (my_task==master_task .and. (forcing_diag)) & write(nu_diag,*) ' ', trim(data_file) if (readflag) then @@ -1101,19 +1155,19 @@ subroutine read_clim_data (readflag, recd, ixm, ixx, ixp, & arg = 1 nrec = recd + ixm call ice_read (nu_forcing, nrec, field_data(:,:,arg,:), & - 'rda8', dbug, field_loc, field_type) + 'rda8', forcing_diag, field_loc, field_type) endif arg = arg + 1 nrec = recd + ixx call ice_read (nu_forcing, nrec, field_data(:,:,arg,:), & - 'rda8', dbug, field_loc, field_type) + 'rda8', forcing_diag, field_loc, field_type) if (ixp /= -99) then arg = arg + 1 nrec = recd + ixp call ice_read (nu_forcing, nrec, field_data(:,:,arg,:), & - 'rda8', dbug, field_loc, field_type) + 'rda8', forcing_diag, field_loc, field_type) endif if (my_task == master_task) close (nu_forcing) @@ -1134,7 +1188,7 @@ subroutine read_clim_data_nc (readflag, recd, ixm, ixx, ixp, & ! no need to get data from other years or to extrapolate data beyond ! the forcing time period. - use ice_diagnostics, only: check_step + use ice_diagnostics, only: debug_model_step logical (kind=log_kind),intent(in) :: readflag @@ -1164,11 +1218,13 @@ subroutine read_clim_data_nc (readflag, recd, ixm, ixx, ixp, & character(len=*), parameter :: subname = '(read_clim_data_nc)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call ice_timer_start(timer_readwrite) ! reading/writing - if (istep1 > check_step) dbug = .true. !! debugging + if (istep1 > debug_model_step) forcing_diag = .true. !! debugging - if (my_task==master_task .and. (dbug)) & + if (my_task==master_task .and. (forcing_diag)) & write(nu_diag,*) ' ', trim(data_file) if (readflag) then @@ -1185,21 +1241,21 @@ subroutine read_clim_data_nc (readflag, recd, ixm, ixx, ixp, & nrec = recd + ixm call ice_read_nc & (fid, nrec, fieldname, field_data(:,:,arg,:), & - dbug, field_loc, field_type) + forcing_diag, field_loc, field_type) endif arg = arg + 1 nrec = recd + ixx call ice_read_nc & (fid, nrec, fieldname, field_data(:,:,arg,:), & - dbug, field_loc, field_type) + forcing_diag, field_loc, field_type) if (ixp /= -99) then arg = arg + 1 nrec = recd + ixp call ice_read_nc & (fid, nrec, fieldname, field_data(:,:,arg,:), & - dbug, field_loc, field_type) + forcing_diag, field_loc, field_type) endif if (my_task == master_task) call ice_close_nc (fid) @@ -1222,14 +1278,16 @@ subroutine interp_coeff_monthly (recslot) real (kind=dbl_kind) :: & secday , & ! seconds in day - tt , & ! seconds elapsed in current year - t1, t2 ! seconds elapsed at month midpoint + tt , & ! days elapsed in current year + t1, t2 ! days elapsed at month midpoint real (kind=dbl_kind) :: & daymid(0:13) ! month mid-points character(len=*), parameter :: subname = '(interp_coeff_monthly)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(secday_out=secday) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -1238,21 +1296,27 @@ subroutine interp_coeff_monthly (recslot) daymid(1:13) = 14._dbl_kind ! time frame ends 0 sec into day 15 daymid(0) = 14._dbl_kind - daymo(12) ! Dec 15, 0 sec - ! make time cyclic - tt = mod(ftime/secday,dayyr) + ! compute days since Jan 1, 00h, yday is the day counter for the year + tt = real(yday-1,kind=dbl_kind) + real(msec,kind=dbl_kind)/secday ! Find neighboring times if (recslot==2) then ! first half of month - t2 = daycal(month) + daymid(month) ! midpoint, current month - if (month == 1) then + t2 = daycal(mmonth) + daymid(mmonth) ! midpoint, current month + if (mmonth == 1) then t1 = daymid(0) ! Dec 15 (0 sec) else - t1 = daycal(month-1) + daymid(month-1) ! midpoint, previous month + t1 = daycal(mmonth-1) + daymid(mmonth-1) ! midpoint, previous month endif else ! second half of month - t1 = daycal(month) + daymid(month) ! midpoint, current month - t2 = daycal(month+1) + daymid(month+1)! day 15 of next month (0 sec) + t1 = daycal(mmonth) + daymid(mmonth) ! midpoint, current month + t2 = daycal(mmonth+1) + daymid(mmonth+1)! day 15 of next month (0 sec) + endif + + if (tt < t1 .or. tt > t2) then + write(nu_diag,*) subname,' ERROR in tt',tt,t1,t2 + call abort_ice (error_message=subname//' ERROR in tt', & + file=__FILE__, line=__LINE__) endif ! Compute coefficients @@ -1282,8 +1346,7 @@ subroutine interp_coeff (recnum, recslot, secint, dataloc) ! local variables real (kind=dbl_kind) :: & - secday, & ! seconds in a day - secyr ! seconds in a year + secday ! seconds in a day real (kind=dbl_kind) :: & tt , & ! seconds elapsed in current year @@ -1292,13 +1355,15 @@ subroutine interp_coeff (recnum, recslot, secint, dataloc) character(len=*), parameter :: subname = '(interp_coeff)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(secday_out=secday) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - secyr = dayyr * secday ! seconds in a year - tt = mod(ftime,secyr) + ! compute seconds since Jan 1, 00h, yday is the day counter for the year + tt = real(yday-1,kind=dbl_kind)*secday + real(msec,kind=dbl_kind) ! Find neighboring times rcnum = real(recnum,kind=dbl_kind) @@ -1322,6 +1387,12 @@ subroutine interp_coeff (recnum, recslot, secint, dataloc) c1intp = abs((t2 - tt) / (t2 - t1)) c2intp = c1 - c1intp + if (forcing_debug .and. my_task == master_task) then + write(nu_diag,*) subname,'fdbg yday,sec = ',yday,msec + write(nu_diag,*) subname,'fdbg tt = ',tt + write(nu_diag,*) subname,'fdbg c12intp = ',c1intp,c2intp + endif + end subroutine interp_coeff !======================================================================= @@ -1335,6 +1406,9 @@ subroutine interp_coeff2 (tt, t1, t2) real (kind=dbl_kind), intent(in) :: & tt , & ! current decimal daynumber t1, t2 ! first+last decimal daynumber + character(len=*), parameter :: subname = '(interp_coeff2)' + + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' ! Compute coefficients c1intp = abs((t2 - tt) / (t2 - t1)) @@ -1364,6 +1438,8 @@ subroutine interpolate_data (field_data, field) character(len=*), parameter :: subname = '(interpolate data)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + !$OMP PARALLEL DO PRIVATE(iblk,i,j) do iblk = 1, nblocks do j = 1, ny_block @@ -1395,6 +1471,8 @@ subroutine file_year (data_file, yr) character(len=*), parameter :: subname = '(file_year)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + if (trim(atm_data_type) == 'hadgem') then ! netcdf i = index(data_file,'.nc') - 5 tmpname = data_file @@ -1481,6 +1559,8 @@ subroutine prepare_forcing (nx_block, ny_block, & character(len=*), parameter :: subname = '(prepare_forcing)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(Tffresh_out=Tffresh, puny_out=puny) call icepack_query_parameters(secday_out=secday) call icepack_query_parameters(calc_strair_out=calc_strair) @@ -1579,7 +1659,7 @@ subroutine prepare_forcing (nx_block, ny_block, & ! convert precipitation units to kg/m^2 s if (trim(precip_units) == 'mm_per_month') then - precip_factor = c12/(secday*days_per_year) + precip_factor = c12/(secday*real(days_per_year,kind=dbl_kind)) elseif (trim(precip_units) == 'mm_per_day') then precip_factor = c1/secday elseif (trim(precip_units) == 'mm_per_sec' .or. & @@ -1699,6 +1779,8 @@ subroutine longwave_parkinson_washington(Tair, cldf, flw) character(len=*), parameter :: subname = '(longwave_parkinson_washington)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(Tffresh_out=Tffresh, & stefan_boltzmann_out=stefan_boltzmann) call icepack_warnings_flush(nu_diag) @@ -1749,6 +1831,8 @@ subroutine longwave_rosati_miyakoda(cldf, Tsfc, & character(len=*), parameter :: subname = '(longwave_rosati_miyakoda)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(Tffresh_out=Tffresh, & stefan_boltzmann_out=stefan_boltzmann, & emissivity_out=emissivity) @@ -1786,6 +1870,8 @@ subroutine ncar_files (yr) character(len=*), parameter :: subname = '(ncar_files)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + fsw_file = & trim(atm_data_dir)//'/MONTHLY/swdn.1996.dat' call file_year(fsw_file,yr) @@ -1857,6 +1943,8 @@ subroutine ncar_data character(len=*), parameter :: subname = '(ncar_data)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(secday_out=secday) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -1870,12 +1958,12 @@ subroutine ncar_data !------------------------------------------------------------------- midmonth = 15 ! data is given on 15th of every month -! midmonth = fix(p5 * real(daymo(month))) ! exact middle +! midmonth = fix(p5 * real(daymo(mmonth))) ! exact middle ! Compute record numbers for surrounding months maxrec = 12 - ixm = mod(month+maxrec-2,maxrec) + 1 - ixp = mod(month, maxrec) + 1 + ixm = mod(mmonth+maxrec-2,maxrec) + 1 + ixp = mod(mmonth, maxrec) + 1 if (mday >= midmonth) ixm = -99 ! other two points will be used if (mday < midmonth) ixp = -99 @@ -1892,29 +1980,29 @@ subroutine ncar_data ! Read 2 monthly values readm = .false. - if (istep==1 .or. (mday==midmonth .and. sec==0)) readm = .true. + if (istep==1 .or. (mday==midmonth .and. msec==0)) readm = .true. if (trim(atm_data_format) == 'bin') then - call read_data (readm, 0, fyear, ixm, month, ixp, & + call read_data (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, fsw_file, fsw_data, & field_loc_center, field_type_scalar) - call read_data (readm, 0, fyear, ixm, month, ixp, & + call read_data (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, flw_file, cldf_data, & field_loc_center, field_type_scalar) - call read_data (readm, 0, fyear, ixm, month, ixp, & + call read_data (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, rain_file, fsnow_data, & field_loc_center, field_type_scalar) else call abort_ice (error_message=subname//'nonbinary atm_data_format unavailable', & file=__FILE__, line=__LINE__) ! The routine exists, for example: -! call read_data_nc (readm, 0, fyear, ixm, month, ixp, & +! call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & ! maxrec, fsw_file, 'fsw', fsw_data, & ! field_loc_center, field_type_scalar) -! call read_data_nc (readm, 0, fyear, ixm, month, ixp, & +! call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & ! maxrec, flw_file, 'cldf',cldf_data, & ! field_loc_center, field_type_scalar) -! call read_data_nc (readm, 0, fyear, ixm, month, ixp, & +! call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & ! maxrec, rain_file,'prec',fsnow_data, & ! field_loc_center, field_type_scalar) endif @@ -1937,7 +2025,7 @@ subroutine ncar_data maxrec = 1460 ! 365*4 ! current record number - recnum = 4*int(yday) - 3 + int(real(sec,kind=dbl_kind)/sec6hr) + recnum = 4*int(yday) - 3 + int(real(msec,kind=dbl_kind)/sec6hr) ! Compute record numbers for surrounding data @@ -2009,6 +2097,8 @@ subroutine LY_files (yr) character(len=*), parameter :: subname = '(LY_files)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + flw_file = & trim(atm_data_dir)//'/MONTHLY/cldf.omip.dat' @@ -2044,6 +2134,9 @@ subroutine LY_files (yr) endif ! master_task end subroutine LY_files + +!======================================================================= + subroutine JRA55_gx1_files(yr) ! integer (kind=int_kind), intent(in) :: & @@ -2051,6 +2144,8 @@ subroutine JRA55_gx1_files(yr) character(len=*), parameter :: subname = '(JRA55_gx1_files)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + uwind_file = & trim(atm_data_dir)//'/8XDAILY/JRA55_03hr_forcing_2005.nc' call file_year(uwind_file,yr) @@ -2060,6 +2155,9 @@ subroutine JRA55_gx1_files(yr) write (nu_diag,*) trim(uwind_file) endif end subroutine JRA55_gx1_files + +!======================================================================= + subroutine JRA55_tx1_files(yr) ! integer (kind=int_kind), intent(in) :: & @@ -2067,6 +2165,8 @@ subroutine JRA55_tx1_files(yr) character(len=*), parameter :: subname = '(JRA55_tx1_files)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + uwind_file = & trim(atm_data_dir)//'/8XDAILY/JRA55_03hr_forcing_tx1_2005.nc' call file_year(uwind_file,yr) @@ -2076,6 +2176,9 @@ subroutine JRA55_tx1_files(yr) write (nu_diag,*) trim(uwind_file) endif end subroutine JRA55_tx1_files + +!======================================================================= + subroutine JRA55_gx3_files(yr) ! integer (kind=int_kind), intent(in) :: & @@ -2083,6 +2186,8 @@ subroutine JRA55_gx3_files(yr) character(len=*), parameter :: subname = '(JRA55_gx3_files)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + uwind_file = & trim(atm_data_dir)//'/8XDAILY/JRA55_gx3_03hr_forcing_2005.nc' call file_year(uwind_file,yr) @@ -2092,6 +2197,7 @@ subroutine JRA55_gx3_files(yr) write (nu_diag,*) trim(uwind_file) endif end subroutine JRA55_gx3_files + !======================================================================= ! ! read Large and Yeager atmospheric data @@ -2131,6 +2237,8 @@ subroutine LY_data character(len=*), parameter :: subname = '(LY_data)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(Tffresh_out=Tffresh) call icepack_query_parameters(secday_out=secday) call icepack_warnings_flush(nu_diag) @@ -2145,12 +2253,12 @@ subroutine LY_data !------------------------------------------------------------------- midmonth = 15 ! data is given on 15th of every month -! midmonth = fix(p5 * real(daymo(month))) ! exact middle +! midmonth = fix(p5 * real(daymo(mmonth))) ! exact middle ! Compute record numbers for surrounding months maxrec = 12 - ixm = mod(month+maxrec-2,maxrec) + 1 - ixp = mod(month, maxrec) + 1 + ixm = mod(mmonth+maxrec-2,maxrec) + 1 + ixp = mod(mmonth, maxrec) + 1 if (mday >= midmonth) ixm = -99 ! other two points will be used if (mday < midmonth) ixp = -99 @@ -2167,11 +2275,11 @@ subroutine LY_data ! Read 2 monthly values readm = .false. - if (istep==1 .or. (mday==midmonth .and. sec==0)) readm = .true. + if (istep==1 .or. (mday==midmonth .and. msec==0)) readm = .true. - call read_clim_data (readm, 0, ixm, month, ixp, & + call read_clim_data (readm, 0, ixm, mmonth, ixp, & flw_file, cldf_data, field_loc_center, field_type_scalar) - call read_clim_data (readm, 0, ixm, month, ixp, & + call read_clim_data (readm, 0, ixm, mmonth, ixp, & rain_file, fsnow_data, field_loc_center, field_type_scalar) call interpolate_data (cldf_data, cldf) @@ -2190,7 +2298,7 @@ subroutine LY_data maxrec = 1460 ! 365*4 ! current record number - recnum = 4*int(yday) - 3 + int(real(sec,kind=dbl_kind)/sec6hr) + recnum = 4*int(yday) - 3 + int(real(msec,kind=dbl_kind)/sec6hr) ! Compute record numbers for surrounding data (2 on each side) @@ -2278,7 +2386,7 @@ subroutine LY_data ! Save record number oldrecnum = recnum - if (dbug) then + if (forcing_diag) then if (my_task == master_task) write (nu_diag,*) 'LY_bulk_data' vmin = global_minval(fsw,distrb_info,tmask) @@ -2310,13 +2418,13 @@ subroutine LY_data if (my_task.eq.master_task) & write (nu_diag,*) 'Qa',vmin,vmax - endif ! dbug + endif ! forcing_diag end subroutine LY_data !======================================================================= - subroutine JRA55_data (yr) + subroutine JRA55_data use ice_blocks, only: block, get_block use ice_global_reductions, only: global_minval, global_maxval @@ -2324,34 +2432,34 @@ subroutine JRA55_data (yr) use ice_flux, only: fsnow, Tair, uatm, vatm, Qa, fsw, flw use ice_grid, only: hm, tlon, tlat, tmask, umask use ice_state, only: aice - use ice_calendar, only: days_per_year, use_leap_years + use ice_calendar, only: days_per_year - integer (kind=int_kind), intent(in) :: & - yr ! current forcing year - - integer (kind=int_kind) :: & + integer (kind=int_kind) :: & ncid , & ! netcdf file id - i, j, n1, iblk, & - yrp , & ! year after yr in forcing cycle + i, j, n1 , & + lfyear , & ! local year value recnum , & ! record number maxrec , & ! maximum record number - recslot , & ! spline slot for current record - dataloc ! = 1 for data located in middle of time interval - ! = 2 for date located at end of time interval + iblk ! block index + + integer (kind=int_kind), save :: & + frec_info(2,2) = -99 ! remember prior values to reduce reading + ! first dim is yr, recnum + ! second dim is data1 data2 real (kind=dbl_kind) :: & sec3hr , & ! number of seconds in 3 hours secday , & ! number of seconds in day - eps, tt , & ! interpolation coeff calc + eps, tt , & ! for interpolation coefficients Tffresh , & vmin, vmax - logical (kind=log_kind) :: debug_n_d = .false. - - character (char_len_long) :: uwind_file_old character(len=64) :: fieldname !netcdf field name + character (char_len_long) :: uwind_file_old character(len=*), parameter :: subname = '(JRA55_data)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(Tffresh_out=Tffresh) call icepack_query_parameters(secday_out=secday) call icepack_warnings_flush(nu_diag) @@ -2359,54 +2467,52 @@ subroutine JRA55_data (yr) file=__FILE__, line=__LINE__) sec3hr = secday/c8 ! seconds in 3 hours - maxrec = days_per_year*8 + maxrec = days_per_year * 8 - if (debug_n_d .and. my_task == master_task) then - write (nu_diag,*) subname,'recnum',recnum - write (nu_diag,*) subname,'maxrec',maxrec - write (nu_diag,*) subname,'days_per_year', days_per_year + if (forcing_debug .and. my_task == master_task) then + write(nu_diag,*) subname,'fdbg dpy, maxrec = ',days_per_year,maxrec endif !------------------------------------------------------------------- ! 3-hourly data ! states are instantaneous, 1st record is 00z Jan 1 ! fluxes are 3 hour averages, 1st record is 00z-03z Jan 1 - ! Both states and fluxes have 1st record defined as 00z Jan 1 ! interpolate states, do not interpolate fluxes - ! fluxes are held constant from [init period, end period) !------------------------------------------------------------------- ! File is NETCDF with winds in NORTH and EAST direction ! file variable names are: - ! glbrad (shortwave W/m^2) - ! dlwsfc (longwave W/m^2) - ! wndewd (eastward wind m/s) - ! wndnwd (northward wind m/s) - ! airtmp (air temperature K) - ! spchmd (specific humidity kg/kg) - ! ttlpcp (precipitation kg/m s-1) + ! glbrad (shortwave W/m^2), 3 hr average + ! dlwsfc (longwave W/m^2), 3 hr average + ! wndewd (eastward wind m/s), instantaneous + ! wndnwd (northward wind m/s), instantaneous + ! airtmp (air temperature K), instantaneous + ! spchmd (specific humidity kg/kg), instantaneous + ! ttlpcp (precipitation kg/m s-1), 3 hr average !------------------------------------------------------------------- uwind_file_old = uwind_file - call file_year(uwind_file,yr) if (uwind_file /= uwind_file_old .and. my_task == master_task) then write(nu_diag,*) subname,' reading forcing file = ',trim(uwind_file) endif call ice_open_nc(uwind_file,ncid) - do n1 = 1,2 + do n1 = 1, 2 + lfyear = fyear + call file_year(uwind_file,lfyear) if (n1 == 1) then - recnum = 8*int(yday) - 7 + int(real(sec,kind=dbl_kind)/sec3hr) + recnum = 8*int(yday) - 7 + int(real(msec,kind=dbl_kind)/sec3hr) if (my_task == master_task .and. (recnum <= 2 .or. recnum >= maxrec-1)) then write(nu_diag,*) subname,' reading forcing file 1st ts = ',trim(uwind_file) endif elseif (n1 == 2) then - recnum = 8*int(yday) - 7 + int(real(sec,kind=dbl_kind)/sec3hr) + 1 + recnum = 8*int(yday) - 7 + int(real(msec,kind=dbl_kind)/sec3hr) + 1 if (recnum > maxrec) then - yrp = fyear_init + mod(nyr,ycycle) ! next year + lfyear = fyear + 1 ! next year + if (lfyear > fyear_final) lfyear = fyear_init recnum = 1 - call file_year(uwind_file,yrp) + call file_year(uwind_file,lfyear) if (my_task == master_task) then write(nu_diag,*) subname,' reading forcing file 2nd ts = ',trim(uwind_file) endif @@ -2415,58 +2521,79 @@ subroutine JRA55_data (yr) endif endif - if (debug_n_d .and. my_task == master_task) then - write(nu_diag,*) subname,' read recnum = ',recnum,n1 + if (forcing_debug .and. my_task == master_task) then + write(nu_diag,*) subname,'fdbg read recnum = ',recnum,n1 endif - fieldname = 'airtmp' - call ice_read_nc(ncid,recnum,fieldname,Tair_data(:,:,n1,:),debug_n_d, & - field_loc=field_loc_center, & - field_type=field_type_scalar) + ! to reduce reading, check whether it's the same data as last read - fieldname = 'wndewd' - call ice_read_nc(ncid,recnum,fieldname,uatm_data(:,:,n1,:),debug_n_d, & - field_loc=field_loc_center, & - field_type=field_type_scalar) + if (lfyear /= frec_info(1,n1) .or. recnum /= frec_info(2,n1)) then - fieldname = 'wndnwd' - call ice_read_nc(ncid,recnum,fieldname,vatm_data(:,:,n1,:),debug_n_d, & - field_loc=field_loc_center, & - field_type=field_type_scalar) - - fieldname = 'spchmd' - call ice_read_nc(ncid,recnum,fieldname,Qa_data(:,:,n1,:),debug_n_d, & - field_loc=field_loc_center, & - field_type=field_type_scalar) - - ! only read one timestep for fluxes, 3 hr average, no interpolation - if (n1 == 1) then - fieldname = 'glbrad' - call ice_read_nc(ncid,recnum,fieldname,fsw_data(:,:,n1,:),debug_n_d, & - field_loc=field_loc_center, & - field_type=field_type_scalar) - - fieldname = 'dlwsfc' - call ice_read_nc(ncid,recnum,fieldname,flw_data(:,:,n1,:),debug_n_d, & - field_loc=field_loc_center, & - field_type=field_type_scalar) - - fieldname = 'ttlpcp' - call ice_read_nc(ncid,recnum,fieldname,fsnow_data(:,:,n1,:),debug_n_d, & - field_loc=field_loc_center, & - field_type=field_type_scalar) - endif + ! check whether we can copy values from 2 to 1, should be faster than reading + ! can only do this from 2 to 1 or 1 to 2 without setting up a temporary + ! it's more likely that the values from data2 when time advances are needed in data1 + ! compare n1=1 year/record with data from last timestep at n1=2 - enddo + if (n1 == 1 .and. lfyear == frec_info(1,2) .and. recnum == frec_info(2,2)) then + Tair_data(:,:,1,:) = Tair_data(:,:,2,:) + uatm_data(:,:,1,:) = uatm_data(:,:,2,:) + vatm_data(:,:,1,:) = vatm_data(:,:,2,:) + Qa_data(:,:,1,:) = Qa_data(:,:,2,:) + fsw_data(:,:,1,:) = fsw_data(:,:,2,:) + flw_data(:,:,1,:) = flw_data(:,:,2,:) + fsnow_data(:,:,1,:) = fsnow_data(:,:,2,:) + else + + fieldname = 'airtmp' + call ice_read_nc(ncid,recnum,fieldname,Tair_data(:,:,n1,:),forcing_debug, & + field_loc=field_loc_center, & + field_type=field_type_scalar) + + fieldname = 'wndewd' + call ice_read_nc(ncid,recnum,fieldname,uatm_data(:,:,n1,:),forcing_debug, & + field_loc=field_loc_center, & + field_type=field_type_scalar) + + fieldname = 'wndnwd' + call ice_read_nc(ncid,recnum,fieldname,vatm_data(:,:,n1,:),forcing_debug, & + field_loc=field_loc_center, & + field_type=field_type_scalar) + + fieldname = 'spchmd' + call ice_read_nc(ncid,recnum,fieldname,Qa_data(:,:,n1,:),forcing_debug, & + field_loc=field_loc_center, & + field_type=field_type_scalar) + + fieldname = 'glbrad' + call ice_read_nc(ncid,recnum,fieldname,fsw_data(:,:,n1,:),forcing_debug, & + field_loc=field_loc_center, & + field_type=field_type_scalar) + + fieldname = 'dlwsfc' + call ice_read_nc(ncid,recnum,fieldname,flw_data(:,:,n1,:),forcing_debug, & + field_loc=field_loc_center, & + field_type=field_type_scalar) + + fieldname = 'ttlpcp' + call ice_read_nc(ncid,recnum,fieldname,fsnow_data(:,:,n1,:),forcing_debug, & + field_loc=field_loc_center, & + field_type=field_type_scalar) + endif ! copy data from n1=2 from last timestep to n1=1 + endif ! input data is same as last timestep + + frec_info(1,n1) = lfyear + frec_info(2,n1) = recnum + + enddo ! n1 call ice_close_nc(ncid) ! reset uwind_file to original year - call file_year(uwind_file,yr) + call file_year(uwind_file,fyear) ! Compute interpolation coefficients eps = 1.0e-6 - tt = real(mod(sec,nint(sec3hr)),kind=dbl_kind) + tt = real(mod(msec,nint(sec3hr)),kind=dbl_kind) c2intp = tt / sec3hr if (c2intp < c0 .and. c2intp > c0-eps) c2intp = c0 if (c2intp > c1 .and. c2intp < c1+eps) c2intp = c1 @@ -2476,8 +2603,8 @@ subroutine JRA55_data (yr) call abort_ice (error_message=subname//' ERROR: c2intp out of range', & file=__FILE__, line=__LINE__) endif - if (debug_n_d .and. my_task == master_task) then - write(nu_diag,*) subname,' c12intp = ',c1intp,c2intp + if (forcing_debug .and. my_task == master_task) then + write(nu_diag,*) subname,'fdbg c12intp = ',c1intp,c2intp endif ! Interpolate @@ -2485,10 +2612,10 @@ subroutine JRA55_data (yr) call interpolate_data (uatm_data, uatm) call interpolate_data (vatm_data, vatm) call interpolate_data (Qa_data, Qa) - ! use 3 hr average for heat flux and precip fields - ! call interpolate_data (fsw_data, fsw) - ! call interpolate_data (flw_data, flw) - ! call interpolate_data (fsnow_data, fsnow) + ! use 3 hr average for heat flux and precip fields, no interpolation +! call interpolate_data (fsw_data, fsw) +! call interpolate_data (flw_data, flw) +! call interpolate_data (fsnow_data, fsnow) fsw(:,:,:) = fsw_data(:,:,1,:) flw(:,:,:) = flw_data(:,:,1,:) fsnow(:,:,:) = fsnow_data(:,:,1,:) @@ -2517,39 +2644,30 @@ subroutine JRA55_data (yr) enddo ! iblk !$OMP END PARALLEL DO - if (debug_n_d .or. dbug) then - if (my_task.eq.master_task) & - write (nu_diag,*) subname,'JRA55_bulk_data' - vmin = global_minval(fsw,distrb_info,tmask) - vmax = global_maxval(fsw,distrb_info,tmask) - if (my_task.eq.master_task) & - write (nu_diag,*) subname,'fsw',vmin,vmax - vmin = global_minval(flw,distrb_info,tmask) - vmax = global_maxval(flw,distrb_info,tmask) - if (my_task.eq.master_task) & - write (nu_diag,*) subname,'flw',vmin,vmax - vmin =global_minval(fsnow,distrb_info,tmask) - vmax =global_maxval(fsnow,distrb_info,tmask) - if (my_task.eq.master_task) & - write (nu_diag,*) subname,'fsnow',vmin,vmax - vmin = global_minval(Tair,distrb_info,tmask) - vmax = global_maxval(Tair,distrb_info,tmask) - if (my_task.eq.master_task) & - write (nu_diag,*) subname,'Tair',vmin,vmax - vmin = global_minval(uatm,distrb_info,umask) - vmax = global_maxval(uatm,distrb_info,umask) - if (my_task.eq.master_task) & - write (nu_diag,*) subname,'uatm',vmin,vmax - vmin = global_minval(vatm,distrb_info,umask) - vmax = global_maxval(vatm,distrb_info,umask) - if (my_task.eq.master_task) & - write (nu_diag,*) subname,'vatm',vmin,vmax - vmin = global_minval(Qa,distrb_info,tmask) - vmax = global_maxval(Qa,distrb_info,tmask) - if (my_task.eq.master_task) & - write (nu_diag,*) subname,'Qa',vmin,vmax - - endif ! dbug + if (forcing_diag .or. forcing_debug) then + if (my_task.eq.master_task) write (nu_diag,*) subname,'fdbg JRA55_bulk_data' + vmin = global_minval(fsw,distrb_info,tmask) + vmax = global_maxval(fsw,distrb_info,tmask) + if (my_task.eq.master_task) write (nu_diag,*) subname,'fdbg fsw',vmin,vmax + vmin = global_minval(flw,distrb_info,tmask) + vmax = global_maxval(flw,distrb_info,tmask) + if (my_task.eq.master_task) write (nu_diag,*) subname,'fdbg flw',vmin,vmax + vmin =global_minval(fsnow,distrb_info,tmask) + vmax =global_maxval(fsnow,distrb_info,tmask) + if (my_task.eq.master_task) write (nu_diag,*) subname,'fdbg fsnow',vmin,vmax + vmin = global_minval(Tair,distrb_info,tmask) + vmax = global_maxval(Tair,distrb_info,tmask) + if (my_task.eq.master_task) write (nu_diag,*) subname,'fdbg Tair',vmin,vmax + vmin = global_minval(uatm,distrb_info,umask) + vmax = global_maxval(uatm,distrb_info,umask) + if (my_task.eq.master_task) write (nu_diag,*) subname,'fdbg uatm',vmin,vmax + vmin = global_minval(vatm,distrb_info,umask) + vmax = global_maxval(vatm,distrb_info,umask) + if (my_task.eq.master_task) write (nu_diag,*) subname,'fdbg vatm',vmin,vmax + vmin = global_minval(Qa,distrb_info,tmask) + vmax = global_maxval(Qa,distrb_info,tmask) + if (my_task.eq.master_task) write (nu_diag,*) subname,'fdbg Qa',vmin,vmax + endif ! forcing_diag end subroutine JRA55_data @@ -2596,6 +2714,8 @@ subroutine compute_shortwave(nx_block, ny_block, & character(len=*), parameter :: subname = '(compute_shortwave)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(secday_out=secday, pi_out=pi) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -2604,7 +2724,7 @@ subroutine compute_shortwave(nx_block, ny_block, & do j=jlo,jhi do i=ilo,ihi deg2rad = pi/c180 -! solar_time = mod(real(sec,kind=dbl_kind),secday)/c3600 & +! solar_time = mod(real(msec,kind=dbl_kind),secday)/c3600 & ! + c12*sin(p5*TLON(i,j)) ! Convert longitude to range of -180 to 180 for LST calculation @@ -2613,7 +2733,7 @@ subroutine compute_shortwave(nx_block, ny_block, & if (lontmp .gt. c180) lontmp = lontmp - c360 if (lontmp .lt. -c180) lontmp = lontmp + c360 - solar_time = mod(real(sec,kind=dbl_kind),secday)/c3600 & + solar_time = mod(real(msec,kind=dbl_kind),secday)/c3600 & + lontmp/c15 if (solar_time .ge. 24._dbl_kind) solar_time = solar_time - 24._dbl_kind hour_angle = (c12 - solar_time)*pi/c12 @@ -2658,6 +2778,8 @@ subroutine Qa_fixLY(nx_block, ny_block, Tair, Qa) character(len=*), parameter :: subname = '(Qa_fixLY)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(Tffresh_out=Tffresh, puny_out=puny) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -2700,6 +2822,8 @@ subroutine hadgem_files (yr) character(len=*), parameter :: subname = '(hadgem_files)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(calc_strair_out=calc_strair, & calc_Tsfc_out=calc_Tsfc) call icepack_warnings_flush(nu_diag) @@ -2898,6 +3022,8 @@ subroutine hadgem_data character(len=*), parameter :: subname = '(hadgem_data)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(Lsub_out=Lsub) call icepack_query_parameters(calc_strair_out=calc_strair, & calc_Tsfc_out=calc_Tsfc) @@ -2913,12 +3039,12 @@ subroutine hadgem_data !------------------------------------------------------------------- midmonth = 15 ! data is given on 15th of every month -! midmonth = fix(p5 * real(daymo(month))) ! exact middle +! midmonth = fix(p5 * real(daymo(mmonth))) ! exact middle ! Compute record numbers for surrounding months maxrec = 12 - ixm = mod(month+maxrec-2,maxrec) + 1 - ixp = mod(month, maxrec) + 1 + ixm = mod(mmonth+maxrec-2,maxrec) + 1 + ixp = mod(mmonth, maxrec) + 1 if (mday >= midmonth) ixm = -99 ! other two points will be used if (mday < midmonth) ixp = -99 @@ -2935,18 +3061,18 @@ subroutine hadgem_data ! Read 2 monthly values readm = .false. - if (istep==1 .or. (mday==midmonth .and. sec==0)) readm = .true. + if (istep==1 .or. (mday==midmonth .and. msec==0)) readm = .true. ! ----------------------------------------------------------- ! Rainfall and snowfall ! ----------------------------------------------------------- fieldname='rainfall' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, rain_file, fieldname, frain_data, & field_loc_center, field_type_scalar) fieldname='snowfall' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, snow_file, fieldname, fsnow_data, & field_loc_center, field_type_scalar) @@ -2961,11 +3087,11 @@ subroutine hadgem_data ! -------------------------------------------------------- fieldname='u_10' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, uwind_file, fieldname, uatm_data, & field_loc_center, field_type_vector) fieldname='v_10' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, vwind_file, fieldname, vatm_data, & field_loc_center, field_type_vector) @@ -2980,11 +3106,11 @@ subroutine hadgem_data ! -------------------------------------------------------- fieldname='taux' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, strax_file, fieldname, strax_data, & field_loc_center, field_type_vector) fieldname='tauy' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, stray_file, fieldname, stray_data, & field_loc_center, field_type_vector) @@ -2999,7 +3125,7 @@ subroutine hadgem_data ! -------------------------------------------------- fieldname='wind_10' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, wind_file, fieldname, wind_data, & field_loc_center, field_type_scalar) @@ -3022,23 +3148,23 @@ subroutine hadgem_data if (calc_Tsfc .or. oceanmixed_ice .or. calc_strair) then fieldname='SW_incoming' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, fsw_file, fieldname, fsw_data, & field_loc_center, field_type_scalar) fieldname='LW_incoming' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, flw_file, fieldname, flw_data, & field_loc_center, field_type_scalar) fieldname='t_10' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, tair_file, fieldname, Tair_data, & field_loc_center, field_type_scalar) fieldname='rho_10' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, rhoa_file, fieldname, rhoa_data, & field_loc_center, field_type_scalar) fieldname='q_10' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, humid_file, fieldname, Qa_data, & field_loc_center, field_type_scalar) @@ -3059,7 +3185,7 @@ subroutine hadgem_data ! ------------------------------------------------------ fieldname='sublim' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, sublim_file, fieldname, sublim_data, & field_loc_center, field_type_scalar) @@ -3068,12 +3194,12 @@ subroutine hadgem_data do n = 1, ncat write(fieldname, '(a,i1)') 'topmeltn',n - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, topmelt_file(n), fieldname, topmelt_data(:,:,:,:,n), & field_loc_center, field_type_scalar) write(fieldname, '(a,i1)') 'botmeltn',n - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, botmelt_file(n), fieldname, botmelt_data(:,:,:,:,n), & field_loc_center, field_type_scalar) @@ -3127,6 +3253,8 @@ subroutine monthly_files (yr) character(len=*), parameter :: subname = '(monthly_files)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + flw_file = & trim(atm_data_dir)//'/MONTHLY/cldf.omip.dat' @@ -3198,6 +3326,8 @@ subroutine monthly_data character(len=*), parameter :: subname = '(monthly_data)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + !------------------------------------------------------------------- ! monthly data ! @@ -3206,12 +3336,12 @@ subroutine monthly_data !------------------------------------------------------------------- midmonth = 15 ! data is given on 15th of every month -! midmonth = fix(p5 * real(daymo(month))) ! exact middle +! midmonth = fix(p5 * real(daymo(mmonth))) ! exact middle ! Compute record numbers for surrounding months maxrec = 12 - ixm = mod(month+maxrec-2,maxrec) + 1 - ixp = mod(month, maxrec) + 1 + ixm = mod(mmonth+maxrec-2,maxrec) + 1 + ixp = mod(mmonth, maxrec) + 1 if (mday >= midmonth) ixm = -99 ! other two points will be used if (mday < midmonth) ixp = -99 @@ -3228,27 +3358,27 @@ subroutine monthly_data ! Read 2 monthly values readm = .false. - if (istep==1 .or. (mday==midmonth .and. sec==0)) readm = .true. + if (istep==1 .or. (mday==midmonth .and. msec==0)) readm = .true. - call read_clim_data (readm, 0, ixm, month, ixp, & + call read_clim_data (readm, 0, ixm, mmonth, ixp, & flw_file, cldf_data, & field_loc_center, field_type_scalar) - call read_clim_data (readm, 0, ixm, month, ixp, & + call read_clim_data (readm, 0, ixm, mmonth, ixp, & rain_file, fsnow_data, & field_loc_center, field_type_scalar) - call read_clim_data (readm, 0, ixm, month, ixp, & + call read_clim_data (readm, 0, ixm, mmonth, ixp, & tair_file, Tair_data, & field_loc_center, field_type_scalar) - call read_clim_data (readm, 0, ixm, month, ixp, & + call read_clim_data (readm, 0, ixm, mmonth, ixp, & humid_file, Qa_data, & field_loc_center, field_type_scalar) - call read_clim_data (readm, 0, ixm, month, ixp, & + call read_clim_data (readm, 0, ixm, mmonth, ixp, & wind_file, wind_data, & field_loc_center, field_type_scalar) - call read_clim_data (readm, 0, ixm, month, ixp, & + call read_clim_data (readm, 0, ixm, mmonth, ixp, & strax_file, strax_data, & field_loc_center, field_type_vector) - call read_clim_data (readm, 0, ixm, month, ixp, & + call read_clim_data (readm, 0, ixm, mmonth, ixp, & stray_file, stray_data, & field_loc_center, field_type_vector) @@ -3295,7 +3425,7 @@ subroutine monthly_data enddo ! iblk !$OMP END PARALLEL DO - if (dbug) then + if (forcing_diag) then if (my_task == master_task) write (nu_diag,*) 'LY_bulk_data' vmin = global_minval(fsw,distrb_info,tmask) vmax = global_maxval(fsw,distrb_info,tmask) @@ -3330,7 +3460,7 @@ subroutine monthly_data if (my_task.eq.master_task) & write (nu_diag,*) 'Qa',vmin,vmax - endif ! dbug + endif ! forcing_diag end subroutine monthly_data @@ -3377,6 +3507,8 @@ subroutine oned_data character(len=*), parameter :: subname = '(oned_data)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + diag = .false. ! write diagnostic information if (trim(atm_data_format) == 'nc') then ! read nc file @@ -3452,6 +3584,8 @@ subroutine oned_files character(len=*), parameter :: subname = '(oned_files)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + fsw_file = & trim(atm_data_dir)//'/hourlysolar_brw1989_5yr.nc' @@ -3517,6 +3651,8 @@ subroutine ocn_data_clim (dt) character(len=*), parameter :: subname = '(ocn_data_clim)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + if (my_task == master_task .and. istep == 1) then if (trim(ocn_data_type)=='clim') then write (nu_diag,*) ' ' @@ -3540,12 +3676,12 @@ subroutine ocn_data_clim (dt) if (trim(ocn_data_type)=='clim') then midmonth = 15 ! data is given on 15th of every month -!!! midmonth = fix(p5 * real(daymo(month))) ! exact middle +!!! midmonth = fix(p5 * real(daymo(mmonth))) ! exact middle ! Compute record numbers for surrounding months maxrec = 12 - ixm = mod(month+maxrec-2,maxrec) + 1 - ixp = mod(month, maxrec) + 1 + ixm = mod(mmonth+maxrec-2,maxrec) + 1 + ixp = mod(mmonth, maxrec) + 1 if (mday >= midmonth) ixm = -99 ! other two points will be used if (mday < midmonth) ixp = -99 @@ -3561,14 +3697,14 @@ subroutine ocn_data_clim (dt) call interp_coeff_monthly (recslot) readm = .false. - if (istep==1 .or. (mday==midmonth .and. sec==0)) readm = .true. + if (istep==1 .or. (mday==midmonth .and. msec==0)) readm = .true. !------------------------------------------------------------------- ! Read two monthly SSS values and interpolate. ! Note: SSS is restored instantaneously to data. !------------------------------------------------------------------- - call read_clim_data (readm, 0, ixm, month, ixp, & + call read_clim_data (readm, 0, ixm, mmonth, ixp, & sss_file, sss_data, & field_loc_center, field_type_scalar) call interpolate_data (sss_data, sss) @@ -3592,7 +3728,7 @@ subroutine ocn_data_clim (dt) !------------------------------------------------------------------- if (trim(ocn_data_type)=='clim') then - call read_clim_data (readm, 0, ixm, month, ixp, & + call read_clim_data (readm, 0, ixm, mmonth, ixp, & sst_file, sst_data, & field_loc_center, field_type_scalar) call interpolate_data (sst_data, sstdat) @@ -3673,6 +3809,8 @@ subroutine ocn_data_ncar_init character(len=*), parameter :: subname = '(ocn_data_ncar_init)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + if (my_task == master_task) then write (nu_diag,*) 'WARNING: evp_prep calculates surface tilt' @@ -3722,13 +3860,14 @@ subroutine ocn_data_ncar_init do m=1,12 ! Note: netCDF does single to double conversion if necessary - if (n >= 4 .and. n <= 7) then - call ice_read_nc(fid, m, vname(n), work1, dbug, & - field_loc_NEcorner, field_type_vector) - else - call ice_read_nc(fid, m, vname(n), work1, dbug, & +! if (n >= 4 .and. n <= 7) then +! call ice_read_nc(fid, m, vname(n), work1, forcing_diag, & +! field_loc_NEcorner, field_type_vector) +! else + call ice_read_nc(fid, m, vname(n), work1, forcing_diag, & field_loc_center, field_type_scalar) - endif +! endif + ocn_frc_m(:,:,:,n,m) = work1(:,:,:) enddo ! month loop @@ -3750,10 +3889,10 @@ subroutine ocn_data_ncar_init do m=1,12 nrec = nrec + 1 if (n >= 4 .and. n <= 7) then - call ice_read (nu_forcing, nrec, work1, 'rda8', dbug, & + call ice_read (nu_forcing, nrec, work1, 'rda8', forcing_diag, & field_loc_NEcorner, field_type_vector) else - call ice_read (nu_forcing, nrec, work1, 'rda8', dbug, & + call ice_read (nu_forcing, nrec, work1, 'rda8', forcing_diag, & field_loc_center, field_type_scalar) endif ocn_frc_m(:,:,:,n,m) = work1(:,:,:) @@ -3764,8 +3903,8 @@ subroutine ocn_data_ncar_init endif !echmod - currents cause Fram outflow to be too large - ocn_frc_m(:,:,:,4,:) = c0 - ocn_frc_m(:,:,:,5,:) = c0 +! ocn_frc_m(:,:,:,4,:) = c0 +! ocn_frc_m(:,:,:,5,:) = c0 !echmod end subroutine ocn_data_ncar_init @@ -3830,6 +3969,8 @@ subroutine ocn_data_ncar_init_3D character(len=*), parameter :: subname = '(ocn_data_ncar_init_3D)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + if (my_task == master_task) then write (nu_diag,*) 'WARNING: evp_prep calculates surface tilt' @@ -3882,10 +4023,10 @@ subroutine ocn_data_ncar_init_3D ! Note: netCDF does single to double conversion if necessary if (n == 4 .or. n == 5) then ! 3D currents nzlev = 1 ! surface currents - call ice_read_nc_uv(fid, m, nzlev, vname(n), work1, dbug, & + call ice_read_nc_uv(fid, m, nzlev, vname(n), work1, forcing_diag, & field_loc_center, field_type_scalar) else - call ice_read_nc(fid, m, vname(n), work1, dbug, & + call ice_read_nc(fid, m, vname(n), work1, forcing_diag, & field_loc_center, field_type_scalar) endif @@ -3967,6 +4108,8 @@ subroutine ocn_data_ncar(dt) character(len=*), parameter :: subname = '(ocn_data_ncar)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + !------------------------------------------------------------------- ! monthly data ! @@ -3975,12 +4118,12 @@ subroutine ocn_data_ncar(dt) !------------------------------------------------------------------- midmonth = 15 ! data is given on 15th of every month -! midmonth = fix(p5 * real(daymo(month),kind=dbl_kind)) ! exact middle +! midmonth = fix(p5 * real(daymo(mmonth),kind=dbl_kind)) ! exact middle ! Compute record numbers for surrounding months maxrec = 12 - ixm = mod(month+maxrec-2,maxrec) + 1 - ixp = mod(month, maxrec) + 1 + ixm = mod(mmonth+maxrec-2,maxrec) + 1 + ixp = mod(mmonth, maxrec) + 1 if (mday >= midmonth) ixm = -99 ! other two points will be used if (mday < midmonth) ixp = -99 @@ -3995,19 +4138,18 @@ subroutine ocn_data_ncar(dt) ! Find interpolation coefficients call interp_coeff_monthly (recslot) + sst_data(:,:,:,:) = c0 do n = nfld, 1, -1 - !$OMP PARALLEL DO PRIVATE(iblk,i,j) do iblk = 1, nblocks ! use sst_data arrays as temporary work space until n=1 if (ixm /= -99) then ! first half of month sst_data(:,:,1,iblk) = ocn_frc_m(:,:,iblk,n,ixm) - sst_data(:,:,2,iblk) = ocn_frc_m(:,:,iblk,n,month) + sst_data(:,:,2,iblk) = ocn_frc_m(:,:,iblk,n,mmonth) else ! second half of month - sst_data(:,:,1,iblk) = ocn_frc_m(:,:,iblk,n,month) + sst_data(:,:,1,iblk) = ocn_frc_m(:,:,iblk,n,mmonth) sst_data(:,:,2,iblk) = ocn_frc_m(:,:,iblk,n,ixp) endif enddo - !$OMP END PARALLEL DO call interpolate_data (sst_data,work1) ! masking by hm is necessary due to NaNs in the data file @@ -4023,7 +4165,7 @@ subroutine ocn_data_ncar(dt) do iblk = 1, nblocks if (hm(i,j,iblk) == c1) then if (n == 2) sss (i,j,iblk) = work1(i,j,iblk) - if (n == 3) hmix (i,j,iblk) = work1(i,j,iblk) + if (n == 3) hmix (i,j,iblk) = max(mixed_layer_depth_default,work1(i,j,iblk)) if (n == 4) uocn (i,j,iblk) = work1(i,j,iblk) if (n == 5) vocn (i,j,iblk) = work1(i,j,iblk) if (n == 6) ss_tltx(i,j,iblk) = work1(i,j,iblk) @@ -4071,7 +4213,7 @@ subroutine ocn_data_ncar(dt) !$OMP END PARALLEL DO endif - if (dbug) then + if (forcing_diag) then if (my_task == master_task) & write (nu_diag,*) 'ocn_data_ncar' vmin = global_minval(Tf,distrb_info,tmask) @@ -4125,6 +4267,8 @@ subroutine ocn_data_oned character(len=*), parameter :: subname = '(ocn_data_oned)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + sss (:,:,:) = 34.0_dbl_kind ! sea surface salinity (ppt) call ocn_freezing_temperature @@ -4136,7 +4280,7 @@ subroutine ocn_data_oned ss_tlty(:,:,:) = c0 frzmlt (:,:,:) = c0 ! freezing/melting potential (W/m^2) qdp (:,:,:) = c0 ! deep ocean heat flux (W/m^2) - hmix (:,:,:) = c20 ! ocean mixed layer depth + hmix (:,:,:) = mixed_layer_depth_default ! ocean mixed layer depth end subroutine ocn_data_oned @@ -4180,6 +4324,8 @@ subroutine ocn_data_hadgem(dt) character(len=*), parameter :: subname = '(ocn_data_hadgem)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + !------------------------------------------------------------------- ! monthly data ! @@ -4188,12 +4334,12 @@ subroutine ocn_data_hadgem(dt) !------------------------------------------------------------------- midmonth = 15 ! data is given on 15th of every month -! midmonth = fix(p5 * real(daymo(month))) ! exact middle +! midmonth = fix(p5 * real(daymo(mmonth))) ! exact middle ! Compute record numbers for surrounding months maxrec = 12 - ixm = mod(month+maxrec-2,maxrec) + 1 - ixp = mod(month, maxrec) + 1 + ixm = mod(mmonth+maxrec-2,maxrec) + 1 + ixp = mod(mmonth, maxrec) + 1 if (mday >= midmonth) ixm = -99 ! other two points will be used if (mday < midmonth) ixp = -99 @@ -4210,7 +4356,7 @@ subroutine ocn_data_hadgem(dt) ! Read 2 monthly values readm = .false. - if (istep==1 .or. (mday==midmonth .and. sec==0)) readm = .true. + if (istep==1 .or. (mday==midmonth .and. msec==0)) readm = .true. if (my_task == master_task .and. istep == 1) then write (nu_diag,*) ' ' @@ -4231,7 +4377,7 @@ subroutine ocn_data_hadgem(dt) ! ----------------------------------------------------------- sst_file = trim(ocn_data_dir)//'/MONTHLY/sst.1997.nc' fieldname='sst' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, sst_file, fieldname, sst_data, & field_loc_center, field_type_scalar) @@ -4265,7 +4411,7 @@ subroutine ocn_data_hadgem(dt) filename = trim(ocn_data_dir)//'/MONTHLY/uocn.1997.nc' fieldname='uocn' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, filename, fieldname, uocn_data, & field_loc_center, field_type_vector) @@ -4274,7 +4420,7 @@ subroutine ocn_data_hadgem(dt) filename = trim(ocn_data_dir)//'/MONTHLY/vocn.1997.nc' fieldname='vocn' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, filename, fieldname, vocn_data, & field_loc_center, field_type_vector) @@ -4334,6 +4480,10 @@ subroutine ocn_data_hycom_init character (char_len) :: & fieldname ! field name in netcdf file + character(len=*), parameter :: subname = '(ocn_data_hycom_init)' + + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + if (trim(ocn_data_type) == 'hycom') then sss_file = trim(ocn_data_dir)//'ice.restart.surf.nc' @@ -4344,7 +4494,7 @@ subroutine ocn_data_hycom_init fieldname = 'sss' call ice_open_nc (sss_file, fid) - call ice_read_nc (fid, 1 , fieldname, sss, dbug, & + call ice_read_nc (fid, 1 , fieldname, sss, forcing_diag, & field_loc_center, field_type_scalar) call ice_close_nc(fid) @@ -4359,7 +4509,7 @@ subroutine ocn_data_hycom_init fieldname = 'sst' call ice_open_nc (sst_file, fid) - call ice_read_nc (fid, 1 , fieldname, sst, dbug, & + call ice_read_nc (fid, 1 , fieldname, sst, forcing_diag, & field_loc_center, field_type_scalar) call ice_close_nc(fid) @@ -4387,6 +4537,9 @@ subroutine hycom_atm_files fid ! File id character (char_len) :: & varname ! variable name in netcdf file + character(len=*), parameter :: subname = '(hycom_atm_files)' + + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' fsw_file = trim(atm_data_dir)//'/forcing.shwflx.nc' flw_file = trim(atm_data_dir)//'/forcing.radflx.nc' @@ -4430,7 +4583,6 @@ subroutine hycom_atm_data use ice_flux, only: fsw, fsnow, Tair, uatm, vatm, Qa, flw use ice_domain, only: nblocks - use ice_calendar, only: year_init integer (kind=int_kind) :: & recnum ! record number @@ -4450,11 +4602,13 @@ subroutine hycom_atm_data character(len=*), parameter :: subname = '(hycom_atm_data)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(Tffresh_out=Tffresh) call icepack_query_parameters(secday_out=secday) - ! current time in HYCOM jday units - hcdate = hc_jday(nyr+year_init-1,0,0)+ yday+sec/secday + ! current time in HYCOM jday units (HYCOM ref year: 1900,12,31,000000) + hcdate = real(compute_days_between(1900,12,31,myear,mmonth,mday)) + msec/secday ! Init recnum try recnum=min(max(oldrecnum,1),Njday_atm-1) @@ -4477,7 +4631,7 @@ subroutine hycom_atm_data write (nu_diag,*) & 'ERROR: CICE: Atm forcing not available at hcdate =',hcdate write (nu_diag,*) & - 'ERROR: CICE: nyr, year_init, yday ,sec = ',nyr, year_init, yday, sec + 'ERROR: CICE: myear, yday ,msec = ',myear, yday, msec call abort_ice ('ERROR: CICE stopped') endif @@ -4528,7 +4682,7 @@ subroutine hycom_atm_data endif ! Interpolate - if (dbug) then + if (forcing_diag) then if (my_task == master_task) then write(nu_diag,*)'CICE: Atm. interpolate: = ',& hcdate,c1intp,c2intp @@ -4581,7 +4735,7 @@ subroutine read_data_nc_point (flag, recd, yr, ixm, ixx, ixp, & ! data is missing, and we assume periodicity when monthly data ! is missing. ! - use ice_diagnostics, only: check_step + use ice_diagnostics, only: debug_model_step logical (kind=log_kind), intent(in) :: flag @@ -4605,8 +4759,6 @@ subroutine read_data_nc_point (flag, recd, yr, ixm, ixx, ixp, & real (kind=dbl_kind), dimension(2), intent(inout) :: & field_data ! 2 values needed for interpolation - character(len=*), parameter :: subname = '(read_data_nc_point)' - integer (kind=int_kind) :: & nrec , & ! record number to read n2, n4 , & ! like ixm and ixp, but @@ -4614,13 +4766,17 @@ subroutine read_data_nc_point (flag, recd, yr, ixm, ixx, ixp, & arg , & ! value of time argument in field_data fid ! file id for netCDF routines + character(len=*), parameter :: subname = '(read_data_nc_point)' + + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call ice_timer_start(timer_readwrite) ! reading/writing field_data = c0 ! to satisfy intent(out) attribute - if (istep1 > check_step) dbug = .true. !! debugging + if (istep1 > debug_model_step) forcing_diag = .true. !! debugging - if (my_task==master_task .and. (dbug)) then + if (my_task==master_task .and. (forcing_diag)) then write(nu_diag,*) ' ', trim(data_file) endif @@ -4667,7 +4823,7 @@ subroutine read_data_nc_point (flag, recd, yr, ixm, ixx, ixp, & nrec = recd + n2 call ice_read_nc & - (fid, nrec, fieldname, field_data(arg), dbug, & + (fid, nrec, fieldname, field_data(arg), forcing_diag, & field_loc, field_type) !if (ixx==1) call ice_close_nc(fid) @@ -4682,7 +4838,7 @@ subroutine read_data_nc_point (flag, recd, yr, ixm, ixx, ixp, & nrec = recd + ixx call ice_read_nc & - (fid, nrec, fieldname, field_data(arg), dbug, & + (fid, nrec, fieldname, field_data(arg), forcing_diag, & field_loc, field_type) if (ixp /= -99) then @@ -4708,7 +4864,7 @@ subroutine read_data_nc_point (flag, recd, yr, ixm, ixx, ixp, & nrec = recd + n4 call ice_read_nc & - (fid, nrec, fieldname, field_data(arg), dbug, & + (fid, nrec, fieldname, field_data(arg), forcing_diag, & field_loc, field_type) endif ! ixp /= -99 @@ -4726,6 +4882,8 @@ subroutine ISPOL_files character(len=*), parameter :: subname = '(ISPOL_files)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + fsw_file = & trim(atm_data_dir)//'/fsw_sfc_4Xdaily.nc' @@ -4817,6 +4975,8 @@ subroutine ISPOL_data character(len=*), parameter :: subname = '(ISPOL_data)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(secday_out=secday) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -4914,7 +5074,7 @@ subroutine ISPOL_data maxrec = 1460 ! 366*4 ! current record number - recnum4X = 4*int(yday) - 3 + int(real(sec,kind=dbl_kind)/sec1hr) + recnum4X = 4*int(yday) - 3 + int(real(msec,kind=dbl_kind)/sec1hr) ! Compute record numbers for surrounding data (2 on each side) ixm = mod(recnum4X+maxrec-2,maxrec) + 1 @@ -5015,6 +5175,8 @@ subroutine ocn_data_ispol_init character(len=*), parameter :: subname = '(ocn_data_ispol_init)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + if (my_task == master_task) then if (restore_ocn) write (nu_diag,*) & @@ -5040,10 +5202,10 @@ subroutine ocn_data_ispol_init do m=1,12 ! Note: netCDF does single to double conversion if necessary if (n >= 4 .and. n <= 7) then - call ice_read_nc(fid, m, vname(n), work, dbug, & + call ice_read_nc(fid, m, vname(n), work, forcing_diag, & field_loc_NEcorner, field_type_vector) else - call ice_read_nc(fid, m, vname(n), work, dbug, & + call ice_read_nc(fid, m, vname(n), work, forcing_diag, & field_loc_center, field_type_scalar) endif ocn_frc_m(:,:,:,n,m) = work @@ -5074,6 +5236,7 @@ subroutine box2001_data use ice_domain, only: nblocks use ice_domain_size, only: max_blocks + use ice_calendar, only: timesecs use ice_blocks, only: nx_block, ny_block, nghost use ice_flux, only: uocn, vocn, uatm, vatm, wind, rhoa, strax, stray use ice_grid, only: uvm, to_ugrid @@ -5089,6 +5252,11 @@ subroutine box2001_data real (kind=dbl_kind) :: & secday, pi , puny, period, pi2, tau + + character(len=*), parameter :: subname = '(box2001_data)' + + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(pi_out=pi, pi2_out=pi2, puny_out=puny) call icepack_query_parameters(secday_out=secday) @@ -5111,12 +5279,12 @@ subroutine box2001_data vocn(i,j,iblk) = vocn(i,j,iblk) * uvm(i,j,iblk) ! wind components - uatm(i,j,iblk) = c5 + (sin(pi2*time/period)-c3) & + uatm(i,j,iblk) = c5 + (sin(pi2*timesecs/period)-c3) & * sin(pi2*real(i-nghost, kind=dbl_kind) & /real(nx_global,kind=dbl_kind)) & * sin(pi *real(j-nghost, kind=dbl_kind) & /real(ny_global,kind=dbl_kind)) - vatm(i,j,iblk) = c5 + (sin(pi2*time/period)-c3) & + vatm(i,j,iblk) = c5 + (sin(pi2*timesecs/period)-c3) & * sin(pi *real(i-nghost, kind=dbl_kind) & /real(nx_global,kind=dbl_kind)) & * sin(pi2*real(j-nghost, kind=dbl_kind) & @@ -5180,6 +5348,8 @@ subroutine get_wave_spec logical (kind=log_kind) :: wave_spec character(len=*), parameter :: subname = '(get_wave_spec)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call ice_timer_start(timer_fsd) call icepack_query_parameters(wave_spec_out=wave_spec, & @@ -5191,7 +5361,7 @@ subroutine get_wave_spec ! if no wave data is provided, wave_spectrum is zero everywhere wave_spectrum(:,:,:,:) = c0 wave_spec_dir = ocn_data_dir - dbug = .false. + forcing_diag = .false. ! wave spectrum and frequencies if (wave_spec) then @@ -5209,7 +5379,7 @@ subroutine get_wave_spec else #ifdef USE_NETCDF call ice_open_nc(wave_spec_file,fid) - call ice_read_nc_xyf (fid, 1, 'efreq', wave_spectrum(:,:,:,:), dbug, & + call ice_read_nc_xyf (fid, 1, 'efreq', wave_spectrum(:,:,:,:), forcing_diag, & field_loc_center, field_type_scalar) call ice_close_nc(fid) #else diff --git a/cicecore/cicedynB/general/ice_forcing_bgc.F90 b/cicecore/cicedynB/general/ice_forcing_bgc.F90 index e5ef851fa..d9408c304 100644 --- a/cicecore/cicedynB/general/ice_forcing_bgc.F90 +++ b/cicecore/cicedynB/general/ice_forcing_bgc.F90 @@ -14,7 +14,7 @@ module ice_forcing_bgc use ice_blocks, only: nx_block, ny_block use ice_domain_size, only: max_blocks use ice_communicate, only: my_task, master_task - use ice_calendar, only: dt, istep, sec, mday, month + use ice_calendar, only: dt, istep, msec, mday, mmonth use ice_fileunits, only: nu_diag use ice_arrays_column, only: restore_bgc, & bgc_data_dir, fe_data_type @@ -163,12 +163,12 @@ subroutine get_forcing_bgc !------------------------------------------------------------------- midmonth = 15 ! data is given on 15th of every month -!!! midmonth = fix(p5 * real(daymo(month))) ! exact middle +!!! midmonth = fix(p5 * real(daymo(mmonth))) ! exact middle ! Compute record numbers for surrounding months maxrec = 12 - ixm = mod(month+maxrec-2,maxrec) + 1 - ixp = mod(month, maxrec) + 1 + ixm = mod(mmonth+maxrec-2,maxrec) + 1 + ixp = mod(mmonth, maxrec) + 1 if (mday >= midmonth) ixm = -99 ! other two points will be used if (mday < midmonth) ixp = -99 @@ -184,7 +184,7 @@ subroutine get_forcing_bgc call interp_coeff_monthly (recslot) readm = .false. - if (istep==1 .or. (mday==midmonth .and. sec==0)) readm = .true. + if (istep==1 .or. (mday==midmonth .and. msec==0)) readm = .true. endif ! 'clim prep' @@ -194,11 +194,11 @@ subroutine get_forcing_bgc !------------------------------------------------------------------- if (trim(bgc_data_type)=='clim' .AND. tr_bgc_Sil) then - ! call read_clim_data (readm, 0, ixm, month, ixp, & + ! call read_clim_data (readm, 0, ixm, mmonth, ixp, & ! sil_file, sil_data, & ! field_loc_center, field_type_scalar) fieldname = 'silicate' - call read_clim_data_nc (readm, 0, ixm, month, ixp, & + call read_clim_data_nc (readm, 0, ixm, mmonth, ixp, & sil_file, fieldname, sil_data, & field_loc_center, field_type_scalar) call interpolate_data (sil_data, sildat) @@ -276,11 +276,11 @@ subroutine get_forcing_bgc !------------------------------------------------------------------- if (trim(bgc_data_type)=='clim' .AND. tr_bgc_Nit) then - ! call read_clim_data (readm, 0, ixm, month, ixp, & + ! call read_clim_data (readm, 0, ixm, mmonth, ixp, & ! nit_file, nit_data, & ! field_loc_center, field_type_scalar) fieldname = 'nitrate' - call read_clim_data_nc (readm, 0, ixm, month, ixp, & + call read_clim_data_nc (readm, 0, ixm, mmonth, ixp, & nit_file, fieldname, nit_data, & field_loc_center, field_type_scalar) call interpolate_data (nit_data, nitdat) @@ -584,7 +584,7 @@ end subroutine faero_default subroutine faero_data - use ice_calendar, only: month, mday, istep, sec + use ice_calendar, only: mmonth, mday, istep, msec use ice_domain_size, only: max_blocks use ice_blocks, only: nx_block, ny_block use ice_flux_bgc, only: faero_atm @@ -625,12 +625,12 @@ subroutine faero_data !------------------------------------------------------------------- midmonth = 15 ! data is given on 15th of every month -! midmonth = fix(p5 * real(daymo(month))) ! exact middle +! midmonth = fix(p5 * real(daymo(mmonth))) ! exact middle ! Compute record numbers for surrounding months maxrec = 12 - ixm = mod(month+maxrec-2,maxrec) + 1 - ixp = mod(month, maxrec) + 1 + ixm = mod(mmonth+maxrec-2,maxrec) + 1 + ixp = mod(mmonth, maxrec) + 1 if (mday >= midmonth) ixm = 99 ! other two points will be used if (mday < midmonth) ixp = 99 @@ -647,23 +647,23 @@ subroutine faero_data ! Read 2 monthly values readm = .false. - if (istep==1 .or. (mday==midmonth .and. sec==0)) readm = .true. + if (istep==1 .or. (mday==midmonth .and. msec==0)) readm = .true. ! aero_file = trim(atm_data_dir)//'faero.nc' aero_file = '/usr/projects/climate/eclare/DATA/gx1v3/faero.nc' fieldname='faero_atm001' - call read_clim_data_nc (readm, 0, ixm, month, ixp, & + call read_clim_data_nc (readm, 0, ixm, mmonth, ixp, & aero_file, fieldname, aero1_data, & field_loc_center, field_type_scalar) fieldname='faero_atm002' - call read_clim_data_nc (readm, 0, ixm, month, ixp, & + call read_clim_data_nc (readm, 0, ixm, mmonth, ixp, & aero_file, fieldname, aero2_data, & field_loc_center, field_type_scalar) fieldname='faero_atm003' - call read_clim_data_nc (readm, 0, ixm, month, ixp, & + call read_clim_data_nc (readm, 0, ixm, mmonth, ixp, & aero_file, fieldname, aero3_data, & field_loc_center, field_type_scalar) @@ -727,12 +727,12 @@ subroutine fzaero_data !------------------------------------------------------------------- midmonth = 15 ! data is given on 15th of every month -! midmonth = fix(p5 * real(daymo(month))) ! exact middle +! midmonth = fix(p5 * real(daymo(mmonth))) ! exact middle ! Compute record numbers for surrounding months maxrec = 12 - ixm = mod(month+maxrec-2,maxrec) + 1 - ixp = mod(month, maxrec) + 1 + ixm = mod(mmonth+maxrec-2,maxrec) + 1 + ixp = mod(mmonth, maxrec) + 1 if (mday >= midmonth) ixm = -99 ! other two points will be used if (mday < midmonth) ixp = -99 @@ -749,14 +749,14 @@ subroutine fzaero_data ! Read 2 monthly values readm = .false. - if (istep==1 .or. (mday==midmonth .and. sec==0)) readm = .true. + if (istep==1 .or. (mday==midmonth .and. msec==0)) readm = .true. ! aero_file = trim(atm_data_dir)//'faero.nc' ! Cam5 monthly total black carbon deposition on the gx1 grid" aero_file = '/usr/projects/climate/njeffery/DATA/CAM/Hailong_Wang/Cam5_bc_monthly_popgrid.nc' fieldname='bcd' - call read_clim_data_nc (readm, 0, ixm, month, ixp, & + call read_clim_data_nc (readm, 0, ixm, mmonth, ixp, & aero_file, fieldname, aero_data, & field_loc_center, field_type_scalar) diff --git a/cicecore/cicedynB/general/ice_init.F90 b/cicecore/cicedynB/general/ice_init.F90 index b59a93862..5e5fd144f 100644 --- a/cicecore/cicedynB/general/ice_init.F90 +++ b/cicecore/cicedynB/general/ice_init.F90 @@ -58,16 +58,18 @@ module ice_init subroutine input_data use ice_broadcast, only: broadcast_scalar, broadcast_array - use ice_diagnostics, only: diag_file, print_global, print_points, latpnt, lonpnt + use ice_diagnostics, only: diag_file, print_global, print_points, latpnt, lonpnt, & + debug_model, debug_model_step use ice_domain, only: close_boundaries, orca_halogrid use ice_domain_size, only: ncat, nilyr, nslyr, nblyr, nfsd, nfreq, & n_iso, n_aero, n_zaero, n_algae, & n_doc, n_dic, n_don, n_fed, n_fep, & max_nstrm - use ice_calendar, only: year_init, istep0, histfreq, histfreq_n, & + use ice_calendar, only: year_init, month_init, day_init, sec_init, & + istep0, histfreq, histfreq_n, & dumpfreq, dumpfreq_n, diagfreq, & npt, dt, ndtd, days_per_year, use_leap_years, & - write_ic, dump_last + write_ic, dump_last, npt_unit use ice_arrays_column, only: oceanmixed_ice use ice_restart_column, only: restart_age, restart_FY, restart_lvl, & restart_pond_cesm, restart_pond_lvl, restart_pond_topo, restart_aero, & @@ -82,7 +84,7 @@ subroutine input_data use ice_flux, only: default_season use ice_flux_bgc, only: cpl_bgc use ice_forcing, only: & - ycycle, fyear_init, dbug, & + ycycle, fyear_init, forcing_diag, & atm_data_type, atm_data_dir, precip_units, rotate_wind, & atm_data_format, ocn_data_format, & bgc_data_type, & @@ -125,7 +127,7 @@ subroutine input_data mu_rdg, hs0, dpscale, rfracmin, rfracmax, pndaspect, hs1, hp1, & a_rapid_mode, Rac_rapid_mode, aspect_rapid_mode, dSdt_slow_mode, & phi_c_slow_mode, phi_i_mushy, kalg, atmiter_conv, Pstar, Cstar, & - sw_frac, sw_dtemp, floediam, hfrazilmin + sw_frac, sw_dtemp, floediam, hfrazilmin, iceruf integer (kind=int_kind) :: ktherm, kstrength, krdg_partic, krdg_redist, natmiter, & kitd, kcatbound, ktransport @@ -154,7 +156,7 @@ subroutine input_data !----------------------------------------------------------------- namelist /setup_nml/ & - days_per_year, use_leap_years, year_init, istep0, & + days_per_year, use_leap_years, istep0, npt_unit, & dt, npt, ndtd, numin, & runtype, runid, bfbflag, numax, & ice_ic, restart, restart_dir, restart_file, & @@ -162,9 +164,10 @@ subroutine input_data pointer_file, dumpfreq, dumpfreq_n, dump_last, & diagfreq, diag_type, diag_file, history_format,& print_global, print_points, latpnt, lonpnt, & - dbug, histfreq, histfreq_n, hist_avg, & + forcing_diag, histfreq, histfreq_n, hist_avg, & history_dir, history_file, history_precision, cpl_bgc, & - conserv_check, & + conserv_check, debug_model, debug_model_step, & + year_init, month_init, day_init, sec_init, & write_ic, incond_dir, incond_file, version_name namelist /grid_nml/ & @@ -224,7 +227,7 @@ subroutine input_data namelist /forcing_nml/ & formdrag, atmbndy, calc_strair, calc_Tsfc, & highfreq, natmiter, atmiter_conv, & - ustar_min, emissivity, & + ustar_min, emissivity, iceruf, & fbot_xfer_type, update_ocn_f, l_mpond_fresh, tfrz_option, & oceanmixed_ice, restore_ice, restore_ocn, trestore, & precip_units, default_season, wave_spec_type,nfreq, & @@ -250,6 +253,9 @@ subroutine input_data days_per_year = 365 ! number of days in a year use_leap_years= .false.! if true, use leap years (Feb 29) year_init = 0 ! initial year + month_init = 1 ! initial month + day_init = 1 ! initial day + sec_init = 0 ! initial second istep0 = 0 ! no. of steps taken in previous integrations, ! real (dumped) or imagined (to set calendar) #ifndef CESMCOUPLED @@ -258,7 +264,10 @@ subroutine input_data numin = 11 ! min allowed unit number numax = 99 ! max allowed unit number npt = 99999 ! total number of time steps (dt) + npt_unit = '1' ! units of npt 'y', 'm', 'd', 's', '1' diagfreq = 24 ! how often diag output is written + debug_model = .false. ! debug output + debug_model_step = 999999999 ! debug model after this step number print_points = .false. ! if true, print point data print_global = .true. ! if true, print global diagnostic data bfbflag = 'off' ! off = optimized @@ -370,6 +379,7 @@ subroutine input_data calc_Tsfc = .true. ! calculate surface temperature update_ocn_f = .false. ! include fresh water and salt fluxes for frazil ustar_min = 0.005 ! minimum friction velocity for ocean heat flux (m/s) + iceruf = 0.0005_dbl_kind ! ice surface roughness at atmosphere interface (m) emissivity = 0.985 ! emissivity of snow and ice l_mpond_fresh = .false. ! logical switch for including meltpond freshwater ! flux feedback to ocean model @@ -426,7 +436,7 @@ subroutine input_data restore_ocn = .false. ! restore sst if true trestore = 90 ! restoring timescale, days (0 instantaneous) restore_ice = .false. ! restore ice state on grid edges if true - dbug = .false. ! true writes diagnostics for input forcing + forcing_diag = .false. ! true writes diagnostics for input forcing latpnt(1) = 90._dbl_kind ! latitude of diagnostic point 1 (deg) lonpnt(1) = 0._dbl_kind ! longitude of point 1 (deg) @@ -584,10 +594,16 @@ subroutine input_data call broadcast_scalar(days_per_year, master_task) call broadcast_scalar(use_leap_years, master_task) call broadcast_scalar(year_init, master_task) + call broadcast_scalar(month_init, master_task) + call broadcast_scalar(day_init, master_task) + call broadcast_scalar(sec_init, master_task) call broadcast_scalar(istep0, master_task) call broadcast_scalar(dt, master_task) call broadcast_scalar(npt, master_task) + call broadcast_scalar(npt_unit, master_task) call broadcast_scalar(diagfreq, master_task) + call broadcast_scalar(debug_model, master_task) + call broadcast_scalar(debug_model_step, master_task) call broadcast_scalar(print_points, master_task) call broadcast_scalar(print_global, master_task) call broadcast_scalar(bfbflag, master_task) @@ -722,6 +738,7 @@ subroutine input_data call broadcast_scalar(update_ocn_f, master_task) call broadcast_scalar(l_mpond_fresh, master_task) call broadcast_scalar(ustar_min, master_task) + call broadcast_scalar(iceruf, master_task) call broadcast_scalar(emissivity, master_task) call broadcast_scalar(fbot_xfer_type, master_task) call broadcast_scalar(precip_units, master_task) @@ -741,14 +758,12 @@ subroutine input_data call broadcast_scalar(restore_ocn, master_task) call broadcast_scalar(trestore, master_task) call broadcast_scalar(restore_ice, master_task) - call broadcast_scalar(dbug, master_task) + call broadcast_scalar(forcing_diag, master_task) call broadcast_array (latpnt(1:2), master_task) call broadcast_array (lonpnt(1:2), master_task) call broadcast_scalar(runid, master_task) call broadcast_scalar(runtype, master_task) - - if (dbug) & ! else only master_task writes to file - call broadcast_scalar(nu_diag, master_task) + !call broadcast_scalar(nu_diag, master_task) ! tracers call broadcast_scalar(tr_iage, master_task) @@ -1443,6 +1458,7 @@ subroutine input_data tmpstr2 = ' : four constant albedos' else tmpstr2 = ' : unknown value' + abort_list = trim(abort_list)//":23" endif write(nu_diag,1030) ' albedo_type = ', trim(albedo_type),trim(tmpstr2) if (trim(albedo_type) == 'ccsm3') then @@ -1469,6 +1485,7 @@ subroutine input_data write(nu_diag,1010) ' calc_strair = ', calc_strair,' : calculate wind stress and speed' write(nu_diag,1010) ' rotate_wind = ', rotate_wind,' : rotate wind/stress to computational grid' write(nu_diag,1010) ' formdrag = ', formdrag,' : use form drag parameterization' + write(nu_diag,1000) ' iceruf = ', iceruf, ' : ice surface roughness at atmosphere interface (m)' if (trim(atmbndy) == 'default') then tmpstr2 = ' : stability-based boundary layer' write(nu_diag,1010) ' highfreq = ', highfreq,' : high-frequency atmospheric coupling' @@ -1621,11 +1638,17 @@ subroutine input_data write(nu_diag,1031) ' runid = ', trim(runid) write(nu_diag,1031) ' runtype = ', trim(runtype) write(nu_diag,1021) ' year_init = ', year_init + write(nu_diag,1021) ' month_init = ', month_init + write(nu_diag,1021) ' day_init = ', day_init + write(nu_diag,1021) ' sec_init = ', sec_init write(nu_diag,1021) ' istep0 = ', istep0 + write(nu_diag,1031) ' npt_unit = ', trim(npt_unit) write(nu_diag,1021) ' npt = ', npt write(nu_diag,1021) ' diagfreq = ', diagfreq write(nu_diag,1011) ' print_global = ', print_global write(nu_diag,1011) ' print_points = ', print_points + write(nu_diag,1011) ' debug_model = ', debug_model + write(nu_diag,1022) ' debug_model_step = ', debug_model_step write(nu_diag,1031) ' bfbflag = ', trim(bfbflag) write(nu_diag,1021) ' numin = ', numin write(nu_diag,1021) ' numax = ', numax @@ -1785,7 +1808,7 @@ subroutine input_data wave_spec_type_in = wave_spec_type, & wave_spec_in=wave_spec, nfreq_in=nfreq, & tfrz_option_in=tfrz_option, kalg_in=kalg, fbot_xfer_type_in=fbot_xfer_type, & - Pstar_in=Pstar, Cstar_in=Cstar, & + Pstar_in=Pstar, Cstar_in=Cstar, iceruf_in=iceruf, & sw_redist_in=sw_redist, sw_frac_in=sw_frac, sw_dtemp_in=sw_dtemp) call icepack_init_tracer_flags(tr_iage_in=tr_iage, tr_FY_in=tr_FY, & tr_lvl_in=tr_lvl, tr_iso_in=tr_iso, tr_aero_in=tr_aero, & @@ -1806,6 +1829,7 @@ subroutine input_data 1011 format (a20,1x,l6) 1020 format (a20,8x,i6,1x,a) ! integer 1021 format (a20,1x,i6) + 1022 format (a20,1x,i12) 1023 format (a20,1x,6i6) 1030 format (a20,a14,1x,a) ! character 1031 format (a20,1x,a,a) diff --git a/cicecore/cicedynB/general/ice_step_mod.F90 b/cicecore/cicedynB/general/ice_step_mod.F90 index b21908e77..29bfdbf0e 100644 --- a/cicecore/cicedynB/general/ice_step_mod.F90 +++ b/cicecore/cicedynB/general/ice_step_mod.F90 @@ -12,7 +12,7 @@ module ice_step_mod use ice_kinds_mod - use ice_constants, only: c0, c1, c1000, c4 + use ice_constants, only: c0, c1, c1000, c4, p25 use ice_exit, only: abort_ice use ice_fileunits, only: nu_diag use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted @@ -189,18 +189,18 @@ subroutine step_therm1 (dt, iblk) use ice_prescribed_mod, only: prescribed_ice #else logical (kind=log_kind) :: & - prescribed_ice ! if .true., use prescribed ice instead of computed + prescribed_ice ! if .true., use prescribed ice instead of computed #endif real (kind=dbl_kind), intent(in) :: & - dt ! time step + dt ! time step (s) integer (kind=int_kind), intent(in) :: & - iblk ! block index + iblk ! block index ! local variables #ifdef CICE_IN_NEMO real (kind=dbl_kind) :: & - raice ! temporary reverse ice concentration + raice ! reciprocal of ice concentration #endif integer (kind=int_kind) :: & ilo,ihi,jlo,jhi, & ! beginning and end of physical domain @@ -215,24 +215,27 @@ subroutine step_therm1 (dt, iblk) logical (kind=log_kind) :: & tr_iage, tr_FY, tr_iso, tr_aero, tr_pond, tr_pond_cesm, & - tr_pond_lvl, tr_pond_topo, calc_Tsfc + tr_pond_lvl, tr_pond_topo, calc_Tsfc, highfreq real (kind=dbl_kind) :: & - puny + uvel_center, & ! cell-centered velocity, x component (m/s) + vvel_center, & ! cell-centered velocity, y component (m/s) + puny ! a very small number real (kind=dbl_kind), dimension(n_aero,2,ncat) :: & - aerosno, aeroice ! kg/m^2 + aerosno, aeroice ! kg/m^2 real (kind=dbl_kind), dimension(n_iso,ncat) :: & - isosno, isoice ! kg/m^2 + isosno, isoice ! kg/m^2 type (block) :: & - this_block ! block information for current block + this_block ! block information for current block character(len=*), parameter :: subname = '(step_therm1)' call icepack_query_parameters(puny_out=puny) call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc) + call icepack_query_parameters(highfreq_out=highfreq) call icepack_query_tracer_sizes(ntrcr_out=ntrcr) call icepack_query_tracer_flags( & tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_iso_out=tr_iso, & @@ -289,6 +292,16 @@ subroutine step_therm1 (dt, iblk) do j = jlo, jhi do i = ilo, ihi + if (highfreq) then ! include ice velocity in calculation of wind stress + uvel_center = p25*(uvel(i,j ,iblk) + uvel(i-1,j ,iblk) & ! cell-centered velocity + + uvel(i,j-1,iblk) + uvel(i-1,j-1,iblk)) ! assumes wind components + vvel_center = p25*(vvel(i,j ,iblk) + vvel(i-1,j ,iblk) & ! are also cell-centered + + vvel(i,j-1,iblk) + vvel(i-1,j-1,iblk)) + else + uvel_center = c0 ! not used + vvel_center = c0 + endif ! highfreq + if (tr_iso) then ! trcrn(nt_iso*) has units kg/m^3 do n=1,ncat do k=1,n_iso @@ -324,8 +337,8 @@ subroutine step_therm1 (dt, iblk) vicen = vicen (i,j,:,iblk), & vsno = vsno (i,j, iblk), & vsnon = vsnon (i,j,:,iblk), & - uvel = uvel (i,j, iblk), & - vvel = vvel (i,j, iblk), & + uvel = uvel_center , & + vvel = vvel_center , & Tsfc = trcrn (i,j,nt_Tsfc,:,iblk), & zqsn = trcrn (i,j,nt_qsno:nt_qsno+nslyr-1,:,iblk), & zqin = trcrn (i,j,nt_qice:nt_qice+nilyr-1,:,iblk), & @@ -1026,7 +1039,7 @@ subroutine step_radiation (dt, iblk) kaer_tab, waer_tab, gaer_tab, kaer_bc_tab, waer_bc_tab, & gaer_bc_tab, bcenh, swgrid, igrid use ice_blocks, only: block, get_block - use ice_calendar, only: calendar_type, days_per_year, nextsw_cday, yday, sec + use ice_calendar, only: calendar_type, days_per_year, nextsw_cday, yday, msec use ice_domain, only: blocks_ice use ice_domain_size, only: ncat, n_aero, nilyr, nslyr, n_zaero, n_algae, nblyr use ice_flux, only: swvdr, swvdf, swidr, swidf, coszen, fsnow @@ -1145,7 +1158,7 @@ subroutine step_radiation (dt, iblk) calendar_type=calendar_type, & days_per_year=days_per_year, & nextsw_cday=nextsw_cday, yday=yday, & - sec=sec, & + sec=msec, & kaer_tab=kaer_tab, kaer_bc_tab=kaer_bc_tab(:,:), & waer_tab=waer_tab, waer_bc_tab=waer_bc_tab(:,:), & gaer_tab=gaer_tab, gaer_bc_tab=gaer_bc_tab(:,:), & diff --git a/cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 b/cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 index 884ee6331..635bbbeb4 100644 --- a/cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 +++ b/cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 @@ -41,6 +41,7 @@ module ice_boundary type, public :: ice_halo integer (int_kind) :: & communicator, &! communicator to use for update messages + numLocalBlocks, &! number of local blocks, needed for halo fill numMsgSend, &! number of messages to send halo update numMsgRecv, &! number of messages to recv halo update numLocalCopies, &! num local copies for halo update @@ -50,6 +51,7 @@ module ice_boundary tripoleTFlag ! NS boundary is a tripole T-fold integer (int_kind), dimension(:), pointer :: & + blockGlobalID, &! list of local block global IDs, needed for halo fill recvTask, &! task from which to recv each msg sendTask, &! task to which to send each msg sizeSend, &! size of each sent message @@ -220,6 +222,13 @@ function ice_HaloCreate(dist, nsBoundaryType, ewBoundaryType, & cornerMsgSize = nghost*nghost tripoleRows = nghost+1 + !*** store some block info to fill haloes properly + call ice_distributionGet(dist, numLocalBlocks=halo%numLocalBlocks) + if (halo%numLocalBlocks > 0) then + allocate(halo%blockGlobalID(halo%numLocalBlocks)) + call ice_distributionGet(dist, blockGlobalID=halo%blockGlobalID) + endif + if (nsBoundaryType == 'tripole' .or. nsBoundaryType == 'tripoleT') then tripoleTFlag = (nsBoundaryType == 'tripoleT') if (tripoleTflag) tripoleRows = tripoleRows+1 @@ -1023,6 +1032,7 @@ subroutine ice_HaloMask(halo, basehalo, mask) communicator, &! communicator for message passing numMsgSend, numMsgRecv, &! number of messages for this halo numLocalCopies, &! num local copies for halo update + numLocalBlocks, &! num local blocks for halo fill tripoleRows, &! number of rows in tripole buffer lbufSizeSend, &! buffer size for send messages lbufSizeRecv ! buffer size for recv messages @@ -1043,6 +1053,7 @@ subroutine ice_HaloMask(halo, basehalo, mask) numMsgSend = basehalo%numMsgSend numMsgRecv = basehalo%numMsgRecv numLocalCopies = basehalo%numLocalCopies + numLocalBlocks = basehalo%numLocalBlocks lbufSizeSend = size(basehalo%sendAddr,dim=2) lbufSizeRecv = size(basehalo%recvAddr,dim=2) @@ -1056,6 +1067,7 @@ subroutine ice_HaloMask(halo, basehalo, mask) halo%recvAddr(3,lbufSizeRecv,numMsgRecv), & halo%srcLocalAddr(3,numLocalCopies), & halo%dstLocalAddr(3,numLocalCopies), & + halo%blockGlobalID(numLocalBlocks), & stat = istat) if (istat > 0) then @@ -1067,10 +1079,13 @@ subroutine ice_HaloMask(halo, basehalo, mask) halo%tripoleRows = tripoleRows halo%tripoleTFlag = tripoleTFlag halo%numLocalCopies = numLocalCopies + halo%numLocalBlocks = numLocalBlocks halo%srcLocalAddr = basehalo%srcLocalAddr(:,1:numLocalCopies) halo%dstLocalAddr = basehalo%dstLocalAddr(:,1:numLocalCopies) + halo%blockGlobalID = basehalo%blockGlobalID + numMsgSend = 0 do nmsg=1,basehalo%numMsgSend scnt = 0 @@ -1176,7 +1191,8 @@ subroutine ice_HaloUpdate2DR8(array, halo, & !----------------------------------------------------------------------- integer (int_kind) :: & - i,j,n,nmsg, &! dummy loop indices + i,j,n,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) iSrc,jSrc, &! source addresses for message @@ -1285,13 +1301,18 @@ subroutine ice_HaloUpdate2DR8(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:) = fill - array(1:nx_block,ny_block-j+1,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:) = fill - array(nx_block-i+1,1:ny_block,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,iblk) = fill + array(1:nx_block, jhi+j,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,iblk) = fill + array(ihi+i, 1:ny_block,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -1569,6 +1590,7 @@ subroutine ice_HaloUpdate2DR4(array, halo, & integer (int_kind) :: & i,j,n,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) iSrc,jSrc, &! source addresses for message @@ -1677,13 +1699,18 @@ subroutine ice_HaloUpdate2DR4(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:) = fill - array(1:nx_block,ny_block-j+1,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:) = fill - array(nx_block-i+1,1:ny_block,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,iblk) = fill + array(1:nx_block, jhi+j,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,iblk) = fill + array(ihi+i, 1:ny_block,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -1961,6 +1988,7 @@ subroutine ice_HaloUpdate2DI4(array, halo, & integer (int_kind) :: & i,j,n,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) iSrc,jSrc, &! source addresses for message @@ -2069,13 +2097,18 @@ subroutine ice_HaloUpdate2DI4(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:) = fill - array(1:nx_block,ny_block-j+1,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:) = fill - array(nx_block-i+1,1:ny_block,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,iblk) = fill + array(1:nx_block, jhi+j,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,iblk) = fill + array(ihi+i, 1:ny_block,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -2353,6 +2386,7 @@ subroutine ice_HaloUpdate3DR8(array, halo, & integer (int_kind) :: & i,j,k,n,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) nz, &! size of array in 3rd dimension @@ -2489,13 +2523,18 @@ subroutine ice_HaloUpdate3DR8(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:,:) = fill - array(1:nx_block,ny_block-j+1,:,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:,:) = fill - array(nx_block-i+1,1:ny_block,:,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,:,iblk) = fill + array(1:nx_block, jhi+j,:,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,:,iblk) = fill + array(ihi+i, 1:ny_block,:,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -2804,6 +2843,7 @@ subroutine ice_HaloUpdate3DR4(array, halo, & integer (int_kind) :: & i,j,k,n,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) nz, &! size of array in 3rd dimension @@ -2940,13 +2980,18 @@ subroutine ice_HaloUpdate3DR4(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:,:) = fill - array(1:nx_block,ny_block-j+1,:,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:,:) = fill - array(nx_block-i+1,1:ny_block,:,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,:,iblk) = fill + array(1:nx_block, jhi+j,:,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,:,iblk) = fill + array(ihi+i, 1:ny_block,:,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -3255,6 +3300,7 @@ subroutine ice_HaloUpdate3DI4(array, halo, & integer (int_kind) :: & i,j,k,n,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) nz, &! size of array in 3rd dimension @@ -3391,13 +3437,18 @@ subroutine ice_HaloUpdate3DI4(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:,:) = fill - array(1:nx_block,ny_block-j+1,:,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:,:) = fill - array(nx_block-i+1,1:ny_block,:,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,:,iblk) = fill + array(1:nx_block, jhi+j,:,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,:,iblk) = fill + array(ihi+i, 1:ny_block,:,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -3706,6 +3757,7 @@ subroutine ice_HaloUpdate4DR8(array, halo, & integer (int_kind) :: & i,j,k,l,n,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) nz, nt, &! size of array in 3rd,4th dimensions @@ -3846,13 +3898,18 @@ subroutine ice_HaloUpdate4DR8(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:,:,:) = fill - array(1:nx_block,ny_block-j+1,:,:,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:,:,:) = fill - array(nx_block-i+1,1:ny_block,:,:,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,:,:,iblk) = fill + array(1:nx_block, jhi+j,:,:,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,:,:,iblk) = fill + array(ihi+i, 1:ny_block,:,:,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -4181,6 +4238,7 @@ subroutine ice_HaloUpdate4DR4(array, halo, & integer (int_kind) :: & i,j,k,l,n,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) nz, nt, &! size of array in 3rd,4th dimensions @@ -4321,13 +4379,18 @@ subroutine ice_HaloUpdate4DR4(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:,:,:) = fill - array(1:nx_block,ny_block-j+1,:,:,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:,:,:) = fill - array(nx_block-i+1,1:ny_block,:,:,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,:,:,iblk) = fill + array(1:nx_block, jhi+j,:,:,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,:,:,iblk) = fill + array(ihi+i, 1:ny_block,:,:,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -4656,6 +4719,7 @@ subroutine ice_HaloUpdate4DI4(array, halo, & integer (int_kind) :: & i,j,k,l,n,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) nz, nt, &! size of array in 3rd,4th dimensions @@ -4796,13 +4860,18 @@ subroutine ice_HaloUpdate4DI4(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:,:,:) = fill - array(1:nx_block,ny_block-j+1,:,:,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:,:,:) = fill - array(nx_block-i+1,1:ny_block,:,:,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,:,:,iblk) = fill + array(1:nx_block, jhi+j,:,:,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,:,:,iblk) = fill + array(ihi+i, 1:ny_block,:,:,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -5232,13 +5301,18 @@ subroutine ice_HaloUpdate_stress(array1, array2, halo, & ! the tripole zipper as needed for stresses. if you zero ! it out, all halo values will be wiped out. !----------------------------------------------------------------------- -! do j = 1,nghost -! array1(1:nx_block, j,:) = fill -! array1(1:nx_block,ny_block-j+1,:) = fill -! enddo -! do i = 1,nghost -! array1(i, 1:ny_block,:) = fill -! array1(nx_block-i+1,1:ny_block,:) = fill +! do iblk = 1, halo%numLocalBlocks +! call get_block_parameter(halo%blockGlobalID(iblk), & +! ilo=ilo, ihi=ihi, & +! jlo=jlo, jhi=jhi) +! do j = 1,nghost +! array(1:nx_block, jlo-j,iblk) = fill +! array(1:nx_block, jhi+j,iblk) = fill +! enddo +! do i = 1,nghost +! array(ilo-i, 1:ny_block,iblk) = fill +! array(ihi+i, 1:ny_block,iblk) = fill +! enddo ! enddo !----------------------------------------------------------------------- @@ -6715,20 +6789,20 @@ subroutine ice_HaloDestroy(halo) character(len=*), parameter :: subname = '(ice_HaloDestroy)' !----------------------------------------------------------------------- - deallocate(halo%sendTask, stat=istat) - deallocate(halo%recvTask, stat=istat) - deallocate(halo%sizeSend, stat=istat) - deallocate(halo%sizeRecv, stat=istat) - deallocate(halo%tripSend, stat=istat) - deallocate(halo%tripRecv, stat=istat) - deallocate(halo%srcLocalAddr, stat=istat) - deallocate(halo%dstLocalAddr, stat=istat) - deallocate(halo%sendAddr, stat=istat) - deallocate(halo%recvAddr, stat=istat) + deallocate(halo%sendTask, & + halo%recvTask, & + halo%sizeSend, & + halo%sizeRecv, & + halo%tripSend, & + halo%tripRecv, & + halo%srcLocalAddr, & + halo%dstLocalAddr, & + halo%sendAddr, & + halo%recvAddr, & + halo%blockGlobalID, stat=istat) if (istat > 0) then - call abort_ice( & - 'ice_HaloDestroy: error deallocating') + call abort_ice(subname,' ERROR: deallocating') return endif end subroutine ice_HaloDestroy diff --git a/cicecore/cicedynB/infrastructure/comm/mpi/ice_timers.F90 b/cicecore/cicedynB/infrastructure/comm/mpi/ice_timers.F90 index 6f9c8b0c6..046cf9336 100644 --- a/cicecore/cicedynB/infrastructure/comm/mpi/ice_timers.F90 +++ b/cicecore/cicedynB/infrastructure/comm/mpi/ice_timers.F90 @@ -60,6 +60,7 @@ module ice_timers #endif timer_bound, &! boundary updates timer_bgc, &! biogeochemistry + timer_forcing, &! forcing timer_evp_1d, &! timer only loop timer_evp_2d ! timer including conversion 1d/2d ! timer_tmp ! for temporary timings @@ -179,6 +180,7 @@ subroutine init_ice_timers call get_ice_timer(timer_hist, 'History ',nblocks,distrb_info%nprocs) call get_ice_timer(timer_bound, 'Bound', nblocks,distrb_info%nprocs) call get_ice_timer(timer_bgc, 'BGC', nblocks,distrb_info%nprocs) + call get_ice_timer(timer_forcing, 'Forcing', nblocks,distrb_info%nprocs) #if (defined CESMCOUPLED) call get_ice_timer(timer_cplrecv, 'Cpl-recv', nblocks,distrb_info%nprocs) call get_ice_timer(timer_rcvsnd, 'Rcv->Snd', nblocks,distrb_info%nprocs) diff --git a/cicecore/cicedynB/infrastructure/comm/serial/ice_boundary.F90 b/cicecore/cicedynB/infrastructure/comm/serial/ice_boundary.F90 index 9c2cfd9fc..c66cdd13c 100644 --- a/cicecore/cicedynB/infrastructure/comm/serial/ice_boundary.F90 +++ b/cicecore/cicedynB/infrastructure/comm/serial/ice_boundary.F90 @@ -40,12 +40,16 @@ module ice_boundary type, public :: ice_halo integer (int_kind) :: & communicator, &! communicator to use for update messages + numLocalBlocks, &! number of local blocks, needed for halo fill numLocalCopies, &! num local copies for halo update tripoleRows ! number of rows in tripole buffer logical (log_kind) :: & tripoleTFlag ! NS boundary is a tripole T-fold + integer (int_kind), dimension(:), pointer :: & + blockGlobalID ! list of local block global IDs, needed for halo fill + integer (int_kind), dimension(:,:), pointer :: & srcLocalAddr, &! src addresses for each local copy dstLocalAddr ! dst addresses for each local copy @@ -174,6 +178,13 @@ function ice_HaloCreate(dist, nsBoundaryType, ewBoundaryType, & cornerMsgSize = nghost*nghost tripoleRows = nghost+1 + !*** store some block info to fill haloes properly + call ice_distributionGet(dist, numLocalBlocks=halo%numLocalBlocks) + if (halo%numLocalBlocks > 0) then + allocate(halo%blockGlobalID(halo%numLocalBlocks)) + call ice_distributionGet(dist, blockGlobalID=halo%blockGlobalID) + endif + if (nsBoundaryType == 'tripole' .or. nsBoundaryType == 'tripoleT') then tripoleTFlag = (nsBoundaryType == 'tripoleT') if (tripoleTflag) tripoleRows = tripoleRows+1 @@ -581,6 +592,7 @@ subroutine ice_HaloMask(halo, basehalo, mask) istat, &! allocate status flag communicator, &! communicator for message passing numLocalCopies, &! num local copies for halo update + numLocalBlocks, &! num local blocks for halo fill tripoleRows ! number of rows in tripole buffer logical (log_kind) :: & @@ -599,9 +611,11 @@ subroutine ice_HaloMask(halo, basehalo, mask) tripoleRows = basehalo%tripoleRows tripoleTFlag = basehalo%tripoleTFlag numLocalCopies = basehalo%numLocalCopies + numLocalBlocks = basehalo%numLocalBlocks allocate(halo%srcLocalAddr(3,numLocalCopies), & halo%dstLocalAddr(3,numLocalCopies), & + halo%blockGlobalID(numLocalBlocks), & stat = istat) if (istat > 0) then @@ -613,10 +627,13 @@ subroutine ice_HaloMask(halo, basehalo, mask) halo%tripoleRows = tripoleRows halo%tripoleTFlag = tripoleTFlag halo%numLocalCopies = numLocalCopies + halo%numLocalBlocks = numLocalBlocks halo%srcLocalAddr = basehalo%srcLocalAddr halo%dstLocalAddr = basehalo%dstLocalAddr + halo%blockGlobalID = basehalo%blockGlobalID + !----------------------------------------------------------------------- end subroutine ice_HaloMask @@ -659,6 +676,7 @@ subroutine ice_HaloUpdate2DR8(array, halo, & integer (int_kind) :: & i,j,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill nxGlobal, &! global domain size in x (tripole) iSrc,jSrc, &! source addresses for message iDst,jDst, &! dest addresses for message @@ -699,13 +717,18 @@ subroutine ice_HaloUpdate2DR8(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:) = fill - array(1:nx_block,ny_block-j+1,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:) = fill - array(nx_block-i+1,1:ny_block,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,iblk) = fill + array(1:nx_block, jhi+j,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,iblk) = fill + array(ihi+i, 1:ny_block,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -945,6 +968,7 @@ subroutine ice_HaloUpdate2DR4(array, halo, & integer (int_kind) :: & i,j,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill nxGlobal, &! global domain size in x (tripole) iSrc,jSrc, &! source addresses for message iDst,jDst, &! dest addresses for message @@ -985,13 +1009,18 @@ subroutine ice_HaloUpdate2DR4(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:) = fill - array(1:nx_block,ny_block-j+1,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:) = fill - array(nx_block-i+1,1:ny_block,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,iblk) = fill + array(1:nx_block, jhi+j,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,iblk) = fill + array(ihi+i, 1:ny_block,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -1231,6 +1260,7 @@ subroutine ice_HaloUpdate2DI4(array, halo, & integer (int_kind) :: & i,j,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill nxGlobal, &! global domain size in x (tripole) iSrc,jSrc, &! source addresses for message iDst,jDst, &! dest addresses for message @@ -1271,13 +1301,18 @@ subroutine ice_HaloUpdate2DI4(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:) = fill - array(1:nx_block,ny_block-j+1,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:) = fill - array(nx_block-i+1,1:ny_block,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,iblk) = fill + array(1:nx_block, jhi+j,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,iblk) = fill + array(ihi+i, 1:ny_block,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -1517,6 +1552,7 @@ subroutine ice_HaloUpdate3DR8(array, halo, & integer (int_kind) :: & i,j,k,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill nxGlobal, &! global domain size in x (tripole) nz, &! size of array in 3rd dimension iSrc,jSrc, &! source addresses for message @@ -1564,13 +1600,18 @@ subroutine ice_HaloUpdate3DR8(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:,:) = fill - array(1:nx_block,ny_block-j+1,:,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:,:) = fill - array(nx_block-i+1,1:ny_block,:,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,:,iblk) = fill + array(1:nx_block, jhi+j,:,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,:,iblk) = fill + array(ihi+i, 1:ny_block,:,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -1829,6 +1870,7 @@ subroutine ice_HaloUpdate3DR4(array, halo, & integer (int_kind) :: & i,j,k,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill nxGlobal, &! global domain size in x (tripole) nz, &! size of array in 3rd dimension iSrc,jSrc, &! source addresses for message @@ -1876,13 +1918,18 @@ subroutine ice_HaloUpdate3DR4(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:,:) = fill - array(1:nx_block,ny_block-j+1,:,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:,:) = fill - array(nx_block-i+1,1:ny_block,:,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,:,iblk) = fill + array(1:nx_block, jhi+j,:,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,:,iblk) = fill + array(ihi+i, 1:ny_block,:,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -2141,6 +2188,7 @@ subroutine ice_HaloUpdate3DI4(array, halo, & integer (int_kind) :: & i,j,k,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill nxGlobal, &! global domain size in x (tripole) nz, &! size of array in 3rd dimension iSrc,jSrc, &! source addresses for message @@ -2188,13 +2236,18 @@ subroutine ice_HaloUpdate3DI4(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:,:) = fill - array(1:nx_block,ny_block-j+1,:,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:,:) = fill - array(nx_block-i+1,1:ny_block,:,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,:,iblk) = fill + array(1:nx_block, jhi+j,:,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,:,iblk) = fill + array(ihi+i, 1:ny_block,:,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -2453,6 +2506,7 @@ subroutine ice_HaloUpdate4DR8(array, halo, & integer (int_kind) :: & i,j,k,l,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill nxGlobal, &! global domain size in x (tripole) nz, nt, &! size of array in 3rd,4th dimensions iSrc,jSrc, &! source addresses for message @@ -2501,13 +2555,18 @@ subroutine ice_HaloUpdate4DR8(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:,:,:) = fill - array(1:nx_block,ny_block-j+1,:,:,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:,:,:) = fill - array(nx_block-i+1,1:ny_block,:,:,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,:,:,iblk) = fill + array(1:nx_block, jhi+j,:,:,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,:,:,iblk) = fill + array(ihi+i, 1:ny_block,:,:,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -2782,6 +2841,7 @@ subroutine ice_HaloUpdate4DR4(array, halo, & integer (int_kind) :: & i,j,k,l,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill nxGlobal, &! global domain size in x (tripole) nz, nt, &! size of array in 3rd,4th dimensions iSrc,jSrc, &! source addresses for message @@ -2830,13 +2890,18 @@ subroutine ice_HaloUpdate4DR4(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:,:,:) = fill - array(1:nx_block,ny_block-j+1,:,:,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:,:,:) = fill - array(nx_block-i+1,1:ny_block,:,:,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,:,:,iblk) = fill + array(1:nx_block, jhi+j,:,:,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,:,:,iblk) = fill + array(ihi+i, 1:ny_block,:,:,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -3111,6 +3176,7 @@ subroutine ice_HaloUpdate4DI4(array, halo, & integer (int_kind) :: & i,j,k,l,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill nxGlobal, &! global domain size in x (tripole) nz, nt, &! size of array in 3rd,4th dimensions iSrc,jSrc, &! source addresses for message @@ -3159,13 +3225,18 @@ subroutine ice_HaloUpdate4DI4(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:,:,:) = fill - array(1:nx_block,ny_block-j+1,:,:,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:,:,:) = fill - array(nx_block-i+1,1:ny_block,:,:,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,:,:,iblk) = fill + array(1:nx_block, jhi+j,:,:,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,:,:,iblk) = fill + array(ihi+i, 1:ny_block,:,:,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -3472,13 +3543,18 @@ subroutine ice_HaloUpdate_stress(array1, array2, halo, & ! the tripole zipper as needed for stresses. if you zero ! it out, all halo values will be wiped out. !----------------------------------------------------------------------- -! do j = 1,nghost -! array1(1:nx_block, j,:) = fill -! array1(1:nx_block,ny_block-j+1,:) = fill -! enddo -! do i = 1,nghost -! array1(i, 1:ny_block,:) = fill -! array1(nx_block-i+1,1:ny_block,:) = fill +! do iblk = 1, halo%numLocalBlocks +! call get_block_parameter(halo%blockGlobalID(iblk), & +! ilo=ilo, ihi=ihi, & +! jlo=jlo, jhi=jhi) +! do j = 1,nghost +! array(1:nx_block, jlo-j,iblk) = fill +! array(1:nx_block, jhi+j,iblk) = fill +! enddo +! do i = 1,nghost +! array(ilo-i, 1:ny_block,iblk) = fill +! array(ihi+i, 1:ny_block,iblk) = fill +! enddo ! enddo !----------------------------------------------------------------------- @@ -4500,8 +4576,14 @@ subroutine ice_HaloDestroy(halo) !----------------------------------------------------------------------- - deallocate(halo%srcLocalAddr, stat=istat) - deallocate(halo%dstLocalAddr, stat=istat) + deallocate(halo%srcLocalAddr, & + halo%dstLocalAddr, & + halo%blockGlobalID, stat=istat) + + if (istat > 0) then + call abort_ice(subname,' ERROR: deallocating') + return + endif end subroutine ice_HaloDestroy diff --git a/cicecore/cicedynB/infrastructure/comm/serial/ice_timers.F90 b/cicecore/cicedynB/infrastructure/comm/serial/ice_timers.F90 index 3074c1dc9..4599de42e 100644 --- a/cicecore/cicedynB/infrastructure/comm/serial/ice_timers.F90 +++ b/cicecore/cicedynB/infrastructure/comm/serial/ice_timers.F90 @@ -52,6 +52,7 @@ module ice_timers timer_hist, &! diagnostics/history timer_bound, &! boundary updates timer_bgc, &! biogeochemistry + timer_forcing, &! forcing timer_evp_1d, &! timer only loop timer_evp_2d ! timer including conversion 1d/2d ! timer_tmp ! for temporary timings @@ -193,8 +194,9 @@ subroutine init_ice_timers call get_ice_timer(timer_hist, 'History ',nblocks,distrb_info%nprocs) call get_ice_timer(timer_bound, 'Bound', nblocks,distrb_info%nprocs) call get_ice_timer(timer_bgc, 'BGC', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_evp_1d, '1d-evp', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_evp_2d, '2d-evp', nblocks,distrb_info%nprocs) + call get_ice_timer(timer_forcing, 'Forcing', nblocks,distrb_info%nprocs) + call get_ice_timer(timer_evp_1d, '1d-evp', nblocks,distrb_info%nprocs) + call get_ice_timer(timer_evp_2d, '2d-evp', nblocks,distrb_info%nprocs) ! call get_ice_timer(timer_tmp, ' ',nblocks,distrb_info%nprocs) !----------------------------------------------------------------------- diff --git a/cicecore/cicedynB/infrastructure/ice_blocks.F90 b/cicecore/cicedynB/infrastructure/ice_blocks.F90 index 5177dd047..2768a40c3 100644 --- a/cicecore/cicedynB/infrastructure/ice_blocks.F90 +++ b/cicecore/cicedynB/infrastructure/ice_blocks.F90 @@ -83,6 +83,9 @@ module ice_blocks nblocks_x ,&! tot num blocks in i direction nblocks_y ! tot num blocks in j direction + logical (kind=log_kind), public :: & + debug_blocks ! print verbose block information + !----------------------------------------------------------------------- ! ! module private data @@ -133,8 +136,6 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & iblock, jblock ,&! block loop indices is, ie, js, je ! temp start, end indices - logical (log_kind) :: dbug - character(len=*), parameter :: subname = '(create_blocks)' !---------------------------------------------------------------------- @@ -252,8 +253,8 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & !*** set last physical point if padded domain else if (j_global(j,n) == ny_global .and. & - j > all_blocks(n)%jlo .and. & - j < all_blocks(n)%jhi) then + j >= all_blocks(n)%jlo .and. & + j < all_blocks(n)%jhi) then all_blocks(n)%jhi = j ! last physical point in padded domain endif end do @@ -300,8 +301,8 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & !*** last physical point in padded domain else if (i_global(i,n) == nx_global .and. & - i > all_blocks(n)%ilo .and. & - i < all_blocks(n)%ihi) then + i >= all_blocks(n)%ilo .and. & + i < all_blocks(n)%ihi) then all_blocks(n)%ihi = i endif end do @@ -311,9 +312,7 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & end do end do -! dbug = .true. - dbug = .false. - if (dbug) then + if (debug_blocks) then if (my_task == master_task) then write(nu_diag,*) 'block i,j locations' do n = 1, nblocks_tot diff --git a/cicecore/cicedynB/infrastructure/ice_domain.F90 b/cicecore/cicedynB/infrastructure/ice_domain.F90 index cc57ea585..52f0da850 100644 --- a/cicecore/cicedynB/infrastructure/ice_domain.F90 +++ b/cicecore/cicedynB/infrastructure/ice_domain.F90 @@ -21,7 +21,7 @@ module ice_domain add_mpi_barriers use ice_broadcast, only: broadcast_scalar, broadcast_array use ice_blocks, only: block, get_block, create_blocks, nghost, & - nblocks_x, nblocks_y, nblocks_tot, nx_block, ny_block + nblocks_x, nblocks_y, nblocks_tot, nx_block, ny_block, debug_blocks use ice_distribution, only: distrb use ice_boundary, only: ice_halo use ice_exit, only: abort_ice @@ -134,7 +134,8 @@ subroutine init_domain_blocks maskhalo_dyn, & maskhalo_remap, & maskhalo_bound, & - add_mpi_barriers + add_mpi_barriers, & + debug_blocks !---------------------------------------------------------------------- ! @@ -153,6 +154,7 @@ subroutine init_domain_blocks maskhalo_remap = .false. ! if true, use masked halos for transport maskhalo_bound = .false. ! if true, use masked halos for bound_state add_mpi_barriers = .false. ! if true, throttle communication + debug_blocks = .false. ! if true, print verbose block information max_blocks = -1 ! max number of blocks per processor block_size_x = -1 ! size of block in first horiz dimension block_size_y = -1 ! size of block in second horiz dimension @@ -190,12 +192,11 @@ subroutine init_domain_blocks call broadcast_scalar(maskhalo_remap, master_task) call broadcast_scalar(maskhalo_bound, master_task) call broadcast_scalar(add_mpi_barriers, master_task) + call broadcast_scalar(debug_blocks, master_task) if (my_task == master_task) then if (max_blocks < 1) then - max_blocks=int( & - ( (dble(nx_global-1)/dble(block_size_x + 1)) * & - (dble(ny_global-1)/dble(block_size_y + 1)) ) & - / dble(nprocs)) + max_blocks=( ((nx_global-1)/block_size_x + 1) * & + ((ny_global-1)/block_size_y + 1) - 1) / nprocs + 1 max_blocks=max(1,max_blocks) write(nu_diag,'(/,a52,i6,/)') & '(ice_domain): max_block < 1: max_block estimated to ',max_blocks @@ -268,6 +269,7 @@ subroutine init_domain_blocks write(nu_diag,'(a,l6)') ' maskhalo_remap = ', maskhalo_remap write(nu_diag,'(a,l6)') ' maskhalo_bound = ', maskhalo_bound write(nu_diag,'(a,l6)') ' add_mpi_barriers = ', add_mpi_barriers + write(nu_diag,'(a,l6)') ' debug_blocks = ', debug_blocks write(nu_diag,'(a,2i6)') ' block_size_x,_y = ', block_size_x, block_size_y write(nu_diag,'(a,i6)') ' max_blocks = ', max_blocks write(nu_diag,'(a,i6,/)')' Number of ghost cells = ', nghost @@ -287,7 +289,7 @@ subroutine init_domain_distribution(KMTG,ULATG) ! initialized here through calls to the appropriate boundary routines. use ice_boundary, only: ice_HaloCreate - use ice_distribution, only: create_distribution, create_local_block_ids + use ice_distribution, only: create_distribution, create_local_block_ids, ice_distributionGet use ice_domain_size, only: max_blocks, nx_global, ny_global real (dbl_kind), dimension(nx_global,ny_global), intent(in) :: & @@ -311,6 +313,7 @@ subroutine init_domain_distribution(KMTG,ULATG) integer (int_kind) :: & i,j,n ,&! dummy loop indices ig,jg ,&! global indices + ninfo ,&! ice_distributionGet check work_unit ,&! size of quantized work unit #ifdef USE_NETCDF fid ,&! file id @@ -326,6 +329,7 @@ subroutine init_domain_distribution(KMTG,ULATG) rad_to_deg ! radians to degrees integer (int_kind), dimension(:), allocatable :: & + blkinfo ,&! ice_distributionGet check nocn ,&! number of ocean points per block work_per_block ! number of work units per block @@ -449,7 +453,6 @@ subroutine init_domain_distribution(KMTG,ULATG) if (my_task == master_task) then ! cannot use ice_read_write due to circular dependency #ifdef USE_NETCDF - write(nu_diag,*) 'read ',trim(distribution_wght_file),minval(wght),maxval(wght) status = nf90_open(distribution_wght_file, NF90_NOWRITE, fid) if (status /= nf90_noerr) then call abort_ice (subname//'ERROR: Cannot open '//trim(distribution_wght_file)) @@ -457,6 +460,7 @@ subroutine init_domain_distribution(KMTG,ULATG) status = nf90_inq_varid(fid, 'wght', varid) status = nf90_get_var(fid, varid, wght) status = nf90_close(fid) + write(nu_diag,*) 'read ',trim(distribution_wght_file),minval(wght),maxval(wght) #else call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) @@ -563,6 +567,49 @@ subroutine init_domain_distribution(KMTG,ULATG) call create_local_block_ids(blocks_ice, distrb_info) + ! internal check of icedistributionGet as part of verification process + if (debug_blocks) then + call ice_distributionGet(distrb_info, nprocs=ninfo) + if (ninfo /= distrb_info%nprocs) & + call abort_ice(subname//' ice_distributionGet nprocs ERROR', file=__FILE__, line=__LINE__) + + call ice_distributionGet(distrb_info, communicator=ninfo) + if (ninfo /= distrb_info%communicator) & + call abort_ice(subname//' ice_distributionGet communicator ERROR', file=__FILE__, line=__LINE__) + + call ice_distributionGet(distrb_info, numLocalBlocks=ninfo) + if (ninfo /= distrb_info%numLocalBlocks) & + call abort_ice(subname//' ice_distributionGet numLocalBlocks ERROR', file=__FILE__, line=__LINE__) + + allocate(blkinfo(ninfo)) + + call ice_distributionGet(distrb_info, blockGlobalID = blkinfo) + do n = 1, ninfo + if (blkinfo(n) /= distrb_info%blockGlobalID(n)) & + call abort_ice(subname//' ice_distributionGet blockGlobalID ERROR', file=__FILE__, line=__LINE__) + enddo + + deallocate(blkinfo) + allocate(blkinfo(nblocks_tot)) + + call ice_distributionGet(distrb_info, blockLocation = blkinfo) + do n = 1, nblocks_tot + if (blkinfo(n) /= distrb_info%blockLocation(n)) & + call abort_ice(subname//' ice_distributionGet blockLocation ERROR', file=__FILE__, line=__LINE__) + enddo + + call ice_distributionGet(distrb_info, blockLocalID = blkinfo) + do n = 1, nblocks_tot + if (blkinfo(n) /= distrb_info%blockLocalID(n)) & + call abort_ice(subname//' ice_distributionGet blockLocalID ERROR', file=__FILE__, line=__LINE__) + enddo + + deallocate(blkinfo) + + if (my_task == master_task) & + write(nu_diag,*) subname,' ice_distributionGet checks pass' + endif + if (associated(blocks_ice)) then nblocks = size(blocks_ice) else diff --git a/cicecore/cicedynB/infrastructure/ice_grid.F90 b/cicecore/cicedynB/infrastructure/ice_grid.F90 index a354efb6b..2304877d2 100644 --- a/cicecore/cicedynB/infrastructure/ice_grid.F90 +++ b/cicecore/cicedynB/infrastructure/ice_grid.F90 @@ -26,7 +26,7 @@ module ice_grid use ice_domain, only: blocks_ice, nblocks, halo_info, distrb_info, & ew_boundary_type, ns_boundary_type, init_domain_distribution use ice_fileunits, only: nu_diag, nu_grid, nu_kmt, & - get_fileunit, release_fileunit + get_fileunit, release_fileunit, flush_fileunit use ice_gather_scatter, only: gather_global, scatter_global use ice_read_write, only: ice_read, ice_read_nc, ice_read_global, & ice_read_global_nc, ice_open, ice_open_nc, ice_close_nc @@ -384,11 +384,9 @@ subroutine init_grid2 ! T-grid cell and U-grid cell quantities !----------------------------------------------------------------- -! tarea(:,:,:) = c0 - !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo @@ -486,7 +484,7 @@ subroutine init_grid2 !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block, & !$OMP angle_0,angle_w,angle_s,angle_sw) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo @@ -642,7 +640,7 @@ subroutine popgrid kmt(:,:,:) = c0 !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo @@ -785,7 +783,7 @@ subroutine popgrid_nc kmt(:,:,:) = c0 !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo @@ -1104,7 +1102,7 @@ subroutine latlongrid !$OMP PARALLEL DO PRIVATE(iblk,this_block,ilo,ihi,jlo,jhi,i,j) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo @@ -1198,15 +1196,9 @@ subroutine rectgrid if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - !$OMP PARALLEL DO PRIVATE(iblk,i,j) - do iblk = 1, nblocks - do j = 1, ny_block - do i = 1, nx_block - ANGLE(i,j,iblk) = c0 ! "square with the world" - enddo - enddo - enddo - !$OMP END PARALLEL DO + hm (:,:,:) = c0 + kmt(:,:,:) = c0 + angle(:,:,:) = c0 ! "square with the world" allocate(work_g1(nx_global,ny_global)) @@ -1396,7 +1388,7 @@ subroutine cpomgrid kmt(:,:,:) = c0 !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo @@ -1636,11 +1628,10 @@ subroutine makemask !----------------------------------------------------------------- bm = c0 -! uvm = c0 !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo @@ -1663,12 +1654,19 @@ subroutine makemask field_loc_center, field_type_scalar) call ice_timer_stop(timer_bound) - !$OMP PARALLEL DO PRIVATE(iblk,i,j) + !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks - do j = 1, ny_block - do i = 1, nx_block - tmask(i,j,iblk) = .false. - umask(i,j,iblk) = .false. + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + ! needs to cover halo (no halo update for logicals) + tmask(:,:,iblk) = .false. + umask(:,:,iblk) = .false. + do j = jlo-nghost, jhi+nghost + do i = ilo-nghost, ihi+nghost if ( hm(i,j,iblk) > p5) tmask(i,j,iblk) = .true. if (uvm(i,j,iblk) > p5) umask(i,j,iblk) = .true. enddo @@ -1684,11 +1682,14 @@ subroutine makemask tarean(:,:,iblk) = c0 tareas(:,:,iblk) = c0 - do j = 1, ny_block - do i = 1, nx_block + do j = jlo,jhi + do i = ilo,ihi - if (ULAT(i,j,iblk) >= -puny) lmask_n(i,j,iblk) = .true. ! N. Hem. - if (ULAT(i,j,iblk) < -puny) lmask_s(i,j,iblk) = .true. ! S. Hem. + if (ULAT(i,j,iblk) >= -puny) then + lmask_n(i,j,iblk) = .true. ! N. Hem. + else + lmask_s(i,j,iblk) = .true. ! S. Hem. + endif ! N hemisphere area mask (m^2) if (lmask_n(i,j,iblk)) tarean(i,j,iblk) = tarea(i,j,iblk) & @@ -1743,7 +1744,7 @@ subroutine Tlatlon !$OMP x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4, & !$OMP tx,ty,tz,da) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo @@ -1915,7 +1916,7 @@ subroutine to_ugrid(work1,work2) !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo @@ -2000,7 +2001,7 @@ subroutine to_tgrid(work1, work2) !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo @@ -2073,7 +2074,7 @@ subroutine gridbox_corners !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo @@ -2400,8 +2401,9 @@ subroutine get_bathymetry do iblk = 1, nblocks do j = 1, ny_block do i = 1, nx_block - k = kmt(i,j,iblk) - if (k > puny) bathymetry(i,j,iblk) = depth(k) + k = min(nint(kmt(i,j,iblk)),nlevel) + if (k > nlevel) call abort_ice(subname//' kmt gt nlevel error') + if (k > 0) bathymetry(i,j,iblk) = depth(k) enddo enddo enddo @@ -2431,7 +2433,7 @@ subroutine get_bathymetry_popfile character(len=*), parameter :: subname = '(get_bathymetry_popfile)' - ntmp = maxval(KMT) + ntmp = maxval(nint(KMT)) nlevel = global_maxval(ntmp,distrb_info) if (my_task==master_task) then @@ -2491,8 +2493,8 @@ subroutine get_bathymetry_popfile do iblk = 1, nblocks do j = 1, ny_block do i = 1, nx_block - k = kmt(i,j,iblk) - if (k > nlevel) call abort_ice(subname//' kmt/nlevel error') + k = nint(kmt(i,j,iblk)) + if (k > nlevel) call abort_ice(subname//' kmt gt nlevel error') if (k > 0) bathymetry(i,j,iblk) = depth(k) enddo enddo diff --git a/cicecore/cicedynB/infrastructure/ice_read_write.F90 b/cicecore/cicedynB/infrastructure/ice_read_write.F90 index 87d0813cc..d902c62f8 100644 --- a/cicecore/cicedynB/infrastructure/ice_read_write.F90 +++ b/cicecore/cicedynB/infrastructure/ice_read_write.F90 @@ -1116,6 +1116,7 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & ! dimlen ! dimension size real (kind=dbl_kind) :: & + missingvalue, & amin, amax, asum ! min, max values and sum of input array ! character (char_len) :: & @@ -1141,6 +1142,8 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & nx = nx_global ny = ny_global + work = c0 ! to satisfy intent(out) attribute + if (present(restart_ext)) then if (restart_ext) then nx = nx_global + 2*nghost @@ -1181,6 +1184,7 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & count=(/nx,ny,1/) ) endif + status = nf90_get_att(fid, varid, "_FillValue", missingvalue) endif ! my_task = master_task !------------------------------------------------------------------- @@ -1188,9 +1192,9 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & !------------------------------------------------------------------- if (my_task==master_task .and. diag) then -! write(nu_diag,*) & -! 'ice_read_nc_xy, fid= ',fid, ', nrec = ',nrec, & -! ', varname = ',trim(varname) + write(nu_diag,*) & + 'ice_read_nc_xy, fid= ',fid, ', nrec = ',nrec, & + ', varname = ',trim(varname) ! status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar) ! write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar ! do id=1,ndim @@ -1198,8 +1202,8 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & ! write(nu_diag,*) 'Dim name = ',trim(dimname),', size = ',dimlen ! enddo amin = minval(work_g1) - amax = maxval(work_g1, mask = work_g1 /= spval_dbl) - asum = sum (work_g1, mask = work_g1 /= spval_dbl) + amax = maxval(work_g1, mask = work_g1 /= missingvalue) + asum = sum (work_g1, mask = work_g1 /= missingvalue) write(nu_diag,*) ' min, max, sum =', amin, amax, asum, trim(varname) endif @@ -1223,12 +1227,15 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & endif deallocate(work_g1) + +! echmod: this should not be necessary if fill/missing are only on land + where (work > 1.0e+30_dbl_kind) work = c0 + if (orca_halogrid .and. .not. present(restart_ext)) deallocate(work_g2) #else call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) - work = c0 ! to satisfy intent(out) attribute #endif end subroutine ice_read_nc_xy @@ -1282,6 +1289,7 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & ! dimlen ! size of dimension real (kind=dbl_kind) :: & + missingvalue, & ! missing value amin, amax, asum ! min, max values and sum of input array ! character (char_len) :: & @@ -1347,6 +1355,7 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & count=(/nx,ny,ncat,1/) ) endif + status = nf90_get_att(fid, varid, "_FillValue", missingvalue) endif ! my_task = master_task !------------------------------------------------------------------- @@ -1354,9 +1363,9 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & !------------------------------------------------------------------- if (my_task==master_task .and. diag) then -! write(nu_diag,*) & -! 'ice_read_nc_xyz, fid= ',fid, ', nrec = ',nrec, & -! ', varname = ',trim(varname) + write(nu_diag,*) & + 'ice_read_nc_xyz, fid= ',fid, ', nrec = ',nrec, & + ', varname = ',trim(varname) ! status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar) ! write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar ! do id=1,ndim @@ -1365,8 +1374,8 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & ! enddo do n=1,ncat amin = minval(work_g1(:,:,n)) - amax = maxval(work_g1(:,:,n), mask = work_g1(:,:,n) /= spval_dbl) - asum = sum (work_g1(:,:,n), mask = work_g1(:,:,n) /= spval_dbl) + amax = maxval(work_g1(:,:,n), mask = work_g1(:,:,n) /= missingvalue) + asum = sum (work_g1(:,:,n), mask = work_g1(:,:,n) /= missingvalue) write(nu_diag,*) ' min, max, sum =', amin, amax, asum, trim(varname) enddo endif diff --git a/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 b/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 index 5a6c79503..1a5681b38 100644 --- a/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 +++ b/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 @@ -197,7 +197,7 @@ subroutine restartfile (ice_ic) use ice_boundary, only: ice_HaloUpdate_stress use ice_blocks, only: nghost, nx_block, ny_block - use ice_calendar, only: istep0, npt + use ice_calendar, only: istep0, npt, calendar use ice_communicate, only: my_task, master_task use ice_domain, only: nblocks, halo_info use ice_domain_size, only: nilyr, nslyr, ncat, & @@ -244,6 +244,7 @@ subroutine restartfile (ice_ic) file=__FILE__, line=__LINE__) call init_restart_read(ice_ic) + call calendar() diag = .true. @@ -529,7 +530,8 @@ subroutine restartfile_v4 (ice_ic) use ice_broadcast, only: broadcast_scalar use ice_blocks, only: nghost, nx_block, ny_block - use ice_calendar, only: istep0, istep1, time, time_forc, calendar, npt + use ice_calendar, only: istep0, istep1, timesecs, calendar, npt, & + set_date_from_timesecs use ice_communicate, only: my_task, master_task use ice_domain, only: nblocks, distrb_info use ice_domain_size, only: nilyr, nslyr, ncat, nx_global, ny_global, & @@ -571,6 +573,9 @@ subroutine restartfile_v4 (ice_ic) real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1, work_g2 + real (kind=dbl_kind) :: & + time_forc ! historic, now local + character(len=*), parameter :: subname = '(restartfile_v4)' call icepack_query_tracer_sizes(ntrcr_out=ntrcr) @@ -602,14 +607,15 @@ subroutine restartfile_v4 (ice_ic) if (use_restart_time) then if (my_task == master_task) then - read (nu_restart) istep0,time,time_forc - write(nu_diag,*) 'Restart read at istep=',istep0,time,time_forc + read (nu_restart) istep0,timesecs,time_forc + write(nu_diag,*) 'Restart read at istep=',istep0,timesecs endif call broadcast_scalar(istep0,master_task) istep1 = istep0 - call broadcast_scalar(time,master_task) - call broadcast_scalar(time_forc,master_task) - call calendar(time) + call broadcast_scalar(timesecs,master_task) +! call broadcast_scalar(time_forc,master_task) + call set_date_from_timesecs(timesecs) + call calendar() else diff --git a/cicecore/cicedynB/infrastructure/ice_restoring.F90 b/cicecore/cicedynB/infrastructure/ice_restoring.F90 index 38104315d..c7254cd80 100644 --- a/cicecore/cicedynB/infrastructure/ice_restoring.F90 +++ b/cicecore/cicedynB/infrastructure/ice_restoring.F90 @@ -98,6 +98,11 @@ subroutine ice_HaloRestore_init vsnon_rest(nx_block,ny_block,ncat,max_blocks), & trcrn_rest(nx_block,ny_block,ntrcr,ncat,max_blocks)) + aicen_rest(:,:,:,:) = c0 + vicen_rest(:,:,:,:) = c0 + vsnon_rest(:,:,:,:) = c0 + trcrn_rest(:,:,:,:,:) = c0 + !----------------------------------------------------------------------- ! initialize ! halo cells have to be filled manually at this stage diff --git a/cicecore/cicedynB/infrastructure/io/io_binary/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_binary/ice_restart.F90 index b1a2d026b..91d57ea48 100644 --- a/cicecore/cicedynB/infrastructure/io/io_binary/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_binary/ice_restart.F90 @@ -31,6 +31,8 @@ module ice_restart public :: init_restart_write, init_restart_read, & read_restart_field, write_restart_field, final_restart + real(kind=dbl_kind) :: time_forc = -99. ! historic now local + !======================================================================= contains @@ -42,7 +44,8 @@ module ice_restart subroutine init_restart_read(ice_ic) - use ice_calendar, only: istep0, istep1, time, time_forc, npt, nyr + use ice_calendar, only: istep0, istep1, timesecs, npt, myear, & + set_date_from_timesecs use ice_communicate, only: my_task, master_task use ice_dyn_shared, only: kdyn use ice_read_write, only: ice_open, ice_open_ext @@ -105,17 +108,18 @@ subroutine init_restart_read(ice_ic) call ice_open(nu_restart,trim(filename),0) endif if (use_restart_time) then - read (nu_restart) istep0,time,time_forc,nyr + read (nu_restart) istep0,timesecs,time_forc,myear else read (nu_restart) iignore,rignore,rignore ! use namelist values endif - write(nu_diag,*) 'Restart read at istep=',istep0,time,time_forc + write(nu_diag,*) 'Restart read at istep=',istep0,timesecs endif call broadcast_scalar(istep0,master_task) - call broadcast_scalar(time,master_task) + call broadcast_scalar(timesecs,master_task) call broadcast_scalar(time_forc,master_task) - call broadcast_scalar(nyr,master_task) + call broadcast_scalar(myear,master_task) + call set_date_from_timesecs(timesecs) istep1 = istep0 @@ -375,8 +379,8 @@ end subroutine init_restart_read subroutine init_restart_write(filename_spec) - use ice_calendar, only: sec, month, mday, nyr, istep1, & - time, time_forc, year_init + use ice_calendar, only: msec, mmonth, mday, myear, istep1, & + timesecs use ice_communicate, only: my_task, master_task use ice_dyn_shared, only: kdyn use ice_read_write, only: ice_open, ice_open_ext @@ -391,8 +395,7 @@ subroutine init_restart_write(filename_spec) tr_pond_topo, tr_pond_lvl, tr_brine integer (kind=int_kind) :: & - nbtrcr, & ! number of bgc tracers - iyear, imonth, iday ! year, month, day + nbtrcr ! number of bgc tracers character(len=char_len_long) :: filename @@ -414,14 +417,10 @@ subroutine init_restart_write(filename_spec) if (present(filename_spec)) then filename = trim(filename_spec) else - iyear = nyr + year_init - 1 - imonth = month - iday = mday - write(filename,'(a,a,a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & restart_dir(1:lenstr(restart_dir)), & restart_file(1:lenstr(restart_file)),'.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec end if ! write pointer (path/file) @@ -434,7 +433,7 @@ subroutine init_restart_write(filename_spec) else call ice_open(nu_dump,filename,0) endif - write(nu_dump) istep1,time,time_forc,nyr + write(nu_dump) istep1,timesecs,time_forc,myear write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif @@ -445,7 +444,7 @@ subroutine init_restart_write(filename_spec) write(filename,'(a,a,a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & restart_dir(1:lenstr(restart_dir)), & restart_file(1:lenstr(restart_file)),'.eap.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec if (restart_ext) then call ice_open_ext(nu_dump_eap,filename,0) @@ -454,7 +453,7 @@ subroutine init_restart_write(filename_spec) endif if (my_task == master_task) then - write(nu_dump_eap) istep1,time,time_forc + write(nu_dump_eap) istep1,timesecs,time_forc write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif @@ -465,7 +464,7 @@ subroutine init_restart_write(filename_spec) write(filename,'(a,a,a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & restart_dir(1:lenstr(restart_dir)), & restart_file(1:lenstr(restart_file)),'.fsd.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec if (restart_ext) then call ice_open_ext(nu_dump_fsd,filename,0) @@ -474,7 +473,7 @@ subroutine init_restart_write(filename_spec) endif if (my_task == master_task) then - write(nu_dump_fsd) istep1,time,time_forc + write(nu_dump_fsd) istep1,timesecs,time_forc write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif @@ -485,7 +484,7 @@ subroutine init_restart_write(filename_spec) write(filename,'(a,a,a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & restart_dir(1:lenstr(restart_dir)), & restart_file(1:lenstr(restart_file)),'.FY.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec if (restart_ext) then call ice_open_ext(nu_dump_FY,filename,0) @@ -494,7 +493,7 @@ subroutine init_restart_write(filename_spec) endif if (my_task == master_task) then - write(nu_dump_FY) istep1,time,time_forc + write(nu_dump_FY) istep1,timesecs,time_forc write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif @@ -505,7 +504,7 @@ subroutine init_restart_write(filename_spec) write(filename,'(a,a,a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & restart_dir(1:lenstr(restart_dir)), & restart_file(1:lenstr(restart_file)),'.iage.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec if (restart_ext) then call ice_open_ext(nu_dump_age,filename,0) @@ -514,7 +513,7 @@ subroutine init_restart_write(filename_spec) endif if (my_task == master_task) then - write(nu_dump_age) istep1,time,time_forc + write(nu_dump_age) istep1,timesecs,time_forc write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif @@ -525,7 +524,7 @@ subroutine init_restart_write(filename_spec) write(filename,'(a,a,a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & restart_dir(1:lenstr(restart_dir)), & restart_file(1:lenstr(restart_file)),'.lvl.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec if (restart_ext) then call ice_open_ext(nu_dump_lvl,filename,0) @@ -534,7 +533,7 @@ subroutine init_restart_write(filename_spec) endif if (my_task == master_task) then - write(nu_dump_lvl) istep1,time,time_forc + write(nu_dump_lvl) istep1,timesecs,time_forc write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif @@ -545,7 +544,7 @@ subroutine init_restart_write(filename_spec) write(filename,'(a,a,a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & restart_dir(1:lenstr(restart_dir)), & restart_file(1:lenstr(restart_file)),'.pond_cesm.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec if (restart_ext) then call ice_open_ext(nu_dump_pond,filename,0) @@ -554,7 +553,7 @@ subroutine init_restart_write(filename_spec) endif if (my_task == master_task) then - write(nu_dump_pond) istep1,time,time_forc + write(nu_dump_pond) istep1,timesecs,time_forc write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif @@ -565,7 +564,7 @@ subroutine init_restart_write(filename_spec) write(filename,'(a,a,a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & restart_dir(1:lenstr(restart_dir)), & restart_file(1:lenstr(restart_file)),'.pond_lvl.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec if (restart_ext) then call ice_open_ext(nu_dump_pond,filename,0) @@ -574,7 +573,7 @@ subroutine init_restart_write(filename_spec) endif if (my_task == master_task) then - write(nu_dump_pond) istep1,time,time_forc + write(nu_dump_pond) istep1,timesecs,time_forc write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif @@ -585,7 +584,7 @@ subroutine init_restart_write(filename_spec) write(filename,'(a,a,a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & restart_dir(1:lenstr(restart_dir)), & restart_file(1:lenstr(restart_file)),'.pond_topo.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec if (restart_ext) then call ice_open_ext(nu_dump_pond,filename,0) @@ -594,7 +593,7 @@ subroutine init_restart_write(filename_spec) endif if (my_task == master_task) then - write(nu_dump_pond) istep1,time,time_forc + write(nu_dump_pond) istep1,timesecs,time_forc write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif @@ -605,7 +604,7 @@ subroutine init_restart_write(filename_spec) write(filename,'(a,a,a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & restart_dir(1:lenstr(restart_dir)), & restart_file(1:lenstr(restart_file)),'.brine.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec if (restart_ext) then call ice_open_ext(nu_dump_hbrine,filename,0) @@ -614,7 +613,7 @@ subroutine init_restart_write(filename_spec) endif if (my_task == master_task) then - write(nu_dump_hbrine) istep1,time,time_forc + write(nu_dump_hbrine) istep1,timesecs,time_forc write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif @@ -625,7 +624,7 @@ subroutine init_restart_write(filename_spec) write(filename,'(a,a,a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & restart_dir(1:lenstr(restart_dir)), & restart_file(1:lenstr(restart_file)),'.bgc.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec if (restart_ext) then call ice_open_ext(nu_dump_bgc,filename,0) @@ -634,7 +633,7 @@ subroutine init_restart_write(filename_spec) endif if (my_task == master_task) then - write(nu_dump_bgc) istep1,time,time_forc + write(nu_dump_bgc) istep1,timesecs,time_forc write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif endif @@ -644,7 +643,7 @@ subroutine init_restart_write(filename_spec) write(filename,'(a,a,a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & restart_dir(1:lenstr(restart_dir)), & restart_file(1:lenstr(restart_file)),'.iso.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec if (restart_ext) then call ice_open_ext(nu_dump_iso,filename,0) @@ -653,7 +652,7 @@ subroutine init_restart_write(filename_spec) endif if (my_task == master_task) then - write(nu_dump_iso) istep1,time,time_forc + write(nu_dump_iso) istep1,timesecs,time_forc write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif @@ -664,7 +663,7 @@ subroutine init_restart_write(filename_spec) write(filename,'(a,a,a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & restart_dir(1:lenstr(restart_dir)), & restart_file(1:lenstr(restart_file)),'.aero.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec if (restart_ext) then call ice_open_ext(nu_dump_aero,filename,0) @@ -673,7 +672,7 @@ subroutine init_restart_write(filename_spec) endif if (my_task == master_task) then - write(nu_dump_aero) istep1,time,time_forc + write(nu_dump_aero) istep1,timesecs,time_forc write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif @@ -803,7 +802,7 @@ end subroutine write_restart_field subroutine final_restart() - use ice_calendar, only: istep1, time, time_forc + use ice_calendar, only: istep1, timesecs use ice_communicate, only: my_task, master_task logical (kind=log_kind) :: & @@ -843,7 +842,7 @@ subroutine final_restart() if (solve_zsal .or. nbtrcr > 0) & close(nu_dump_bgc) - write(nu_diag,*) 'Restart read/written ',istep1,time,time_forc + write(nu_diag,*) 'Restart read/written ',istep1,timesecs endif end subroutine final_restart 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 b3024302e..9c6b30ee1 100644 --- a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 @@ -47,8 +47,9 @@ subroutine ice_write_hist (ns) use ice_arrays_column, only: hin_max, floe_rad_c use ice_blocks, only: nx_block, ny_block use ice_broadcast, only: broadcast_scalar - use ice_calendar, only: time, sec, idate, idate0, write_ic, & - histfreq, dayyr, days_per_year, use_leap_years + use ice_calendar, only: msec, timesecs, idate, idate0, write_ic, & + histfreq, days_per_year, use_leap_years, dayyr, & + year_init, month_init, day_init use ice_communicate, only: my_task, master_task use ice_domain, only: distrb_info use ice_domain_size, only: nx_global, ny_global, max_nstrm, max_blocks @@ -80,7 +81,6 @@ subroutine ice_write_hist (ns) integer (kind=int_kind), dimension(5) :: dimidcz integer (kind=int_kind), dimension(3) :: dimid_nverts integer (kind=int_kind), dimension(6) :: dimidex -! real (kind=real_kind) :: ltime real (kind=dbl_kind) :: ltime2 character (char_len) :: title character (char_len_long) :: ncfile(max_nstrm) @@ -133,8 +133,7 @@ subroutine ice_write_hist (ns) if (my_task == master_task) then -! ltime=time/int(secday) - ltime2=time/int(secday) + ltime2 = timesecs/secday call construct_filename(ncfile(ns),'nc',ns) @@ -1038,9 +1037,9 @@ subroutine ice_write_hist (ns) 'ERROR: global attribute source') if (use_leap_years) then - write(title,'(a,i3,a)') 'This year has ',int(dayyr),' days' + write(title,'(a,i3,a)') 'This year has ',dayyr,' days' else - write(title,'(a,i3,a)') 'All years have exactly ',int(dayyr),' days' + write(title,'(a,i3,a)') 'All years have exactly ',dayyr,' days' endif status = nf90_put_att(ncid,nf90_global,'comment',title) if (status /= nf90_noerr) call abort_ice(subname// & @@ -1051,7 +1050,7 @@ subroutine ice_write_hist (ns) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: global attribute date1') - write(title,'(a,i6)') 'seconds elapsed into model date: ',sec + write(title,'(a,i6)') 'seconds elapsed into model date: ',msec status = nf90_put_att(ncid,nf90_global,'comment3',title) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: global attribute date2') @@ -1091,7 +1090,6 @@ subroutine ice_write_hist (ns) status = nf90_inq_varid(ncid,'time',varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: getting time varid') -!sgl status = nf90_put_var(ncid,varid,ltime) status = nf90_put_var(ncid,varid,ltime2) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: writing time variable') diff --git a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 index 53c7dac60..e744caf09 100644 --- a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 @@ -42,8 +42,8 @@ module ice_restart subroutine init_restart_read(ice_ic) - use ice_calendar, only: sec, month, mday, nyr, istep0, istep1, & - time, time_forc, npt + use ice_calendar, only: msec, mmonth, mday, myear, & + istep0, istep1, npt use ice_communicate, only: my_task, master_task character(len=char_len_long), intent(in), optional :: ice_ic @@ -53,7 +53,7 @@ subroutine init_restart_read(ice_ic) character(len=char_len_long) :: & filename, filename0 - integer (kind=int_kind) :: status + integer (kind=int_kind) :: status, status1 character(len=*), parameter :: subname = '(init_restart_read)' @@ -79,24 +79,36 @@ subroutine init_restart_read(ice_ic) 'ERROR: reading restart ncfile '//trim(filename)) if (use_restart_time) then - status = nf90_get_att(ncid, nf90_global, 'istep1', istep0) - status = nf90_get_att(ncid, nf90_global, 'time', time) - status = nf90_get_att(ncid, nf90_global, 'time_forc', time_forc) - status = nf90_get_att(ncid, nf90_global, 'nyr', nyr) - if (status == nf90_noerr) then - status = nf90_get_att(ncid, nf90_global, 'month', month) + status1 = nf90_noerr + status = nf90_get_att(ncid, nf90_global, 'istep1', istep0) + if (status /= nf90_noerr) status1 = status +! status = nf90_get_att(ncid, nf90_global, 'time', time) +! status = nf90_get_att(ncid, nf90_global, 'time_forc', time_forc) + status = nf90_get_att(ncid, nf90_global, 'myear', myear) + if (status /= nf90_noerr) status = nf90_get_att(ncid, nf90_global, 'nyr', myear) + if (status /= nf90_noerr) status1 = status + status = nf90_get_att(ncid, nf90_global, 'mmonth', mmonth) + if (status /= nf90_noerr) status = nf90_get_att(ncid, nf90_global, 'month', mmonth) + if (status /= nf90_noerr) status1 = status status = nf90_get_att(ncid, nf90_global, 'mday', mday) - status = nf90_get_att(ncid, nf90_global, 'sec', sec) - endif + if (status /= nf90_noerr) status1 = status + status = nf90_get_att(ncid, nf90_global, 'msec', msec) + if (status /= nf90_noerr) status = nf90_get_att(ncid, nf90_global, 'sec', msec) + if (status /= nf90_noerr) status1 = status + if (status1 /= nf90_noerr) call abort_ice(subname// & + 'ERROR: reading restart time '//trim(filename)) endif ! use namelist values if use_restart_time = F endif call broadcast_scalar(istep0,master_task) - call broadcast_scalar(time,master_task) - call broadcast_scalar(time_forc,master_task) - call broadcast_scalar(nyr,master_task) - +! call broadcast_scalar(time,master_task) + call broadcast_scalar(myear,master_task) + call broadcast_scalar(mmonth,master_task) + call broadcast_scalar(mday,master_task) + call broadcast_scalar(msec,master_task) +! call broadcast_scalar(time_forc,master_task) + istep1 = istep0 ! if runid is bering then need to correct npt for istep0 @@ -118,8 +130,7 @@ end subroutine init_restart_read subroutine init_restart_write(filename_spec) use ice_blocks, only: nghost - use ice_calendar, only: sec, month, mday, nyr, istep1, & - time, time_forc, year_init + use ice_calendar, only: msec, mmonth, mday, myear, istep1 use ice_communicate, only: my_task, master_task use ice_domain_size, only: nx_global, ny_global, ncat, nilyr, nslyr, & n_iso, n_aero, nblyr, n_zaero, n_algae, n_doc, & @@ -145,7 +156,6 @@ subroutine init_restart_write(filename_spec) integer (kind=int_kind) :: & k, n, & ! index nx, ny, & ! global array size - iyear, & ! year nbtrcr ! number of bgc tracers character(len=char_len_long) :: filename @@ -186,12 +196,10 @@ subroutine init_restart_write(filename_spec) if (present(filename_spec)) then filename = trim(filename_spec) else - iyear = nyr + year_init - 1 - write(filename,'(a,a,a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & restart_dir(1:lenstr(restart_dir)), & restart_file(1:lenstr(restart_file)),'.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec end if ! write pointer (path/file) @@ -208,12 +216,12 @@ subroutine init_restart_write(filename_spec) 'ERROR: creating restart ncfile '//trim(filename)) status = nf90_put_att(ncid,nf90_global,'istep1',istep1) - status = nf90_put_att(ncid,nf90_global,'time',time) - status = nf90_put_att(ncid,nf90_global,'time_forc',time_forc) - status = nf90_put_att(ncid,nf90_global,'nyr',nyr) - status = nf90_put_att(ncid,nf90_global,'month',month) +! status = nf90_put_att(ncid,nf90_global,'time',time) +! status = nf90_put_att(ncid,nf90_global,'time_forc',time_forc) + status = nf90_put_att(ncid,nf90_global,'myear',myear) + status = nf90_put_att(ncid,nf90_global,'mmonth',mmonth) status = nf90_put_att(ncid,nf90_global,'mday',mday) - status = nf90_put_att(ncid,nf90_global,'sec',sec) + status = nf90_put_att(ncid,nf90_global,'msec',msec) nx = nx_global ny = ny_global @@ -795,7 +803,7 @@ end subroutine write_restart_field subroutine final_restart() - use ice_calendar, only: istep1, time, time_forc + use ice_calendar, only: istep1, idate use ice_communicate, only: my_task, master_task integer (kind=int_kind) :: status @@ -806,7 +814,7 @@ subroutine final_restart() status = nf90_close(ncid) if (my_task == master_task) & - write(nu_diag,*) 'Restart read/written ',istep1,time,time_forc + write(nu_diag,*) 'Restart read/written ',istep1,idate #else call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & 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 7e16f2591..72a1ed97f 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 @@ -41,8 +41,8 @@ subroutine ice_write_hist (ns) use ice_blocks, only: nx_block, ny_block use ice_broadcast, only: broadcast_scalar - use ice_calendar, only: time, sec, idate, idate0, write_ic, & - histfreq, dayyr, days_per_year, use_leap_years + use ice_calendar, only: msec, timesecs, idate, idate0, write_ic, & + histfreq, days_per_year, use_leap_years, dayyr use ice_communicate, only: my_task, master_task use ice_constants, only: c0, c360, spval, spval_dbl use ice_domain, only: distrb_info, nblocks @@ -76,7 +76,6 @@ subroutine ice_write_hist (ns) character (char_len_long) :: ncfile(max_nstrm) integer (kind=int_kind) :: iotype - integer (kind=int_kind) :: iyear, imonth, iday integer (kind=int_kind) :: icategory,ind,i_aice,boundid character (char_len) :: start_time,current_date,current_time @@ -176,8 +175,8 @@ subroutine ice_write_hist (ns) call ice_pio_initdecomp(ndim3=nzslyr, ndim4=ncat_hist, iodesc=iodesc4ds) call ice_pio_initdecomp(ndim3=nfsd_hist, ndim4=ncat_hist, iodesc=iodesc4df) - ltime2 = time/int(secday) - ltime = real(time/int(secday),kind=real_kind) + ltime2 = timesecs/secday + ltime = real(timesecs/secday,kind=real_kind) ! option of turning on double precision history files lprecision = pio_real @@ -861,16 +860,16 @@ subroutine ice_write_hist (ns) status = pio_put_att(File,pio_global,'source',trim(title)) if (use_leap_years) then - write(title,'(a,i3,a)') 'This year has ',int(dayyr),' days' + write(title,'(a,i3,a)') 'This year has ',dayyr,' days' else - write(title,'(a,i3,a)') 'All years have exactly ',int(dayyr),' days' + write(title,'(a,i3,a)') 'All years have exactly ',dayyr,' days' endif status = pio_put_att(File,pio_global,'comment',trim(title)) write(title,'(a,i8.8)') 'File written on model date ',idate status = pio_put_att(File,pio_global,'comment2',trim(title)) - write(title,'(a,i6)') 'seconds elapsed into model date: ',sec + write(title,'(a,i6)') 'seconds elapsed into model date: ',msec status = pio_put_att(File,pio_global,'comment3',trim(title)) title = 'CF-1.0' diff --git a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 index eb703abcd..12d5d8e71 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 @@ -41,8 +41,8 @@ module ice_restart subroutine init_restart_read(ice_ic) - use ice_calendar, only: istep0, istep1, time, time_forc, nyr, month, & - mday, sec, npt + use ice_calendar, only: istep0, istep1, myear, mmonth, & + mday, msec, npt use ice_communicate, only: my_task, master_task use ice_domain_size, only: ncat use ice_read_write, only: ice_open @@ -54,7 +54,7 @@ subroutine init_restart_read(ice_ic) character(len=char_len_long) :: & filename, filename0 - integer (kind=int_kind) :: status + integer (kind=int_kind) :: status, status1 integer (kind=int_kind) :: iotype @@ -87,28 +87,40 @@ subroutine init_restart_read(ice_ic) call ice_pio_initdecomp(ndim3=ncat , iodesc=iodesc3d_ncat,remap=.true.) if (use_restart_time) then - status = pio_get_att(File, pio_global, 'istep1', istep0) - status = pio_get_att(File, pio_global, 'time', time) - status = pio_get_att(File, pio_global, 'time_forc', time_forc) - call pio_seterrorhandling(File, PIO_BCAST_ERROR) - status = pio_get_att(File, pio_global, 'nyr', nyr) - call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) - if (status == PIO_noerr) then - status = pio_get_att(File, pio_global, 'month', month) + status1 = PIO_noerr + status = pio_get_att(File, pio_global, 'istep1', istep0) +! status = pio_get_att(File, pio_global, 'time', time) +! status = pio_get_att(File, pio_global, 'time_forc', time_forc) + call pio_seterrorhandling(File, PIO_BCAST_ERROR) + status = pio_get_att(File, pio_global, 'myear', myear) + if (status /= PIO_noerr) status = pio_get_att(File, pio_global, 'nyr', myear) + if (status /= PIO_noerr) status1 = status + status = pio_get_att(File, pio_global, 'mmonth', mmonth) + if (status /= PIO_noerr) status = pio_get_att(File, pio_global, 'month', mmonth) + if (status /= PIO_noerr) status1 = status status = pio_get_att(File, pio_global, 'mday', mday) - status = pio_get_att(File, pio_global, 'sec', sec) - endif + if (status /= PIO_noerr) status1 = status + status = pio_get_att(File, pio_global, 'msec', msec) + if (status /= PIO_noerr) status = pio_get_att(File, pio_global, 'sec', msec) + if (status /= PIO_noerr) status1 = status + if (status1 /= PIO_noerr) & + call abort_ice(subname//"ERROR: reading restart time ") + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) endif ! use namelist values if use_restart_time = F ! endif if (my_task == master_task) then - write(nu_diag,*) 'Restart read at istep=',istep0,time,time_forc + write(nu_diag,*) 'Restart read at istep=',istep0,myear,mmonth,mday,msec endif call broadcast_scalar(istep0,master_task) - call broadcast_scalar(time,master_task) - call broadcast_scalar(time_forc,master_task) - call broadcast_scalar(nyr,master_task) + call broadcast_scalar(myear,master_task) + call broadcast_scalar(mmonth,master_task) + call broadcast_scalar(mday,master_task) + call broadcast_scalar(msec,master_task) +! call broadcast_scalar(time,master_task) +! call broadcast_scalar(time_forc,master_task) + call broadcast_scalar(myear,master_task) istep1 = istep0 @@ -126,8 +138,7 @@ end subroutine init_restart_read subroutine init_restart_write(filename_spec) - use ice_calendar, only: sec, month, mday, nyr, istep1, & - time, time_forc, year_init + use ice_calendar, only: msec, mmonth, mday, myear, istep1 use ice_communicate, only: my_task, master_task use ice_domain_size, only: nx_global, ny_global, ncat, nilyr, nslyr, & n_iso, n_aero, nblyr, n_zaero, n_algae, n_doc, & @@ -155,9 +166,6 @@ subroutine init_restart_write(filename_spec) ! local variables - integer (kind=int_kind) :: & - iyear, imonth, iday ! year, month, day - character(len=char_len_long) :: filename integer (kind=int_kind) :: dimid_ni, dimid_nj, dimid_ncat, & @@ -196,14 +204,10 @@ subroutine init_restart_write(filename_spec) if (present(filename_spec)) then filename = trim(filename_spec) else - iyear = nyr + year_init - 1 - imonth = month - iday = mday - write(filename,'(a,a,a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & restart_dir(1:lenstr(restart_dir)), & restart_file(1:lenstr(restart_file)),'.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec end if if (restart_format(1:3) /= 'bin') filename = trim(filename) // '.nc' @@ -224,12 +228,12 @@ subroutine init_restart_write(filename_spec) clobber=.true., cdf64=lcdf64, iotype=iotype) status = pio_put_att(File,pio_global,'istep1',istep1) - status = pio_put_att(File,pio_global,'time',time) - status = pio_put_att(File,pio_global,'time_forc',time_forc) - status = pio_put_att(File,pio_global,'nyr',nyr) - status = pio_put_att(File,pio_global,'month',month) +! status = pio_put_att(File,pio_global,'time',time) +! status = pio_put_att(File,pio_global,'time_forc',time_forc) + status = pio_put_att(File,pio_global,'myear',myear) + status = pio_put_att(File,pio_global,'mmonth',mmonth) status = pio_put_att(File,pio_global,'mday',mday) - status = pio_put_att(File,pio_global,'sec',sec) + status = pio_put_att(File,pio_global,'msec',msec) status = pio_def_dim(File,'ni',nx_global,dimid_ni) status = pio_def_dim(File,'nj',ny_global,dimid_nj) @@ -702,7 +706,7 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3,diag, & status = pio_inq_varid(File,trim(vname),vardesc) - if (status /= 0) then + if (status /= PIO_noerr) then call abort_ice(subname//"ERROR: CICE restart? Missing variable: "//trim(vname)) endif @@ -854,7 +858,7 @@ end subroutine write_restart_field subroutine final_restart() - use ice_calendar, only: istep1, time, time_forc + use ice_calendar, only: istep1, idate, msec use ice_communicate, only: my_task, master_task character(len=*), parameter :: subname = '(final_restart)' @@ -864,7 +868,7 @@ subroutine final_restart() call pio_closefile(File) if (my_task == master_task) & - write(nu_diag,*) 'Restart read/written ',istep1,time,time_forc + write(nu_diag,*) 'Restart read/written ',istep1,idate,msec end subroutine final_restart diff --git a/cicecore/drivers/direct/hadgem3/CICE.F90 b/cicecore/drivers/direct/hadgem3/CICE.F90 index e444dcd40..b2314240c 100644 --- a/cicecore/drivers/direct/hadgem3/CICE.F90 +++ b/cicecore/drivers/direct/hadgem3/CICE.F90 @@ -56,40 +56,3 @@ program icemodel end program icemodel !======================================================================= -! -! Wrapper for the print_state debugging routine. -! Useful for debugging in the main driver (see ice.F_debug) -! ip, jp, mtask are set in ice_diagnostics.F -! -! author Elizabeth C. Hunke, LANL -! - subroutine debug_ice(plabeld) - - use ice_kinds_mod - use ice_calendar, only: istep1 - use ice_communicate, only: my_task - use ice_diagnostics, only: check_step, iblkp, ip, jp, mtask, print_state - use ice_domain, only: nblocks - use ice_blocks, only: nx_block, ny_block - - character (char_len), intent(in) :: plabeld - - ! local - integer (kind=int_kind) :: i, j, iblk - - if (istep1 >= check_step) then - - do iblk = 1, nblocks - do j = 1, ny_block - do i = 1, nx_block - if (iblk==iblkp .and. i==ip .and. j==jp .and. my_task==mtask) & - call print_state(plabeld,i,j,iblk) - enddo - enddo - enddo - - endif - - end subroutine debug_ice - -!======================================================================= diff --git a/cicecore/drivers/direct/hadgem3/CICE_FinalMod.F90 b/cicecore/drivers/direct/hadgem3/CICE_FinalMod.F90 index 397950023..2fdb170f1 100644 --- a/cicecore/drivers/direct/hadgem3/CICE_FinalMod.F90 +++ b/cicecore/drivers/direct/hadgem3/CICE_FinalMod.F90 @@ -48,12 +48,6 @@ subroutine CICE_Finalize !echmod if (nu_diag /= 6) close (nu_diag) ! diagnostic output call release_all_fileunits - !------------------------------------------------------------------- - ! write 'finished' file if needed - !------------------------------------------------------------------- - - if (runid == 'bering') call writeout_finished_file() - !------------------------------------------------------------------- ! quit MPI !------------------------------------------------------------------- @@ -63,31 +57,6 @@ subroutine CICE_Finalize end subroutine CICE_Finalize -!======================================================================= -! -! Write a file indicating that this run finished cleanly. This is -! needed only for runs on machine 'bering' (set using runid = 'bering'). -! -! author: Adrian Turner, LANL - - subroutine writeout_finished_file() - - use ice_restart_shared, only: restart_dir - use ice_communicate, only: my_task, master_task - - character(len=char_len_long) :: filename - - if (my_task == master_task) then - - filename = trim(restart_dir)//"finished" - open(11,file=filename) - write(11,*) "finished" - close(11) - - endif - - end subroutine writeout_finished_file - !======================================================================= end module CICE_FinalMod diff --git a/cicecore/drivers/mct/cesm1/CICE_FinalMod.F90 b/cicecore/drivers/mct/cesm1/CICE_FinalMod.F90 index 943787498..0be3636f0 100644 --- a/cicecore/drivers/mct/cesm1/CICE_FinalMod.F90 +++ b/cicecore/drivers/mct/cesm1/CICE_FinalMod.F90 @@ -45,12 +45,6 @@ subroutine CICE_Finalize !echmod if (nu_diag /= 6) close (nu_diag) ! diagnostic output call release_all_fileunits - !------------------------------------------------------------------- - ! write 'finished' file if needed - !------------------------------------------------------------------- - - if (runid == 'bering') call writeout_finished_file() - !------------------------------------------------------------------- ! quit MPI !------------------------------------------------------------------- @@ -60,31 +54,6 @@ subroutine CICE_Finalize end subroutine CICE_Finalize -!======================================================================= -! -! Write a file indicating that this run finished cleanly. This is -! needed only for runs on machine 'bering' (set using runid = 'bering'). -! -! author: Adrian Turner, LANL - - subroutine writeout_finished_file() - - use ice_restart_shared, only: restart_dir - - character(len=char_len_long) :: filename - character(len=*), parameter :: subname = '(writeout_finished_file)' - - if (my_task == master_task) then - - filename = trim(restart_dir)//"finished" - open(11,file=filename) - write(11,*) "finished" - close(11) - - endif - - end subroutine writeout_finished_file - !======================================================================= end module CICE_FinalMod diff --git a/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 b/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 index da745d965..c3de87f68 100644 --- a/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 +++ b/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 @@ -64,7 +64,7 @@ subroutine cice_init(mpicom_ice) floe_binwidth, c_fsd_range use ice_state, only: alloc_state use ice_flux_bgc, only: alloc_flux_bgc - use ice_calendar, only: dt, dt_dyn, time, istep, istep1, write_ic, & + use ice_calendar, only: dt, dt_dyn, istep, istep1, write_ic, & init_calendar, calendar use ice_communicate, only: init_communicate, my_task, master_task use ice_diagnostics, only: init_diags @@ -156,7 +156,7 @@ subroutine cice_init(mpicom_ice) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - call calendar(time) ! determine the initial date + call calendar ! determine the initial date call init_forcing_ocn(dt) ! initialize sss and sst from data call init_state ! initialize the ice state @@ -233,7 +233,7 @@ subroutine init_restart use ice_arrays_column, only: dhsn use ice_blocks, only: nx_block, ny_block - use ice_calendar, only: time, calendar + use ice_calendar, only: calendar use ice_constants, only: c0 use ice_domain, only: nblocks use ice_domain_size, only: ncat, n_iso, n_aero, nfsd @@ -295,7 +295,7 @@ subroutine init_restart if (trim(runtype) == 'continue') then ! start from core restart file call restartfile() ! given by pointer in ice_in - call calendar(time) ! update time parameters + call calendar ! update time parameters if (kdyn == 2) call read_restart_eap ! EAP else if (restart) then ! ice_ic = core restart file call restartfile (ice_ic) ! or 'default' or 'none' diff --git a/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 b/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 index d53014b7b..e9ab0d7e4 100644 --- a/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 +++ b/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 @@ -44,7 +44,7 @@ module CICE_RunMod subroutine CICE_Run - use ice_calendar, only: istep, istep1, time, dt, stop_now, calendar + use ice_calendar, only: istep, istep1, dt, stop_now, calendar, advance_timestep use ice_forcing, only: get_forcing_atmo, get_forcing_ocn, & get_wave_spec use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & @@ -81,12 +81,14 @@ subroutine CICE_Run ! call ice_step - istep = istep + 1 ! update time step counters - istep1 = istep1 + 1 - time = time + dt ! determine the time and date +! istep = istep + 1 ! update time step counters +! istep1 = istep1 + 1 +! time = time + dt ! determine the time and date ! call calendar(time) ! at the end of the timestep + call advance_timestep() ! advance timestep and update calendar data + call ice_timer_start(timer_couple) ! atm/ocn coupling ! for standalone @@ -108,7 +110,7 @@ subroutine CICE_Run call init_flux_atm ! Initialize atmosphere fluxes sent to coupler call init_flux_ocn ! initialize ocean fluxes sent to coupler - call calendar(time) ! at the end of the timestep +! call calendar(time) ! at the end of the timestep call ice_timer_stop(timer_couple) ! atm/ocn coupling @@ -136,7 +138,7 @@ subroutine ice_step use ice_boundary, only: ice_HaloUpdate use ice_calendar, only: dt, dt_dyn, ndtd, diagfreq, write_restart, istep - use ice_calendar, only: idate, sec + use ice_calendar, only: idate, msec use ice_diagnostics, only: init_mass_diags, runtime_diags use ice_diagnostics_bgc, only: hbrine_diags, zsal_diags, bgc_diags use ice_domain, only: halo_info, nblocks @@ -207,7 +209,7 @@ subroutine ice_step if (prescribed_ice) then ! read prescribed ice call t_barrierf('cice_run_presc_BARRIER',MPI_COMM_ICE) call t_startf ('cice_run_presc') - call ice_prescribed_run(idate, sec) + call ice_prescribed_run(idate, msec) call t_stopf ('cice_run_presc') endif diff --git a/cicecore/drivers/mct/cesm1/ice_comp_esmf.F90 b/cicecore/drivers/mct/cesm1/ice_comp_esmf.F90 index 8ae80abdc..08681d84f 100644 --- a/cicecore/drivers/mct/cesm1/ice_comp_esmf.F90 +++ b/cicecore/drivers/mct/cesm1/ice_comp_esmf.F90 @@ -48,10 +48,10 @@ module ice_comp_esmf use ice_constants, only : c0, c1, spval_dbl, rad_to_deg, radius, secday use ice_communicate, only : my_task, master_task, MPI_COMM_ICE use ice_calendar, only : istep, istep1, force_restart_now, write_ic,& - idate, idate0, mday, time, month, daycal, & - sec, dt, dt_dyn, calendar, & + idate, idate0, mday, time, mmonth, & + msec, dt, dt_dyn, calendar, & calendar_type, nextsw_cday, days_per_year, & - nyr, new_year, time2sec, year_init + myear, new_year, time2sec, year_init use icepack_orbital, only : eccen, obliqr, lambm0, mvelpp use ice_timers @@ -178,12 +178,11 @@ subroutine ice_init_esmf(comp, import_state, export_state, EClock, rc) integer :: ref_ymd ! Reference date (YYYYMMDD) integer :: ref_tod ! reference time of day (s) integer :: iyear ! yyyy - integer :: nyrp ! yyyy + integer :: myearp ! yyyy integer :: dtime ! time step integer :: shrlogunit,shrloglev ! old values integer :: iam,ierr integer :: lbnum - integer :: daycal(13) !number of cumulative days per month integer :: nleaps ! number of leap days before current year integer :: mpicom_loc, mpicom_vm, gsize integer :: nfields @@ -367,17 +366,17 @@ subroutine ice_init_esmf(comp, import_state, export_state, EClock, rc) endif iyear = (idate/10000) ! integer year of basedate - month = (idate-iyear*10000)/100 ! integer month of basedate - mday = idate-iyear*10000-month*100 ! day of month of basedate + mmonth= (idate-iyear*10000)/100 ! integer month of basedate + mday = idate-iyear*10000-mmonth*100 ! day of month of basedate if (my_task == master_task) then write(nu_diag,*) trim(subname),' curr_ymd = ',curr_ymd write(nu_diag,*) trim(subname),' cice year_init = ',year_init write(nu_diag,*) trim(subname),' cice start date = ',idate - write(nu_diag,*) trim(subname),' cice start ymds = ',iyear,month,mday,start_tod + write(nu_diag,*) trim(subname),' cice start ymds = ',iyear,mmonth,mday,start_tod endif - call time2sec(iyear,month,mday,time) + call time2sec(iyear,mmonth,mday,time) time = time+start_tod call shr_sys_flush(nu_diag) @@ -641,7 +640,7 @@ subroutine ice_run_esmf(comp, import_state, export_state, EClock, rc) integer :: curr_tod ! Current time of day (s) integer :: shrlogunit,shrloglev ! old values integer :: lbnum - integer :: n, nyrp + integer :: n, myearp type(ESMF_Array) :: i2x, x2i real(R8), pointer :: fptr(:,:) character(len=*), parameter :: subname = '(ice_run_esmf)' @@ -695,9 +694,9 @@ subroutine ice_run_esmf(comp, import_state, export_state, EClock, rc) force_restart_now = seq_timemgr_RestartAlarmIsOn(EClock) if (calendar_type .eq. "GREGORIAN") then - nyrp = nyr - nyr = (curr_ymd/10000)+1 ! integer year of basedate - if (nyr /= nyrp) then + myearp = myear + myear = (curr_ymd/10000)+1 ! integer year of basedate + if (myear /= myearp) then new_year = .true. else new_year = .false. @@ -758,7 +757,7 @@ subroutine ice_run_esmf(comp, import_state, export_state, EClock, rc) ! check that internal clock is in sync with master clock !-------------------------------------------------------------------- - tod = sec + tod = msec ymd = idate if (.not. seq_timemgr_EClockDateInSync( EClock, ymd, tod )) then call seq_timemgr_EClockGetData( EClock, curr_ymd=ymd_sync, & diff --git a/cicecore/drivers/mct/cesm1/ice_comp_mct.F90 b/cicecore/drivers/mct/cesm1/ice_comp_mct.F90 index 7162d6397..64dff54e2 100644 --- a/cicecore/drivers/mct/cesm1/ice_comp_mct.F90 +++ b/cicecore/drivers/mct/cesm1/ice_comp_mct.F90 @@ -47,10 +47,9 @@ module ice_comp_mct use ice_constants, only : ice_init_constants use ice_communicate, only : my_task, master_task, MPI_COMM_ICE use ice_calendar, only : istep, istep1, force_restart_now, write_ic,& - idate, idate0, mday, time, month, daycal, & - sec, dt, dt_dyn, calendar, & - calendar_type, nextsw_cday, days_per_year, & - nyr, new_year, time2sec, year_init + idate, idate0, mday, mmonth, myear, & + msec, dt, dt_dyn, calendar, & + calendar_type, nextsw_cday, days_per_year use ice_timers use ice_kinds_mod, only : int_kind, dbl_kind, char_len_long, log_kind @@ -151,13 +150,11 @@ subroutine ice_init_mct( EClock, cdata_i, x2i_i, i2x_i, NLFilename ) integer :: curr_tod ! Current time of day (s) integer :: ref_ymd ! Reference date (YYYYMMDD) integer :: ref_tod ! reference time of day (s) - integer :: iyear ! yyyy - integer :: nyrp ! yyyy + integer :: myearp ! yyyy integer :: dtime ! time step integer :: shrlogunit,shrloglev ! old values integer :: iam,ierr integer :: lbnum - integer :: daycal(13) !number of cumulative days per month integer :: nleaps ! number of leap days before current year integer :: mpicom_loc ! temporary mpicom logical (kind=log_kind) :: atm_aero, tr_aero, tr_zaero @@ -302,10 +299,9 @@ subroutine ice_init_mct( EClock, cdata_i, x2i_i, i2x_i, NLFilename ) ! - on restart run ! - istep0, time and time_forc are read from restart file ! - istep1 is set to istep0 - ! - idate is determined from time via the call to calendar (see below) + ! - date information is determined from restart ! - on initial run - ! - iyear, month and mday obtained from sync clock - ! - time determined from iyear, month and mday + ! - myear, mmonth, mday, msec obtained from sync clock ! - istep0 and istep1 are set to 0 call seq_timemgr_EClockGetData(EClock, & @@ -335,37 +331,26 @@ subroutine ice_init_mct( EClock, cdata_i, x2i_i, i2x_i, NLFilename ) idate0 = curr_ymd idate = curr_ymd -! idate0 = curr_ymd - (year_init*10000) -! idate = curr_ymd - (year_init*10000) - if (idate < 0) then - write(nu_diag,*) trim(subname),' ERROR curr_ymd,year_init =',curr_ymd,year_init + write(nu_diag,*) trim(subname),' ERROR curr_ymd =',curr_ymd write(nu_diag,*) trim(subname),' ERROR idate lt zero',idate call shr_sys_abort(subname//' :: ERROR idate lt zero') endif - iyear = (idate/10000) ! integer year of basedate - month = (idate-iyear*10000)/100 ! integer month of basedate - mday = idate-iyear*10000-month*100 ! day of month of basedate + myear = (idate/10000) ! integer year of basedate + mmonth= (idate-myear*10000)/100 ! integer month of basedate + mday = idate-myear*10000-mmonth*100 ! day of month of basedate + msec = start_tod ! seconds if (my_task == master_task) then write(nu_diag,*) trim(subname),' curr_ymd = ',curr_ymd - write(nu_diag,*) trim(subname),' cice year_init = ',year_init write(nu_diag,*) trim(subname),' cice start date = ',idate - write(nu_diag,*) trim(subname),' cice start ymds = ',iyear,month,mday,start_tod + write(nu_diag,*) trim(subname),' cice start ymds = ',myear,mmonth,mday,start_tod endif - if (calendar_type /= "GREGORIAN") then - call time2sec(iyear-year_init,month,mday,time) - else - call time2sec(iyear-(year_init-1),month,mday,time) - endif - - time = time+start_tod - call shr_sys_flush(nu_diag) end if - call calendar(time) ! update calendar info + call calendar ! update calendar info if (write_ic) call accum_hist(dt) ! write initial conditions !--------------------------------------------------------------------------- @@ -527,7 +512,7 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i ) integer :: curr_tod ! Current time of day (s) integer :: shrlogunit,shrloglev ! old values integer :: lbnum - integer :: n, nyrp + integer :: n, myearp type(mct_gGrid) , pointer :: dom_i type(seq_infodata_type), pointer :: infodata type(mct_gsMap) , pointer :: gsMap_i @@ -580,9 +565,9 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i ) force_restart_now = seq_timemgr_RestartAlarmIsOn(EClock) ! if (calendar_type .eq. "GREGORIAN") then -! nyrp = nyr -! nyr = (curr_ymd/10000)+1 ! integer year of basedate -! if (nyr /= nyrp) then +! myearp = myear +! myear = (curr_ymd/10000)+1 ! integer year of basedate +! if (myear /= myearp) then ! new_year = .true. ! else ! new_year = .false. @@ -632,7 +617,7 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i ) ! check that internal clock is in sync with master clock !-------------------------------------------------------------------- - tod = sec + tod = msec ymd = idate if (.not. seq_timemgr_EClockDateInSync( EClock, ymd, tod )) then call seq_timemgr_EClockGetData( EClock, curr_ymd=ymd_sync, & diff --git a/cicecore/drivers/mct/cesm1/ice_prescribed_mod.F90 b/cicecore/drivers/mct/cesm1/ice_prescribed_mod.F90 index 4debdfa55..e068a2892 100644 --- a/cicecore/drivers/mct/cesm1/ice_prescribed_mod.F90 +++ b/cicecore/drivers/mct/cesm1/ice_prescribed_mod.F90 @@ -42,7 +42,7 @@ module ice_prescribed_mod use ice_blocks, only : nx_block, ny_block, block, get_block use ice_domain, only : nblocks, distrb_info, blocks_ice use ice_grid, only : TLAT,TLON,hm,tmask - use ice_calendar, only : idate, sec, calendar_type + use ice_calendar, only : idate, calendar_type use ice_arrays_column, only : hin_max use ice_read_write use ice_exit, only: abort_ice diff --git a/cicecore/drivers/nuopc/cmeps/CICE_FinalMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_FinalMod.F90 index 943787498..0be3636f0 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_FinalMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_FinalMod.F90 @@ -45,12 +45,6 @@ subroutine CICE_Finalize !echmod if (nu_diag /= 6) close (nu_diag) ! diagnostic output call release_all_fileunits - !------------------------------------------------------------------- - ! write 'finished' file if needed - !------------------------------------------------------------------- - - if (runid == 'bering') call writeout_finished_file() - !------------------------------------------------------------------- ! quit MPI !------------------------------------------------------------------- @@ -60,31 +54,6 @@ subroutine CICE_Finalize end subroutine CICE_Finalize -!======================================================================= -! -! Write a file indicating that this run finished cleanly. This is -! needed only for runs on machine 'bering' (set using runid = 'bering'). -! -! author: Adrian Turner, LANL - - subroutine writeout_finished_file() - - use ice_restart_shared, only: restart_dir - - character(len=char_len_long) :: filename - character(len=*), parameter :: subname = '(writeout_finished_file)' - - if (my_task == master_task) then - - filename = trim(restart_dir)//"finished" - open(11,file=filename) - write(11,*) "finished" - close(11) - - endif - - end subroutine writeout_finished_file - !======================================================================= end module CICE_FinalMod diff --git a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 index b37d73f65..a57f8aef8 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 @@ -45,8 +45,9 @@ subroutine cice_init floe_binwidth, c_fsd_range use ice_state, only: alloc_state use ice_flux_bgc, only: alloc_flux_bgc - use ice_calendar, only: dt, dt_dyn, time, istep, istep1, write_ic, & - init_calendar, calendar + use ice_calendar, only: dt, dt_dyn, istep, istep1, write_ic, & + init_calendar, advance_timestep, calc_timesteps + use ice_calendar, only: calendar use ice_communicate, only: my_task, master_task use ice_diagnostics, only: init_diags use ice_domain, only: init_domain_blocks @@ -130,8 +131,7 @@ subroutine cice_init call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - - call calendar(time) ! determine the initial date + call calendar() ! determine the initial date ! TODO: - why is this being called when you are using CMEPS? call init_forcing_ocn(dt) ! initialize sss and sst from data @@ -192,7 +192,7 @@ subroutine init_restart use ice_arrays_column, only: dhsn use ice_blocks, only: nx_block, ny_block - use ice_calendar, only: time, calendar + use ice_calendar, only: calendar use ice_constants, only: c0 use ice_domain, only: nblocks use ice_domain_size, only: ncat, n_iso, n_aero, nfsd @@ -254,7 +254,7 @@ subroutine init_restart if (trim(runtype) == 'continue') then ! start from core restart file call restartfile() ! given by pointer in ice_in - call calendar(time) ! update time parameters + call calendar() ! update time parameters if (kdyn == 2) call read_restart_eap ! EAP else if (restart) then ! ice_ic = core restart file call restartfile (ice_ic) ! or 'default' or 'none' diff --git a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 index 644ef72fa..3daa7e192 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 @@ -44,7 +44,7 @@ module CICE_RunMod subroutine CICE_Run - use ice_calendar, only: istep, istep1, time, dt, stop_now, calendar + use ice_calendar, only: istep, istep1, dt, calendar, advance_timestep use ice_forcing, only: get_forcing_atmo, get_forcing_ocn, & get_wave_spec use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & @@ -77,18 +77,16 @@ subroutine CICE_Run ! timestep loop !-------------------------------------------------------------------- - istep = istep + 1 ! update time step counters - istep1 = istep1 + 1 - time = time + dt ! determine the time and date - call ice_timer_start(timer_couple) ! atm/ocn coupling + call advance_timestep() ! advance timestep and update calendar data + if (z_tracers) call get_atm_bgc ! biogeochemistry call init_flux_atm ! Initialize atmosphere fluxes sent to coupler call init_flux_ocn ! initialize ocean fluxes sent to coupler - call calendar(time) ! at the end of the timestep + call calendar() ! at the end of the timestep call ice_timer_stop(timer_couple) ! atm/ocn coupling @@ -113,7 +111,7 @@ subroutine ice_step use ice_boundary, only: ice_HaloUpdate use ice_calendar, only: dt, dt_dyn, ndtd, diagfreq, write_restart, istep - use ice_calendar, only: idate, sec + use ice_calendar, only: idate, msec use ice_diagnostics, only: init_mass_diags, runtime_diags use ice_diagnostics_bgc, only: hbrine_diags, zsal_diags, bgc_diags use ice_domain, only: halo_info, nblocks @@ -185,7 +183,7 @@ subroutine ice_step if (prescribed_ice) then ! read prescribed ice call t_barrierf('cice_run_presc_BARRIER',MPI_COMM_ICE) call t_startf ('cice_run_presc') - call ice_prescribed_run(idate, sec) + call ice_prescribed_run(idate, msec) call t_stopf ('cice_run_presc') endif #endif diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index da3d95369..ebfc3d674 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -29,13 +29,13 @@ module ice_comp_nuopc use ice_grid , only : tlon, tlat, hm, tarea, ULON, ULAT use ice_communicate , only : init_communicate, my_task, master_task, mpi_comm_ice use ice_calendar , only : force_restart_now, write_ic - use ice_calendar , only : idate, mday, time, month, daycal, time2sec, year_init - use ice_calendar , only : sec, dt, calendar, calendar_type, nextsw_cday, istep + use ice_calendar , only : idate, mday, mmonth, year_init, timesecs + use ice_calendar , only : msec, dt, calendar, calendar_type, nextsw_cday, istep use ice_kinds_mod , only : dbl_kind, int_kind, char_len, char_len_long use ice_scam , only : scmlat, scmlon, single_column use ice_fileunits , only : nu_diag, nu_diag_set, inst_index, inst_name use ice_fileunits , only : inst_suffix, release_all_fileunits, flush_fileunit - use ice_restart_shared , only : runid, runtype, restart_dir, restart_file + use ice_restart_shared , only : runid, runtype, restart, use_restart_time, restart_dir, restart_file use ice_history , only : accum_hist use CICE_InitMod , only : cice_init use CICE_RunMod , only : cice_run @@ -395,7 +395,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) Tocnfrz_in = -34.0_dbl_kind*0.054_dbl_kind, & pi_in = SHR_CONST_PI, & snowpatch_in = 0.005_dbl_kind, & - dragio_in = 0.00962_dbl_kind) + dragio_in = 0.00536_dbl_kind) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -422,8 +422,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) runtype = "initial" else if (trim(starttype) == trim('continue') ) then runtype = "continue" + restart = .true. + use_restart_time = .true. else if (trim(starttype) == trim('branch')) then runtype = "continue" + restart = .true. + use_restart_time = .true. else call abort_ice( subname//' ERROR: unknown starttype' ) end if @@ -514,12 +518,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call shr_file_setLogUnit (shrlogunit) - call NUOPC_CompAttributeGet(gcomp, name="diro", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name="diro", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then diag_filename = trim(cvalue) end if - call NUOPC_CompAttributeGet(gcomp, name="logfile", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name="logfile", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then diag_filename = trim(diag_filename) // '/' // trim(cvalue) @@ -600,14 +606,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call abort_ice(subname//' :: ERROR idate lt zero') endif iyear = (idate/10000) ! integer year of basedate - month = (idate-iyear*10000)/100 ! integer month of basedate - mday = idate-iyear*10000-month*100 ! day of month of basedate + mmonth= (idate-iyear*10000)/100 ! integer month of basedate + mday = idate-iyear*10000-mmonth*100 ! day of month of basedate if (my_task == master_task) then write(nu_diag,*) trim(subname),' curr_ymd = ',curr_ymd write(nu_diag,*) trim(subname),' cice year_init = ',year_init write(nu_diag,*) trim(subname),' cice start date = ',idate - write(nu_diag,*) trim(subname),' cice start ymds = ',iyear,month,mday,start_tod + write(nu_diag,*) trim(subname),' cice start ymds = ',iyear,mmonth,mday,start_tod write(nu_diag,*) trim(subname),' cice calendar_type = ',trim(calendar_type) endif @@ -615,15 +621,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (calendar_type == "GREGORIAN" .or. & calendar_type == "Gregorian" .or. & calendar_type == "gregorian") then - call time2sec(iyear-(year_init-1),month,mday,time) + call time2sec(iyear-(year_init-1),mmonth,mday,time) else - call time2sec(iyear-year_init,month,mday,time) + call time2sec(iyear-year_init,mmonth,mday,time) endif #endif - time = time+start_tod + timesecs = timesecs+start_tod end if - call calendar(time) ! update calendar info + call calendar() ! update calendar info if (write_ic) then call accum_hist(dt) ! write initial conditions end if @@ -878,7 +884,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! TODO (mvertens, 2018-12-21): fill in iceberg_prognostic as .false. if (debug_export > 0 .and. my_task==master_task) then call State_fldDebug(exportState, flds_scalar_name, 'cice_export:', & - idate, sec, nu_diag, rc=rc) + idate, msec, nu_diag, rc=rc) end if !-------------------------------- @@ -1019,7 +1025,7 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- ! cice clock - tod = sec + tod = msec ymd = idate ! model clock @@ -1080,7 +1086,7 @@ subroutine ModelAdvance(gcomp, rc) ! write Debug output if (debug_import > 0 .and. my_task==master_task) then call State_fldDebug(importState, flds_scalar_name, 'cice_import:', & - idate, sec, nu_diag, rc=rc) + idate, msec, nu_diag, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if (dbug > 0) then @@ -1107,7 +1113,7 @@ subroutine ModelAdvance(gcomp, rc) ! write Debug output if (debug_export > 0 .and. my_task==master_task) then call State_fldDebug(exportState, flds_scalar_name, 'cice_export:', & - idate, sec, nu_diag, rc=rc) + idate, msec, nu_diag, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if (dbug > 0) then diff --git a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 index 78ea39b4e..6eca4f2b4 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 @@ -47,7 +47,7 @@ end subroutine ice_prescribed_init use ice_blocks , only : nx_block, ny_block, block, get_block use ice_domain , only : nblocks, distrb_info, blocks_ice use ice_grid , only : TLAT, TLON, hm, tmask, tarea, grid_type, ocn_gridcell_frac - use ice_calendar , only : idate, sec, calendar_type + use ice_calendar , only : idate, calendar_type use ice_arrays_column , only : hin_max use ice_read_write use ice_exit , only: abort_ice diff --git a/cicecore/drivers/nuopc/dmi/CICE.F90 b/cicecore/drivers/nuopc/dmi/CICE.F90 index 2fd0c9f88..7056e0e5b 100644 --- a/cicecore/drivers/nuopc/dmi/CICE.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE.F90 @@ -57,39 +57,3 @@ program icemodel end program icemodel !======================================================================= -! -! Wrapper for the print_state debugging routine. -! Useful for debugging in the main driver (see ice.F_debug) -! ip, jp, mtask are set in ice_diagnostics.F -! -! author Elizabeth C. Hunke, LANL -! - subroutine debug_ice(iblk, plabeld) - - use ice_kinds_mod - use ice_calendar, only: istep1 - use ice_communicate, only: my_task - use ice_diagnostics, only: check_step, iblkp, ip, jp, mtask, print_state - use ice_blocks, only: nx_block, ny_block - - character (char_len), intent(in) :: plabeld - integer (kind=int_kind), intent(in) :: iblk - - ! local - integer (kind=int_kind) :: i, j - character(len=*), parameter :: subname='(debug_ice)' - - if (istep1 >= check_step .and. & - iblk==iblkp .and. my_task==mtask) then - - do j = 1, ny_block - do i = 1, nx_block - if (i==ip .and. j==jp) call print_state(plabeld,i,j,iblk) - enddo - enddo - - endif - - end subroutine debug_ice - -!======================================================================= diff --git a/cicecore/drivers/nuopc/dmi/CICE_FinalMod.F90 b/cicecore/drivers/nuopc/dmi/CICE_FinalMod.F90 index 9e2681dbb..9f32875e1 100644 --- a/cicecore/drivers/nuopc/dmi/CICE_FinalMod.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE_FinalMod.F90 @@ -35,9 +35,9 @@ subroutine CICE_Finalize character(len=*), parameter :: subname = '(CICE_Finalize)' - !------------------------------------------------------------------- - ! stop timers and print timer info - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! stop timers and print timer info + !------------------------------------------------------------------- call ice_timer_stop(timer_total) ! stop timing entire run call ice_timer_print_all(stats=.false.) ! print timing information @@ -55,15 +55,9 @@ subroutine CICE_Finalize !echmod if (nu_diag /= 6) close (nu_diag) ! diagnostic output call release_all_fileunits - !------------------------------------------------------------------- - ! write 'finished' file if needed - !------------------------------------------------------------------- - - if (runid == 'bering') call writeout_finished_file() - - !------------------------------------------------------------------- - ! quit MPI - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! quit MPI + !------------------------------------------------------------------- #ifndef coupled #ifndef CICE_DMI @@ -72,31 +66,6 @@ subroutine CICE_Finalize #endif end subroutine CICE_Finalize -!======================================================================= -! -! Write a file indicating that this run finished cleanly. This is -! needed only for runs on machine 'bering' (set using runid = 'bering'). -! -! author: Adrian Turner, LANL - - subroutine writeout_finished_file() - - use ice_restart_shared, only: restart_dir - - character(len=char_len_long) :: filename - character(len=*), parameter :: subname = '(writeout_finished_file)' - - if (my_task == master_task) then - - filename = trim(restart_dir)//"finished" - open(11,file=filename) - write(11,*) "finished" - close(11) - - endif - - end subroutine writeout_finished_file - !======================================================================= end module CICE_FinalMod diff --git a/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 b/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 index 70ef5f895..625348863 100644 --- a/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 @@ -46,9 +46,9 @@ subroutine CICE_Initialize(mpi_comm) integer (kind=int_kind), optional, intent(in) :: mpi_comm ! communicator from nuopc character(len=*), parameter :: subname='(CICE_Initialize)' - !-------------------------------------------------------------------- - ! model initialization - !-------------------------------------------------------------------- + !-------------------------------------------------------------------- + ! model initialization + !-------------------------------------------------------------------- if (present(mpi_comm)) then call cice_init(mpi_comm) @@ -69,14 +69,15 @@ subroutine cice_init(mpi_comm) floe_binwidth, c_fsd_range use ice_state, only: alloc_state use ice_flux_bgc, only: alloc_flux_bgc - use ice_calendar, only: dt, dt_dyn, time, istep, istep1, write_ic, & - init_calendar, calendar + use ice_calendar, only: dt, dt_dyn, istep, istep1, write_ic, & + init_calendar, advance_timestep, calc_timesteps use ice_communicate, only: init_communicate, my_task, master_task use ice_diagnostics, only: init_diags use ice_domain, only: init_domain_blocks use ice_domain_size, only: ncat, nfsd use ice_dyn_eap, only: init_eap, alloc_dyn_eap use ice_dyn_shared, only: kdyn, init_dyn, alloc_dyn_shared + use ice_dyn_vp, only: init_vp use ice_flux, only: init_coupler_flux, init_history_therm, & init_history_dyn, init_flux_atm, init_flux_ocn, alloc_flux use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & @@ -87,7 +88,8 @@ subroutine cice_init(mpi_comm) use ice_history, only: init_hist, accum_hist use ice_restart_shared, only: restart, runtype use ice_init, only: input_data, init_state - use ice_init_column, only: init_thermo_vertical, init_shortwave, init_zbgc, input_zbgc, count_tracers + use ice_init_column, only: init_thermo_vertical, init_shortwave, & + init_zbgc, input_zbgc, count_tracers use ice_kinds_mod use ice_restoring, only: ice_HaloRestore_init use ice_timers, only: timer_total, init_ice_timers, ice_timer_start @@ -166,9 +168,6 @@ subroutine cice_init(mpi_comm) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) -#ifndef CICE_DMI - call calendar(time) ! determine the initial date -#endif #ifndef CICE_IN_NEMO call init_forcing_ocn(dt) ! initialize sss and sst from data #endif @@ -188,6 +187,7 @@ subroutine cice_init(mpi_comm) call init_diags ! initialize diagnostic output points call init_history_therm ! initialize thermo history variables call init_history_dyn ! initialize dynamic history variables + call calc_timesteps ! update timestep counter if not using npt_unit="1" call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) call icepack_query_tracer_flags(tr_iso_out=tr_iso) @@ -204,10 +204,7 @@ subroutine cice_init(mpi_comm) if (trim(runtype) == 'continue' .or. restart) & call init_shortwave ! initialize radiative transfer - istep = istep + 1 ! update time step counters - istep1 = istep1 + 1 - time = time + dt ! determine the time and date - call calendar(time) ! at the end of the first timestep + call advance_timestep() !-------------------------------------------------------------------- ! coupler communication or forcing data initialization @@ -252,7 +249,7 @@ subroutine init_restart use ice_arrays_column, only: dhsn use ice_blocks, only: nx_block, ny_block - use ice_calendar, only: time, calendar + use ice_calendar, only: calendar use ice_constants, only: c0 use ice_domain, only: nblocks use ice_domain_size, only: ncat, n_iso, n_aero, nfsd @@ -314,7 +311,7 @@ subroutine init_restart if (trim(runtype) == 'continue') then ! start from core restart file call restartfile() ! given by pointer in ice_in - call calendar(time) ! update time parameters + call calendar() ! update time parameters if (kdyn == 2) call read_restart_eap ! EAP else if (restart) then ! ice_ic = core restart file call restartfile (ice_ic) ! or 'default' or 'none' diff --git a/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 b/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 index df8fe4978..cfd519146 100644 --- a/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 @@ -43,7 +43,7 @@ module CICE_RunMod subroutine CICE_Run - use ice_calendar, only: istep, istep1, time, dt, stop_now, calendar + use ice_calendar, only: istep, istep1, dt, stop_now, advance_timestep use ice_forcing, only: get_forcing_atmo, get_forcing_ocn, & get_wave_spec use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & @@ -73,20 +73,16 @@ subroutine CICE_Run file=__FILE__, line=__LINE__) #ifndef CICE_IN_NEMO - !-------------------------------------------------------------------- - ! timestep loop - !-------------------------------------------------------------------- + !-------------------------------------------------------------------- + ! timestep loop + !-------------------------------------------------------------------- #ifndef CICE_DMI - timeLoop: do + timeLoop: do #endif #endif call ice_step - istep = istep + 1 ! update time step counters - istep1 = istep1 + 1 - time = time + dt ! determine the time and date - - call calendar(time) ! at the end of the timestep + call advance_timestep() ! advance time #ifndef CICE_IN_NEMO #ifndef CICE_DMI @@ -361,8 +357,8 @@ subroutine coupling_prep (iblk) albpnd, albcnt, apeff_ai, fpond, fresh, l_mpond_fresh, & alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & fresh_ai, fsalt_ai, fsalt, & - fswthru_ai, fhocn, fswthru, scale_factor, snowfrac, & - fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & + fswthru_ai, fhocn, scale_factor, snowfrac, & + fswthru, fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt @@ -556,11 +552,12 @@ subroutine coupling_prep (iblk) evap (:,:,iblk), & Tref (:,:,iblk), Qref (:,:,iblk), & fresh (:,:,iblk), fsalt (:,:,iblk), & - fhocn (:,:,iblk), fswthru (:,:,iblk), & - fswthru_vdr(:,:,iblk), & - fswthru_vdf(:,:,iblk), & - fswthru_idr(:,:,iblk), & - fswthru_idf(:,:,iblk), & + fhocn (:,:,iblk), & + fswthru (:,:,iblk), & + fswthru_vdr (:,:,iblk), & + fswthru_vdf (:,:,iblk), & + fswthru_idr (:,:,iblk), & + fswthru_idf (:,:,iblk), & faero_ocn(:,:,:,iblk), & alvdr (:,:,iblk), alidr (:,:,iblk), & alvdf (:,:,iblk), alidf (:,:,iblk), & @@ -635,11 +632,12 @@ subroutine sfcflux_to_ocn(nx_block, ny_block, & real (kind=dbl_kind) :: & puny, & ! + Lsub, & ! rLsub ! 1/Lsub character(len=*), parameter :: subname = '(sfcflux_to_ocn)' - call icepack_query_parameters(puny_out=puny) + call icepack_query_parameters(puny_out=puny, Lsub_out=Lsub) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) diff --git a/cicecore/drivers/standalone/cice/CICE.F90 b/cicecore/drivers/standalone/cice/CICE.F90 index 2fd0c9f88..7056e0e5b 100644 --- a/cicecore/drivers/standalone/cice/CICE.F90 +++ b/cicecore/drivers/standalone/cice/CICE.F90 @@ -57,39 +57,3 @@ program icemodel end program icemodel !======================================================================= -! -! Wrapper for the print_state debugging routine. -! Useful for debugging in the main driver (see ice.F_debug) -! ip, jp, mtask are set in ice_diagnostics.F -! -! author Elizabeth C. Hunke, LANL -! - subroutine debug_ice(iblk, plabeld) - - use ice_kinds_mod - use ice_calendar, only: istep1 - use ice_communicate, only: my_task - use ice_diagnostics, only: check_step, iblkp, ip, jp, mtask, print_state - use ice_blocks, only: nx_block, ny_block - - character (char_len), intent(in) :: plabeld - integer (kind=int_kind), intent(in) :: iblk - - ! local - integer (kind=int_kind) :: i, j - character(len=*), parameter :: subname='(debug_ice)' - - if (istep1 >= check_step .and. & - iblk==iblkp .and. my_task==mtask) then - - do j = 1, ny_block - do i = 1, nx_block - if (i==ip .and. j==jp) call print_state(plabeld,i,j,iblk) - enddo - enddo - - endif - - end subroutine debug_ice - -!======================================================================= diff --git a/cicecore/drivers/standalone/cice/CICE_FinalMod.F90 b/cicecore/drivers/standalone/cice/CICE_FinalMod.F90 index dd0ca0b20..a59c210aa 100644 --- a/cicecore/drivers/standalone/cice/CICE_FinalMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_FinalMod.F90 @@ -55,12 +55,6 @@ subroutine CICE_Finalize !echmod if (nu_diag /= 6) close (nu_diag) ! diagnostic output call release_all_fileunits - !------------------------------------------------------------------- - ! write 'finished' file if needed - !------------------------------------------------------------------- - - if (runid == 'bering') call writeout_finished_file() - !------------------------------------------------------------------- ! quit MPI !------------------------------------------------------------------- @@ -69,31 +63,6 @@ subroutine CICE_Finalize end subroutine CICE_Finalize -!======================================================================= -! -! Write a file indicating that this run finished cleanly. This is -! needed only for runs on machine 'bering' (set using runid = 'bering'). -! -! author: Adrian Turner, LANL - - subroutine writeout_finished_file() - - use ice_restart_shared, only: restart_dir - - character(len=char_len_long) :: filename - character(len=*), parameter :: subname = '(writeout_finished_file)' - - if (my_task == master_task) then - - filename = trim(restart_dir)//"finished" - open(11,file=filename) - write(11,*) "finished" - close(11) - - endif - - end subroutine writeout_finished_file - !======================================================================= end module CICE_FinalMod diff --git a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 index 8b507740d..60f71fa8a 100644 --- a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 @@ -64,8 +64,8 @@ subroutine cice_init floe_binwidth, c_fsd_range use ice_state, only: alloc_state use ice_flux_bgc, only: alloc_flux_bgc - use ice_calendar, only: dt, dt_dyn, time, istep, istep1, write_ic, & - init_calendar, calendar + use ice_calendar, only: dt, dt_dyn, istep, istep1, write_ic, & + init_calendar, advance_timestep, calc_timesteps use ice_communicate, only: init_communicate, my_task, master_task use ice_diagnostics, only: init_diags use ice_domain, only: init_domain_blocks @@ -156,8 +156,6 @@ subroutine cice_init if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) -! call calendar(time) ! determine the initial date - call init_forcing_ocn(dt) ! initialize sss and sst from data call init_state ! initialize the ice state call init_transport ! initialize horizontal transport @@ -175,6 +173,7 @@ subroutine cice_init call init_diags ! initialize diagnostic output points call init_history_therm ! initialize thermo history variables call init_history_dyn ! initialize dynamic history variables + call calc_timesteps ! update timestep counter if not using npt_unit="1" call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) call icepack_query_tracer_flags(tr_iso_out=tr_iso) @@ -191,10 +190,12 @@ subroutine cice_init if (trim(runtype) == 'continue' .or. restart) & call init_shortwave ! initialize radiative transfer - istep = istep + 1 ! update time step counters - istep1 = istep1 + 1 - time = time + dt ! determine the time and date - call calendar(time) ! at the end of the first timestep +! tcraig, use advance_timestep here +! istep = istep + 1 ! update time step counters +! istep1 = istep1 + 1 +! time = time + dt ! determine the time and date +! call calendar(time) ! at the end of the first timestep + call advance_timestep() !-------------------------------------------------------------------- ! coupler communication or forcing data initialization @@ -231,7 +232,7 @@ subroutine init_restart use ice_arrays_column, only: dhsn use ice_blocks, only: nx_block, ny_block - use ice_calendar, only: time, calendar + use ice_calendar, only: calendar use ice_constants, only: c0 use ice_domain, only: nblocks use ice_domain_size, only: ncat, n_iso, n_aero, nfsd @@ -293,7 +294,7 @@ subroutine init_restart if (trim(runtype) == 'continue') then ! start from core restart file call restartfile() ! given by pointer in ice_in - call calendar(time) ! update time parameters + call calendar() ! update time parameters if (kdyn == 2) call read_restart_eap ! EAP else if (restart) then ! ice_ic = core restart file call restartfile (ice_ic) ! or 'default' or 'none' diff --git a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 index 9f6f42f28..08059435f 100644 --- a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 @@ -43,7 +43,7 @@ module CICE_RunMod subroutine CICE_Run - use ice_calendar, only: istep, istep1, time, dt, stop_now, calendar + use ice_calendar, only: istep, istep1, dt, stop_now, advance_timestep use ice_forcing, only: get_forcing_atmo, get_forcing_ocn, & get_wave_spec use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & @@ -82,11 +82,12 @@ subroutine CICE_Run call ice_step - istep = istep + 1 ! update time step counters - istep1 = istep1 + 1 - time = time + dt ! determine the time and date - - call calendar(time) ! at the end of the timestep +! tcraig, use advance_timestep now +! istep = istep + 1 ! update time step counters +! istep1 = istep1 + 1 +! time = time + dt ! determine the time and date +! call calendar(time) ! at the end of the timestep + call advance_timestep() ! advance time #ifndef CICE_IN_NEMO if (stop_now >= 1) exit timeLoop @@ -137,7 +138,7 @@ subroutine ice_step use ice_boundary, only: ice_HaloUpdate use ice_calendar, only: dt, dt_dyn, ndtd, diagfreq, write_restart, istep - use ice_diagnostics, only: init_mass_diags, runtime_diags + use ice_diagnostics, only: init_mass_diags, runtime_diags, debug_model, debug_ice use ice_diagnostics_bgc, only: hbrine_diags, zsal_diags, bgc_diags use ice_domain, only: halo_info, nblocks use ice_dyn_eap, only: write_restart_eap @@ -175,6 +176,15 @@ subroutine ice_step character(len=*), parameter :: subname = '(ice_step)' + character (len=char_len) :: plabeld + + if (debug_model) then + plabeld = 'beginning time step' + do iblk = 1, nblocks + call debug_ice (iblk, plabeld) + enddo + endif + call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc, skl_bgc_out=skl_bgc, & solve_zsal_out=solve_zsal, z_tracers_out=z_tracers, ktherm_out=ktherm, & wave_spec_out=wave_spec) @@ -218,14 +228,36 @@ subroutine ice_step if (calc_Tsfc) call prep_radiation (iblk) + if (debug_model) then + plabeld = 'post prep_radiation' + call debug_ice (iblk, plabeld) + endif + !----------------------------------------------------------------- ! thermodynamics and biogeochemistry !----------------------------------------------------------------- call step_therm1 (dt, iblk) ! vertical thermodynamics + + if (debug_model) then + plabeld = 'post step_therm1' + call debug_ice (iblk, plabeld) + endif + call biogeochemistry (dt, iblk) ! biogeochemistry + + if (debug_model) then + plabeld = 'post biogeochemistry' + call debug_ice (iblk, plabeld) + endif + call step_therm2 (dt, iblk) ! ice thickness distribution thermo + if (debug_model) then + plabeld = 'post step_therm2' + call debug_ice (iblk, plabeld) + endif + endif ! ktherm > 0 enddo ! iblk @@ -251,6 +283,13 @@ subroutine ice_step ! momentum, stress, transport call step_dyn_horiz (dt_dyn) + if (debug_model) then + plabeld = 'post step_dyn_horiz' + do iblk = 1, nblocks + call debug_ice (iblk, plabeld) + enddo ! iblk + endif + ! ridging !$OMP PARALLEL DO PRIVATE(iblk) do iblk = 1, nblocks @@ -258,12 +297,26 @@ subroutine ice_step enddo !$OMP END PARALLEL DO + if (debug_model) then + plabeld = 'post step_dyn_ridge' + do iblk = 1, nblocks + call debug_ice (iblk, plabeld) + enddo ! iblk + endif + ! clean up, update tendency diagnostics offset = c0 call update_state (dt_dyn, daidtd, dvidtd, dagedtd, offset) enddo + if (debug_model) then + plabeld = 'post dynamics' + do iblk = 1, nblocks + call debug_ice (iblk, plabeld) + enddo + endif + !----------------------------------------------------------------- ! albedo, shortwave radiation !----------------------------------------------------------------- @@ -277,12 +330,22 @@ subroutine ice_step if (ktherm >= 0) call step_radiation (dt, iblk) + if (debug_model) then + plabeld = 'post step_radiation' + call debug_ice (iblk, plabeld) + endif + !----------------------------------------------------------------- ! get ready for coupling and the next time step !----------------------------------------------------------------- call coupling_prep (iblk) + if (debug_model) then + plabeld = 'post coupling_prep' + call debug_ice (iblk, plabeld) + endif + enddo ! iblk !$OMP END PARALLEL DO @@ -627,11 +690,12 @@ subroutine sfcflux_to_ocn(nx_block, ny_block, & real (kind=dbl_kind) :: & puny, & ! + Lsub, & ! rLsub ! 1/Lsub character(len=*), parameter :: subname = '(sfcflux_to_ocn)' - call icepack_query_parameters(puny_out=puny) + call icepack_query_parameters(puny_out=puny, Lsub_out=Lsub) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) diff --git a/cicecore/drivers/standalone/cice/CICE_RunMod.F90_debug b/cicecore/drivers/standalone/cice/CICE_RunMod.F90_debug deleted file mode 100644 index 5f7eebe31..000000000 --- a/cicecore/drivers/standalone/cice/CICE_RunMod.F90_debug +++ /dev/null @@ -1,704 +0,0 @@ -!======================================================================= -! -! Main driver for time stepping of CICE. -! -! authors Elizabeth C. Hunke, LANL -! Philip W. Jones, LANL -! William H. Lipscomb, LANL -! -! 2006 ECH: moved exit timeLoop to prevent execution of unnecessary timestep -! 2006 ECH: Streamlined for efficiency -! 2006 ECH: Converted to free source form (F90) -! 2007 BPB: Modified Delta-Eddington shortwave interface -! 2008 ECH: moved ESMF code to its own driver - - module CICE_RunMod - - use ice_kinds_mod - use ice_fileunits, only: nu_diag - use ice_arrays_column, only: oceanmixed_ice - use ice_constants, only: c0, c1 - use ice_constants, only: field_loc_center, field_type_scalar - use ice_exit, only: abort_ice - use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted - use icepack_intfc, only: icepack_max_iso, icepack_max_aero - use icepack_intfc, only: icepack_query_parameters - use icepack_intfc, only: icepack_query_tracer_flags, icepack_query_tracer_sizes - - implicit none - private - public :: CICE_Run, ice_step - -!======================================================================= - - contains - -!======================================================================= -! -! This is the main driver routine for advancing CICE forward in time. -! -! author Elizabeth C. Hunke, LANL -! Philip W. Jones, LANL -! William H. Lipscomb, LANL - - subroutine CICE_Run - - use ice_calendar, only: istep, istep1, time, dt, stop_now, calendar - use ice_forcing, only: get_forcing_atmo, get_forcing_ocn, & - get_wave_spec - use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & - fiso_default, faero_default - use ice_flux, only: init_flux_atm, init_flux_ocn - use ice_timers, only: ice_timer_start, ice_timer_stop, & - timer_couple, timer_step - logical (kind=log_kind) :: & - tr_iso, tr_aero, tr_zaero, skl_bgc, z_tracers, wave_spec, tr_fsd - character(len=*), parameter :: subname = '(CICE_Run)' - - !-------------------------------------------------------------------- - ! initialize error code and step timer - !-------------------------------------------------------------------- - - call ice_timer_start(timer_step) ! start timing entire run - - call icepack_query_parameters(skl_bgc_out=skl_bgc, & - z_tracers_out=z_tracers, & - wave_spec_out=wave_spec) - call icepack_query_tracer_flags(tr_iso_out=tr_iso, & - tr_aero_out=tr_aero, & - tr_zaero_out=tr_zaero, & - tr_fsd_out=tr_fsd) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - -#ifndef CICE_IN_NEMO - !-------------------------------------------------------------------- - ! timestep loop - !-------------------------------------------------------------------- - - timeLoop: do -#endif - - call ice_step - - istep = istep + 1 ! update time step counters - istep1 = istep1 + 1 - time = time + dt ! determine the time and date - - call calendar(time) ! at the end of the timestep - -#ifndef CICE_IN_NEMO - if (stop_now >= 1) exit timeLoop -#endif - - call ice_timer_start(timer_couple) ! atm/ocn coupling - -! for now, wave_spectrum is constant in time -! if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice - call get_forcing_atmo ! atmospheric forcing from data - call get_forcing_ocn(dt) ! ocean forcing from data - - ! isotopes - if (tr_iso) call fiso_default ! default values - ! aerosols - ! if (tr_aero) call faero_data ! data file - ! if (tr_zaero) call fzaero_data ! data file (gx1) - if (tr_aero .or. tr_zaero) call faero_default ! default values - - if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry - if (z_tracers) call get_atm_bgc ! biogeochemistry - - call init_flux_atm ! Initialize atmosphere fluxes sent to coupler - call init_flux_ocn ! initialize ocean fluxes sent to coupler - - call ice_timer_stop(timer_couple) ! atm/ocn coupling - -#ifndef CICE_IN_NEMO - enddo timeLoop -#endif - - !-------------------------------------------------------------------- - ! end of timestep loop - !-------------------------------------------------------------------- - - call ice_timer_stop(timer_step) ! end timestepping loop timer - - end subroutine CICE_Run - -!======================================================================= -! -! Calls drivers for physics components, some initialization, and output -! -! author Elizabeth C. Hunke, LANL -! William H. Lipscomb, LANL - - subroutine ice_step - - use ice_boundary, only: ice_HaloUpdate - use ice_calendar, only: dt, dt_dyn, ndtd, diagfreq, write_restart, istep - use ice_diagnostics, only: init_mass_diags, runtime_diags - use ice_diagnostics_bgc, only: hbrine_diags, zsal_diags, bgc_diags - use ice_domain, only: halo_info, nblocks - use ice_dyn_eap, only: write_restart_eap - use ice_dyn_shared, only: kdyn, kridge - use ice_flux, only: scale_factor, init_history_therm, & - daidtt, daidtd, dvidtt, dvidtd, dagedtt, dagedtd - use ice_history, only: accum_hist - use ice_history_bgc, only: init_history_bgc - use ice_restart, only: final_restart - use ice_restart_column, only: write_restart_age, write_restart_FY, & - write_restart_lvl, write_restart_pond_cesm, write_restart_pond_lvl, & - write_restart_pond_topo, write_restart_aero, write_restart_fsd, & - write_restart_iso, write_restart_bgc, write_restart_hbrine - use ice_restart_driver, only: dumpfile - use ice_restoring, only: restore_ice, ice_HaloRestore - use ice_step_mod, only: prep_radiation, step_therm1, step_therm2, & - update_state, step_dyn_horiz, step_dyn_ridge, step_radiation, & - biogeochemistry, save_init, step_dyn_wave - use ice_timers, only: ice_timer_start, ice_timer_stop, & - timer_diags, timer_column, timer_thermo, timer_bound, & - timer_hist, timer_readwrite - - integer (kind=int_kind) :: & - iblk , & ! block index - k , & ! dynamics supercycling index - ktherm ! thermodynamics is off when ktherm = -1 - - real (kind=dbl_kind) :: & - offset ! d(age)/dt time offset - - logical (kind=log_kind) :: & - tr_iage, tr_FY, tr_lvl, tr_fsd, & - tr_pond_cesm, tr_pond_lvl, tr_pond_topo, tr_brine, tr_iso, tr_aero, & - calc_Tsfc, skl_bgc, solve_zsal, z_tracers, wave_spec - - character(len=*), parameter :: subname = '(ice_step)' - - character (len=char_len) :: plabeld - - plabeld = 'beginning time step' - do iblk = 1, nblocks - call debug_ice (iblk, plabeld) - enddo - - call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc, skl_bgc_out=skl_bgc, & - solve_zsal_out=solve_zsal, z_tracers_out=z_tracers, ktherm_out=ktherm, & - wave_spec_out=wave_spec) - call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & - tr_lvl_out=tr_lvl, tr_pond_cesm_out=tr_pond_cesm, tr_pond_lvl_out=tr_pond_lvl, & - tr_pond_topo_out=tr_pond_topo, tr_brine_out=tr_brine, tr_aero_out=tr_aero, & - tr_iso_out=tr_iso, tr_fsd_out=tr_fsd) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - !----------------------------------------------------------------- - ! restoring on grid boundaries - !----------------------------------------------------------------- - - if (restore_ice) call ice_HaloRestore - - !----------------------------------------------------------------- - ! initialize diagnostics and save initial state values - !----------------------------------------------------------------- - - call ice_timer_start(timer_diags) ! diagnostics/history - call init_mass_diags ! diagnostics per timestep - call init_history_therm - call init_history_bgc - call ice_timer_stop(timer_diags) ! diagnostics/history - - call ice_timer_start(timer_column) ! column physics - call ice_timer_start(timer_thermo) ! thermodynamics - - call save_init - - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - - if (ktherm >= 0) then - - !----------------------------------------------------------------- - ! scale radiation fields - !----------------------------------------------------------------- - - if (calc_Tsfc) call prep_radiation (iblk) - - plabeld = 'post prep_radiation' - call debug_ice (iblk, plabeld) - - !----------------------------------------------------------------- - ! thermodynamics and biogeochemistry - !----------------------------------------------------------------- - - call step_therm1 (dt, iblk) ! vertical thermodynamics - - plabeld = 'post step_therm1' - call debug_ice (iblk, plabeld) - - call biogeochemistry (dt, iblk) ! biogeochemistry - - plabeld = 'post biogeochemistry' - call debug_ice (iblk, plabeld) - - call step_therm2 (dt, iblk) ! ice thickness distribution thermo - - plabeld = 'post step_therm2' - call debug_ice (iblk, plabeld) - - endif ! ktherm > 0 - - enddo ! iblk - !$OMP END PARALLEL DO - - ! clean up, update tendency diagnostics - offset = dt - call update_state (dt, daidtt, dvidtt, dagedtt, offset) - - call ice_timer_stop(timer_thermo) ! thermodynamics - call ice_timer_stop(timer_column) ! column physics - - !----------------------------------------------------------------- - ! dynamics, transport, ridging - !----------------------------------------------------------------- - - ! wave fracture of the floe size distribution - ! note this is called outside of the dynamics subcycling loop - if (tr_fsd .and. wave_spec) call step_dyn_wave(dt) - - do k = 1, ndtd - - ! momentum, stress, transport - call step_dyn_horiz (dt_dyn) - - do iblk = 1, nblocks - plabeld = 'post step_dyn_horiz' - call debug_ice (iblk, plabeld) - enddo ! iblk - - ! ridging - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - if (kridge > 0) call step_dyn_ridge (dt_dyn, ndtd, iblk) - enddo - !$OMP END PARALLEL DO - - do iblk = 1, nblocks - plabeld = 'post step_dyn_ridge' - call debug_ice (iblk, plabeld) - enddo ! iblk - - ! clean up, update tendency diagnostics - offset = c0 - call update_state (dt_dyn, daidtd, dvidtd, dagedtd, offset) - - enddo - - plabeld = 'post dynamics' - do iblk = 1, nblocks - call debug_ice (iblk, plabeld) - enddo - - !----------------------------------------------------------------- - ! albedo, shortwave radiation - !----------------------------------------------------------------- - - call ice_timer_start(timer_column) ! column physics - call ice_timer_start(timer_thermo) ! thermodynamics - -!MHRI: CHECK THIS OMP - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - - if (ktherm >= 0) call step_radiation (dt, iblk) - - plabeld = 'post step_radiation' - call debug_ice (iblk, plabeld) - - !----------------------------------------------------------------- - ! get ready for coupling and the next time step - !----------------------------------------------------------------- - - call coupling_prep (iblk) - - plabeld = 'post coupling_prep' - call debug_ice (iblk, plabeld) - - enddo ! iblk - !$OMP END PARALLEL DO - - call ice_timer_start(timer_bound) - call ice_HaloUpdate (scale_factor, halo_info, & - field_loc_center, field_type_scalar) - call ice_timer_stop(timer_bound) - - call ice_timer_stop(timer_thermo) ! thermodynamics - call ice_timer_stop(timer_column) ! column physics - - !----------------------------------------------------------------- - ! write data - !----------------------------------------------------------------- - - call ice_timer_start(timer_diags) ! diagnostics - if (mod(istep,diagfreq) == 0) then - call runtime_diags(dt) ! log file - if (solve_zsal) call zsal_diags - if (skl_bgc .or. z_tracers) call bgc_diags - if (tr_brine) call hbrine_diags - endif - call ice_timer_stop(timer_diags) ! diagnostics - - call ice_timer_start(timer_hist) ! history - call accum_hist (dt) ! history file - call ice_timer_stop(timer_hist) ! history - - call ice_timer_start(timer_readwrite) ! reading/writing - if (write_restart == 1) then - call dumpfile ! core variables for restarting - if (tr_iage) call write_restart_age - if (tr_FY) call write_restart_FY - if (tr_lvl) call write_restart_lvl - if (tr_pond_cesm) call write_restart_pond_cesm - if (tr_pond_lvl) call write_restart_pond_lvl - if (tr_pond_topo) call write_restart_pond_topo - if (tr_fsd) call write_restart_fsd - if (tr_iso) call write_restart_iso - if (tr_aero) call write_restart_aero - if (solve_zsal .or. skl_bgc .or. z_tracers) & - call write_restart_bgc - if (tr_brine) call write_restart_hbrine - if (kdyn == 2) call write_restart_eap - call final_restart - endif - - call ice_timer_stop(timer_readwrite) ! reading/writing - - end subroutine ice_step - -!======================================================================= -! -! Prepare for coupling -! -! authors: Elizabeth C. Hunke, LANL - - subroutine coupling_prep (iblk) - - use ice_arrays_column, only: alvdfn, alidfn, alvdrn, alidrn, & - albicen, albsnon, albpndn, apeffn, fzsal_g, fzsal, snowfracn - use ice_blocks, only: nx_block, ny_block, get_block, block - use ice_domain, only: blocks_ice - use ice_calendar, only: dt, nstreams - use ice_domain_size, only: ncat - use ice_flux, only: alvdf, alidf, alvdr, alidr, albice, albsno, & - albpnd, albcnt, apeff_ai, fpond, fresh, l_mpond_fresh, & - alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & - fresh_ai, fsalt_ai, fsalt, & - fswthru_ai, fhocn, scale_factor, snowfrac, & - fswthru, fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & - swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & - fsens, flat, fswabs, flwout, evap, Tref, Qref, & - scale_fluxes, frzmlt_init, frzmlt - use ice_flux_bgc, only: faero_ocn, fiso_ocn, Qref_iso, fiso_evap, & - fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai - use ice_grid, only: tmask - use ice_state, only: aicen, aice -#ifdef CICE_IN_NEMO - use ice_state, only: aice_init - use ice_flux, only: flatn_f, fsurfn_f -#endif - use ice_step_mod, only: ocean_mixed_layer - use ice_timers, only: timer_couple, ice_timer_start, ice_timer_stop - - integer (kind=int_kind), intent(in) :: & - iblk ! block index - - ! local variables - - integer (kind=int_kind) :: & - ilo,ihi,jlo,jhi, & ! beginning and end of physical domain - n , & ! thickness category index - i,j , & ! horizontal indices - k , & ! tracer index - nbtrcr ! - - type (block) :: & - this_block ! block information for current block - - logical (kind=log_kind) :: & - calc_Tsfc ! - - real (kind=dbl_kind) :: & - cszn , & ! counter for history averaging - puny , & ! - rhofresh , & ! - netsw ! flag for shortwave radiation presence - - character(len=*), parameter :: subname = '(coupling_prep)' - - call icepack_query_parameters(puny_out=puny, rhofresh_out=rhofresh) - call icepack_query_tracer_sizes(nbtrcr_out=nbtrcr) - call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - !----------------------------------------------------------------- - ! Save current value of frzmlt for diagnostics. - ! Update mixed layer with heat and radiation from ice. - !----------------------------------------------------------------- - - do j = 1, ny_block - do i = 1, nx_block - frzmlt_init (i,j,iblk) = frzmlt(i,j,iblk) - enddo - enddo - - call ice_timer_start(timer_couple) ! atm/ocn coupling - - if (oceanmixed_ice) & - call ocean_mixed_layer (dt,iblk) ! ocean surface fluxes and sst - - !----------------------------------------------------------------- - ! Aggregate albedos - !----------------------------------------------------------------- - - do j = 1, ny_block - do i = 1, nx_block - alvdf(i,j,iblk) = c0 - alidf(i,j,iblk) = c0 - alvdr(i,j,iblk) = c0 - alidr(i,j,iblk) = c0 - - albice(i,j,iblk) = c0 - albsno(i,j,iblk) = c0 - albpnd(i,j,iblk) = c0 - apeff_ai(i,j,iblk) = c0 - snowfrac(i,j,iblk) = c0 - - ! for history averaging - cszn = c0 - netsw = swvdr(i,j,iblk)+swidr(i,j,iblk)+swvdf(i,j,iblk)+swidf(i,j,iblk) - if (netsw > puny) cszn = c1 - do n = 1, nstreams - albcnt(i,j,iblk,n) = albcnt(i,j,iblk,n) + cszn - enddo - enddo - enddo - - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do n = 1, ncat - do j = jlo, jhi - do i = ilo, ihi - if (aicen(i,j,n,iblk) > puny) then - - alvdf(i,j,iblk) = alvdf(i,j,iblk) & - + alvdfn(i,j,n,iblk)*aicen(i,j,n,iblk) - alidf(i,j,iblk) = alidf(i,j,iblk) & - + alidfn(i,j,n,iblk)*aicen(i,j,n,iblk) - alvdr(i,j,iblk) = alvdr(i,j,iblk) & - + alvdrn(i,j,n,iblk)*aicen(i,j,n,iblk) - alidr(i,j,iblk) = alidr(i,j,iblk) & - + alidrn(i,j,n,iblk)*aicen(i,j,n,iblk) - - netsw = swvdr(i,j,iblk) + swidr(i,j,iblk) & - + swvdf(i,j,iblk) + swidf(i,j,iblk) - if (netsw > puny) then ! sun above horizon - albice(i,j,iblk) = albice(i,j,iblk) & - + albicen(i,j,n,iblk)*aicen(i,j,n,iblk) - albsno(i,j,iblk) = albsno(i,j,iblk) & - + albsnon(i,j,n,iblk)*aicen(i,j,n,iblk) - albpnd(i,j,iblk) = albpnd(i,j,iblk) & - + albpndn(i,j,n,iblk)*aicen(i,j,n,iblk) - endif - - apeff_ai(i,j,iblk) = apeff_ai(i,j,iblk) & ! for history - + apeffn(i,j,n,iblk)*aicen(i,j,n,iblk) - snowfrac(i,j,iblk) = snowfrac(i,j,iblk) & ! for history - + snowfracn(i,j,n,iblk)*aicen(i,j,n,iblk) - - endif ! aicen > puny - enddo - enddo - enddo - - do j = 1, ny_block - do i = 1, nx_block - - !----------------------------------------------------------------- - ! reduce fresh by fpond for coupling - !----------------------------------------------------------------- - - if (l_mpond_fresh) then - fpond(i,j,iblk) = fpond(i,j,iblk) * rhofresh/dt - fresh(i,j,iblk) = fresh(i,j,iblk) - fpond(i,j,iblk) - endif - - !---------------------------------------------------------------- - ! Store grid box mean albedos and fluxes before scaling by aice - !---------------------------------------------------------------- - - alvdf_ai (i,j,iblk) = alvdf (i,j,iblk) - alidf_ai (i,j,iblk) = alidf (i,j,iblk) - alvdr_ai (i,j,iblk) = alvdr (i,j,iblk) - alidr_ai (i,j,iblk) = alidr (i,j,iblk) - fresh_ai (i,j,iblk) = fresh (i,j,iblk) - fsalt_ai (i,j,iblk) = fsalt (i,j,iblk) - fhocn_ai (i,j,iblk) = fhocn (i,j,iblk) - fswthru_ai(i,j,iblk) = fswthru(i,j,iblk) - fzsal_ai (i,j,iblk) = fzsal (i,j,iblk) - fzsal_g_ai(i,j,iblk) = fzsal_g(i,j,iblk) - - if (nbtrcr > 0) then - do k = 1, nbtrcr - flux_bio_ai (i,j,k,iblk) = flux_bio (i,j,k,iblk) - enddo - endif - - !----------------------------------------------------------------- - ! Save net shortwave for scaling factor in scale_factor - !----------------------------------------------------------------- - scale_factor(i,j,iblk) = & - swvdr(i,j,iblk)*(c1 - alvdr_ai(i,j,iblk)) & - + swvdf(i,j,iblk)*(c1 - alvdf_ai(i,j,iblk)) & - + swidr(i,j,iblk)*(c1 - alidr_ai(i,j,iblk)) & - + swidf(i,j,iblk)*(c1 - alidf_ai(i,j,iblk)) - - enddo - enddo - - !----------------------------------------------------------------- - ! Divide fluxes by ice area - ! - the CESM coupler assumes fluxes are per unit ice area - ! - also needed for global budget in diagnostics - !----------------------------------------------------------------- - - call scale_fluxes (nx_block, ny_block, & - tmask (:,:,iblk), nbtrcr, & - icepack_max_aero, & - aice (:,:,iblk), Tf (:,:,iblk), & - Tair (:,:,iblk), Qa (:,:,iblk), & - strairxT (:,:,iblk), strairyT(:,:,iblk), & - fsens (:,:,iblk), flat (:,:,iblk), & - fswabs (:,:,iblk), flwout (:,:,iblk), & - evap (:,:,iblk), & - Tref (:,:,iblk), Qref (:,:,iblk), & - fresh (:,:,iblk), fsalt (:,:,iblk), & - fhocn (:,:,iblk), & - fswthru (:,:,iblk), & - fswthru_vdr (:,:,iblk), & - fswthru_vdf (:,:,iblk), & - fswthru_idr (:,:,iblk), & - fswthru_idf (:,:,iblk), & - faero_ocn(:,:,:,iblk), & - alvdr (:,:,iblk), alidr (:,:,iblk), & - alvdf (:,:,iblk), alidf (:,:,iblk), & - fzsal (:,:,iblk), fzsal_g (:,:,iblk), & - flux_bio (:,:,1:nbtrcr,iblk), & - Qref_iso =Qref_iso (:,:,:,iblk), & - fiso_evap=fiso_evap(:,:,:,iblk), & - fiso_ocn =fiso_ocn (:,:,:,iblk)) - -#ifdef CICE_IN_NEMO -!echmod - comment this out for efficiency, if .not. calc_Tsfc - if (.not. calc_Tsfc) then - - !--------------------------------------------------------------- - ! If surface fluxes were provided, conserve these fluxes at ice - ! free points by passing to ocean. - !--------------------------------------------------------------- - - call sfcflux_to_ocn & - (nx_block, ny_block, & - tmask (:,:,iblk), aice_init(:,:,iblk), & - fsurfn_f (:,:,:,iblk), flatn_f(:,:,:,iblk), & - fresh (:,:,iblk), fhocn (:,:,iblk)) - endif -!echmod -#endif - call ice_timer_stop(timer_couple) ! atm/ocn coupling - - end subroutine coupling_prep - -#ifdef CICE_IN_NEMO - -!======================================================================= -! -! If surface heat fluxes are provided to CICE instead of CICE calculating -! them internally (i.e. .not. calc_Tsfc), then these heat fluxes can -! be provided at points which do not have ice. (This is could be due to -! the heat fluxes being calculated on a lower resolution grid or the -! heat fluxes not recalculated at every CICE timestep.) At ice free points, -! conserve energy and water by passing these fluxes to the ocean. -! -! author: A. McLaren, Met Office - - subroutine sfcflux_to_ocn(nx_block, ny_block, & - tmask, aice, & - fsurfn_f, flatn_f, & - fresh, fhocn) - - use ice_domain_size, only: ncat - - integer (kind=int_kind), intent(in) :: & - nx_block, ny_block ! block dimensions - - logical (kind=log_kind), dimension (nx_block,ny_block), intent(in) :: & - tmask ! land/boundary mask, thickness (T-cell) - - real (kind=dbl_kind), dimension(nx_block,ny_block), intent(in):: & - aice ! initial ice concentration - - real (kind=dbl_kind), dimension(nx_block,ny_block,ncat), intent(in) :: & - fsurfn_f, & ! net surface heat flux (provided as forcing) - flatn_f ! latent heat flux (provided as forcing) - - real (kind=dbl_kind), dimension(nx_block,ny_block), intent(inout):: & - fresh , & ! fresh water flux to ocean (kg/m2/s) - fhocn ! actual ocn/ice heat flx (W/m**2) - - - ! local variables - integer (kind=int_kind) :: & - i, j, n ! horizontal indices - - real (kind=dbl_kind) :: & - puny, & ! - rLsub ! 1/Lsub - - character(len=*), parameter :: subname = '(sfcflux_to_ocn)' - - call icepack_query_parameters(puny_out=puny) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - rLsub = c1 / Lsub - - do n = 1, ncat - do j = 1, ny_block - do i = 1, nx_block - if (tmask(i,j) .and. aice(i,j) <= puny) then - fhocn(i,j) = fhocn(i,j) & - + fsurfn_f(i,j,n) + flatn_f(i,j,n) - fresh(i,j) = fresh(i,j) & - + flatn_f(i,j,n) * rLsub - endif - enddo ! i - enddo ! j - enddo ! n - - - end subroutine sfcflux_to_ocn - -#endif - -!======================================================================= - - end module CICE_RunMod - -!======================================================================= diff --git a/cicecore/drivers/unittest/calchk/calchk.F90 b/cicecore/drivers/unittest/calchk/calchk.F90 new file mode 100644 index 000000000..bbd61b63e --- /dev/null +++ b/cicecore/drivers/unittest/calchk/calchk.F90 @@ -0,0 +1,588 @@ + + program calchk + + use ice_kinds_mod, only: int_kind, dbl_kind + use ice_calendar, only: myear, mmonth, mday, msec + use ice_calendar, only: year_init, month_init, day_init, sec_init + use ice_calendar, only: dt, ndtd, istep0, diagfreq, npt, npt_unit + use ice_calendar, only: months_per_year, daymo, timesecs, seconds_per_day + use ice_calendar, only: use_leap_years, days_per_year + use ice_calendar, only: compute_elapsed_days + use ice_calendar, only: update_date, calc_timesteps + use ice_calendar, only: init_calendar, calendar + use ice_calendar, only: set_date_from_timesecs + use ice_calendar, only: calendar_date2time, calendar_time2date + use ice_calendar, only: compute_calendar_data + implicit none + + integer(kind=int_kind) :: yearmax + integer(kind=int_kind) :: nday,nptc + integer(kind=int_kind) :: n,m,ny,nm,nd,nf1,nf2,xadd,nfa,nfb,nfc,ns1,ns2 + integer(kind=int_kind) :: yi,mi,di,si + integer(kind=int_kind) :: dyear,dmon,dday,dsec + integer(kind=int_kind) :: fyear,fmon,fday,fsec + character(len=32) :: calstr,unitstr,signstr + integer (kind=int_kind) :: tdaymo (months_per_year) ! days per month + integer (kind=int_kind) :: tdaycal(months_per_year+1) ! day count per month + integer (kind=int_kind) :: tdayyr ! days in year + + integer(kind=int_kind), parameter :: ntests = 8 + character(len=8) :: errorflag0,errorflag(1:ntests),errorflagtmp + character(len=32) :: testname(ntests) + integer(kind=int_kind) :: yearv(ntests),monv(ntests),dayv(ntests),secv(ntests),ndayv(ntests) ! computed values + integer(kind=int_kind) :: yearc(ntests),monc(ntests),dayc(ntests),secc(ntests),ndayc(ntests) ! correct results + real(kind=dbl_kind) :: timesecsv(ntests),timesecsc(ntests) + character(len=*), parameter :: & + passflag = 'PASS', & + failflag = 'FAIL' + + write(6,*) ' ' + write(6,*) 'Running CALCHK' + write(6,*) ' ' + + errorflag0 = passflag + errorflag(:) = passflag + testname(:) = '' + testname(1) = 'compute_elapsed_days' + testname(2) = 'set_date_from_timesecs' + testname(3) = 'calendar advance' + testname(4) = 'date2time time2date' + testname(5) = 'big add/sub update_date' + testname(6) = 'small add/sub update_date' + testname(7) = 'special checks' + testname(8) = 'calc_timesteps' + + ndtd = 1 + + ! test yearmax years from year 0 +! yearmax = 1000 + yearmax = 100000 + + ! test 3 calendars + do n = 1,3 + + errorflag(:) = passflag + + if (n == 1) then + use_leap_years = .false. + days_per_year = 365 + calstr = 'noleap' + elseif (n == 2) then + use_leap_years = .false. + days_per_year = 360 + calstr = '360day' + elseif (n == 3) then + use_leap_years = .true. + days_per_year = 365 + calstr = 'gregorian' + endif + + istep0 = 1000 + year_init = 0 + month_init = 1 + day_init = 1 + sec_init = 0 + myear = -1 + mmonth = -1 + mday = -1 + dt = 86400._dbl_kind + diagfreq = 99999999 + call init_calendar() + + !----------------- + ! This test makes sure compute_elapsed_days works for different calendars + ! and multiple years. This also checks that the timesecs value computed + ! in calendar and passed into set_date_from_timesecs returns the correct date. + ! In test1, nday should increment 1 day each loop and the final number + ! of days is known for 1000 and 100000 years (precomputed) + ! In test2, set_date_from_timesecs will reset myear, mmonth, mday, msec + !----------------- + + ndayc(1) = -1 ! prior day + do ny = 0,yearmax + do nm = 1,months_per_year + do nd = 1,daymo(nm) + + errorflagtmp = passflag + yearv(1) = ny + monv(1) = nm + dayv(1) = nd + secv(1) = 0 + + ! check days increment by 1 + ndayv(1) = compute_elapsed_days(yearv(1),monv(1),dayv(1)) + if (ndayv(1) - ndayc(1) /= 1) then + errorflagtmp = failflag + errorflag(1) = failflag + write(6,*) 'ERROR1: did not increment one day',yearv(1),monv(1),dayv(1),ndayv(1) + endif + + ! establish internal date and update internal calendar including timesecs + myear = yearv(1) + mmonth = monv(1) + mday = dayv(1) + msec = secv(1) + call calendar() + timesecsv(1) = timesecs + + ! check set_date_from_timesecs + yearc(2) = myear + monc(2) = mmonth + dayc(2) = mday + secc(2) = msec + timesecsc(2) = timesecs + ndayc(2) = ndayv(1) + myear = -1 + mmonth = -1 + mday = -1 + msec = -1 + timesecs = -1 + call set_date_from_timesecs(timesecsc(2)) + if (myear /= yearc(2) .or. mmonth /= monc(2) .or. mday /= dayc(2) .or. msec /= secc(2) .or. timesecs /= timesecsc(2)) then + errorflagtmp = failflag + errorflag(2) = failflag + write(6,*) 'ERROR2: timesecs error' + write(6,1001) 'e2',ndayc(2),yearc(2),'-',monc(2),'-',dayc(2),':',secc(2),' timesecs = ',timesecsc(2) + endif + if (errorflagtmp /= passflag .or. & + ndayv(1) <= 10 .or. mod(ndayv(1),yearmax*10) == 0 .or. & + (yearv(1) == yearmax .and. monv(1) == months_per_year)) then + write(6,1001) ' CHECK1: ',ndayv(1),yearv(1) ,'-',monv(1),'-',dayv(1),':',secv(1) ,' timesecs = ',timesecsv(1) + endif + ndayc(1) = ndayv(1) + enddo + enddo + enddo + + ! check total number of days run in yearmax years + if (yearmax == 1000) then + if (n == 1) then + ndayc(1) = 365364 + elseif (n == 2) then + ndayc(1) = 360359 + elseif (n == 3) then + ndayc(1) = 365607 + endif + if (ndayv(1) /= ndayc(1)) then + errorflag(1) = failflag + write(6,*) 'ERROR1a: final nday incorrect', ndayv(1), ndayc(1) + endif + endif + + ! check total number of days run in yearmax years + if (yearmax == 100000) then + if (n == 1) then + ndayc(1) = 36500364 + elseif (n == 2) then + ndayc(1) = 36000359 + elseif (n == 3) then + ndayc(1) = 36524615 + endif + if (ndayv(1) /= ndayc(1)) then + errorflag(1) = failflag + write(6,*) 'ERROR1a: final nday incorrect', ndayv(1), ndayc(1) + endif + endif + + !----------------- + ! check adding arbitrary amounts to each date unit and see if calendar reconciles properly + ! then subtract same arbitrary amounts in reverse order and make sure it ends at original value + !----------------- + + yearv(1) = 1000 + monv(1) = 1 + dayv(1) = 1 + secv(1) = 0 + myear = yearv(1) + mmonth = monv(1) + mday = dayv(1) + msec = secv(1) + call calendar() + nday = compute_elapsed_days(myear,mmonth,mday) + dyear = 0 + dmon = 0 + dday = 0 + dsec = 0 + do nfa = 1,-1,-2 + write(6,*) ' ' + write(6,1001) ' CHECK3: ',nday,myear ,'-',mmonth ,'-',mday ,':',msec ,' timesecs = ',timesecs + do nfb = 1,10 + do nfc = 1,4 + if (nfa == 1) then + nf1 = nfb + nf2 = nfc + signstr = 'Add' + elseif (nfa == -1) then + nf1 = 11-nfb + nf2 = 5-nfc + signstr = 'Sub' + endif + fyear = 0 + fmon = 0 + fday = 0 + fsec = 0 + if (nf2 == 1) then + xadd = nf1*nf1 + unitstr = 'years' + myear = myear + nfa*xadd + if (nfa == 1) dyear = dyear + nfa*xadd + fyear = nfa*xadd + elseif (nf2 == 2) then + xadd = nf1*nf1 + unitstr = 'months' + mmonth = mmonth + nfa*xadd + if (nfa == 1) dmon = dmon + nfa*xadd + fmon = nfa*xadd + elseif (nf2 == 3) then + xadd = nf1*nf1*nf1*nf1 + unitstr = 'days' + mday = mday + nfa*xadd + if (nfa == 1) dday = dday + nfa*xadd + fday = nfa*xadd + elseif (nf2 == 4) then + xadd = nf1*nf1*nf1*nf1*nf1*nf1*nf1 + unitstr = 'seconds' + msec = msec + nfa*xadd + if (nfa == 1) dsec = dsec + nfa*xadd + fsec = nfa*xadd + endif + call calendar() + nday = compute_elapsed_days(myear,mmonth,mday) + write(6,1002) ' CHECK3: '//trim(signstr)//' ',xadd,trim(unitstr) + write(6,1001) ' CHECK3: ',nday,myear ,'-',mmonth ,'-',mday ,':',msec ,' timesecs = ',timesecs + + !----------------- + ! This checks update_date add and subtract to make sure the original value is returned + !----------------- + + yearc(6) = myear + monc(6) = mmonth + dayc(6) = mday + secc(6) = msec + timesecsc(6) = timesecs + yearv(6) = yearc(6) + monv(6) = monc(6) + dayv(6) = dayc(6) + secv(6) = secc(6) + call update_date(yearv(6),monv(6),dayv(6),secv(6),fyear,fmon,fday,fsec) + write(6,1001) ' CHECK6: ',-1,yearv(6),'-',monv(6),'-',dayv(6),':',secv(6) + if (yearc(6) == yearv(6) .and. monc(6) == monv(6) .and. dayc(6) == dayv(6) .and. secc(6) == secv(6) .and. timesecsc(6) == timesecsv(6)) then + errorflag(6) = failflag + write(6,*) ' ' + write(6,*) 'ERROR6a: update date error' + write(6,1001) 'e6',nday,yearv(6),'-',monv(6),'-',dayv(6),':',secv(6),' timesecs = ',timesecsv(6) + write(6,1001) ' ',nday,yearc(6),'-',monc(6),'-',dayc(6),':',secc(6),' timesecs = ',timesecsc(6) + write(6,*) ' ',fyear,fmon,fday,fsec + write(6,*) ' ' + endif + call update_date(yearv(6),monv(6),dayv(6),secv(6),-fyear,-fmon,-fday,-fsec) + call calendar_date2time(yearc(6),monc(6),dayc(6),secc(6),timesecsv(6)) + if (yearc(6) /= yearv(6) .or. monc(6) /= monv(6) .or. dayc(6) /= dayv(6) .or. secc(6) /= secv(6) .or. timesecsc(6) /= timesecsv(6)) then + errorflag(6) = failflag + write(6,*) ' ' + write(6,*) 'ERROR6b: update date error' + write(6,1001) 'e6',nday,yearv(6),'-',monv(6),'-',dayv(6),':',secv(6),' timesecs = ',timesecsv(6) + write(6,1001) ' ',nday,yearc(6),'-',monc(6),'-',dayc(6),':',secc(6),' timesecs = ',timesecsc(6) + write(6,*) ' ',fyear,fmon,fday,fsec + write(6,*) ' ' + endif + + !----------------- + ! This checks date2time and time2date leveraging the pseudo random dates + ! plus various reference settings. Different reference dates means + ! timesecs won't match, so don't check them. + !----------------- + + yi = myear/2 + mi = max(mmonth/2,1) + di = max(mday*7/8,1) + si = max(msec*7/8,1) + yearc(4) = myear + monc(4) = mmonth + dayc(4) = mday + secc(4) = msec + timesecsc(4) = timesecs + yearv(4) = -1 + monv(4) = -1 + dayv(4) = -1 + secv(4) = -1 + timesecsv(4) = -1 + call calendar_date2time(yearc(4),monc(4),dayc(4),secc(4),timesecsv(4),yi,mi,di,si) + call calendar_time2date(timesecsv(4),yearv(4),monv(4),dayv(4),secv(4),yi,mi,di,si) + write(6,*) 'CHECK4: ',timesecsv(4) + if (yearc(4) /= yearv(4) .or. monc(4) /= monv(4) .or. dayc(4) /= dayv(4) .or. secc(4) /= secv(4)) then + errorflag(4) = failflag + write(6,*) ' ' + write(6,*) 'ERROR4: date2time time2date error' + write(6,1001) 'e4',nday,yearv(4),'-',monv(4),'-',dayv(4),':',secv(4),' timesecs = ',timesecsv(4) + write(6,1001) ' ',nday,yearc(4),'-',monc(4),'-',dayc(4),':',secc(4),' timesecs = ',timesecsc(4) + write(6,*) ' ' + endif + + enddo + enddo + + yearv(3) = myear + monv(3) = mmonth + dayv(3) = mday + secv(3) = msec + timesecsv(3) = timesecs + if (nfa == 1) then + if (n == 1) then + yearc(3) = 1487 + monc(3) = 1 + dayc(3) = 21 + secc(3) = 22825 + ndayc(3) = 542775 + elseif (n == 2) then + yearc(3) = 1488 + monc(3) = 1 + dayc(3) = 13 + secc(3) = 22825 + ndayc(3) = 535692 + elseif (n == 3) then + yearc(3) = 1487 + monc(3) = 1 + dayc(3) = 5 + secc(3) = 22825 + ndayc(3) = 543120 + endif + elseif (nfa == -1) then + yearc(3) = yearv(1) + monc(3) = monv(1) + dayc(3) = dayv(1) + secc(3) = secv(1) + if (n == 1) then + ndayc(3) = 365000 + elseif (n == 2) then + ndayc(3) = 360000 + elseif (n == 3) then + ndayc(3) = 365243 + endif + endif + + ! check answers + if (yearv(3) /= yearc(3) .or. monv(3) /= monc(3) .or. dayv(3) /= dayc(3) .or. secv(3) /= secc(3)) then + errorflag(3) = failflag + write(6,*) ' ' + write(6,*) 'ERROR3: calendar advance error' + write(6,1001) 'e3',nday,yearc(3),'-',monc(3),'-',dayc(3),':',secc(3),' timesecs = ',timesecsc(3) + write(6,1001) ' ',nday,yearv(3),'-',monv(3),'-',dayv(3),':',secv(3),' timesecs = ',timesecsv(3) + write(6,*) ' ' + endif + enddo + + write(6,*) ' ' + yearv(1) = 1000 + monv(1) = 1 + dayv(1) = 1 + secv(1) = 0 + yearv(5) = yearv(1) + monv(5) = monv(1) + dayv(5) = dayv(1) + secv(5) = secv(1) + write(6,1001) ' CHECK5a: ',-1,yearv(5) ,'-',monv(5) ,'-',dayv(5) ,':',secv(5) + write(6,1002) ' Add ',dyear,'years' + write(6,1002) ' Add ',dmon,'months' + write(6,1002) ' Add ',dday,'days' + write(6,1002) ' Add ',dsec,'seconds' + call update_date(yearv(5),monv(5),dayv(5),secv(5),dyear,dmon,dday,dsec) + write(6,1001) ' CHECK5a: ',-1,yearv(5) ,'-',monv(5) ,'-',dayv(5) ,':',secv(5) + write(6,*) ' ' + + ! correct answers + if (n == 1) then + yearc(5) = 1487 + monc(5) = 1 + dayc(5) = 24 + secc(5) = 22825 + ndayc(5) = 542775 + elseif (n == 2) then + yearc(5) = 1488 + monc(5) = 1 + dayc(5) = 13 + secc(5) = 22825 + ndayc(5) = 535692 + elseif (n == 3) then + yearc(5) = 1487 + monc(5) = 1 + dayc(5) = 7 + secc(5) = 22825 + ndayc(5) = 543120 + endif + + ! check answers + if (yearv(5) /= yearc(5) .or. monv(5) /= monc(5) .or. dayv(5) /= dayc(5) .or. secv(5) /= secc(5)) then + errorflag(5) = failflag + write(6,*) ' ' + write(6,*) 'ERROR5a: calendar advance error' + write(6,1001) 'e5',nday,yearc(5),'-',monc(5),'-',dayc(5),':',secc(5),' timesecs = ',timesecs + write(6,1001) ' ',nday,yearv(5),'-',monv(5),'-',dayv(5),':',secv(5),' timesecs = ',timesecs + write(6,*) ' ' + endif + + write(6,1001) ' CHECK5b: ',-1,yearv(5) ,'-',monv(5) ,'-',dayv(5) ,':',secv(5) + write(6,1002) ' Sub ',dyear,'years' + write(6,1002) ' Sub ',dmon,'months' + write(6,1002) ' Sub ',dday,'days' + write(6,1002) ' Sub ',dsec,'seconds' + call update_date(yearv(5),monv(5),dayv(5),secv(5),-dyear,-dmon,-dday,-dsec) + write(6,1001) ' CHECK5b: ',-1,yearv(5) ,'-',monv(5) ,'-',dayv(5) ,':',secv(5) + + ! correct answers + yearc(5) = yearv(1) + monc(5) = monv(1) + dayc(5) = dayv(1) + secc(5) = secv(1) + if (yearv(5) /= yearc(5) .or. monv(5) /= monc(5) .or. dayv(5) /= dayc(5) .or. secv(5) /= secc(5)) then + errorflag(5) = failflag + write(6,*) ' ' + write(6,*) 'ERROR5b: calendar advance error' + write(6,1001) 'e5',nday,yearc(5),'-',monc(5),'-',dayc(5),':',secc(5),' timesecs = ',timesecs + write(6,1001) ' ',nday,yearv(5),'-',monv(5),'-',dayv(5),':',secv(5),' timesecs = ',timesecs + write(6,*) ' ' + endif + + !------------------------- + ! Special checks: + ! Add a month to the last day of each month + ! Check date2time for seconds + !------------------------- + + write(6,*) ' ' + do ny = 1,5 + do nm = 1, months_per_year + if (ny == 1) yearv(7) = 1900 + if (ny == 2) yearv(7) = 1999 + if (ny == 3) yearv(7) = 2000 + if (ny == 4) yearv(7) = 2004 + if (ny == 5) yearv(7) = 2005 + call compute_calendar_data(yearv(7),tdaymo,tdaycal,tdayyr) + monv(7) = nm + dayv(7) = tdaymo(nm) + secv(7) = 0 + if (tdaymo(mod(nm,months_per_year)+1) >= tdaymo(nm)) then + monc(7) = mod(nm,months_per_year)+1 + dayc(7) = dayv(7) + else + monc(7) = mod(nm+1,months_per_year)+1 + dayc(7) = tdaymo(nm) - tdaymo(mod(nm,months_per_year)+1) + endif + yearc(7) = yearv(7) + if (monc(7) < monv(7)) yearc(7) = yearv(7) + 1 + secc(7) = secv(7) + call update_date(yearv(7),monv(7),dayv(7),secv(7),dmon=1) + write(6,1001) ' CHECK7a:',1,yearv(7),'-',monv(7),'-',dayv(7),':',secv(7) + if (yearv(7) /= yearc(7) .or. monv(7) /= monc(7) .or. dayv(7) /= dayc(7) .or. secv(7) /= secc(7)) then + errorflag(7) = failflag + write(6,*) ' ' + write(6,*) 'ERROR7a: add 1 month to end of month error' + write(6,1001) 'e7',-1,yearc(7),'-',monc(7),'-',dayc(7),':',secc(7) + write(6,1001) ' ',-1,yearv(7),'-',monv(7),'-',dayv(7),':',secv(7) + write(6,*) ' ' + endif + enddo + enddo + + do ns1 = 0,seconds_per_day,seconds_per_day/4 + do ns2 = 0,seconds_per_day,seconds_per_day/4 + yearv(7) = 2002 + monv(7) = 3 + call compute_calendar_data(yearv(7),tdaymo,tdaycal,tdayyr) + dayv(7) = tdaymo(monv(7)) + call calendar_date2time(yearv(7),monv(7),dayv(7),ns2,timesecsv(7),yearv(7),monv(7),dayv(7),ns1) + write(6,*) 'CHECK7b:',ns1,ns2,timesecsv(7) + if (timesecsv(7) /= ns2-ns1) then + errorflag(7) = failflag + write(6,*) ' ' + write(6,*) 'ERROR7b: sec diff same date error' + write(6,*) ' ',ns1,ns2,timesecsv(7),ns2-ns1 + write(6,*) ' ' + endif + call calendar_date2time(yearv(7),monv(7)+1,1,ns2,timesecsv(7),yearv(7),monv(7),dayv(7),ns1) + write(6,*) 'CHECK7c:',ns1,ns2,timesecsv(7) + if (timesecsv(7) /= ns2-ns1+seconds_per_day) then + errorflag(7) = failflag + write(6,*) ' ' + write(6,*) 'ERROR7c: sec diff next day error' + write(6,*) ' ',ns1,ns2,timesecsv(7),ns2-ns1+seconds_per_day + write(6,*) ' ' + endif + enddo + enddo + + !------------------------- + ! calc_timesteps + !------------------------- + + myear = 2000 + mmonth = 2 + mday = 1 + msec = 0 + do nf1 = 1,6 + npt = 10 + dt = 3600._dbl_kind + + if (nf1 == 1) then + npt_unit = '1' + nptc = 10 + endif + if (nf1 == 2) then + npt_unit = 's' + npt = 36000. + nptc = 10 + endif + if (nf1 == 3) then + npt_unit = 'h' + nptc = 10 + endif + if (nf1 == 4) then + npt_unit = 'd' + nptc = 240 + endif + if (nf1 == 5) then + npt_unit = 'm' + if (n == 1) nptc = 7272 + if (n == 2) nptc = 7200 + if (n == 3) nptc = 7296 + endif + if (nf1 == 6) then + npt_unit = 'y' + if (n == 1) nptc = 87600 + if (n == 2) nptc = 86400 + if (n == 3) nptc = 87672 + endif + call calc_timesteps() + write(6,*) 'CHECK8:',npt + if (npt /= nptc) then + errorflag(8) = failflag + write(6,*) 'ERROR8: npt error',npt,nptc + endif + enddo + + !------------------------- + ! write test results + !------------------------- + + write(6,*) ' ' + write(6,*) 'Test Results: ',yearmax,' years' + do m = 1,ntests + write(6,*) trim(errorflag(m))," ... ",trim(calstr)," ",trim(testname(m)) + if (errorflag(m) == failflag) errorflag0=failflag + enddo + write(6,*) ' ' + + enddo ! do n + + 1001 format(a,i10,1x,i7.4,a,i2.2,a,i2.2,a,i5.5,a,e23.16) + 1002 format(a,i10,1x,a) + + write(6,*) ' ' + if (errorflag0 == passflag) then + write(6,*) 'CALCHK COMPLETED SUCCESSFULLY' + else + write(6,*) 'CALCHK FAILED' + endif + + end program + diff --git a/cicecore/drivers/unittest/helloworld/helloworld.F90 b/cicecore/drivers/unittest/helloworld/helloworld.F90 new file mode 100644 index 000000000..651436bea --- /dev/null +++ b/cicecore/drivers/unittest/helloworld/helloworld.F90 @@ -0,0 +1,8 @@ + + program hello_world + + write(6,*) 'hello_world' + write(6,*) 'COMPLETED SUCCESSFULLY' + + end program + diff --git a/cicecore/shared/ice_calendar.F90 b/cicecore/shared/ice_calendar.F90 index e7107f42a..4d7ae378f 100644 --- a/cicecore/shared/ice_calendar.F90 +++ b/cicecore/shared/ice_calendar.F90 @@ -2,7 +2,7 @@ ! Calendar routines for managing time ! -! authors: Elizabeth C. Hunke, LANL +! Authors: Elizabeth C. Hunke, LANL ! Tony Craig, NCAR ! Craig MacLachlan, UK Met Office ! @@ -10,10 +10,12 @@ ! Converted to free form source (F90). ! 2010 CM : Fixed support for Gregorian calendar: subroutines ! sec2time, time2sec and set_calendar added. +! 2020 TC : Significant refactor to move away from time as prognostic module ice_calendar use ice_kinds_mod + use ice_communicate, only: my_task, master_task use ice_constants, only: c0, c1, c100, c30, c360, c365, c3600, & c4, c400 use ice_domain_size, only: max_nstrm @@ -25,78 +27,88 @@ module ice_calendar implicit none private - public :: init_calendar, calendar, time2sec, sec2time, hc_jday + ! INTERFACES - integer (kind=int_kind), public :: & - days_per_year , & ! number of days in one year - daymo(12) , & ! number of days in each month - daycal(13) ! day number at end of month + public :: init_calendar ! initialize calendar + public :: calc_timesteps ! initialize number of timesteps (after namelist and restart are read) + public :: advance_timestep ! advance model 1 timestep and update calendar + public :: calendar ! update model internal calendar/time information + public :: set_date_from_timesecs ! set model date from time in seconds + ! (relative to init date) + ! needed for binary restarts - ! 360-day year data - integer (kind=int_kind) :: & - daymo360(12) , & ! number of days in each month - daycal360(13) ! day number at end of month - data daymo360 / 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30/ - data daycal360/ 0,30, 60, 90,120,150,180,210,240,270,300,330,360/ + ! semi-private, only used directly by unit tester + public :: compute_elapsed_days ! compute elapsed days since 0000-01-01 + public :: compute_days_between ! compute elapsed days between two dates + public :: update_date ! input date and delta date, compute new date + public :: calendar_date2time ! convert date to time relative to init date + public :: calendar_time2date ! convert time to date relative to init date + public :: compute_calendar_data ! compute info about calendar for a given year - ! 365-day year data - integer (kind=int_kind) :: & - daymo365(12) , & ! number of days in each month - daycal365(13) ! day number at end of month - data daymo365 / 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/ - data daycal365/ 0,31, 59, 90,120,151,181,212,243,273,304,334,365/ + ! private functions + private :: set_calendar ! sets model calendar type (noleap, etc) - ! 366-day year data (leap year) - integer (kind=int_kind) :: & - daymo366(12) , & ! number of days in each month - daycal366(13) ! day number at end of month - data daymo366 / 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/ - data daycal366/ 0,31, 60, 91,121,152,182,213,244,274,305,335,366/ + ! PUBLIC - real (kind=dbl_kind), parameter :: & - days_per_4c = 146097.0_dbl_kind, & - days_per_c = 36524.0_dbl_kind, & - days_per_4y = 1461.0_dbl_kind, & - days_per_y = 365.0_dbl_kind + character(len=*), public, parameter :: & + ice_calendar_gregorian = 'Gregorian', & ! calendar name, actually proleptic gregorian here + ice_calendar_noleap = 'NO_LEAP', & ! 365 day per year calendar + ice_calendar_360day = '360day' ! 360 day calendar with 30 days per month + + integer (kind=int_kind), public, parameter :: & + months_per_year = 12, & ! months per year + hours_per_day = 24 ! hours per day + + integer (kind=int_kind), public :: & + seconds_per_day , & ! seconds per day + seconds_per_hour , & ! seconds per hour + days_per_year , & ! number of days in one year + daymo(months_per_year), & ! number of days in each month + daycal(months_per_year+1) ! accumulated days in year to end of prior month integer (kind=int_kind), public :: & - istep , & ! local step counter for time loop - istep0 , & ! counter, number of steps taken in previous run + ! step counters + istep , & ! local step counter for current run in time loop + istep0 , & ! counter, number of steps at start of run istep1 , & ! counter, number of steps at current timestep + ! basic model time variables + myear , & ! year number + mmonth , & ! month number, 1 to months_per_year mday , & ! day of the month - hour , & ! hour of the day - month , & ! month number, 1 to 12 - monthp , & ! last month + msec , & ! elapsed seconds into date + ! initial time year_init, & ! initial year - nyr , & ! year number + month_init,& ! initial month + day_init, & ! initial day of month + sec_init , & ! initial seconds + ! other stuff idate , & ! date (yyyymmdd) - idate0 , & ! initial date (yyyymmdd) - sec , & ! elapsed seconds into date + idate0 , & ! initial date (yyyymmdd), associated with year_init, month_init, day_init + dayyr , & ! number of days in the current year npt , & ! total number of time steps (dt) + npt0 , & ! original npt value in npt0_unit ndtd , & ! number of dynamics subcycles: dt_dyn=dt/ndtd stop_now , & ! if 1, end program execution write_restart, & ! if 1, write restart now diagfreq , & ! diagnostic output frequency (10 = once per 10 dt) dumpfreq_n , & ! restart output frequency (10 = once per 10 d,m,y) nstreams , & ! number of history output streams - histfreq_n(max_nstrm) ! history output frequency + histfreq_n(max_nstrm) ! history output frequency + + logical (kind=log_kind), public :: & + new_year , & ! new year = .true. + new_month , & ! new month = .true. + new_day , & ! new day = .true. + new_hour ! new hour = .true. real (kind=dbl_kind), public :: & dt , & ! thermodynamics timestep (s) dt_dyn , & ! dynamics/transport/ridging timestep (s) - time , & ! total elapsed time (s) - time_forc , & ! time of last forcing update (s) + timesecs , & ! total elapsed time (s) yday , & ! day of the year - tday , & ! absolute day number - dayyr , & ! number of days per year - nextsw_cday , & ! julian day of next shortwave calculation - basis_seconds ! Seconds since calendar zero + nextsw_cday ! julian day of next shortwave calculation logical (kind=log_kind), public :: & - new_year , & ! new year = .true. - new_month , & ! new month = .true. - new_day , & ! new day = .true. - new_hour , & ! new hour = .true. use_leap_years , & ! use leap year functionality if true write_ic , & ! write initial condition now dump_last , & ! write restart file on last time step @@ -104,6 +116,8 @@ module ice_calendar write_history(max_nstrm) ! write history now character (len=1), public :: & + npt_unit, & ! run length unit, 'y', 'm', 'd', 'h', 's', '1' + npt0_unit, & ! original run length unit, 'y', 'm', 'd', 'h', 's', '1' histfreq(max_nstrm), & ! history output frequency, 'y','m','d','h','1' dumpfreq ! restart frequency, 'y','m','d' @@ -111,17 +125,33 @@ module ice_calendar calendar_type ! differentiates Gregorian from other calendars ! default = ' ' + ! PRIVATE + + integer (kind=int_kind) :: & + hour ! hour of the day + + ! 360-day year data + integer (kind=int_kind) :: & + daymo360(months_per_year) ! number of days in each month + data daymo360 / 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30/ + + ! 365-day year data + integer (kind=int_kind) :: & + daymo365(months_per_year) ! number of days in each month + data daymo365 / 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/ + + ! 366-day year data (leap year) + integer (kind=int_kind) :: & + daymo366(months_per_year) ! number of days in each month + data daymo366 / 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/ + + !======================================================================= contains !======================================================================= - ! Initialize calendar variables -! -! authors: Elizabeth C. Hunke, LANL -! Tony Craig, NCAR -! Craig MacLachlan, UK Met Office subroutine init_calendar @@ -134,99 +164,178 @@ subroutine init_calendar if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) + seconds_per_day = nint(secday) + if ((abs(real(seconds_per_day,kind=dbl_kind)/secday)-1.0_dbl_kind) > 1.0e-7) then + write(nu_diag,*) trim(subname),' ERROR secday should basically be an integer',secday + call abort_ice(subname//'ERROR: improper secday') + endif + seconds_per_hour = nint(secday/real(hours_per_day,kind=dbl_kind)) + if (abs(seconds_per_hour*hours_per_day - seconds_per_day) > 0) then + write(nu_diag,*) trim(subname),' ERROR seconds per day and hours per day inconsistent' + call abort_ice(subname//'ERROR: improper seconds_per_hour') + endif + istep = 0 ! local timestep number - time=istep0*dt ! s - yday=c0 ! absolute day number - mday=0 ! day of the month - month=0 ! month - nyr=0 ! year - idate=00000101 ! date - sec=0 ! seconds into date + myear=year_init ! year + mmonth=month_init ! month + mday=day_init ! day of the month + msec=sec_init ! seconds into date + hour=0 ! computed in calendar, but needs some reasonable initial value istep1 = istep0 ! number of steps at current timestep ! real (dumped) or imagined (use to set calendar) + idate0 = (myear)*10000 + mmonth*100 + mday ! date (yyyymmdd) stop_now = 0 ! end program execution if stop_now=1 dt_dyn = dt/real(ndtd,kind=dbl_kind) ! dynamics et al timestep force_restart_now = .false. - ! Check that the number of days per year is set correctly when using - ! leap years. If not, set days_per_year correctly and warn the user. - if (use_leap_years .and. days_per_year /= 365) then - days_per_year = 365 - write(nu_diag,*) 'Warning: days_per_year has been set to 365', & - ' because use_leap_years = .true.' - end if - #ifdef CESMCOUPLED ! calendar_type set by coupling #else - calendar_type = ' ' - if (use_leap_years .and. days_per_year == 365) calendar_type = 'Gregorian' -#endif - - dayyr = real(days_per_year, kind=dbl_kind) - if (days_per_year == 360) then - daymo = daymo360 - daycal = daycal360 - elseif (days_per_year == 365) then - daymo = daymo365 - daycal = daycal365 - else - call abort_ice(subname//'ERROR: days_per_year must be 360 or 365') + calendar_type = '' + if (use_leap_years) then + if (days_per_year == 365) then + calendar_type = trim(ice_calendar_gregorian) + else + call abort_ice(subname//'ERROR: use_leap_years is true, must set days_per_year to 365') + endif + else + if (days_per_year == 365) then + calendar_type = trim(ice_calendar_noleap) + elseif (days_per_year == 360) then + calendar_type = trim(ice_calendar_360day) + else + call abort_ice(subname//'ERROR: days_per_year only 365 or 360 supported') + endif endif +#endif - ! Get the time in seconds from calendar zero to start of initial year - call time2sec(year_init,1,1,basis_seconds) + call set_calendar(myear) + call calendar() - ! determine initial date (assumes namelist year_init, istep0 unchanged) - sec = mod(time,secday) ! elapsed seconds into date at - ! end of dt - tday = (time-sec)/secday + c1 ! absolute day number + end subroutine init_calendar - ! Convert the current timestep into a calendar date - call sec2time(nyr,month,mday,basis_seconds+sec) +!======================================================================= +! Initialize timestep counter +! This converts npt_unit and npt to a number of timesteps stored in npt +! npt0 and npt0_unit remember the original values +! It is safe to call this more than once, but it should be called only after +! the initial model run date is known (from namelist or restart) and before +! the first timestep - yday = mday + daycal(month) ! day of the year - nyr = nyr - year_init + 1 ! year number + subroutine calc_timesteps - idate0 = (nyr+year_init-1)*10000 + month*100 + mday ! date (yyyymmdd) + real (kind=dbl_kind) :: secday ! seconds per day + real (kind=dbl_kind) :: dtimesecs ! time in seconds of run + integer (kind=int_kind) :: yeare,monthe,daye,sece ! time at end of run + character(len=*),parameter :: subname='(calc_timesteps)' - end subroutine init_calendar + call icepack_query_parameters(secday_out=secday) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) -!======================================================================= + yeare = myear + monthe = mmonth + daye = mday + sece = msec + npt0 = npt + npt0_unit = npt_unit + + if (npt_unit == 'y') then + call update_date(yeare,monthe,daye,sece,dyear=npt) + call calendar_date2time(yeare,monthe,daye,sece,dtimesecs,myear,mmonth,mday,msec) + elseif (npt_unit == 'm') then + call update_date(yeare,monthe,daye,sece,dmon=npt) + call calendar_date2time(yeare,monthe,daye,sece,dtimesecs,myear,mmonth,mday,msec) + elseif (npt_unit == 'd') then + dtimesecs = real(npt,kind=dbl_kind)*secday + call update_date(yeare,monthe,daye,sece,dday=npt) + elseif (npt_unit == 'h') then + dtimesecs = real(npt,kind=dbl_kind)*secday/real(hours_per_day,kind=dbl_kind) + call update_date(yeare,monthe,daye,sece,dsec=nint(dtimesecs)) + elseif (npt_unit == 's') then + call update_date(yeare,monthe,daye,sece,dsec=npt) + dtimesecs = real(npt,kind=dbl_kind) + elseif (npt_unit == '1') then + dtimesecs = dt*real(npt,kind=dbl_kind) + call update_date(yeare,monthe,daye,sece,dsec=nint(dtimesecs)) + else + write(nu_diag,*) trim(subname),' ERROR invalid npt_unit = ',trim(npt_unit) + call abort_ice(subname//'ERROR: invalid npt_unit') + endif + + npt = nint(dtimesecs/dt) + npt_unit = '1' + + if (my_task == master_task) then + write(nu_diag,*) ' ' + write(nu_diag,'(1x,2a,i9,a,f13.2)') subname,' modified npt from ',npt0,' '//trim(npt0_unit)//' with dt= ',dt + write(nu_diag,'(1x,2a,i9,a,f13.2)') subname,' to ',npt ,' '//trim(npt_unit )//' with dt= ',dt + write(nu_diag,'(1x,2a,i6.4,a,i2.2,a,i2.2,a,i5.5)') subname,' start time is',myear,'-',mmonth,'-',mday,':',msec + write(nu_diag,'(1x,2a,i6.4,a,i2.2,a,i2.2,a,i5.5)') subname,' end time is',yeare,'-',monthe,'-',daye,':',sece + write(nu_diag,*) ' ' + endif + + ! check that npt is very close to an integer + if ((abs(real(npt,kind=dbl_kind)*dt/dtimesecs)-1.0_dbl_kind) > 1.0e-7) then + write(nu_diag,*) trim(subname),' ERROR dt and npt not consistent',npt,dt + call abort_ice(subname//'ERROR: improper npt') + endif + + end subroutine calc_timesteps +!======================================================================= ! Determine the date at the end of the time step -! -! authors: Elizabeth C. Hunke, LANL -! Tony Craig, NCAR -! Craig MacLachlan, UK Met Office - subroutine calendar(ttime) + subroutine advance_timestep() - use ice_communicate, only: my_task, master_task + ! local variables + + integer(kind=int_kind) :: & + idt ! integer dt + character(len=*),parameter :: subname='(advance_timestep)' + + if (trim(npt_unit) /= '1') then + write(nu_diag,*) trim(subname),' ERROR npt_unit should be converted to timesteps by now ',trim(npt_unit) + write(nu_diag,*) trim(subname),' ERROR you may need to call calc_timesteps to convert from other units' + call abort_ice(subname//'ERROR: npt_unit incorrect') + endif + + istep = istep + 1 + istep1 = istep1 + 1 + idt = nint(dt) + ! dt is historically a real but it should be an integer + ! make sure dt is very close to an integer + if ((abs(real(idt,kind=dbl_kind)/dt)-1.0_dbl_kind) > 1.0e-7) then + write(nu_diag,*) trim(subname),' ERROR dt error, needs to be integer number of seconds, dt=',dt + call abort_ice(subname//'ERROR: improper dt') + endif + msec = msec + idt + call calendar() - real (kind=dbl_kind), intent(in) :: & - ttime ! time variable + end subroutine advance_timestep + +!======================================================================= +! Update the calendar and time manager info + + subroutine calendar() + +! real (kind=dbl_kind), intent(in), optional :: & +! ttime ! time variable ! local variables integer (kind=int_kind) :: & ns , & ! loop index - nyrp,mdayp,hourp , & ! previous year, day, hour + yearp,monthp,dayp,hourp , & ! previous year, month, day, hour elapsed_days , & ! since beginning this run elapsed_months , & ! since beginning this run - elapsed_hours , & ! since beginning this run - month0 - real (kind=dbl_kind) :: secday ! seconds per day + elapsed_hours ! since beginning this run character(len=*),parameter :: subname='(calendar)' - call icepack_query_parameters(secday_out=secday) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - nyrp=nyr - monthp=month - mdayp=mday + yearp=myear + monthp=mmonth + dayp=mday hourp=hour new_year=.false. new_month=.false. @@ -235,349 +344,576 @@ subroutine calendar(ttime) write_history(:)=.false. write_restart=0 - sec = mod(ttime,secday) ! elapsed seconds into date at - ! end of dt - tday = (ttime-sec)/secday + c1 ! absolute day number - - ! Deterime the current date from the timestep - call sec2time(nyr,month,mday,basis_seconds+ttime) + call update_date(myear,mmonth,mday,msec) + call set_calendar(myear) - yday = mday + daycal(month) ! day of the year - nyr = nyr - year_init + 1 ! year number - - hour = int((ttime)/c3600) + c1 ! hour + idate = (myear)*10000 + mmonth*100 + mday ! date (yyyymmdd) + yday = daycal(mmonth) + mday ! day of the year + hour = (msec+1)/(seconds_per_hour) + elapsed_months = (myear - year_init)*months_per_year + mmonth - month_init + elapsed_days = compute_days_between(year_init,month_init,day_init,myear,mmonth,mday) + elapsed_hours = elapsed_days * hours_per_day + call calendar_date2time(myear,mmonth,mday,msec,timesecs) - month0 = int((idate0 - int(idate0 / 10000) * 10000) / 100) - - elapsed_months = (nyr - 1)*12 + (month - month0) - elapsed_days = int((istep * dt) / secday) - elapsed_hours = int(ttime/3600) - - idate = (nyr+year_init-1)*10000 + month*100 + mday ! date (yyyymmdd) + !--- compute other stuff #ifndef CESMCOUPLED if (istep >= npt+1) stop_now = 1 if (istep == npt .and. dump_last) write_restart = 1 ! last timestep #endif - if (nyr /= nyrp) new_year = .true. - if (month /= monthp) new_month = .true. - if (mday /= mdayp) new_day = .true. - if (hour /= hourp) new_hour = .true. + if (myear /= yearp) new_year = .true. + if (mmonth /= monthp) new_month = .true. + if (mday /= dayp) new_day = .true. + if (hour /= hourp) new_hour = .true. + ! History writing flags do ns = 1, nstreams - if (histfreq(ns)=='1' .and. histfreq_n(ns)/=0) then - if (mod(istep1, histfreq_n(ns))==0) & - write_history(ns)=.true. - endif + + select case (histfreq(ns)) + case ("y", "Y") + if (new_year .and. histfreq_n(ns)/=0) then + if (mod(myear, histfreq_n(ns))==0) & + write_history(ns) = .true. + endif + case ("m", "M") + if (new_month .and. histfreq_n(ns)/=0) then + if (mod(elapsed_months,histfreq_n(ns))==0) & + write_history(ns) = .true. + endif + case ("d", "D") + if (new_day .and. histfreq_n(ns)/=0) then + if (mod(elapsed_days,histfreq_n(ns))==0) & + write_history(ns) = .true. + endif + case ("h", "H") + if (new_hour .and. histfreq_n(ns)/=0) then + if (mod(elapsed_hours,histfreq_n(ns))==0) & + write_history(ns) = .true. + endif + case ("1") + if (histfreq_n(ns)/=0) then + if (mod(istep1, histfreq_n(ns))==0) & + write_history(ns)=.true. + endif + end select + enddo - if (dumpfreq == '1') then + ! Restart writing flag + + select case (dumpfreq) + case ("y", "Y") + if (new_year .and. mod(myear, dumpfreq_n)==0) & + write_restart = 1 + case ("m", "M") + if (new_month .and. mod(elapsed_months,dumpfreq_n)==0) & + write_restart = 1 + case ("d", "D") + if (new_day .and. mod(elapsed_days, dumpfreq_n)==0) & + write_restart = 1 + case ("h", "H") + if (new_hour .and. mod(elapsed_hours, dumpfreq_n)==0) & + write_restart = 1 + case ("1") if (mod(istep1, dumpfreq_n)==0) & write_restart = 1 - endif - - if (istep > 1) then + end select - do ns = 1, nstreams + if (force_restart_now) write_restart = 1 - select case (histfreq(ns)) - case ("y", "Y") - if (new_year .and. histfreq_n(ns)/=0) then - if (mod(nyr, histfreq_n(ns))==0) & - write_history(ns) = .true. - endif - case ("m", "M") - if (new_month .and. histfreq_n(ns)/=0) then - if (mod(elapsed_months,histfreq_n(ns))==0) & - write_history(ns) = .true. - endif - case ("d", "D") - if (new_day .and. histfreq_n(ns)/=0) then - if (mod(elapsed_days,histfreq_n(ns))==0) & - write_history(ns) = .true. - endif - case ("h", "H") - if (new_hour .and. histfreq_n(ns)/=0) then - if (mod(elapsed_hours,histfreq_n(ns))==0) & - write_history(ns) = .true. - endif - end select - - enddo ! nstreams - - select case (dumpfreq) - case ("y", "Y") - if (new_year .and. mod(nyr, dumpfreq_n)==0) & - write_restart = 1 - case ("m", "M") - if (new_month .and. mod(elapsed_months,dumpfreq_n)==0) & - write_restart = 1 - case ("d", "D") - if (new_day .and. mod(elapsed_days, dumpfreq_n)==0) & - write_restart = 1 - case ("h", "H") - if (new_hour .and. mod(elapsed_hours, dumpfreq_n)==0) & - write_restart = 1 - end select - - if (force_restart_now) write_restart = 1 - - endif ! istep > 1 - - if (my_task == master_task .and. mod(istep,diagfreq) == 0 & + if (my_task == master_task .and. mod(istep1,diagfreq) == 0 & .and. stop_now /= 1) then write(nu_diag,*) ' ' write(nu_diag,'(a7,i10,4x,a6,i10,4x,a4,i10)') & - 'istep1:', istep1, 'idate:', idate, 'sec:', sec + 'istep1:', istep1, 'idate:', idate, 'sec:', msec endif end subroutine calendar !======================================================================= +! Set the model calendar data for year -! Convert the date to seconds since calendar zero. -! ** This is based on the UM routine TIME2SEC ** -! -! authors: Craig MacLachlan, UK Met Office + subroutine set_calendar(year) - subroutine time2sec(year,month,day,tsec) + integer (kind=int_kind), intent(in) :: year ! current year - integer (kind=int_kind), intent(in) :: year ! year - integer (kind=int_kind), intent(in) :: month ! month - integer (kind=int_kind), intent(in) :: day ! year - real (kind=dbl_kind), intent(out) :: tsec ! seconds since calendar zero + ! Internal variable + character(len=*),parameter :: subname='(set_calendar)' - ! local variables + call compute_calendar_data(year,daymo,daycal,dayyr) - real (kind=dbl_kind) :: days_since_calz ! days since calendar zero - real (kind=dbl_kind) :: secday ! seconds per day - integer (kind=int_kind) :: years_since_calz ! days since calendar zero - character(len=*),parameter :: subname='(time2sec)' + end subroutine set_calendar + +!======================================================================= +! Add and reconcile date +! delta time arguments are optional + + subroutine update_date(ayear,amon,aday,asec,dyear,dmon,dday,dsec) + + integer (kind=int_kind), intent(inout) :: ayear, amon, aday, asec ! year, month, day, sec + integer (kind=int_kind), intent(in), optional :: dyear, dmon, dday, dsec ! delta year, month, day, sec + + ! local variables + integer (kind=int_kind) :: tdaymo (months_per_year) ! days per month + integer (kind=int_kind) :: tdaycal(months_per_year+1) ! day count per month + integer (kind=int_kind) :: tdayyr ! days in year + real (kind=dbl_kind) :: secday ! seconds per day + integer (kind=int_kind) :: isecday ! seconds per day + integer (kind=int_kind) :: delta + character(len=*),parameter :: subname='(update_date)' call icepack_query_parameters(secday_out=secday) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) + isecday = nint(secday) + + ! order matters. think about adding 1 month and 10 days to the 25th of a month + ! what is the right order? + ! will add all deltas then reconcile years then months then days then seconds + + if (present(dyear)) ayear = ayear + dyear + if (present(dmon)) amon = amon + dmon + if (present(dday)) aday = aday + dday + if (present(dsec)) asec = asec + dsec + + ! adjust negative data first + ! reconcile months - years + do while (amon <= 0) + delta = int((abs(amon))/months_per_year) + 1 + ayear = ayear - delta + amon = amon + delta*months_per_year + enddo + call compute_calendar_data(ayear,tdaymo,tdaycal,tdayyr) + + ! reconcile days - months - years + do while (aday <= 0) + amon = amon - 1 + do while (amon <= 0) + delta = int((abs(amon))/months_per_year) + 1 + ayear = ayear - delta + amon = amon + delta*months_per_year + call compute_calendar_data(ayear,tdaymo,tdaycal,tdayyr) + enddo + aday = aday + tdaymo(amon) + enddo - if (dayyr == 360) then - days_since_calz = c360*year + c30*(month-1) + day - c1 - tsec = secday * days_since_calz + ! reconcile seconds - days - months - years + if (asec < 0) then + delta = int(abs(asec)/isecday) + 1 + aday = aday - delta + asec = asec + delta*isecday + endif + do while (aday <= 0) + amon = amon - 1 + do while (amon <= 0) + delta = int((abs(amon))/months_per_year) + 1 + ayear = ayear - delta + amon = amon + delta*months_per_year + call compute_calendar_data(ayear,tdaymo,tdaycal,tdayyr) + enddo + aday = aday + tdaymo(amon) + enddo - else - - if (use_leap_years) then + ! check for negative data + if (ayear < 0 .or. amon <= 0 .or. aday <= 0 .or. asec < 0) then + write(nu_diag,*) trim(subname),' ERROR in dateA, ',ayear,amon,aday,asec + call abort_ice(subname//'ERROR: in date') + endif + + ! reconcile months - years + do while (amon > months_per_year) + delta = int((amon-1)/months_per_year) + ayear = ayear + delta + amon = amon - delta*months_per_year + enddo + call compute_calendar_data(ayear,tdaymo,tdaycal,tdayyr) + + ! reconcile days - months - years + do while (aday > tdaymo(amon)) + aday = aday - tdaymo(amon) + amon = amon + 1 + do while (amon > months_per_year) + delta = int((amon-1)/months_per_year) + ayear = ayear + delta + amon = amon - delta*months_per_year + call compute_calendar_data(ayear,tdaymo,tdaycal,tdayyr) + enddo + enddo - call set_calendar(year) + ! reconcile seconds - days - months - years + if (asec >= isecday) then + delta = int(asec/isecday) + aday = aday + delta + asec = asec - delta*isecday + endif + do while (aday > tdaymo(amon)) + aday = aday - tdaymo(amon) + amon = amon + 1 + do while (amon > months_per_year) + delta = int((amon-1)/months_per_year) + ayear = ayear + delta + amon = amon - delta*months_per_year + call compute_calendar_data(ayear,tdaymo,tdaycal,tdayyr) + enddo + enddo - ! Add on the days from this year - days_since_calz = day + daycal(month) - c1 + ! check for negative data, just in case + if (ayear < 0 .or. amon <= 0 .or. aday <= 0 .or. asec < 0) then + write(nu_diag,*) trim(subname),' ERROR in dateB, ',ayear,amon,aday,asec + call abort_ice(subname//'ERROR: in date') + endif - ! Subtract a year because we only want to count whole years - years_since_calz = year - 1 - - ! Add days from preceeding years - days_since_calz = days_since_calz & - + int(years_since_calz/c400)*days_per_4c - years_since_calz = years_since_calz & - - int(years_since_calz/c400)*400 + end subroutine update_date - days_since_calz = days_since_calz & - + int(years_since_calz/c100)*days_per_c - years_since_calz = years_since_calz & - - int(years_since_calz/c100)*100 +!======================================================================= - days_since_calz = days_since_calz & - + int(years_since_calz/c4)*days_per_4y - years_since_calz = years_since_calz & - - int(years_since_calz/c4)*4 +! Set internal calendar date from timesecs input +! Needed for binary restarts where only timesecs is on the restart file - days_since_calz = days_since_calz & - + years_since_calz*days_per_y + subroutine set_date_from_timesecs(ttimesecs) - tsec = secday * days_since_calz - - else ! Using fixed 365-day calendar - - days_since_calz = c365*year + daycal365(month) + day - c1 - tsec = secday * days_since_calz + real (kind=dbl_kind), intent(in) :: ttimesecs ! seconds since init date - end if + ! Internal variable + character(len=*),parameter :: subname='(set_date_from_timesecs)' - end if + timesecs = ttimesecs + call calendar_time2date(ttimesecs,myear,mmonth,mday,msec,year_init,month_init,day_init,sec_init) - end subroutine time2sec + end subroutine set_date_from_timesecs !======================================================================= +! Compute elapsed days from year0,month0,day0 to year1,month1,day1 +! Same day results in 0 elapsed days -! Convert the time in seconds since calendar zero to a date. -! -! authors: Craig MacLachlan, UK Met Office + integer function compute_days_between(year0,month0,day0,year1,month1,day1) - subroutine sec2time(year,month,day,tsec) + integer (kind=int_kind), intent(in) :: year0 ! start year + integer (kind=int_kind), intent(in) :: month0 ! start month + integer (kind=int_kind), intent(in) :: day0 ! start day + integer (kind=int_kind), intent(in) :: year1 ! end year + integer (kind=int_kind), intent(in) :: month1 ! end month + integer (kind=int_kind), intent(in) :: day1 ! end day - integer (kind=int_kind), intent(out) :: year ! year - integer (kind=int_kind), intent(out) :: month ! month - integer (kind=int_kind), intent(out) :: day ! year - real (kind=dbl_kind), intent(in) :: tsec ! seconds since calendar zero + ! Internal variable + logical (kind=log_kind) :: isleap ! Leap year logical + integer (kind=int_kind) :: nday0, nday1 + character(len=*),parameter :: subname='(compute_days_between)' - ! local variables + nday0 = compute_elapsed_days(year0,month0,day0) + nday1 = compute_elapsed_days(year1,month1,day1) - real (kind=dbl_kind) :: days_since_calz ! days since calendar zero - real (kind=dbl_kind) :: secday ! seconds per day - integer (kind=int_kind) :: k ! counter - character(len=*),parameter :: subname='(sec2time)' + compute_days_between = nday1 - nday0 - call icepack_query_parameters(secday_out=secday) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) + end function compute_days_between + +!======================================================================= +! compute calendar data based on year + + subroutine compute_calendar_data(ayear,adaymo,adaycal,adayyr) + + integer (kind=int_kind), intent(in) :: ayear ! year + integer (kind=int_kind), intent(out) :: adaymo(:) ! days per month + integer (kind=int_kind), intent(out) :: adaycal(:) ! day count per month + integer (kind=int_kind), intent(out) :: adayyr ! days per year + + ! Internal variable + logical (kind=log_kind) :: isleap ! Leap year logical + integer (kind=int_kind) :: n + character(len=*),parameter :: subname='(compute_calendar_data)' - days_since_calz = int(tsec/secday) + if (ayear < 0) then + write(nu_diag,*) trim(subname),' ERROR in ayear = ',ayear + call abort_ice(subname//'ERROR: in ayear') + endif - if (dayyr == 360) then + if (size(adaymo) /= months_per_year .or. & + size(adaycal) /= months_per_year+1 ) then + call abort_ice(subname//'ERROR: in argument sizes') + endif - year = int(days_since_calz/c360) - month = mod(int(days_since_calz/c30),12) + 1 - day = mod(int(days_since_calz),30) + 1 + if (trim(calendar_type) == trim(ice_calendar_gregorian)) then + + isleap = .false. ! not a leap year + if (mod(ayear, 4) == 0) isleap = .true. + if (mod(ayear,100) == 0) isleap = .false. + if (mod(ayear,400) == 0) isleap = .true. + + if (isleap) then + adaymo = daymo366 + else + adaymo = daymo365 + endif + elseif (trim(calendar_type) == trim(ice_calendar_360day)) then + adaymo = daymo360 else + adaymo = daymo365 + endif - if (use_leap_years) then - - year = int(days_since_calz/days_per_4c)*400 - days_since_calz = days_since_calz & - - int(days_since_calz/days_per_4c)*days_per_4c - - if (days_since_calz == 4*days_per_c) then - year = year + 400 - days_since_calz = days_per_y + 1 - else - year = year + int(days_since_calz/days_per_c)*100 - days_since_calz = days_since_calz & - - int(days_since_calz/days_per_c)*days_per_c - - year = year + int(days_since_calz/days_per_4y)*4 - days_since_calz = days_since_calz & - - int(days_since_calz/days_per_4y)*days_per_4y - - if (days_since_calz == 4*days_per_y) then - year = year + 4 - days_since_calz = days_per_y + 1 - else - year = year + int(days_since_calz/days_per_y) + 1 - days_since_calz = days_since_calz & - - int(days_since_calz/days_per_y)*days_per_y + c1 - endif - endif + adaycal(1) = 0 + do n = 1, months_per_year + adaycal(n+1) = adaycal(n) + adaymo(n) + enddo + adayyr=adaycal(months_per_year+1) - ! Ensure the calendar variables are correct for this year. - call set_calendar(year) + end subroutine compute_calendar_data - ! Calculate the month - month = 1 - do k = 1, 12 - if (days_since_calz > daycal(k)) month = k - enddo +!======================================================================= +! Compute elapsed days from 0000-01-01 to year1,month1,day1 +! 0000-01-01 is 0 elapsed days - ! Calculate the day of the month - day = days_since_calz - daycal(month) + integer function compute_elapsed_days(ayear,amonth,aday) - else ! Using fixed 365-day calendar - - year = int(days_since_calz/c365) - days_since_calz = days_since_calz - year*365 + 1 - - ! Calculate the month - month = 1 - do k = 1, 12 - if (days_since_calz > daycal365(k)) month = k - enddo + integer (kind=int_kind), intent(in) :: ayear ! year + integer (kind=int_kind), intent(in) :: amonth ! month + integer (kind=int_kind), intent(in) :: aday ! day - ! Calculate the day of the month - day = days_since_calz - daycal365(month) + ! Internal variable + integer (kind=int_kind) :: ced_nday, n + integer (kind=int_kind) :: lyear,lmonth,lday,lsec + integer (kind=int_kind) :: tdaymo (months_per_year) ! days per month + integer (kind=int_kind) :: tdaycal(months_per_year+1) ! day count per month + integer (kind=int_kind) :: tdayyr ! days in year + character(len=*),parameter :: subname='(compute_elapsed_days)' + + ! use 0000-01-01 as base, year 0 is a leap year + ! this must be implemented consistent with set_calendar + + lyear = ayear + lmonth = amonth + lday = aday + lsec = 0 + + if (lyear < 0 .or. lmonth <= 0 .or. lday <= 0) then + write(nu_diag,*) trim(subname),' ERROR for year,month,day = ',lyear,lmonth,lday + call abort_ice(subname//'ERROR: illegal date') + elseif (lmonth > months_per_year) then + call update_date(lyear,lmonth,lday,lsec) + endif - end if + ! compute days from year 0000-01-01 to year-01-01 + ! don't loop thru years for performance reasons + if (trim(calendar_type) == trim(ice_calendar_gregorian)) then + if (lyear == 0) then + ced_nday = 0 + else + ced_nday = lyear * 365 + 1 + (lyear-1)/4 - (lyear-1)/100 + (lyear-1)/400 + endif + else + ced_nday = lyear * daycal(months_per_year+1) + endif - end if + ! now compute days in this year + call compute_calendar_data(lyear,tdaymo,tdaycal,tdayyr) - end subroutine sec2time + do n = 1, lmonth-1 + ced_nday = ced_nday + tdaymo(n) + enddo -!======================================================================= + if (lday <= tdaymo(lmonth)) then + ced_nday = ced_nday + lday - 1 + else + write(nu_diag,*) trim(subname),' ERROR for year,month,day = ',ayear,amonth,aday + call abort_ice(subname//'ERROR: illegal day in month') + endif -! Set the "days per month", "days per year", etc variables for the -! current year. -! -! authors: Craig MacLachlan, UK Met Office + compute_elapsed_days = ced_nday - subroutine set_calendar(year) + end function compute_elapsed_days - integer (kind=int_kind), intent(in) :: year ! current year +!======================================================================= +! Compute time in seconds from input calendar date +! relative to year_init, month_init, day_init, sec_init unless _ref values passed in +! For santity, must pass all four ref values or none - ! Internal variable - logical (kind=log_kind) :: isleap ! Leap year logical - character(len=*),parameter :: subname='(set_calendar)' + subroutine calendar_date2time(ayear,amon,aday,asec,atimesecs,year_ref,mon_ref,day_ref,sec_ref) + + integer(kind=int_kind), intent(in) :: & + ayear,amon,aday,asec ! year, month, day, sec of ttimesecs + real (kind=dbl_kind), intent(out) :: atimesecs ! seconds since init date + integer(kind=int_kind), intent(in), optional :: & + year_ref,mon_ref,day_ref,sec_ref ! year, month, day, sec reference time - isleap = .false. ! not a leap year - if (mod(year, 4) == 0) isleap = .true. - if (mod(year,100) == 0) isleap = .false. - if (mod(year,400) == 0) isleap = .true. - - ! Ensure the calendar is set correctly - if (isleap) then - daycal = daycal366 - daymo = daymo366 - dayyr=real(daycal(13), kind=dbl_kind) - days_per_year=int(dayyr) + ! Internal variable + real (kind=dbl_kind) :: secday + integer (kind=int_kind) :: elapsed_days ! since beginning this run + integer (kind=int_kind) :: lyear_ref,lmon_ref,lday_ref,lsec_ref ! local reference year, month, day, sec + integer (kind=int_kind) :: cnt + character(len=*),parameter :: subname='(calendar_date2time)' + + ! set reference date and check that 0 or 4 optional arguments are passed + cnt = 0 + if (present(year_ref)) then + lyear_ref = year_ref + cnt = cnt + 1 + else + lyear_ref = year_init + endif + if (present(mon_ref)) then + lmon_ref = mon_ref + cnt = cnt + 1 + else + lmon_ref = month_init + endif + if (present(day_ref)) then + lday_ref = day_ref + cnt = cnt + 1 + else + lday_ref = day_init + endif + if (present(sec_ref)) then + lsec_ref = sec_ref + cnt = cnt + 1 else - daycal = daycal365 - daymo = daymo365 - dayyr=real(daycal(13), kind=dbl_kind) - days_per_year=int(dayyr) + lsec_ref = sec_init endif + if (cnt /= 0 .and. cnt /= 4) then + write(nu_diag,*) trim(subname),' ERROR in ref args, must pass 0 or 4 ' + call abort_ice(subname//'ERROR: in ref args, must pass 0 or 4') + endif + + call icepack_query_parameters(secday_out=secday) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + elapsed_days = compute_days_between(lyear_ref,lmon_ref,lday_ref,ayear,amon,aday) + atimesecs = real(elapsed_days,kind=dbl_kind)*secday + & + real(asec,kind=dbl_kind) - real(lsec_ref,kind=dbl_kind) - end subroutine set_calendar + end subroutine calendar_date2time !======================================================================= +! Compute calendar date from input time in seconds +! relative to year_init, month_init, day_init, sec_init or ref data if passed. +! For sanity, require all four or no ref values. +! Implemented to minimize accumulating errors and avoid overflows +! and perform well. - real(kind=dbl_kind) function hc_jday(iyear,imm,idd,ihour) -!-------------------------------------------------------------------- -! converts "calendar" date to HYCOM julian day: -! 1) year,month,day,hour (4 arguments) -! 2) year,doy,hour (3 arguments) + subroutine calendar_time2date(atimesecs,ayear,amon,aday,asec,year_ref,mon_ref,day_ref,sec_ref) + + real (kind=dbl_kind), intent(in) :: atimesecs ! seconds since init date + integer(kind=int_kind), intent(out) :: & + ayear,amon,aday,asec ! year, month, day, sec of timesecs + integer(kind=int_kind), intent(in), optional :: & + year_ref,mon_ref,day_ref,sec_ref ! year, month, day, sec reference time + + ! Internal variable + integer (kind=int_kind) :: ndays + integer (kind=int_kind) :: tyear, tmon, tday, tsec ! temporaries + integer (kind=int_kind) :: tdaymo (months_per_year) ! days per month + integer (kind=int_kind) :: tdaycal(months_per_year+1) ! day count per month + integer (kind=int_kind) :: tdayyr ! days in year + real (kind=dbl_kind) :: secday, rdays, ltimesecs + integer (kind=int_kind) :: lyear_ref,lmon_ref,lday_ref,lsec_ref ! local reference year, month, day, sec + integer (kind=int_kind) :: cnt + character(len=*),parameter :: subname='(calendar_time2date)' + + call icepack_query_parameters(secday_out=secday) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + ! we could allow negative atimesecs, but this shouldn't be needed + if (atimesecs < 0._dbl_kind) then + write(nu_diag,*) trim(subname),' ERROR in atimesecs ',atimesecs + call abort_ice(subname//'ERROR: in atimesecs') + endif + + ! set reference date and check that 0 or 4 optional arguments are passed + cnt = 0 + if (present(year_ref)) then + lyear_ref = year_ref + cnt = cnt + 1 + else + lyear_ref = year_init + endif + if (present(mon_ref)) then + lmon_ref = mon_ref + cnt = cnt + 1 + else + lmon_ref = month_init + endif + if (present(day_ref)) then + lday_ref = day_ref + cnt = cnt + 1 + else + lday_ref = day_init + endif + if (present(sec_ref)) then + lsec_ref = sec_ref + cnt = cnt + 1 + else + lsec_ref = sec_init + endif + if (cnt /= 0 .and. cnt /= 4) then + write(nu_diag,*) trim(subname),' ERROR in ref args, must pass 0 or 4 ' + call abort_ice(subname//'ERROR: in ref args, must pass 0 or 4') + endif + +! ------------------------------------------------------------------- +! tcraig, this is risky because atimesecs is real and could be very large +! ayear = lyear_ref +! amon = lmon_ref +! aday = lday_ref +! asec = lsec_ref ! -! HYCOM model day is calendar days since 31/12/1900 -!-------------------------------------------------------------------- - real(kind=dbl_kind) :: dtime - integer(kind=int_kind) :: iyear,iyr,imm,idd,idoy,ihr - integer(kind=int_kind), optional :: ihour - - if (present(ihour)) then - !----------------- - ! yyyy mm dd HH - !----------------- - iyr=iyear-1901 - if (mod(iyr,4)==3) then - dtime = floor(365.25_dbl_kind*iyr)*c1 + daycal366(imm)*c1 + idd*c1 + ihour/24._dbl_kind - else - dtime = floor(365.25_dbl_kind*iyr)*c1 + daycal365(imm)*c1 + idd*c1 + ihour/24._dbl_kind - endif - - else - !----------------- - ! yyyy DOY HH - !----------------- - ihr = idd ! redefine input - idoy = imm ! redefine input - iyr = iyear - 1901 - dtime = floor(365.25_dbl_kind*iyr)*c1 + idoy*c1 + ihr/24._dbl_kind - - endif - - hc_jday=dtime - - return - end function hc_jday +! call update_date(ayear,amon,aday,asec,dsec=nint(atimesecs)) +! return +! ------------------------------------------------------------------- + + ! initial guess + tyear = lyear_ref + tmon = 1 + tday = 1 + tsec = 0 + + ! add initial seconds to timesecs and treat lsec_ref as zero + ltimesecs = atimesecs + real(lsec_ref,kind=dbl_kind) + + ! first estimate of tyear + call compute_calendar_data(tyear,tdaymo,tdaycal,tdayyr) + rdays = ltimesecs/secday + tyear = tyear + int(rdays)/tdayyr + + ! reduce estimate of tyear if ndays > rdays + ndays = compute_days_between(lyear_ref,lmon_ref,lday_ref,tyear,tmon,tday) + if (ndays > int(rdays)) then + tyear = tyear - (ndays - int(rdays))/tdayyr - 1 + ndays = compute_days_between(lyear_ref,lmon_ref,lday_ref,tyear,tmon,tday) + endif + call compute_calendar_data(tyear,tdaymo,tdaycal,tdayyr) + + ! compute residual days, switch to integers, compute date + rdays = ltimesecs/secday + tday = int(rdays) - ndays + 1 + + do while (tday > tdaymo(tmon)) + tday = tday - tdaymo(tmon) + tmon = tmon + 1 + do while (tmon > months_per_year) + tmon = tmon - months_per_year + tyear = tyear + 1 + call compute_calendar_data(tyear,tdaymo,tdaycal,tdayyr) + enddo + enddo + + ndays = compute_days_between(lyear_ref,lmon_ref,lday_ref,tyear,tmon,tday) + tsec = int(ltimesecs - real(ndays,kind=dbl_kind)*secday) + if (tsec > secday) then + write(nu_diag,*) trim(subname),' ERROR in seconds, ',tyear,tmon,tday,tsec + call abort_ice(subname//'ERROR: in seconds') + endif + + ayear = tyear + amon = tmon + aday = tday + asec = tsec + + end subroutine calendar_time2date !======================================================================= diff --git a/cicecore/shared/ice_distribution.F90 b/cicecore/shared/ice_distribution.F90 index 8c5808820..1a23b63be 100644 --- a/cicecore/shared/ice_distribution.F90 +++ b/cicecore/shared/ice_distribution.F90 @@ -12,7 +12,7 @@ module ice_distribution use ice_kinds_mod use ice_domain_size, only: max_blocks use ice_communicate, only: my_task, master_task, create_communicator - use ice_blocks, only: nblocks_x, nblocks_y, nblocks_tot + use ice_blocks, only: nblocks_x, nblocks_y, nblocks_tot, debug_blocks use ice_exit, only: abort_ice use ice_fileunits, only: nu_diag @@ -154,8 +154,6 @@ subroutine create_local_block_ids(block_ids, distribution) integer (int_kind) :: & n, bcount ! dummy counters - logical (log_kind) :: dbug - character(len=*),parameter :: subname='(create_local_block_ids)' !----------------------------------------------------------------------- @@ -178,15 +176,14 @@ subroutine create_local_block_ids(block_ids, distribution) ! !----------------------------------------------------------------------- -! dbug = .true. - dbug = .false. if (bcount > 0) then do n=1,size(distribution%blockLocation) if (distribution%blockLocation(n) == my_task+1) then block_ids(distribution%blockLocalID(n)) = n - if (dbug) then - write(nu_diag,*) subname,'block id, proc, local_block: ', & + if (debug_blocks .and. my_task == master_task) then + write(nu_diag,'(2a,3i8)') & + subname,' block id, proc, local_block: ', & block_ids(distribution%blockLocalID(n)), & distribution%blockLocation(n), & distribution%blockLocalID(n) @@ -402,7 +399,7 @@ subroutine ice_distributionGet(distribution,& numLocalBlocks ! number of blocks distributed to this ! local processor - integer (int_kind), dimension(:), pointer, optional :: & + integer (int_kind), dimension(:), optional :: & blockLocation ,&! processor location for all blocks blockLocalID ,&! local block id for all blocks blockGlobalID ! global block id for each local block @@ -422,7 +419,7 @@ subroutine ice_distributionGet(distribution,& if (present(blockLocation)) then if (associated(distribution%blockLocation)) then - blockLocation => distribution%blockLocation + blockLocation = distribution%blockLocation else call abort_ice(subname//'ERROR: blockLocation not allocated') return @@ -575,7 +572,11 @@ function create_distrb_cart(nprocs, workPerBlock) result(newDistrb) nprocsX, &! num of procs in x for global domain nprocsY, &! num of procs in y for global domain numBlocksXPerProc, &! num of blocks per processor in x - numBlocksYPerProc ! num of blocks per processor in y + numBlocksYPerProc, &! num of blocks per processor in y + numBlocksPerProc ! required number of blocks per processor + + character(len=char_len) :: & + numBlocksPerProc_str ! required number of blocks per processor (as string) character(len=*),parameter :: subname='(create_distrb_cart)' @@ -628,6 +629,14 @@ function create_distrb_cart(nprocs, workPerBlock) result(newDistrb) numBlocksXPerProc = (nblocks_x-1)/nprocsX + 1 numBlocksYPerProc = (nblocks_y-1)/nprocsY + 1 + ! Check if max_blocks is too small + numBlocksPerProc = numBlocksXPerProc * numBlocksYPerProc + if (numBlocksPerProc > max_blocks) then + write(numBlocksPerProc_str, '(i2)') numBlocksPerProc + call abort_ice(subname//'ERROR: max_blocks too small (need at least '//trim(numBlocksPerProc_str)//')') + return + endif + do j=1,nprocsY do i=1,nprocsX processor = (j-1)*nprocsX + i ! number the processors @@ -786,6 +795,8 @@ function create_distrb_rake(nprocs, workPerBlock) result(newDistrb) maxWork = maxval(workPerBlock) if (numOcnBlocks <= 2*nprocs) then + if (my_task == master_task) & + write(nu_diag,*) subname,' 1d rake on entire distribution' allocate(priority(nblocks_tot), stat=istat) if (istat > 0) then @@ -807,7 +818,7 @@ function create_distrb_rake(nprocs, workPerBlock) result(newDistrb) end do end do - allocate(workTmp(nblocks_tot), procTmp(nblocks_tot), stat=istat) + allocate(workTmp(nprocs), procTmp(nprocs), stat=istat) if (istat > 0) then call abort_ice( & 'create_distrb_rake: error allocating procTmp') @@ -841,6 +852,8 @@ function create_distrb_rake(nprocs, workPerBlock) result(newDistrb) !---------------------------------------------------------------------- else + if (my_task == master_task) & + write(nu_diag,*) subname,' rake in each direction' call proc_decomposition(dist%nprocs, nprocsX, nprocsY) @@ -996,6 +1009,10 @@ function create_distrb_rake(nprocs, workPerBlock) result(newDistrb) if (pid > 0) then procTmp(pid) = procTmp(pid) + 1 + if (procTmp(pid) > max_blocks) then + call abort_ice(subname//'ERROR: max_blocks too small') + return + endif newDistrb%blockLocalID (n) = procTmp(pid) newDistrb%blockIndex(pid,procTmp(pid)) = n else @@ -1413,7 +1430,7 @@ end function create_distrb_spiralcenter function create_distrb_wghtfile(nprocs, workPerBlock) result(newDistrb) ! This function creates a distribution of blocks across processors -! using a simple wghtfile algorithm. Mean for prescribed ice or +! using a simple wghtfile algorithm. Meant for prescribed ice or ! standalone CAM mode. integer (int_kind), intent(in) :: & @@ -2094,8 +2111,6 @@ function create_distrb_spacecurve(nprocs,work_per_block) ii,extra,tmp1, &! loop tempories used for s1,ig ! partitioning curve - logical, parameter :: Debug = .FALSE. - type (factor_t) :: xdim,ydim integer (int_kind) :: it,jj,i2,j2 @@ -2189,9 +2204,9 @@ function create_distrb_spacecurve(nprocs,work_per_block) call GenSpaceCurve(Mesh) Mesh = Mesh + 1 ! make it 1-based indexing - if(Debug) then - if(my_task ==0) call PrintCurve(Mesh) - endif +! if (debug_blocks) then +! if (my_task == master_task) call PrintCurve(Mesh) +! endif !----------------------------------------------- ! Reindex the SFC to address internal sub-blocks @@ -2238,8 +2253,8 @@ function create_distrb_spacecurve(nprocs,work_per_block) endif enddo nblocks=ii - if(Debug) then - if(my_task==0) call PrintCurve(Mesh3) + if (debug_blocks) then + if (my_task == master_task) call PrintCurve(Mesh3) endif !---------------------------------------------------- @@ -2258,8 +2273,8 @@ function create_distrb_spacecurve(nprocs,work_per_block) ! ! First region gets nblocksL+1 blocks per partition ! Second region gets nblocksL blocks per partition - if(Debug) print *,'nprocs,extra,nblocks,nblocksL,s1: ', & - nprocs,extra,nblocks,nblocksL,s1 +! if(debug_blocks) write(nu_diag,*) 'nprocs,extra,nblocks,nblocksL,s1: ', & +! nprocs,extra,nblocks,nblocksL,s1 !----------------------------------------------------------- ! Use the SFC to partition the blocks across processors @@ -2304,6 +2319,10 @@ function create_distrb_spacecurve(nprocs,work_per_block) if(pid>0) then proc_tmp(pid) = proc_tmp(pid) + 1 + if (proc_tmp(pid) > max_blocks) then + call abort_ice(subname//'ERROR: max_blocks too small') + return + endif dist%blockLocalID(n) = proc_tmp(pid) dist%blockIndex(pid,proc_tmp(pid)) = n else @@ -2326,11 +2345,11 @@ function create_distrb_spacecurve(nprocs,work_per_block) endif enddo - if(Debug) then - if(my_task==0) print *,'dist%blockLocation:= ',dist%blockLocation - print *,'IAM: ',my_task,' SpaceCurve: Number of blocks {total,local} :=', & - nblocks_tot,nblocks,proc_tmp(my_task+1) - endif +! if (debug_blocks) then +! if (my_task == master_task) write(nu_diag,*) 'dist%blockLocation:= ',dist%blockLocation +! write(nu_diag,*) 'IAM: ',my_task,' SpaceCurve: Number of blocks {total,local} :=', & +! nblocks_tot,nblocks,proc_tmp(my_task+1) +! endif !--------------------------------- ! Deallocate temporary arrays !--------------------------------- diff --git a/cicecore/shared/ice_init_column.F90 b/cicecore/shared/ice_init_column.F90 index b3937c0cd..1362e055e 100644 --- a/cicecore/shared/ice_init_column.F90 +++ b/cicecore/shared/ice_init_column.F90 @@ -188,7 +188,7 @@ subroutine init_shortwave swgrid, igrid use ice_blocks, only: block, get_block, nx_block, ny_block use ice_calendar, only: dt, calendar_type, & - days_per_year, nextsw_cday, yday, sec + days_per_year, nextsw_cday, yday, msec use ice_diagnostics, only: npnt, print_points, pmloc, piloc, pjloc use ice_domain, only: nblocks, blocks_ice use ice_flux, only: alvdf, alidf, alvdr, alidr, & @@ -356,7 +356,7 @@ subroutine init_shortwave calendar_type=calendar_type, & days_per_year=days_per_year, & nextsw_cday=nextsw_cday, yday=yday, & - sec=sec, & + sec=msec, & kaer_tab=kaer_tab, kaer_bc_tab=kaer_bc_tab(:,:), & waer_tab=waer_tab, waer_bc_tab=waer_bc_tab(:,:), & gaer_tab=gaer_tab, gaer_bc_tab=gaer_bc_tab(:,:), & @@ -408,7 +408,7 @@ subroutine init_shortwave do i = ilo, ihi if (aicen(i,j,n,iblk) > puny) then - + alvdf(i,j,iblk) = alvdf(i,j,iblk) & + alvdfn(i,j,n,iblk)*aicen(i,j,n,iblk) alidf(i,j,iblk) = alidf(i,j,iblk) & @@ -417,7 +417,7 @@ subroutine init_shortwave + alvdrn(i,j,n,iblk)*aicen(i,j,n,iblk) alidr(i,j,iblk) = alidr(i,j,iblk) & + alidrn(i,j,n,iblk)*aicen(i,j,n,iblk) - + netsw = swvdr(i,j,iblk) + swidr(i,j,iblk) & + swvdf(i,j,iblk) + swidf(i,j,iblk) if (netsw > puny) then ! sun above horizon @@ -428,12 +428,12 @@ subroutine init_shortwave albpnd(i,j,iblk) = albpnd(i,j,iblk) & + albpndn(i,j,n,iblk)*aicen(i,j,n,iblk) endif - + apeff_ai(i,j,iblk) = apeff_ai(i,j,iblk) & + apeffn(i,j,n,iblk)*aicen(i,j,n,iblk) snowfrac(i,j,iblk) = snowfrac(i,j,iblk) & + snowfracn(i,j,n,iblk)*aicen(i,j,n,iblk) - + endif ! aicen > puny enddo ! i diff --git a/cicecore/shared/ice_spacecurve.F90 b/cicecore/shared/ice_spacecurve.F90 index 78b256b8f..931b2312b 100644 --- a/cicecore/shared/ice_spacecurve.F90 +++ b/cicecore/shared/ice_spacecurve.F90 @@ -13,12 +13,14 @@ module ice_spacecurve ! !USES: use ice_kinds_mod + use ice_blocks, only: debug_blocks use ice_communicate, only: my_task, master_task use ice_exit, only: abort_ice use ice_fileunits use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted implicit none + private ! !PUBLIC TYPES: @@ -30,13 +32,13 @@ module ice_spacecurve ! !PUBLIC MEMBER FUNCTIONS: - public :: GenSpaceCurve, & - IsLoadBalanced + public :: GenSpaceCurve public :: Factor, & IsFactorable, & PrintFactor, & ProdFactor, & + PrintCurve, & MatchFactor ! !PRIVATE MEMBER FUNCTIONS: @@ -60,8 +62,6 @@ module ice_spacecurve maxdim, &! dimensionality of entire space vcnt ! visitation count - logical :: verbose=.FALSE. - type (factor_t), public :: fact ! stores the factorization !EOP @@ -118,8 +118,6 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ltype, &! type of SFC on next level ll ! next level down - logical :: debug = .FALSE. - character(len=*),parameter :: subname='(Cinco)' !----------------------------------------------------------------------- @@ -136,12 +134,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,21) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,21) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'Cinco: After Position [0,0] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'Cinco: After Position [0,0] ',pos endif !-------------------------------------------------------------- @@ -153,12 +151,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,22) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,22) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [1,0] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [1,0] ',pos endif !-------------------------------------------------------------- @@ -170,12 +168,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,23) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,23) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [2,0] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [2,0] ',pos endif !-------------------------------------------------------------- @@ -187,12 +185,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,24) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,24) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [2,1] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [2,1] ',pos endif !-------------------------------------------------------------- @@ -204,12 +202,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = -md if(ll .gt. 1) then - if(debug) write(*,25) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,25) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [2,2] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [2,2] ',pos endif !-------------------------------------------------------------- @@ -221,12 +219,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,26) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,26) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [1,2] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [1,2] ',pos endif !-------------------------------------------------------------- @@ -238,12 +236,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,27) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,27) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [1,1] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [1,1] ',pos endif !-------------------------------------------------------------- @@ -255,12 +253,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = md if(ll .gt. 1) then - if(debug) write(*,28) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,28) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [0,1] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [0,1] ',pos endif !-------------------------------------------------------------- @@ -272,12 +270,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,29) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,29) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [0,2] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [0,2] ',pos endif !-------------------------------------------------------------- @@ -289,12 +287,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,30) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,30) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [0,3] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [0,3] ',pos endif !-------------------------------------------------------------- @@ -306,12 +304,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,31) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,31) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [0,4] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [0,4] ',pos endif !-------------------------------------------------------------- @@ -323,12 +321,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = -md if(ll .gt. 1) then - if(debug) write(*,32) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,32) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [1,4] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [1,4] ',pos endif !-------------------------------------------------------------- @@ -340,12 +338,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = md if(ll .gt. 1) then - if(debug) write(*,33) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,33) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [1,3] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [1,3] ',pos endif !-------------------------------------------------------------- @@ -357,12 +355,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,34) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,34) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [2,3] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [2,3] ',pos endif !-------------------------------------------------------------- @@ -374,12 +372,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,35) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,35) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [2,4] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [2,4] ',pos endif !-------------------------------------------------------------- @@ -391,12 +389,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,36) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,36) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [3,4] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [3,4] ',pos endif !-------------------------------------------------------------- @@ -408,12 +406,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = -md if(ll .gt. 1) then - if(debug) write(*,37) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,37) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [4,4] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [4,4] ',pos endif !-------------------------------------------------------------- @@ -425,12 +423,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,38) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,38) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [4,3] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [4,3] ',pos endif !-------------------------------------------------------------- @@ -442,12 +440,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,39) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,39) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [3,3] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [3,3] ',pos endif !-------------------------------------------------------------- @@ -459,12 +457,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = md if(ll .gt. 1) then - if(debug) write(*,40) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,40) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [3,2] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [3,2] ',pos endif !-------------------------------------------------------------- @@ -476,12 +474,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = -md if(ll .gt. 1) then - if(debug) write(*,41) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,41) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [4,2] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [4,2] ',pos endif !-------------------------------------------------------------- @@ -493,12 +491,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,42) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,42) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [4,1] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [4,1] ',pos endif !-------------------------------------------------------------- @@ -510,12 +508,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,43) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,43) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [3,1] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [3,1] ',pos endif !-------------------------------------------------------------- @@ -527,12 +525,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = md if(ll .gt. 1) then - if(debug) write(*,44) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,44) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [3,0] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [3,0] ',pos endif !-------------------------------------------------------------- @@ -544,12 +542,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = jd if(ll .gt. 1) then - if(debug) write(*,45) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,45) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [4,0] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [4,0] ',pos endif 21 format('Call Cinco Pos [0,0] Level ',i1,' at (',i2,',',i2,')',4(i3)) @@ -632,8 +630,6 @@ recursive function PeanoM(l,type,ma,md,ja,jd) result(ierr) ltype, &! type of SFC on next level ll ! next level down - logical :: debug = .FALSE. - character(len=*),parameter :: subname='(PeanoM)' !----------------------------------------------------------------------- @@ -650,12 +646,12 @@ recursive function PeanoM(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,21) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,21) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'PeanoM: After Position [0,0] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'PeanoM: After Position [0,0] ',pos endif @@ -667,12 +663,12 @@ recursive function PeanoM(l,type,ma,md,ja,jd) result(ierr) lja = lma ljd = lmd if(ll .gt. 1) then - if(debug) write(*,22) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,22) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'PeanoM: After Position [0,1] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'PeanoM: After Position [0,1] ',pos endif !-------------------------------------------------------------- @@ -683,12 +679,12 @@ recursive function PeanoM(l,type,ma,md,ja,jd) result(ierr) lja = lma ljd = lmd if(ll .gt. 1) then - if(debug) write(*,23) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,23) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'PeanoM: After Position [0,2] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'PeanoM: After Position [0,2] ',pos endif !-------------------------------------------------------------- @@ -699,12 +695,12 @@ recursive function PeanoM(l,type,ma,md,ja,jd) result(ierr) lja = lma ljd = lmd if(ll .gt. 1) then - if(debug) write(*,24) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,24) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'PeanoM: After Position [1,2] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'PeanoM: After Position [1,2] ',pos endif @@ -717,12 +713,12 @@ recursive function PeanoM(l,type,ma,md,ja,jd) result(ierr) ljd = -lmd if(ll .gt. 1) then - if(debug) write(*,25) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,25) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'PeanoM: After Position [2,2] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'PeanoM: After Position [2,2] ',pos endif !-------------------------------------------------------------- @@ -734,12 +730,12 @@ recursive function PeanoM(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,26) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,26) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'PeanoM: After Position [2,1] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'PeanoM: After Position [2,1] ',pos endif !-------------------------------------------------------------- @@ -751,12 +747,12 @@ recursive function PeanoM(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,27) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,27) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'PeanoM: After Position [1,1] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'PeanoM: After Position [1,1] ',pos endif @@ -769,12 +765,12 @@ recursive function PeanoM(l,type,ma,md,ja,jd) result(ierr) ljd = -lmd if(ll .gt. 1) then - if(debug) write(*,28) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,28) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'PeanoM: After Position [1,0] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'PeanoM: After Position [1,0] ',pos endif !-------------------------------------------------------------- @@ -786,12 +782,12 @@ recursive function PeanoM(l,type,ma,md,ja,jd) result(ierr) ljd = jd if(ll .gt. 1) then - if(debug) write(*,29) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,29) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'PeanoM: After Position [2,0] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'PeanoM: After Position [2,0] ',pos endif 21 format('Call PeanoM Pos [0,0] Level ',i1,' at (',i2,',',i2,')',4(i3)) @@ -858,8 +854,6 @@ recursive function Hilbert(l,type,ma,md,ja,jd) result(ierr) ltype, &! type of SFC on next level ll ! next level down - logical :: debug = .FALSE. - character(len=*),parameter :: subname='(Hilbert)' !----------------------------------------------------------------------- @@ -875,12 +869,12 @@ recursive function Hilbert(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,21) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,21) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'Hilbert: After Position [0,0] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'Hilbert: After Position [0,0] ',pos endif @@ -892,12 +886,12 @@ recursive function Hilbert(l,type,ma,md,ja,jd) result(ierr) lja = lma ljd = lmd if(ll .gt. 1) then - if(debug) write(*,22) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,22) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'Hilbert: After Position [0,1] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'Hilbert: After Position [0,1] ',pos endif @@ -910,12 +904,12 @@ recursive function Hilbert(l,type,ma,md,ja,jd) result(ierr) ljd = -md if(ll .gt. 1) then - if(debug) write(*,23) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,23) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'Hilbert: After Position [1,1] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'Hilbert: After Position [1,1] ',pos endif !-------------------------------------------------------------- @@ -927,12 +921,12 @@ recursive function Hilbert(l,type,ma,md,ja,jd) result(ierr) ljd = jd if(ll .gt. 1) then - if(debug) write(*,24) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,24) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'Hilbert: After Position [1,0] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'Hilbert: After Position [1,0] ',pos endif 21 format('Call Hilbert Pos [0,0] Level ',i1,' at (',i2,',',i2,')',4(i3)) @@ -1048,6 +1042,7 @@ function log2( n) end function log2 !*********************************************************************** +#ifdef UNDEPRECATE_IsLoadBalanced !BOP ! !IROUTINE: IsLoadBalanced ! !INTERFACE: @@ -1095,7 +1090,7 @@ function IsLoadBalanced(nelem,npart) !----------------------------------------------------------------------- end function IsLoadBalanced - +#endif !*********************************************************************** !BOP ! !IROUTINE: GenCurve @@ -1128,6 +1123,7 @@ function GenCurve(l,type,ma,md,ja,jd) result(ierr) !EOP !BOC + logical, save :: f2=.true., f3=.true., f5=.true. ! first calls character(len=*),parameter :: subname='(GenCurve)' !----------------------------------------------------------------------- @@ -1137,11 +1133,17 @@ function GenCurve(l,type,ma,md,ja,jd) result(ierr) !------------------------------------------------- if(type == 2) then + if (f2 .and. my_task == master_task) write(nu_diag,*) subname,' calling Hilbert (2)' ierr = Hilbert(l,type,ma,md,ja,jd) + f2 = .false. elseif ( type == 3) then + if (f3 .and. my_task == master_task) write(nu_diag,*) subname,' calling PeanoM (3)' ierr = PeanoM(l,type,ma,md,ja,jd) + f3 = .false. elseif ( type == 5) then + if (f5 .and. my_task == master_task) write(nu_diag,*) subname,' calling Cinco (5)' ierr = Cinco(l,type,ma,md,ja,jd) + f5 = .false. endif !EOP @@ -1210,7 +1212,7 @@ subroutine MatchFactor(fac1,fac2,val,found) found = .false. val1 = FirstFactor(fac1) -!JMD print *,'Matchfactor: found value: ',val1 +!JMD write(nu_diag,*)'Matchfactor: found value: ',val1 found = FindandMark(fac2,val1,.true.) tmp = FindandMark(fac1,val1,found) if (found) then @@ -1245,10 +1247,10 @@ subroutine PrintFactor(msg,fac) integer (int_kind) :: i character(len=*),parameter :: subname='(PrintFactor)' - write(*,*) subname,' ' - write(*,*) subname,'msg = ',trim(msg) - write(*,*) subname,(fac%factors(i),i=1,fac%numfact) - write(*,*) subname,(fac%used(i),i=1,fac%numfact) + write(nu_diag,*) subname,' ' + write(nu_diag,*) subname,'msg = ',trim(msg) + write(nu_diag,*) subname,(fac%factors(i),i=1,fac%numfact) + write(nu_diag,*) subname,(fac%used(i),i=1,fac%numfact) end subroutine PrintFactor @@ -1448,6 +1450,9 @@ subroutine map(l) maxdim=d vcnt=0 + ! tcx, if l is 0, then fact has no factors, just return + if (l == 0) return + type = fact%factors(l) ierr = GenCurve(l,type,0,1,0,1) @@ -1492,113 +1497,113 @@ subroutine PrintCurve(Mesh) gridsize = SIZE(Mesh,dim=1) - write(*,*) subname,":" + write(nu_diag,*) subname,":",gridsize if(gridsize == 2) then - write (*,*) "A Level 1 Hilbert Curve:" - write (*,*) "------------------------" + write (nu_diag,*) "A Level 1 Hilbert Curve:" + write (nu_diag,*) "------------------------" do i=1,gridsize - write(*,2) Mesh(1,i),Mesh(2,i) + write(nu_diag,2) Mesh(1,i),Mesh(2,i) enddo else if(gridsize == 3) then - write (*,*) "A Level 1 Peano Meandering Curve:" - write (*,*) "---------------------------------" + write (nu_diag,*) "A Level 1 Peano Meandering Curve:" + write (nu_diag,*) "---------------------------------" do i=1,gridsize - write(*,3) Mesh(1,i),Mesh(2,i),Mesh(3,i) + write(nu_diag,3) Mesh(1,i),Mesh(2,i),Mesh(3,i) enddo else if(gridsize == 4) then - write (*,*) "A Level 2 Hilbert Curve:" - write (*,*) "------------------------" + write (nu_diag,*) "A Level 2 Hilbert Curve:" + write (nu_diag,*) "------------------------" do i=1,gridsize - write(*,4) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i) + write(nu_diag,4) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i) enddo else if(gridsize == 5) then - write (*,*) "A Level 1 Cinco Curve:" - write (*,*) "------------------------" + write (nu_diag,*) "A Level 1 Cinco Curve:" + write (nu_diag,*) "------------------------" do i=1,gridsize - write(*,5) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i),Mesh(5,i) + write(nu_diag,5) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i),Mesh(5,i) enddo else if(gridsize == 6) then - write (*,*) "A Level 1 Hilbert and Level 1 Peano Curve:" - write (*,*) "------------------------------------------" + write (nu_diag,*) "A Level 1 Hilbert and Level 1 Peano Curve:" + write (nu_diag,*) "------------------------------------------" do i=1,gridsize - write(*,6) Mesh(1,i),Mesh(2,i),Mesh(3,i), & + write(nu_diag,6) Mesh(1,i),Mesh(2,i),Mesh(3,i), & Mesh(4,i),Mesh(5,i),Mesh(6,i) enddo else if(gridsize == 8) then - write (*,*) "A Level 3 Hilbert Curve:" - write (*,*) "------------------------" + write (nu_diag,*) "A Level 3 Hilbert Curve:" + write (nu_diag,*) "------------------------" do i=1,gridsize - write(*,8) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & + write(nu_diag,8) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & Mesh(5,i),Mesh(6,i),Mesh(7,i),Mesh(8,i) enddo else if(gridsize == 9) then - write (*,*) "A Level 2 Peano Meandering Curve:" - write (*,*) "---------------------------------" + write (nu_diag,*) "A Level 2 Peano Meandering Curve:" + write (nu_diag,*) "---------------------------------" do i=1,gridsize - write(*,9) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & + write(nu_diag,9) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & Mesh(5,i),Mesh(6,i),Mesh(7,i),Mesh(8,i), & Mesh(9,i) enddo else if(gridsize == 10) then - write (*,*) "A Level 1 Hilbert and Level 1 Cinco Curve:" - write (*,*) "---------------------------------" + write (nu_diag,*) "A Level 1 Hilbert and Level 1 Cinco Curve:" + write (nu_diag,*) "---------------------------------" do i=1,gridsize - write(*,10) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & + write(nu_diag,10) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & Mesh(5,i),Mesh(6,i),Mesh(7,i),Mesh(8,i), & Mesh(9,i),Mesh(10,i) enddo else if(gridsize == 12) then - write (*,*) "A Level 2 Hilbert and Level 1 Peano Curve:" - write (*,*) "------------------------------------------" + write (nu_diag,*) "A Level 2 Hilbert and Level 1 Peano Curve:" + write (nu_diag,*) "------------------------------------------" do i=1,gridsize - write(*,12) Mesh(1,i),Mesh(2,i), Mesh(3,i), Mesh(4,i), & + write(nu_diag,12) Mesh(1,i),Mesh(2,i), Mesh(3,i), Mesh(4,i), & Mesh(5,i),Mesh(6,i), Mesh(7,i), Mesh(8,i), & Mesh(9,i),Mesh(10,i),Mesh(11,i),Mesh(12,i) enddo else if(gridsize == 15) then - write (*,*) "A Level 1 Peano and Level 1 Cinco Curve:" - write (*,*) "------------------------" + write (nu_diag,*) "A Level 1 Peano and Level 1 Cinco Curve:" + write (nu_diag,*) "------------------------" do i=1,gridsize - write(*,15) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & + write(nu_diag,15) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & Mesh(5,i),Mesh(6,i),Mesh(7,i),Mesh(8,i), & Mesh(9,i),Mesh(10,i),Mesh(11,i),Mesh(12,i), & Mesh(13,i),Mesh(14,i),Mesh(15,i) enddo else if(gridsize == 16) then - write (*,*) "A Level 4 Hilbert Curve:" - write (*,*) "------------------------" + write (nu_diag,*) "A Level 4 Hilbert Curve:" + write (nu_diag,*) "------------------------" do i=1,gridsize - write(*,16) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & + write(nu_diag,16) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & Mesh(5,i),Mesh(6,i),Mesh(7,i),Mesh(8,i), & Mesh(9,i),Mesh(10,i),Mesh(11,i),Mesh(12,i), & Mesh(13,i),Mesh(14,i),Mesh(15,i),Mesh(16,i) enddo else if(gridsize == 18) then - write (*,*) "A Level 1 Hilbert and Level 2 Peano Curve:" - write (*,*) "------------------------------------------" + write (nu_diag,*) "A Level 1 Hilbert and Level 2 Peano Curve:" + write (nu_diag,*) "------------------------------------------" do i=1,gridsize - write(*,18) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & + write(nu_diag,18) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & Mesh(5,i), Mesh(6,i), Mesh(7,i), Mesh(8,i), & Mesh(9,i), Mesh(10,i),Mesh(11,i),Mesh(12,i), & Mesh(13,i),Mesh(14,i),Mesh(15,i),Mesh(16,i), & Mesh(17,i),Mesh(18,i) enddo else if(gridsize == 20) then - write (*,*) "A Level 2 Hilbert and Level 1 Cinco Curve:" - write (*,*) "------------------------------------------" + write (nu_diag,*) "A Level 2 Hilbert and Level 1 Cinco Curve:" + write (nu_diag,*) "------------------------------------------" do i=1,gridsize - write(*,20) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & + write(nu_diag,20) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & Mesh(5,i), Mesh(6,i), Mesh(7,i), Mesh(8,i), & Mesh(9,i), Mesh(10,i),Mesh(11,i),Mesh(12,i), & Mesh(13,i),Mesh(14,i),Mesh(15,i),Mesh(16,i), & Mesh(17,i),Mesh(18,i),Mesh(19,i),Mesh(20,i) enddo else if(gridsize == 24) then - write (*,*) "A Level 3 Hilbert and Level 1 Peano Curve:" - write (*,*) "------------------------------------------" + write (nu_diag,*) "A Level 3 Hilbert and Level 1 Peano Curve:" + write (nu_diag,*) "------------------------------------------" do i=1,gridsize - write(*,24) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & + write(nu_diag,24) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & Mesh(5,i), Mesh(6,i), Mesh(7,i), Mesh(8,i), & Mesh(9,i), Mesh(10,i),Mesh(11,i),Mesh(12,i), & Mesh(13,i),Mesh(14,i),Mesh(15,i),Mesh(16,i), & @@ -1606,10 +1611,10 @@ subroutine PrintCurve(Mesh) Mesh(21,i),Mesh(22,i),Mesh(23,i),Mesh(24,i) enddo else if(gridsize == 25) then - write (*,*) "A Level 2 Cinco Curve:" - write (*,*) "------------------------------------------" + write (nu_diag,*) "A Level 2 Cinco Curve:" + write (nu_diag,*) "------------------------------------------" do i=1,gridsize - write(*,25) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & + write(nu_diag,25) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & Mesh(5,i), Mesh(6,i), Mesh(7,i), Mesh(8,i), & Mesh(9,i), Mesh(10,i),Mesh(11,i),Mesh(12,i), & Mesh(13,i),Mesh(14,i),Mesh(15,i),Mesh(16,i), & @@ -1618,10 +1623,10 @@ subroutine PrintCurve(Mesh) Mesh(25,i) enddo else if(gridsize == 27) then - write (*,*) "A Level 3 Peano Meandering Curve:" - write (*,*) "---------------------------------" + write (nu_diag,*) "A Level 3 Peano Meandering Curve:" + write (nu_diag,*) "---------------------------------" do i=1,gridsize - write(*,27) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & + write(nu_diag,27) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & Mesh(5,i), Mesh(6,i), Mesh(7,i), Mesh(8,i), & Mesh(9,i), Mesh(10,i),Mesh(11,i),Mesh(12,i), & Mesh(13,i),Mesh(14,i),Mesh(15,i),Mesh(16,i), & @@ -1629,11 +1634,24 @@ subroutine PrintCurve(Mesh) Mesh(21,i),Mesh(22,i),Mesh(23,i),Mesh(24,i), & Mesh(25,i),Mesh(26,i),Mesh(27,i) enddo + else if(gridsize == 30) then + write (nu_diag,*) "A Level 1 Cinco and Level 1 Peano and Level 1 Hilbert Curve:" + write (nu_diag,*) "---------------------------------" + do i=1,gridsize + write(nu_diag,30) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & + Mesh(5,i), Mesh(6,i), Mesh(7,i), Mesh(8,i), & + Mesh(9,i), Mesh(10,i),Mesh(11,i),Mesh(12,i), & + Mesh(13,i),Mesh(14,i),Mesh(15,i),Mesh(16,i), & + Mesh(17,i),Mesh(18,i),Mesh(19,i),Mesh(20,i), & + Mesh(21,i),Mesh(22,i),Mesh(23,i),Mesh(24,i), & + Mesh(25,i),Mesh(26,i),Mesh(27,i),Mesh(28,i), & + Mesh(29,i),Mesh(30,i) + enddo else if(gridsize == 32) then - write (*,*) "A Level 5 Hilbert Curve:" - write (*,*) "------------------------" + write (nu_diag,*) "A Level 5 Hilbert Curve:" + write (nu_diag,*) "------------------------" do i=1,gridsize - write(*,32) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & + write(nu_diag,32) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & Mesh(5,i), Mesh(6,i), Mesh(7,i), Mesh(8,i), & Mesh(9,i), Mesh(10,i),Mesh(11,i),Mesh(12,i), & Mesh(13,i),Mesh(14,i),Mesh(15,i),Mesh(16,i), & @@ -1659,6 +1677,7 @@ subroutine PrintCurve(Mesh) 24 format('|',24(i3,'|')) 25 format('|',25(i3,'|')) 27 format('|',27(i3,'|')) +30 format('|',30(i4,'|')) 32 format('|',32(i4,'|')) !EOC @@ -1711,7 +1730,13 @@ subroutine GenSpaceCurve(Mesh) fact = factor(gridsize) level = fact%numfact - if(verbose) print *,'GenSpacecurve: level is ',level + if (debug_blocks .and. my_task==master_task .and. my_task==master_task) then + write(nu_diag,*) subname,' dim,size = ',dim,gridsize + write(nu_diag,*) subname,' numfact = ',level + call printfactor(subname,fact) + call flush_fileunit(nu_diag) + endif + allocate(ordered(gridsize,gridsize)) !-------------------------------------------- @@ -1730,61 +1755,10 @@ subroutine GenSpaceCurve(Mesh) deallocate(pos,ordered) -!EOP -!----------------------------------------------------------------------- - end subroutine GenSpaceCurve - recursive subroutine qsort(a) - - integer, intent(inout) :: a(:) - integer :: split - character(len=*),parameter :: subname='(qsort)' - - if(SIZE(a) > 1) then - call partition(a,split) - call qsort(a(:split-1)) - call qsort(a(split:)) - endif - - end subroutine qsort - - subroutine partition(a,marker) - - INTEGER, INTENT(IN OUT) :: a(:) - INTEGER, INTENT(OUT) :: marker - INTEGER :: left, right, pivot, temp - character(len=*),parameter :: subname='(partition)' - - pivot = (a(1) + a(size(a))) / 2 ! Average of first and last elements to prevent quadratic - left = 0 ! behavior with sorted or reverse sorted data - right = size(a) + 1 - - DO WHILE (left < right) - right = right - 1 - DO WHILE (a(right) > pivot) - right = right-1 - END DO - left = left + 1 - DO WHILE (a(left) < pivot) - left = left + 1 - END DO - IF (left < right) THEN - temp = a(left) - a(left) = a(right) - a(right) = temp - END IF - END DO - - IF (left == right) THEN - marker = left + 1 - ELSE - marker = left - END IF - - end subroutine partition - - +!EOC +!----------------------------------------------------------------------- end module ice_spacecurve diff --git a/cicecore/version.txt b/cicecore/version.txt index e16cf8bfe..cfd991555 100644 --- a/cicecore/version.txt +++ b/cicecore/version.txt @@ -1 +1 @@ -CICE 6.1.4 +CICE 6.2.0 diff --git a/configuration/scripts/Makefile b/configuration/scripts/Makefile index 7b39d5c8d..e0b7799d6 100644 --- a/configuration/scripts/Makefile +++ b/configuration/scripts/Makefile @@ -75,7 +75,7 @@ AR := ar .SUFFIXES: .SUFFIXES: .F90 .F .c .o -.PHONY: all cice libcice targets target db_files db_flags clean realclean +.PHONY: all cice libcice targets target db_files db_flags clean realclean helloworld calchk all: $(EXEC) cice: $(EXEC) @@ -92,7 +92,9 @@ cice: $(EXEC) targets: @echo " " - @echo "Supported Makefile Targets are: cice, libcice, makdep, depends, clean, realclean, targets, db_files, db_flags" + @echo "Supported Makefile Targets are: cice, libcice, makdep, depends, clean, realclean" + @echo " Diagnostics: targets, db_files, db_flags" + @echo " Unit Tests : helloworld, calchk" target: targets db_files: @@ -134,6 +136,20 @@ $(DEPGEN): $(OBJS_DEPGEN) @ echo "Building makdep" $(SCC) -o $@ $(CFLAGS_HOST) $< +#------------------------------------------------------------------------------- +# unit tests +#------------------------------------------------------------------------------- + +# this builds all dependent source code automatically even though only a subset might actually be used +# this is no different than the cice target and in fact the binary is called cice +# it exists just to create separation as needed for unit tests +calchk: $(EXEC) + +# this builds just a subset of source code specified explicitly and requires a separate target +HWOBJS := helloworld.o +helloworld: $(HWOBJS) + $(LD) -o $(EXEC) $(LDFLAGS) $(HWOBJS) $(ULIBS) $(SLIBS) + #------------------------------------------------------------------------------- # build rules: MACFILE, cmd-line, or env vars must provide the needed macros #------------------------------------------------------------------------------- diff --git a/configuration/scripts/cice.batch.csh b/configuration/scripts/cice.batch.csh index 6d1f735a4..902abb56b 100755 --- a/configuration/scripts/cice.batch.csh +++ b/configuration/scripts/cice.batch.csh @@ -105,11 +105,20 @@ cat >> ${jobfile} << EOFB EOFB else if (${ICE_MACHINE} =~ onyx*) then +# special for onyx with 44 cores per node and constraint on mpiprocs +set tpn1 = ${taskpernode} +if (${taskpernode} < 44) set tpn1 = 22 +if (${taskpernode} < 22) set tpn1 = 11 +if (${taskpernode} < 11) set tpn1 = 4 +if (${taskpernode} < 4) set tpn1 = 2 +if (${taskpernode} < 2) set tpn1 = 1 +@ nn1 = ${ntasks} / ${tpn1} +if (${nn1} * ${tpn1} < ${ntasks}) @ nn1 = $nn1 + 1 cat >> ${jobfile} << EOFB #PBS -N ${ICE_CASENAME} #PBS -q ${queue} #PBS -A ${acct} -#PBS -l select=${nnodes}:ncpus=${maxtpn}:mpiprocs=${taskpernode} +#PBS -l select=${nn1}:ncpus=${maxtpn}:mpiprocs=${tpn1} #PBS -l walltime=${batchtime} #PBS -j oe ###PBS -M username@domain.com @@ -133,6 +142,22 @@ cat >> ${jobfile} << EOFB ###SBATCH --mail-user username@domain.com EOFB +else if (${ICE_MACHINE} =~ compy*) then +if (${runlength} <= 2) set queue = "short" +cat >> ${jobfile} <> ${jobfile} << EOFB #SBATCH -J ${ICE_CASENAME} diff --git a/configuration/scripts/cice.build b/configuration/scripts/cice.build index b9aed44fe..d75d74253 100755 --- a/configuration/scripts/cice.build +++ b/configuration/scripts/cice.build @@ -142,6 +142,10 @@ if !($?ICE_MACHINE_BLDTHRDS) then set ICE_MACHINE_BLDTHRDS = 1 endif +if (${directmake} == 0) then + set target = ${ICE_TARGET} +endif + if (${directmake} == 1) then echo "make ${target}" ${ICE_MACHINE_MAKE} -j ${ICE_MACHINE_BLDTHRDS} VPFILE=Filepath EXEC=${ICE_RUNDIR}/cice \ @@ -185,12 +189,12 @@ if (${quiet} == "true") then echo " quiet mode on... patience" ${ICE_MACHINE_MAKE} -j ${ICE_MACHINE_BLDTHRDS} VPFILE=Filepath EXEC=${ICE_RUNDIR}/cice \ -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.${ICE_MACHCOMP} \ - DEPFILE=${ICE_CASEDIR}/makdep.c cice >& ${ICE_BLDLOG_FILE} + DEPFILE=${ICE_CASEDIR}/makdep.c ${target} >& ${ICE_BLDLOG_FILE} set bldstat = ${status} else ${ICE_MACHINE_MAKE} -j ${ICE_MACHINE_BLDTHRDS} VPFILE=Filepath EXEC=${ICE_RUNDIR}/cice \ -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.${ICE_MACHCOMP} \ - DEPFILE=${ICE_CASEDIR}/makdep.c cice |& tee ${ICE_BLDLOG_FILE} + DEPFILE=${ICE_CASEDIR}/makdep.c ${target} |& tee ${ICE_BLDLOG_FILE} set bldstat = ${status} endif diff --git a/configuration/scripts/cice.launch.csh b/configuration/scripts/cice.launch.csh index a05b3a9d3..7d45a387f 100755 --- a/configuration/scripts/cice.launch.csh +++ b/configuration/scripts/cice.launch.csh @@ -81,6 +81,18 @@ srun --cpu-bind=cores ./cice >&! \$ICE_RUNLOG_FILE EOFR endif +#======= +else if (${ICE_MACHINE} =~ compy*) then +if (${ICE_COMMDIR} =~ serial*) then +cat >> ${jobfile} << EOFR +./cice >&! \$ICE_RUNLOG_FILE +EOFR +else +cat >> ${jobfile} << EOFR +srun --mpi=pmi2 --kill-on-bad-exit --cpu-bind=cores ./cice >&! \$ICE_RUNLOG_FILE +EOFR +endif + #======= else if (${ICE_MACHINE} =~ badger*) then if (${ICE_COMMDIR} =~ serial*) then diff --git a/configuration/scripts/cice.run.setup.csh b/configuration/scripts/cice.run.setup.csh index 901671a36..ea8efeb03 100755 --- a/configuration/scripts/cice.run.setup.csh +++ b/configuration/scripts/cice.run.setup.csh @@ -95,9 +95,15 @@ if ( \$status == 0 ) then echo "CICE run completed successfully" echo "\`date\` \${0}: CICE run completed successfully" >> \${ICE_CASEDIR}/README.case else - echo "CICE run did NOT complete" - echo "\`date\` \${0}: CICE run did NOT complete" >> \${ICE_CASEDIR}/README.case - exit -1 + grep 'COMPLETED SUCCESSFULLY' \${checkfile} + if ( \$status == 0 ) then + echo "Run completed successfully" + echo "\`date\` \${0}: Run completed successfully" >> \${ICE_CASEDIR}/README.case + else + echo "CICE run did NOT complete" + echo "\`date\` \${0}: CICE run did NOT complete" >> \${ICE_CASEDIR}/README.case + exit -1 + endif endif if ( \${diagtype} == 0) then diff --git a/configuration/scripts/cice.settings b/configuration/scripts/cice.settings index d2653a29d..3bd85f5f9 100755 --- a/configuration/scripts/cice.settings +++ b/configuration/scripts/cice.settings @@ -13,6 +13,7 @@ setenv ICE_RSTDIR ${ICE_RUNDIR}/restart setenv ICE_HSTDIR ${ICE_RUNDIR}/history setenv ICE_LOGDIR ${ICE_CASEDIR}/logs setenv ICE_DRVOPT standalone/cice +setenv ICE_TARGET cice setenv ICE_IOTYPE netcdf # binary, netcdf, pio1, pio2 setenv ICE_CLEANBUILD true setenv ICE_CPPDEFS "" diff --git a/configuration/scripts/cice_decomp.csh b/configuration/scripts/cice_decomp.csh index b20f8d129..aa1bb9a54 100755 --- a/configuration/scripts/cice_decomp.csh +++ b/configuration/scripts/cice_decomp.csh @@ -44,6 +44,17 @@ else if (${grid} == 'gbox128') then set blckx = 8; set blcky = 8 endif +else if (${grid} == 'gbox180') then + set nxglob = 180 + set nyglob = 180 + if (${cicepes} <= 1) then + set blckx = 180; set blcky = 180 + else if (${cicepes} <= 36) then + set blckx = 30; set blcky = 30 + else + set blckx = 9; set blcky = 9 + endif + else if (${grid} == 'gbox80') then set nxglob = 80 set nyglob = 80 @@ -98,6 +109,12 @@ else if (${grid} == 'tx1') then set blckx = 10; set blcky = 10 endif +# this is for unit testing +else if (${grid} == 'none') then + set nxglob = 1 + set nyglob = 1 + set blckx = 1; set blcky = 1 + else echo "${0:t}: ERROR unknown grid ${grid}" exit -9 diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index f34db14f0..e5fcb9177 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -1,9 +1,13 @@ &setup_nml days_per_year = 365 - use_leap_years = .false. - year_init = 1997 + use_leap_years = .true. + year_init = 2005 + month_init = 1 + day_init = 1 + sec_init = 0 istep0 = 0 dt = 3600.0 + npt_unit = '1' npt = 24 ndtd = 1 runtype = 'initial' @@ -25,6 +29,9 @@ diagfreq = 24 diag_type = 'stdout' diag_file = 'ice_diag.d' + debug_model = .false. + debug_model_step = 999999999 + forcing_diag = .false. print_global = .true. print_points = .true. conserv_check = .false. @@ -32,7 +39,6 @@ lonpnt(1) = 0. latpnt(2) = -65. lonpnt(2) = -45. - dbug = .false. histfreq = 'm','x','x','x','x' histfreq_n = 1 , 1 , 1 , 1 , 1 hist_avg = .true. @@ -196,6 +202,7 @@ natmiter = 5 atmiter_conv = 0.0d0 ustar_min = 0.0005 + iceruf = 0.0005 emissivity = 0.985 fbot_xfer_type = 'constant' update_ocn_f = .false. @@ -216,7 +223,7 @@ bgc_data_type = 'default' fe_data_type = 'default' ice_data_type = 'default' - fyear_init = 1997 + fyear_init = 2005 ycycle = 1 atm_data_format = 'bin' atm_data_dir = '/glade/u/home/tcraig/cice_data/' @@ -236,12 +243,14 @@ processor_shape = 'slenderX2' distribution_type = 'cartesian' distribution_wght = 'latitude' + distribution_wght_file = 'unknown' ew_boundary_type = 'cyclic' ns_boundary_type = 'open' maskhalo_dyn = .false. maskhalo_remap = .false. maskhalo_bound = .false. add_mpi_barriers = .false. + debug_blocks = .false. / &zbgc_nml diff --git a/configuration/scripts/machines/Macros.banting_intel b/configuration/scripts/machines/Macros.banting_intel index 7ed7f7b5a..2bab45725 100644 --- a/configuration/scripts/machines/Macros.banting_intel +++ b/configuration/scripts/machines/Macros.banting_intel @@ -13,7 +13,7 @@ FFLAGS := -fp-model source -convert big_endian -assume byterecl -ftz -traceb #-xHost ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -g -check -fpe0 -ftrapuv -fp-model except -check noarg_temp_created + FFLAGS += -O0 -g -check -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays # -heap-arrays 1024 else FFLAGS += -O2 diff --git a/configuration/scripts/machines/Macros.cheyenne_gnu b/configuration/scripts/machines/Macros.cheyenne_gnu index f46d80414..082130f77 100644 --- a/configuration/scripts/machines/Macros.cheyenne_gnu +++ b/configuration/scripts/machines/Macros.cheyenne_gnu @@ -13,6 +13,7 @@ FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) FFLAGS += -O0 -g -fcheck=bounds -finit-real=nan -fimplicit-none -ffpe-trap=invalid,zero,overflow +# FFLAGS += -O0 -g -fcheck=all -finit-real=snan -fimplicit-none -ffpe-trap=invalid,zero,overflow CFLAGS += -O0 endif diff --git a/configuration/scripts/machines/Macros.cheyenne_intel b/configuration/scripts/machines/Macros.cheyenne_intel index 243295487..52fc07ebb 100644 --- a/configuration/scripts/machines/Macros.cheyenne_intel +++ b/configuration/scripts/machines/Macros.cheyenne_intel @@ -12,7 +12,9 @@ FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -trace FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -link_mpi=dbg +# FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -link_mpi=dbg + FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -link_mpi=dbg +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays -link_mpi=dbg else FFLAGS += -O2 endif diff --git a/configuration/scripts/machines/Macros.compy_intel b/configuration/scripts/machines/Macros.compy_intel new file mode 100644 index 000000000..604337f59 --- /dev/null +++ b/configuration/scripts/machines/Macros.compy_intel @@ -0,0 +1,44 @@ +#============================================================================== +# Makefile macro for PNNL compy, intel compiler +#============================================================================== + +CPP := fpp +CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CFLAGS := -c -O2 -fp-model precise -xHost + +FIXEDFLAGS := -132 +FREEFLAGS := -FR +FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback -xHost +FFLAGS_NOOPT:= -O0 + +ifeq ($(ICE_BLDDEBUG), true) + FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created +else + FFLAGS += -O2 +endif + +SCC := icc +SFC := ifort +MPICC := mpiicc +MPIFC := mpiifort +ifeq ($(ICE_COMMDIR), mpi) + FC := $(MPIFC) + CC := $(MPICC) +else + FC := $(SFC) + CC := $(SCC) +endif +LD := $(FC) + +INC_NETCDF := $(NETCDF_PATH)/include +LIB_NETCDF := $(NETCDF_PATH)/lib + +INCLDIR := $(INCLDIR) -I$(INC_NETCDF) +SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff + +ifeq ($(ICE_THREADED), true) + LDFLAGS += -qopenmp + CFLAGS += -qopenmp + FFLAGS += -qopenmp +endif + diff --git a/configuration/scripts/machines/Macros.conda_macos b/configuration/scripts/machines/Macros.conda_macos index 4acc4d3ba..9be1b9ab4 100644 --- a/configuration/scripts/machines/Macros.conda_macos +++ b/configuration/scripts/machines/Macros.conda_macos @@ -45,6 +45,7 @@ ifeq ($(strip $(SDKPATH)),) CFLAGS_HOST := else CFLAGS_HOST = -isysroot $(SDKPATH) + LD += -L$(SDKPATH)/usr/lib endif # Libraries to be passed to the linker diff --git a/configuration/scripts/machines/Macros.daley_intel b/configuration/scripts/machines/Macros.daley_intel index 897e6e057..a434ffdb3 100644 --- a/configuration/scripts/machines/Macros.daley_intel +++ b/configuration/scripts/machines/Macros.daley_intel @@ -13,7 +13,7 @@ FFLAGS := -fp-model source -convert big_endian -assume byterecl -ftz -traceb #-xHost ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -g -check -fpe0 -ftrapuv -fp-model except -check noarg_temp_created + FFLAGS += -O0 -g -check -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays # -heap-arrays 1024 else FFLAGS += -O2 diff --git a/configuration/scripts/machines/Macros.gaffney_intel b/configuration/scripts/machines/Macros.gaffney_intel index 61dfe2518..7eccd36da 100644 --- a/configuration/scripts/machines/Macros.gaffney_intel +++ b/configuration/scripts/machines/Macros.gaffney_intel @@ -13,7 +13,7 @@ FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -# FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -init=snan,arrays +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays else FFLAGS += -O2 endif diff --git a/configuration/scripts/machines/Macros.koehr_intel b/configuration/scripts/machines/Macros.koehr_intel index 284d30c55..aee4b31a8 100644 --- a/configuration/scripts/machines/Macros.koehr_intel +++ b/configuration/scripts/machines/Macros.koehr_intel @@ -13,7 +13,7 @@ FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -# FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -init=snan,arrays +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays else FFLAGS += -O2 endif diff --git a/configuration/scripts/machines/Macros.mustang_intel18 b/configuration/scripts/machines/Macros.mustang_intel18 index 5d1849488..28c1c1964 100644 --- a/configuration/scripts/machines/Macros.mustang_intel18 +++ b/configuration/scripts/machines/Macros.mustang_intel18 @@ -13,6 +13,7 @@ FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays else FFLAGS += -O2 endif diff --git a/configuration/scripts/machines/Macros.mustang_intel19 b/configuration/scripts/machines/Macros.mustang_intel19 index 5d1849488..28c1c1964 100644 --- a/configuration/scripts/machines/Macros.mustang_intel19 +++ b/configuration/scripts/machines/Macros.mustang_intel19 @@ -13,6 +13,7 @@ FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays else FFLAGS += -O2 endif diff --git a/configuration/scripts/machines/Macros.mustang_intel20 b/configuration/scripts/machines/Macros.mustang_intel20 index 5d1849488..28c1c1964 100644 --- a/configuration/scripts/machines/Macros.mustang_intel20 +++ b/configuration/scripts/machines/Macros.mustang_intel20 @@ -13,6 +13,7 @@ FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays else FFLAGS += -O2 endif diff --git a/configuration/scripts/machines/Macros.onyx_intel b/configuration/scripts/machines/Macros.onyx_intel index 55f6fbbf5..92879ee82 100644 --- a/configuration/scripts/machines/Macros.onyx_intel +++ b/configuration/scripts/machines/Macros.onyx_intel @@ -13,6 +13,7 @@ FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays else FFLAGS += -O2 endif diff --git a/configuration/scripts/machines/env.cheyenne_gnu b/configuration/scripts/machines/env.cheyenne_gnu index b17a15917..3bfe59c31 100755 --- a/configuration/scripts/machines/env.cheyenne_gnu +++ b/configuration/scripts/machines/env.cheyenne_gnu @@ -31,6 +31,9 @@ endif endif +limit coredumpsize unlimited +limit stacksize unlimited + setenv ICE_MACHINE_MACHNAME cheyenne setenv ICE_MACHINE_MACHINFO "SGI ICE XA Xeon E5-2697V4 Broadwell" setenv ICE_MACHINE_ENVNAME gnu diff --git a/configuration/scripts/machines/env.cheyenne_intel b/configuration/scripts/machines/env.cheyenne_intel index ce4eba29b..4a430622e 100755 --- a/configuration/scripts/machines/env.cheyenne_intel +++ b/configuration/scripts/machines/env.cheyenne_intel @@ -31,6 +31,9 @@ endif endif +limit coredumpsize unlimited +limit stacksize unlimited + setenv ICE_MACHINE_MACHNAME cheyenne setenv ICE_MACHINE_MACHINFO "SGI ICE XA Xeon E5-2697V4 Broadwell" setenv ICE_MACHINE_ENVNAME intel diff --git a/configuration/scripts/machines/env.cheyenne_pgi b/configuration/scripts/machines/env.cheyenne_pgi index ba9ea498d..693692842 100755 --- a/configuration/scripts/machines/env.cheyenne_pgi +++ b/configuration/scripts/machines/env.cheyenne_pgi @@ -31,6 +31,9 @@ endif endif +limit coredumpsize unlimited +limit stacksize unlimited + setenv ICE_MACHINE_MACHNAME cheyenne setenv ICE_MACHINE_MACHINFO "SGI ICE XA Xeon E5-2697V4 Broadwell" setenv ICE_MACHINE_ENVNAME pgi diff --git a/configuration/scripts/machines/env.compy_intel b/configuration/scripts/machines/env.compy_intel new file mode 100755 index 000000000..fe3511aa6 --- /dev/null +++ b/configuration/scripts/machines/env.compy_intel @@ -0,0 +1,42 @@ +#!/bin/csh -f + +set inp = "undefined" +if ($#argv == 1) then + set inp = $1 +endif + +if ("$inp" != "-nomodules") then + +source /share/apps/modules/init/csh + +module purge +module load intel/19.0.5 +module load intelmpi/2019u4 +module load netcdf/4.6.3 +module load hdf5/1.10.5 + +#setenv NETCDF_PATH ${NETCDF_DIR} +setenv NETCDF_PATH /share/apps/netcdf/4.6.3/intel/19.0.5 +setenv OMP_PROC_BIND true +setenv OMP_PLACES threads +setenv I_MPI_ADJUST_ALLREDUCE 1 +limit coredumpsize unlimited +limit stacksize unlimited + +endif + +setenv ICE_MACHINE_MACHNAME compy +setenv ICE_MACHINE_MACHINFO "PNNL Intel Xeon Skylake with 192 GB of DDR4 DRAM" +setenv ICE_MACHINE_ENVNAME intel +setenv ICE_MACHINE_ENVINFO "intel/19.0.5 intelmpi/2019u4 netcdf/4.6.3" +setenv ICE_MACHINE_MAKE gmake +setenv ICE_MACHINE_WKDIR /compyfs/$USER/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /compyfs/inputdata/cice-consortium/ +setenv ICE_MACHINE_BASELINE /compyfs/$USER/CICE_BASELINE +setenv ICE_MACHINE_SUBMIT "sbatch " +setenv ICE_MACHINE_ACCT e3sm +setenv ICE_MACHINE_QUEUE "slurm" +setenv ICE_MACHINE_TPNODE 40 # tasks per node +setenv ICE_MACHINE_BLDTHRDS 4 +setenv ICE_MACHINE_QSTAT "squeue --jobs=" + diff --git a/configuration/scripts/options/set_env.calchk b/configuration/scripts/options/set_env.calchk new file mode 100644 index 000000000..7dfe9612e --- /dev/null +++ b/configuration/scripts/options/set_env.calchk @@ -0,0 +1,2 @@ +setenv ICE_DRVOPT unittest/calchk +setenv ICE_TARGET calchk diff --git a/configuration/scripts/options/set_env.helloworld b/configuration/scripts/options/set_env.helloworld new file mode 100644 index 000000000..60587fb91 --- /dev/null +++ b/configuration/scripts/options/set_env.helloworld @@ -0,0 +1,2 @@ +setenv ICE_DRVOPT unittest/helloworld +setenv ICE_TARGET helloworld diff --git a/configuration/scripts/options/set_nml.alt01 b/configuration/scripts/options/set_nml.alt01 index 98124b3f2..705fc8f63 100644 --- a/configuration/scripts/options/set_nml.alt01 +++ b/configuration/scripts/options/set_nml.alt01 @@ -15,7 +15,7 @@ kcatbound = 1 kitd = 0 ktherm = 0 conduct = 'bubbly' -kdyn = 0 +kdyn = 1 seabed_stress = .true. seabed_stress_method = 'probabilistic' use_bathymetry = .true. diff --git a/configuration/scripts/options/set_nml.alt03 b/configuration/scripts/options/set_nml.alt03 index 507f56a1b..a72696777 100644 --- a/configuration/scripts/options/set_nml.alt03 +++ b/configuration/scripts/options/set_nml.alt03 @@ -23,3 +23,4 @@ Ktens = 0. e_ratio = 2. seabed_stress = .true. use_bathymetry = .true. +l_mpond_fresh = .true. diff --git a/configuration/scripts/options/set_nml.alt05 b/configuration/scripts/options/set_nml.alt05 index 5a1f83110..5e439d9e0 100644 --- a/configuration/scripts/options/set_nml.alt05 +++ b/configuration/scripts/options/set_nml.alt05 @@ -8,6 +8,3 @@ tr_pond_topo = .false. tr_pond_lvl = .false. tr_aero = .false. shortwave = 'dEdd' -albedo_type = 'default' - - diff --git a/configuration/scripts/options/set_nml.alt06 b/configuration/scripts/options/set_nml.alt06 new file mode 100644 index 000000000..197f1f4a7 --- /dev/null +++ b/configuration/scripts/options/set_nml.alt06 @@ -0,0 +1,5 @@ +ncat = 7 +kcatbound = 3 +nslyr = 3 +ice_ic = 'default' +restart = .false. diff --git a/configuration/scripts/options/set_nml.bgcz b/configuration/scripts/options/set_nml.bgcz index 62c93f783..379a2fd63 100644 --- a/configuration/scripts/options/set_nml.bgcz +++ b/configuration/scripts/options/set_nml.bgcz @@ -26,5 +26,5 @@ tr_bgc_PON = .true. tr_bgc_hum = .true. tr_bgc_DON = .true. tr_bgc_Fe = .true. - - +# modal_aero = .true. +# dEdd_algae = .true. diff --git a/configuration/scripts/options/set_nml.bigdiag b/configuration/scripts/options/set_nml.bigdiag new file mode 100644 index 000000000..a98bc0c2b --- /dev/null +++ b/configuration/scripts/options/set_nml.bigdiag @@ -0,0 +1,8 @@ +forcing_diag = .true. +debug_model = .true. +debug_model_step = 4 +print_global = .true. +print_points = .true. +debug_blocks = .true. +latpnt(1) = 85. +lonpnt(1) = -150. diff --git a/configuration/scripts/options/set_nml.box2001 b/configuration/scripts/options/set_nml.box2001 index 79382d84e..84cac67b2 100644 --- a/configuration/scripts/options/set_nml.box2001 +++ b/configuration/scripts/options/set_nml.box2001 @@ -1,4 +1,5 @@ days_per_year = 360 +use_leap_years = .false. npt = 240 ice_ic = 'default' restart = .false. diff --git a/configuration/scripts/options/set_nml.boxadv b/configuration/scripts/options/set_nml.boxadv index 6fcdcc5df..49ab3f13c 100644 --- a/configuration/scripts/options/set_nml.boxadv +++ b/configuration/scripts/options/set_nml.boxadv @@ -18,4 +18,6 @@ kdyn = 2 kstrength = 0 krdg_partic = 0 krdg_redist = 0 +shortwave = 'ccsm3' +albedo_type = 'constant' diff --git a/configuration/scripts/options/set_nml.boxdyn b/configuration/scripts/options/set_nml.boxnodyn similarity index 88% rename from configuration/scripts/options/set_nml.boxdyn rename to configuration/scripts/options/set_nml.boxnodyn index 72e89db5c..e6de6be0d 100644 --- a/configuration/scripts/options/set_nml.boxdyn +++ b/configuration/scripts/options/set_nml.boxnodyn @@ -2,6 +2,7 @@ nilyr = 1 ice_ic = 'default' restart = .false. days_per_year = 360 +use_leap_years = .false. npt = 72 dumpfreq = 'd' dumpfreq_n = 2 @@ -25,3 +26,5 @@ revised_evp = .false. kstrength = 0 krdg_partic = 1 krdg_redist = 1 +shortwave = 'ccsm3' +albedo_type = 'constant' diff --git a/configuration/scripts/options/set_nml.boxrestore b/configuration/scripts/options/set_nml.boxrestore index d00ec41c8..6092a4d23 100644 --- a/configuration/scripts/options/set_nml.boxrestore +++ b/configuration/scripts/options/set_nml.boxrestore @@ -26,3 +26,5 @@ krdg_partic = 0 krdg_redist = 0 seabed_stress = .true. restore_ice = .true. +shortwave = 'ccsm3' +albedo_type = 'constant' diff --git a/configuration/scripts/options/set_nml.boxslotcyl b/configuration/scripts/options/set_nml.boxslotcyl index b13c8ca43..7d9f5e90e 100644 --- a/configuration/scripts/options/set_nml.boxslotcyl +++ b/configuration/scripts/options/set_nml.boxslotcyl @@ -11,6 +11,8 @@ kcatbound = 2 ew_boundary_type = 'open' ns_boundary_type = 'open' close_boundaries = .true. +tr_lvl = .false. +tr_pond_lvl = .false. ktherm = -1 kdyn = -1 kridge = -1 diff --git a/configuration/scripts/options/set_nml.debugblocks b/configuration/scripts/options/set_nml.debugblocks new file mode 100644 index 000000000..299dfff66 --- /dev/null +++ b/configuration/scripts/options/set_nml.debugblocks @@ -0,0 +1 @@ +debug_blocks = .true. diff --git a/configuration/scripts/options/set_nml.dspiralcenter b/configuration/scripts/options/set_nml.dspiralcenter new file mode 100644 index 000000000..fcf32dde7 --- /dev/null +++ b/configuration/scripts/options/set_nml.dspiralcenter @@ -0,0 +1 @@ +distribution_type = 'spiralcenter' diff --git a/configuration/scripts/options/set_nml.dwghtfile b/configuration/scripts/options/set_nml.dwghtfile new file mode 100644 index 000000000..d72b0fb8a --- /dev/null +++ b/configuration/scripts/options/set_nml.dwghtfile @@ -0,0 +1,3 @@ + distribution_type = 'wghtfile' + distribution_wght = 'file' + distribution_wght_file = 'ICE_MACHINE_INPUTDATA/CICE_data/grid/gx1/cice62_gx1_wghtmask.nc' diff --git a/configuration/scripts/options/set_nml.gbox180 b/configuration/scripts/options/set_nml.gbox180 new file mode 100644 index 000000000..7b139f94a --- /dev/null +++ b/configuration/scripts/options/set_nml.gbox180 @@ -0,0 +1,4 @@ +ice_ic = 'default' +grid_type = 'rectangular' +atm_data_type = 'box2001' +ice_data_type = 'box2001' diff --git a/configuration/scripts/options/set_nml.gx1 b/configuration/scripts/options/set_nml.gx1 index e1d18dc8b..2e8d4f5b7 100644 --- a/configuration/scripts/options/set_nml.gx1 +++ b/configuration/scripts/options/set_nml.gx1 @@ -3,7 +3,7 @@ runtype = 'initial' year_init = 2005 use_leap_years = .true. use_restart_time = .false. -ice_ic = 'ICE_MACHINE_INPUTDATA/CICE_data/ic/gx1/iced_gx1_v5.nc' +ice_ic = 'ICE_MACHINE_INPUTDATA/CICE_data/ic/gx1/iced_gx1_v6.2005-01-01.nc' grid_format = 'bin' grid_type = 'displaced_pole' grid_file = 'ICE_MACHINE_INPUTDATA/CICE_data/grid/gx1/grid_gx1.bin' @@ -17,5 +17,5 @@ atm_data_format = 'nc' atm_data_type = 'JRA55_gx1' atm_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1/JRA55' precip_units = 'mks' -ocn_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1/COREII' +ocn_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1/CESM/MONTHLY' bgc_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1/WOA/MONTHLY' diff --git a/configuration/scripts/options/set_nml.gx1apr b/configuration/scripts/options/set_nml.gx1apr new file mode 100644 index 000000000..c150d5815 --- /dev/null +++ b/configuration/scripts/options/set_nml.gx1apr @@ -0,0 +1,5 @@ +year_init = 2005 +month_init = 4 +day_init = 1 +sec_init = 0 +ice_ic = 'ICE_MACHINE_INPUTDATA/CICE_data/ic/gx1/iced_gx1_v6.2005-04-01.nc' diff --git a/configuration/scripts/options/set_nml.gx1coreii b/configuration/scripts/options/set_nml.gx1coreii index 44b334194..13b8db59e 100644 --- a/configuration/scripts/options/set_nml.gx1coreii +++ b/configuration/scripts/options/set_nml.gx1coreii @@ -1,6 +1,7 @@ year_init = 1997 use_leap_years = .false. use_restart_time = .true. +ice_ic = 'ICE_MACHINE_INPUTDATA/CICE_data/ic/gx1/iced_gx1_v5.nc' fyear_init = 2005 ycycle = 1 atm_data_format = 'bin' diff --git a/configuration/scripts/options/set_nml.gx1prod b/configuration/scripts/options/set_nml.gx1prod index a26af8102..f725c4367 100644 --- a/configuration/scripts/options/set_nml.gx1prod +++ b/configuration/scripts/options/set_nml.gx1prod @@ -1,7 +1,18 @@ -year_init = 1958 -dt = 3600 -npt = 87600 +year_init = 2005 +use_leap_years = .true. +npt_unit = 'y' +npt = 1 dumpfreq = 'm' -fyear_init = 1958 -ycycle = 52 -ocn_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1' +fyear_init = 2005 +ycycle = 5 +ocn_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1/CESM/MONTHLY/' +use_bathymetry = .true. +seabed_stress = .true. +seabed_stress_method = 'LKD' +ocn_data_type = 'ncar' +ocn_data_format = 'nc' +oceanmixed_ice = .true. +oceanmixed_file = 'ocean_forcing_clim_2D_gx1.20210330.nc' +tr_brine = .true. +f_taubx = 'm' +f_tauby = 'm' diff --git a/configuration/scripts/options/set_nml.gx3sep2 b/configuration/scripts/options/set_nml.gx3sep2 new file mode 100644 index 000000000..4eeefc64d --- /dev/null +++ b/configuration/scripts/options/set_nml.gx3sep2 @@ -0,0 +1,6 @@ +year_init = 2005 +month_init = 9 +day_init = 2 +sec_init = 7200 +use_leap_years = .true. +ice_ic = 'ICE_MACHINE_INPUTDATA/CICE_data/ic/gx3/iced_gx3_v6.2005-09-01.nc' diff --git a/configuration/scripts/options/set_nml.ml b/configuration/scripts/options/set_nml.ml new file mode 100644 index 000000000..0d00cbd5b --- /dev/null +++ b/configuration/scripts/options/set_nml.ml @@ -0,0 +1,7 @@ + +oceanmixed_ice = .true. +ocn_data_type = 'ncar' +ocn_data_format = 'nc' +ocn_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1/CESM/MONTHLY' +oceanmixed_file = 'ocean_forcing_clim_2D_gx1.20210330.nc' + diff --git a/configuration/scripts/options/set_nml.run10day b/configuration/scripts/options/set_nml.run10day index deae3e993..05160c42d 100644 --- a/configuration/scripts/options/set_nml.run10day +++ b/configuration/scripts/options/set_nml.run10day @@ -1,4 +1,5 @@ -npt = 240 +npt_unit = 'd' +npt = 10 dumpfreq = 'd' dumpfreq_n = 10 histfreq = 'd','x','x','x','x' diff --git a/configuration/scripts/options/set_nml.run1day b/configuration/scripts/options/set_nml.run1day index d7b70f973..a4ed751d5 100644 --- a/configuration/scripts/options/set_nml.run1day +++ b/configuration/scripts/options/set_nml.run1day @@ -1,4 +1,5 @@ -npt = 24 +npt_unit = 'd' +npt = 1 dumpfreq = 'd' dumpfreq_n = 1 diag_type = 'stdout' diff --git a/configuration/scripts/options/set_nml.run1year b/configuration/scripts/options/set_nml.run1year index 9a5baadfd..4e481870c 100644 --- a/configuration/scripts/options/set_nml.run1year +++ b/configuration/scripts/options/set_nml.run1year @@ -1,4 +1,5 @@ -npt = 8760 +npt_unit = 'y' +npt = 1 dumpfreq = 'm' dumpfreq_n = 12 diagfreq = 24 diff --git a/configuration/scripts/options/set_nml.run2day b/configuration/scripts/options/set_nml.run2day index 8129d59f6..60ece02f0 100644 --- a/configuration/scripts/options/set_nml.run2day +++ b/configuration/scripts/options/set_nml.run2day @@ -1,4 +1,5 @@ -npt = 48 +npt_unit = 'd' +npt = 2 dumpfreq = 'd' dumpfreq_n = 2 histfreq = 'd','x','x','x','x' diff --git a/configuration/scripts/options/set_nml.run3day b/configuration/scripts/options/set_nml.run3day index 1fbf7a115..1a839468e 100644 --- a/configuration/scripts/options/set_nml.run3day +++ b/configuration/scripts/options/set_nml.run3day @@ -1,4 +1,5 @@ -npt = 72 +npt_unit = 'd' +npt = 3 dumpfreq = 'd' dumpfreq_n = 2 diag_type = 'stdout' diff --git a/configuration/scripts/options/set_nml.run3dt b/configuration/scripts/options/set_nml.run3dt index 102a19d80..4ff27ce22 100644 --- a/configuration/scripts/options/set_nml.run3dt +++ b/configuration/scripts/options/set_nml.run3dt @@ -1,3 +1,4 @@ +npt_unit = '1' npt = 3 dump_last = .true. histfreq = '1','x','x','x','x' diff --git a/configuration/scripts/options/set_nml.run5day b/configuration/scripts/options/set_nml.run5day index 4113c48e6..88d498a89 100644 --- a/configuration/scripts/options/set_nml.run5day +++ b/configuration/scripts/options/set_nml.run5day @@ -1,4 +1,5 @@ -npt = 120 +npt_unit = 'd' +npt = 5 dumpfreq = 'd' dumpfreq_n = 5 histfreq = 'd','x','x','x','x' diff --git a/configuration/scripts/options/set_nml.run60day b/configuration/scripts/options/set_nml.run60day index 01fd59504..96f6dea1c 100644 --- a/configuration/scripts/options/set_nml.run60day +++ b/configuration/scripts/options/set_nml.run60day @@ -1,4 +1,5 @@ -npt = 1440 +npt_unit = 'd' +npt = 60 dumpfreq = 'd' dumpfreq_n = 30 histfreq = 'd','x','x','x','x' diff --git a/configuration/scripts/options/set_nml.run90day b/configuration/scripts/options/set_nml.run90day index 06db1a3d8..34d31166f 100644 --- a/configuration/scripts/options/set_nml.run90day +++ b/configuration/scripts/options/set_nml.run90day @@ -1,4 +1,5 @@ -npt = 2160 +npt_unit = 'd' +npt = 90 dumpfreq = 'd' dumpfreq_n = 30 histfreq = 'd','x','x','x','x' diff --git a/configuration/scripts/options/set_nml.seabedLKD b/configuration/scripts/options/set_nml.seabedLKD new file mode 100644 index 000000000..b53977d36 --- /dev/null +++ b/configuration/scripts/options/set_nml.seabedLKD @@ -0,0 +1,6 @@ +use_bathymetry = .true. +seabed_stress = .true. +seabed_stress_method = 'LKD' +histfreq = 'm','d','x','x','x' +f_taubx = 'md' +f_tauby = 'md' diff --git a/configuration/scripts/options/set_nml.seabedprob b/configuration/scripts/options/set_nml.seabedprob new file mode 100644 index 000000000..d6ad877ee --- /dev/null +++ b/configuration/scripts/options/set_nml.seabedprob @@ -0,0 +1,6 @@ +use_bathymetry = .true. +seabed_stress = .true. +seabed_stress_method = 'probabilistic' +histfreq = 'm','d','x','x','x' +f_taubx = 'md' +f_tauby = 'md' diff --git a/configuration/scripts/options/test_nml.restart1 b/configuration/scripts/options/test_nml.restart1 index 82f934720..6ab0bd88b 100644 --- a/configuration/scripts/options/test_nml.restart1 +++ b/configuration/scripts/options/test_nml.restart1 @@ -1,4 +1,5 @@ -npt = 240 +npt = 10 +npt_unit = 'd' dumpfreq = 'd' dumpfreq_n = 5 runtype = 'initial' diff --git a/configuration/scripts/options/test_nml.restart2 b/configuration/scripts/options/test_nml.restart2 index 4ae10c5a6..c12887eb0 100644 --- a/configuration/scripts/options/test_nml.restart2 +++ b/configuration/scripts/options/test_nml.restart2 @@ -1,4 +1,5 @@ -npt = 120 +npt = 5 +npt_unit = 'd' dumpfreq = 'd' dumpfreq_n = 5 runtype = 'continue' diff --git a/configuration/scripts/tests/base_suite.ts b/configuration/scripts/tests/base_suite.ts old mode 100755 new mode 100644 index 1ed489730..c37750a31 --- a/configuration/scripts/tests/base_suite.ts +++ b/configuration/scripts/tests/base_suite.ts @@ -5,6 +5,7 @@ smoke gx3 1x4 debug,diag1,run2day smoke gx3 4x1 debug,diag1,run5day restart gx3 8x2 debug smoke gx3 8x2 diag24,run1year,medium +smoke gx3 7x2 diag1,bigdiag,run1day decomp gx3 4x2x25x29x5 none smoke gx3 4x2 diag1,run5day smoke_gx3_8x2_diag1_run5day smoke gx3 4x1 diag1,run5day,thread smoke_gx3_8x2_diag1_run5day @@ -16,14 +17,18 @@ restart gx3 8x2 alt02 restart gx3 4x2 alt03 restart gx3 4x4 alt04 restart gx3 4x4 alt05 +restart gx3 8x2 alt06 restart gx3 6x2 alt01,debug,short restart gx3 8x2 alt02,debug,short restart gx3 4x2 alt03,debug,short smoke gx3 4x4 alt04,debug,short smoke gx3 4x4 alt05,debug,short +smoke gx3 8x2 alt06,debug,short +smoke gx3 10x2 debug,diag1,run5day,gx3sep2 +smoke gx3 7x2 diag1,bigdiag,run1day restart gbox128 4x2 short -restart gbox128 4x2 boxdyn,short -restart gbox128 4x2 boxdyn,short,debug +restart gbox128 4x2 boxnodyn,short +restart gbox128 4x2 boxnodyn,short,debug restart gbox128 2x2 boxadv,short smoke gbox128 2x2 boxadv,short,debug restart gbox128 4x4 boxrestore,short @@ -39,7 +44,9 @@ restart gx1 8x1 bgczclim,medium smoke gx1 24x1 medium,run90day,yi2008 smoke gx3 8x1 medium,run90day,yi2008 restart gx1 24x1 short -restart gx3 8x1 short +restart gx1 16x2 seabedLKD,gx1apr,medium,debug +restart gx1 15x2 seabedprob,medium +restart gx1 32x1 gx1prod,medium smoke gx3 4x2 fsd1,diag24,run5day,debug smoke gx3 8x2 fsd12,diag24,run5day,short restart gx3 4x2 fsd12,debug,short diff --git a/configuration/scripts/tests/baseline.script b/configuration/scripts/tests/baseline.script index a1ab4e055..6f13807e3 100644 --- a/configuration/scripts/tests/baseline.script +++ b/configuration/scripts/tests/baseline.script @@ -20,38 +20,93 @@ endif # Baseline comparing run if (${ICE_BASECOM} != ${ICE_SPVAL}) then - set test_dir = ${ICE_RUNDIR}/restart - set base_dir = ${ICE_BASELINE}/${ICE_BASECOM}/${ICE_TESTNAME}/restart - - set baseline_log = `ls -1t ${ICE_BASELINE}/${ICE_BASECOM}/${ICE_TESTNAME}/cice.runlog* | head -1` set btimeloop = -1 set bdynamics = -1 set bcolumn = -1 - if (${baseline_log} != "" ) then - set btimeloop = `grep TimeLoop ${baseline_log} | grep Timer | cut -c 22-32` - set bdynamics = `grep Dynamics ${baseline_log} | grep Timer | cut -c 22-32` - set bcolumn = `grep Column ${baseline_log} | grep Timer | cut -c 22-32` - if (${btimeloop} == "") set btimeloop = -1 - if (${bdynamics} == "") set bdynamics = -1 - if (${bcolumn} == "") set bcolumn = -1 - endif - echo "" - echo "Regression Compare Mode:" - echo "base_dir: ${base_dir}" - echo "test_dir: ${test_dir}" + if (${ICE_TEST} == "unittest") then + set test_file = `ls -1t ${ICE_RUNDIR}/cice.runlog* | head -1` + set base_file = `ls -1t ${ICE_BASELINE}/${ICE_BASECOM}/${ICE_TESTNAME}/cice.runlog* | head -1` + + echo "" + echo "bfb Log Compare Mode:" + echo "base_file: ${base_file}" + echo "test_file: ${test_file}" + + ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} notcicefile + set bfbstatus = $status + + else + + set test_dir = ${ICE_RUNDIR}/restart + set base_dir = ${ICE_BASELINE}/${ICE_BASECOM}/${ICE_TESTNAME}/restart + + set baseline_log = `ls -1t ${ICE_BASELINE}/${ICE_BASECOM}/${ICE_TESTNAME}/cice.runlog* | head -1` + if (${baseline_log} != "" ) then + set btimeloop = `grep TimeLoop ${baseline_log} | grep Timer | cut -c 22-32` + set bdynamics = `grep Dynamics ${baseline_log} | grep Timer | cut -c 22-32` + set bcolumn = `grep Column ${baseline_log} | grep Timer | cut -c 22-32` + if (${btimeloop} == "") set btimeloop = -1 + if (${bdynamics} == "") set bdynamics = -1 + if (${bcolumn} == "") set bcolumn = -1 + endif + + echo "" + echo "Regression Compare Mode:" + echo "base_dir: ${base_dir}" + echo "test_dir: ${test_dir}" + + ${ICE_CASEDIR}/casescripts/comparebfb.csh ${base_dir} ${test_dir} + set bfbstatus = $status + + if ( ${bfbstatus} != 0 ) then + + set test_file = `ls -1t ${ICE_RUNDIR}/cice.runlog* | head -1` + set base_file = `ls -1t ${ICE_BASELINE}/${ICE_BASECOM}/${ICE_TESTNAME}/cice.runlog* | head -1` + + echo "" + echo "bfb Log Compare Mode:" + echo "base_file: ${base_file}" + echo "test_file: ${test_file}" + + if ("${base_file}" == "" || "${test_file}" == "" ) then + echo "MISS ${ICE_TESTNAME} complog ${ICE_BASECOM} missing-data" >> ${ICE_CASEDIR}/test_output + echo "Missing data" + else + ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} + set logstatus = $status + + if ( ${logstatus} == 0 ) then + echo "PASS ${ICE_TESTNAME} complog ${ICE_BASECOM}" >> ${ICE_CASEDIR}/test_output + echo "Regression baseline and test dataset may be the same" + else if ( ${logstatus} == 1 ) then + echo "FAIL ${ICE_TESTNAME} complog ${ICE_BASECOM} different-data" >> ${ICE_CASEDIR}/test_output + echo "Regression baseline and test dataset are not the same" + else if ( ${logstatus} == 2 ) then + echo "MISS ${ICE_TESTNAME} complog ${ICE_BASECOM} missing-data" >> ${ICE_CASEDIR}/test_output + echo "Missing data" + else + echo "FAIL ${ICE_TESTNAME} complog ${ICE_BASECOM} usage-error" >> ${ICE_CASEDIR}/test_output + echo "Regression baseline and test dataset error in usage" + endif + endif + + endif + + endif - ${ICE_CASEDIR}/casescripts/comparebfb.csh ${base_dir} ${test_dir} - set bfbstatus = $status if ( ${bfbstatus} == 0 ) then echo "PASS ${ICE_TESTNAME} compare ${ICE_BASECOM} ${btimeloop} ${bdynamics} ${bcolumn}" >> ${ICE_CASEDIR}/test_output echo "Regression baseline and test dataset are identical" + else if ( ${bfbstatus} == 1 ) then + echo "FAIL ${ICE_TESTNAME} compare ${ICE_BASECOM} ${btimeloop} ${bdynamics} ${bcolumn} different-data" >> ${ICE_CASEDIR}/test_output + echo "Regression baseline and test dataset are different" else if ( ${bfbstatus} == 2 ) then echo "MISS ${ICE_TESTNAME} compare ${ICE_BASECOM} ${btimeloop} ${bdynamics} ${bcolumn} missing-data" >> ${ICE_CASEDIR}/test_output echo "Missing data" else - echo "FAIL ${ICE_TESTNAME} compare ${ICE_BASECOM} ${btimeloop} ${bdynamics} ${bcolumn} different-data" >> ${ICE_CASEDIR}/test_output - echo "Regression baseline and test dataset are different" + echo "FAIL ${ICE_TESTNAME} compare ${ICE_BASECOM} ${btimeloop} ${bdynamics} ${bcolumn} usage-error" >> ${ICE_CASEDIR}/test_output + echo "Regression baseline and test dataset error in usage" endif endif @@ -88,12 +143,15 @@ if (${ICE_BFBCOMP} != ${ICE_SPVAL}) then if (${bfbstatus} == 0) then echo "PASS ${ICE_TESTNAME} bfbcomp ${ICE_BFBCOMP}" >> ${ICE_CASEDIR}/test_output echo "bfb baseline and test dataset are identical" + else if (${bfbstatus} == 1) then + echo "FAIL ${ICE_TESTNAME} bfbcomp ${ICE_BFBCOMP} different-data" >> ${ICE_CASEDIR}/test_output + echo "bfbcomp and test dataset are different" else if (${bfbstatus} == 2) then echo "MISS ${ICE_TESTNAME} bfbcomp ${ICE_BFBCOMP} missing-data" >> ${ICE_CASEDIR}/test_output echo "Missing data" else - echo "FAIL ${ICE_TESTNAME} bfbcomp ${ICE_BFBCOMP} different-data" >> ${ICE_CASEDIR}/test_output - echo "bfbcomp and test dataset are different" + echo "FAIL ${ICE_TESTNAME} bfbcomp ${ICE_BFBCOMP} usage-error" >> ${ICE_CASEDIR}/test_output + echo "bfbcomp and test dataset usage error" endif endif diff --git a/configuration/scripts/tests/comparelog.csh b/configuration/scripts/tests/comparelog.csh index 8c1ff3a3c..d9e4a7a89 100755 --- a/configuration/scripts/tests/comparelog.csh +++ b/configuration/scripts/tests/comparelog.csh @@ -3,8 +3,9 @@ # Compare prognostic output in two log files #----------------------------------------------------------- -# usage: comparelog.csh base_file test_file +# usage: comparelog.csh base_file test_file [notcicefile] # does diff of two files +# optional 3rd argument indicates the file is not a cice file so diff entire thing # # Return Codes (depends on quality of error checking) # 0 = pass @@ -13,13 +14,26 @@ # 9 = error set filearg = 0 +set cicefile = 0 +set notcicefile = "notcicefile" if ( $#argv == 2 ) then + set cicefile = 1 set filearg = 1 set base_data = $argv[1] set test_data = $argv[2] -else + if ("$argv[1]" == "${notcicefile}") set filearg = 0 + if ("$argv[2]" == "${notcicefile}") set filearg = 0 +else if ( $#argv == 3 ) then + set cicefile = 0 + set filearg = 1 + set base_data = $argv[1] + set test_data = $argv[2] + if ("$argv[3]" != "${notcicefile}") set filearg = 0 +endif + +if (${filearg} == 0) then echo "Error in ${0}" - echo "Usage: ${0} " + echo "Usage: ${0} [notcicefile]" echo " does diff of two files" exit 9 endif @@ -28,7 +42,7 @@ set failure = 0 set base_out = "comparelog_base_out_file.log" set test_out = "comparelog_test_out_file.log" -if ($filearg == 1) then +if (${filearg} == 1) then echo "base_data: $base_data" echo "test_data: $test_data" if ( -f ${base_data} && -f ${test_data}) then @@ -38,12 +52,18 @@ if ($filearg == 1) then else touch ${base_out} - cat ${base_data} | grep -A 99999999 istep1: | grep -e istep1: -e = | grep -iv "min, max, sum" >&! ${base_out} touch ${test_out} - cat ${test_data} | grep -A 99999999 istep1: | grep -e istep1: -e = | grep -iv "min, max, sum" >&! ${test_out} + + if (${cicefile} == 1) then + cat ${base_data} | grep -A 99999999 "total ice area (km^2)" | grep -e istep1: -e = | grep -iv "min, max, sum" >&! ${base_out} + cat ${test_data} | grep -A 99999999 "total ice area (km^2)" | grep -e istep1: -e = | grep -iv "min, max, sum" >&! ${test_out} + else + cp -f ${base_data} ${base_out} + cp -f ${test_data} ${test_out} + endif set basenum = `cat ${base_out} | wc -l` - set testnum = `cat ${base_out} | wc -l` + set testnum = `cat ${test_out} | wc -l` set filediff = `diff -w ${base_out} ${test_out} | wc -l` if (${basenum} > 0 && ${testnum} > 0) then diff --git a/configuration/scripts/tests/decomp_suite.ts b/configuration/scripts/tests/decomp_suite.ts index 4eb5394d9..9c82c5d27 100644 --- a/configuration/scripts/tests/decomp_suite.ts +++ b/configuration/scripts/tests/decomp_suite.ts @@ -1,15 +1,50 @@ # Test Grid PEs Sets BFB-compare restart gx3 4x2x25x29x4 dslenderX2 +restart gx1 64x1x16x16x10 dwghtfile +restart gbox180 16x1x6x6x60 dspacecurve,debugblocks decomp gx3 4x2x25x29x5 none sleep 30 -restart gx3 1x1x50x58x4 droundrobin,thread restart_gx3_4x2x25x29x4_dslenderX2 -restart gx3 4x1x25x116x1 dslenderX1,thread restart_gx3_4x2x25x29x4_dslenderX2 -restart gx3 6x2x4x29x18 dspacecurve restart_gx3_4x2x25x29x4_dslenderX2 -restart gx3 8x2x8x10x20 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 -restart gx3 6x2x50x58x1 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 -restart gx3 4x2x19x19x10 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 -restart gx3 1x20x5x29x80 dsectrobin,short restart_gx3_4x2x25x29x4_dslenderX2 -restart gx3 16x2x5x10x20 drakeX2 restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 1x1x50x58x4 droundrobin,thread restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 4x1x25x116x1 dslenderX1,thread restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 6x2x4x29x18 dspacecurve restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 8x2x8x10x20 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 6x2x50x58x1 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 5x2x33x23x4 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 4x2x19x19x10 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 20x2x5x4x30 dsectrobin,short restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 16x2x5x10x20 drakeX2 restart_gx3_4x2x25x29x4_dslenderX2 restart gx3 8x2x8x10x20 droundrobin,maskhalo restart_gx3_4x2x25x29x4_dslenderX2 -restart gx3 1x4x25x29x16 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 1x4x25x29x16 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 1x8x30x20x32 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 1x1x120x125x1 droundrobin,thread restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 16x2x1x1x800 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 16x2x2x2x200 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 16x2x3x3x100 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 16x2x8x8x80 dspiralcenter restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 10x1x10x29x4 dsquarepop,thread restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 8x1x25x29x4 drakeX2,thread restart_gx3_4x2x25x29x4_dslenderX2 + +smoke gx3 4x2x25x29x4 debug,run2day,dslenderX2 +smoke gx1 64x1x16x16x10 debug,run2day,dwghtfile +smoke gbox180 16x1x6x6x60 debug,run2day,dspacecurve,debugblocks +sleep 30 +smoke gx3 1x1x25x58x8 debug,run2day,droundrobin,thread smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 20x1x5x116x1 debug,run2day,dslenderX1,thread smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 6x2x4x29x18 debug,run2day,dspacecurve smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 8x2x10x12x16 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 6x2x50x58x1 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 5x2x33x23x4 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 4x2x19x19x10 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 20x2x5x4x30 debug,run2day,dsectrobin,short smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 16x2x5x10x20 debug,run2day,drakeX2 smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 8x2x8x10x20 debug,run2day,droundrobin,maskhalo smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 1x6x25x29x16 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 1x8x30x20x32 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 1x1x120x125x1 debug,run2day,droundrobin,thread smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 16x2x1x1x800 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 16x2x2x2x200 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 16x2x3x3x100 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 16x2x8x8x80 debug,run2day,dspiralcenter smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 10x1x10x29x4 debug,run2day,dsquarepop,thread smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 8x1x25x29x4 debug,run2day,drakeX2,thread smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day diff --git a/configuration/scripts/tests/io_suite.ts b/configuration/scripts/tests/io_suite.ts old mode 100755 new mode 100644 index a17e3f625..6fe1f589a --- a/configuration/scripts/tests/io_suite.ts +++ b/configuration/scripts/tests/io_suite.ts @@ -7,6 +7,7 @@ restart gx3 16x2 gx3ncarbulk,alt02,histall,iobinary,precision8 #restart gx3 4x2 gx3ncarbulk,alt03,histall,iobinary restart gx3 8x4 gx3ncarbulk,alt04,histall,iobinary,precision8 restart gx3 4x4 gx3ncarbulk,alt05,histall,iobinary +restart gx3 14x2 gx3ncarbulk,alt06,histall,iobinary,precision8 restart gx3 32x1 gx3ncarbulk,bgcz,histall,iobinary,precision8 restart gx3 16x2 gx3ncarbulk,bgcskl,histall,iobinary restart gx3 14x2 gx3ncarbulk,isotope,histall,iobinary,precision8 @@ -18,6 +19,7 @@ restart gx3 15x2 alt02,histall,ionetcdf restart gx3 24x1 alt03,histall,ionetcdf,precision8 restart gx3 8x4 alt04,histall,ionetcdf,cdf64 restart gx3 8x4 alt05,histall,ionetcdf,precision8,cdf64 +restart gx3 16x2 alt06,histall,ionetcdf restart gx3 30x1 bgcz,histall,ionetcdf restart gx3 15x2 bgcskl,histall,ionetcdf,precision8 restart gx3 31x1 isotope,histall,ionetcdf,cdf64 @@ -29,6 +31,7 @@ restart gx3 32x1 alt02,histall,iopio1,precision8 restart gx3 24x1 alt03,histall,iopio1 restart gx3 8x4 alt04,histall,iopio1,precision8,cdf64 restart gx3 8x4 alt05,histall,iopio1,cdf64 +restart gx3 32x1 alt06,histall,iopio1,precision8 restart gx3 16x2 bgcz,histall,iopio1,precision8 restart gx3 30x1 bgcskl,histall,iopio1 restart gx3 8x4 isotope,histall,iopio1,precision8,cdf64 @@ -40,6 +43,7 @@ restart gx3 32x1 alt02,histall,iopio2,cdf64 restart gx3 24x1 alt03,histall,iopio2,precision8 restart gx3 8x4 alt04,histall,iopio2 restart gx3 8x4 alt05,histall,iopio2,precision8,cdf64 +restart gx3 16x2 alt06,histall,iopio2,cdf64 restart gx3 16x2 bgcz,histall,iopio2,cdf64 restart gx3 30x1 bgcskl,histall,iopio2,precision8 restart gx3 8x4 isotope,histall,iopio2 @@ -51,6 +55,7 @@ restart gx3 32x1 alt02,histall,iopio1p,precision8,cdf64 restart gx3 24x1 alt03,histall,iopio1p,cdf64 restart gx3 8x4 alt04,histall,iopio1p,precision8 restart gx3 8x4 alt05,histall,iopio1p +restart gx3 6x4 alt06,histall,iopio1p,precision8,cdf64 restart gx3 16x2 bgcz,histall,iopio1p,precision8,cdf64 restart gx3 30x1 bgcskl,histall,iopio1p,cdf64 restart gx3 8x4 isotope,histall,iopio1p,precision8 @@ -62,6 +67,7 @@ restart gx3 32x1 alt02,histall,iopio2p restart gx3 24x1 alt03,histall,iopio2p,precision8,cdf64 restart gx3 8x4 alt04,histall,iopio2p,cdf64 restart gx3 8x4 alt05,histall,iopio2p,precision8 +restart gx3 24x1 alt06,histall,iopio2p restart gx3 16x2 bgcz,histall,iopio2p restart gx3 30x1 bgcskl,histall,iopio2p,precision8,cdf64 restart gx3 8x4 isotope,histall,iopio2p,cdf64 diff --git a/configuration/scripts/tests/lcov_modify_source.sh b/configuration/scripts/tests/lcov_modify_source.sh new file mode 100755 index 000000000..ceadca4f4 --- /dev/null +++ b/configuration/scripts/tests/lcov_modify_source.sh @@ -0,0 +1,44 @@ +#!/bin/bash + +filelist=`find cicecore icepack -type f -name "*.F90"` +LCOV_EXCL=" ! LCOV_EXCL_LINE" + +#echo $filelist + +for file in $filelist; do + + echo $file + ofile=${file}.orig + nfile=${file} + + mv ${file} ${file}.orig + + # line by line making sure each line has a trailing newline (-n) + # preserve whitespace (IFS) + # and include backslashes (-r) + IFS='' + contblock=0 + cat $ofile | while read -r line || [[ -n $line ]]; do + + if [[ $contblock == 1 ]]; then + # in a continuation block + if [[ $line =~ ^.*"&".*$ ]]; then + # found another continuation line, add exclude string and write out line + echo ${line} ${LCOV_EXCL} >> ${nfile} + else + # continuation block ends, write out line + contblock=0 + echo ${line} >> ${nfile} + fi + else + # not in a continuation block, write out line + echo ${line} >> ${nfile} + if [[ $line =~ ^\s*.*"&".*$ && ! $line =~ ^\s*( if ).*$ ]]; then + # new continuation block found + contblock=1 + fi + fi + + done + +done diff --git a/configuration/scripts/tests/nothread_suite.ts b/configuration/scripts/tests/nothread_suite.ts index afe1963b3..da1267e86 100644 --- a/configuration/scripts/tests/nothread_suite.ts +++ b/configuration/scripts/tests/nothread_suite.ts @@ -21,11 +21,13 @@ restart gx3 16x1 alt02 restart gx3 8x1 alt03 restart gx3 16x1 alt04 restart gx3 16x1 alt05 +restart gx3 20x1 alt06 restart gx3 18x1 alt01,debug,short restart gx3 20x1 alt02,debug,short restart gx3 24x1 alt03,debug,short smoke gx3 24x1 alt04,debug,short smoke gx3 32x1 alt05,debug,short +smoke gx3 16x1 alt06,debug,short restart gx3 16x1 isotope smoke gx3 6x1 isotope,debug smoke gx3 8x1 fsd1,diag24,run5day,debug @@ -34,8 +36,8 @@ restart gx3 12x1 fsd12,debug,short smoke gx3 20x1 fsd12ww3,diag24,run1day,medium restart gbox128 8x1 short -restart gbox128 16x1 boxdyn,short -restart gbox128 24x1 boxdyn,short,debug +restart gbox128 16x1 boxnodyn,short +restart gbox128 24x1 boxnodyn,short,debug restart gbox128 12x1 boxadv,short smoke gbox128 20x1 boxadv,short,debug restart gbox128 32x1 boxrestore,short diff --git a/configuration/scripts/tests/quick_suite.ts b/configuration/scripts/tests/quick_suite.ts index 9384f0333..48646673d 100644 --- a/configuration/scripts/tests/quick_suite.ts +++ b/configuration/scripts/tests/quick_suite.ts @@ -2,5 +2,5 @@ smoke gx3 8x2 diag1,run5day smoke gx3 1x1 diag1,run1day restart gbox128 8x1 diag1 -restart gx3 4x2 debug,diag1,run5day +restart gx3 4x2 debug,diag1 smoke gx3 4x1 diag1,run5day,thread smoke_gx3_8x2_diag1_run5day diff --git a/configuration/scripts/tests/report_results.csh b/configuration/scripts/tests/report_results.csh index 2eb3731d5..e1f3a7342 100755 --- a/configuration/scripts/tests/report_results.csh +++ b/configuration/scripts/tests/report_results.csh @@ -82,11 +82,11 @@ if ("${shrepo}" !~ "*cice-consortium*") then endif set noglob -set green = "\![#00C000](https://placehold.it/15/00C000/000000?text=+)" -set red = "\![#F00000](https://placehold.it/15/F00000/000000?text=+)" -set orange = "\![#FFA500](https://placehold.it/15/FFA500/000000?text=+)" -set yellow = "\![#FFE600](https://placehold.it/15/FFE600/000000?text=+)" -set gray = "\![#AAAAAA](https://placehold.it/15/AAAAAA/000000?text=+)" +set green = "\![#00C000](images/00C000.png)" +set red = "\![#F00000](images/F00000.png)" +set orange = "\![#FFA500](images/FFA500.png)" +set yellow = "\![#FFE600](images/FFE600.png)" +set gray = "\![#AAAAAA](images/AAAAAA.png)" unset noglob #============================================================== diff --git a/configuration/scripts/tests/test_unittest.script b/configuration/scripts/tests/test_unittest.script new file mode 100644 index 000000000..0fcd148a6 --- /dev/null +++ b/configuration/scripts/tests/test_unittest.script @@ -0,0 +1,24 @@ + +#---------------------------------------------------- +# Run the CICE model +# cice.run returns -1 if run did not complete successfully + +./cice.run +set res="$status" + +set log_file = `ls -t1 ${ICE_RUNDIR}/cice.runlog* | head -1` + +mv -f ${ICE_CASEDIR}/test_output ${ICE_CASEDIR}/test_output.prev +cat ${ICE_CASEDIR}/test_output.prev | grep -iv "${ICE_TESTNAME} run" >! ${ICE_CASEDIR}/test_output +mv -f ${ICE_CASEDIR}/test_output ${ICE_CASEDIR}/test_output.prev +cat ${ICE_CASEDIR}/test_output.prev | grep -iv "${ICE_TESTNAME} test" >! ${ICE_CASEDIR}/test_output +rm -f ${ICE_CASEDIR}/test_output.prev + +set grade = FAIL +if ( $res == 0 ) then + set grade = PASS +endif + +echo "$grade ${ICE_TESTNAME} run " >> ${ICE_CASEDIR}/test_output +echo "$grade ${ICE_TESTNAME} test " >> ${ICE_CASEDIR}/test_output + diff --git a/configuration/scripts/tests/unittest_suite.ts b/configuration/scripts/tests/unittest_suite.ts new file mode 100644 index 000000000..2e9dcc7cf --- /dev/null +++ b/configuration/scripts/tests/unittest_suite.ts @@ -0,0 +1,4 @@ +# Test Grid PEs Sets BFB-compare +unittest gx3 1x1 helloworld +unittest gx3 1x1 calchk + diff --git a/configuration/tools/convert_restarts.f90 b/configuration/tools/cice4_restart_conversion/convert_restarts.f90 similarity index 100% rename from configuration/tools/convert_restarts.f90 rename to configuration/tools/cice4_restart_conversion/convert_restarts.f90 diff --git a/configuration/tools/jra55_datasets/interp_jra55_ncdf_bilinear.py b/configuration/tools/jra55_datasets/interp_jra55_ncdf_bilinear.py new file mode 100755 index 000000000..6cc796481 --- /dev/null +++ b/configuration/tools/jra55_datasets/interp_jra55_ncdf_bilinear.py @@ -0,0 +1,441 @@ +#! /usr/bin/env python3 + +import xesmf as xe +from netCDF4 import Dataset +import argparse +import os +import numpy as np +from datetime import datetime + +###################################################### +###################################################### +def make_regridder(lon1, lat1, lon2, lat2, method, periodic, grdname, + lon1_b=None, lat1_b=None, lon2_b=None, lat2_b=None): + ''' + make nearest neighbor xESMF regridder object. + input: + lon1: source longitudes (degrees) + lat1: source latitudes (degrees) + lon2: target longitudes (degrees) + lat2: target latitudes (degrees) + method: regridding method (bilinear, patch, conservative, nearest_s2d) + periodic: True if periodic longitudes, false if not + grdname: filename for regridder (Ugrid or Tgrid) + ''' + if method != "conservative": + # define grids for regridder + grid1 = {'lon' : lon1, 'lat' : lat1} + grid2 = {'lon' : lon2, 'lat' : lat2} + + + else: + # conservative needs boundary lon/lat + grid1 = {'lon' : lon1, 'lat' : lat1, + 'lon_b' : lon1_b, 'lat_b' : lat1_b} + + grid2 = {'lon' : lon2, 'lat' : lat2, + 'lon_b' : lon2_b, 'lat_b' : lat2_b} + + # make regridder + # here specify reuse_weights=False to re-generate weight file. + # if wanted to reuse file inteas of making int, + # check if file exists and change use_file_weights=True. + # see commented out example below + use_file_weights=False + + # check if regrid file exists. + # If so, reuse file instead of regenerating. + # if (os.path.isfile(blin_grid_name)): + # use_file_weights = True + + regridder = xe.Regridder(ds_in=grid1,ds_out=grid2, + method=method, + periodic=periodic, + filename=grdname, + reuse_weights=use_file_weights) + + + return regridder + +######################################### +######################################### +def halo_extrapolate(a,ew_bndy_type,ns_bndy_type): + ''' + Extrapolate to 'halo' cell as in CICE code + ice_boundary.F90:ice_HaloExtrapolate. + inputs: + a: array nx+1, ny+1 (nghost/nhalo hard-coded as 1 for now) + ew_bndy_type: east/west boundary type (cyclic, regional, etc) + ns_bndy_type: norh/south boundary type (cyclic, regional, etc) + + return: a with halo applied + ''' + + # get dimension of a + # expected to be 0:nx+nghost, 0:ny+nghost + nj, ni = a.shape # note with Python NetCDF is nj, ni order + # W/E edges + if ew_bndy_type == 'cyclic': + a[: ,0] = a[:,-2] # -2, since -1 is ghost cell + a[:,-1] = a[:, 1] # 1, since 0 is ghost cell + else: # if (trim(ew_bndy_type) /= 'cyclic') then + a[:, 0] = 2.0*a[:, 1] - a[:, 2] + a[:,-1] = 2.0*a[:,-2] - a[:,-3] + + # south edge + if ns_bndy_type == 'cyclic': + a[0,:] = a[-2,:] # -2, since -1 is ghost cell + else: + a[0,:] = 2.0*a[1,:] - a[2,:] + + # north edge treated a little different, depending + # on if bndy type is tripole + if ns_bndy_type == 'cyclic': + a[-1,:] = a[1,:] # 1, since 0 is ghost cell + + elif (ns_bndy_type != 'cyclic' and + ns_bndy_type != 'tripole' and + ns_bndy_type != 'tripoleT'): + + a[-1,:] = 2.0*a[-2,:] - a[-3,:] + + else: + pass # do nothing + + # return array with halo upated + return a + +######################################### +######################################### + +def Tlatlon(ulat,ulon,ew_bndy_type,ns_bndy_type): + ''' + Make TLAT/TLON from ULAT/ULON. + see ice_grid.F90:Tlatlon for method + Inputs: + ulat: U grid latitude in degrees + ulon: U grid longitude in degrees + + output: + tlat in degrees + tlon in degrees + ''' + + # method obtained from ice_grid.F90: subroutine Tlatlon + ulatcos = np.cos(np.deg2rad(ulat)) + ulatsin = np.sin(np.deg2rad(ulat)) + + uloncos = np.cos(np.deg2rad(ulon)) + ulonsin = np.sin(np.deg2rad(ulon)) + + # initialize array with nghost=1 on each side + nj, ni = ulatcos.shape # note: Python NetCDF is nj, ni order + print("Tlatlon nj, ni", nj, ni) + + nghost = 1 + workdims = (nj+2*nghost,ni+2*nghost) + #print("Tlatlon workdims", workdims) + + ulatcos1 = np.zeros(workdims,dtype='f8') + ulatsin1 = np.zeros(workdims,dtype='f8') + uloncos1 = np.zeros(workdims,dtype='f8') + ulonsin1 = np.zeros(workdims,dtype='f8') + + # fill middle of work arrays + ulatcos1[1:nj+1,1:ni+1] = ulatcos + ulatsin1[1:nj+1,1:ni+1] = ulatsin + + # fill middle of work arrays + ulatcos1[1:nj+1,1:ni+1] = ulatcos + ulatsin1[1:nj+1,1:ni+1] = ulatsin + + uloncos1[1:nj+1,1:ni+1] = uloncos + ulonsin1[1:nj+1,1:ni+1] = ulonsin + + # fill halos + ulatcos1 = halo_extrapolate(ulatcos1,ew_bndy_type,ns_bndy_type) + ulatsin1 = halo_extrapolate(ulatsin1,ew_bndy_type,ns_bndy_type) + uloncos1 = halo_extrapolate(uloncos1,ew_bndy_type,ns_bndy_type) + ulonsin1 = halo_extrapolate(ulonsin1,ew_bndy_type,ns_bndy_type) + + # now do computations as in ice_grid.F90:Tlatlon + + # x, y, z are full 2d + x = uloncos1 * ulatcos1 + y = ulonsin1 * ulatcos1 + z = ulatsin1 + + tx = 0.25*(x[0:nj, 0:ni ] + # x1 + x[0:nj, 1:ni+1] + # x2 + x[1:nj+1,0:ni ] + # x3 + x[1:nj+1,1:ni+1]) # x4 + + #print("Tlonlat: x.shape", x.shape) + #print("Tlonlat: tx.shape", tx.shape) + + + ty = 0.25*(y[0:nj, 0:ni ] + # y1 + y[0:nj, 1:ni+1] + # y2 + y[1:nj+1,0:ni ] + # y3 + y[1:nj+1,1:ni+1]) # y4 + + + tz = 0.25*(z[0:nj, 0:ni ] + # z1 + z[0:nj, 1:ni+1] + # z2 + z[1:nj+1,0:ni ] + # z3 + z[1:nj+1,1:ni+1]) # z4 + + da = np.sqrt(tx*tx + ty*ty + tz*tz) + + tz = tz/da + + tlon = np.arctan2(ty,tx) + tlat = np.arcsin(tz) + + # returnd tlat, tlon in degrees + return np.rad2deg(tlat), np.rad2deg(tlon) + +########################## +########################## + +def get_command_line_args(): + ''' + argument parser for command line arguments + ''' + + dstr = "Interplate JRA55 data" + parser = argparse.ArgumentParser(description=dstr) + + # add arguments + parser.add_argument("JRADTG", type=str, help="JRA55 file date time group") + parser.add_argument("dstgrid", type=str, help="Destination grid file (NetCDF)") + parser.add_argument("ncout", type=str, help="Output file name (NetCDF)") + + + # get the arguments + args = parser.parse_args() + + # return values + return args.JRADTG, args.dstgrid, args.ncout + + +################################ +################################ + +def get_jra55_nc_dict(): + ''' + Create dictionary that links the NetCDF variable name + with the file prefix. The file prefix is appended by + JRADTG from command line + ''' + # specify dictionary with dataset prefix names + jra55dict = {"TPRAT_GDS4_SFC_ave3h" : "fcst_phy2m.061_tprat.reg_tl319", # precip + "DSWRF_GDS4_SFC_ave3h" : "fcst_phy2m.204_dswrf.reg_tl319", # downward shortwave + "DLWRF_GDS4_SFC_ave3h" : "fcst_phy2m.205_dlwrf.reg_tl319", # downward longwave + "TMP_GDS4_HTGL" : "fcst_surf.011_tmp.reg_tl319" , # air temp + "UGRD_GDS4_HTGL" : "fcst_surf.033_ugrd.reg_tl319" , # u velocity + "VGRD_GDS4_HTGL" : "fcst_surf.034_vgrd.reg_tl319" , # v velocity + "SPFH_GDS4_HTGL" : "fcst_surf.051_spfh.reg_tl319"} # specify humidity + + + return jra55dict + +################################ +################################ + +def get_jra55_cice_var(): + ''' + Make dictionary relating JRA55 NetCDF variables + to CICE variables. + ''' + + # specify output variable names + # This is for current CICE expected names + # it might be better to change CICE in long run + cice_var = {"TPRAT_GDS4_SFC_ave3h" : "ttlpcp", + "DSWRF_GDS4_SFC_ave3h" : "glbrad", + "DLWRF_GDS4_SFC_ave3h" : "dlwsfc", + "TMP_GDS4_HTGL" : "airtmp", + "UGRD_GDS4_HTGL" : "wndewd", + "VGRD_GDS4_HTGL" : "wndnwd", + "SPFH_GDS4_HTGL" : "spchmd"} + + return cice_var + +################################ +################################ + +def init_ncout(ncout,nc1,llat,llon): + + ''' + Initialize output NetCDF file + with proper units and dimensions. + ''' + + dsout = Dataset(ncout,'w',format='NETCDF3_64BIT_OFFSET') + + # get dimensions from size of lat + (nlat,nlon) = llat.shape + + # create dimensions + time = dsout.createDimension('time',None) # unlimited + dim_j = dsout.createDimension('dim_j',nlat) + dim_i = dsout.createDimension('dim_i',nlon) + + # create time variable. + # note is defined as 'times' (with and s) to not conflict + # with dimension 'time' + times = dsout.createVariable('time','f8',('time',)) + times.units = nc1['initial_time0_hours'].units + times.calendar = 'gregorian' + + # loop over nc1 times + dates = [] + dates.append(nc1['initial_time0_hours'][0] + nc1['forecast_time1'][1]) + # loop over remaining + for h in nc1['initial_time0_hours'][1:-1]: + for ft in nc1['forecast_time1'][:]: + dates.append(h + ft) + + # include only first forecast_time of last initial time + dates.append(nc1['initial_time0_hours'][-1] + nc1['forecast_time1'][0]) + + # write dates to file + times[:] = dates + + # create LON/LAT variables + LON = dsout.createVariable('LON','f8',('dim_j','dim_i',)) + LON.units = 'degrees_east' + + LAT = dsout.createVariable('LAT','f8',('dim_j','dim_i',)) + LAT.units = 'degrees_north' + + # write LON, LAT to file + LON[:] = llon[:,:] + LAT[:] = llat[:,:] + + + return dsout + +################################ +################################ + + +# main subroutine +if __name__ == "__main__": + + # get jra dtg and ncout from command line + JRADTG, dstgrid, ncout = get_command_line_args() + + # get jra55 variable/filename prefix dictionary + jra55dict = get_jra55_nc_dict() + + # get dictionary linking jra55 variables names + # and CICE forcing varible names + cice_var = get_jra55_cice_var() + + # read input grid. + # use one of the jra55 files. + # it is assumed all JRA data are the same grid for later + fname = f"{jra55dict['TMP_GDS4_HTGL']:s}.{JRADTG:s}.nc" + print("opening dataset ", fname) + grid1_ds = Dataset(fname,'r',format='NETCDF3_64BIT_OFFSET') + lon1 = grid1_ds['g4_lon_3'][:] # 1D + lat1 = grid1_ds['g4_lat_2'][:] # 1D + + # open destination grid + # here it is assumed a CICE NetCDF file. + # the user can update as appropriate + print("Opening ", dstgrid) + grid2_ds = Dataset(dstgrid,'r',format='NETCDF3_64BIT_OFFSET') + ulon2 = grid2_ds["lon"][:,:] # 2D. Assumed ULON in degrees + ulat2 = grid2_ds["lat"][:,:] # 2D. Assumed ULAT in degrees + if np.max(np.abs(ulat2)) < 10. : + ulon2 = np.rad2deg(ulon2) + ulat2 = np.rad2deg(ulat2) + + # make tgrid from ugrid + ew_bndy_type = 'cyclic' + ns_bndy_type = 'open' + tlat2, tlon2 = Tlatlon(ulat2,ulon2,ew_bndy_type,ns_bndy_type) + + # make regridders + print("making bilinear regridder") + method = 'bilinear' + periodic = True + blin_grid_name = 'bilinear_jra55_gx3.nc' + rgrd_bilinear = make_regridder(lon1,lat1,tlon2,tlat2, + method,periodic,blin_grid_name) + + # setup output dataset by adding lat/lon + dsout = init_ncout(ncout,grid1_ds,tlat2,tlon2) + + # no longer need grid1, grid2 + grid1_ds.close() + grid2_ds.close() + + # do the regridding + # Loop over all the files using regridder from above + # and add to dataout + for var, fprefix in jra55dict.items(): + fname = f"{fprefix:s}.{JRADTG:s}.nc" + print("reading ", fname) + jra_ds = Dataset(fname,'r',format='NETCDF3_CLASSIC') + + # make output variable + data = dsout.createVariable(cice_var[var],'f4',('time','dim_j','dim_i')) + + # do interpolation + print("Interpolating ", var) + + if var.find('ave3h') > 0: # ave3r in var + # use bilinear here + d = rgrd_bilinear(jra_ds[var][:,:,:,:]) + + # write to file in correct time order + for t in range(d.shape[0]): + for n in range(d.shape[1]): + #print('indx (2*t)+n = ', (2*t)+n) + data[(2*t)+n,:,:] = d[t,n,:,:] + + else: + # instantaneous use bilinear + d = rgrd_bilinear(jra_ds[var][:,:,:,:]) + + # write to file in correct time order. + # note need to write 2nd forecast_time first. + # in this case first forecast_time is NaN + data[0,:,:] = d[0,1,:,:] + for t in range(1,d.shape[0]-1): + for n in range(d.shape[1]): + #print('indx (2*t)+n-1 = ', (2*t)+n-1) + data[(2*t)+n-1,:,:] = d[t,n,:,:] + + # write first forecast time of last initial time + # second forecast time is NAN + data[-1,:,:] = d[-1,0,:,:] + + # add coordinates attribute + data.coordinates = "LON LAT time" + data.long_name = jra_ds[var].long_name + data.units = jra_ds[var].units + + precip_factor = 1. / 86400. + + # Convert mm / day to kg/m^2/s. + if var.find('PRAT') > 0: + data[:] = data[:] * precip_factor + data.units = 'kg/m2/s' + else: + data.units = jra_ds[var].units + + # close jra55 file + jra_ds.close() + + + # write tou output file + # close output file + dsout.close() + + print("Done") + diff --git a/configuration/tools/jra55_datasets/make_forcing.csh b/configuration/tools/jra55_datasets/make_forcing.csh new file mode 100755 index 000000000..c57871a25 --- /dev/null +++ b/configuration/tools/jra55_datasets/make_forcing.csh @@ -0,0 +1,49 @@ +#!/bin/csh +# ----- +# This is a script that worked on NCAR's cheyenne in March, 2021. +# It converts raw JRA55 datasets to a format that CICE can use. +# This tools is documented in the CICE user guide. The +# tool interpolates to a CICE grid and does things like convert units. +# ----- +# The interp_jra55_ncdf_bilinar.py script was placed in "scripts_dir" +# The raw JRA55 datasets were placed in "jra55_data_dir" +# The CICE grid files were places in "jra55_data_dir" +# The model output was created in "output_data_dir" +# ----- +#PBS -N make_forcing +#PBS -q regular +#PBS -l select=1:ncpus=4:mpiprocs=4 +#PBS -l walltime=06:00:00 +#PBS -A P93300665 + +set scripts_dir = "/glade/work/tcraig/cice-consortium/cice.jra55_tool/configuration/tools/jra55_datasets" +set jra55_data_dir = "/glade/scratch/dbailey/JRA_DATA/" +set output_data_dir = "/glade/scratch/tcraig/JRA_DATA_output" +set grid = "gx3" +set cice_grid_file = "grid_gx3.nc" + +module load python/3.7.9 +source /glade/u/apps/opt/ncar_pylib/ncar_pylib.csh default +module load nco + +mkdir -p ${output_data_dir} +cd ${output_data_dir} + +ln -s ${jra55_data_dir}/fcst_*.nc . +ln -s ${jra55_data_dir}/grid_*.nc . + +ln -s ${scripts_dir}/interp_jra55_ncdf_bilinear.py . + +#foreach year ( 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 ) +foreach year ( 1997 ) + +./interp_jra55_ncdf_bilinear.py ${year}010100_${year}033121 ${cice_grid_file} JRA55_${grid}_03hr_forcing_${year}-q1.nc +./interp_jra55_ncdf_bilinear.py ${year}040100_${year}063021 ${cice_grid_file} JRA55_${grid}_03hr_forcing_${year}-q2.nc +./interp_jra55_ncdf_bilinear.py ${year}070100_${year}093021 ${cice_grid_file} JRA55_${grid}_03hr_forcing_${year}-q3.nc +./interp_jra55_ncdf_bilinear.py ${year}100100_${year}123121 ${cice_grid_file} JRA55_${grid}_03hr_forcing_${year}-q4.nc + +ncrcat JRA55_${grid}_03hr_forcing_${year}-??.nc JRA55_${grid}_03hr_forcing_${year}.nc + +/bin/rm -f ${jra55_data_dir}/JRA55_${grid}_03hr_forcing_${year}-??.nc + +end diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index 59ddc4122..9e2868947 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -139,8 +139,10 @@ either Celsius or Kelvin units). "daymo", "number of days in one month", "" "daycal", "day number at end of month", "" "days_per_year", ":math:`\bullet` number of days in one year", "365" + "day_init", ":math:`\bullet` the initial day of the month", "" "dbl_kind", "definition of double precision", "selected_real_kind(13)" - "dbug", ":math:`\bullet` write extra diagnostics", ".false." + "debug_model", "Logical that controls extended model point debugging.", "" + "debug_model_step", "Initial timestep for output associated with debug_model.", "" "Delta", "function of strain rates (see Section :ref:`dynam`)", "1/s" "default_season", "Season from which initial values of forcing are set.", "winter" "denom1", "combination of constants for stress equation", "" @@ -229,6 +231,7 @@ either Celsius or Kelvin units). "flw", "incoming longwave radiation", "W/m\ :math:`^2`" "flwout", "outgoing longwave radiation", "W/m\ :math:`^2`" "fm", "Coriolis parameter * mass in U cell", "kg/s" + "forcing_diag", ":math:`\bullet` write extra diagnostics for forcing inputs", ".false." "formdrag", ":math:`\bullet` calculate form drag", "" "fpond", "fresh water flux to ponds", "kg/m\ :math:`^2`/s" "fr_resp", "bgc respiration fraction", "0.05" @@ -258,9 +261,9 @@ either Celsius or Kelvin units). "fswthru_idr", "near IR direct shortwave penetrating to ocean", "W/m\ :math:`^2`" "fswthru_idf", "near IR diffuse shortwave penetrating to ocean", "W/m\ :math:`^2`" "fswthru_ai", "grid-box-mean shortwave penetrating to ocean (fswthru)", "W/m\ :math:`^2`" - "fyear", "current data year", "" - "fyear_final", "last data year", "" - "fyear_init", ":math:`\bullet` initial data year", "" + "fyear", "current forcing data year", "" + "fyear_final", "last forcing data year", "" + "fyear_init", ":math:`\bullet` initial forcing data year", "" "**G**", "", "" "gravit", "gravitational acceleration", "9.80616 m/s\ :math:`^2`" "grid_file", ":math:`\bullet` input file for grid info", "" @@ -313,7 +316,7 @@ either Celsius or Kelvin units). "ice_stderr", "unit number for standard error output", "" "ice_ref_salinity", "reference salinity for ice–ocean exchanges", "4. ppt" "icells", "number of grid cells with specified property (for vectorization)", "" - "iceruf", "ice surface roughness", "5.\ :math:`\times`\ 10\ :math:`^{-4}` m" + "iceruf", ":math:`\bullet` ice surface roughness at atmosphere interface", "5.\ :math:`\times`\ 10\ :math:`^{-4}` m" "icetmask", "ice extent mask (T-cell)", "" "iceumask", "ice extent mask (U-cell)", "" "idate", "the date at the end of the current time step (yyyymmdd)", "" @@ -378,18 +381,21 @@ either Celsius or Kelvin units). "max_blocks", "maximum number of blocks per processor", "" "max_ntrcr", "maximum number of tracers available", "5" "maxraft", "maximum thickness of ice that rafts", "1. m" - "mday", "day of the month", "" + "mday", "model day of the month", "" "meltb", "basal ice melt", "m" "meltl", "lateral ice melt", "m" "melts", "snow melt", "m" "meltt", "top ice melt", "m" "min_salin", "threshold for brine pockets", "0.1 ppt" "mlt_onset", "day of year that surface melt begins", "" - "month", "the month number", "" + "mmonth", "model month number", "" "monthp", "previous month number", "" + "month_init", ":math:`\bullet` the initial month", "" "mps_to_cmpdy", "m per s to cm per day conversion", "8.64\ :math:`\times`\ 10\ :math:`^6`" + "msec", "model seconds elasped into day", "" "mtask", "local processor number that writes debugging data", "" "mu_rdg", ":math:`\bullet` e-folding scale of ridged ice", "" + "myear", "model year", "" "my_task", "task ID for the current processor", "" "**N**", "", "" "n_aero", "number of aerosol species", "" @@ -416,7 +422,8 @@ either Celsius or Kelvin units). "nlt_bgc_[chem]", "ocean sources and sinks for biogeochemistry", "" "nml_filename", "namelist file name", "" "nprocs", ":math:`\bullet` total number of processors", "" - "npt", ":math:`\bullet` total number of time steps (dt)", "" + "npt", ":math:`\bullet` total run length values associate with npt_unit", "" + "npt_unit", "units of the run length, number set by npt", "" "ns_boundary_type", ":math:`\bullet` type of north-south boundary condition", "" "nslyr", "number of snow layers in each category", "" "nspint", "number of solar spectral intervals", "" @@ -443,7 +450,6 @@ either Celsius or Kelvin units). "nvarz", "number of category, vertical grid fields written to history", "" "nx(y)_block", "total number of gridpoints on block in x(y) direction", "" "nx(y)_global", "number of physical gridpoints in x(y) direction, global domain", "" - "nyr", "year number", "" "**O**", "", "" "ocean_bio", "concentrations of bgc constituents in the ocean", "" "oceanmixed_file", ":math:`\bullet` data file containing ocean forcing data", "" @@ -555,8 +561,8 @@ either Celsius or Kelvin units). "scale_factor", "scaling factor for shortwave radiation components", "" "seabed_stress", "if true, calculate seabed stress", "F" "seabed_stress_method", "method for calculating seabed stress (‘LKD’ or ‘probabilistic’)", "LKD" - "sec", "seconds elasped into idate", "" "secday", "number of seconds in a day", "86400." + "sec_init", ":math:`\bullet` the initial second", "" "shcoef", "transfer coefficient for sensible heat", "" "shear", "strain rate II component", "1/s" "shlat", "southern latitude of artificial mask edge", "30\ :math:`^\circ`\ N" @@ -596,12 +602,11 @@ either Celsius or Kelvin units). "tarear", "1/tarea", "1/m\ :math:`^2`" "tareas", "area of southern hemisphere T-cells", "m\ :math:`^2`" "tcstr", "string identifying T grid for history variables", "" - "tday", "absolute day number", "" "Tf", "freezing temperature", "C" "Tffresh", "freezing temp of fresh ice", "273.15 K" "tfrz_option", ":math:`\bullet` form of ocean freezing temperature", "" "thinS", "minimum ice thickness for brine tracer", "" - "time", "total elapsed time", "s" + "timesecs", "total elapsed time in seconds", "s" "time_beg", "beginning time for history averages", "" "time_bounds", "beginning and ending time for history averages", "" "time_end", "ending time for history averages", "" @@ -681,7 +686,7 @@ either Celsius or Kelvin units). "**X**", "", "" "**Y**", "", "" "ycycle", ":math:`\bullet` number of years in forcing data cycle", "" - "yday", "day of the year", "" + "yday", "day of the year, computed in the model calendar", "" "yield_curve", "type of yield curve", "ellipse" "yieldstress11(12, 22)", "yield stress tensor components", "" "year_init", ":math:`\bullet` the initial year", "" diff --git a/doc/source/conf.py b/doc/source/conf.py index e876980ab..4cf2f580d 100644 --- a/doc/source/conf.py +++ b/doc/source/conf.py @@ -62,9 +62,9 @@ # built documents. # # The short X.Y version. -version = u'6.1.4' +version = u'6.2.0' # The full version, including alpha/beta/rc tags. -version = u'6.1.4' +version = u'6.2.0' # The language for content autogenerated by Sphinx. Refer to documentation # for a list of supported languages. diff --git a/doc/source/developer_guide/dg_dynamics.rst b/doc/source/developer_guide/dg_dynamics.rst index c94d47b35..47b54bde2 100644 --- a/doc/source/developer_guide/dg_dynamics.rst +++ b/doc/source/developer_guide/dg_dynamics.rst @@ -90,12 +90,9 @@ Time Manager Time manager data is module data in **cicecore/shared/ice_calendar.F90**. Much of the time manager data is public and operated on during the model timestepping. The model timestepping actually takes -place in the **CICE_RunMod.F90** file which is part of the driver code and tends to look like this:: +place in the **CICE_RunMod.F90** file which is part of the driver code. - call ice_step - istep = istep + 1 ! update time step counters - istep1 = istep1 + 1 - time = time + dt ! determine the time and date +The time manager was updated in early 2021. Additional information about the time manager can be found here, :ref:`timemanagerplus` diff --git a/doc/source/developer_guide/dg_forcing.rst b/doc/source/developer_guide/dg_forcing.rst index 90ef843b0..0c0380538 100644 --- a/doc/source/developer_guide/dg_forcing.rst +++ b/doc/source/developer_guide/dg_forcing.rst @@ -120,8 +120,8 @@ Time interpolation coefficients are computed in the **JRA55_data** subroutine. The forcing data is converted to model inputs in the subroutine **prepare_forcing** called in **get_forcing_atmo**. To clarify, the JRA55 input data includes -- uatm = model grid i-direction wind velocity component (m/s) -- vatm = model grid j-direction wind velocity component (m/s) +- uatm = T-cell centered, model grid i-direction wind velocity component (m/s) +- vatm = T-cell-centered, model grid j-direction wind velocity component (m/s) - Tair = air temperature (K) - Qa = specific humidity (kg/kg) - flw = incoming longwave radiation (W/m^2) diff --git a/doc/source/developer_guide/dg_scripts.rst b/doc/source/developer_guide/dg_scripts.rst index da5ef7d24..50853b3ea 100644 --- a/doc/source/developer_guide/dg_scripts.rst +++ b/doc/source/developer_guide/dg_scripts.rst @@ -161,25 +161,25 @@ To add a new test (for example newtest), several files may be needed, Generating a new test, particularly the **test_newtest.script** usually takes some iteration before it's working properly. -.. _dev_compliance: +.. _dev_validation: -Code Compliance Script +Code Validation Script ---------------------- -The code compliance test validates non bit-for-bit model changes. The directory -**configuration/scripts/tests/QC** contains scripts related to the compliance testing, -and this process is described in :ref:`compliance`. This section will describe a set -of scripts that test and validate the code compliance process. This should be done -when the compliance test or compliance test scripts (i.e., ``cice.t-test.py``) are modified. -Again, this section **documents a validation process for the compliance scripts**; it does not -describe to how run the compliance test itself. +The code validation (aka QC or quality control) test validates non bit-for-bit model changes. The directory +**configuration/scripts/tests/QC** contains scripts related to the validation testing, +and this process is described in :ref:`validation`. This section will describe a set +of scripts that test and validate the QC process. This should be done +when the QC test or QC test scripts (i.e., ``cice.t-test.py``) are modified. +Again, this section **documents a validation process for the QC scripts**; it does not +describe to how run the validation test itself. -Two scripts have been created to automatically validate the code compliance script. +Two scripts have been created to automatically validate the QC script. These scripts are: * ``gen_qc_cases.csh``, which creates the 4 test cases required for validation, builds the executable, and submits to the queue. -* ``compare_qc_cases.csh``, which runs the code compliance script on three combinations +* ``compare_qc_cases.csh``, which runs the QC script on three combinations of the 4 test cases and outputs whether or not the correct response was received. The ``gen_qc_cases.csh`` script allows users to pass some arguments similar @@ -216,7 +216,7 @@ To install the necessary Python packages, the ``pip`` Python utility can be used check to see if there is any Python module (``module avail python``) that you might need to load prior to using ``pip``. -To perform the validation, execute the following commands. +To perform the QC validation, execute the following commands. .. code-block:: bash diff --git a/doc/source/developer_guide/dg_tools.rst b/doc/source/developer_guide/dg_tools.rst new file mode 100644 index 000000000..ba29e0184 --- /dev/null +++ b/doc/source/developer_guide/dg_tools.rst @@ -0,0 +1,150 @@ +:tocdepth: 3 + +.. _tools: + +Tools +============= + + +.. _cice4restart: + +CICE4 restart conversion +------------------------- + +There is a Fortran program in **configuration/tools/cice4_restart_conversion** +that will help convert a CICE4 restart file into a CICE5 restart file. +There is a bit of documentation contained in that source code about how +to build, use, and run the tool. A few prognostic variables were changed +from CICE4 to CICE5 which fundamentally altered the fields saved to +the restart file. See +**configuration/tools/cice4_restart_conversion/convert_restarts.f90** +for additional information. + + +.. _jra55datasettool: + +JRA55 forcing datasets +------------------------ + +This section describes how to generate JRA55 forcing data for the CICE model. +Raw JRA55 files have to be interpolated and processed into input files specifically +for the CICE model. A tool exists in **configuration/tools/jra55_datasets** +to support that process. +The raw JRA55 data is obtained from the NCAR/UCAR Research Data Archive and +the conversion tools are written in python. + +Requirements +********************* + +Python3 is required, and the following +python packages are required with the tested version number in parenthesis. These +versions are not necessarily the only versions that work, they just indicate what +versions were used when the script was recently run. + +- python3 (python3.7.9) +- numpy (1.18.5) +- netCDF4 (1.5.5) +- ESMPy (8.0.0) +- xesmf (0.3.0) + +NCO is required for aggregating the output files into yearly files. + +- netcdf (4.7.4) +- nco (4.9.5) + +Raw JRA55 forcing data +************************* + +The raw JRA55 forcing data is obtained from the UCAR/NCAR Research Data Archive, +https://rda.ucar.edu/. You must first register (free) and then sign in. The +"JRA-55 Reanalysis Daily 3-Hourly and 6-Hourly Data" is ds628.0 and can be found here, +https://rda.ucar.edu/datasets/ds628.0. + +The "Data access" tabs will provide a list of product categories. +The JRA55 data of interest are located in 2 separate products. Winds, air +temperature, and specific humidity fields are included in "JRA-55 +3-Hourly Model Resolution 2-Dimensional Instantaneous Diagnostic Fields". +Precipitation and downward radiation fluxes are found in "JRA-55 3-Hourly +Model Resolution 2-Dimensional Average Diagnostic Fields". (Note the +difference between instantaneous and averaged data products. There are several +JRA55 datasets available, you will likely have to scroll down the page to find +these datasets.) Data are also available on a coarser 1.25° grid, but the tools +are best used with the native TL319 JRA55 grid. + +The fields needed for CICE are + +- specific humidity (3-hourly instantaneous), Qa +- temperature (3-hourly instantaneous), Tair +- u-component of wind (3-hourly instantaneous), uatm +- v-component of wind(3-hourly instantaneous), vatm +- downward longwave radiation flux (3 hourly average), flw +- downward solar radiation flux (3 hourly average), fsw +- total precipitation (3 hourly average), fsnow + +To customize the dataset for download, choose the “Get a Subset” option. Select +the desired times in the “Temporal Selection” section, then click on desired parameters +(see list above). After clicking continue, select Output Format "Converted to NetCDF". + +Once the data request is made, an email notification will be sent with a dedicated +URL that will provide a variety of options for downloading the data remotely. +The data will be available to download for 5 days. +The raw data consists of multiple files, each containing three months of data for +one field. + + +Data conversion +************************* + +The script, **configuration/tools/jra55_datasets/interp_jra55_ncdf_bilinear.py**, +converts the raw data to CICE input files. + +The script uses a bilinear regridding algorithm to regrid from the JRA55 grid to +the CICE grid. The scripts use the Python package ‘xesmf’ to generate bilinear +regridding weights, and these regridding weights are written to the file defined by +the variable "blin_grid_name" in **interp_jra55_ncdf_bilinear.py**. This filename +can be modified by editing **interp_jra55_ncdf_bilinear.py**. +The weights file can be re-used if interpolating different data on the same grid. +Although not tested in this version of the scripts, additional regridding options +are available by xesmf, including ‘conservative’ and ‘nearest neighbor’. These +methods have not been tested in the current version of the scripts. The reader +is referred to the xESMF web page for further documentation +(https://xesmf.readthedocs.io/en/latest/ last accessed 5 NOV 2020). + +To use the **interp_jra55_ncdf_bilinear** script, do :: + + python3 interp_jra55_ncdf_bilinear.py –h + +to see the latest interface information :: + + usage: interp_jra55_ncdf_bilinear.py [-h] JRADTG gridout ncout + + Interpolate JRA55 data to CICE grid + + positional arguments: + JRADTG JRA55 input file date time group + gridout CICE grid file (NetCDF) + ncout Output NetCDF filename + + optional arguments: + -h, --help show this help message and exit + +Sample usage is :: + + ./interp_jra55_ncdf_bilinear.py 1996010100_1996033121 grid_gx3.nc JRA55_gx3_03hr_forcing_1996-q1.nc + ./interp_jra55_ncdf_bilinear.py 1996040100_1996063021 grid_gx3.nc JRA55_gx3_03hr_forcing_1996-q2.nc + ./interp_jra55_ncdf_bilinear.py 1996070100_1996093021 grid_gx3.nc JRA55_gx3_03hr_forcing_1996-q3.nc + ./interp_jra55_ncdf_bilinear.py 1996100100_1996123121 grid_gx3.nc JRA55_gx3_03hr_forcing_1996-q4.nc + +In this case, the 4 quarters of 1996 JRA55 data is going to be interpolated to the gx3 grid. +NCO can be used to aggregate these files into a single file :: + + ncrcat JRA55_gx3_03hr_forcing_1996-??.nc JRA55_${grid}_03hr_forcing_1996.nc + +NOTES + +- The scripts are designed to read a CICE grid file in netCDF format. This is the "grid_gx3.nc" file above. The NetCDF grid names are hardcoded in **interp_jra55_ncdf_bilinear.py**. If you are using a different grid file with different variable names, this subroutine needs to be updated. +- All files should be placed in a common directory. This includes the raw JRA55 input files, the CICE grid file, and **interp_jra55_ncdf_bilinear.py**. The output files will be written to the same directory. +- The script **configuration/tools/jra55_datasets/make_forcing.csh** was used on the NCAR cheyenne machine in March, 2021 to generate CICE forcing data. It assumes the raw JRA55 is downloaded, but then sets up the python environment, links all the data in a common directory, runs **interp_jra55_ncdf_bilinear.py** and then aggregates the quarterly data using NCO. +- The new forcing files can then be defined in the **ice_in** namelist file using the input variables, ``atm_data_type``, ``atm_data_format``, ``atm_data_dir``, ``fyear_init``, and ``ycycle``. See :ref:`forcing` for more information. +- The total precipitation field is mm/day in JRA55. This field is initially read in as snow, but prepare_forcing in **ice_forcing.F90** splits that into rain or snow forcing depending on the air temperature. + diff --git a/doc/source/developer_guide/index.rst b/doc/source/developer_guide/index.rst index ab5b2d1e6..6fc3356f4 100644 --- a/doc/source/developer_guide/index.rst +++ b/doc/source/developer_guide/index.rst @@ -17,5 +17,6 @@ Developer Guide dg_forcing.rst dg_icepack.rst dg_scripts.rst + dg_tools.rst dg_other.rst diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index ccf7f0356..44ee6f5b0 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -78,6 +78,7 @@ can be modified as needed. "ICE_HSTDIR", "string", "unused", "${ICE_RUNDIR}/history" "ICE_LOGDIR", "string", "log directory", "${ICE_CASEDIR}/logs" "ICE_DRVOPT", "string", "unused", "standalone/cice" + "ICE_TARGET", "string", "build target", "set by cice.setup" "ICE_IOTYPE", "string", "I/O format", "set by cice.setup" " ", "netcdf", "serial netCDF" " ", "pio", "parallel netCDF" @@ -143,7 +144,9 @@ setup_nml "``conserv_check``", "logical", "check conservation", "``.false.``" "``cpl_bgc``", "logical", "couple bgc thru driver", "``.false.``" "``days_per_year``", "integer", "number of days in a model year", "365" - "``dbug``", "logical", "write extra diagnostics", "``.false.``" + "``day_init``", "integer", "the initial day of the month if not using restart", "1" + "``debug_model``", "logical", "write extended model point diagnostics", "``.false.``" + "``debug_model_step``", "logical", "initial timestep to write ``debug_model`` output", "999999999" "``diagfreq``", "integer", "frequency of diagnostic output in timesteps", "24" "``diag_type``", "``stdout``", "write diagnostic output to stdout", "``stdout``" "", "``file``", "write diagnostic output to file", "" @@ -156,6 +159,7 @@ setup_nml "", "``1``", "write restart every ``dumpfreq_n`` time step", "" "``dumpfreq_n``", "integer", "write restart frequency with ``dumpfreq``", "1" "``dump_last``", "logical", "write restart on last time step of simulation", "``.false.``" + "``forcing_diag``", "logical", "write extra diagnostics", "``.false.``" "``hist_avg``", "logical", "write time-averaged data", "``.true.``" "``histfreq``", "``d``", "write history every ``histfreq_n`` days", "'1','h','d','m','y'" "", "``h``", "write history every ``histfreq_n`` hours", "" @@ -178,8 +182,15 @@ setup_nml "``latpnt``", "real", "latitude of (2) diagnostic points", "90.0,-65.0" "``lcdf64``", "logical", "use 64-bit netcdf format", "``.false.``" "``lonpnt``", "real", "longitude of (2) diagnostic points", "0.0,-45.0" + "``month_init``", "integer", "the initial month if not using restart", "1" "``ndtd``", "integer", "number of dynamics/advection/ridging/steps per thermo timestep", "1" - "``npt``", "integer", "total number of time steps to take", "99999" + "``npt``", "integer", "total number of npt_units to run the model", "99999" + "``npt_unit``", "``d``", "run ``npt`` days", "1" + "", "``h``", "run ``npt`` hours", "" + "", "``m``", "run ``npt`` months", "" + "", "``s``", "run ``npt`` seconds", "" + "", "``y``", "run ``npt`` years", "" + "", "``1``", "run ``npt`` timesteps", "" "``numin``", "integer", "minimum internal IO unit number", "11" "``numax``", "integer", "maximum internal IO unit number", "99" "``pointer_file``", "string", "restart pointer filename", "'ice.restart_file'" @@ -194,6 +205,7 @@ setup_nml "``runid``", "string", "label for run (currently CESM only)", "'unknown'" "``runtype``", "``continue``", "restart using ``pointer_file``", "``initial``" "", "``initial``", "start from ``ice_ic``", "" + "``sec_init``", "integer", "the initial second if not using restart", "0" "``use_leap_years``", "logical", "include leap days", "``.false.``" "``use_restart_time``", "logical", "set initial date using restart file", "``.true.``" "``version_name``", "string", "model version", "'unknown_version_name'" @@ -212,6 +224,7 @@ grid_nml "``bathymetry_file``", "string", "name of bathymetry file to be read", "‘unknown_bathymetry_file’" "``bathymetry_format``", "``default``", "NetCDF depth field", "‘default’" "", "``pop``", "pop thickness file in cm in ascii format", "" + "``close_boundaries``", "logical", "force two gridcell wide land mask on boundaries", "``.false.`` "``dxrect``", "real", "x-direction grid spacing for rectangular grid in cm", "0.0" "``dyrect``", "real", "y-direction grid spacing for rectangular grid in cm", "0.0" "``gridcpl_file``", "string", "input file for coupling grid info", "'unknown_gridcpl_file'" @@ -248,6 +261,7 @@ domain_nml "``add_mpi_barriers``", "logical", "throttle communication", "``.false.``" "``block_size_x``", "integer", "block size in x direction", "-1" "``block_size_y``", "integer", "block size in y direction", "-1" + "``debug_blocks``", "logical", "add additional print statements to debug the block decomposition", "``.false.``" "``distribution_type``", "``cartesian``", "2D cartesian block distribution method", "``cartesian``" "", "``rake``", "redistribute blocks among neighbors", "" "", "``roundrobin``", "1 block per proc until blocks are used", "" @@ -355,6 +369,8 @@ dynamics_nml "", "", "", "" "``advection``", "``remap``", "linear remapping advection scheme", "``remap``" "", "``upwind``", "donor cell advection", "" + "``algo_nonlin``", "``anderson``", "use nonlinear anderson algorithm for implicit solver", "picard" + "", "``picard``", "use picard algorithm", "" "``alphab``", "real", ":math:`\alpha_{b}` factor in :cite:`Lemieux16`", "20.0" "``arlx``", "real", "revised_evp value", "300.0" "``brlx``", "real", "revised_evp value", "300.0" @@ -394,11 +410,11 @@ dynamics_nml "``monitor_pgmres``", "logical", "write velocity norm at each PGMRES iteration", "``.false.``" "``mu_rdg``", "real", "e-folding scale of ridged ice for ``krdg_partic`` = 1 in m^0.5", "3.0" "``ndte``", "integer", "number of EVP subcycles", "120" - "``ortho_type``", "``mgs``", "Use modified Gram-Shchmidt in FGMRES solver", "``mgs``" - "", "``cgs``", "Use classical Gram-Shchmidt in FGMRES solver", "" - "``precond``", "``pgmres``", "Use GMRES as preconditioner for FGMRES solver", "``pgmres``" - "", "``diag``", "Use Jacobi preconditioner for the FGMRES solver", "" + "``ortho_type``", "``cgs``", "Use classical Gram-Shchmidt in FGMRES solver", "``mgs``" + "", "``mgs``", "Use modified Gram-Shchmidt in FGMRES solver", "" + "``precond``", "``diag``", "Use Jacobi preconditioner for the FGMRES solver", "``pgmres``" "", "``ident``", "Don't use a preconditioner for the FGMRES solver", "" + "", "``pgmres``", "Use GMRES as preconditioner for FGMRES solver", "" "``Pstar``", "real", "constant in Hibler strength formula (N/m\ :math:`^2`)", "2.75e4" "``reltol_nonlin``", "real", "relative tolerance for nonlinear solver", "1e-8" "``reltol_fgmres``", "real", "relative tolerance for FGMRES solver", "1e-2" @@ -411,6 +427,7 @@ dynamics_nml "", "``geostropic``", "computed from ocean velocity", "" "``threshold_hw``", "real", "Max water depth for grounding (see :cite:`Amundrud04`)", "30." "``yield_curve``", "``ellipse``", "elliptical yield curve", "``ellipse``" + "``use_mean_vrel``", "logical", "Use mean of two previous iterations for vrel in VP", "``.true.``" "", "", "", "" shortwave_nml @@ -495,7 +512,7 @@ forcing_nml "``default_season``", "``summer``", "forcing initial summer values", "``winter``" "", "``winter``", "forcing initial winter values", "" "``emissivity``", "real", "emissivity of snow and ice", "0.985" - "``fbot_xfer_type``", "``Cdn_ocn``", "variabler ocean heat transfer coefficient scheme", "``constant``" + "``fbot_xfer_type``", "``Cdn_ocn``", "variable ocean heat transfer coefficient scheme", "``constant``" "", "``constant``", "constant ocean heat transfer coefficient", "" "``fe_data_type``", "``clim``", "ocean climatology forcing value for iron", "``default``" "", "``default``", "default forcing value for iron", "" @@ -505,6 +522,7 @@ forcing_nml "``ice_data_type``", "``boxslotcyl``", "initialize ice concentration and velocity for :ref:`boxslotcyl` test (:cite:`Zalesak79`)", "``default``" "", "``box2001``", "initialize ice concentration for :ref:`box2001` test (:cite:`Hunke01`)", "" "", "``default``", "no special initialization", "" + "``iceruf``", "real", "ice surface roughness at atmosphere interface", "0.0005" "``l_mpond_fresh``", "``.false.``", "release pond water immediately to ocean", "``.false.``" "", "``true``", "retain (topo) pond water until ponds drain", "" "``natmiter``", "integer", "number of atmo boundary layer iterations", "5" @@ -525,6 +543,7 @@ forcing_nml "``restart_coszen``", "logical", "read/write coszen in restart files", "``.false.``" "``restore_ocn``", "logical", "restore sst to data", "``.false.``" "``restore_ice``", "logical", "restore ice state along lateral boundaries", "``.false.``" + "``rotate_wind``", "logical", "rotate wind from east/north to computation grid", "``.true.``" "``tfrz_option``", "``linear_salt``", "linear functino of salinity (ktherm=1)", "``mushy``" "", "``minus1p8``", "constant ocean freezing temperature (:math:`-1.8^{\circ} C`)", "" "", "``mushy``", "matches mushy-layer thermo (ktherm=2)", "" diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index cbfe37b0c..566d10fbc 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -163,18 +163,19 @@ information to the log file, and if the block size or max blocks is inconsistent with the task and thread size, the model will abort. The code will also print a warning if the maximum number of blocks is too large. Although this is not fatal, it does use extra memory. If ``max_blocks`` is -set to -1, the code will compute a ``max_blocks`` on the fly. +set to -1, the code will compute a tentative ``max_blocks`` on the fly. A loop at the end of routine *create\_blocks* in module **ice\_blocks.F90** will print the locations for all of the blocks on -the global grid if dbug is set to be true. Likewise, a similar loop at +the global grid if the namelist variable ``debug_blocks`` is set to be true. Likewise, a similar loop at the end of routine *create\_local\_block\_ids* in module **ice\_distribution.F90** will print the processor and local block number for each block. With this information, the grid decomposition -into processors and blocks can be ascertained. The dbug flag must be -manually set in the code in each case (independently of the dbug flag in -**ice\_in**), as there may be hundreds or thousands of blocks to print -and this information should be needed only rarely. This information is +into processors and blocks can be ascertained. This ``debug_blocks`` variable +should be used carefully as there may be hundreds or thousands of blocks to print +and this information should be needed only rarely. ``debug_blocks`` +can be set to true using the +``debugblocks`` option with **cice.setup**. This information is much easier to look at using a debugger such as Totalview. There is also an output field that can be activated in `icefields\_nml`, ``f_blkmask``, that prints out the variable ``blkmask`` to the history file and @@ -268,8 +269,11 @@ routines, is adopted from POP. The boundary routines perform boundary communications among processors when MPI is in use and among blocks whenever there is more than one block per processor. -Open/cyclic boundary conditions are the default in CICE; the physical -domain can still be closed using the land mask. In our bipolar, +Open/cyclic boundary conditions are the default in CICE. Closed boundary +conditions are not supported currently. The physical +domain can still be closed using the land mask and this can be done in +namelist with the ``close_boundaries`` namelist which forces the mask +on the boundary to land for a two gridcell depth. In our bipolar, displaced-pole grids, one row of grid cells along the north and south boundaries is located on land, and along east/west domain boundaries not masked by land, periodic conditions wrap the domain around the globe. @@ -529,12 +533,72 @@ schemes and the aerosol tracers, and the level-ice pond parameterization additionally requires the level-ice tracers. +.. _timemanagerplus: + +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Time Manager and Initialization +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The time manager is an important piece of the CICE model. + +.. _timemanager: + +**************************** +Time Manager +**************************** + +The primary prognostic variables in the time manager are ``myear``, +``mmonth``, ``mday``, and ``msec``. These are integers and identify +the current model year, month, day, and second respectively. +The model timestep is ``dt`` with units of seconds. See :ref:`parameters` +for additional information about choosing an appropriate timestep. +The internal variables ``istep``, ``istep0``, and ``istep1`` keep +track of the number of timesteps. ``istep`` is the counter for +the current run and is set to 0 at the start of each run. ``istep0`` +is the step count at the start of a long multi-restart run, and +``istep1`` is the step count of a long multi-restart run. + +In general, the time manager should be advanced by calling +*advance\_timestep*. This subroutine in **ice\_calendar.F90** +automatically advances the model time by ``dt``. It also advances +the istep numbers and calls subroutine *calendar* to update +additional calendar data. + +The namelist variable ``use_restart_time`` specifies whether to +use the time and step numbers saved on a restart file or whether +to set the initial model time to the namelist values defined by +``year_init``, ``month_init``, ``day_init``, and ``sec_init``. +Normally, ``use_restart_time`` is set to false on the initial run +and then set to true on subsequent restart runs of the same +case to allow time to advance thereafter. More information about +the restart capability can be found here, :ref:`restartfiles`. + +The time manager was updated in early 2021. The standalone model +was modified, and some tests were done in a coupled framework after +modifications to the high level coupling interface. For some coupled models, the +coupling interface may need to be updated when updating CICE with the new time manager. +In particular, the old prognostic variable ``time`` no longer exists in CICE, +``year_init`` only defines the model initial year, and +the calendar subroutine is called without any arguments. One can +set the namelist variables ``year_init``, ``month_init``, ``day_init``, +``sec_init``, and ``dt`` in conjuction with ``days_per_year`` and +``use_leap_years`` to initialize the model date, timestep, and calendar. +To overwrite the default/namelist settings in the coupling layer, +set the **ice\_calendar.F90** variables ``myear``, ``mmonth``, ``mday``, +``msec`` and ``dt`` after the namelists have been read. Subroutine +*calendar* should then be called to update all the calendar data. +Finally, subroutine *advance\_timestep* should be used to advance +the model time manager. It advances the step numbers, advances +time by ``dt``, and updates the calendar data. The older method +of manually advancing the steps and adding ``dt`` to ``time`` should +be deprecated. + .. _init: -~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Initialization and coupling -~~~~~~~~~~~~~~~~~~~~~~~~~~~ +**************************** +Initialization and Restarts +**************************** The ice model’s parameters and variables are initialized in several steps. Many constants and physical parameters are set in @@ -612,9 +676,9 @@ reset to ‘none.’ .. _parameters: -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +********************************** Choosing an appropriate time step -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +********************************** The time step is chosen based on stability of the transport component (both horizontal and in thickness space) and on resolution of the @@ -705,6 +769,8 @@ the problem, and ``brlx`` represents the effective subcycling Model output ~~~~~~~~~~~~ +There are a number of model output streams and formats. + .. _history: ************* @@ -720,7 +786,8 @@ for history and restart files, and history and restart file must use the same io package. The namelist variable ``history_format`` further refines the format approach or style for some io packages. -Model output data is averaged over the period(s) given by ``histfreq`` and +Model output data can be written as instantaneous or average data as specified +by the ``hist_avg`` namelist flag. The data is written at the period(s) given by ``histfreq`` and ``histfreq_n``, and written to binary or netCDF files prepended by ``history_file`` in **ice_in**. These settings for history files are set in the **setup_nml** section of **ice_in** (see :ref:`tabnamelist`). @@ -759,20 +826,22 @@ is now a character string corresponding to ``histfreq`` or ‘x’ for none. files, no matter what the frequency is.) If there are no namelist flags with a given ``histfreq`` value, or if an element of ``histfreq_n`` is 0, then no file will be written at that frequency. The output period can be -discerned from the filenames. +discerned from the filenames. All history streams will be either instantaneous +or averaged as specified by the ``hist_avg`` namelist setting. For example, in the namelist: :: - ``histfreq`` = ’1’, ’h’, ’d’, ’m’, ’y’ - ``histfreq_n`` = 1, 6, 0, 1, 1 - ``f_hi`` = ’1’ - ``f_hs`` = ’h’ - ``f_Tsfc`` = ’d’ - ``f_aice`` = ’m’ - ``f_meltb`` = ’mh’ - ``f_iage`` = ’x’ + histfreq = ’1’, ’h’, ’d’, ’m’, ’y’ + histfreq_n = 1, 6, 0, 1, 1 + hist_avg = .true. + f_hi = ’1’ + f_hs = ’h’ + f_Tsfc = ’d’ + f_aice = ’m’ + f_meltb = ’mh’ + f_iage = ’x’ Here, ``hi`` will be written to a file on every timestep, ``hs`` will be written once every 6 hours, ``aice`` once a month, ``meltb`` once a month AND @@ -784,6 +853,14 @@ as long as for a single frequency. If you only want monthly output, the most efficient setting is ``histfreq`` = ’m’,’x’,’x’,’x’,’x’. The code counts the number of desired streams (``nstreams``) based on ``histfreq``. +There is no restart capability built into the history implementation. If the +model stops in the middle of a history accumulation period, that data is lost +on restart, and the accumulation is zeroed out at startup. That means the +dump frequency (see :ref:`restartfiles`) and history frequency need to be +somewhat coordinated. For +example, if monthly history files are requested, the dump frequency should be +set to an integer number of months. + The history variable names must be unique for netCDF, so in cases where a variable is written at more than one frequency, the variable name is appended with the frequency in files after the first one. In the example @@ -799,7 +876,7 @@ every 3 months, for example. If ``write_ic`` is set to true in **ice\_in**, a snapshot of the same set of history fields at the start of the run will be written to the history directory in **iceh\_ic.[timeID].nc(da)**. Several history variables are -hard-coded for instantaneous output regardless of the averaging flag, at +hard-coded for instantaneous output regardless of the ``hist_avg`` averaging flag, at the frequency given by their namelist flag. The normalized principal components of internal ice stress are computed @@ -908,6 +985,8 @@ The timers use *MPI\_WTIME* for parallel runs and the F90 intrinsic | 16 | BGC | biogeochemistry | +--------------+-------------+----------------------------------------------------+ +.. _restartfiles: + ************* Restart files ************* @@ -937,7 +1016,8 @@ Additional namelist flags provide further control of restart behavior. of a run when it is otherwise not scheduled to occur. The flag ``use_restart_time`` enables the user to choose to use the model date provided in the restart files. If ``use_restart_time`` = false then the -initial model date stamp is determined from the namelist parameters. +initial model date stamp is determined from the namelist parameters, +``year_init``, ``month_init``, ``day_init``, and ``sec_init``.. lcdf64 = true sets 64-bit netCDF output, allowing larger file sizes. Routines for gathering, scattering and (unformatted) reading and writing @@ -957,5 +1037,6 @@ initialized with no ice. The gx3 case was run for 1 year using the 1997 forcing data provided with the code. The gx1 case was run for 20 years, so that the date of restart in the file is 1978-01-01. Note that the restart dates provided in the restart files can be overridden using the -namelist variables ``use_restart_time``, ``year_init`` and ``istep0``. The +namelist variables ``use_restart_time``, ``year_init``, ``month_init``, +``day_init``, and ``sec_init``. The forcing time can also be overridden using ``fyear_init``. diff --git a/doc/source/user_guide/ug_running.rst b/doc/source/user_guide/ug_running.rst index 541fa81a4..aca7d4933 100644 --- a/doc/source/user_guide/ug_running.rst +++ b/doc/source/user_guide/ug_running.rst @@ -36,12 +36,19 @@ The Consortium has tested the following compilers at some point, - Intel 17.0.2.174 - Intel 17.0.5.239 - Intel 18.0.1.163 +- Intel 18.0.5 - Intel 19.0.2 - Intel 19.0.3.199 +- Intel 19.1.0.166 +- Intel 19.1.1.217 - PGI 16.10.0 +- PGI 19.9-0 +- PGI 20.1-0 - GNU 6.3.0 - GNU 7.2.0 - GNU 7.3.0 +- GNU 8.3.0 +- GNU 9.3.0 - Cray 8.5.8 - Cray 8.6.4 - NAG 6.2 @@ -54,22 +61,33 @@ The Consortium has tested the following mpi versions, - MPICH 7.6.3 - MPICH 7.7.6 - Intel MPI 18.0.1 +- Intel MPI 18.0.4 +- Intel MPI 2019 Update 6 - MPT 2.14 - MPT 2.17 - MPT 2.18 - MPT 2.19 +- MPT 2.20 +- MPT 2.21 +- mvapich2-2.3.3 - OpenMPI 1.6.5 +- OpenMPI 4.0.2 The NetCDF implementation is relatively general and should work with any version of NetCDF 3 or 4. The Consortium has tested - NetCDF 4.3.0 - NetCDF 4.3.2 - NetCDF 4.4.0 -- NetCDF 4.4.1.1.32 +- NetCDF 4.4.1.1.3 - NetCDF 4.4.1.1 - NetCDF 4.4.2 - NetCDF 4.5.0 +- NetCDF 4.5.2 - NetCDF 4.6.1.3 +- NetCDF 4.6.3 +- NetCDF 4.6.3.2 +- NetCDF 4.7.2 +- NetCDF 4.7.4 Please email the Consortium if this list can be extended. @@ -257,7 +275,7 @@ Some of the options are ``bgcISPOL`` and ``bgcNICE`` specify bgc options -``boxadv``, ``boxdyn``, and ``boxrestore`` are simple box configurations +``boxadv``, ``boxnodyn``, and ``boxrestore`` are simple box configurations ``alt*`` which turns on various combinations of dynamics and physics options for testing @@ -713,7 +731,14 @@ Next, create the "cice" conda environment from the ``environment.yml`` file in t conda env create -f configuration/scripts/machines/environment.yml -This step needs to be done only once. +This step needs to be done only once and will maintain a static conda environment. To update the conda environment later, use + +.. code-block:: bash + + conda env create -f configuration/scripts/machines/environment.yml --force + +This will update the conda environment to the latest software versions. + .. _using_conda_env: @@ -772,7 +797,7 @@ A few notes about the conda configuration: - It is not recommeded to run other test suites than ``quick_suite`` or ``travis_suite`` on a personal computer. - The conda environment is automatically activated when compiling or running the model using the ``./cice.build`` and ``./cice.run`` scripts in the case directory. These scripts source the file ``env.conda_{linux.macos}``, which calls ``conda activate cice``. -- To use the "cice" conda environment with the Python plotting (see :ref:`timeseries`) and quality control scripts (see :ref:`CodeCompliance`), you must manually activate the environment: +- To use the "cice" conda environment with the Python plotting (see :ref:`timeseries`) and quality control (QC) scripts (see :ref:`CodeValidation`), you must manually activate the environment: .. code-block:: bash @@ -897,7 +922,7 @@ To use the ``timeseries.py`` script, the following requirements must be met: * matplotlib Python package * datetime Python package -See :ref:`CodeCompliance` for additional information about how to setup the Python +See :ref:`CodeValidation` for additional information about how to setup the Python environment, but we recommend using ``pip`` as follows: :: pip install --user numpy diff --git a/doc/source/user_guide/ug_testing.rst b/doc/source/user_guide/ug_testing.rst index 61aa1c05f..5a289db6a 100644 --- a/doc/source/user_guide/ug_testing.rst +++ b/doc/source/user_guide/ug_testing.rst @@ -525,7 +525,7 @@ Test Suite Examples This will compare to results saved in the baseline [bdir] directory under the subdirectory cice.v01a. With the ``--bcmp`` option, the results will be tested against prior baselines to verify bit-for-bit, which is an important step prior - to approval of many (not all, see :ref:`compliance`) Pull Requests to incorporate code into + to approval of many (not all, see :ref:`validation`) Pull Requests to incorporate code into the CICE Consortium master code. You can use other regression options as well. (``--bdir`` and ``--bgen``) @@ -625,6 +625,49 @@ Test Suite Examples The setenv syntax is for csh/tcsh. In bash, the syntax would be SUITE_BUILD=true. +.. _unittesting: + +Unit Testing +--------------- + +Unit testing is supported in the CICE scripts. Unit tests are implemented +via a distinct top level driver that tests CICE model features explicitly. +These drivers can be found in **cicecore/drivers/unittest/**. In addition, +there are some script files that also support the unit testing. + +The unit tests build and run very much like the standard CICE model. +A case is created and model output is saved to the case logs directory. +Unit tests can be run as part of a test suite and the output is +compared against an earlier set of output using a simple diff of the +log files. + +For example, to run the existing calendar unit test as a case, + +.. code-block:: bash + + ./cice.setup -m onyx -e intel --case calchk01 -p 1x1 -s calchk + cd calchk01 + ./cice.build + ./cice.submit + +Or to run the existing calendar unit test as a test, + +.. code-block:: bash + + ./cice.setup -m onyx -e intel --test unittest -p 1x1 --testid cc01 -s calchk --bgen cice.cc01 + cd onyx_intel_unittest_gx3_1x1_calchk.cc01/ + ./cice.build + ./cice.submit + +To create a new unit test, add a new driver in **cicecore/driver/unittest**. +The directory name should be the name of the test. +Then create the appropriate set_nml or set_env files for the new unittest name +in **configuration/scripts/options**. In particular, **ICE_DRVOPT** and +**ICE_TARGET** need to be defined in a set_env file. Finally, edit +**configuration/scripts/Makefile** and create a target for the unit test. +The unit tests calchk or helloworld can be used as examples. + + .. _testreporting: Test Reporting @@ -672,7 +715,10 @@ This argument turns on special compiler flags including reduced optimization and invokes the gcov tool. Once runs are complete, either lcov or codecov can be used to analyze the results. This option is currently only available with the gnu compiler and on a few systems -with modified Macros files. +with modified Macros files. In the current implementation, when ``--coverage`` is +invoked, the sandbox is copied to a new sandbox called something like cice_lcov_yymmdd-hhmmss. +The source code in the new sandbox is modified slightly to improve coverage statistics +and the full coverage suite is run there. At the present time, the ``--coverage`` flag invokes the lcov analysis automatically by running the **report_lcov.csh** script in the test suite directory. The output @@ -728,9 +774,9 @@ assess test coverage. ..in the future. -.. _compliance: +.. _validation: -Code Compliance Test (non bit-for-bit validation) +Code Validation Test (non bit-for-bit validation) ---------------------------------------------------- A core tenet of CICE dycore and CICE innovations is that they must not change @@ -855,7 +901,7 @@ autocorrelation :math:`r_1`. .. _quadratic: -Quadratic Skill Compliance Test +Quadratic Skill Validation Test ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In addition to the two-stage test of mean sea ice thickness, we also @@ -939,12 +985,12 @@ hemispheres, and must exceed a critical value nominally set to test and the Two-Stage test described in the previous section are provided in :cite:`Hunke18`. -.. _CodeCompliance: +.. _CodeValidation: -Code Compliance Testing Procedure +Code Validation Testing Procedure ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The CICE code compliance test is performed by running a python script +The CICE code validation (QC) test is performed by running a python script (**configurations/scripts/tests/QC/cice.t-test.py**). In order to run the script, the following requirements must be met: @@ -958,7 +1004,7 @@ QC testing should be carried out using configurations (ie. namelist settings) th exercise the active code modifications. Multiple configurations may need to be tested in some cases. Developers can contact the Consortium for guidance or if there are questions. -In order to generate the files necessary for the compliance test, test cases should be +In order to generate the files necessary for the validation test, test cases should be created with the ``qc`` option (i.e., ``--set qc``) when running cice.setup. This option results in daily, non-averaged history files being written for a 5 year simulation. @@ -970,7 +1016,7 @@ To install the necessary Python packages, the ``pip`` Python utility can be used pip install --user numpy pip install --user matplotlib -To run the compliance test, setup a baseline run with the original baseline model and then +To run the validation test, setup a baseline run with the original baseline model and then a perturbation run based on recent model changes. Use ``--set qc`` in both runs in addition to other settings needed. Then use the QC script to compare history output, diff --git a/doc/source/user_guide/ug_troubleshooting.rst b/doc/source/user_guide/ug_troubleshooting.rst index 9e6f39941..a8a9c2c4d 100644 --- a/doc/source/user_guide/ug_troubleshooting.rst +++ b/doc/source/user_guide/ug_troubleshooting.rst @@ -119,17 +119,24 @@ Several utilities are available that can be helpful when debugging the code. Not all of these will work everywhere in the code, due to possible conflicts in module dependencies. -*debug\_ice* (**CICE.F90**) +*debug\_ice* (**ice\_diagnostics.F90**) A wrapper for *print\_state* that is easily called from numerous - points during the timestepping loop (see - **CICE\_RunMod.F90\_debug**, which can be substituted for - **CICE\_RunMod.F90**). + points during the timestepping loop. *print\_state* (**ice\_diagnostics.F90**) Print the ice state and forcing fields for a given grid cell. -`dbug` = true (**ice\_in**) - Print numerous diagnostic quantities. +`forcing\_diag` = true (**ice\_in**) + Print numerous diagnostic quantities associated with input forcing. + +`debug\_blocks` = true (**ice\_in**) + Print diagnostics during block decomposition and distribution. + +`debug\_model` = true (**ice\_in**) + Print extended diagnostics for the first point associated with `print\_points`. + +`debug\_model\_step` = true (**ice\_in**) + Timestep to starting printing diagnostics associated with `debug\_model`. `print\_global` (**ice\_in**) If true, compute and print numerous global sums for energy and mass @@ -138,11 +145,11 @@ conflicts in module dependencies. `print\_points` (**ice\_in**) If true, print numerous diagnostic quantities for two grid cells, - one near the north pole and one in the Weddell Sea. This utility + defined by `lonpnt` and `latpnt` in the namelist file. + This utility also provides the local grid indices and block and processor numbers (`ip`, `jp`, `iblkp`, `mtask`) for these points, which can be used in - conjunction with `check\_step`, to call *print\_state*. These flags - are set in **ice\_diagnostics.F90**. This option can be fairly slow, + to call *print\_state*. This option can be fairly slow, due to gathering data from processors. `conserv\_check` = true (**ice\_in**) diff --git a/icepack b/icepack index 8bc17e1ee..9a7e22089 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 8bc17e1eee235fb0e26857119175990aa0102613 +Subproject commit 9a7e220890f70d2654314cbb023b9137f15d6327