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/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 ed5be187a..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) diff --git a/cicecore/cicedynB/general/ice_forcing.F90 b/cicecore/cicedynB/general/ice_forcing.F90 index 186e50f6c..200b3d00b 100755 --- a/cicecore/cicedynB/general/ice_forcing.F90 +++ b/cicecore/cicedynB/general/ice_forcing.F90 @@ -158,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 @@ -389,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 @@ -436,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, mmonth, 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) @@ -738,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 @@ -776,9 +776,9 @@ subroutine read_data (flag, recd, yr, ixm, ixx, ixp, & 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 @@ -816,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 @@ -828,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 @@ -853,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) @@ -888,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 @@ -927,9 +927,9 @@ subroutine read_data_nc (flag, recd, yr, ixm, ixx, ixp, & 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 @@ -968,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) @@ -982,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 @@ -1008,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 @@ -1034,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 @@ -1065,9 +1065,9 @@ subroutine read_data_nc_hycom (flag, recd, & 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 @@ -1078,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) @@ -1104,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 @@ -1137,9 +1137,9 @@ subroutine read_clim_data (readflag, recd, ixm, ixx, ixp, & 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 @@ -1155,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) @@ -1188,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 @@ -1222,9 +1222,9 @@ subroutine read_clim_data_nc (readflag, recd, ixm, ixx, ixp, & 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 @@ -1241,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) @@ -2386,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) @@ -2418,7 +2418,7 @@ subroutine LY_data if (my_task.eq.master_task) & write (nu_diag,*) 'Qa',vmin,vmax - endif ! dbug + endif ! forcing_diag end subroutine LY_data @@ -2644,7 +2644,7 @@ subroutine JRA55_data enddo ! iblk !$OMP END PARALLEL DO - if (dbug .or. forcing_debug) then + 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) @@ -2667,7 +2667,7 @@ subroutine JRA55_data 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 ! dbug + endif ! forcing_diag end subroutine JRA55_data @@ -3425,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) @@ -3460,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 @@ -3861,10 +3861,10 @@ subroutine ocn_data_ncar_init ! 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, & +! 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, dbug, & + call ice_read_nc(fid, m, vname(n), work1, forcing_diag, & field_loc_center, field_type_scalar) ! endif @@ -3889,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(:,:,:) @@ -4023,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 @@ -4213,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) @@ -4494,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) @@ -4509,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) @@ -4682,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 @@ -4735,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 @@ -4774,9 +4774,9 @@ subroutine read_data_nc_point (flag, recd, yr, ixm, ixx, ixp, & 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 @@ -4823,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) @@ -4838,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 @@ -4864,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 @@ -5202,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 @@ -5361,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 @@ -5379,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_init.F90 b/cicecore/cicedynB/general/ice_init.F90 index 8a239abd7..5e5fd144f 100644 --- a/cicecore/cicedynB/general/ice_init.F90 +++ b/cicecore/cicedynB/general/ice_init.F90 @@ -58,7 +58,8 @@ 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, & @@ -83,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, & @@ -163,9 +164,9 @@ 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 @@ -265,6 +266,8 @@ subroutine input_data 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 @@ -433,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) @@ -599,6 +602,8 @@ subroutine input_data 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) @@ -753,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) @@ -1455,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 @@ -1643,6 +1647,8 @@ subroutine input_data 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 @@ -1823,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/infrastructure/ice_domain.F90 b/cicecore/cicedynB/infrastructure/ice_domain.F90 index f2153db5e..52f0da850 100644 --- a/cicecore/cicedynB/infrastructure/ice_domain.F90 +++ b/cicecore/cicedynB/infrastructure/ice_domain.F90 @@ -289,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) :: & @@ -313,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 @@ -328,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 @@ -565,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/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/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/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 0557ff988..9f32875e1 100644 --- a/cicecore/drivers/nuopc/dmi/CICE_FinalMod.F90 +++ b/cicecore/drivers/nuopc/dmi/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 !------------------------------------------------------------------- @@ -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/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_RunMod.F90 b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 index 65230a471..08059435f 100644 --- a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 @@ -138,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 @@ -176,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) @@ -219,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 @@ -252,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 @@ -259,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 !----------------------------------------------------------------- @@ -278,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 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 index ba740501f..bbd61b63e 100644 --- a/cicecore/drivers/unittest/calchk/calchk.F90 +++ b/cicecore/drivers/unittest/calchk/calchk.F90 @@ -55,8 +55,8 @@ program calchk ndtd = 1 ! test yearmax years from year 0 - yearmax = 1000 -! yearmax = 100000 +! yearmax = 1000 + yearmax = 100000 ! test 3 calendars do n = 1,3 diff --git a/cicecore/shared/ice_distribution.F90 b/cicecore/shared/ice_distribution.F90 index 6128f28d8..1a23b63be 100644 --- a/cicecore/shared/ice_distribution.F90 +++ b/cicecore/shared/ice_distribution.F90 @@ -181,8 +181,9 @@ subroutine create_local_block_ids(block_ids, distribution) if (distribution%blockLocation(n) == my_task+1) then block_ids(distribution%blockLocalID(n)) = n - if (debug_blocks) 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) @@ -398,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 @@ -418,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 @@ -794,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 @@ -815,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') @@ -849,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) @@ -1425,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) :: & @@ -2106,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 @@ -2201,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 @@ -2250,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 !---------------------------------------------------- @@ -2270,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 @@ -2342,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_spacecurve.F90 b/cicecore/shared/ice_spacecurve.F90 index c1b956109..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 @@ -1495,7 +1497,7 @@ subroutine PrintCurve(Mesh) gridsize = SIZE(Mesh,dim=1) - write(nu_diag,*) subname,":" + write(nu_diag,*) subname,":",gridsize if(gridsize == 2) then write (nu_diag,*) "A Level 1 Hilbert Curve:" @@ -1632,6 +1634,19 @@ 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 (nu_diag,*) "A Level 5 Hilbert Curve:" write (nu_diag,*) "------------------------" @@ -1662,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 @@ -1714,10 +1730,10 @@ subroutine GenSpaceCurve(Mesh) fact = factor(gridsize) level = fact%numfact - if (verbose) then - write(nu_diag,*) subname,'chk1',dim,gridsize - write(nu_diag,*) subname,'chk2',level - call printfactor(subname//' chk3 ',fact) + 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 @@ -1739,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/configuration/scripts/cice_decomp.csh b/configuration/scripts/cice_decomp.csh index d481da854..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 diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index 353e80361..e5fcb9177 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -29,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. @@ -36,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. @@ -241,6 +243,7 @@ processor_shape = 'slenderX2' distribution_type = 'cartesian' distribution_wght = 'latitude' + distribution_wght_file = 'unknown' ew_boundary_type = 'cyclic' ns_boundary_type = 'open' maskhalo_dyn = .false. 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.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 92% rename from configuration/scripts/options/set_nml.boxdyn rename to configuration/scripts/options/set_nml.boxnodyn index b9bb956fb..e6de6be0d 100644 --- a/configuration/scripts/options/set_nml.boxdyn +++ b/configuration/scripts/options/set_nml.boxnodyn @@ -26,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.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/tests/base_suite.ts b/configuration/scripts/tests/base_suite.ts index e9985bca5..c37750a31 100644 --- 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,15 +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 diff --git a/configuration/scripts/tests/baseline.script b/configuration/scripts/tests/baseline.script index 9f2722785..6f13807e3 100644 --- a/configuration/scripts/tests/baseline.script +++ b/configuration/scripts/tests/baseline.script @@ -69,21 +69,26 @@ if (${ICE_BASECOM} != ${ICE_SPVAL}) then echo "base_file: ${base_file}" echo "test_file: ${test_file}" - ${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 + if ("${base_file}" == "" || "${test_file}" == "" ) 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" + ${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 diff --git a/configuration/scripts/tests/decomp_suite.ts b/configuration/scripts/tests/decomp_suite.ts index c9d2ff7c4..9c82c5d27 100644 --- a/configuration/scripts/tests/decomp_suite.ts +++ b/configuration/scripts/tests/decomp_suite.ts @@ -1,39 +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 5x2x33x23x4 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 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 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 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 1x20x5x29x80 debug,run2day,dsectrobin,short smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day -smoke gx3 16x2x5x10x20 debug,run2day,drakeX2 smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +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 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 index a17e3f625..6fe1f589a 100644 --- 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/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/doc/source/cice_index.rst b/doc/source/cice_index.rst index af3d20285..9e2868947 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -141,7 +141,8 @@ either Celsius or Kelvin units). "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", "" @@ -230,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" diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 81f754909..44ee6f5b0 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -145,7 +145,8 @@ setup_nml "``cpl_bgc``", "logical", "couple bgc thru driver", "``.false.``" "``days_per_year``", "integer", "number of days in a model year", "365" "``day_init``", "integer", "the initial day of the month if not using restart", "1" - "``dbug``", "logical", "write extra diagnostics", "``.false.``" + "``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", "" @@ -158,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", "" @@ -222,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'" diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index 0979a5719..566d10fbc 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -172,8 +172,7 @@ 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. This ``debug_blocks`` variable -is independent of the ``dbug`` variable in -**ice\_in**, as there may be hundreds or thousands of blocks to print +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 @@ -270,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. diff --git a/doc/source/user_guide/ug_running.rst b/doc/source/user_guide/ug_running.rst index 1fa24c875..aca7d4933 100644 --- a/doc/source/user_guide/ug_running.rst +++ b/doc/source/user_guide/ug_running.rst @@ -275,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 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**)