./PaxHeaders.32795/CESM2.1.3_sourcemods0000644000000000000000000000012213774500031014257 xustar0026 mtime=1609728025.17101 30 atime=1609728026.833882581 26 ctime=1609728025.17101 CESM2.1.3_sourcemods/0000755006307300017500000000000013774500031014560 5ustar00islasncar00000000000000CESM2.1.3_sourcemods/PaxHeaders.32795/forcing_sfwf.F90-ORIG0000644000000000000000000000012313774500023017673 xustar0027 mtime=1609728019.317681 27 atime=1609728019.303996 29 ctime=1609728019.31718016 CESM2.1.3_sourcemods/forcing_sfwf.F90-ORIG0000644006307300017500000021230113774500023020252 0ustar00islasncar00000000000000!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| module forcing_sfwf !BOP ! !MODULE: forcing_sfwf ! !DESCRIPTION: ! Contains routines and variables used for determining the ! surface fresh water flux. ! ! !REVISION HISTORY: ! SVN:$Id$ ! ! !USES: use kinds_mod use blocks use distribution use domain use constants use io use grid use global_reductions use forcing_tools use forcing_shf use ice use time_management use prognostic use exit_mod implicit none private save ! !PUBLIC MEMBER FUNCTIONS: public :: init_sfwf, & set_sfwf ! !PUBLIC DATA MEMBERS: real (r8), public, allocatable, dimension(:,:,:,:) :: & SFWF_COMP real (r8), public, allocatable, dimension(:,:,:,:,:) :: & TFW_COMP real (r8), public :: &! public for use in restart sfwf_interp_last ! time when last interpolation was done !*** water balance factors for bulk-NCEP forcing real (r8), public :: &! public for use in restart sum_precip, &! global precip for water balance precip_fact = c1, &! factor for adjusting precip for water balance precip_fact_const,&! value used for precip_fact when ladjust_precip=.false. ssh_initial ! initial ssh real (r8), dimension(km), public :: & sal_initial logical (log_kind), public :: & lfw_as_salt_flx ! treat fw flux as virtual salt flux ! even with var.thickness sfc layer logical (log_kind), public :: & lsend_precip_fact ! if T,send precip_fact to cpl for use in fw balance ! (partially-coupled option) !EOP !BOC !----------------------------------------------------------------------- ! ! module variables ! !----------------------------------------------------------------------- real (r8), allocatable, dimension(:,:,:,:,:) :: & SFWF_DATA ! forcing data used to get SFWF real (r8), dimension(12) :: & sfwf_data_time ! time (hours) corresponding to surface fresh ! water fluxes real (r8), dimension(20) :: & sfwf_data_renorm ! factors for converting to model units real (r8) :: & sfwf_data_inc, &! time increment between values of forcing data sfwf_data_next, &! time to be used for next value of forcing data sfwf_data_update, &! time new forcing data needs to be added to interpolation set sfwf_interp_inc, &! time increment between interpolation sfwf_interp_next, &! time when next interpolation will be done sfwf_restore_tau, &! restoring time scale sfwf_restore_rtau, &! reciprocal of restoring time scale sfwf_weak_restore, &! sfwf_strong_restore, &! sfwf_strong_restore_ms ! integer (int_kind) :: & sfwf_interp_order, &! order of temporal interpolation sfwf_data_time_min_loc, &! time index for first SFWF_DATA point sfwf_data_num_fields integer (int_kind), public :: & sfwf_num_comps character (char_len), dimension(:), allocatable :: & sfwf_data_names ! short names for input data fields integer (int_kind), dimension(:), allocatable :: & sfwf_bndy_loc, &! location and field types for ghost sfwf_bndy_type ! cell update routines !*** integer addresses for various forcing data fields integer (int_kind) :: & ! restoring and partially-coupled options sfwf_data_sss integer (int_kind), public :: &! bulk-NCEP and partially-coupled (some) options sfwf_data_precip, & sfwf_comp_precip, & sfwf_comp_evap, & sfwf_comp_wrest, & sfwf_comp_srest real (r8) :: & ann_avg_precip, &! !sum_fw, &! !ann_avg_fw, &! ssh_final real (r8), dimension (km) :: & sal_final logical (log_kind) :: & ladjust_precip integer (int_kind),public :: &! used with the partially-coupled option sfwf_comp_cpl, & sfwf_data_flxio, & sfwf_comp_flxio, & tfw_num_comps, & tfw_comp_cpl, & tfw_comp_flxio real (r8), parameter :: & precip_mean = 3.4e-5_r8 character (char_len) :: & sfwf_filename, &! name of file conainting forcing data sfwf_file_fmt, &! format (bin or netcdf) of forcing file sfwf_interp_freq, &! keyword for period of temporal interpolation sfwf_interp_type, &! sfwf_data_label, & sfwf_string !general purpose character string private to module character (char_len),public :: & sfwf_data_type, &! keyword for period of forcing data sfwf_formulation logical (log_kind), public :: & lms_balance ! control balancing of P,E,M,R,S in marginal seas ! .T. only with sfc_layer_oldfree option !EOC !*********************************************************************** contains !*********************************************************************** !BOP ! !IROUTINE: init_sfwf ! !INTERFACE: subroutine init_sfwf(STF) ! !DESCRIPTION: ! Initializes surface fresh water flux forcing by either calculating ! or reading in the surface fresh water flux. Also does initial ! book-keeping concerning when new data is needed for the temporal ! interpolation and when the forcing will need to be updated. ! ! !REVISION HISTORY: ! same as module ! !INPUT/OUTPUT PARAMETERS: real (r8), dimension(nx_block,ny_block,nt,max_blocks_clinic), & intent(inout) :: & STF ! surface tracer fluxes at current timestep !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer(int_kind) :: & k, n, &! dummy loop indices iblock, &! block loop index nml_error ! namelist error flag character (char_len) :: & forcing_filename ! full filename for forcing input logical (log_kind) :: & lprintsalinitial = .false. real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: & WORK ! temporary work space real (r8), dimension(:,:,:,:,:), target, allocatable :: & TEMP_DATA ! temporary array for reading monthly data type (block) :: & this_block ! block info for local block type (datafile) :: & forcing_file ! data file structure for input forcing file type (io_field_desc) :: & io_sss, &! io field descriptor for input sss field io_precip, &! io field descriptor for input precip field io_flxio ! io field descriptor for input io_flxio field type (io_dim) :: & i_dim, j_dim, &! dimension descriptors for horiz dimensions month_dim ! dimension descriptor for monthly data namelist /forcing_sfwf_nml/ sfwf_data_type, sfwf_data_inc, & sfwf_interp_type, sfwf_interp_freq, & sfwf_interp_inc, sfwf_restore_tau, & sfwf_filename, sfwf_file_fmt, & sfwf_data_renorm, sfwf_formulation, & ladjust_precip, sfwf_weak_restore,& sfwf_strong_restore, lfw_as_salt_flx, & sfwf_strong_restore_ms, & lsend_precip_fact, lms_balance, & precip_fact_const !----------------------------------------------------------------------- ! ! read surface fresh water flux namelist input after setting ! default values. ! !----------------------------------------------------------------------- sfwf_formulation = 'restoring' sfwf_data_type = 'analytic' sfwf_data_inc = 1.e20_r8 sfwf_interp_type = 'nearest' sfwf_interp_freq = 'never' sfwf_interp_inc = 1.e20_r8 sfwf_restore_tau = 1.e20_r8 sfwf_filename = 'unknown-sfwf' sfwf_file_fmt = 'bin' sfwf_data_renorm = c1 !sfwf_data_renorm = 1.e-3_r8 ! convert from psu to msu ladjust_precip = .false. lms_balance = .false. sfwf_weak_restore = 0.092_r8 sfwf_strong_restore_ms = 0.6648_r8 sfwf_strong_restore = 0.6648_r8 lfw_as_salt_flx = .false. lsend_precip_fact = .false. precip_fact_const = c1 if (my_task == master_task) then open (nml_in, file=nml_filename, status='old',iostat=nml_error) if (nml_error /= 0) then nml_error = -1 else nml_error = 1 endif do while (nml_error > 0) read(nml_in, nml=forcing_sfwf_nml,iostat=nml_error) end do if (nml_error == 0) close(nml_in) endif call broadcast_scalar(nml_error, master_task) if (nml_error /= 0) then call exit_POP(sigAbort,'ERROR reading forcing_sfwf_nml') endif call broadcast_scalar(sfwf_data_type, master_task) call broadcast_scalar(sfwf_data_inc, master_task) call broadcast_scalar(sfwf_interp_type, master_task) call broadcast_scalar(sfwf_interp_freq, master_task) call broadcast_scalar(sfwf_interp_inc, master_task) call broadcast_scalar(sfwf_restore_tau, master_task) call broadcast_scalar(sfwf_filename, master_task) call broadcast_scalar(sfwf_file_fmt, master_task) call broadcast_scalar(sfwf_formulation, master_task) call broadcast_array (sfwf_data_renorm, master_task) call broadcast_scalar(ladjust_precip, master_task) call broadcast_scalar(sfwf_weak_restore, master_task) call broadcast_scalar(sfwf_strong_restore, master_task) call broadcast_scalar(sfwf_strong_restore_ms, master_task) call broadcast_scalar(lfw_as_salt_flx, master_task) call broadcast_scalar(lsend_precip_fact, master_task) call broadcast_scalar(lms_balance, master_task) call broadcast_scalar(precip_fact_const, master_task) !----------------------------------------------------------------------- ! ! set precip_fact if ladjust_precip=.false. ! !----------------------------------------------------------------------- if (.not. ladjust_precip) then precip_fact = precip_fact_const call document ('init_sfwf', 'setting precip_fact to precip_fact_const') call document ('init_sfwf', 'precip_fact', precip_fact) endif !----------------------------------------------------------------------- ! ! convert data_type to 'monthly-calendar' if input is 'monthly' ! !----------------------------------------------------------------------- if (sfwf_data_type == 'monthly') sfwf_data_type = 'monthly-calendar' !----------------------------------------------------------------------- ! ! set values based on sfwf_formulation ! !----------------------------------------------------------------------- select case (sfwf_formulation) case ('restoring') allocate(sfwf_data_names(1), & sfwf_bndy_loc (1), & sfwf_bndy_type (1)) sfwf_data_num_fields = 1 sfwf_data_sss = 1 sfwf_data_names(sfwf_data_sss) = 'SSS' sfwf_bndy_loc (sfwf_data_sss) = field_loc_center sfwf_bndy_type (sfwf_data_sss) = field_type_scalar case ('bulk-NCEP') sfwf_data_num_fields = 2 sfwf_data_sss = 1 sfwf_data_precip = 2 allocate(sfwf_data_names(sfwf_data_num_fields), & sfwf_bndy_loc (sfwf_data_num_fields), & sfwf_bndy_type (sfwf_data_num_fields)) sfwf_data_names(sfwf_data_sss) = 'SSS' sfwf_bndy_loc (sfwf_data_sss) = field_loc_center sfwf_bndy_type (sfwf_data_sss) = field_type_scalar sfwf_data_names(sfwf_data_precip) = 'PRECIPITATION' sfwf_bndy_loc (sfwf_data_precip) = field_loc_center sfwf_bndy_type (sfwf_data_precip) = field_type_scalar sfwf_num_comps = 4 sfwf_comp_precip = 1 sfwf_comp_evap = 2 sfwf_comp_wrest = 3 sfwf_comp_srest = 4 case ('partially-coupled') sfwf_data_num_fields = 2 sfwf_data_sss = 1 sfwf_data_flxio = 2 allocate(sfwf_data_names(sfwf_data_num_fields), & sfwf_bndy_loc (sfwf_data_num_fields), & sfwf_bndy_type (sfwf_data_num_fields)) sfwf_data_names(sfwf_data_sss) = 'SSS' sfwf_bndy_loc (sfwf_data_sss) = field_loc_center sfwf_bndy_type (sfwf_data_sss) = field_type_scalar sfwf_data_names(sfwf_data_flxio) = 'FLXIO' sfwf_bndy_loc (sfwf_data_flxio) = field_loc_center sfwf_bndy_type (sfwf_data_flxio) = field_type_scalar sfwf_num_comps = 4 sfwf_comp_wrest = 1 sfwf_comp_srest = 2 sfwf_comp_cpl = 3 sfwf_comp_flxio = 4 tfw_num_comps = 2 tfw_comp_cpl = 1 tfw_comp_flxio = 2 case default call exit_POP(sigAbort, & 'init_sfwf: Unknown value for sfwf_formulation') end select if ( sfwf_formulation == 'bulk-NCEP' .or. & sfwf_formulation == 'partially-coupled' ) then !*** calculate initial salinity profile for ocean points that are !*** not marginal seas. !*** very first step of run if (ladjust_precip .and. nsteps_total == 0) then sum_precip = c0 ssh_initial = c0 !sum_fw = c0 do k = 1,km !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) if (partial_bottom_cells) then WORK(:,:,iblock) = & merge(TRACER(:,:,k,2,curtime,iblock)* & TAREA(:,:,iblock)*DZT(:,:,k,iblock), & c0, k <= KMT(:,:,iblock) .and. & MASK_SR(:,:,iblock) > 0) else WORK(:,:,iblock) = & merge(TRACER(:,:,k,2,curtime,iblock)* & TAREA(:,:,iblock)*dz(k), & c0, k <= KMT(:,:,iblock) .and. & MASK_SR(:,:,iblock) > 0) endif end do !$OMP END PARALLEL DO sal_initial(k) = global_sum(WORK,distrb_clinic,field_loc_center)/ & (volume_t_k(k) - volume_t_marg_k(k)) ! in m^3 enddo endif endif !*** document sal_initial if (lprintsalinitial) then do k = 1,km write(sfwf_string,'(a,i3,a)') 'sal_initial(',k,')' call document ('init_sfwf', trim(sfwf_string), sal_initial(k)) enddo endif !----------------------------------------------------------------------- ! ! calculate inverse of restoring time scale and convert to seconds. ! !----------------------------------------------------------------------- sfwf_restore_rtau = c1/(seconds_in_day*sfwf_restore_tau) !----------------------------------------------------------------------- ! ! convert interp_type to corresponding integer value. ! !----------------------------------------------------------------------- select case (sfwf_interp_type) case ('nearest') sfwf_interp_order = 1 case ('linear') sfwf_interp_order = 2 case ('4point') sfwf_interp_order = 4 case default call exit_POP(sigAbort, & 'init_sfwf: Unknown value for sfwf_interp_type') end select !----------------------------------------------------------------------- ! ! set values of the surface fresh water flux arrays (SFWF or ! SFWF_DATA) depending on type of the surface fresh water flux ! data. ! !----------------------------------------------------------------------- select case (sfwf_data_type) !----------------------------------------------------------------------- ! ! no surface fresh water flux, therefore no interpolation in time ! is needed (sfwf_interp_freq = 'none'), nor are there any new ! values to be used (sfwf_data_next = sfwf_data_update = never). ! !----------------------------------------------------------------------- case ('none') STF(:,:,2,:) = c0 sfwf_data_next = never sfwf_data_update = never sfwf_interp_freq = 'never' !----------------------------------------------------------------------- ! ! simple analytic surface salinity that is constant in time, ! therefore no new values will be needed. ! !----------------------------------------------------------------------- case ('analytic') allocate(SFWF_DATA(nx_block,ny_block,max_blocks_clinic, & sfwf_data_num_fields,1)) SFWF_DATA = c0 select case (sfwf_formulation) case ('restoring') SFWF_DATA(:,:,:,sfwf_data_sss,1) = 0.035_r8 end select sfwf_data_next = never sfwf_data_update = never sfwf_interp_freq = 'never' !----------------------------------------------------------------------- ! ! annual mean climatological surface salinity (read in from a file) ! that is constant in time, therefore no new values will be needed. ! !----------------------------------------------------------------------- case ('annual') allocate(SFWF_DATA(nx_block,ny_block,max_blocks_clinic, & sfwf_data_num_fields,1)) SFWF_DATA = c0 forcing_file = construct_file(sfwf_file_fmt, & full_name=trim(sfwf_filename), & record_length = rec_type_dbl, & recl_words=nx_global*ny_global) call data_set(forcing_file,'open_read') i_dim = construct_io_dim('i',nx_global) j_dim = construct_io_dim('j',nx_global) select case (sfwf_formulation) case ('restoring') io_sss = construct_io_field( & trim(sfwf_data_names(sfwf_data_sss)), & dim1=i_dim, dim2=j_dim, & field_loc = sfwf_bndy_loc(sfwf_data_sss), & field_type = sfwf_bndy_type(sfwf_data_sss), & d2d_array=SFWF_DATA(:,:,:,sfwf_data_sss,1)) call data_set(forcing_file,'define',io_sss) call data_set(forcing_file,'read' ,io_sss) call destroy_io_field(io_sss) case ('bulk-NCEP') io_sss = construct_io_field( & trim(sfwf_data_names(sfwf_data_sss)), & dim1=i_dim, dim2=j_dim, & field_loc = sfwf_bndy_loc(sfwf_data_sss), & field_type = sfwf_bndy_type(sfwf_data_sss), & d2d_array=SFWF_DATA(:,:,:,sfwf_data_sss,1)) io_precip = construct_io_field( & trim(sfwf_data_names(sfwf_data_precip)), & dim1=i_dim, dim2=j_dim, & field_loc = sfwf_bndy_loc(sfwf_data_precip), & field_type = sfwf_bndy_type(sfwf_data_precip), & d2d_array=SFWF_DATA(:,:,:,sfwf_data_precip,1)) call data_set(forcing_file,'define',io_sss) call data_set(forcing_file,'define',io_precip) call data_set(forcing_file,'read' ,io_sss) call data_set(forcing_file,'read' ,io_precip) call destroy_io_field(io_sss) call destroy_io_field(io_precip) allocate( SFWF_COMP(nx_block,ny_block,max_blocks_clinic, & sfwf_num_comps)) SFWF_COMP = c0 ! initialize case ('partially-coupled') io_sss = construct_io_field( & trim(sfwf_data_names(sfwf_data_sss)), & dim1=i_dim, dim2=j_dim, & field_loc = sfwf_bndy_loc(sfwf_data_sss), & field_type = sfwf_bndy_type(sfwf_data_sss), & d2d_array=SFWF_DATA(:,:,:,sfwf_data_sss,1)) io_flxio = construct_io_field( & trim(sfwf_data_names(sfwf_data_flxio)), & dim1=i_dim, dim2=j_dim, & field_loc = sfwf_bndy_loc(sfwf_data_flxio), & field_type = sfwf_bndy_type(sfwf_data_flxio), & d2d_array=SFWF_DATA(:,:,:,sfwf_data_flxio,1)) call data_set(forcing_file,'define',io_sss) call data_set(forcing_file,'define',io_flxio) call data_set(forcing_file,'read' ,io_sss) call data_set(forcing_file,'read' ,io_flxio) call destroy_io_field(io_sss) call destroy_io_field(io_flxio) allocate( SFWF_COMP(nx_block,ny_block,max_blocks_clinic, & sfwf_num_comps)) SFWF_COMP = c0 ! initialize end select call data_set(forcing_file,'close') call destroy_file(forcing_file) !*** renormalize values if necessary to compensate for !*** different units. do n = 1,sfwf_data_num_fields if (sfwf_data_renorm(n) /= c1) SFWF_DATA(:,:,:,n,:) = & sfwf_data_renorm(n)*SFWF_DATA(:,:,:,n,:) enddo sfwf_data_next = never sfwf_data_update = never sfwf_interp_freq = 'never' if (my_task == master_task) then write(stdout,blank_fmt) write(stdout,'(a25,a)') ' SFWF Annual file read: ', & trim(sfwf_filename) endif !----------------------------------------------------------------------- ! ! monthly mean climatological surface fresh water flux. all ! 12 months are read in from a file. interpolation order ! (sfwf_interp_order) may be specified with namelist input. ! !----------------------------------------------------------------------- case ('monthly-equal','monthly-calendar') allocate(SFWF_DATA(nx_block,ny_block,max_blocks_clinic, & sfwf_data_num_fields,0:12), & TEMP_DATA(nx_block,ny_block,12,max_blocks_clinic, & sfwf_data_num_fields) ) SFWF_DATA = c0 call find_forcing_times(sfwf_data_time, sfwf_data_inc, & sfwf_interp_type, sfwf_data_next, & sfwf_data_time_min_loc, & sfwf_data_update, sfwf_data_type) forcing_file = construct_file(sfwf_file_fmt, & full_name=trim(sfwf_filename), & record_length = rec_type_dbl, & recl_words=nx_global*ny_global) call data_set(forcing_file,'open_read') i_dim = construct_io_dim('i',nx_global) j_dim = construct_io_dim('j',nx_global) month_dim = construct_io_dim('month',12) select case (sfwf_formulation) case ('restoring') io_sss = construct_io_field( & trim(sfwf_data_names(sfwf_data_sss)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = sfwf_bndy_loc(sfwf_data_sss), & field_type = sfwf_bndy_type(sfwf_data_sss), & d3d_array=TEMP_DATA(:,:,:,:,sfwf_data_sss)) call data_set(forcing_file,'define',io_sss) call data_set(forcing_file,'read' ,io_sss) call destroy_io_field(io_sss) case ('bulk-NCEP') io_sss = construct_io_field( & trim(sfwf_data_names(sfwf_data_sss)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = sfwf_bndy_loc(sfwf_data_sss), & field_type = sfwf_bndy_type(sfwf_data_sss), & d3d_array=TEMP_DATA(:,:,:,:,sfwf_data_sss)) io_precip = construct_io_field( & trim(sfwf_data_names(sfwf_data_precip)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = sfwf_bndy_loc(sfwf_data_precip), & field_type = sfwf_bndy_type(sfwf_data_precip), & d3d_array=TEMP_DATA(:,:,:,:,sfwf_data_precip)) call data_set(forcing_file,'define',io_sss) call data_set(forcing_file,'define',io_precip) call data_set(forcing_file,'read' ,io_sss) call data_set(forcing_file,'read' ,io_precip) call destroy_io_field(io_sss) call destroy_io_field(io_precip) allocate(SFWF_COMP(nx_block,ny_block,max_blocks_clinic, & sfwf_num_comps)) SFWF_COMP = c0 ! initialize case ('partially-coupled') io_sss = construct_io_field( & trim(sfwf_data_names(sfwf_data_sss)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = sfwf_bndy_loc(sfwf_data_sss), & field_type = sfwf_bndy_type(sfwf_data_sss), & d3d_array=TEMP_DATA(:,:,:,:,sfwf_data_sss)) io_flxio = construct_io_field( & trim(sfwf_data_names(sfwf_data_flxio )), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = sfwf_bndy_loc(sfwf_data_flxio ), & field_type = sfwf_bndy_type(sfwf_data_flxio ), & d3d_array=TEMP_DATA(:,:,:,:,sfwf_data_flxio )) call data_set(forcing_file,'define',io_sss) call data_set(forcing_file,'define',io_flxio ) call data_set(forcing_file,'read' ,io_sss) call data_set(forcing_file,'read' ,io_flxio ) call destroy_io_field(io_sss) call destroy_io_field(io_flxio ) allocate(SFWF_COMP(nx_block,ny_block,max_blocks_clinic, & sfwf_num_comps)) SFWF_COMP = c0 ! initialize end select call data_set(forcing_file,'close') call destroy_file(forcing_file) !*** re-order data and renormalize values if necessary to !*** compensate for different units. !$OMP PARALLEL DO PRIVATE(iblock, k, n) do iblock=1,nblocks_clinic do k=1,sfwf_data_num_fields if (sfwf_data_renorm(k) /= c1) then do n=1,12 SFWF_DATA(:,:,iblock,k,n) = & TEMP_DATA(:,:,n,iblock,k)*sfwf_data_renorm(k) end do else do n=1,12 SFWF_DATA(:,:,iblock,k,n) = TEMP_DATA(:,:,n,iblock,k) end do endif end do end do !$OMP END PARALLEL DO deallocate(TEMP_DATA) if (my_task == master_task) then write(stdout,blank_fmt) write(stdout,'(a25,a)') ' SFWF Monthly file read: ', & trim(sfwf_filename) endif !----------------------------------------------------------------------- ! ! surface salinity specified every n-hours, where the n-hour ! increment should be specified with namelist input ! (sfwf_data_inc). only as many times as are necessary based on ! the order of the temporal interpolation scheme ! (sfwf_interp_order) reside in memory at any given time. ! !----------------------------------------------------------------------- case ('n-hour') allocate( SFWF_DATA(nx_block,ny_block,max_blocks_clinic, & sfwf_data_num_fields,0:sfwf_interp_order)) SFWF_DATA = c0 call find_forcing_times(sfwf_data_time, sfwf_data_inc, & sfwf_interp_type, sfwf_data_next, & sfwf_data_time_min_loc, & sfwf_data_update, sfwf_data_type) do n=1,sfwf_interp_order call get_forcing_filename(forcing_filename, sfwf_filename, & sfwf_data_time(n), sfwf_data_inc) forcing_file = construct_file(sfwf_file_fmt, & full_name=trim(sfwf_filename), & record_length = rec_type_dbl, & recl_words=nx_global*ny_global) call data_set(forcing_file,'open_read') i_dim = construct_io_dim('i',nx_global) j_dim = construct_io_dim('j',nx_global) select case (sfwf_formulation) case ('restoring') io_sss = construct_io_field( & trim(sfwf_data_names(sfwf_data_sss)), & dim1=i_dim, dim2=j_dim, & field_loc = sfwf_bndy_loc(sfwf_data_sss), & field_type = sfwf_bndy_type(sfwf_data_sss), & d2d_array=SFWF_DATA(:,:,:,sfwf_data_sss,n)) call data_set(forcing_file,'define',io_sss) call data_set(forcing_file,'read' ,io_sss) call destroy_io_field(io_sss) case ('bulk-NCEP') io_sss = construct_io_field( & trim(sfwf_data_names(sfwf_data_sss)), & dim1=i_dim, dim2=j_dim, & field_loc = sfwf_bndy_loc(sfwf_data_sss), & field_type = sfwf_bndy_type(sfwf_data_sss), & d2d_array=SFWF_DATA(:,:,:,sfwf_data_sss,n)) io_precip = construct_io_field( & trim(sfwf_data_names(sfwf_data_precip)), & dim1=i_dim, dim2=j_dim, & field_loc = sfwf_bndy_loc(sfwf_data_precip), & field_type = sfwf_bndy_type(sfwf_data_precip), & d2d_array=SFWF_DATA(:,:,:,sfwf_data_precip,n)) call data_set(forcing_file,'define',io_sss) call data_set(forcing_file,'define',io_precip) call data_set(forcing_file,'read' ,io_sss) call data_set(forcing_file,'read' ,io_precip) call destroy_io_field(io_sss) call destroy_io_field(io_precip) case ('partially-coupled') io_sss = construct_io_field( & trim(sfwf_data_names(sfwf_data_sss)), & dim1=i_dim, dim2=j_dim, & field_loc = sfwf_bndy_loc(sfwf_data_sss), & field_type = sfwf_bndy_type(sfwf_data_sss), & d2d_array=SFWF_DATA(:,:,:,sfwf_data_sss,n)) io_flxio = construct_io_field( & trim(sfwf_data_names(sfwf_data_flxio )), & dim1=i_dim, dim2=j_dim, & field_loc = sfwf_bndy_loc(sfwf_data_flxio ), & field_type = sfwf_bndy_type(sfwf_data_flxio ), & d2d_array=SFWF_DATA(:,:,:,sfwf_data_flxio ,n)) call data_set(forcing_file,'define',io_sss) call data_set(forcing_file,'define',io_flxio ) call data_set(forcing_file,'read' ,io_sss) call data_set(forcing_file,'read' ,io_flxio ) call destroy_io_field(io_sss) call destroy_io_field(io_flxio ) end select call data_set(forcing_file,'close') call destroy_file(forcing_file) if (my_task == master_task) then write(stdout,blank_fmt) write(stdout,'(a24,a)') ' SFWF n-hour file read: ', & trim(forcing_filename) endif enddo if (sfwf_formulation == 'bulk-NCEP' .or. & sfwf_formulation == 'partially-coupled') then allocate(SFWF_COMP(nx_block,ny_block,max_blocks_clinic, & sfwf_num_comps)) SFWF_COMP = c0 ! initialize endif !*** renormalize values if necessary to compensate for different !*** units. do n = 1,sfwf_data_num_fields if (sfwf_data_renorm(n) /= c1) SFWF_DATA(:,:,:,n,:) = & sfwf_data_renorm(n)*SFWF_DATA(:,:,:,n,:) enddo case default call exit_POP(sigAbort, & 'init_sfwf: Unknown value for sfwf_data_type') end select if ( sfwf_formulation == 'partially-coupled' ) then allocate ( TFW_COMP(nx_block,ny_block,nt,max_blocks_clinic, & tfw_num_comps)) TFW_COMP = c0 endif !----------------------------------------------------------------------- ! ! now check interpolation period (sfwf_interp_freq) to set the ! time for the next temporal interpolation (sfwf_interp_next). ! ! if no interpolation is to be done, set next interpolation time ! to a large number so the surface fresh water flux update test ! in routine set_surface_forcing will always be false. ! ! if interpolation is to be done every n-hours, find the first ! interpolation time greater than the current time. ! ! if interpolation is to be done every timestep, set next interpolation ! time to a large negative number so the surface fresh water flux ! update test in routine set_surface_forcing will always be true. ! !----------------------------------------------------------------------- select case (sfwf_interp_freq) case ('never') sfwf_interp_next = never sfwf_interp_last = never sfwf_interp_inc = c0 case ('n-hour') call find_interp_time(sfwf_interp_inc, sfwf_interp_next) case ('every-timestep') sfwf_interp_next = always sfwf_interp_inc = c0 case default call exit_POP(sigAbort, & 'init_sfwf: Unknown value for sfwf_interp_freq') end select if(nsteps_total == 0) sfwf_interp_last = thour00 !----------------------------------------------------------------------- ! ! echo forcing options to stdout. ! !----------------------------------------------------------------------- sfwf_data_label = 'Surface Fresh Water Flux' call echo_forcing_options(sfwf_data_type, & sfwf_formulation, sfwf_data_inc, & sfwf_interp_freq, sfwf_interp_type, & sfwf_interp_inc, sfwf_data_label) if (my_task == master_task) then if (lfw_as_salt_flx .and. sfc_layer_type == sfc_layer_varthick) & write(stdout,'(a47)') & ' Fresh water flux input as virtual salt flux' endif !----------------------------------------------------------------------- !EOC call flushm (stdout) end subroutine init_sfwf !*********************************************************************** !BOP ! !IROUTINE: set_sfwf ! !INTERFACE: subroutine set_sfwf(STF,FW,TFW) ! !DESCRIPTION: ! Updates the current value of the surface fresh water flux arrays ! by interpolating fields or computing fields at the current time. ! If new data are necessary for the interpolation, the new data are ! read from a file. ! ! !REVISION HISTORY: ! same as module ! !INPUT/OUTPUT PARAMETERS: real (r8), dimension(nx_block,ny_block,nt,max_blocks_clinic), & intent(inout) :: & STF, &! surface tracer fluxes at current timestep TFW ! tracer concentration in fresh water flux real (r8), dimension(nx_block,ny_block,max_blocks_clinic), & intent(inout) :: & FW ! fresh water flux if using varthick sfc layer !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & iblock ! local address for current block type (block) :: & this_block ! block info for current block !----------------------------------------------------------------------- ! ! check if new data is necessary for interpolation. if yes, then ! shuffle indices in SFWF_DATA and sfwf_data_time arrays ! and read in new data if necessary ('n-hour' case). note ! that no new data is necessary for 'analytic' and 'annual' cases. ! then perform interpolation or computation of fluxes at current time ! using updated forcing data. ! !----------------------------------------------------------------------- select case(sfwf_data_type) case ('analytic') select case (sfwf_formulation) case ('restoring') !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) STF(:,:,2,iblock) = & (SFWF_DATA(:,:,iblock,sfwf_data_sss,1) - & TRACER(:,:,1,2,curtime,iblock))* & sfwf_restore_rtau*dz(1) end do !$OMP END PARALLEL DO end select case('annual') select case (sfwf_formulation) case ('restoring') !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) STF(:,:,2,iblock) = & (SFWF_DATA(:,:,iblock,sfwf_data_sss,1) - & TRACER(:,:,1,2,curtime,iblock))* & sfwf_restore_rtau*dz(1) end do !$OMP END PARALLEL DO case ('bulk-NCEP') call calc_sfwf_bulk_ncep(STF,FW,TFW,1) case ('partially-coupled') call calc_sfwf_partially_coupled(1) end select case ('monthly-equal','monthly-calendar') sfwf_data_label = 'SFWF Monthly' if (thour00 >= sfwf_data_update) then call update_forcing_data( sfwf_data_time, & sfwf_data_time_min_loc, sfwf_interp_type, & sfwf_data_next, sfwf_data_update, & sfwf_data_type, sfwf_data_inc, & SFWF_DATA(:,:,:,:,1:12),sfwf_data_renorm, & sfwf_data_label, sfwf_data_names, & sfwf_bndy_loc, sfwf_bndy_type, & sfwf_filename, sfwf_file_fmt) endif if (thour00 >= sfwf_interp_next .or. nsteps_run == 0) then call interpolate_forcing(SFWF_DATA(:,:,:,:,0), & SFWF_DATA(:,:,:,:,1:12), & sfwf_data_time, sfwf_interp_type, & sfwf_data_time_min_loc, sfwf_interp_freq, & sfwf_interp_inc, sfwf_interp_next, & sfwf_interp_last, nsteps_run) if (nsteps_run /= 0) sfwf_interp_next = & sfwf_interp_next + sfwf_interp_inc endif select case (sfwf_formulation) case ('restoring') !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) STF(:,:,2,iblock) = & (SFWF_DATA(:,:,iblock,sfwf_data_sss,0) - & TRACER(:,:,1,2,curtime,iblock))* & sfwf_restore_rtau*dz(1) end do !$OMP END PARALLEL DO case ('bulk-NCEP') call calc_sfwf_bulk_ncep(STF,FW,TFW,12) case ('partially-coupled') call calc_sfwf_partially_coupled(12) end select case('n-hour') sfwf_data_label = 'SFWF n-hour' if (thour00 >= sfwf_data_update) then call update_forcing_data( sfwf_data_time, & sfwf_data_time_min_loc, sfwf_interp_type, & sfwf_data_next, sfwf_data_update, & sfwf_data_type, sfwf_data_inc, & SFWF_DATA(:,:,:,:,1:sfwf_interp_order), & sfwf_data_renorm, & sfwf_data_label, sfwf_data_names, & sfwf_bndy_loc, sfwf_bndy_type, & sfwf_filename, sfwf_file_fmt) endif if (thour00 >= sfwf_interp_next .or. nsteps_run == 0) then call interpolate_forcing(SFWF_DATA(:,:,:,:,0), & SFWF_DATA(:,:,:,:,1:sfwf_interp_order), & sfwf_data_time, sfwf_interp_type, & sfwf_data_time_min_loc, sfwf_interp_freq, & sfwf_interp_inc, sfwf_interp_next, & sfwf_interp_last, nsteps_run) if (nsteps_run /= 0) sfwf_interp_next = & sfwf_interp_next + sfwf_interp_inc endif select case (sfwf_formulation) case ('restoring') !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) STF(:,:,2,iblock) = & (SFWF_DATA(:,:,iblock,sfwf_data_sss,0) - & TRACER(:,:,1,2,curtime,iblock))* & sfwf_restore_rtau*dz(1) end do !$OMP END PARALLEL DO case ('bulk-NCEP') call calc_sfwf_bulk_ncep(STF, FW, TFW, sfwf_interp_order) case ('partially-coupled') call calc_sfwf_partially_coupled(sfwf_interp_order) end select end select !----------------------------------------------------------------------- !EOC end subroutine set_sfwf !*********************************************************************** !BOP ! !IROUTINE: calc_sfwf_bulk_ncep ! !INTERFACE: subroutine calc_sfwf_bulk_ncep(STF, FW, TFW, time_dim) ! !DESCRIPTION: ! Calculates surface freshwater flux from a combination of ! air-sea fluxes (precipitation, evaporation based on ! latent heat flux computed in calc\_shf\_bulk\_ncep), ! and restoring terms (due to restoring fields of SSS). ! ! Notes: ! the forcing data (on t-grid) are computed and ! stored in SFWF\_DATA(:,:,sfwf\_comp\_*,now) where: ! sfwf\_data\_sss is restoring SSS (psu) ! sfwf\_data\_precip is precipitation (m/y) ! ! !REVISION HISTORY: ! same as module ! !INPUT PARAMETERS: integer (int_kind), intent(in) :: & time_dim ! number of time points for interpolation ! !INPUT/OUTPUT PARAMETERS: real (r8), dimension(nx_block,ny_block,nt,max_blocks_clinic), & intent(inout) :: & STF, &! surface tracer fluxes for all tracers TFW ! tracer concentration in fresh water flux ! !OUTPUT PARAMETERS: real (r8), dimension(nx_block,ny_block,max_blocks_clinic), & intent(out) :: & FW ! fresh water flux if using varthick sfc layer !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & now, &! index for location of interpolated data k, n, &! dummy loop indices iblock ! block loop index real (r8) :: & dttmp, &! temporary time step variable fres_hor_ave, &! area-weighted mean of weak restoring fres_hor_area, &! total area of weak restoring area_glob_m_marg, &! total ocean area - marginal sea area vol_glob_m_marg, &! total ocean volume - marginal sea volume weak_mean ! mean weak restoring real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: & WORK1, WORK2 ! temporary work space type(block) :: & this_block ! block info for current block !----------------------------------------------------------------------- ! ! sfwf_weak_restore= weak(non-ice) restoring h2o flux per msu (kg/s/m^2/msu) ! sfwf_strong_restore= strong (ice) .. .. .. .. .. .. ! ! to calculate restoring factors, use mixed layer of 50m, ! and restoring time constant tau (days): ! ! F (kg/s/m^2/msu) ! tau = 6 : 2.77 ! tau = 30 : 0.55 ! tau = 182.5: 0.092 ! tau = 365 : 0.046 ! tau = 730 : 0.023 ! tau = Inf : 0.0 ! !----------------------------------------------------------------------- !----------------------------------------------------------------------- ! ! set location where interpolated data exists. ! !----------------------------------------------------------------------- if (sfwf_data_type == 'annual') then now = 1 else now = 0 endif !----------------------------------------------------------------------- ! ! compute forcing terms for each block ! !----------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) !*** compute evaporation from latent heat computed in shf forcing SFWF_COMP(:,:,iblock,sfwf_comp_evap) = & SHF_COMP(:,:,iblock,shf_comp_qlat)/latent_heat_vapor_mks !*** precipitation (kg/m^2/s) SFWF_COMP(:,:,iblock,sfwf_comp_precip) = & SFWF_DATA(:,:,iblock,sfwf_data_precip,now)*precip_fact ! *c1000/seconds_in_year ! convert m/y to Kg/m^2/s if needed !*** weak salinity restoring term !*** (note: OCN_WGT = 0. at land points) !*** will be subtracting global mean later, so compute !*** necessary terms for global mean SFWF_COMP(:,:,iblock,sfwf_comp_wrest) = & -sfwf_weak_restore*OCN_WGT(:,:,iblock)* & MASK_SR(:,:,iblock)* & (SFWF_DATA(:,:,iblock,sfwf_data_sss,now) - & TRACER(:,:,1,2,curtime,iblock)) WORK1(:,:,iblock) = TAREA(:,:,iblock)* & SFWF_COMP(:,:,iblock,sfwf_comp_wrest) WORK2(:,:,iblock) = TAREA(:,:,iblock)*OCN_WGT(:,:,iblock)* & MASK_SR(:,:,iblock) !*** strong salinity restoring term where (KMT(:,:,iblock) > 0) SFWF_COMP(:,:,iblock,sfwf_comp_srest) = & -sfwf_strong_restore*(c1 - OCN_WGT(:,:,iblock))* & (SFWF_DATA(:,:,iblock,sfwf_data_sss,now) - & TRACER(:,:,1,2,curtime,iblock)) endwhere where (KMT(:,:,iblock) > 0 .and. MASK_SR(:,:,iblock) == 0) SFWF_COMP(:,:,iblock,sfwf_comp_srest) = & -sfwf_strong_restore_ms* & (SFWF_DATA(:,:,iblock,sfwf_data_sss,now) - & TRACER(:,:,1,2,curtime,iblock)) endwhere end do ! block loop !$OMP END PARALLEL DO !---------------------------------------------------------------------- ! ! compute global mean of weak restoring term ! !---------------------------------------------------------------------- fres_hor_ave = global_sum(WORK1, distrb_clinic, field_loc_center) fres_hor_area = global_sum(WORK2, distrb_clinic, field_loc_center) weak_mean = fres_hor_ave/fres_hor_area !----------------------------------------------------------------------- ! ! finish computing forcing terms for each block ! !----------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) !*** subtract mean from weak restoring term SFWF_COMP(:,:,iblock,sfwf_comp_wrest) = & SFWF_COMP(:,:,iblock,sfwf_comp_wrest) - OCN_WGT(:,:,iblock)* & MASK_SR(:,:,iblock)*weak_mean ! if variable thickness surface layer, compute net surface ! freshwater flux (kg/m^2/s) due to restoring terms only ! then compute freshwater flux due to P-E and convert to (m/s) ! then set the tracer content in the freshwater flux ! defaults are FW*SST for tracer 1 (temperature) ! 0 for salinity (really fresh water) ! 0 for all other tracers ! ! IF DATA ARE AVAILABLE... ! IMPLEMENT SUM OVER FRESHWATER TYPES (E,P,R,F,M) HERE: ! ! TFW(:,:,n) = FW_EVAP*TW_EVAP(:,:,n) + FW_PRECIP*TW_PRECIP(:,:,n) ! + FW_ROFF*TW_ROFF(:,:,n) + FW_MELT*TW_MELT(:,:,n) ! + FW_FREEZE*TW_FREEZE(:,:,n) ! ! where, for example FW_ROFF is the water flux from rivers ! and TW_ROFF(:,:,n) is the concentration of the nth tracer ! in the river water; similarly for water fluxes due to ! evaporation, precipitation, ice freezing, and ice melting. if (sfc_layer_type == sfc_layer_varthick .and. & .not. lfw_as_salt_flx) then STF(:,:,2,iblock) = SFWF_COMP(:,:,iblock,sfwf_comp_wrest) + & SFWF_COMP(:,:,iblock,sfwf_comp_srest) FW(:,:,iblock) = OCN_WGT(:,:,iblock)*MASK_SR(:,:,iblock)* & (SFWF_COMP(:,:,iblock,sfwf_comp_evap) + & SFWF_COMP(:,:,iblock,sfwf_comp_precip))* & fwmass_to_fwflux !*** fw same temp as ocean and no tracers in FW input TFW(:,:,1,iblock) = FW(:,:,iblock)* & TRACER(:,:,1,1,curtime,iblock) TFW(:,:,2:nt,iblock) = c0 !*** if rigid lid or old free surface form, compute !*** net surface freshwater flux (kg/m^2/s) else STF(:,:,2,iblock) = OCN_WGT(:,:,iblock)*MASK_SR(:,:,iblock)* & (SFWF_COMP(:,:,iblock,sfwf_comp_evap) + & SFWF_COMP(:,:,iblock,sfwf_comp_precip)) + & SFWF_COMP(:,:,iblock,sfwf_comp_wrest)+ & SFWF_COMP(:,:,iblock,sfwf_comp_srest) endif !*** convert surface freshwater flux (kg/m^2/s) to !*** salinity flux (msu*cm/s) STF(:,:,2,iblock) = STF(:,:,2,iblock)*salinity_factor !*** compute fields for accumulating annual-mean precipitation !*** over ocean points that are not marginal seas. WORK1(:,:,iblock) = merge(SFWF_COMP(:,:,iblock,sfwf_comp_precip)*& TAREA(:,:,iblock)*OCN_WGT(:,:,iblock), & c0, MASK_SR(:,:,iblock) > 0) !WORK2 = merge(FW_OLD(:,:,iblock)*TAREA(:,:,iblock), & ! c0, MASK_SR(:,:,iblock) > 0) end do ! block loop !$OMP END PARALLEL DO !----------------------------------------------------------------------- ! ! accumulate annual-mean precipitation over ocean points that are ! not marginal seas. ! !----------------------------------------------------------------------- if (avg_ts .or. back_to_back) then dttmp = p5*dtt else dttmp = dtt endif area_glob_m_marg = area_t - area_t_marg sum_precip = sum_precip + dttmp*1.0e-4_r8* & global_sum(WORK1,distrb_clinic,field_loc_center)/ & area_glob_m_marg !sum_fw = sum_fw + & ! dttmp*global_sum(WORK2,distrb_clinic,field_loc_center)/ & ! area_glob_m_marg !----------------------------------------------------------------------- ! ! Perform end of year adjustment calculations ! !----------------------------------------------------------------------- if (eoy) then !*** Compute the surface volume-averaged salinity and !*** average surface height (for variable thickness sfc layer) !*** note that it is evaluated at the current time level. !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) if (sfc_layer_type == sfc_layer_varthick) then WORK1(:,:,iblock) = merge( & TRACER(:,:,1,2,curtime,iblock)*TAREA(:,:,iblock)* & (dz(1) + PSURF(:,:,curtime,iblock)/grav), & c0, KMT(:,:,iblock) > 0 .and. MASK_SR(:,:,iblock) > 0) WORK2(:,:,iblock) = merge(PSURF(:,:,curtime,iblock)* & TAREA(:,:,iblock)/grav, c0, & KMT(:,:,iblock) > 0 .and. & MASK_SR(:,:,iblock) > 0) else WORK1(:,:,iblock) = merge(TRACER(:,:,1,2,curtime,iblock)* & TAREA(:,:,iblock)*dz(1), & c0, KMT(:,:,iblock) > 0 .and. & MASK_SR(:,:,iblock) > 0) endif end do !$OMP END PARALLEL DO vol_glob_m_marg = volume_t_k(1) - volume_t_marg_k(1) sal_final(1) = 1.0e-6_r8* & global_sum(WORK1, distrb_clinic, field_loc_center)/ & vol_glob_m_marg if (sfc_layer_type == sfc_layer_varthick) then ssh_final = 1.0e-4_r8* & global_sum(WORK2, distrb_clinic, field_loc_center)/ & area_glob_m_marg/seconds_in_year if (my_task == master_task) then write(stdout,blank_fmt) write(stdout,'(a22,1pe23.15)') & 'annual change in SSH: ', ssh_final endif ssh_final = ssh_final*10.0_r8 ! convert (cm/s) -> kg/m^2/s ! (cm/s)x0.01(m/cm)x1000kg/m^3 else ssh_final = c0 endif !*** Compute the volume-averaged salinity for each level. do k=2,km !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) if (partial_bottom_cells) then WORK1(:,:,iblock) = & merge(TRACER(:,:,k,2,curtime,iblock)* & TAREA(:,:,iblock)*DZT(:,:,k,iblock), c0, & k <= KMT(:,:,iblock) .and. & MASK_SR(:,:,iblock) > 0) else WORK1(:,:,iblock) = & merge(TRACER(:,:,k,2,curtime,iblock)* & TAREA(:,:,iblock)*dz(k), c0, & k <= KMT(:,:,iblock) .and. & MASK_SR(:,:,iblock) > 0) endif end do !$OMP END PARALLEL DO vol_glob_m_marg = volume_t_k(k) - volume_t_marg_k(k) if (vol_glob_m_marg == 0) vol_glob_m_marg = 1.e+20_r8 sal_final(k) = 1.0e-6_r8* & global_sum(WORK1, distrb_clinic, field_loc_center)/ & vol_glob_m_marg enddo !*** find annual mean precip and reset annual counters !ann_avg_fw = sum_fw / seconds_in_year !if (my_task == master_task) then ! write(stdout,blank_fmt) ! write(stdout,'(a32,1pe22.15)') & ! 'annual average freshwater flux: ', ann_avg_fw !endif !sum_fw = c0 ann_avg_precip = sum_precip / seconds_in_year sum_precip = c0 if (ladjust_precip) call precip_adjustment sal_initial = sal_final ssh_initial = ssh_final endif ! end of year calculations !----------------------------------------------------------------------- !EOC end subroutine calc_sfwf_bulk_ncep !*********************************************************************** !BOP ! !IROUTINE: calc_sfwf_partially_coupled ! !INTERFACE: subroutine calc_sfwf_partially_coupled(time_dim) ! !DESCRIPTION: ! Calculate ice-ocean flux, weak restoring, and strong restoring ! components of surface freshwater flux for partially-coupled formulation. ! these components will later be used in ! set\_surface\_forcing (forcing.F) to form the total surface freshwater ! (salt) flux. ! ! the forcing data (on t-grid) sets needed are ! sfwf\_data\_sss, restoring SSS (msu) ! sfwf\_data\_flxio, diagnosed ("climatological") (kg/m^2/s) ! ice-ocean freshwater flux ! ! !REVISION HISTORY: ! same as module ! !INPUT PARAMETERS: integer (int_kind), intent(in) :: & time_dim ! number of time points for interpolation !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & now, &! index for location of interpolated data k, n, &! dummy loop indices iblock ! block loop index real (r8) :: & dttmp, &! temporary time step variable fres_hor_ave, &! area-weighted mean of weak restoring fres_hor_area, &! total area of weak restoring area_glob_m_marg, &! total ocean area - marginal sea area vol_glob_m_marg ! total ocean volume - marginal sea volume real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: & WORK,WORK1, WORK2 ! temporary work space type(block) :: & this_block ! block info for current block !----------------------------------------------------------------------- ! ! set location where interpolated data exists. ! !----------------------------------------------------------------------- area_glob_m_marg = 1.0e-4*(area_t - area_t_marg) if (sfwf_data_type == 'annual') then now = 1 else now = 0 endif !----------------------------------------------------------------------- ! ! compute forcing terms for each block ! !----------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) if (.not. luse_cpl_ifrac) then WORK(:,:,iblock) = OCN_WGT(:,:,iblock)*MASK_SR(:,:,iblock) else WORK(:,:,iblock) = MASK_SR(:,:,iblock) endif !*** weak salinity restoring term !*** (note: MASK_SR = 0. at land and marginal-sea points) !*** will be subtracting global mean later, so compute !*** necessary terms for global mean SFWF_COMP(:,:,iblock,sfwf_comp_wrest) = & -sfwf_weak_restore*WORK(:,:,iblock)* & (SFWF_DATA(:,:,iblock,sfwf_data_sss,now) - & TRACER(:,:,1,2,curtime,iblock)) WORK1(:,:,iblock) = TAREA(:,:,iblock)* & SFWF_COMP(:,:,iblock,sfwf_comp_wrest) WORK2(:,:,iblock) = TAREA(:,:,iblock)*WORK(:,:,iblock) end do ! block loop !$OMP END PARALLEL DO !---------------------------------------------------------------------- ! ! compute global mean of weak restoring term ! !---------------------------------------------------------------------- fres_hor_ave = global_sum(WORK1, distrb_clinic, field_loc_center) fres_hor_area = global_sum(WORK2, distrb_clinic, field_loc_center) !----------------------------------------------------------------------- ! ! finish computing forcing terms for each block ! !----------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) ! subtract global mean from weak restoring term SFWF_COMP(:,:,iblock,sfwf_comp_wrest) = & SFWF_COMP(:,:,iblock,sfwf_comp_wrest) - WORK(:,:,iblock)* & fres_hor_ave/fres_hor_area where (KMT(:,:,iblock) > 0) SFWF_COMP(:,:,iblock,sfwf_comp_srest) = & -sfwf_strong_restore*(c1 - OCN_WGT(:,:,iblock))* & (SFWF_DATA(:,:,iblock,sfwf_data_sss,now) - & TRACER(:,:,1,2,curtime,iblock)) endwhere where (KMT(:,:,iblock) > 0 .and. MASK_SR(:,:,iblock) == 0) SFWF_COMP(:,:,iblock,sfwf_comp_srest) = & -sfwf_strong_restore_ms* & (SFWF_DATA(:,:,iblock,sfwf_data_sss,now) - & TRACER(:,:,1,2,curtime,iblock)) endwhere !*** ice-ocean climatological flux term if ( .not. lactive_ice ) then where (KMT(:,:,iblock) > 0) SFWF_COMP(:,:,iblock,sfwf_comp_flxio) = & (c1 - OCN_WGT(:,:,iblock))* & SFWF_DATA(:,:,iblock,sfwf_data_flxio,now) endwhere if ( .not. lms_balance ) & SFWF_COMP(:,:,iblock,sfwf_comp_flxio) = & SFWF_COMP(:,:,iblock,sfwf_comp_flxio)*MASK_SR(:,:,iblock) endif !*** convert surface freshwater flux components (kg/m^2/s) to !*** salinity flux components (msu*cm/s) SFWF_COMP(:,:,iblock,sfwf_comp_wrest) = & SFWF_COMP(:,:,iblock,sfwf_comp_wrest)*salinity_factor SFWF_COMP(:,:,iblock,sfwf_comp_srest) = & SFWF_COMP(:,:,iblock,sfwf_comp_srest)*salinity_factor if ( sfc_layer_type == sfc_layer_varthick .and. & .not. lfw_as_salt_flx) then WORK(:,:,iblock) = fwmass_to_fwflux * & SFWF_COMP(:,:,iblock,sfwf_comp_flxio) SFWF_COMP(:,:,iblock,sfwf_comp_flxio) = WORK(:,:,iblock) call tmelt(WORK1(:,:,iblock),TRACER(:,:,1,2,curtime,iblock)) TFW_COMP(:,:,1, iblock,tfw_comp_flxio) = WORK(:,:,iblock)* & WORK1(:,:,iblock) TFW_COMP(:,:,2:nt,iblock,tfw_comp_flxio) = c0 else SFWF_COMP(:,:,iblock,sfwf_comp_flxio) = salinity_factor* & SFWF_COMP(:,:,iblock,sfwf_comp_flxio) endif end do ! block loop !$OMP END PARALLEL DO !----------------------------------------------------------------------- ! ! Perform end of year adjustment calculations ! !----------------------------------------------------------------------- if (eoy) then !*** Compute the surface volume-averaged salinity and !*** average surface height (for variable thickness sfc layer) !*** note that it is evaluated at the current time level. !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) if (sfc_layer_type == sfc_layer_varthick) then WORK1(:,:,iblock) = merge( & TRACER(:,:,1,2,curtime,iblock)*TAREA(:,:,iblock)* & (dz(1) + PSURF(:,:,curtime,iblock)/grav), & c0, KMT(:,:,iblock) > 0 .and. MASK_SR(:,:,iblock) > 0) WORK2(:,:,iblock) = merge(PSURF(:,:,curtime,iblock)* & TAREA(:,:,iblock)/grav, c0, & KMT(:,:,iblock) > 0 .and. & MASK_SR(:,:,iblock) > 0) else WORK1(:,:,iblock) = merge(TRACER(:,:,1,2,curtime,iblock)* & TAREA(:,:,iblock)*dz(1), & c0, KMT(:,:,iblock) > 0 .and. & MASK_SR(:,:,iblock) > 0) endif end do !$OMP END PARALLEL DO vol_glob_m_marg = 1.0e-6_r8*(volume_t_k(1) - volume_t_marg_k(1)) sal_final(1) = 1.0e-6_r8* &! convert to m^3 global_sum(WORK1,distrb_clinic,field_loc_center)/vol_glob_m_marg if (sfc_layer_type == sfc_layer_varthick) then ssh_final = 1.0e-4_r8* &! convert to m^3 global_sum(WORK2, distrb_clinic, field_loc_center)/ & area_glob_m_marg/seconds_in_year if (my_task == master_task) then write(stdout,blank_fmt) write(stdout,'(a22,1pe23.15)') & 'annual change in SSH: ', ssh_final endif ssh_final = ssh_final*10.0_r8 ! convert (cm/s) -> kg/m^2/s ! (cm/s)x0.01(m/cm)x1000kg/m^3 else ssh_final = c0 endif !*** Compute the volume-averaged salinity for each level. do k=2,km !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) if (partial_bottom_cells) then WORK1(:,:,iblock) = & merge(TRACER(:,:,k,2,curtime,iblock)* & TAREA(:,:,iblock)*DZT(:,:,k,iblock), c0, & k <= KMT(:,:,iblock) .and. & MASK_SR(:,:,iblock) > 0) else WORK1(:,:,iblock) = & merge(TRACER(:,:,k,2,curtime,iblock)* & TAREA(:,:,iblock)*dz(k), c0, & k <= KMT(:,:,iblock) .and. & MASK_SR(:,:,iblock) > 0) endif end do !$OMP END PARALLEL DO vol_glob_m_marg = 1.0e-6_r8*(volume_t_k(k) - volume_t_marg_k(k)) if (vol_glob_m_marg == 0) vol_glob_m_marg = 1.e+20_r8 sal_final(k) = 1.0e-6_r8* &! convert to m^3 global_sum(WORK1,distrb_clinic,field_loc_center)/vol_glob_m_marg enddo if (ladjust_precip) call precip_adjustment sal_initial = sal_final ssh_initial = ssh_final endif ! end of year calculations !----------------------------------------------------------------------- !EOC end subroutine calc_sfwf_partially_coupled !*********************************************************************** !BOP ! !IROUTINE: precip_adjustment ! !INTERFACE: subroutine precip_adjustment ! !DESCRIPTION: ! Computes a precipitation factor to multiply the fresh water flux ! due to precipitation uniformly to insure a balance of fresh water ! at the ocean surface. ! ! !REVISION HISTORY: ! same as module !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- real (r8) :: & sal_tendency, fw_tendency, precip_tav, & area_glob_m_marg, &! global ocean area - marginal sea area (cm^2) vol_glob_m_marg ! global ocean vol - marginal sea vol (cm^3) integer (int_kind) :: k !----------------------------------------------------------------------- ! ! compute tendency of salinity for eack "k" layer, considering the ! effects of depth acceleration ! !----------------------------------------------------------------------- do k=1,km sal_initial(k) = (sal_final(k) - sal_initial(k))/ & (dttxcel(k)*seconds_in_year) enddo !----------------------------------------------------------------------- ! ! form the global volume-averaged tendency to be used in "precip_fact" ! computation ! !----------------------------------------------------------------------- sal_tendency = c0 do k=1,km vol_glob_m_marg = 1.0e-6_r8*(volume_t_k(k) - volume_t_marg_k(k)) sal_tendency = sal_tendency + vol_glob_m_marg*sal_initial(k) enddo vol_glob_m_marg = 1.0e-6_r8*(volume_t - volume_t_marg) sal_tendency = sal_tendency/vol_glob_m_marg if (my_task == master_task) then write (stdout,'(a58,1pe22.15)') & ' precip_adjustment: volume-averaged salinity tendency = ', & sal_tendency endif !----------------------------------------------------------------------- ! ! convert "sal_tendency" from (msu/s) to -(kg/m^2/s). note that ! areag in cm^2 and volgt in cm^3 ! assumes density of fresh water = 1000 kg/m**3 ! !----------------------------------------------------------------------- area_glob_m_marg = 1.0e-4*(area_t - area_t_marg) sal_tendency = - sal_tendency*vol_glob_m_marg* & 1.0e6_r8/area_glob_m_marg/ocn_ref_salinity !----------------------------------------------------------------------- ! ! compute annual change in mass due to freshwater flux (kg/m^2/s) ! !----------------------------------------------------------------------- fw_tendency = ssh_final - ssh_initial if (my_task == master_task) then write (stdout,'(a22)') ' precip_adjustment: ' write (stdout,'(a28,1pe22.15)') ' sal_tendency (kg/m^2/s): ', & sal_tendency write (stdout,'(a28,1pe22.15)') ' fw_tendency (kg/m^2/s): ', & fw_tendency endif !----------------------------------------------------------------------- ! ! change "precip_fact" based on tendency of freshwater and previous ! amount of precipitation ! !----------------------------------------------------------------------- if (sfwf_formulation == 'partially-coupled') then precip_tav = precip_mean else precip_tav = ann_avg_precip/precip_fact endif precip_fact = precip_fact - & (sal_tendency + fw_tendency)/precip_tav if (my_task == master_task) then write (stdout,'(a33,e14.8)') ' Changed precipitation factor to ',& precip_fact endif !----------------------------------------------------------------------- !EOC end subroutine precip_adjustment !*********************************************************************** end module forcing_sfwf !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| CESM2.1.3_sourcemods/PaxHeaders.32795/forcing_sfwf.F900000644000000000000000000000012313774500023017135 xustar0027 mtime=1609728019.303459 26 atime=1609728019.29122 30 ctime=1609728019.302985369 CESM2.1.3_sourcemods/forcing_sfwf.F900000644006307300017500000023205513774500023017524 0ustar00islasncar00000000000000!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| module forcing_sfwf ! CMB added option for formulation to be hosing, which can be used in ! coupled mode ! Testing gave bfb with not hosed run, when namelist was set to hose ! but hosing input file had all zeros. ! Important because the namelist variables are fussy and have ! potential interdependency. ! Be sure you do not hose in the marginal seas !!! ! The model does some correcting of the net fw flux to ! ensure freshwater balance in each of the marginal seas (see set_forcing_coupled) ! I do this BEFORE hosing. So hosing if in the marginal ! seas will destroy balance. !BOP ! !MODULE: forcing_sfwf ! !DESCRIPTION: ! Contains routines and variables used for determining the ! surface fresh water flux. ! ! !REVISION HISTORY: ! SVN:$Id$ ! ! !USES: use kinds_mod use blocks use distribution use domain use constants use io use grid use global_reductions use forcing_tools use forcing_shf use ice use time_management use prognostic use exit_mod implicit none private save ! !PUBLIC MEMBER FUNCTIONS: public :: init_sfwf, & set_sfwf ! !PUBLIC DATA MEMBERS: real (r8), public, allocatable, dimension(:,:,:,:) :: & SFWF_COMP real (r8), public, allocatable, dimension(:,:,:,:,:) :: & TFW_COMP real (r8), public :: &! public for use in restart sfwf_interp_last ! time when last interpolation was done !*** water balance factors for bulk-NCEP forcing real (r8), public :: &! public for use in restart sum_precip, &! global precip for water balance hosing_fact = c1, &! factor for adjusting hosing for water balance precip_fact = c1, &! factor for adjusting precip for water balance precip_fact_const,&! value used for precip_fact when ladjust_precip=.false. ssh_initial ! initial ssh real (r8), dimension(km), public :: & sal_initial logical (log_kind), public :: & lfw_as_salt_flx ! treat fw flux as virtual salt flux ! even with var.thickness sfc layer logical (log_kind), public :: & lsend_precip_fact ! if T,send precip_fact to cpl for use in fw balance ! (partially-coupled option) !EOP !BOC !----------------------------------------------------------------------- ! ! module variables ! !----------------------------------------------------------------------- real (r8), allocatable, dimension(:,:,:,:,:) :: & SFWF_DATA ! forcing data used to get SFWF real (r8), dimension(12) :: & sfwf_data_time ! time (hours) corresponding to surface fresh ! water fluxes real (r8), dimension(20) :: & sfwf_data_renorm ! factors for converting to model units real (r8) :: & sfwf_data_inc, &! time increment between values of forcing data sfwf_data_next, &! time to be used for next value of forcing data sfwf_data_update, &! time new forcing data needs to be added to interpolation set sfwf_interp_inc, &! time increment between interpolation sfwf_interp_next, &! time when next interpolation will be done sfwf_restore_tau, &! restoring time scale sfwf_restore_rtau, &! reciprocal of restoring time scale sfwf_weak_restore, &! sfwf_strong_restore, &! sfwf_strong_restore_ms ! integer (int_kind) :: & sfwf_interp_order, &! order of temporal interpolation sfwf_data_time_min_loc, &! time index for first SFWF_DATA point sfwf_data_num_fields integer (int_kind), public :: & sfwf_num_comps character (char_len), dimension(:), allocatable :: & sfwf_data_names ! short names for input data fields integer (int_kind), dimension(:), allocatable :: & sfwf_bndy_loc, &! location and field types for ghost sfwf_bndy_type ! cell update routines !*** integer addresses for various forcing data fields integer (int_kind) :: & ! restoring and partially-coupled options sfwf_data_sss integer (int_kind), public :: &! bulk-NCEP and partially-coupled (some) options sfwf_data_precip, & sfwf_comp_precip, & sfwf_comp_evap, & sfwf_comp_wrest, & sfwf_comp_srest integer (int_kind), public :: &! hosing options sfwf_data_hosing, & sfwf_comp_hosing real (r8) :: & ann_avg_precip, &! !sum_fw, &! !ann_avg_fw, &! ssh_final real (r8), dimension (km) :: & sal_final logical (log_kind) :: & ladjust_precip integer (int_kind),public :: &! used with the partially-coupled option sfwf_comp_cpl, & sfwf_data_flxio, & sfwf_comp_flxio, & tfw_num_comps, & tfw_comp_cpl, & tfw_comp_flxio real (r8), parameter :: & precip_mean = 3.4e-5_r8 character (char_len) :: & sfwf_filename, &! name of file conainting forcing data sfwf_file_fmt, &! format (bin or netcdf) of forcing file sfwf_interp_freq, &! keyword for period of temporal interpolation sfwf_interp_type, &! sfwf_data_label, & sfwf_string !general purpose character string private to module character (char_len),public :: & sfwf_data_type, &! keyword for period of forcing data sfwf_formulation logical (log_kind), public :: & lms_balance ! control balancing of P,E,M,R,S in marginal seas ! .T. only with sfc_layer_oldfree option !EOC !*********************************************************************** contains !*********************************************************************** !BOP ! !IROUTINE: init_sfwf ! !INTERFACE: subroutine init_sfwf(STF) ! !DESCRIPTION: ! Initializes surface fresh water flux forcing by either calculating ! or reading in the surface fresh water flux. Also does initial ! book-keeping concerning when new data is needed for the temporal ! interpolation and when the forcing will need to be updated. ! ! !REVISION HISTORY: ! same as module ! !INPUT/OUTPUT PARAMETERS: real (r8), dimension(nx_block,ny_block,nt,max_blocks_clinic), & intent(inout) :: & STF ! surface tracer fluxes at current timestep !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer(int_kind) :: & k, n, &! dummy loop indices iblock, &! block loop index nml_error ! namelist error flag character (char_len) :: & forcing_filename ! full filename for forcing input logical (log_kind) :: & lprintsalinitial = .false. real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: & WORK ! temporary work space real (r8), dimension(:,:,:,:,:), target, allocatable :: & TEMP_DATA ! temporary array for reading monthly data type (block) :: & this_block ! block info for local block type (datafile) :: & forcing_file ! data file structure for input forcing file type (io_field_desc) :: & io_sss, &! io field descriptor for input sss field io_hosing, &! io field descriptor for input hosing field io_precip, &! io field descriptor for input precip field io_flxio ! io field descriptor for input io_flxio field type (io_dim) :: & i_dim, j_dim, &! dimension descriptors for horiz dimensions month_dim ! dimension descriptor for monthly data namelist /forcing_sfwf_nml/ sfwf_data_type, sfwf_data_inc, & sfwf_interp_type, sfwf_interp_freq, & sfwf_interp_inc, sfwf_restore_tau, & sfwf_filename, sfwf_file_fmt, & sfwf_data_renorm, sfwf_formulation, & ladjust_precip, sfwf_weak_restore,& sfwf_strong_restore, lfw_as_salt_flx, & sfwf_strong_restore_ms, & lsend_precip_fact, lms_balance, & precip_fact_const !----------------------------------------------------------------------- ! ! read surface fresh water flux namelist input after setting ! default values. ! !----------------------------------------------------------------------- if (my_task == master_task) then write(stdout,'(a70)') & ' CMB added a new sfwf type called hosing, be sure to use it' endif ! CMB Note that turning the data_type to anything but 'none' turns on ! CMB the code here. It would be bad to have ! CMB the formulation be anything but 'hosing' when running coupled!!! ! CMB Note that hosing formumation does not use the data_renorm or any variable ! CMB with restore in it, make them one or zero for safety sake. ! CMB Model code ships with these here set to POP defaults and then practice has ! CMB been to change to CCSM defaults and customize for given run in the namelist ! CMB I changed to make these the CCSM defaults and customize for hosing here. ! CMB The namelist is still read after this and can alter these defaults sfwf_formulation = 'hosing' sfwf_data_type = 'monthly' sfwf_data_inc = 1.e20_r8 ! CMB not used if data_type is monthly sfwf_interp_type = 'linear' ! CMB interpolation in time sfwf_interp_freq = 'every-timestep' ! CMB how oftern to interpolate in time sfwf_interp_inc = 1.e20_r8 ! CMB not used if doing every-timestep sfwf_restore_tau = 1.e20_r8 ! CMB not used if 'hosing' sfwf_filename = 'sfwftest2deg' sfwf_file_fmt = 'nc' sfwf_data_renorm = c1 !sfwf_data_renorm = 1.e-3_r8 ! convert from psu to msu ladjust_precip = .false. ! CMB balances P globally, .false. in CCSM coupled default lms_balance = .true. ! CMB balance P,E,M,R,S in marginal seas, .true. in CCSM coupled default sfwf_weak_restore = 0.0_r8 ! CMB make these zero to stop any restoring sfwf_strong_restore_ms = 0.0_r8 sfwf_strong_restore = 0.0_r8 lfw_as_salt_flx = .true. ! CMB makes all fw fluxes a virtual salt flux, .true. in ccsm namelist lsend_precip_fact = .false. ! CMB this does nothing, might as well be false. supposed to be ! a parameter sent by coupler when true precip_fact_const = c1 ! !!!IRS, this wasn't in CESM1 - will it mess up pacemaker?? if (my_task == master_task) then open (nml_in, file=nml_filename, status='old',iostat=nml_error) if (nml_error /= 0) then nml_error = -1 else nml_error = 1 endif do while (nml_error > 0) read(nml_in, nml=forcing_sfwf_nml,iostat=nml_error) end do if (nml_error == 0) close(nml_in) endif call broadcast_scalar(nml_error, master_task) if (nml_error /= 0) then call exit_POP(sigAbort,'ERROR reading forcing_sfwf_nml') endif call broadcast_scalar(sfwf_data_type, master_task) call broadcast_scalar(sfwf_data_inc, master_task) call broadcast_scalar(sfwf_interp_type, master_task) call broadcast_scalar(sfwf_interp_freq, master_task) call broadcast_scalar(sfwf_interp_inc, master_task) call broadcast_scalar(sfwf_restore_tau, master_task) call broadcast_scalar(sfwf_filename, master_task) call broadcast_scalar(sfwf_file_fmt, master_task) call broadcast_scalar(sfwf_formulation, master_task) call broadcast_array (sfwf_data_renorm, master_task) call broadcast_scalar(ladjust_precip, master_task) call broadcast_scalar(sfwf_weak_restore, master_task) call broadcast_scalar(sfwf_strong_restore, master_task) call broadcast_scalar(sfwf_strong_restore_ms, master_task) call broadcast_scalar(lfw_as_salt_flx, master_task) call broadcast_scalar(lsend_precip_fact, master_task) call broadcast_scalar(lms_balance, master_task) call broadcast_scalar(precip_fact_const, master_task) !----------------------------------------------------------------------- ! ! set precip_fact if ladjust_precip=.false. ! !----------------------------------------------------------------------- if (.not. ladjust_precip) then precip_fact = precip_fact_const call document ('init_sfwf', 'setting precip_fact to precip_fact_const') call document ('init_sfwf', 'precip_fact', precip_fact) endif !----------------------------------------------------------------------- ! ! convert data_type to 'monthly-calendar' if input is 'monthly' ! !----------------------------------------------------------------------- if (sfwf_data_type == 'monthly') sfwf_data_type = 'monthly-calendar' !----------------------------------------------------------------------- ! ! set values based on sfwf_formulation ! !----------------------------------------------------------------------- select case (sfwf_formulation) case ('restoring') allocate(sfwf_data_names(1), & sfwf_bndy_loc (1), & sfwf_bndy_type (1)) sfwf_data_num_fields = 1 sfwf_data_sss = 1 sfwf_data_names(sfwf_data_sss) = 'SSS' sfwf_bndy_loc (sfwf_data_sss) = field_loc_center sfwf_bndy_type (sfwf_data_sss) = field_type_scalar case ('bulk-NCEP') sfwf_data_num_fields = 2 sfwf_data_sss = 1 sfwf_data_precip = 2 allocate(sfwf_data_names(sfwf_data_num_fields), & sfwf_bndy_loc (sfwf_data_num_fields), & sfwf_bndy_type (sfwf_data_num_fields)) sfwf_data_names(sfwf_data_sss) = 'SSS' sfwf_bndy_loc (sfwf_data_sss) = field_loc_center sfwf_bndy_type (sfwf_data_sss) = field_type_scalar sfwf_data_names(sfwf_data_precip) = 'PRECIPITATION' sfwf_bndy_loc (sfwf_data_precip) = field_loc_center sfwf_bndy_type (sfwf_data_precip) = field_type_scalar sfwf_num_comps = 4 sfwf_comp_precip = 1 sfwf_comp_evap = 2 sfwf_comp_wrest = 3 sfwf_comp_srest = 4 case ('hosing') sfwf_data_num_fields = 1 sfwf_data_hosing = 1 sfwf_num_comps = 2 sfwf_comp_hosing = 1 ! put the hosing stuff in this index of SFWF_COMP sfwf_comp_cpl = 2 ! put the cpl stuff in this index of SFWF_COMP allocate(sfwf_data_names(sfwf_data_num_fields), & sfwf_bndy_loc (sfwf_data_num_fields), & sfwf_bndy_type (sfwf_data_num_fields)) sfwf_data_names(sfwf_data_hosing) = 'HOSING' ! CMB I think this sets up the variable name for nc file sfwf_bndy_loc (sfwf_data_hosing) = field_loc_center sfwf_bndy_type (sfwf_data_hosing) = field_type_scalar case ('partially-coupled') sfwf_data_num_fields = 2 sfwf_data_sss = 1 sfwf_data_flxio = 2 allocate(sfwf_data_names(sfwf_data_num_fields), & sfwf_bndy_loc (sfwf_data_num_fields), & sfwf_bndy_type (sfwf_data_num_fields)) sfwf_data_names(sfwf_data_sss) = 'SSS' sfwf_bndy_loc (sfwf_data_sss) = field_loc_center sfwf_bndy_type (sfwf_data_sss) = field_type_scalar sfwf_data_names(sfwf_data_flxio) = 'FLXIO' sfwf_bndy_loc (sfwf_data_flxio) = field_loc_center sfwf_bndy_type (sfwf_data_flxio) = field_type_scalar sfwf_num_comps = 4 sfwf_comp_wrest = 1 sfwf_comp_srest = 2 sfwf_comp_cpl = 3 sfwf_comp_flxio = 4 tfw_num_comps = 2 tfw_comp_cpl = 1 tfw_comp_flxio = 2 case default call exit_POP(sigAbort, & 'init_sfwf: Unknown value for sfwf_formulation') end select if ( sfwf_formulation == 'bulk-NCEP' .or. & sfwf_formulation == 'partially-coupled' ) then !*** calculate initial salinity profile for ocean points that are !*** not marginal seas. !*** very first step of run if (ladjust_precip .and. nsteps_total == 0) then sum_precip = c0 ssh_initial = c0 !sum_fw = c0 do k = 1,km !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) if (partial_bottom_cells) then WORK(:,:,iblock) = & merge(TRACER(:,:,k,2,curtime,iblock)* & TAREA(:,:,iblock)*DZT(:,:,k,iblock), & c0, k <= KMT(:,:,iblock) .and. & MASK_SR(:,:,iblock) > 0) else WORK(:,:,iblock) = & merge(TRACER(:,:,k,2,curtime,iblock)* & TAREA(:,:,iblock)*dz(k), & c0, k <= KMT(:,:,iblock) .and. & MASK_SR(:,:,iblock) > 0) endif end do !$OMP END PARALLEL DO sal_initial(k) = global_sum(WORK,distrb_clinic,field_loc_center)/ & (volume_t_k(k) - volume_t_marg_k(k)) ! in m^3 enddo endif endif !*** document sal_initial if (lprintsalinitial) then do k = 1,km write(sfwf_string,'(a,i3,a)') 'sal_initial(',k,')' call document ('init_sfwf', trim(sfwf_string), sal_initial(k)) enddo endif !----------------------------------------------------------------------- ! ! calculate inverse of restoring time scale and convert to seconds. ! !----------------------------------------------------------------------- sfwf_restore_rtau = c1/(seconds_in_day*sfwf_restore_tau) !----------------------------------------------------------------------- ! ! convert interp_type to corresponding integer value. ! !----------------------------------------------------------------------- select case (sfwf_interp_type) case ('nearest') sfwf_interp_order = 1 case ('linear') sfwf_interp_order = 2 case ('4point') sfwf_interp_order = 4 case default call exit_POP(sigAbort, & 'init_sfwf: Unknown value for sfwf_interp_type') end select !----------------------------------------------------------------------- ! ! set values of the surface fresh water flux arrays (SFWF or ! SFWF_DATA) depending on type of the surface fresh water flux ! data. ! !----------------------------------------------------------------------- select case (sfwf_data_type) !----------------------------------------------------------------------- ! ! no surface fresh water flux, therefore no interpolation in time ! is needed (sfwf_interp_freq = 'none'), nor are there any new ! values to be used (sfwf_data_next = sfwf_data_update = never). ! !----------------------------------------------------------------------- case ('none') STF(:,:,2,:) = c0 sfwf_data_next = never sfwf_data_update = never sfwf_interp_freq = 'never' !----------------------------------------------------------------------- ! ! simple analytic surface salinity that is constant in time, ! therefore no new values will be needed. ! !----------------------------------------------------------------------- case ('analytic') allocate(SFWF_DATA(nx_block,ny_block,max_blocks_clinic, & sfwf_data_num_fields,1)) SFWF_DATA = c0 select case (sfwf_formulation) case ('restoring') SFWF_DATA(:,:,:,sfwf_data_sss,1) = 0.035_r8 end select sfwf_data_next = never sfwf_data_update = never sfwf_interp_freq = 'never' !----------------------------------------------------------------------- ! ! annual mean climatological surface salinity (read in from a file) ! that is constant in time, therefore no new values will be needed. ! !----------------------------------------------------------------------- case ('annual') allocate(SFWF_DATA(nx_block,ny_block,max_blocks_clinic, & sfwf_data_num_fields,1)) SFWF_DATA = c0 forcing_file = construct_file(sfwf_file_fmt, & full_name=trim(sfwf_filename), & record_length = rec_type_dbl, & recl_words=nx_global*ny_global) call data_set(forcing_file,'open_read') i_dim = construct_io_dim('i',nx_global) j_dim = construct_io_dim('j',nx_global) select case (sfwf_formulation) case ('hosing') io_hosing = construct_io_field( & trim(sfwf_data_names(sfwf_data_hosing)), & dim1=i_dim, dim2=j_dim, & field_loc = sfwf_bndy_loc(sfwf_data_hosing), & field_type = sfwf_bndy_type(sfwf_data_hosing), & d2d_array=SFWF_DATA(:,:,:,sfwf_data_hosing,1)) call data_set(forcing_file,'define',io_hosing) call data_set(forcing_file,'read' ,io_hosing) call destroy_io_field(io_hosing) allocate( SFWF_COMP(nx_block,ny_block,max_blocks_clinic, & sfwf_num_comps)) SFWF_COMP = c0 ! initialize case ('restoring') io_sss = construct_io_field( & trim(sfwf_data_names(sfwf_data_sss)), & dim1=i_dim, dim2=j_dim, & field_loc = sfwf_bndy_loc(sfwf_data_sss), & field_type = sfwf_bndy_type(sfwf_data_sss), & d2d_array=SFWF_DATA(:,:,:,sfwf_data_sss,1)) call data_set(forcing_file,'define',io_sss) call data_set(forcing_file,'read' ,io_sss) call destroy_io_field(io_sss) case ('bulk-NCEP') io_sss = construct_io_field( & trim(sfwf_data_names(sfwf_data_sss)), & dim1=i_dim, dim2=j_dim, & field_loc = sfwf_bndy_loc(sfwf_data_sss), & field_type = sfwf_bndy_type(sfwf_data_sss), & d2d_array=SFWF_DATA(:,:,:,sfwf_data_sss,1)) io_precip = construct_io_field( & trim(sfwf_data_names(sfwf_data_precip)), & dim1=i_dim, dim2=j_dim, & field_loc = sfwf_bndy_loc(sfwf_data_precip), & field_type = sfwf_bndy_type(sfwf_data_precip), & d2d_array=SFWF_DATA(:,:,:,sfwf_data_precip,1)) call data_set(forcing_file,'define',io_sss) call data_set(forcing_file,'define',io_precip) call data_set(forcing_file,'read' ,io_sss) call data_set(forcing_file,'read' ,io_precip) call destroy_io_field(io_sss) call destroy_io_field(io_precip) allocate( SFWF_COMP(nx_block,ny_block,max_blocks_clinic, & sfwf_num_comps)) SFWF_COMP = c0 ! initialize case ('partially-coupled') io_sss = construct_io_field( & trim(sfwf_data_names(sfwf_data_sss)), & dim1=i_dim, dim2=j_dim, & field_loc = sfwf_bndy_loc(sfwf_data_sss), & field_type = sfwf_bndy_type(sfwf_data_sss), & d2d_array=SFWF_DATA(:,:,:,sfwf_data_sss,1)) io_flxio = construct_io_field( & trim(sfwf_data_names(sfwf_data_flxio)), & dim1=i_dim, dim2=j_dim, & field_loc = sfwf_bndy_loc(sfwf_data_flxio), & field_type = sfwf_bndy_type(sfwf_data_flxio), & d2d_array=SFWF_DATA(:,:,:,sfwf_data_flxio,1)) call data_set(forcing_file,'define',io_sss) call data_set(forcing_file,'define',io_flxio) call data_set(forcing_file,'read' ,io_sss) call data_set(forcing_file,'read' ,io_flxio) call destroy_io_field(io_sss) call destroy_io_field(io_flxio) allocate( SFWF_COMP(nx_block,ny_block,max_blocks_clinic, & sfwf_num_comps)) SFWF_COMP = c0 ! initialize end select call data_set(forcing_file,'close') call destroy_file(forcing_file) !*** renormalize values if necessary to compensate for !*** different units. do n = 1,sfwf_data_num_fields if (sfwf_data_renorm(n) /= c1) SFWF_DATA(:,:,:,n,:) = & sfwf_data_renorm(n)*SFWF_DATA(:,:,:,n,:) enddo sfwf_data_next = never sfwf_data_update = never sfwf_interp_freq = 'never' if (my_task == master_task) then write(stdout,blank_fmt) write(stdout,'(a25,a)') ' SFWF Annual file read: ', & trim(sfwf_filename) endif !----------------------------------------------------------------------- ! ! monthly mean climatological surface fresh water flux. all ! 12 months are read in from a file. interpolation order ! (sfwf_interp_order) may be specified with namelist input. ! !----------------------------------------------------------------------- case ('monthly-equal','monthly-calendar') allocate(SFWF_DATA(nx_block,ny_block,max_blocks_clinic, & sfwf_data_num_fields,0:12), & TEMP_DATA(nx_block,ny_block,12,max_blocks_clinic, & sfwf_data_num_fields) ) SFWF_DATA = c0 call find_forcing_times(sfwf_data_time, sfwf_data_inc, & sfwf_interp_type, sfwf_data_next, & sfwf_data_time_min_loc, & sfwf_data_update, sfwf_data_type) forcing_file = construct_file(sfwf_file_fmt, & full_name=trim(sfwf_filename), & record_length = rec_type_dbl, & recl_words=nx_global*ny_global) call data_set(forcing_file,'open_read') i_dim = construct_io_dim('i',nx_global) j_dim = construct_io_dim('j',nx_global) month_dim = construct_io_dim('month',12) select case (sfwf_formulation) case ('hosing') io_hosing = construct_io_field( & trim(sfwf_data_names(sfwf_data_hosing)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = sfwf_bndy_loc(sfwf_data_hosing), & field_type = sfwf_bndy_type(sfwf_data_hosing), & d3d_array=TEMP_DATA(:,:,:,:,sfwf_data_hosing)) call data_set(forcing_file,'define',io_hosing) call data_set(forcing_file,'read' ,io_hosing) call destroy_io_field(io_hosing) allocate( SFWF_COMP(nx_block,ny_block,max_blocks_clinic, & sfwf_num_comps)) SFWF_COMP = c0 ! initialize case ('restoring') io_sss = construct_io_field( & trim(sfwf_data_names(sfwf_data_sss)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = sfwf_bndy_loc(sfwf_data_sss), & field_type = sfwf_bndy_type(sfwf_data_sss), & d3d_array=TEMP_DATA(:,:,:,:,sfwf_data_sss)) call data_set(forcing_file,'define',io_sss) call data_set(forcing_file,'read' ,io_sss) call destroy_io_field(io_sss) case ('bulk-NCEP') io_sss = construct_io_field( & trim(sfwf_data_names(sfwf_data_sss)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = sfwf_bndy_loc(sfwf_data_sss), & field_type = sfwf_bndy_type(sfwf_data_sss), & d3d_array=TEMP_DATA(:,:,:,:,sfwf_data_sss)) io_precip = construct_io_field( & trim(sfwf_data_names(sfwf_data_precip)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = sfwf_bndy_loc(sfwf_data_precip), & field_type = sfwf_bndy_type(sfwf_data_precip), & d3d_array=TEMP_DATA(:,:,:,:,sfwf_data_precip)) call data_set(forcing_file,'define',io_sss) call data_set(forcing_file,'define',io_precip) call data_set(forcing_file,'read' ,io_sss) call data_set(forcing_file,'read' ,io_precip) call destroy_io_field(io_sss) call destroy_io_field(io_precip) allocate(SFWF_COMP(nx_block,ny_block,max_blocks_clinic, & sfwf_num_comps)) SFWF_COMP = c0 ! initialize case ('partially-coupled') io_sss = construct_io_field( & trim(sfwf_data_names(sfwf_data_sss)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = sfwf_bndy_loc(sfwf_data_sss), & field_type = sfwf_bndy_type(sfwf_data_sss), & d3d_array=TEMP_DATA(:,:,:,:,sfwf_data_sss)) io_flxio = construct_io_field( & trim(sfwf_data_names(sfwf_data_flxio )), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = sfwf_bndy_loc(sfwf_data_flxio ), & field_type = sfwf_bndy_type(sfwf_data_flxio ), & d3d_array=TEMP_DATA(:,:,:,:,sfwf_data_flxio )) call data_set(forcing_file,'define',io_sss) call data_set(forcing_file,'define',io_flxio ) call data_set(forcing_file,'read' ,io_sss) call data_set(forcing_file,'read' ,io_flxio ) call destroy_io_field(io_sss) call destroy_io_field(io_flxio ) allocate(SFWF_COMP(nx_block,ny_block,max_blocks_clinic, & sfwf_num_comps)) SFWF_COMP = c0 ! initialize end select call data_set(forcing_file,'close') call destroy_file(forcing_file) !*** re-order data and renormalize values if necessary to !*** compensate for different units. !$OMP PARALLEL DO PRIVATE(iblock, k, n) do iblock=1,nblocks_clinic do k=1,sfwf_data_num_fields if (sfwf_data_renorm(k) /= c1) then do n=1,12 SFWF_DATA(:,:,iblock,k,n) = & TEMP_DATA(:,:,n,iblock,k)*sfwf_data_renorm(k) end do else do n=1,12 SFWF_DATA(:,:,iblock,k,n) = TEMP_DATA(:,:,n,iblock,k) end do endif end do end do !$OMP END PARALLEL DO deallocate(TEMP_DATA) if (my_task == master_task) then write(stdout,blank_fmt) write(stdout,'(a25,a)') ' SFWF Monthly file read: ', & trim(sfwf_filename) endif !----------------------------------------------------------------------- ! ! surface salinity specified every n-hours, where the n-hour ! increment should be specified with namelist input ! (sfwf_data_inc). only as many times as are necessary based on ! the order of the temporal interpolation scheme ! (sfwf_interp_order) reside in memory at any given time. ! !----------------------------------------------------------------------- case ('n-hour') ! CMB WARNING, hosing cannot be n-hour allocate( SFWF_DATA(nx_block,ny_block,max_blocks_clinic, & sfwf_data_num_fields,0:sfwf_interp_order)) SFWF_DATA = c0 call find_forcing_times(sfwf_data_time, sfwf_data_inc, & sfwf_interp_type, sfwf_data_next, & sfwf_data_time_min_loc, & sfwf_data_update, sfwf_data_type) do n=1,sfwf_interp_order call get_forcing_filename(forcing_filename, sfwf_filename, & sfwf_data_time(n), sfwf_data_inc) forcing_file = construct_file(sfwf_file_fmt, & full_name=trim(sfwf_filename), & record_length = rec_type_dbl, & recl_words=nx_global*ny_global) call data_set(forcing_file,'open_read') i_dim = construct_io_dim('i',nx_global) j_dim = construct_io_dim('j',nx_global) select case (sfwf_formulation) case ('hosing') call exit_POP(sigAbort, 'swfw_formulation type hosing is not ' /& &/ 'coded to allow data_type of n-hour ' ) case ('restoring') io_sss = construct_io_field( & trim(sfwf_data_names(sfwf_data_sss)), & dim1=i_dim, dim2=j_dim, & field_loc = sfwf_bndy_loc(sfwf_data_sss), & field_type = sfwf_bndy_type(sfwf_data_sss), & d2d_array=SFWF_DATA(:,:,:,sfwf_data_sss,n)) call data_set(forcing_file,'define',io_sss) call data_set(forcing_file,'read' ,io_sss) call destroy_io_field(io_sss) case ('bulk-NCEP') io_sss = construct_io_field( & trim(sfwf_data_names(sfwf_data_sss)), & dim1=i_dim, dim2=j_dim, & field_loc = sfwf_bndy_loc(sfwf_data_sss), & field_type = sfwf_bndy_type(sfwf_data_sss), & d2d_array=SFWF_DATA(:,:,:,sfwf_data_sss,n)) io_precip = construct_io_field( & trim(sfwf_data_names(sfwf_data_precip)), & dim1=i_dim, dim2=j_dim, & field_loc = sfwf_bndy_loc(sfwf_data_precip), & field_type = sfwf_bndy_type(sfwf_data_precip), & d2d_array=SFWF_DATA(:,:,:,sfwf_data_precip,n)) call data_set(forcing_file,'define',io_sss) call data_set(forcing_file,'define',io_precip) call data_set(forcing_file,'read' ,io_sss) call data_set(forcing_file,'read' ,io_precip) call destroy_io_field(io_sss) call destroy_io_field(io_precip) case ('partially-coupled') io_sss = construct_io_field( & trim(sfwf_data_names(sfwf_data_sss)), & dim1=i_dim, dim2=j_dim, & field_loc = sfwf_bndy_loc(sfwf_data_sss), & field_type = sfwf_bndy_type(sfwf_data_sss), & d2d_array=SFWF_DATA(:,:,:,sfwf_data_sss,n)) io_flxio = construct_io_field( & trim(sfwf_data_names(sfwf_data_flxio )), & dim1=i_dim, dim2=j_dim, & field_loc = sfwf_bndy_loc(sfwf_data_flxio ), & field_type = sfwf_bndy_type(sfwf_data_flxio ), & d2d_array=SFWF_DATA(:,:,:,sfwf_data_flxio ,n)) call data_set(forcing_file,'define',io_sss) call data_set(forcing_file,'define',io_flxio ) call data_set(forcing_file,'read' ,io_sss) call data_set(forcing_file,'read' ,io_flxio ) call destroy_io_field(io_sss) call destroy_io_field(io_flxio ) end select call data_set(forcing_file,'close') call destroy_file(forcing_file) if (my_task == master_task) then write(stdout,blank_fmt) write(stdout,'(a24,a)') ' SFWF n-hour file read: ', & trim(forcing_filename) endif enddo if (sfwf_formulation == 'bulk-NCEP' .or. & sfwf_formulation == 'partially-coupled') then allocate(SFWF_COMP(nx_block,ny_block,max_blocks_clinic, & sfwf_num_comps)) SFWF_COMP = c0 ! initialize endif !*** renormalize values if necessary to compensate for different !*** units. do n = 1,sfwf_data_num_fields if (sfwf_data_renorm(n) /= c1) SFWF_DATA(:,:,:,n,:) = & sfwf_data_renorm(n)*SFWF_DATA(:,:,:,n,:) enddo case default call exit_POP(sigAbort, & 'init_sfwf: Unknown value for sfwf_data_type') end select if ( sfwf_formulation == 'partially-coupled' ) then allocate ( TFW_COMP(nx_block,ny_block,nt,max_blocks_clinic, & tfw_num_comps)) TFW_COMP = c0 endif !----------------------------------------------------------------------- ! ! now check interpolation period (sfwf_interp_freq) to set the ! time for the next temporal interpolation (sfwf_interp_next). ! ! if no interpolation is to be done, set next interpolation time ! to a large number so the surface fresh water flux update test ! in routine set_surface_forcing will always be false. ! ! if interpolation is to be done every n-hours, find the first ! interpolation time greater than the current time. ! ! if interpolation is to be done every timestep, set next interpolation ! time to a large negative number so the surface fresh water flux ! update test in routine set_surface_forcing will always be true. ! !----------------------------------------------------------------------- select case (sfwf_interp_freq) case ('never') sfwf_interp_next = never sfwf_interp_last = never sfwf_interp_inc = c0 case ('n-hour') call find_interp_time(sfwf_interp_inc, sfwf_interp_next) case ('every-timestep') sfwf_interp_next = always sfwf_interp_inc = c0 case default call exit_POP(sigAbort, & 'init_sfwf: Unknown value for sfwf_interp_freq') end select if(nsteps_total == 0) sfwf_interp_last = thour00 !----------------------------------------------------------------------- ! ! echo forcing options to stdout. ! !----------------------------------------------------------------------- sfwf_data_label = 'Surface Fresh Water Flux' call echo_forcing_options(sfwf_data_type, & sfwf_formulation, sfwf_data_inc, & sfwf_interp_freq, sfwf_interp_type, & sfwf_interp_inc, sfwf_data_label) if (my_task == master_task) then if (lfw_as_salt_flx .and. sfc_layer_type == sfc_layer_varthick) & write(stdout,'(a47)') & ' Fresh water flux input as virtual salt flux' endif !----------------------------------------------------------------------- !EOC call flushm (stdout) end subroutine init_sfwf !*********************************************************************** !BOP ! !IROUTINE: set_sfwf ! !INTERFACE: subroutine set_sfwf(STF,FW,TFW) ! !DESCRIPTION: ! Updates the current value of the surface fresh water flux arrays ! by interpolating fields or computing fields at the current time. ! If new data are necessary for the interpolation, the new data are ! read from a file. ! ! !REVISION HISTORY: ! same as module ! !INPUT/OUTPUT PARAMETERS: ! CMB CCSM expects tracer concentration to be zero real (r8), dimension(nx_block,ny_block,nt,max_blocks_clinic), & intent(inout) :: & STF, &! surface tracer fluxes at current timestep TFW ! tracer concentration in fresh water flux real (r8), dimension(nx_block,ny_block,max_blocks_clinic), & intent(inout) :: & FW ! fresh water flux if using varthick sfc layer !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & iblock ! local address for current block type (block) :: & this_block ! block info for current block !----------------------------------------------------------------------- ! ! check if new data is necessary for interpolation. if yes, then ! shuffle indices in SFWF_DATA and sfwf_data_time arrays ! and read in new data if necessary ('n-hour' case). note ! that no new data is necessary for 'analytic' and 'annual' cases. ! then perform interpolation or computation of fluxes at current time ! using updated forcing data. ! !----------------------------------------------------------------------- select case(sfwf_data_type) case ('analytic') select case (sfwf_formulation) case ('restoring') !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) STF(:,:,2,iblock) = & (SFWF_DATA(:,:,iblock,sfwf_data_sss,1) - & TRACER(:,:,1,2,curtime,iblock))* & sfwf_restore_rtau*dz(1) end do !$OMP END PARALLEL DO end select case('annual') select case (sfwf_formulation) case ('restoring') !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) STF(:,:,2,iblock) = & (SFWF_DATA(:,:,iblock,sfwf_data_sss,1) - & TRACER(:,:,1,2,curtime,iblock))* & sfwf_restore_rtau*dz(1) end do !$OMP END PARALLEL DO case ('bulk-NCEP') call calc_sfwf_bulk_ncep(STF,FW,TFW,1) case ('hosing') call calc_sfwf_hosing(1) case ('partially-coupled') call calc_sfwf_partially_coupled(1) end select case ('monthly-equal','monthly-calendar') sfwf_data_label = 'SFWF Monthly' if (thour00 >= sfwf_data_update) then call update_forcing_data( sfwf_data_time, & sfwf_data_time_min_loc, sfwf_interp_type, & sfwf_data_next, sfwf_data_update, & sfwf_data_type, sfwf_data_inc, & SFWF_DATA(:,:,:,:,1:12),sfwf_data_renorm, & sfwf_data_label, sfwf_data_names, & sfwf_bndy_loc, sfwf_bndy_type, & sfwf_filename, sfwf_file_fmt) endif if (thour00 >= sfwf_interp_next .or. nsteps_run == 0) then call interpolate_forcing(SFWF_DATA(:,:,:,:,0), & SFWF_DATA(:,:,:,:,1:12), & sfwf_data_time, sfwf_interp_type, & sfwf_data_time_min_loc, sfwf_interp_freq, & sfwf_interp_inc, sfwf_interp_next, & sfwf_interp_last, nsteps_run) if (nsteps_run /= 0) sfwf_interp_next = & sfwf_interp_next + sfwf_interp_inc endif select case (sfwf_formulation) case ('restoring') !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) STF(:,:,2,iblock) = & (SFWF_DATA(:,:,iblock,sfwf_data_sss,0) - & TRACER(:,:,1,2,curtime,iblock))* & sfwf_restore_rtau*dz(1) end do !$OMP END PARALLEL DO case ('bulk-NCEP') call calc_sfwf_bulk_ncep(STF,FW,TFW,12) case ('hosing') call calc_sfwf_hosing(12) case ('partially-coupled') call calc_sfwf_partially_coupled(12) end select case('n-hour') sfwf_data_label = 'SFWF n-hour' if (thour00 >= sfwf_data_update) then call update_forcing_data( sfwf_data_time, & sfwf_data_time_min_loc, sfwf_interp_type, & sfwf_data_next, sfwf_data_update, & sfwf_data_type, sfwf_data_inc, & SFWF_DATA(:,:,:,:,1:sfwf_interp_order), & sfwf_data_renorm, & sfwf_data_label, sfwf_data_names, & sfwf_bndy_loc, sfwf_bndy_type, & sfwf_filename, sfwf_file_fmt) endif if (thour00 >= sfwf_interp_next .or. nsteps_run == 0) then call interpolate_forcing(SFWF_DATA(:,:,:,:,0), & SFWF_DATA(:,:,:,:,1:sfwf_interp_order), & sfwf_data_time, sfwf_interp_type, & sfwf_data_time_min_loc, sfwf_interp_freq, & sfwf_interp_inc, sfwf_interp_next, & sfwf_interp_last, nsteps_run) if (nsteps_run /= 0) sfwf_interp_next = & sfwf_interp_next + sfwf_interp_inc endif select case (sfwf_formulation) case ('restoring') !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) STF(:,:,2,iblock) = & (SFWF_DATA(:,:,iblock,sfwf_data_sss,0) - & TRACER(:,:,1,2,curtime,iblock))* & sfwf_restore_rtau*dz(1) end do !$OMP END PARALLEL DO case ('bulk-NCEP') call calc_sfwf_bulk_ncep(STF, FW, TFW, sfwf_interp_order) case ('partially-coupled') call calc_sfwf_partially_coupled(sfwf_interp_order) end select end select !----------------------------------------------------------------------- !EOC end subroutine set_sfwf !*********************************************************************** !BOP ! !IROUTINE: calc_sfwf_hosing ! !INTERFACE: subroutine calc_sfwf_hosing(time_dim) ! CMB written by me ! Hosing is tricky in the sense that it is computed on a different time step ! than that of the coupler calling pop_set_forcing_coupled, which computes ! the forcing from the vars sent by the coupler. Use same method as partial-coupled ! that is to just put the hosing in SFWF_COMP index sfwf_comp_hosing ! and later combine with the coupler terms in forcing.F90 subroutine sfwf_combined_forcing ! !DESCRIPTION: ! Calculates surface freshwater flux from hosing, akin to adding ! additional precipitation ! ! Notes: ! the forcing data (on t-grid) are computed and ! stored in SFWF\_DATA(:,:,sfwf\_comp\_*,now) where: ! sfwf\_data\_hosing is like precipitation (m/y) ! ! !REVISION HISTORY: ! same as module ! !INPUT PARAMETERS: integer (int_kind), intent(in) :: & time_dim ! number of time points for interpolation !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & now, &! index for location of interpolated data k, n, &! dummy loop indices iblock ! block loop index real (r8) :: & dttmp, & ! temporary time step variable stf_sum1, stf_sum2 type(block) :: & this_block ! block info for current block !----------------------------------------------------------------------- ! ! set location where interpolated data exists. ! !----------------------------------------------------------------------- if (sfwf_data_type == 'annual') then now = 1 else now = 0 endif !----------------------------------------------------------------------- ! ! compute forcing terms for each block ! !----------------------------------------------------------------------- stf_sum1 = global_sum(SFWF_COMP(:,:,:,sfwf_comp_hosing),distrb_clinic,field_loc_center) !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) ! *** SFWF_COMP at the end of this step should have units of kg/m2/s ! *** hosing_fact is 1 at present since the input file should have units of kg/m2/s SFWF_COMP(:,:,iblock,sfwf_comp_hosing) = & SFWF_DATA(:,:,iblock,sfwf_data_hosing,now)*hosing_fact ! *** SFWF_COMP at the end of this step should have units of msu*cm/s ! *** same as STF(:,:,2,:) is subroutine pop_set_coupled_forcing of forcing_coupled.F90 SFWF_COMP(:,:,iblock,sfwf_comp_hosing) = & SFWF_COMP(:,:,iblock,sfwf_comp_hosing)*salinity_factor end do ! block loop !$OMP END PARALLEL DO stf_sum2 = global_sum(SFWF_COMP(:,:,:,sfwf_comp_hosing),distrb_clinic,field_loc_center) if (my_task == master_task) then write(stdout,'(a30,2(e12.3))') & 'HOSING SFWF_COMP global sums 1 and 2 ', stf_sum1, stf_sum2 endif !----------------------------------------------------------------------- !EOC end subroutine calc_sfwf_hosing !*********************************************************************** !BOP ! !IROUTINE: calc_sfwf_bulk_ncep ! !INTERFACE: subroutine calc_sfwf_bulk_ncep(STF, FW, TFW, time_dim) ! !DESCRIPTION: ! Calculates surface freshwater flux from a combination of ! air-sea fluxes (precipitation, evaporation based on ! latent heat flux computed in calc\_shf\_bulk\_ncep), ! and restoring terms (due to restoring fields of SSS). ! ! Notes: ! the forcing data (on t-grid) are computed and ! stored in SFWF\_DATA(:,:,sfwf\_comp\_*,now) where: ! sfwf\_data\_sss is restoring SSS (psu) ! sfwf\_data\_precip is precipitation (m/y) ! ! !REVISION HISTORY: ! same as module ! !INPUT PARAMETERS: integer (int_kind), intent(in) :: & time_dim ! number of time points for interpolation ! !INPUT/OUTPUT PARAMETERS: real (r8), dimension(nx_block,ny_block,nt,max_blocks_clinic), & intent(inout) :: & STF, &! surface tracer fluxes for all tracers TFW ! tracer concentration in fresh water flux ! !OUTPUT PARAMETERS: real (r8), dimension(nx_block,ny_block,max_blocks_clinic), & intent(out) :: & FW ! fresh water flux if using varthick sfc layer !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & now, &! index for location of interpolated data k, n, &! dummy loop indices iblock ! block loop index real (r8) :: & dttmp, &! temporary time step variable fres_hor_ave, &! area-weighted mean of weak restoring fres_hor_area, &! total area of weak restoring area_glob_m_marg, &! total ocean area - marginal sea area vol_glob_m_marg, &! total ocean volume - marginal sea volume weak_mean ! mean weak restoring real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: & WORK1, WORK2 ! temporary work space type(block) :: & this_block ! block info for current block !----------------------------------------------------------------------- ! ! sfwf_weak_restore= weak(non-ice) restoring h2o flux per msu (kg/s/m^2/msu) ! sfwf_strong_restore= strong (ice) .. .. .. .. .. .. ! ! to calculate restoring factors, use mixed layer of 50m, ! and restoring time constant tau (days): ! ! F (kg/s/m^2/msu) ! tau = 6 : 2.77 ! tau = 30 : 0.55 ! tau = 182.5: 0.092 ! tau = 365 : 0.046 ! tau = 730 : 0.023 ! tau = Inf : 0.0 ! !----------------------------------------------------------------------- !----------------------------------------------------------------------- ! ! set location where interpolated data exists. ! !----------------------------------------------------------------------- if (sfwf_data_type == 'annual') then now = 1 else now = 0 endif !----------------------------------------------------------------------- ! ! compute forcing terms for each block ! !----------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) !*** compute evaporation from latent heat computed in shf forcing SFWF_COMP(:,:,iblock,sfwf_comp_evap) = & SHF_COMP(:,:,iblock,shf_comp_qlat)/latent_heat_vapor_mks !*** precipitation (kg/m^2/s) SFWF_COMP(:,:,iblock,sfwf_comp_precip) = & SFWF_DATA(:,:,iblock,sfwf_data_precip,now)*precip_fact ! *c1000/seconds_in_year ! convert m/y to Kg/m^2/s if needed !*** weak salinity restoring term !*** (note: OCN_WGT = 0. at land points) !*** will be subtracting global mean later, so compute !*** necessary terms for global mean SFWF_COMP(:,:,iblock,sfwf_comp_wrest) = & -sfwf_weak_restore*OCN_WGT(:,:,iblock)* & MASK_SR(:,:,iblock)* & (SFWF_DATA(:,:,iblock,sfwf_data_sss,now) - & TRACER(:,:,1,2,curtime,iblock)) WORK1(:,:,iblock) = TAREA(:,:,iblock)* & SFWF_COMP(:,:,iblock,sfwf_comp_wrest) WORK2(:,:,iblock) = TAREA(:,:,iblock)*OCN_WGT(:,:,iblock)* & MASK_SR(:,:,iblock) !*** strong salinity restoring term where (KMT(:,:,iblock) > 0) SFWF_COMP(:,:,iblock,sfwf_comp_srest) = & -sfwf_strong_restore*(c1 - OCN_WGT(:,:,iblock))* & (SFWF_DATA(:,:,iblock,sfwf_data_sss,now) - & TRACER(:,:,1,2,curtime,iblock)) endwhere where (KMT(:,:,iblock) > 0 .and. MASK_SR(:,:,iblock) == 0) SFWF_COMP(:,:,iblock,sfwf_comp_srest) = & -sfwf_strong_restore_ms* & (SFWF_DATA(:,:,iblock,sfwf_data_sss,now) - & TRACER(:,:,1,2,curtime,iblock)) endwhere end do ! block loop !$OMP END PARALLEL DO !---------------------------------------------------------------------- ! ! compute global mean of weak restoring term ! !---------------------------------------------------------------------- fres_hor_ave = global_sum(WORK1, distrb_clinic, field_loc_center) fres_hor_area = global_sum(WORK2, distrb_clinic, field_loc_center) weak_mean = fres_hor_ave/fres_hor_area !----------------------------------------------------------------------- ! ! finish computing forcing terms for each block ! !----------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) !*** subtract mean from weak restoring term SFWF_COMP(:,:,iblock,sfwf_comp_wrest) = & SFWF_COMP(:,:,iblock,sfwf_comp_wrest) - OCN_WGT(:,:,iblock)* & MASK_SR(:,:,iblock)*weak_mean ! if variable thickness surface layer, compute net surface ! freshwater flux (kg/m^2/s) due to restoring terms only ! then compute freshwater flux due to P-E and convert to (m/s) ! then set the tracer content in the freshwater flux ! defaults are FW*SST for tracer 1 (temperature) ! 0 for salinity (really fresh water) ! 0 for all other tracers ! ! IF DATA ARE AVAILABLE... ! IMPLEMENT SUM OVER FRESHWATER TYPES (E,P,R,F,M) HERE: ! ! TFW(:,:,n) = FW_EVAP*TW_EVAP(:,:,n) + FW_PRECIP*TW_PRECIP(:,:,n) ! + FW_ROFF*TW_ROFF(:,:,n) + FW_MELT*TW_MELT(:,:,n) ! + FW_FREEZE*TW_FREEZE(:,:,n) ! ! where, for example FW_ROFF is the water flux from rivers ! and TW_ROFF(:,:,n) is the concentration of the nth tracer ! in the river water; similarly for water fluxes due to ! evaporation, precipitation, ice freezing, and ice melting. if (sfc_layer_type == sfc_layer_varthick .and. & .not. lfw_as_salt_flx) then STF(:,:,2,iblock) = SFWF_COMP(:,:,iblock,sfwf_comp_wrest) + & SFWF_COMP(:,:,iblock,sfwf_comp_srest) FW(:,:,iblock) = OCN_WGT(:,:,iblock)*MASK_SR(:,:,iblock)* & (SFWF_COMP(:,:,iblock,sfwf_comp_evap) + & SFWF_COMP(:,:,iblock,sfwf_comp_precip))* & fwmass_to_fwflux !*** fw same temp as ocean and no tracers in FW input TFW(:,:,1,iblock) = FW(:,:,iblock)* & TRACER(:,:,1,1,curtime,iblock) TFW(:,:,2:nt,iblock) = c0 !*** if rigid lid or old free surface form, compute !*** net surface freshwater flux (kg/m^2/s) else STF(:,:,2,iblock) = OCN_WGT(:,:,iblock)*MASK_SR(:,:,iblock)* & (SFWF_COMP(:,:,iblock,sfwf_comp_evap) + & SFWF_COMP(:,:,iblock,sfwf_comp_precip)) + & SFWF_COMP(:,:,iblock,sfwf_comp_wrest)+ & SFWF_COMP(:,:,iblock,sfwf_comp_srest) endif !*** convert surface freshwater flux (kg/m^2/s) to !*** salinity flux (msu*cm/s) STF(:,:,2,iblock) = STF(:,:,2,iblock)*salinity_factor !*** compute fields for accumulating annual-mean precipitation !*** over ocean points that are not marginal seas. WORK1(:,:,iblock) = merge(SFWF_COMP(:,:,iblock,sfwf_comp_precip)*& TAREA(:,:,iblock)*OCN_WGT(:,:,iblock), & c0, MASK_SR(:,:,iblock) > 0) !WORK2 = merge(FW_OLD(:,:,iblock)*TAREA(:,:,iblock), & ! c0, MASK_SR(:,:,iblock) > 0) end do ! block loop !$OMP END PARALLEL DO !----------------------------------------------------------------------- ! ! accumulate annual-mean precipitation over ocean points that are ! not marginal seas. ! !----------------------------------------------------------------------- if (avg_ts .or. back_to_back) then dttmp = p5*dtt else dttmp = dtt endif area_glob_m_marg = area_t - area_t_marg sum_precip = sum_precip + dttmp*1.0e-4_r8* & global_sum(WORK1,distrb_clinic,field_loc_center)/ & area_glob_m_marg !sum_fw = sum_fw + & ! dttmp*global_sum(WORK2,distrb_clinic,field_loc_center)/ & ! area_glob_m_marg !----------------------------------------------------------------------- ! ! Perform end of year adjustment calculations ! !----------------------------------------------------------------------- if (eoy) then !*** Compute the surface volume-averaged salinity and !*** average surface height (for variable thickness sfc layer) !*** note that it is evaluated at the current time level. !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) if (sfc_layer_type == sfc_layer_varthick) then WORK1(:,:,iblock) = merge( & TRACER(:,:,1,2,curtime,iblock)*TAREA(:,:,iblock)* & (dz(1) + PSURF(:,:,curtime,iblock)/grav), & c0, KMT(:,:,iblock) > 0 .and. MASK_SR(:,:,iblock) > 0) WORK2(:,:,iblock) = merge(PSURF(:,:,curtime,iblock)* & TAREA(:,:,iblock)/grav, c0, & KMT(:,:,iblock) > 0 .and. & MASK_SR(:,:,iblock) > 0) else WORK1(:,:,iblock) = merge(TRACER(:,:,1,2,curtime,iblock)* & TAREA(:,:,iblock)*dz(1), & c0, KMT(:,:,iblock) > 0 .and. & MASK_SR(:,:,iblock) > 0) endif end do !$OMP END PARALLEL DO vol_glob_m_marg = volume_t_k(1) - volume_t_marg_k(1) sal_final(1) = 1.0e-6_r8* & global_sum(WORK1, distrb_clinic, field_loc_center)/ & vol_glob_m_marg if (sfc_layer_type == sfc_layer_varthick) then ssh_final = 1.0e-4_r8* & global_sum(WORK2, distrb_clinic, field_loc_center)/ & area_glob_m_marg/seconds_in_year if (my_task == master_task) then write(stdout,blank_fmt) write(stdout,'(a22,1pe23.15)') & 'annual change in SSH: ', ssh_final endif ssh_final = ssh_final*10.0_r8 ! convert (cm/s) -> kg/m^2/s ! (cm/s)x0.01(m/cm)x1000kg/m^3 else ssh_final = c0 endif !*** Compute the volume-averaged salinity for each level. do k=2,km !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) if (partial_bottom_cells) then WORK1(:,:,iblock) = & merge(TRACER(:,:,k,2,curtime,iblock)* & TAREA(:,:,iblock)*DZT(:,:,k,iblock), c0, & k <= KMT(:,:,iblock) .and. & MASK_SR(:,:,iblock) > 0) else WORK1(:,:,iblock) = & merge(TRACER(:,:,k,2,curtime,iblock)* & TAREA(:,:,iblock)*dz(k), c0, & k <= KMT(:,:,iblock) .and. & MASK_SR(:,:,iblock) > 0) endif end do !$OMP END PARALLEL DO vol_glob_m_marg = volume_t_k(k) - volume_t_marg_k(k) if (vol_glob_m_marg == 0) vol_glob_m_marg = 1.e+20_r8 sal_final(k) = 1.0e-6_r8* & global_sum(WORK1, distrb_clinic, field_loc_center)/ & vol_glob_m_marg enddo !*** find annual mean precip and reset annual counters !ann_avg_fw = sum_fw / seconds_in_year !if (my_task == master_task) then ! write(stdout,blank_fmt) ! write(stdout,'(a32,1pe22.15)') & ! 'annual average freshwater flux: ', ann_avg_fw !endif !sum_fw = c0 ann_avg_precip = sum_precip / seconds_in_year sum_precip = c0 if (ladjust_precip) call precip_adjustment sal_initial = sal_final ssh_initial = ssh_final endif ! end of year calculations !----------------------------------------------------------------------- !EOC end subroutine calc_sfwf_bulk_ncep !*********************************************************************** !BOP ! !IROUTINE: calc_sfwf_partially_coupled ! !INTERFACE: subroutine calc_sfwf_partially_coupled(time_dim) ! !DESCRIPTION: ! Calculate ice-ocean flux, weak restoring, and strong restoring ! components of surface freshwater flux for partially-coupled formulation. ! these components will later be used in ! set\_surface\_forcing (forcing.F) to form the total surface freshwater ! (salt) flux. ! ! the forcing data (on t-grid) sets needed are ! sfwf\_data\_sss, restoring SSS (msu) ! sfwf\_data\_flxio, diagnosed ("climatological") (kg/m^2/s) ! ice-ocean freshwater flux ! ! !REVISION HISTORY: ! same as module ! !INPUT PARAMETERS: integer (int_kind), intent(in) :: & time_dim ! number of time points for interpolation !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & now, &! index for location of interpolated data k, n, &! dummy loop indices iblock ! block loop index real (r8) :: & dttmp, &! temporary time step variable fres_hor_ave, &! area-weighted mean of weak restoring fres_hor_area, &! total area of weak restoring area_glob_m_marg, &! total ocean area - marginal sea area vol_glob_m_marg ! total ocean volume - marginal sea volume real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: & WORK,WORK1, WORK2 ! temporary work space type(block) :: & this_block ! block info for current block !----------------------------------------------------------------------- ! ! set location where interpolated data exists. ! !----------------------------------------------------------------------- area_glob_m_marg = 1.0e-4*(area_t - area_t_marg) if (sfwf_data_type == 'annual') then now = 1 else now = 0 endif !----------------------------------------------------------------------- ! ! compute forcing terms for each block ! !----------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) if (.not. luse_cpl_ifrac) then WORK(:,:,iblock) = OCN_WGT(:,:,iblock)*MASK_SR(:,:,iblock) else WORK(:,:,iblock) = MASK_SR(:,:,iblock) endif !*** weak salinity restoring term !*** (note: MASK_SR = 0. at land and marginal-sea points) !*** will be subtracting global mean later, so compute !*** necessary terms for global mean SFWF_COMP(:,:,iblock,sfwf_comp_wrest) = & -sfwf_weak_restore*WORK(:,:,iblock)* & (SFWF_DATA(:,:,iblock,sfwf_data_sss,now) - & TRACER(:,:,1,2,curtime,iblock)) WORK1(:,:,iblock) = TAREA(:,:,iblock)* & SFWF_COMP(:,:,iblock,sfwf_comp_wrest) WORK2(:,:,iblock) = TAREA(:,:,iblock)*WORK(:,:,iblock) end do ! block loop !$OMP END PARALLEL DO !---------------------------------------------------------------------- ! ! compute global mean of weak restoring term ! !---------------------------------------------------------------------- fres_hor_ave = global_sum(WORK1, distrb_clinic, field_loc_center) fres_hor_area = global_sum(WORK2, distrb_clinic, field_loc_center) !----------------------------------------------------------------------- ! ! finish computing forcing terms for each block ! !----------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) ! subtract global mean from weak restoring term SFWF_COMP(:,:,iblock,sfwf_comp_wrest) = & SFWF_COMP(:,:,iblock,sfwf_comp_wrest) - WORK(:,:,iblock)* & fres_hor_ave/fres_hor_area where (KMT(:,:,iblock) > 0) SFWF_COMP(:,:,iblock,sfwf_comp_srest) = & -sfwf_strong_restore*(c1 - OCN_WGT(:,:,iblock))* & (SFWF_DATA(:,:,iblock,sfwf_data_sss,now) - & TRACER(:,:,1,2,curtime,iblock)) endwhere where (KMT(:,:,iblock) > 0 .and. MASK_SR(:,:,iblock) == 0) SFWF_COMP(:,:,iblock,sfwf_comp_srest) = & -sfwf_strong_restore_ms* & (SFWF_DATA(:,:,iblock,sfwf_data_sss,now) - & TRACER(:,:,1,2,curtime,iblock)) endwhere !*** ice-ocean climatological flux term if ( .not. lactive_ice ) then where (KMT(:,:,iblock) > 0) SFWF_COMP(:,:,iblock,sfwf_comp_flxio) = & (c1 - OCN_WGT(:,:,iblock))* & SFWF_DATA(:,:,iblock,sfwf_data_flxio,now) endwhere if ( .not. lms_balance ) & SFWF_COMP(:,:,iblock,sfwf_comp_flxio) = & SFWF_COMP(:,:,iblock,sfwf_comp_flxio)*MASK_SR(:,:,iblock) endif !*** convert surface freshwater flux components (kg/m^2/s) to !*** salinity flux components (msu*cm/s) SFWF_COMP(:,:,iblock,sfwf_comp_wrest) = & SFWF_COMP(:,:,iblock,sfwf_comp_wrest)*salinity_factor SFWF_COMP(:,:,iblock,sfwf_comp_srest) = & SFWF_COMP(:,:,iblock,sfwf_comp_srest)*salinity_factor if ( sfc_layer_type == sfc_layer_varthick .and. & .not. lfw_as_salt_flx) then WORK(:,:,iblock) = fwmass_to_fwflux * & SFWF_COMP(:,:,iblock,sfwf_comp_flxio) SFWF_COMP(:,:,iblock,sfwf_comp_flxio) = WORK(:,:,iblock) call tmelt(WORK1(:,:,iblock),TRACER(:,:,1,2,curtime,iblock)) TFW_COMP(:,:,1, iblock,tfw_comp_flxio) = WORK(:,:,iblock)* & WORK1(:,:,iblock) TFW_COMP(:,:,2:nt,iblock,tfw_comp_flxio) = c0 else SFWF_COMP(:,:,iblock,sfwf_comp_flxio) = salinity_factor* & SFWF_COMP(:,:,iblock,sfwf_comp_flxio) endif end do ! block loop !$OMP END PARALLEL DO !----------------------------------------------------------------------- ! ! Perform end of year adjustment calculations ! !----------------------------------------------------------------------- if (eoy) then !*** Compute the surface volume-averaged salinity and !*** average surface height (for variable thickness sfc layer) !*** note that it is evaluated at the current time level. !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) if (sfc_layer_type == sfc_layer_varthick) then WORK1(:,:,iblock) = merge( & TRACER(:,:,1,2,curtime,iblock)*TAREA(:,:,iblock)* & (dz(1) + PSURF(:,:,curtime,iblock)/grav), & c0, KMT(:,:,iblock) > 0 .and. MASK_SR(:,:,iblock) > 0) WORK2(:,:,iblock) = merge(PSURF(:,:,curtime,iblock)* & TAREA(:,:,iblock)/grav, c0, & KMT(:,:,iblock) > 0 .and. & MASK_SR(:,:,iblock) > 0) else WORK1(:,:,iblock) = merge(TRACER(:,:,1,2,curtime,iblock)* & TAREA(:,:,iblock)*dz(1), & c0, KMT(:,:,iblock) > 0 .and. & MASK_SR(:,:,iblock) > 0) endif end do !$OMP END PARALLEL DO vol_glob_m_marg = 1.0e-6_r8*(volume_t_k(1) - volume_t_marg_k(1)) sal_final(1) = 1.0e-6_r8* &! convert to m^3 global_sum(WORK1,distrb_clinic,field_loc_center)/vol_glob_m_marg if (sfc_layer_type == sfc_layer_varthick) then ssh_final = 1.0e-4_r8* &! convert to m^3 global_sum(WORK2, distrb_clinic, field_loc_center)/ & area_glob_m_marg/seconds_in_year if (my_task == master_task) then write(stdout,blank_fmt) write(stdout,'(a22,1pe23.15)') & 'annual change in SSH: ', ssh_final endif ssh_final = ssh_final*10.0_r8 ! convert (cm/s) -> kg/m^2/s ! (cm/s)x0.01(m/cm)x1000kg/m^3 else ssh_final = c0 endif !*** Compute the volume-averaged salinity for each level. do k=2,km !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) if (partial_bottom_cells) then WORK1(:,:,iblock) = & merge(TRACER(:,:,k,2,curtime,iblock)* & TAREA(:,:,iblock)*DZT(:,:,k,iblock), c0, & k <= KMT(:,:,iblock) .and. & MASK_SR(:,:,iblock) > 0) else WORK1(:,:,iblock) = & merge(TRACER(:,:,k,2,curtime,iblock)* & TAREA(:,:,iblock)*dz(k), c0, & k <= KMT(:,:,iblock) .and. & MASK_SR(:,:,iblock) > 0) endif end do !$OMP END PARALLEL DO vol_glob_m_marg = 1.0e-6_r8*(volume_t_k(k) - volume_t_marg_k(k)) if (vol_glob_m_marg == 0) vol_glob_m_marg = 1.e+20_r8 sal_final(k) = 1.0e-6_r8* &! convert to m^3 global_sum(WORK1,distrb_clinic,field_loc_center)/vol_glob_m_marg enddo if (ladjust_precip) call precip_adjustment sal_initial = sal_final ssh_initial = ssh_final endif ! end of year calculations !----------------------------------------------------------------------- !EOC end subroutine calc_sfwf_partially_coupled !*********************************************************************** !BOP ! !IROUTINE: precip_adjustment ! !INTERFACE: subroutine precip_adjustment ! !DESCRIPTION: ! Computes a precipitation factor to multiply the fresh water flux ! due to precipitation uniformly to insure a balance of fresh water ! at the ocean surface. ! ! !REVISION HISTORY: ! same as module !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- real (r8) :: & sal_tendency, fw_tendency, precip_tav, & area_glob_m_marg, &! global ocean area - marginal sea area (cm^2) vol_glob_m_marg ! global ocean vol - marginal sea vol (cm^3) integer (int_kind) :: k !----------------------------------------------------------------------- ! ! compute tendency of salinity for eack "k" layer, considering the ! effects of depth acceleration ! !----------------------------------------------------------------------- do k=1,km sal_initial(k) = (sal_final(k) - sal_initial(k))/ & (dttxcel(k)*seconds_in_year) enddo !----------------------------------------------------------------------- ! ! form the global volume-averaged tendency to be used in "precip_fact" ! computation ! !----------------------------------------------------------------------- sal_tendency = c0 do k=1,km vol_glob_m_marg = 1.0e-6_r8*(volume_t_k(k) - volume_t_marg_k(k)) sal_tendency = sal_tendency + vol_glob_m_marg*sal_initial(k) enddo vol_glob_m_marg = 1.0e-6_r8*(volume_t - volume_t_marg) sal_tendency = sal_tendency/vol_glob_m_marg if (my_task == master_task) then write (stdout,'(a58,1pe22.15)') & ' precip_adjustment: volume-averaged salinity tendency = ', & sal_tendency endif !----------------------------------------------------------------------- ! ! convert "sal_tendency" from (msu/s) to -(kg/m^2/s). note that ! areag in cm^2 and volgt in cm^3 ! assumes density of fresh water = 1000 kg/m**3 ! !----------------------------------------------------------------------- area_glob_m_marg = 1.0e-4*(area_t - area_t_marg) sal_tendency = - sal_tendency*vol_glob_m_marg* & 1.0e6_r8/area_glob_m_marg/ocn_ref_salinity !----------------------------------------------------------------------- ! ! compute annual change in mass due to freshwater flux (kg/m^2/s) ! !----------------------------------------------------------------------- fw_tendency = ssh_final - ssh_initial if (my_task == master_task) then write (stdout,'(a22)') ' precip_adjustment: ' write (stdout,'(a28,1pe22.15)') ' sal_tendency (kg/m^2/s): ', & sal_tendency write (stdout,'(a28,1pe22.15)') ' fw_tendency (kg/m^2/s): ', & fw_tendency endif !----------------------------------------------------------------------- ! ! change "precip_fact" based on tendency of freshwater and previous ! amount of precipitation ! !----------------------------------------------------------------------- if (sfwf_formulation == 'partially-coupled') then precip_tav = precip_mean else precip_tav = ann_avg_precip/precip_fact endif precip_fact = precip_fact - & (sal_tendency + fw_tendency)/precip_tav if (my_task == master_task) then write (stdout,'(a33,e14.8)') ' Changed precipitation factor to ',& precip_fact endif !----------------------------------------------------------------------- !EOC end subroutine precip_adjustment !*********************************************************************** end module forcing_sfwf !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| CESM2.1.3_sourcemods/PaxHeaders.32795/forcing_shf.F900000644000000000000000000000012413774500023016751 xustar0027 mtime=1609728019.330436 27 atime=1609728019.318312 30 ctime=1609728019.329921246 CESM2.1.3_sourcemods/forcing_shf.F900000644006307300017500000027605513774500023017347 0ustar00islasncar00000000000000!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| module forcing_shf !BOP ! !MODULE: forcing_shf ! !DESCRIPTION: ! Contains routines and variables used for determining the surface ! heat flux. ! ! !REVISION HISTORY: ! SVN:$Id$ ! ! !USES: use kinds_mod use blocks use distribution use domain use global_reductions use constants use io use grid use forcing_tools use registry use time_management use prognostic use exit_mod implicit none private save ! !PUBLIC MEMBER FUNCTIONS: public :: init_shf, & set_shf ! !PUBLIC DATA MEMBERS: real (r8), dimension(nx_block,ny_block,max_blocks_clinic), & public, target :: & SHF_QSW, & ! incoming short wave SHF_QSW_RAW ! no masking, no diurnal cycle logical (log_kind), public :: & lsw_absorb ! true if short wave available as separate flux ! (use penetrative short wave) !*** the following must be shared with sfwf forcing in !*** bulk-NCEP option real (r8), allocatable, dimension(:,:,:,:), public :: & SHF_COMP real (r8), allocatable, dimension(:,:,:), public :: & OCN_WGT integer (int_kind), allocatable, dimension(:,:,:), public :: & MASK_SR ! strong restoring mask for marginal seas integer (int_kind), public :: & shf_data_tair, & shf_data_qair, & shf_data_cldfrac, & shf_data_windspd, & shf_comp_heatflux, & ! CMB for either alyssa_restoring or heating shf_comp_qsw, & shf_comp_qlw, & shf_comp_qlat, & shf_comp_qsens, & shf_comp_wrest, & shf_comp_srest, & shf_comp_cpl !*** the following are needed by restart real (r8), public :: & shf_interp_last ! time when last interpolation was done !EOP !BOC !----------------------------------------------------------------------- ! ! module variables ! !----------------------------------------------------------------------- real (r8), allocatable, dimension(:,:,:,:,:) :: & SHF_DATA ! forcing data to use for computing SHF real (r8), dimension(12) :: & shf_data_time ! time (hours) corresponding to surface heat fluxes real (r8), dimension(20) :: & shf_data_renorm ! factors for converting to model units real (r8), parameter, private :: & T_strong_restore_limit = -1.8_r8, & T_weak_restore_limit = -0.8_r8, & dT_restore_limit = T_weak_restore_limit - T_strong_restore_limit real (r8) :: & shf_data_inc, &! time increment between values of forcing data shf_data_next, &! time that will be used for the next value of forcing data that is needed shf_data_update, &! time when the a new forcing value needs to be added to interpolation set shf_interp_inc, &! time increment between interpolation shf_interp_next, &! time when next interpolation will be done shf_restore_tau, &! CMB use this for alyssa_restore, ignoring weak/strong stuff shf_restore_rtau, & shf_weak_restore, &! heat flux weak restoring max time scale shf_strong_restore,&! heat flux strong restoring max time scale shf_strong_restore_ms integer (int_kind) :: & shf_interp_order, &! order of temporal interpolation shf_data_time_min_loc, &! time index for first shf_data point shf_data_num_fields integer (int_kind), public :: & shf_num_comps character (char_len), dimension(:), allocatable :: & shf_data_names ! short names for input data fields integer (int_kind), dimension(:), allocatable :: & shf_bndy_loc, &! location and field type for ghost shf_bndy_type ! cell updates ! the following is necessary for sst restoring and partially-coupled integer (int_kind) :: & shf_data_sst ! the following is necessary for stuff CMB added integer (int_kind) :: & shf_data_flxio ! the following are necessary for Barnier-restoring integer (int_kind) :: & shf_data_tstar, & shf_data_tau, & shf_data_ice, & shf_data_qsw character (char_len) :: & shf_interp_freq, &! keyword for period of temporal interpolation shf_filename, &! file containing forcing data shf_file_fmt, &! format (bin or netcdf) of shf file shf_interp_type, & shf_data_label character (char_len), public :: & shf_data_type, &! keyword for period of forcing data shf_formulation ! the following is necessary for partially-coupled ! luse_cpl_ifrac = .T. use fractional ice coverage ! sent by the coupler from the (dummy) ice, ! .F. use fractional ice coverage based on the ! STR SST climatology. logical (log_kind), public :: & luse_cpl_ifrac real (r8), allocatable, dimension(:,:,:) :: & SHF_MASK ! CMB mask to weight forced shf_comp !----------------------------------------------------------------------- ! ! the following are needed for long-wave heat flux ! with bulk-NCEP forcing ! !----------------------------------------------------------------------- real (r8), allocatable, dimension (:,:,:) :: & CCINT real (r8), dimension(21) :: & cc = (/ 0.88_r8, 0.84_r8, 0.80_r8, & 0.76_r8, 0.72_r8, 0.68_r8, & 0.63_r8, 0.59_r8, 0.52_r8, & 0.50_r8, 0.50_r8, 0.50_r8, & 0.52_r8, 0.59_r8, 0.63_r8, & 0.68_r8, 0.72_r8, 0.76_r8, & 0.80_r8, 0.84_r8, 0.88_r8 /) real (r8), dimension(21) :: & clat = (/ -90.0_r8, -80.0_r8, -70.0_r8, & -60.0_r8, -50.0_r8, -40.0_r8, & -30.0_r8, -20.0_r8, -10.0_r8, & -5.0_r8, 0.0_r8, 5.0_r8, & 10.0_r8, 20.0_r8, 30.0_r8, & 40.0_r8, 50.0_r8, 60.0_r8, & 70.0_r8, 80.0_r8, 90.0_r8 /) !EOC !*********************************************************************** contains !*********************************************************************** !BOP ! !IROUTINE: init_shf ! !INTERFACE: subroutine init_shf(STF) ! !DESCRIPTION: ! Initializes surface heat flux forcing by either calculating ! or reading in the surface heat flux. Also do initial ! book-keeping concerning when new data is needed for the temporal ! interpolation and when the forcing will need to be updated. ! ! !REVISION HISTORY: ! same as module ! !OUTPUT PARAMETERS: real (r8), dimension(nx_block,ny_block,nt,max_blocks_clinic), & intent(out) :: & STF ! surface tracer flux - this routine only modifies ! the slice corresponding to temperature (tracer 1) !EOP !BOC !---------------------------------------------------------------------- ! ! local variables ! !---------------------------------------------------------------------- integer (int_kind) :: & i,j, k, n, iblock, &! loop indices nml_error ! namelist error flag character (char_len) :: & forcing_filename ! temp for full filename of forcing file logical (log_kind) :: & no_region_mask ! flag for existence of region mask real (r8), dimension(:,:,:,:,:), target, allocatable :: & TEMP_DATA ! temporary data array for monthly forcing type (datafile) :: & forcing_file ! file containing forcing fields type (io_field_desc) :: & ! io descriptors for various input fields io_sst, & io_flxio, & !CMB io_mask, & !CMB io_tstar, & io_tau, & io_ice, & io_qsw, & io_tair, & io_qair, & io_cldfrac, & io_windspd real (r8) :: stf_sum1 ! for global sum diag type (io_dim) :: & i_dim, j_dim, &! dimension descriptors for horiz dims month_dim ! dimension descriptor for monthly data namelist /forcing_shf_nml/ shf_data_type, shf_data_inc, & shf_interp_type, shf_interp_freq, & shf_interp_inc, shf_restore_tau, & shf_filename, shf_file_fmt, & shf_data_renorm, & shf_formulation, & shf_weak_restore, shf_strong_restore,& shf_strong_restore_ms, & luse_cpl_ifrac !----------------------------------------------------------------------- ! ! read surface heat flux namelist input after setting default values. ! !----------------------------------------------------------------------- shf_formulation = 'restoring' shf_data_type = 'analytic' shf_data_inc = 1.e20_r8 shf_interp_type = 'nearest' shf_interp_freq = 'never' shf_interp_inc = 1.e20_r8 shf_restore_tau = 1.e20_r8 shf_filename = 'unknown-shf' shf_file_fmt = 'bin' shf_data_renorm = c1 shf_weak_restore = c0 shf_strong_restore = 92.64_r8 shf_strong_restore_ms = 92.64_r8 luse_cpl_ifrac = .false. if (my_task == master_task) then open (nml_in, file=nml_filename, status='old',iostat=nml_error) if (nml_error /= 0) then nml_error = -1 else nml_error = 1 endif do while (nml_error > 0) read(nml_in, nml=forcing_shf_nml,iostat=nml_error) end do if (nml_error == 0) close(nml_in) endif call broadcast_scalar(nml_error, master_task) if (nml_error /= 0) then call exit_POP(sigAbort,'ERROR reading forcing_shf_nml') endif call broadcast_scalar(shf_formulation, master_task) call broadcast_scalar(shf_data_type, master_task) call broadcast_scalar(shf_data_inc, master_task) call broadcast_scalar(shf_interp_type, master_task) call broadcast_scalar(shf_interp_freq, master_task) call broadcast_scalar(shf_interp_inc, master_task) call broadcast_scalar(shf_restore_tau, master_task) call broadcast_scalar(shf_filename, master_task) call broadcast_scalar(shf_file_fmt, master_task) call broadcast_array (shf_data_renorm, master_task) call broadcast_scalar(shf_weak_restore, master_task) call broadcast_scalar(shf_strong_restore, master_task) call broadcast_scalar(shf_strong_restore_ms, master_task) call broadcast_scalar(luse_cpl_ifrac, master_task) !----------------------------------------------------------------------- ! ! convert data_type to 'monthly-calendar' if input is 'monthly' ! !----------------------------------------------------------------------- if (shf_data_type == 'monthly') shf_data_type = 'monthly-calendar' !----------------------------------------------------------------------- ! ! set values based on shf_formulation ! !----------------------------------------------------------------------- select case (shf_formulation) case ('restoring') lsw_absorb = .false. shf_data_num_fields = 1 allocate(shf_data_names(shf_data_num_fields), & shf_bndy_loc (shf_data_num_fields), & shf_bndy_type (shf_data_num_fields)) shf_data_sst = 1 shf_data_names(shf_data_sst) = 'SST' shf_bndy_loc (shf_data_sst) = field_loc_center shf_bndy_type (shf_data_sst) = field_type_scalar case ('alyssa_restoring') lsw_absorb = .true. ! CMB not sure about this shf_data_num_fields = 1 allocate(shf_data_names(shf_data_num_fields), & shf_bndy_loc (shf_data_num_fields), & shf_bndy_type (shf_data_num_fields)) shf_data_sst = 1 shf_data_names(shf_data_sst) = 'SST' shf_bndy_loc (shf_data_sst) = field_loc_center shf_bndy_type (shf_data_sst) = field_type_scalar shf_num_comps = 3 shf_comp_heatflux = 1 shf_comp_cpl = 2 shf_comp_qsw = 3 case ('heating') lsw_absorb = .true. ! CMB not sure what this is shf_data_num_fields = 1 allocate(shf_data_names(shf_data_num_fields), & shf_bndy_loc (shf_data_num_fields), & shf_bndy_type (shf_data_num_fields)) shf_data_flxio = 1 shf_data_names(shf_data_flxio) = 'APPLIED_SHF' shf_bndy_loc (shf_data_flxio) = field_loc_center shf_bndy_type (shf_data_flxio) = field_type_scalar shf_num_comps = 3 shf_comp_heatflux = 1 shf_comp_cpl = 2 shf_comp_qsw = 3 case ('Barnier-restoring') lsw_absorb = .true. shf_data_num_fields = 4 allocate(shf_data_names(shf_data_num_fields), & shf_bndy_loc (shf_data_num_fields), & shf_bndy_type (shf_data_num_fields)) shf_data_tstar = 1 shf_data_tau = 2 shf_data_ice = 3 shf_data_qsw = 4 shf_data_names(shf_data_tstar) = 'TSTAR' shf_bndy_loc (shf_data_tstar) = field_loc_center shf_bndy_type (shf_data_tstar) = field_type_scalar shf_data_names(shf_data_tau) = 'TAU' shf_bndy_loc (shf_data_tau) = field_loc_center shf_bndy_type (shf_data_tau) = field_type_scalar shf_data_names(shf_data_ice) = 'ICE' shf_bndy_loc (shf_data_ice) = field_loc_center shf_bndy_type (shf_data_ice) = field_type_scalar shf_data_names(shf_data_qsw) = 'QSW' shf_bndy_loc (shf_data_qsw) = field_loc_center shf_bndy_type (shf_data_qsw) = field_type_scalar case ('bulk-NCEP') lsw_absorb = .true. shf_data_num_fields = 6 allocate(shf_data_names(shf_data_num_fields), & shf_bndy_loc (shf_data_num_fields), & shf_bndy_type (shf_data_num_fields)) shf_data_sst = 1 shf_data_tair = 2 shf_data_qair = 3 shf_data_qsw = 4 shf_data_cldfrac = 5 shf_data_windspd = 6 shf_data_names(shf_data_sst) = 'SST' shf_bndy_loc (shf_data_sst) = field_loc_center shf_bndy_type (shf_data_sst) = field_type_scalar shf_data_names(shf_data_tair) = 'TAIR' shf_bndy_loc (shf_data_tair) = field_loc_center shf_bndy_type (shf_data_tair) = field_type_scalar shf_data_names(shf_data_qair) = 'QAIR' shf_bndy_loc (shf_data_qair) = field_loc_center shf_bndy_type (shf_data_qair) = field_type_scalar shf_data_names(shf_data_qsw) = 'QSW' shf_bndy_loc (shf_data_qsw) = field_loc_center shf_bndy_type (shf_data_qsw) = field_type_scalar shf_data_names(shf_data_cldfrac) = 'CLDFRAC' shf_bndy_loc (shf_data_cldfrac) = field_loc_center shf_bndy_type (shf_data_cldfrac) = field_type_scalar shf_data_names(shf_data_windspd) = 'WINDSPD' shf_bndy_loc (shf_data_windspd) = field_loc_center shf_bndy_type (shf_data_windspd) = field_type_scalar shf_num_comps = 6 shf_comp_qsw = 1 shf_comp_qlw = 2 shf_comp_qlat = 3 shf_comp_qsens = 4 shf_comp_wrest = 5 shf_comp_srest = 6 !*** initialize CCINT (cloud factor used in long-wave heat flux !*** with bulk-NCEP forcing). allocate(CCINT(nx_block,ny_block,max_blocks_clinic)) !$OMP PARALLEL DO PRIVATE(iblock,i,j) do iblock=1,nblocks_clinic do j=1,ny_block do i=1,20 where ((TLAT(:,j,iblock)*radian > clat(i )) .and. & (TLAT(:,j,iblock)*radian <= clat(i+1))) CCINT(:,j,iblock) = cc(i) + (cc(i+1)-cc(i))* & (TLAT(:,j,iblock)*radian - clat(i))/ & (clat(i+1)-clat(i)) endwhere end do ! i end do ! j end do ! block loop !$OMP END PARALLEL DO case ('partially-coupled') call register_string('partially-coupled') lsw_absorb = .false. shf_data_num_fields = 1 allocate(shf_data_names(shf_data_num_fields), & shf_bndy_loc (shf_data_num_fields), & shf_bndy_type (shf_data_num_fields)) shf_data_sst = 1 shf_data_names(shf_data_sst) = 'SST' shf_bndy_loc (shf_data_sst) = field_loc_center shf_bndy_type (shf_data_sst) = field_type_scalar shf_num_comps = 4 shf_comp_wrest = 1 shf_comp_srest = 2 shf_comp_cpl = 3 shf_comp_qsw = 4 case default call exit_POP(sigAbort, & 'init_shf: Unknown value for shf_formulation') end select !----------------------------------------------------------------------- ! ! calculate inverse of restoring time scale and convert to seconds. ! !----------------------------------------------------------------------- shf_restore_tau = seconds_in_day*shf_restore_tau shf_restore_rtau = c1/shf_restore_tau !----------------------------------------------------------------------- ! ! initialize SHF_QSW in case a value is needed but not ! supplied by data: for example, with KPP and restoring. ! !----------------------------------------------------------------------- SHF_QSW = c0 SHF_QSW_RAW = c0 !----------------------------------------------------------------------- ! ! set strong restoring mask to 0 only at ocean points that are ! marginal seas and land. ! !----------------------------------------------------------------------- if (allocated(REGION_MASK)) then allocate( MASK_SR(nx_block,ny_block,max_blocks_clinic)) no_region_mask = .false. !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic MASK_SR(:,:,iblock) = merge(0, 1, & REGION_MASK(:,:,iblock) <= 0) end do !$OMP END PARALLEL DO else no_region_mask = .true. endif ! CMB make mask for our use allocate( SHF_MASK(nx_block,ny_block,max_blocks_clinic)) SHF_MASK = c0 forcing_file = construct_file(shf_file_fmt, & full_name = trim(shf_filename), & record_length = rec_type_dbl, & recl_words=nx_global*ny_global) call data_set(forcing_file,'open_read') i_dim = construct_io_dim('i',nx_global) j_dim = construct_io_dim('j',ny_global) io_mask = construct_io_field( & trim('SHF_MASK'), & dim1=i_dim, dim2=j_dim, & field_loc = field_loc_center, & field_type = field_type_scalar, & d2d_array=SHF_MASK) call data_set(forcing_file,'define',io_mask) call data_set(forcing_file,'read' ,io_mask) call destroy_io_field(io_mask) call data_set(forcing_file,'close') call destroy_file(forcing_file) stf_sum1 = global_sum(SHF_MASK,distrb_clinic,field_loc_center) if (my_task == master_task) then write(stdout,'(a30,a30)') 'Reading SHF_MASK from file ', trim(shf_filename) write(stdout,'(a30,(e12.3))') & 'SHF_MASK global sum is ', stf_sum1 endif !----------------------------------------------------------------------- ! ! convert interp_type to corresponding integer value. ! !----------------------------------------------------------------------- select case (shf_interp_type) case ('nearest') shf_interp_order = 1 case ('linear') shf_interp_order = 2 case ('4point') shf_interp_order = 4 case default call exit_POP(sigAbort, & 'init_shf: Unknown value for shf_interp_type') end select !----------------------------------------------------------------------- ! ! set values of the surface heat flux arrays (STF or SHF_DATA) ! depending on the type of the surface heat flux data. ! !----------------------------------------------------------------------- select case (shf_data_type) !----------------------------------------------------------------------- ! ! no surface heat flux, therefore no interpolation in time ! needed, nor are there any new values to be used. ! !----------------------------------------------------------------------- case ('none') STF(:,:,1,:) = c0 shf_data_next = never shf_data_update = never shf_interp_freq = 'never' !----------------------------------------------------------------------- ! ! simple analytic surface temperature that is constant in ! time, therefore no new values will be needed. ! !----------------------------------------------------------------------- case ('analytic') allocate( SHF_DATA(nx_block,ny_block,max_blocks_clinic, & shf_data_num_fields,1)) !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic select case (shf_formulation) case ('restoring') SHF_DATA(:,:,iblock,shf_data_sst,1) = & 28.0_r8*(c1 - sin(ULAT(:,:,iblock))) end select end do ! block loop !$OMP END PARALLEL DO shf_data_next = never shf_data_update = never shf_interp_freq = 'never' !----------------------------------------------------------------------- ! ! annual mean climatological surface temperature (read in from file) ! that is constant in time, therefore no new values will be needed ! (shf_data_next = shf_data_update = never). ! !----------------------------------------------------------------------- case ('annual') allocate( SHF_DATA(nx_block,ny_block,max_blocks_clinic, & shf_data_num_fields,1)) SHF_DATA = c0 forcing_file = construct_file(shf_file_fmt, & full_name=trim(shf_filename), & record_length = rec_type_dbl, & recl_words=nx_global*ny_global) call data_set(forcing_file,'open_read') i_dim = construct_io_dim('i',nx_global) j_dim = construct_io_dim('j',ny_global) select case (shf_formulation) case ('restoring') io_sst = construct_io_field( & trim(shf_data_names(shf_data_sst)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_sst), & field_type = shf_bndy_type(shf_data_sst), & d2d_array=SHF_DATA(:,:,:,shf_data_sst,1)) call data_set(forcing_file,'define',io_sst) call data_set(forcing_file,'read' ,io_sst) call destroy_io_field(io_sst) case ('alyssa_restoring') io_sst = construct_io_field( & trim(shf_data_names(shf_data_sst)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_sst), & field_type = shf_bndy_type(shf_data_sst), & d2d_array=SHF_DATA(:,:,:,shf_data_sst,1)) call data_set(forcing_file,'define',io_sst) call data_set(forcing_file,'read' ,io_sst) call destroy_io_field(io_sst) allocate(SHF_COMP(nx_block,ny_block,max_blocks_clinic, & shf_num_comps)) SHF_COMP = c0 ! initialize case ('heating') io_flxio = construct_io_field( & trim(shf_data_names(shf_data_flxio)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_flxio), & field_type = shf_bndy_type(shf_data_flxio), & d2d_array=SHF_DATA(:,:,:,shf_data_flxio,1)) call data_set(forcing_file,'define',io_flxio) call data_set(forcing_file,'read' ,io_flxio) call destroy_io_field(io_flxio) stf_sum1 = global_sum(SHF_DATA(:,:,:,shf_data_flxio,1),distrb_clinic,field_loc_center) if (my_task == master_task) then write(stdout,'(a30,a30)') 'Reading first SHF_DATA from file ', trim(shf_data_names(shf_data_flxio)) write(stdout,'(a30,(e12.3))') & 'SHF_DATA global sum is ', stf_sum1 endif allocate(SHF_COMP(nx_block,ny_block,max_blocks_clinic, & shf_num_comps)) SHF_COMP = c0 ! initialize case ('partially-coupled') io_sst = construct_io_field( & trim(shf_data_names(shf_data_sst)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_sst), & field_type = shf_bndy_type(shf_data_sst), & d2d_array=SHF_DATA(:,:,:,shf_data_sst,1)) call data_set(forcing_file,'define',io_sst) call data_set(forcing_file,'read' ,io_sst) call destroy_io_field(io_sst) allocate(SHF_COMP(nx_block,ny_block,max_blocks_clinic, & shf_num_comps), & OCN_WGT (nx_block,ny_block,max_blocks_clinic)) SHF_COMP = c0 ! initialize case ('Barnier-restoring') io_tstar = construct_io_field( & trim(shf_data_names(shf_data_tstar)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_tstar), & field_type = shf_bndy_type(shf_data_tstar), & d2d_array=SHF_DATA(:,:,:,shf_data_tstar,1)) io_tau = construct_io_field( & trim(shf_data_names(shf_data_tau)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_tau), & field_type = shf_bndy_type(shf_data_tau), & d2d_array=SHF_DATA(:,:,:,shf_data_tau,1)) io_ice = construct_io_field( & trim(shf_data_names(shf_data_ice)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_ice), & field_type = shf_bndy_type(shf_data_ice), & d2d_array=SHF_DATA(:,:,:,shf_data_ice,1)) io_qsw = construct_io_field( & trim(shf_data_names(shf_data_qsw)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_qsw), & field_type = shf_bndy_type(shf_data_qsw), & d2d_array=SHF_DATA(:,:,:,shf_data_qsw,1)) call data_set(forcing_file,'define',io_tstar) call data_set(forcing_file,'define',io_tau) call data_set(forcing_file,'define',io_ice) call data_set(forcing_file,'define',io_qsw) call data_set(forcing_file,'read',io_tstar) call data_set(forcing_file,'read',io_tau) call data_set(forcing_file,'read',io_ice) call data_set(forcing_file,'read',io_qsw) call destroy_io_field(io_tstar) call destroy_io_field(io_tau) call destroy_io_field(io_ice) call destroy_io_field(io_qsw) SHF_DATA(:,:,:,shf_data_tau,1) = seconds_in_day* & SHF_DATA(:,:,:,shf_data_tau,1) case ('bulk-NCEP') io_sst = construct_io_field( & trim(shf_data_names(shf_data_sst)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_sst), & field_type = shf_bndy_type(shf_data_sst), & d2d_array=SHF_DATA(:,:,:,shf_data_sst,1)) io_tair = construct_io_field( & trim(shf_data_names(shf_data_tair)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_tair), & field_type = shf_bndy_type(shf_data_tair), & d2d_array=SHF_DATA(:,:,:,shf_data_tair,1)) io_qair = construct_io_field( & trim(shf_data_names(shf_data_qair)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_qair), & field_type = shf_bndy_type(shf_data_qair), & d2d_array=SHF_DATA(:,:,:,shf_data_qair,1)) io_qsw = construct_io_field( & trim(shf_data_names(shf_data_qsw)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_qsw), & field_type = shf_bndy_type(shf_data_qsw), & d2d_array=SHF_DATA(:,:,:,shf_data_qsw,1)) io_cldfrac = construct_io_field( & trim(shf_data_names(shf_data_cldfrac)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_cldfrac), & field_type = shf_bndy_type(shf_data_cldfrac), & d2d_array=SHF_DATA(:,:,:,shf_data_cldfrac,1)) io_windspd = construct_io_field( & trim(shf_data_names(shf_data_windspd)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_windspd), & field_type = shf_bndy_type(shf_data_windspd), & d2d_array=SHF_DATA(:,:,:,shf_data_windspd,1)) call data_set(forcing_file, 'define', io_sst) call data_set(forcing_file, 'define', io_tair) call data_set(forcing_file, 'define', io_qair) call data_set(forcing_file, 'define', io_qsw) call data_set(forcing_file, 'define', io_cldfrac) call data_set(forcing_file, 'define', io_windspd) call data_set(forcing_file, 'read', io_sst) call data_set(forcing_file, 'read', io_tair) call data_set(forcing_file, 'read', io_qair) call data_set(forcing_file, 'read', io_qsw) call data_set(forcing_file, 'read', io_cldfrac) call data_set(forcing_file, 'read', io_windspd) call destroy_io_field(io_sst) call destroy_io_field(io_tair) call destroy_io_field(io_qair) call destroy_io_field(io_qsw) call destroy_io_field(io_cldfrac) call destroy_io_field(io_windspd) allocate(SHF_COMP(nx_block,ny_block,max_blocks_clinic, & shf_num_comps), & OCN_WGT (nx_block,ny_block,max_blocks_clinic)) SHF_COMP = c0 ! initialize end select call data_set(forcing_file,'close') !*** renormalize values if necessary to compensate for different !*** units do n = 1,shf_data_num_fields if (shf_data_renorm(n) /= c1) SHF_DATA(:,:,:,n,:) = & shf_data_renorm(n)*SHF_DATA(:,:,:,n,:) enddo shf_data_next = never shf_data_update = never shf_interp_freq = 'never' if (my_task == master_task) then write(stdout,blank_fmt) write(stdout,'(a23,a)') ' SHF Annual file read: ', & trim(forcing_file%full_name) endif call destroy_file(forcing_file) !----------------------------------------------------------------------- ! monthly mean climatological surface heat flux. all ! 12 months are read in from a file. interpolation order ! (shf_interp_order) may be specified with namelist input. !----------------------------------------------------------------------- case ('monthly-equal','monthly-calendar') allocate(SHF_DATA(nx_block,ny_block,max_blocks_clinic, & shf_data_num_fields,0:12), & TEMP_DATA(nx_block,ny_block,12,max_blocks_clinic, & shf_data_num_fields)) SHF_DATA = c0 call find_forcing_times(shf_data_time, shf_data_inc, & shf_interp_type, shf_data_next, & shf_data_time_min_loc, shf_data_update, & shf_data_type) forcing_file = construct_file(shf_file_fmt, & full_name = trim(shf_filename), & record_length = rec_type_dbl, & recl_words=nx_global*ny_global) call data_set(forcing_file,'open_read') i_dim = construct_io_dim('i',nx_global) j_dim = construct_io_dim('j',ny_global) month_dim = construct_io_dim('month',12) select case (shf_formulation) case ('restoring') io_sst = construct_io_field( & trim(shf_data_names(shf_data_sst)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_sst), & field_type = shf_bndy_type(shf_data_sst), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_sst)) call data_set(forcing_file,'define',io_sst) call data_set(forcing_file,'read' ,io_sst) call destroy_io_field(io_sst) !$OMP PARALLEL DO PRIVATE(iblock, n) do iblock=1,nblocks_clinic do n=1,12 SHF_DATA (:,:,iblock,shf_data_sst,n) = & TEMP_DATA(:,:,n,iblock,shf_data_sst) end do end do !$OMP END PARALLEL DO case ('alyssa_restoring', 'partially-coupled') io_sst = construct_io_field( & trim(shf_data_names(shf_data_sst)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_sst), & field_type = shf_bndy_type(shf_data_sst), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_sst)) call data_set(forcing_file,'define',io_sst) call data_set(forcing_file,'read' ,io_sst) call destroy_io_field(io_sst) !$OMP PARALLEL DO PRIVATE(iblock, n) do iblock=1,nblocks_clinic do n=1,12 SHF_DATA (:,:,iblock,shf_data_sst,n) = & TEMP_DATA(:,:,n,iblock,shf_data_sst) end do end do !$OMP END PARALLEL DO allocate(SHF_COMP(nx_block,ny_block,max_blocks_clinic, & shf_num_comps), & OCN_WGT (nx_block,ny_block,max_blocks_clinic)) SHF_COMP = c0 ! initialize case ('heating') io_flxio = construct_io_field( & trim(shf_data_names(shf_data_flxio)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_flxio), & field_type = shf_bndy_type(shf_data_flxio), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_flxio)) call data_set(forcing_file,'define',io_flxio) call data_set(forcing_file,'read' ,io_flxio) call destroy_io_field(io_flxio) !$OMP PARALLEL DO PRIVATE(iblock, n) do iblock=1,nblocks_clinic do n=1,12 SHF_DATA (:,:,iblock,shf_data_flxio,n) = & TEMP_DATA(:,:,n,iblock,shf_data_flxio) end do end do !$OMP END PARALLEL DO allocate(SHF_COMP(nx_block,ny_block,max_blocks_clinic, & shf_num_comps), & OCN_WGT (nx_block,ny_block,max_blocks_clinic)) SHF_COMP = c0 ! initialize case ('Barnier-restoring') io_tstar = construct_io_field( & trim(shf_data_names(shf_data_tstar)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_tstar), & field_type = shf_bndy_type(shf_data_tstar), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_tstar)) io_tau = construct_io_field( & trim(shf_data_names(shf_data_tau)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_tau), & field_type = shf_bndy_type(shf_data_tau), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_tau)) io_ice = construct_io_field( & trim(shf_data_names(shf_data_ice)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_ice), & field_type = shf_bndy_type(shf_data_ice), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_ice)) io_qsw = construct_io_field( & trim(shf_data_names(shf_data_qsw)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_qsw), & field_type = shf_bndy_type(shf_data_qsw), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_qsw)) call data_set(forcing_file,'define',io_tstar) call data_set(forcing_file,'define',io_tau) call data_set(forcing_file,'define',io_ice) call data_set(forcing_file,'define',io_qsw) call data_set(forcing_file,'read',io_tstar) call data_set(forcing_file,'read',io_tau) call data_set(forcing_file,'read',io_ice) call data_set(forcing_file,'read',io_qsw) !$OMP PARALLEL DO PRIVATE(iblock,n) do iblock=1,nblocks_clinic do n=1,12 SHF_DATA (:,:,iblock,shf_data_tstar,n) = & TEMP_DATA(:,:,n,iblock,shf_data_tstar) SHF_DATA (:,:,iblock,shf_data_tau,n) = & TEMP_DATA(:,:,n,iblock,shf_data_tau)*seconds_in_day SHF_DATA (:,:,iblock,shf_data_ice,n) = & TEMP_DATA(:,:,n,iblock,shf_data_ice) SHF_DATA (:,:,iblock,shf_data_qsw,n) = & TEMP_DATA(:,:,n,iblock,shf_data_qsw) end do end do !$OMP END PARALLEL DO call destroy_io_field(io_tstar) call destroy_io_field(io_tau) call destroy_io_field(io_ice) call destroy_io_field(io_qsw) case ('bulk-NCEP') io_sst = construct_io_field( & trim(shf_data_names(shf_data_sst)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_sst), & field_type = shf_bndy_type(shf_data_sst), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_sst)) io_tair = construct_io_field( & trim(shf_data_names(shf_data_tair)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_tair), & field_type = shf_bndy_type(shf_data_tair), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_tair)) io_qair = construct_io_field( & trim(shf_data_names(shf_data_qair)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_qair), & field_type = shf_bndy_type(shf_data_qair), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_qair)) io_qsw = construct_io_field( & trim(shf_data_names(shf_data_qsw)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_qsw), & field_type = shf_bndy_type(shf_data_qsw), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_qsw)) io_cldfrac = construct_io_field( & trim(shf_data_names(shf_data_cldfrac)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_cldfrac), & field_type = shf_bndy_type(shf_data_cldfrac), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_cldfrac)) io_windspd = construct_io_field( & trim(shf_data_names(shf_data_windspd)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_windspd), & field_type = shf_bndy_type(shf_data_windspd), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_windspd)) call data_set(forcing_file, 'define', io_sst) call data_set(forcing_file, 'define', io_tair) call data_set(forcing_file, 'define', io_qair) call data_set(forcing_file, 'define', io_qsw) call data_set(forcing_file, 'define', io_cldfrac) call data_set(forcing_file, 'define', io_windspd) call data_set(forcing_file, 'read', io_sst) call data_set(forcing_file, 'read', io_tair) call data_set(forcing_file, 'read', io_qair) call data_set(forcing_file, 'read', io_qsw) call data_set(forcing_file, 'read', io_cldfrac) call data_set(forcing_file, 'read', io_windspd) !$OMP PARALLEL DO PRIVATE(iblock, n) do iblock=1,nblocks_clinic do n=1,12 SHF_DATA (:,:,iblock,shf_data_sst,n) = & TEMP_DATA(:,:,n,iblock,shf_data_sst) SHF_DATA (:,:,iblock,shf_data_tair,n) = & TEMP_DATA(:,:,n,iblock,shf_data_tair) SHF_DATA (:,:,iblock,shf_data_qair,n) = & TEMP_DATA(:,:,n,iblock,shf_data_qair) SHF_DATA (:,:,iblock,shf_data_qsw,n) = & TEMP_DATA(:,:,n,iblock,shf_data_qsw) SHF_DATA (:,:,iblock,shf_data_cldfrac,n) = & TEMP_DATA(:,:,n,iblock,shf_data_cldfrac) SHF_DATA (:,:,iblock,shf_data_windspd,n) = & TEMP_DATA(:,:,n,iblock,shf_data_windspd) end do end do !$OMP END PARALLEL DO call destroy_io_field(io_sst) call destroy_io_field(io_tair) call destroy_io_field(io_qair) call destroy_io_field(io_qsw) call destroy_io_field(io_cldfrac) call destroy_io_field(io_windspd) allocate( SHF_COMP(nx_block,ny_block,max_blocks_clinic, & shf_num_comps), & OCN_WGT(nx_block,ny_block,max_blocks_clinic)) SHF_COMP = c0 ! initialize end select deallocate(TEMP_DATA) call data_set(forcing_file,'close') call destroy_file(forcing_file) !*** renormalize values if necessary to compensate for different !*** units. do n = 1,shf_data_num_fields if (shf_data_renorm(n) /= c1) SHF_DATA(:,:,:,n,:) = & shf_data_renorm(n)*SHF_DATA(:,:,:,n,:) enddo if (my_task == master_task) then write(stdout,blank_fmt) write(stdout,'(a24,a)') ' SHF Monthly file read: ', & trim(shf_filename) endif !----------------------------------------------------------------------- ! ! surface temperature specified every n-hours, where the n-hour ! increment should be specified with namelist input ! (shf_data_inc). only as many times as are necessary based on ! the order of the temporal interpolation scheme ! (shf_interp_order) reside in memory at any given time. ! !----------------------------------------------------------------------- case ('n-hour') allocate(SHF_DATA(nx_block,ny_block,max_blocks_clinic, & shf_data_num_fields,0:shf_interp_order)) SHF_DATA = c0 call find_forcing_times(shf_data_time, shf_data_inc, & shf_interp_type, shf_data_next, & shf_data_time_min_loc, shf_data_update, & shf_data_type) do n = 1, shf_interp_order call get_forcing_filename(forcing_filename, shf_filename, & shf_data_time(n), shf_data_inc) if (my_task == master_task) then write(stdout,blank_fmt) write(stdout,'(a23,a)') ' SHF n-hour about to file read: ', & trim(forcing_filename) endif forcing_file = construct_file(shf_file_fmt, & full_name=trim(forcing_filename), & record_length = rec_type_dbl, & recl_words = nx_global*ny_global) call data_set(forcing_file,'open_read') i_dim = construct_io_dim('i',nx_global) j_dim = construct_io_dim('j',ny_global) select case (shf_formulation) case ('heating') io_flxio = construct_io_field( & trim(shf_data_names(shf_data_flxio)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_flxio), & field_type = shf_bndy_type(shf_data_flxio), & d2d_array=SHF_DATA(:,:,:,shf_data_flxio,n)) call data_set(forcing_file,'define',io_flxio) call data_set(forcing_file,'read' ,io_flxio) call destroy_io_field(io_flxio) case ('restoring','partially-coupled','alyssa_restoring') io_sst = construct_io_field( & trim(shf_data_names(shf_data_sst)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_sst), & field_type = shf_bndy_type(shf_data_sst), & d2d_array=SHF_DATA(:,:,:,shf_data_sst,n)) call data_set(forcing_file,'define',io_sst) call data_set(forcing_file,'read' ,io_sst) call destroy_io_field(io_sst) case ('Barnier-restoring') io_tstar = construct_io_field( & trim(shf_data_names(shf_data_tstar)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_tstar), & field_type = shf_bndy_type(shf_data_tstar), & d2d_array=SHF_DATA(:,:,:,shf_data_tstar,n)) io_tau = construct_io_field( & trim(shf_data_names(shf_data_tau)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_tau), & field_type = shf_bndy_type(shf_data_tau), & d2d_array=SHF_DATA(:,:,:,shf_data_tau ,n)) io_ice = construct_io_field( & trim(shf_data_names(shf_data_ice)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_ice), & field_type = shf_bndy_type(shf_data_ice), & d2d_array=SHF_DATA(:,:,:,shf_data_ice ,n)) io_qsw = construct_io_field( & trim(shf_data_names(shf_data_qsw)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_qsw), & field_type = shf_bndy_type(shf_data_qsw), & d2d_array=SHF_DATA(:,:,:,shf_data_qsw ,n)) call data_set(forcing_file,'define',io_tstar) call data_set(forcing_file,'define',io_tau) call data_set(forcing_file,'define',io_ice) call data_set(forcing_file,'define',io_qsw) call data_set(forcing_file,'read',io_tstar) call data_set(forcing_file,'read',io_tau) call data_set(forcing_file,'read',io_ice) call data_set(forcing_file,'read',io_qsw) call destroy_io_field(io_tstar) call destroy_io_field(io_tau) call destroy_io_field(io_ice) call destroy_io_field(io_qsw) SHF_DATA(:,:,:,shf_data_tau ,n) = & SHF_DATA(:,:,:,shf_data_tau ,n)*seconds_in_day case ('bulk-NCEP') io_sst = construct_io_field( & trim(shf_data_names(shf_data_sst)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_sst), & field_type = shf_bndy_type(shf_data_sst), & d2d_array=SHF_DATA(:,:,:,shf_data_sst,n)) io_tair = construct_io_field( & trim(shf_data_names(shf_data_tair)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_tair), & field_type = shf_bndy_type(shf_data_tair), & d2d_array=SHF_DATA(:,:,:,shf_data_tair,n)) io_qair = construct_io_field( & trim(shf_data_names(shf_data_qair)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_qair), & field_type = shf_bndy_type(shf_data_qair), & d2d_array=SHF_DATA(:,:,:,shf_data_qair,n)) io_qsw = construct_io_field( & trim(shf_data_names(shf_data_qsw)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_qsw), & field_type = shf_bndy_type(shf_data_qsw), & d2d_array=SHF_DATA(:,:,:,shf_data_qsw,n)) io_cldfrac = construct_io_field( & trim(shf_data_names(shf_data_cldfrac)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_cldfrac), & field_type = shf_bndy_type(shf_data_cldfrac), & d2d_array=SHF_DATA(:,:,:,shf_data_cldfrac,n)) io_windspd = construct_io_field( & trim(shf_data_names(shf_data_windspd)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_windspd), & field_type = shf_bndy_type(shf_data_windspd), & d2d_array=SHF_DATA(:,:,:,shf_data_windspd,n)) call data_set(forcing_file, 'define', io_sst) call data_set(forcing_file, 'define', io_tair) call data_set(forcing_file, 'define', io_qair) call data_set(forcing_file, 'define', io_qsw) call data_set(forcing_file, 'define', io_cldfrac) call data_set(forcing_file, 'define', io_windspd) call data_set(forcing_file, 'read', io_sst) call data_set(forcing_file, 'read', io_tair) call data_set(forcing_file, 'read', io_qair) call data_set(forcing_file, 'read', io_qsw) call data_set(forcing_file, 'read', io_cldfrac) call data_set(forcing_file, 'read', io_windspd) call destroy_io_field(io_sst) call destroy_io_field(io_tair) call destroy_io_field(io_qair) call destroy_io_field(io_qsw) call destroy_io_field(io_cldfrac) call destroy_io_field(io_windspd) end select call data_set(forcing_file,'close') call destroy_file(forcing_file) if (my_task == master_task) then write(stdout,blank_fmt) write(stdout,'(a23,a)') ' SHF n-hour file read: ', & trim(forcing_filename) endif enddo if (shf_formulation == 'bulk-NCEP' .or. & shf_formulation == 'partially-coupled') then allocate(SHF_COMP(nx_block,ny_block,max_blocks_clinic, & shf_num_comps), & OCN_WGT(nx_block,ny_block,max_blocks_clinic)) SHF_COMP = c0 ! initialize endif if (shf_formulation == 'alyssa_restoring' .or. & shf_formulation == 'heating' ) then allocate(SHF_COMP(nx_block,ny_block,max_blocks_clinic, & shf_num_comps)) SHF_COMP = c0 ! initialize endif !*** renormalize values if necessary to compensate for different !*** units. do n = 1,shf_data_num_fields if (shf_data_renorm(n) /= c1) SHF_DATA(:,:,:,n,:) = & shf_data_renorm(n)*SHF_DATA(:,:,:,n,:) enddo case default call exit_POP(sigAbort,'init_shf: Unknown value for shf_data_type') end select !----------------------------------------------------------------------- ! ! now check interpolation period (shf_interp_freq) to set the ! time for the next temporal interpolation (shf_interp_next). ! ! if no interpolation is to be done, set next interpolation time ! to a large number so the surface heat flux update test ! in routine set_surface_forcing will always be false. ! ! if interpolation is to be done every n-hours, find the first ! interpolation time greater than the current time. ! ! if interpolation is to be done every timestep, set next interpolation ! time to a large negative number so the surface heat flux ! update test in routine set_surface_forcing will always be true. ! !----------------------------------------------------------------------- select case (shf_interp_freq) case ('never') shf_interp_next = never shf_interp_last = never shf_interp_inc = c0 case ('n-hour') call find_interp_time(shf_interp_inc, shf_interp_next) case ('every-timestep') shf_interp_next = always shf_interp_inc = c0 case default call exit_POP(sigAbort, & 'init_shf: Unknown value for shf_interp_freq') end select if (nsteps_total == 0) shf_interp_last = thour00 !----------------------------------------------------------------------- ! ! echo forcing options to stdout. ! !----------------------------------------------------------------------- shf_data_label = 'Surface Heat Flux' call echo_forcing_options(shf_data_type, shf_formulation, & shf_data_inc, shf_interp_freq, & shf_interp_type, shf_interp_inc, & shf_data_label) !----------------------------------------------------------------------- !EOC call flushm (stdout) end subroutine init_shf !*********************************************************************** !BOP ! !IROUTINE: set_shf ! !INTERFACE: subroutine set_shf(STF) ! !DESCRIPTION: ! Updates the current value of the surface heat flux array ! (shf) by interpolating to the current time or calculating ! fluxes based on states at current time. If new data are ! required for interpolation, new data are read. ! ! !REVISION HISTORY: ! same as module ! !INPUT/OUTPUT PARAMETERS: real (r8), dimension(nx_block,ny_block,nt,max_blocks_clinic), & intent(inout) :: & STF ! surface tracer fluxes at current timestep real (r8) :: stf_sum1 ! for global sum diag !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & iblock !----------------------------------------------------------------------- ! ! check if new data is necessary for interpolation. if yes, then ! shuffle indices in SHF_DATA and shf_data_time arrays ! and read in new data if necessary ('n-hour' case). note ! that no new data is necessary for 'analytic' and 'annual' cases. ! then perform interpolation using updated shf data or compute fluxes ! based on current or interpolated state data. ! !----------------------------------------------------------------------- select case(shf_data_type) case ('analytic') select case (shf_formulation) case ('restoring') !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic STF(:,:,1,iblock) = (SHF_DATA(:,:,iblock,shf_data_sst,1) - & TRACER(:,:,1,1,curtime,iblock))* & shf_restore_rtau*dz(1) end do !$OMP END PARALLEL DO end select case ('annual') select case (shf_formulation) case ('restoring') !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic STF(:,:,1,iblock) = (SHF_DATA(:,:,iblock,shf_data_sst,1) - & TRACER(:,:,1,1,curtime,iblock))* & shf_restore_rtau*dz(1) end do !$OMP END PARALLEL DO case ('alyssa_restoring') call calc_shf_alyssa_restoring(1) case ('heating') call calc_shf_heating(1) case ('Barnier-restoring') call calc_shf_barnier_restoring(STF,1) case ('bulk-NCEP') call calc_shf_bulk_ncep(STF,1) case ('partially-coupled') call calc_shf_partially_coupled(1) end select case ('monthly-equal','monthly-calendar') shf_data_label = 'SHF Monthly' if (thour00 >= shf_data_update) then call update_forcing_data(shf_data_time, shf_data_time_min_loc,& shf_interp_type, shf_data_next, & shf_data_update, shf_data_type, & shf_data_inc, SHF_DATA(:,:,:,:,1:12),& shf_data_renorm, & shf_data_label, shf_data_names, & shf_bndy_loc, shf_bndy_type, & shf_filename, shf_file_fmt) endif if (thour00 >= shf_interp_next .or. nsteps_run == 0) then call interpolate_forcing(SHF_DATA(:,:,:,:,0), & SHF_DATA(:,:,:,:,1:12), & shf_data_time, shf_interp_type, & shf_data_time_min_loc, shf_interp_freq, & shf_interp_inc, shf_interp_next, & shf_interp_last, nsteps_run) if (nsteps_run /= 0) shf_interp_next = & shf_interp_next + shf_interp_inc endif select case (shf_formulation) case ('restoring') !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic STF(:,:,1,iblock) = (SHF_DATA(:,:,iblock,shf_data_sst,0) - & TRACER(:,:,1,1,curtime,iblock))* & shf_restore_rtau*dz(1) end do !$OMP END PARALLEL DO case ('alyssa_restoring') call calc_shf_alyssa_restoring(12) case ('heating') call calc_shf_heating(12) case ('Barnier-restoring') call calc_shf_barnier_restoring(STF,12) case ('bulk-NCEP') call calc_shf_bulk_ncep(STF,12) case ('partially-coupled') call calc_shf_partially_coupled(12) end select case('n-hour') shf_data_label = 'SHF n-hour' if (thour00 >= shf_data_update) then if (my_task == master_task) then write(stdout,blank_fmt) write(stdout,'(a23)') ' SHF n-hour update forcing_data' endif call update_forcing_data(shf_data_time, shf_data_time_min_loc,& shf_interp_type, shf_data_next, & shf_data_update, shf_data_type, & shf_data_inc, & SHF_DATA(:,:,:,:,1:shf_interp_order),& shf_data_renorm, & shf_data_label, shf_data_names, & shf_bndy_loc, shf_bndy_type, & shf_filename, shf_file_fmt) endif if (thour00 >= shf_interp_next .or. nsteps_run == 0) then if (my_task == master_task) then write(stdout,blank_fmt) write(stdout,'(a23)') ' SHF n-hour interpolate forcing_data' endif call interpolate_forcing(SHF_DATA(:,:,:,:,0), & SHF_DATA(:,:,:,:,1:shf_interp_order), & shf_data_time, shf_interp_type, & shf_data_time_min_loc, shf_interp_freq, & shf_interp_inc, shf_interp_next, & shf_interp_last, nsteps_run) if (nsteps_run /= 0) shf_interp_next = & shf_interp_next + shf_interp_inc stf_sum1 = global_sum(SHF_DATA(:,:,:,shf_data_flxio,0),distrb_clinic,field_loc_center) if (my_task == master_task) then write(stdout,blank_fmt) write(stdout,'(a30,(e12.3))') & 'SHF_DATA global sum interp_next ', stf_sum1 endif endif select case (shf_formulation) case ('restoring') !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic STF(:,:,1,iblock) = (SHF_DATA(:,:,iblock,shf_data_sst,0) - & TRACER(:,:,1,1,curtime,iblock))* & shf_restore_rtau*dz(1) end do !$OMP END PARALLEL DO case ('alyssa_restoring') call calc_shf_alyssa_restoring(shf_interp_order) case ('heating') call calc_shf_heating(shf_interp_order) case ('Barnier-restoring') call calc_shf_barnier_restoring(STF, shf_interp_order) case ('partially-coupled') call calc_shf_partially_coupled(shf_interp_order) case ('bulk-NCEP') call calc_shf_bulk_ncep(STF, shf_interp_order) end select end select ! shf_data_type !----------------------------------------------------------------------- !EOC end subroutine set_shf !*********************************************************************** !BOP ! !IROUTINE: calc_shf_heating ! !INTERFACE: subroutine calc_shf_heating(time_dim) ! !DESCRIPTION: ! Calculates some stuff ! for heating formulation. These components will later be ! added to shf_comp_cpl component in set_coupled_forcing ! (forcing_coupled) to form the total surface heat flux. ! ! The only forcing dataset (on t-grid) is ! shf_data_flxio, applied shf ! ! ! !REVISION HISTORY: ! same as module ! !INPUT PARAMETERS: integer (int_kind), intent(in) :: & time_dim !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & n, now, k, & iblock ! local address of current block type(block) :: & this_block ! block info for current block real (r8) :: & dttmp, & ! temporary time step variable stf_sum0, stf_sum1, stf_sum2 !----------------------------------------------------------------------- ! ! set location of interpolated data ! !----------------------------------------------------------------------- if (shf_data_type == 'annual') then now = 1 else now = 0 endif !----------------------------------------------------------------------- ! ! compute forcing terms for each block ! !----------------------------------------------------------------------- stf_sum0 = global_sum(SHF_DATA(:,:,:,shf_data_flxio,now),distrb_clinic,field_loc_center) stf_sum1 = global_sum(SHF_COMP(:,:,:,shf_comp_heatflux),distrb_clinic,field_loc_center) if (my_task == master_task) then write(stdout,'(a30,(e12.3))') & 'HEATING SHF_COMP global sums 1 and 2 ', stf_sum1 endif !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) SHF_COMP(:,:,iblock,shf_comp_heatflux) = & SHF_MASK(:,:,iblock)* & SHF_DATA(:,:,iblock,shf_data_flxio,now) !---------------------------------------------------------------------- ! ! convert to model units: (W/m^2) to (C*cm/s) ! !---------------------------------------------------------------------- SHF_COMP(:,:,iblock,shf_comp_heatflux) = & SHF_COMP(:,:,iblock,shf_comp_heatflux)*hflux_factor end do ! block loop !$OMP END PARALLEL DO stf_sum2 = global_sum(SHF_COMP(:,:,:,shf_comp_heatflux),distrb_clinic,field_loc_center) if (my_task == master_task) then write(stdout,'(a30,3(e12.4))') & 'HEATFLUX SHF_COMP global sums ', stf_sum0, stf_sum1, stf_sum2 endif !---------------------------------------------------------------------- !EOC end subroutine calc_shf_heating !*********************************************************************** !BOP ! !IROUTINE: calc_shf_alyssa_restoring ! !INTERFACE: subroutine calc_shf_alyssa_restoring(time_dim) ! !DESCRIPTION: ! Calculates some stuff ! for alyssa_restoring formulation. These components will later be ! added to shf_comp_cpl component in set_coupled_forcing ! (forcing_coupled) to form the total surface heat flux. ! ! The only forcing dataset (on t-grid) is ! shf_data_sst, restoring SST ! ! ! !REVISION HISTORY: ! same as module ! !INPUT PARAMETERS: integer (int_kind), intent(in) :: & time_dim !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & n, now, k, & iblock ! local address of current block type(block) :: & this_block ! block info for current block real (r8) :: & dttmp, & ! temporary time step variable stf_sum1, stf_sum2 !----------------------------------------------------------------------- ! ! set location of interpolated data ! !----------------------------------------------------------------------- if (shf_data_type == 'annual') then now = 1 else now = 0 endif !----------------------------------------------------------------------- ! ! compute forcing terms for each block ! !----------------------------------------------------------------------- stf_sum1 = global_sum(SHF_COMP(:,:,:,shf_comp_heatflux),distrb_clinic,field_loc_center) !$OMP PARALLEL DO PRIVATE(iblock, this_block) do iblock=1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) SHF_COMP(:,:,iblock,shf_comp_heatflux) = shf_restore_rtau*dz(1)* & SHF_MASK(:,:,iblock)* & (SHF_DATA(:,:,iblock,shf_data_sst,now) - & TRACER(:,:,1,1,curtime,iblock)) !---------------------------------------------------------------------- ! ! convert to model units: (W/m^2) to (C*cm/s) ! !---------------------------------------------------------------------- ! SHF_COMP(:,:,iblock,shf_comp_heatflux) = & ! SHF_COMP(:,:,iblock,shf_comp_heatflux)*hflux_factor end do ! block loop !$OMP END PARALLEL DO stf_sum2 = global_sum(SHF_COMP(:,:,:,shf_comp_heatflux),distrb_clinic,field_loc_center) if (my_task == master_task) then write(stdout,'(a30,2(e12.3))') & 'HEATFLUX SHF_COMP global sums 1 and 2 ', stf_sum1, stf_sum2 endif !---------------------------------------------------------------------- !EOC end subroutine calc_shf_alyssa_restoring !*********************************************************************** !BOP ! !IROUTINE: calc_shf_barnier_restoring ! !INTERFACE: subroutine calc_shf_barnier_restoring(STF, time_dim) ! !DESCRIPTION: ! calculates surface heat fluxes ! ! !REVISION HISTORY: ! same as module ! !INPUT PARAMETERS: integer (int_kind), intent(in) :: & time_dim ! number of time points for interpolation ! !INPUT/OUTPUT PARAMETERS: real (r8), dimension(nx_block,ny_block,nt,max_blocks_clinic), & intent(inout) :: & STF ! surface heat flux at current timestep !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & nearest_data, now, &! indices for nearest,interpolated time slices iblock ! local address of current block real (r8) :: & tcheck, ice_cutoff, ice_restore_temp !----------------------------------------------------------------------- ! ! local parameters ! !----------------------------------------------------------------------- ice_cutoff = 0.9_r8 ice_restore_temp = -2.0_r8 !----------------------------------------------------------------------- ! ! if annual forcing, no interpolation to current time is necessary. ! otherwise, interpolated fields in index=0 slice of data array ! !----------------------------------------------------------------------- if (shf_data_type == 'annual') then now = 1 nearest_data = 1 else now = 0 !*** find nearest data time and use it for determining the ice !*** mask in place of interpolated field. !*** NOTE: this is for backward compatibility. perhaps !*** interpolating and using a cut-off of .45 would be acceptable. tcheck = (shf_data_update - thour00)/shf_data_inc select case(shf_interp_type) case ('nearest') nearest_data = shf_data_time_min_loc case ('linear') if (tcheck > 0.5) then nearest_data = shf_data_time_min_loc else nearest_data = shf_data_time_min_loc + 1 endif case ('4point') if (tcheck > 0.5) then nearest_data = shf_data_time_min_loc + 1 else nearest_data = shf_data_time_min_loc + 2 endif end select if ((nearest_data - time_dim) > 0 ) nearest_data = & nearest_data - time_dim endif !----------------------------------------------------------------------- ! ! calculate forcing for each block ! !----------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic !----------------------------------------------------------------------- ! ! check for ice concentration >= ice_cutoff in the nearest month. ! if there is ice, set TAU to be constant and set TSTAR to ! ice_restore_temp. ! !----------------------------------------------------------------------- where (SHF_DATA(:,:,iblock,shf_data_ice,nearest_data) >= & ice_cutoff) SHF_DATA(:,:,iblock,shf_data_tau,now) = shf_restore_tau SHF_DATA(:,:,iblock,shf_data_tstar,now) = ice_restore_temp endwhere !----------------------------------------------------------------------- ! ! apply restoring only where TAU is defined. ! !----------------------------------------------------------------------- where (SHF_DATA(:,:,iblock,shf_data_tau,now) > c0) STF(:,:,1,iblock) =(SHF_DATA(:,:,iblock,shf_data_tstar,now) - & TRACER(:,:,1,1,curtime,iblock))* & dz(1)/SHF_DATA(:,:,iblock,shf_data_tau,now) elsewhere STF(:,:,1,iblock) = c0 end where !----------------------------------------------------------------------- ! ! copy penetrative shortwave into its own array (SHF_QSW) and ! convert to T flux from W/m^2. ! !----------------------------------------------------------------------- SHF_QSW(:,:,iblock) = SHF_DATA(:,:,iblock,shf_data_qsw,now)* & hflux_factor SHF_QSW_RAW(:,:,iblock) = SHF_QSW(:,:,iblock) end do !$OMP END PARALLEL DO !----------------------------------------------------------------------- !EOC end subroutine calc_shf_barnier_restoring !*********************************************************************** !BOP ! !IROUTINE: calc_shf_bulk_ncep ! !INTERFACE: subroutine calc_shf_bulk_ncep(STF, time_dim) ! !DESCRIPTION: ! Calculates surface heat flux from a combination of ! air-sea fluxes (based on air temperature, specific humidity, ! solar short wave flux, cloud fraction, and windspeed) ! and restoring terms (due to restoring fields of SST). ! ! Notes: ! the forcing data (on t-grid) ! are computed as SHF\_DATA(:,:,shf\_comp\_*,now) where: ! ! shf\_data\_sst, restoring SST (C) ! shf\_data\_tair, surface air temp. at tair\_height (K) ! shf\_data\_qair, specific humidity at qair\_height (kg/kg) ! shf\_data\_qsw, surface short wave flux ($W/m^2$) ! shf\_data\_cldfrac, cloud fraction (0.-1.) ! shf\_data\_windspd , windspeed at height windspd\_height (m/s) ! ! !REVISION HISTORY: ! same as module ! !INPUT PARAMETERS: integer (int_kind), intent(in) :: & time_dim ! !INPUT/OUTPUT PARAMETERS: real (r8), dimension(nx_block,ny_block,nt,max_blocks_clinic), & intent(inout) :: & STF ! surface tracer fluxes at current timestep !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & n, now, k, & iblock ! local address of current block real (r8), dimension(nx_block,ny_block) :: & RTEA, &! work array FRAC_CLOUD_COVER ! fractional cloud cover real (r8), parameter :: & windspd_height = 10.0_r8, & tair_height = 2.0_r8, & qair_height = 2.0_r8, & qair_mod_fact = 0.94_r8, &! factor to modify humidity sw_mod_fact = 0.875_r8, &! factor to modify short-wave flux sw_mod_albedo = 0.93_r8 ! factor to modify albedo !----------------------------------------------------------------------- ! ! shf_weak_restore= weak(non-ice) restoring heatflux per degree (W/m2/C) ! shf_strong_restore= strong (ice) .. .. .. .. .. .. ! ! to calculate restoring factors, use mixed layer of 50m, ! and restoring time constant tau (days): ! ! Q (W/m2/C) ! tau = 6 : 386.0 ! tau = 30 : 77.2 ! tau = 182.5: 12.0 ! tau = 365 : 6.0 ! tau = 730 : 3.0 ! tau = Inf : 0.0 ! !--------------------------------------------------------------------- !----------------------------------------------------------------------- ! ! set location of interpolated data ! !----------------------------------------------------------------------- if (shf_data_type == 'annual') then now = 1 else now = 0 endif !---------------------------------------------------------------------- ! ! compute ocean weights (fraction of ocean vs. ice) every timestep ! !---------------------------------------------------------------------- call ocean_weights(now) !---------------------------------------------------------------------- ! ! do the rest of the computation for each block ! !---------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblock,FRAC_CLOUD_COVER,RTEA) do iblock=1,nblocks_clinic !---------------------------------------------------------------------- ! ! compute sensible and latent heat fluxes ! !---------------------------------------------------------------------- call sen_lat_flux( & SHF_DATA(:,:,iblock,shf_data_windspd,now), windspd_height, & TRACER(:,:,1,1,curtime,iblock), & SHF_DATA(:,:,iblock,shf_data_tair,now), tair_height, & SHF_DATA(:,:,iblock,shf_data_qair,now), qair_height, & T0_Kelvin, SHF_COMP(:,:,iblock,shf_comp_qsens), & SHF_COMP(:,:,iblock,shf_comp_qlat)) !---------------------------------------------------------------------- ! ! compute short wave and long wave fluxes ! !---------------------------------------------------------------------- SHF_COMP(:,:,iblock,shf_comp_qsw) = sw_mod_albedo*sw_mod_fact* & SHF_DATA(:,:,iblock,shf_data_qsw,now) FRAC_CLOUD_COVER = c1 - CCINT(:,:,iblock)* & SHF_DATA(:,:,iblock,shf_data_cldfrac,now)**2 RTEA = sqrt( c1000*SHF_DATA(:,:,iblock,shf_data_qair,now) & /(0.622_r8 + 0.378_r8 & *SHF_DATA(:,:,iblock,shf_data_qair,now)) + eps2 ) SHF_COMP(:,:,iblock,shf_comp_qlw) = -emissivity*stefan_boltzmann*& SHF_DATA(:,:,iblock,shf_data_tair,now)**3* & (SHF_DATA(:,:,iblock,shf_data_tair,now)* & (0.39_r8-0.05_r8*RTEA)*FRAC_CLOUD_COVER + & c4*(TRACER(:,:,1,1,curtime,iblock) + & T0_Kelvin - & SHF_DATA(:,:,iblock,shf_data_tair,now)) ) !---------------------------------------------------------------------- ! ! weak temperature restoring term (note: OCN_WGT = 0 at land pts) ! !---------------------------------------------------------------------- SHF_COMP(:,:,iblock,shf_comp_wrest) = shf_weak_restore* & MASK_SR(:,:,iblock)*OCN_WGT(:,:,iblock)* & (SHF_DATA(:,:,iblock,shf_data_sst,now) - & TRACER(:,:,1,1,curtime,iblock)) !---------------------------------------------------------------------- ! ! strong temperature restoring term ! !---------------------------------------------------------------------- where (KMT(:,:,iblock) > 0) SHF_COMP(:,:,iblock,shf_comp_srest) = shf_strong_restore* & (c1-OCN_WGT(:,:,iblock))* & (SHF_DATA(:,:,iblock,shf_data_sst,now) - & TRACER(:,:,1,1,curtime,iblock)) endwhere where (KMT(:,:,iblock) > 0 .and. MASK_SR(:,:,iblock) == 0) SHF_COMP(:,:,iblock,shf_comp_srest) = shf_strong_restore_ms* & (SHF_DATA(:,:,iblock,shf_data_sst,now) - & TRACER(:,:,1,1,curtime,iblock)) endwhere !---------------------------------------------------------------------- ! ! net surface heat flux (W/m^2) (except penetrative shortwave flux) ! convert to model units ! !---------------------------------------------------------------------- STF(:,:,1,iblock) = hflux_factor* & (OCN_WGT(:,:,iblock)*MASK_SR(:,:,iblock)* & (SHF_COMP(:,:,iblock,shf_comp_qsens) + & SHF_COMP(:,:,iblock,shf_comp_qlat ) + & SHF_COMP(:,:,iblock,shf_comp_qlw )) + & SHF_COMP(:,:,iblock,shf_comp_wrest) + & SHF_COMP(:,:,iblock,shf_comp_srest)) !---------------------------------------------------------------------- ! ! copy penetrative shortwave flux into its own array (SHF_QSW) and ! convert it and SHF to model units. ! !---------------------------------------------------------------------- SHF_QSW(:,:,iblock) = SHF_COMP(:,:,iblock,shf_comp_qsw)* & OCN_WGT(:,:,iblock)*MASK_SR(:,:,iblock)* & hflux_factor SHF_QSW_RAW(:,:,iblock) = SHF_COMP(:,:,iblock,shf_comp_qsw)* & hflux_factor end do !$OMP END PARALLEL DO !---------------------------------------------------------------------- !EOC end subroutine calc_shf_bulk_ncep !*********************************************************************** !BOP ! !IROUTINE: calc_shf_partially_coupled ! !INTERFACE: subroutine calc_shf_partially_coupled(time_dim) ! !DESCRIPTION: ! Calculates weak and strong restoring components of surface heat flux ! for partially-coupled formulation. These components will later be ! added to shf_comp_cpl component in set_coupled_forcing ! (forcing_coupled) to form the total surface heat flux. ! ! The only forcing dataset (on t-grid) is ! shf_data_sst, restoring SST ! ! ! !REVISION HISTORY: ! same as module ! !INPUT PARAMETERS: integer (int_kind), intent(in) :: & time_dim !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & n, now, k, & iblock ! local address of current block real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: & WORK1 ! work array !----------------------------------------------------------------------- ! ! set location of interpolated data ! !----------------------------------------------------------------------- if (shf_data_type == 'annual') then now = 1 else now = 0 endif !---------------------------------------------------------------------- ! ! compute ocean weights (fraction of ocean vs. ice) every timestep, ! if needed ! !---------------------------------------------------------------------- if ( .not. luse_cpl_ifrac ) then call ocean_weights (now) WORK1 = OCN_WGT*MASK_SR else WORK1 = MASK_SR endif !---------------------------------------------------------------------- ! ! do the rest of the computation for each block ! !---------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic !---------------------------------------------------------------------- ! ! weak temperature restoring term (note: MASK_SR = 0. at land and ! marginal sea points) ! note that weak restoring may be applied to every non-marginal-sea ! ocean point. ! !---------------------------------------------------------------------- SHF_COMP(:,:,iblock,shf_comp_wrest) = shf_weak_restore* & WORK1(:,:,iblock)* & (SHF_DATA(:,:,iblock,shf_data_sst,now) - & TRACER(:,:,1,1,curtime,iblock)) !---------------------------------------------------------------------- ! ! strong temperature restoring term ! note that strong restoring may be applied only in marginal seas. ! in under-ice regions, the ice formation term may replace the ! strong-restoring term. ! !---------------------------------------------------------------------- where (KMT(:,:,iblock) > 0) SHF_COMP(:,:,iblock,shf_comp_srest) = shf_strong_restore* & (c1-OCN_WGT(:,:,iblock))* & (SHF_DATA(:,:,iblock,shf_data_sst,now) - & TRACER(:,:,1,1,curtime,iblock)) endwhere where (KMT(:,:,iblock) > 0 .and. MASK_SR(:,:,iblock) == 0) SHF_COMP(:,:,iblock,shf_comp_srest) = shf_strong_restore_ms* & (SHF_DATA(:,:,iblock,shf_data_sst,now) - & TRACER(:,:,1,1,curtime,iblock)) endwhere !---------------------------------------------------------------------- ! ! convert to model units: (W/m^2) to (C*cm/s) ! !---------------------------------------------------------------------- SHF_COMP(:,:,iblock,shf_comp_wrest) = & SHF_COMP(:,:,iblock,shf_comp_wrest)*hflux_factor SHF_COMP(:,:,iblock,shf_comp_srest) = & SHF_COMP(:,:,iblock,shf_comp_srest)*hflux_factor end do !$OMP END PARALLEL DO !---------------------------------------------------------------------- !EOC end subroutine calc_shf_partially_coupled !*********************************************************************** !BOP ! !IROUTINE: sen_lat_flux ! !INTERFACE: subroutine sen_lat_flux(US,hu,SST,TH,ht,QH,hq,tk0,HS,HL) ! !DESCRIPTION: ! Computes latent and sensible heat fluxes following bulk formulae and ! coefficients in Large and Pond (1981; 1982) ! ! Assume 1) a neutral 10m drag coefficient = cdn = ! .0027/u10 + .000142 + .0000764 u10 ! 2) a neutral 10m stanton number ctn= .0327 sqrt(cdn), unstable ! ctn= .0180 sqrt(cdn), stable ! 3) a neutral 10m dalton number cen= .0346 sqrt(cdn) ! 4) the saturation humidity of air at t(k) = qsat(t) ($kg/m^3$) ! ! note 1) here, tstar = /u*, and qstar = /u*. ! 2) wind speedx should all be above a minimum speed say 0.5 m/s ! 3) with optional interation loop, niter=3, should suffice ! ! *** this version is for analyses inputs with hu = 10m and ht = hq ** ! *** also, SST enters in Celsius *************************** ! ! !REVISION HISTORY: ! same as module ! !INPUT PARAMETERS: real (r8), dimension (nx_block,ny_block), intent(in) :: & US, &! mean wind speed (m/s) at height hu (m) TH, &! mean air temperature (k) at height ht (m) QH, &! mean air humidity (kg/kg) at height hq (m) SST ! sea surface temperature (K) real (r8), intent(in) :: & hu, &! height (m) for mean wind speed ht, &! height (m) for mean air temperature hq, &! height (m) for mean air humidity tk0 ! Celsius zero point ! !OUTPUT PARAMETERS: real (r8), dimension (nx_block,ny_block), intent(out) :: & HS, &! sensible heat flux (w/m^2), into ocean HL ! latent heat flux (w/m^2), into ocean !EOP !BOC !-------------------------------------------------------------------------- ! ! local variables ! !-------------------------------------------------------------------------- real (r8), dimension (nx_block,ny_block) :: & SH,T0,DELP,DELQ,STABLETMP,RDN,RHN,USTARR,TSTARR,QSTARR,TAU, & HUOL,HTOL,HQOL,SSHUM,PSIMH,PSIXH,RD,UZN,RH,RE,QSAT real (r8) :: & ren,umin,zolmin,vonk,lapse_rate,gravity_mks,f1,refhgt,aln,czol !----------------------------------------------------------------------- ! ! constants ! !----------------------------------------------------------------------- umin = 0.5_r8 ! minimum wind speed zolmin = -100._r8 ! minimum stability parameter vonk = 0.4_r8 ! Von Karman''s constant lapse_rate = 0.01_r8 ! abiabatic lapse rate deg/m gravity_mks = grav/100.0_r8 ! gravity m/s/s f1 = 0.606_r8 refhgt = 10.0_r8 ! reference height aln = log(ht/refhgt) czol = hu*vonk*gravity_mks SH = max(US,umin) !----------------------------------------------------------------------- ! ! initial guess z/l=0.0; hu=ht=hq=z ! !----------------------------------------------------------------------- T0 = TH * (c1 + f1 * QH) ! virtual temperature (k) QSAT = 640380._r8 / exp(5107.4_r8/(SST+tk0)) SSHUM = 0.98_r8 * QSAT/rho_air ! sea surface humidity (kg/kg) DELP = TH + lapse_rate*ht - SST - tk0 ! pot temperature diff (k) DELQ = QH - SSHUM STABLETMP = 0.5_r8 + sign(0.5_r8 , DELP) RDN = sqrt(CDN(SH)) RHN = (c1-STABLETMP)* 0.0327_r8 + STABLETMP * 0.0180_r8 ren = 0.0346_r8 USTARR = RDN * SH TSTARR = RHN * DELP QSTARR = REN * DELQ !----------------------------------------------------------------------- ! ! first iteration loop ! !----------------------------------------------------------------------- HUOL = czol * (TSTARR/T0 + QSTARR/(c1/f1+QH)) / USTARR**2 HUOL = max(HUOL,zolmin) STABLETMP = 0.5_r8 + sign(0.5_r8 , HUOL) HTOL = HUOL * ht / hu HQOL = HUOL * hq / hu !----------------------------------------------------------------------- ! ! evaluate all stability functions assuming hq = ht ! !----------------------------------------------------------------------- SSHUM = max(sqrt(abs(c1 - 16._r8*HUOL)),c1) SSHUM = sqrt(SSHUM) PSIMH = -5._r8 * HUOL * STABLETMP + (c1-STABLETMP) & * log((c1+SSHUM*(c2+SSHUM))*(c1+SSHUM*SSHUM)/8._r8) & - c2*atan(SSHUM)+1.571_r8 SSHUM = max(sqrt(abs(c1 - 16._r8*HTOL)),c1) PSIXH = -5._r8*HTOL*STABLETMP + (c1-STABLETMP)*c2*log((c1+SSHUM)/c2) !----------------------------------------------------------------------- ! ! shift wind speed using old coefficient ! !----------------------------------------------------------------------- RD = RDN / (c1-RDN/vonk*PSIMH ) UZN = max(SH * RD / RDN , umin) !----------------------------------------------------------------------- ! ! update the transfer coefficients at 10 meters and neutral stability ! !----------------------------------------------------------------------- RDN = sqrt(CDN(UZN)) ren = 0.0346_r8 RHN = (c1-STABLETMP)*0.0327_r8 + STABLETMP *0.0180_r8 !----------------------------------------------------------------------- ! ! shift all coefficients to the measurement height and stability ! !----------------------------------------------------------------------- RD = RDN / (c1-RDN/vonk*PSIMH ) RH = RHN / (c1+RHN/vonk*( aln -PSIXH) ) RE = ren / (c1+ren/vonk*( aln -PSIXH) ) !----------------------------------------------------------------------- ! ! update USTARR, TSTARR, QSTARR using updated, shifted coefficients ! !----------------------------------------------------------------------- USTARR = RD * SH QSTARR = RE * DELQ TSTARR = RH * DELP !----------------------------------------------------------------------- ! ! second iteration to converge on z/l and hence the fluxes ! !----------------------------------------------------------------------- HUOL= czol * (TSTARR/T0+QSTARR/(c1/f1+QH)) / USTARR**2 HUOL= max(HUOL,zolmin) STABLETMP = 0.5_r8 + sign(0.5_r8 , HUOL) HTOL = HUOL * ht / hu HQOL = HUOL * hq / hu !----------------------------------------------------------------------- ! ! evaluate all stability functions assuming hq = ht ! !----------------------------------------------------------------------- SSHUM = max(sqrt(abs(c1 - 16.*HUOL)),c1) SSHUM = sqrt(SSHUM) PSIMH = -5._r8 * HUOL * STABLETMP + (c1-STABLETMP) & * log((c1+SSHUM*(c2+SSHUM))*(c1+SSHUM*SSHUM)/8._r8) & - c2*atan(SSHUM)+1.571_r8 SSHUM = max(sqrt(abs(c1 - 16._r8*HTOL)),c1) PSIXH = -5._r8*HTOL*STABLETMP + (c1-STABLETMP)*c2*log((c1+SSHUM)/c2) !----------------------------------------------------------------------- ! ! shift wind speed using old coefficient ! !----------------------------------------------------------------------- RD = RDN / (c1-RDN/vonk*PSIMH ) UZN = max(SH * RD / RDN , umin) !----------------------------------------------------------------------- ! ! update the transfer coefficients at 10 meters and neutral stability ! !----------------------------------------------------------------------- RDN = sqrt(CDN(UZN)) ren = 0.0346_r8 RHN = (c1-STABLETMP)*0.0327_r8 + STABLETMP*0.0180_r8 !----------------------------------------------------------------------- ! ! shift all coefficients to the measurement height and stability ! !----------------------------------------------------------------------- RD = RDN / (c1-RDN/vonk*PSIMH ) RH = RHN / (c1+RHN/vonk*( aln -PSIXH) ) RE = ren / (c1+ren/vonk*( aln -PSIXH) ) !----------------------------------------------------------------------- ! ! update USTARR, TSTARR, QSTARR using updated, shifted coefficients ! !----------------------------------------------------------------------- USTARR = RD * SH QSTARR = RE * DELQ TSTARR = RH * DELP !----------------------------------------------------------------------- ! ! done >>>> compute the fluxes ! !----------------------------------------------------------------------- TAU = rho_air * USTARR**2 TAU = TAU * US / SH HS = cp_air* TAU * TSTARR / USTARR HL = latent_heat_vapor_mks * TAU * QSTARR / USTARR !----------------------------------------------------------------------- !EOC end subroutine sen_lat_flux !*********************************************************************** !BOP ! !IROUTINE: CDN ! !INTERFACE: function CDN(UMPS) ! !DESCRIPTION: ! ! !REVISION HISTORY: ! same as module ! !INPUT PARAMETERS: real (r8), dimension(nx_block,ny_block), intent(in) :: & UMPS ! !OUTPUT PARAMETERS: real (r8), dimension(nx_block,ny_block) :: & CDN !EOP !BOC !----------------------------------------------------------------------- !----------------------------------------------------------------------- CDN = 0.0027_r8/UMPS + .000142_r8 + .0000764_r8*UMPS !----------------------------------------------------------------------- !EOC end function CDN !*********************************************************************** !BOP ! !IROUTINE: ocean_weights ! !INTERFACE: subroutine ocean_weights(now) ! !DESCRIPTION: ! Compute ocean weights (fraction of ocean vs. ice) every timestep ! ! !REVISION HISTORY: ! same as module ! !INPUT PARAMETERS: integer (int_kind), intent(in) :: & now !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & iblock !---------------------------------------------------------------------- ! ! compute ocean weights (fraction of ocean vs. ice) every timestep ! !---------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic where (SHF_DATA(:,:,iblock,shf_data_sst,now) <= & T_strong_restore_limit) OCN_WGT(:,:,iblock) = c0 elsewhere OCN_WGT(:,:,iblock) =(SHF_DATA(:,:,iblock,shf_data_sst,now) - & T_strong_restore_limit)/dT_restore_limit endwhere where (SHF_DATA(:,:,iblock,shf_data_sst,now) >= & T_weak_restore_limit) OCN_WGT(:,:,iblock) = c1 !*** zero OCN_WGT at land pts where (KMT(:,:,iblock) == 0) OCN_WGT(:,:,iblock) = c0 end do !$OMP END PARALLEL DO !----------------------------------------------------------------------- !EOC end subroutine ocean_weights end module forcing_shf !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| CESM2.1.3_sourcemods/PaxHeaders.32795/namelist_definition_pop.xml0000644000000000000000000000012413774500031021625 xustar0027 mtime=1609728025.170195 27 atime=1609728025.157124 30 ctime=1609728025.169481811 CESM2.1.3_sourcemods/namelist_definition_pop.xml0000644006307300017500000046650213774500031022221 0ustar00islasncar00000000000000 Number of processors in the baroclinic distribution. Default: Set by CESM scripts Number of processors in the barotropic distribution. Default: Set by CESM scripts Selector for method used to distribute blocks in baroclinic distribution. Valid Values: 'cartesian', 'balanced', 'spacecurve', 'blockone' Default: 'cartesian' Selector for method used to distribute blocks in barotropic distribution. Valid Values: 'cartesian', 'balanced', 'spacecurve', 'blockone' Default: 'cartesian' Selector for type of boundary used in the logical east-west direction for global domain. Valid Values: 'cyclic', 'closed' Default: 'cyclic' Selector for type of boundary used in the logical north-south direction for global domain. Valid Values: 'cyclic', 'closed', 'tripole' Default: 'closed' Flag to add MPI_Barrier calls for timing studies in time-step module. Default: .false. Number of input / output tasks. Default: 1 Flag to redirect stdout to a log file. Default: '.true.' Root name for ocean-model log file. Default: Set by CESM scripts. Flag to activate the use of pointer files, which point to the location of restart files. Default: '.true.' Root filename of the file that points to location of restarts. Default: rpointer.ocn.* (found in $RUNDIR) The CESM identifier for the run. Default: $CASENAME Option for time mixing: avgbb = DEPRECATED OPTION. leapfrog with occasional time-averaging timestep, immediately followed by another time-averaging timestep ("back-to-back" avg). DO NOT USE THIS OPTION in scientific experiments. avgfit = leapfrog with occasional time-averaging timestep to control stability. The timestep is modified such that an integer number of full and half timesteps fits into each coupling interval. robert = leapfrog with modified Robert-Asselin time filtering to control stability. The timestep is modifed such that an integer number of full timesteps fits into each coupling interval. Valid Values: 'robert' 'avgfit', 'avgbb' Frequency of mixing timestep. Ignored when time_mix_opt = 'robert' Default: 17 Flag for implicit treatment of Coriolis terms. Default: .true. Flag for timestep acceleration. Default: .false. File containing vertical profile of timestep acceleration factors. Default: Set by CESM scripts based on ocean grid Factor to multiply momentum timestep in order to set the momentum timestep to a value different from the tracer timestep. Default: 1.0 Year at the start of the experiment. iyear0 remains fixed over the course of the integration; it does not change if experiment is continued. Default: 1 Month number at the start of the experiment. imonth0 remains fixed over the course of the integration; it does not change if experiment is continued. Default: 1 Day number at the start of the experiment. iday0 remains fixed over the course of the integration; it does not change if experiment is continued. Default: 2 Hours at the start of the experiment. ihour0 remains fixed over the course of the integration; it does not change if experiment is continued. Default: 0 Minutes at the start of the experiment. iminute0 remains fixed over the course of the integration; it does not change if experiment is continued. Default: 0 Seconds at the start of the experiment. isecond0 remains fixed over the course of the integration; it does not change if experiment is continued. Default: 0 Selector for units used in determining tracer timestep size; used in conjunction with dt_count to serve as a starting point from which POP determines the exact model timestep size. Not all permissible time_mix_opt values are compatible with all dt_option values. The recommended option is steps_per_day Valid Values: 'steps_per_year', 'steps_per_day', 'seconds', 'hours' Default: 'steps_per_day' Number of timesteps in dt_option units. Serves as a starting point from which POP determines the exact model timestep size. Default: Set by CESM scripts based on ocean grid Units of time for 'stop_count'. In conjunction with 'stop_count', determines stopping time. Valid Values: 'never', 'eoy', 'eom', 'eod', 'nyear', 'nyears', 'nmonth', 'nmonths', 'nday', 'ndays', 'nstep', 'nsteps', 'date' Default: 'nyear' Number of stop_option units before POP stops OR date (yyyymmdd) at which POP stops. Default: 1000 Single character used to separate yyyy mm dd in date string. Note a blank space (' ') can be used to indicate no separator, but this is not recommended. Default: "-" Flag to select calendar with leap years. Default: .false. Number of intervals per day into which full and half timesteps must exactly "fit" when using time_mix_opt='avgfit' Default: 1 Tuning parameter used in Robert filtering. Williams, Paul D. "A proposed Modification to the Robert-Asselin Time Filter." Monthly Weather Review, Vol 137, 2009. Default: 1.0 Tuning parameter used in Robert filtering. Williams, Paul D. "A proposed Modification to the Robert-Asselin Time Filter." Monthly Weather Review, Vol 137, 2009. Default: 0.20 Print time_manager info every timestep and print initial time-flag info. Default: .false. Conserve across each Robert Filtering step. Note that this option is unstable, so only use it as a sanity check over a few days at most. Default: .false. Option to define the horizontal grid by reading from an input file ('file') or generating the grid internally ('internal') Valid Values: 'internal', 'file' Default: 'file' Option to define the vertical grid by reading from an input file ('file') or generating the grid internally ('internal'). Valid Values: 'internal', 'file' Default: 'file' Option to define the bottom topography (KMT) by reading discretized values from an input file ('file') or generating an idealized flat-bottom topography internally ('internal'). Valid Values: 'bathymetry','file','internal' Default: 'file' Name of the input file (with path) containing horizontal grid information. Default: Set by CESM scripts based on ocean grid Name of the input file (with path) containing the thickness (cm) of each vertical layer. Default: Set by CESM scripts based on ocean grid Name of the input file containing integer indices of the deepest vertical grid level at each horizontal gridpoint. Default: Set by CESM scripts based on ocean grid Name of the output file for writing horizontal grid information. Default: '$RUNDIR/$CASENAME.pop.h.topography_bathymetry.ieeer8' Name of an input file containing bathymetry information. Default: 'unknown_bathymetry' Number of topography smoothing passes. Default: 0 Flag used to select flat-bottom topography. Default: .false. Flag for removing isolated or disconnected ocean gridpoints. Default: .false. Name of the input file containing integer region number at each horizontal gridpoint. Default: Set by CESM scripts based on ocean grid Name of the input file containing integer region identification numbers at each gridpoint. The information in this file associates region ids with a region name; a negative region id indicates a marginal sea. Default: Set by CESM scripts based on ocean grid Option for surface layer type: variable thickness ('varthick'), rigid lid ('rigid'), or old free-surface formulation ('oldfree'). The 'oldfree' option is obsolete. Valid Values: 'varthick', 'rigid', 'oldfree' Default: 'varthick' Flag to activate the use of partial bottom cells. Default: .false. Input file containing thickness (cm) of partial bottom cell for each column. Default: 'unknown_bottom_cell' Minimum allowable non-zero KMT value. Default: 3 Flag to run POP in 1D dynamics mode (recommend only using with T62_g37 resolution) Default: .false. Flag to treat all columns the same (true 1D run). Recommend only using with the T62_g37 resolution; can not be run without l1Ddyn = .true. Default: .false. Flag to run POP with a spatially-constant Coriolis parameter; can not be run without l1Ddyn = .true. Default: .false. Flag to run POP with a specified minimum value for the Coriolis parameter; can not be run without l1Ddyn = .true. Default: .false. if l1Ddyn = .false; .true. if l1Ddyn = .true. If lmin_Coriolis = .true., this is smallest value for Coriolis parameter. (units = 1/s) Default: 6.4e-6 (corresponds to ~2.5 degrees) If lconst_Coriolis = .true., use this value for Coriolis parameter. (units = 1/s) Default: 1e-4 If lidentical_columns = .true., use this value for tau_x in surface forcing. (units = N/m^2, converted in source code) Default: 0.1 If lidentical_columns = .true., use this value for SHF coefficient in surface forcing (units = W/m^2, converted in source code). Default: -100 Option for initializing ocean conditions. 'ccsm_startup' reads initial temperature and salinity from a file; 'ccsm_continue' and 'ccsm_branch' read ocean initial conditions from a restart file; 'ccsm_hybrid' reads ocean initial conditions from a restart file with a different model date; and 'PHC' remaps PHC Levitus data to POP grid. 'PHC' is a research option that is available but not publicly supported. Default: 'ccsm_RUNTYPE' Name of the input file containing ocean initial conditions. Contents of this file depend on init_ts_option. If luse_pointer_files = .true., and init_ts_option is 'ccsm_continue', 'ccsm_branch', or 'ccsm_hybrid', then init_ts_file is ignored and POP reads the file specified in the ocean rpointer files. Default: Set by CESM scripts based on ocean grid Data format type of init_ts_file file; either binary ('bin') or netCDF ('nc'). Valid Values: 'bin', 'nc' Default: 'bin' Suboption for initializing temperature and salinity. See CESM documentation. This option should only be used by experts. If init_ts_suboption = 'spunup', then init_ts_option is set (internally) to 'ccsm_startup_spunup'; otherwise, this option has no effect. If the spunup suboption is selected, the model T,S are initialized from the specified input file, but velocities are initialized to zero, as in a 'ccsm_startup' run. This option should only be used by experts. Default: 'null' Name of the output file for writing temperature and salinity. This file is only generated when init_ts_option = 'PHC' Default: '$RUNDIR/$CASENAME.pop.h.ts_ic' Data format type of init_ts_outfile file; either binary ('bin') or netCDF ('nc'). Valid Values: 'bin', 'nc' Default: 'nc' init_ts_perturb perturbation for ts. Default: 1.0e-3 Units of time for diag_global_freq (frequency of global diagnostics). Valid Values: 'never', 'nyear', 'nmonth', 'nday', 'nhour', 'nsecond', 'nstep' Default: 'nmonth' Frequency of computing and printing of global diagnostics. Default: 1 Units of time for diag_cfl_freq (frequency of CFL diagnostics). Valid Values: 'never', 'nyear', 'nmonth', 'nday', 'nhour', 'nsecond', 'nstep' Default: 'nmonth' Frequency of computing and printing CFL diagnostics. Default: 1 Units of time for diag_transp_freq (frequency of transport diagnostics). Valid Values: 'never', 'nyear', 'nmonth', 'nday', 'nhour', 'nsecond', 'nstep' Default: 'nmonth' Frequency of computing and printing transport diagnostics. Default: 1 Name of the file that contains information for choosing fields for output. (the "transport_contents" file name) Default: Set by CESM scripts based on ocean grid Flag to control the writing of some global diagnostics for all vertical levels. If true, tracer mean diagnostics at all vertical levels are computed and printed. Default: .false. Flag to control the writing of some CFL diagnostics for all vertical levels. If true, CFL diagnostics at all vertical levels are computed and printed. Default: .false. Name of the output file into which diagnostics are written. Default: '$RUNDIR/$CASENAME.pop.dd' Name of the output file into which transport diagnostics are written. Default: '$RUNDIR/$CASENAME.pop.dt' Name of the output file into which the velocity diagnostics are written. Default: '$RUNDIR/$CASENAME.pop.dv' Flag to activate the computation of the velocity diagnostics. Default: .true. Flag to control the computation of global budget diagnostics for tracers. Default: .true. Flag to control the printing Robert-filter budget terms in a human-eye-friendly manner. Default: .false. Flag to control the computation and printing of barotropic stream function diagnostics. Default: .true. Units of time for restart_freq (restart frequency). Valid Values: 'never', 'nyear', 'nmonth', 'nday', 'nhour', 'nsecond', 'nstep' Default: 'nyear' Number of 'restart_freq_opt' units between the writing of restart files. Default: 100000 Name of the restart output filename root. The model code will create the complete restart output filename based on the model date. Default: '$RUNDIR/$CASENAME.pop.r' Data format type of restart_outfile file; either binary ('bin') or netCDF ('nc'). Valid Values: 'bin', 'nc' Default: 'nc' Flag to turn even_odd restarts on. Default: .false. Frequency to write even/odd restart files (units = nstep). Default: 100000 Flag to apply correction to pressure upon restart. If .true., surface pressure is modified to correct for an error due to (possible) different timestep. Use .false. for exact restart. Default: .false. Units of time for restart_start. Take restart_start units prior to beginning the writing of regular restart files. Default: 'nstep' Wait prior to beginning to output restart files. Number of units of restart_start_opt before restart files are started in a run. Default: 0 Units of time for history_freq (frequency of writing history files). Valid Values: 'never', 'nyear', 'nmonth', 'nday', 'nhour', 'nsecond', 'nstep' Default: 'never' Frequency of writing history files. Default: 1 Root filename for history files. Default: '$CASENAME.pop.hs' Filename for choosing fields for output in history file. Default: Set by CESM scripts based on ocean grid Data format type of history_outfile file; either binary ('bin') or netCDF ('nc'). Valid Values: 'bin', 'nc' Default: 'nc' Units of time for movie_freq (frequency of writing movie files). Valid Values: 'never', 'nyear', 'nmonth', 'nday', 'nhour', 'nsecond', 'nstep' Default: 'never' Frequency of writing movie files. Default: 1 Root filename for movie files. Default: '$CASENAME.pop.hm' Filename for choosing fields for output in movie file. Default: Set by CESM scripts based on ocean grid Data format type of movie_outfile file; either binary ('bin') or netCDF ('nc'). Valid Values: 'bin', 'nc' Default: 'nc' Method to solve the two-dimensional elliptic equation for the surface pressure. Valid Values: 'ChronGear','pcg','PCSI' 'ChronGear' = Chronopoulos-Gear conjugate-gradient solver with preconditioner. 'pcg' = Preconditioned conjugate-gradient solver. 'PCSI' = Preconditioned Classical Stiefel Iteration. Default: 'ChronGear' Convergence error criterion: |δX/X| < convergenceCriterion Default: 1.0e-13 Upper limit on number of solver iterations. Default: 1000 Check for convergence every convergenceCheckFreq iterations. Default: 10 Start checking for convergence after convergenceCheckStart steps (starting step number of convergence checking). Default: 60 Preconditioner choice. Valid Values: 'diagonal', 'evp','file' 'diagonal' -- No preconditioner. 'file' -- A preconditioner is used to reduce number of iterations to convergence. No longer supported. 'evp' -- Edge-vertex preconditioner. Default: 'diagonal' File containing preconditioner coefficients for solver; used when preconditionerChoice='file'. Default: 'unknownPrecondFile' Convergence error criterion for Lanczos step. Default: 0.15 Maximum number of Lanczos steps taken to get eigenvalues. Default: 100 Selector for method of computing vertical diffusion. Valid Values: 'const', 'rich', 'kpp' 'const' -- use constant vertical mixing 'rich' -- use Richardson-number vertical mixing 'kpp' -- use Kpp vertical mixing Default: 'kpp' Time-centering parameter for implicit vertical mixing. Use of the default value (1.0) is recommended. Valid Values: in the range [0.5,1.0] Default: 1.0 Drag coefficient used in quadratic bottom drag formula (dimensionless). Default: 1.0e-3 Flag to activate computation of vertical mixing implicitly in time. Default: .true. Selector for convection method. Valid Values: 'adjustment', 'diffusion' 'adjustment' -- convection treated by adjustment. 'diffusion' -- convection treated by large mixing coefficients. Default: 'diffusion' Number of passes through the convective-adjustment algorithm. Default: 2 Tracer mixing coefficient to be used with diffusion option. Default: 10000.0 Momentum mixing coefficient to use with diffusion option. Default: 10000.0 !-- - - - - - - - - - - - - - - - - - --> Option for geothermal (bottom) heat flux. Valid Values: 'const', 'spatial' Default: 'const' Constant geothermal heat flux to apply to bottom layers. (W/m^2) Default: 0.0 Depth (cm) below which geothermal heat flux is applied. Default: 1000.0e2 Vertical viscosity coefficient (momentum mixing) (cm^2/s). Default: 0.25 Vertical diffusivity coefficient (tracer mixing) (cm^2/s). Default: 0.25 Background vertical viscosity (cm^2/s). Default: 1.0 Background vertical diffusivity (cm^2/s). Default: 0.1 Coefficient for Richardson-number function. Default: 50.0 Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Flag to activate Schmittner's method southern ocean modification. Default: .true. Flag for setting q==1 in construction of 3D tidal energy field from tidal constituents for plotting/testing' Do not activate this flag in a scientific experiment. Default: .false. Flag for setting q==0.33 in construction of 3D tidal energy field from tidal constituents for plotting/testing' Do not activate this flag in a scientific experiment. Default: .false. Flag to activate tidal mixing. Default: .true. Flag to impose tidal_mix_max on all TIDAL_DIFF values. Default: .true. Flag to impose tidal_mix_max on all TIDAL_DIFF values. Default: .true. Flag to activate collection of fields used to create Melet plot. Default: .false. Flag to activate 18.6-year lunar cycle. Default: .false. Selector for tidal mixing scheme method. 'jayne' Jayne, S. R., and L. C. St. Laurent, 2001: Parameterizing tidal dissipation over rough topography. Geophys. Res. Lett., v28, 811-814. Simmons, H. L., S. R. Jayne, L. C. St. Laurent, and A. J. Weaver, 2004: Tidally driven mixing in a numerical model of the ocean general circulation. Ocean Modelling, vol 6, 245-263. Jayne, Steven R., 2009: The Impact of Abyssal Mixing Parameterizations in an Ocean General Circulation Model. JPO, vol 39, 1756-1775. 'schmittner' Use with 3D datasets only. Schmittner, A. and G.D. Egbert, 2014: An improved parameterization of tidal mixing for ocean models. Geosci. Model Dev., 7, 211-224, 201 'polzin' Melet version is implemented. Polzin, K. L., 2009: An abyssal recipe. Ocean Modelling, vol 30, 298-309 Melet, A. et al, 2013: Sensitivity of the ocean state to the vertical distribution of the internal-tide-driven mixing. J. Phys Oceanography, vol 43, 602-615 Default: 'jayne' Selector for tidal mixing energy file source. 'jayne' Jayne 2009 'arbic' not yet available 'ER03' Egbert and Ray 2003 'GN13' Green and Nycander 2013 'LGM0' LGM present day Wilmes 2017 'LGMi5g21' LGM 21kyrbp sea-level reconstruction ig5 'LGMi6g21' LGM 21kyrbp sea-level reconstruction ig6 Default: 'jayne' Minimum value of N**2 used in tidal diffusion computations. Default: 1.0e-08 Fraction of energy available for mixing local to the generation region. Default: 0.33 Tidal mixing efficiency. (Gamma) Default: 0.2 Vertical decay scale for turbulence (cm). Default: 500.0e02 Input file containing initialization variables (urms and topographic roughness) for use in the Polzin tidal mixing method. Default: 'unknown_tidal_vars_file_polz' Tidal dissipation vertical threshhold in tidal-constituent dataset (cm). Energy above this level is not included in the parameterization. Active only when 3D tidal-constituent datasets are used. Default: 0.0e02 Maximum for vertical diffusivity and viscosity (cm^2/s). Default: 100.0 ################## TEST Apply minimum tidal mixing value in specified regions Default: .false. Number of regions where minimum tidal-mixing values will be applied Default: 2 Number of bottom k-levels where minimum tidal-mixing values will be applied Default: 6 Name of regions where minimum tidal-mixing values will be applied Default: 2 Array of minimum tidal-mixing values Default: 1.0 Array of tidal-mixing lower TLAT values Default: 1.0 Array of tidal-mixing upper TLAT values Default: 1.0 Array of tidal-mixing lower TLON values Default: 1.0 Array of tidal-mixing upper TLON values Default: 1.0 ################## TEST Input file containing tidal energy. Default: 'unknown_tidal_energy_file' File format of the tidal_energy_file file. Valid Values: 'bin,nc' Default: 'nc' Array of tidal energy timeseries modulation files (18.6 year tidal cycle), for each of the tidal constituents M2,S2,K1,O1. Ignored if the lunar cycle is not active. Default: 'unknown_tidal_energy_ts_files' File format of the tidal_energy_ts_file file. Ignored if the lunar cycle is not active. Valid Values: 'ascii' Default: 'ascii' tidal_energy_ts_file calendar type. Ignored if the lunar cycle is not active. Valid Values: '365' Default: '365' Model year assigned to the selected data year. Ignored if the lunar cycle is not active. Default: '1' Starting year used in the model from the lunar-cycle timeseries data record. The lunar-cycle timeseries data record starts at 1500-01-02 (yyyy-mm-dd). Ignored if the lunar cycle is not active. Default: '1948' Numerical representation of the starting month used in the model from the lunar-cycle timeseries data record. 1 ==> January, etc. The lunar-cycle timeseries data record starts at 1500-01-02 (yyyy-mm-dd). Ignored if the lunar cycle is not active. Default: '1' Starting day used in the model from the lunar-cycle timeseries data record. The lunar-cycle timeseries data record starts at 1500-01-02 (yyyy-mm-dd). There are no data points at 29-Feb, but the model can accomodate a Gregorian calendar anyway, by interpolating between 28-Feb and 01-Mar. Ignored if the lunar cycle is not active. Default: '1' Final year used in the model from the lunar-cycle timeseries data record. The lunar-cycle timeseries data record extends through 2200-12-31 (yyyy-mm-dd). Ignored if the lunar cycle is not active. Default: '2009' Numerical representation of the final month used in the model from the lunar-cycle timeseries data record. The lunar-cycle timeseries data record extends through 2200-12-31 (yyyy-mm-dd). Ignored if the lunar cycle is not active. Default: '' Final day used in the model from the lunar-cycle timeseries data record. The lunar-cycle timeseries data record extends through 2200-12-31 (yyyy-mm-dd). Ignored if the lunar cycle is not active. Default: '1' File format of the tidal_vars_file_polz file (netCDF only). Ignored if the 'polzin' tidal_mixing_method_choice option is not active. Default: 'nc' Vertical decay function used in the Schmittner subgridscale scheme. Ignored if the 'schmittner' tidal_mixing_method_choice option is not active. Valid Values: 'SSJ02','P09' Default: 'SSJ02' Background diffusivity (Ledwell). Default: 0.16 Variation in diffusivity. Default: 0.0 Equatorial diffusivity (Gregg). Default: 0.01 Maximum PSI-induced diffusivity (MacKinnon). Default: 0.13 Banda Sea diffusivity (Gordon). Default: 1.0 Depth at which diffusivity equals vdc1 Default: 1000.0e02 Inverse length for transition region. Default: 4.5e-05 Prandtl number. Default: 10.0 Coefficient for Richardson number term. Default: 50.0 Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Number of times to vertically smooth Ri. Default: 1 Flag for computing Ri-dependent mixing. Default: .true. Flag for computing double-diffusive mixing. Default: .true. Flag for computing short-wave forcing. Default: .true. Flag to check Ekman, Monin-Obhukov depth limit. Default: .false. Flag to decrease Arctic background diffusivity; typically only used as an option with niw_mixing in research mode. Default: .false. Flag to allow horizontally-varying background (need bckgrnd_vdc2=0.0). Default: .true. Flag for using inertial mixing parameterization. Default: .false. Flag for using CVMix for mixing instead of POP routines Default: .true. Langmuir mixing parameterization option. Valid Values: 'null', 'vr12-ma', 'vr12-en' Default: 'vr12-ma' Tracer advection choice. Valid Values: 'center','upwind','lw_lim' Default: 'upwind3' Type of horizontal momentum mixing. Valid Values: 'del2', 'del4', 'anis', 'gent' Default: 'anis' Type of horizontal tracer mixing. Valid Values: 'del2','del4','gent','gmaniso' Default: 'gent' Flag for submesoscale mixing. Default: .true. Flag to internally compute mixing coefficient. Default: .false. Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Flag to enable spatially-varying mixing. Default: .false. Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Horizontal momentum mixing coefficient. Default: 0.5e8 Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Flag to internally compute mixing coefficient. Default: .false. Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Flag to enable spatially-varying mixing. Default: .false. Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Horizontal tracer mixing coefficient. Default: 0.6e7 Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Flag to internally compute mixing coefficient. Default: .false. Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Flag to enable spatially-varying mixing. Default: .false. Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Horizontal momentum mixing coefficient. Default: -0.6e20 Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Flag to internally compute mixing coefficient. Default: .false. Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Flag to enable spatially-varying mixing. Default: .false. Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Horizontal tracer mixing coefficient. Default: -0.2e20 Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! choice for major axis direction Valid Values: 'shear', 'east', 'zonal', 'flow', 'pvgrid', 'read' Default: 'shear' choice for minor diffusivity Valid Values: 'simple', 'read' Default: 'simple' choice for diffusivity ratio (major/minor) Valid Values: 'shear', 'simple', 'read' Default: 'shear' Flag to add random fluctuation to orientation Default: .false. T reduce major only for cfl violations, F reduce entire tensor for cfl violations Default: .true. T Set isotropic diffusivity with minor: F set isotropic diffusivity with avg of major and minor Default: .true. T to do isotropic using diagnosis Default: .false. Save aniso time averaged diagnostics Default: .true. T to use simple subcell volume = 1/8 T-cell volume, F to use HTN & HTE Default: .false. T do VDC here, F to do in vertical_mix Default: .false. multiplication factor for cfl check Default: 0.175 constant eigenvalue ratio Default: 5.0 max negative factor of major to set minor, set to 0 to force minor to be positive Default: 0.0 minor eigenvalue multiplicative factor Default: 1.0 multiplicative coefficient for shear dispersion term: MAJOR = MINOR + shrdispfac/MINOR*<(U*dy)^2+(V*dx)^2> Default: 0.5 Choice for KAPPA_ISOP (isopycnal). Valid Values: 'cons', 'steer', 'depth', 'vmhs', 'hdgr', 'drad', 'bfre', 'bfvm', 'bfhd', 'bfdr', 'edgr' Default: 'bfre' Choice for KAPPA_THIC (thickness). Valid Values: 'cons', 'steer', 'depth', 'vmhs', 'hdgr', 'drad', 'bfre', 'bfvm', 'bfhd', 'bfdr', 'edgr' Default: 'bfre' Frequency of KAPPA computation. Valid Values: 'never', 'every_time_step', 'once_a_day' Default: 'once_a_day' Choice for slope control. Valid Values: 'tanh', 'notanh', 'clip', 'Gerd' Default: 'notanh' 1 of 2 parameters for variation of KAPPA with kappa_type_depth option. Default: 1.0 1 of 2 parameters for variation of KAPPA with kappa_type_depth option. Default: 0.0 Depth scale for variation of KAPPA with kappa_type_depth. Default: 150000.0 Isopycnal diffusivity. Default: 3.0e7 Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Thickness (GM bolus) diffusivity. Default: 3.0e7 Flag to use ag_bkg_srfbl as maxmium background horizontal diffusivity within the surface boundary layer (rather than using KAPPA_ISOP). Default: .true. Background horizontal diffusivity within the surface boundary layer. Default: 3.0e7 Background horizontal diffusivity at k = KMT Default: 0.0 specify isopcynal deep diffusivity as fraction of the reference value Default: 0.1 specify thickness deep diffusivity as fraction of the reference value Default: 0.1 Maximum slope allowed for redi diffusion. Default: 0.3 Maximum slope allowed for bolus transport. Default: 0.3 Flag for diagnostic bolus velocity computation. Default: .true. Flag for diagnostic steering level eddy flux computation. Default: .true. Flag for transition layer parameterization. Default: .true. Flag to use climatoligical N^2 data instead of model-dependent N^2. Default: .false. File name for the time-dependent buoyancy frequency (squared). Default: '$RUNDIR/buoyancy_freq' buoyancy_freq_filename format (binary or netCDF). Valid Values: 'bin', 'nc' Default: 'nc' Unitless tuning parameter. Default: 1.2 Effective upper limit for inverse eddy timescale (unitless). Default: 500.0 Minimum value for KAPPA (cm^2/s). Default: 0.35e7 Maximum value for KAPPA (cm^2/s). Default: 2.0e7 Efficiency factor: must be between 0.06 and 0.08 [inclusive]. Default: 0.07 Time scale constant in seconds -- must be between 1 and 4 days [86400 and 345600 seconds]. Default: 8.64e4 (1 day) Flag to use constant horizontal length scale given by hor_length_scale rather than varying length scale with space and time. Default: .false. Constant horizontal length scale in cm (if luse_const_horiz_len_scale=.true.). Default: 5.0e5 (5 km) Direction that breaks isotropy. Valid Values: 'flow', 'east', 'grid' Default: 'east' Flag to allow spatially variable anisotropic viscosity. Default: .true. Flag to use nonlinear Smagorinski viscosities (c_para/perp and u_para/perp) rather than input anisotropic viscosities (visc_para/perp). Default: .false. Viscosity parallel to alignment direction. Default: 50.0e7 Viscosity perpendicular to alignment direction. Default: 50.0e7 Dimensionless Smagorinksi coefficient parallel to alignment direction. Default: 8.0 Dimensionless Smagorinksi coefficient perpendicular to alignment direction. Default: 8.0 Velocity for grid Reynolds number viscous limit (parallel to alignment direction). Default: 5.0 Velocity for grid Reynolds number viscous limit (perpendicular to alignment direction). Default: 5.0 1 of 7 coefficients for variable viscosity form. Units are cm^2/s. Default: 0.6e7 1 of 7 coefficients for variable viscosity form. Default: 0.5 1 of 7 coefficients for variable viscosity form. Default: 0.16 1 of 7 coefficients for variable viscosity form. Units are 1/cm. Default: 2.e-8 1 of 7 coefficients for variable viscosity form. Default: 3 1 of 7 coefficients for variable viscosity form. Units are cm^2/s. Default: 0.6e7 1 of 7 coefficients for variable viscosity form. Units are degrees of latitude. Default: 45.0 Latitude at which to vary perpendicular Smagorinsky viscosity. Default: 20.0 Coefficient of latitude-dependent Smagorinsky viscosity. Default: 0.98 Gaussian width of latitude-dependent Smagorinksy viscosity. Default: 98.0 File name for variable viscosity factor. Default: 'ccsm-internal' var_viscosity_infile format (binary or netCDF). Valid Values: 'bin', 'nc' Default: 'bin' File for output of internally-computed viscosity. Default: '$RUNDIR/$CASENAME.pop.hv' var_viscosity_outfile format (binary or netCDF). Valid Values: 'bin', 'nc' Default: 'nc' Which equation of state to use. Valid Values: 'jmcd', 'mwjf', 'poly', 'line' Default: 'mwjf' File containing polynomial equation of state coefficients. Default: 'internal' Option for checking for valid temperature and salinity ranges. Valid Values: 'ignore', 'check', 'enforce' Default: 'enforce' Frequency (in steps) for checking validity of temperature and salinity ranges. Default: 100000 Flag to prevent very cold water. Default: .false. Lowest level from which to integrate ice formation. Default: 1 Option for frequency of computing ice. Valid Values: 'never', 'coupled', 'nyear', 'nmonth', 'nday', 'nhour', 'nsecond', 'nstep' Default: 'coupled' Frequency with which to compute ice (units of ice_freq_opt). Default: 100000 Flag for whether POP is coupled to an active ice model. Default: Depends on $OCN_ICE_FORCING ("inactive" => .false.) CESM2 default for forming ice every timestep when coupled Default: .true. Flag to turn on averaging of pressure across three time steps. Default: .true. Flag for adding correction to Boussinesq approximation. Default: .false. Flag to turn on topographic stress. Default: .false. Number of passes the topography smoother will make. Default: 0 Flag to damp UVEL and VVEL; currently the only method for damping is from private communication with Nick Klingaman (Univ. of Reading); it is a non-linear damping. Default: .false. Type or periodicity of wind stress forcing. Valid Values: 'none', 'analytic', 'annual', 'monthly', 'monthly-calendar', 'monthly-equal', 'n-hour' LANL Default: 'analytic' CESM Default: 'none' Increment (in hours) between forcing times if ws_data_type='nhour'. LANL Default: 1e20 CESM Default: 24. How often to temporally interpolate wind stress data to current time; value in namelist is ignored and value set to 'never' if ws_data_type is 'analytic', 'none', or 'annual'. Valid Values: 'never', 'n-hour', 'every-timestep' LANL Default: 'never' CESM Default: 'every-timestep' Type of temporal interpolation for wind stress data. Valid Values: 'nearest', 'linear', '4point' LANL Default: 'nearest' CESM Default: 'linear' Increment (in hours) between interpolation times if ws_interp_freq = 'n-hour'. LANL Default: 1e20 CESM Default: 72. Name of file containing wind stress, or root of filenames if ws_data_type='n-hour' Default: 'unknown-ws' ws_filename format (binary of netCDF) Valid Values: 'bin', 'nc' Default: 'bin' Renormalization constants for the components in the wind stress forcing file. LANL Default: 20*1. CESM Default: 10., 19*1. Surface heat flux formation. Valid Values: 'restoring', 'Barnier-restoring', 'bulk-NCEP', 'partially-coupled', 'heating', 'alyssa_restoring' LANL Default: 'restoring' CESM Default: 'partially-coupled' or 'restoring' depending on configuration Type or periodicity of surface heat flux forcing. Valid Values='none', 'analytic', 'annual', 'monthly', 'monthly-equal', 'monthly-calendar', 'n-hour' LANL Default: 'analytic' CESM Default: 'monthly' if formulation is 'partially-coupled', 'none' otherwise Increment (in hours) between forcing times if shf_data_type='n-hour'. LANL Default: 1e20 CESM Default: 24. How often to temporally interpolate surface heat flux data to current time. Valid Values: 'never', 'n-hour', 'every-timestep' LANL Default: 'never' CESM Default: 'every-timestep' Type of temporal interpolation for surface heat flux data. LANL Default: 'nearest' CESM Default: 'linear' Increment (in hours) between interpolation times if shf_interp_freq = 'n-hour'. LANL Default: 1e20 CESM Default: 72. Restoring timescale (days) if shf_formulation='restoring'. LANL Default: 1e20 CESM Default: 30. Name of file containing surface heat flux data, or root of filenames if shf_data_type='n-hour'. LANL Default: 'unknown-shf' CESM Default: '$shf_filename', auto-filled by CESM scripts shf_filename format (binary or netCDF) Valid Values: 'bin', 'nc' Default: 'bin' Renormalization constants for the components in the surface heat flux forcing file. LANL Default: 20*1. CESM Default: (0.94, 19*1.) Restoring flux for weak restoring in bulk-NCEP Default: 0. Restoring flux for strong restoring in bulk-NCEP LANL Default: 92.64 CESM Default: 0.0 Flag to control use of fractional ice coverage. LANL Default: N/A, CESM only CESM Default: .true. if shf_formulation='partially-coupled', .false. otherwise Restoring flux for strong restoring over marginal seas in bulk-NCEP LANL Default: N/A, CESM only CESM Default: 92.64 Surface fresh water flux formulation. Valid Values: 'restoring', 'bulk-NCEP', 'partially-coupled', 'hosing' LANL Default: 'restoring' CESM Default: 'restoring' or 'partially-coupled', depending on configuration Type or periodicity of surface fresh water flux forcing. Valid Values: 'none', 'analytic', 'annual', 'monthly', 'monthly-equal', 'monthly-calendar', 'n-hour' LANL Default: 'analytic' CESM Default: 'none' or 'monthly' Increment (hours) between forcing times if sfwf_data_type='n-hour'. LANL Default: 1e20 CESM Default: 24. How often to temporally interpolate surface fresh water flux data to current time. Valid Values: 'never', 'n-hour', 'every-timestep' LANL Default: 'never' CESM Default: 'every-timestep' Type of temporal interpolation for surface fresh water flux data. Valid Values: 'nearest', 'linear', '4point' LANL Default: 'nearest' CESM Default: 'linear' Increment (hours) between interpolation times if sfwf_interp_freq='n-hour'. LANL Default: 1e20 CESM Default: 72. Restoring timescale (days) if sfwf_formulation='restoring'. LANL Default: 1e20 CESM Default: 30. Name of file containing surface fresh water flux data, or root of filenames if sfwf_data_type='n-hour'. LANL Default: 'unknown_sfwf' CESM Default: '$sfwf_filename', auto-filled by CESM scripts sfwf_filename format (binary or netCDF). Valid Values: 'bin', 'nc' Default: 'bin' Renormalization constants for components in sfwf forcing file. LANL Default: 20*1. CESM Default: 0.001, 19*1. Restoring flux for weak restoring in 'bulk-NCEP' and 'partially-coupled' formulation. LANL Default: 0.092 CESM Default: 0.0115 Restoring flux for strong restoring in 'bulk-NCEP' and 'partially-coupled' formulation. LANL Default: 0.6648 CESM Default: 0.0 Restoring flux for strong restoring over marginal seas in CESM 'bulk-NCEP' and 'partially-coupled' formulations. LANL Default: N/A, CESM only CESM Default: 0.6648 Adjust precipitation to balance water budget. LANL Default: .false. CESM Default: .true. if sfwf_formulation='partially-coupled', .false. otherwise Balance E, P, M, R, and S in marginal seas. LANL Default: N/A, CESM only CESM Default: .true. if sfwf_formulation='partially-coupled', .false. otherwise Treat fresh water flux as virtual salt flux when using varthick sfc layer. LANL Default: .false. CESM Default: .true. Flag for sending precip_fact to CESM coupler for use in fresh-water balance. LANL Default: N/A, CESM only CESM Default: .true. if sfwf_formulation='partially-coupled', .false. otherwise Value used for precip_fact when ladjust_precip=.false.. LANL Default: N/A, CESM only CESM Default: 1.0 Type or periodicity of interior potential temperature forcing. Valid Values: 'none', 'annual', 'monthly', 'monthly-equal', 'monthly-calendar', 'n-hour', 'shr_stream' Default: 'none' Increment (hours) between forcing times if pt_interior_data_type='n-hour'. LANL Default: 1e20 CESM Default: 24 How often to temporally interpolate interior potential temperature data to current time. Valid Values: 'never', 'n-hour', 'every-timestep' LANL Default: 'never' CESM Default: 'every-timestep' Type of temporal interpolation for interior potential temperature data. Valid Values: 'nearest', 'linear', '4point' LANL Default: 'nearest' CESM Default: 'linear' Increment (hours) between interpolation times if interp_freq='n-hour' LANL Default: 1e20 CESM Default: 72 Restoring timescale (days) if pt_interior_formulation='restoring'. LANL Default: 1e20 CESM Default: 365 File containing interior potential temperature data, or root of filenames if pt_interior_data_type='n--hour'. Default: 'unknown-pt_interior' pt_interior_filename format (binary or netCDF). Valid Values: 'bin', 'nc' Default: 'bin' Maximum level for interior potential temperature restoring. Default: 0 Interior potential temperature formulation. Default: 'restoring' Renormalization constants for components in interior potential temperature forcing file. Default: 20*1. Enable variable interior potential temperature restoring. Default: .false. Name of file containing variable interior potential temperature restoring data. Default: 'unknown-pt_interior_restore' pt_interior_restore_filename format (binary or netCDF). Valid Values: 'bin', 'nc' Default: 'bin' PT interior restoring includes the surface layer Default: .false. Default: 1 Default: 1 Default: 1 Default: unknown-pt_interior_shr_stream Type or periodicity of interior salinity forcing. Valid Values: 'none', 'annual' ,'monthly', 'monthly-equal', 'monthly-calendar', 'n-hour', 'shr_stream' Default: 'none' Increment (hours) between forcing times if s_interior_data_type='n-hour'. LANL Default: 1e20 CESM Default: 24 How often to temporally interpolate interior salinity data to current time. Valid Values: 'never', 'n-hour', 'every-timestep' LANL Default: 'never' CESM Default: 'every-timestep' Type of temporal interpolation for interior salinity data. Valid Values: 'nearest', 'linear', '4point' LANL Default: 'nearest' CESM Default: 'linear' Increment (hours) between interpolation times if s_interior_interp_freq='n-hour'. LANL Default: 1e20 CESM Default: 72 Restoring timescale (days) if s_interior_formulation='restoring'. LANL Default: 1e20 CESM Default: 365 Name of file containing interior salinity data, or root of filenames if s_interior_data_type='n-hour'. Default: 'unknown-s_interior' s_interior_filename format (binary or netCDF) Valid Values: 'bin', 'nc' Default: 'bin' Maximum level for interior salinity restoring. Default: 0 Interior salinity formulation. Default: 'restoring' Renormalization constants for components in interior salinity forcing file. Default: 20*1. Enable variable interior salinity restoring. Default: .false. Name of file containing variable interior salinity restoring data. Default: 'unknown-s_interior_restore' s_interior_restore_filename format (binary or netCDF). Valid Values: 'bin', 'nc' Default: 'bin' S interior restoring includes the surface layer Default: .false. Default: 1 Default: 1 Default: 1 Default: unknown-s_interior_shr_stream Type or periodicity of atmospheric forcing. Valid Values: 'none', 'analytic', 'annual', 'monthly', 'monthly-equal', 'monthly-calendar', 'n-hour' Default: 'none' Increment (in hours) between forcing times if ap_data_type='n-hour'. Default: 1.e20 How often to temporally interpolate atmospheric forcing data to current time. Valid Values: 'never','n-hour','every-timestep' Default: 'never' Type of temporal interpolation for atmospheric pressure forcing data. Valid Values: 'nearest', 'linear', '4point' Default: 'nearest' Increment (in hours) between interpolation times if ap_interp_freq = 'n-hour'. Default: 1e20 Name of file containing atmospheric pressure forcing, or root of filenames if ap_data_type='n-hour'. Default: 'unknown-ap' ap_filename format (binary or netCDF) Valid Values: 'bin', 'nc' Default: 'bin' Renormalization constants for the components in the atmospheric pressure forcing file. Default: 20*1. Units of time for coupled_freq (frequency POP is coupled to atmosphere/sea ice models via CESM flux coupler). Valid Values: 'nyear', 'nmonth', 'nday', 'nhour', 'nsecond', 'nstep', 'never' Default: 'nhour' Frequency POP is coupled to atmosphere / sea ice models via CESM flux coupler (units given by coupled_freq_opt). Default: 24 Option for distributing net shortwave heat flux over a coupling interval (all options preserve time-integrated flux). Valid Values: 'const','12hr','cosz' Default: 'cosz' Short-wave absorption type. Valid Values: 'top-layer', 'jerlov', 'chlorophyll' Default: 'chlorophyll' Chlorophyll option. Valid Values: 'file', 'model' Default: auto-filled by CESM scripts Chlorophyll input filename. Default: auto-filled by CESM scripts chl_filename format (binary or netCDF). Valid Values: 'bin', 'nc' Default: 'bin' Jerlov water type. Valid Values: 1-5 (correspond to I, IA, IB, II, and III, respectively) Default: 3 Type of the auxiliary latitudinal grid. Valid Values: 'southern', 'full', 'user-specified' Default: 'southern' Beginning latitude for the auxiliary grid (degrees north). Default: -90.0 Ending latitude for the auxiliary grid (degrees north). Default: 90.0 Auxiliary grid dimension. Default: 180 Flag for turning on output for meridional overturning circulation. Default: .true. for displaced pole grids, .false. for tripole grids. Flag for outputting northward heat transport. Default: .true. for displaced pole grids, .false. for tripole grids. Flag for outputting northward salt transport. Default: .true. for displaced pole grids, .false. for tripole grids. Names of the selected input regions when n_transport_reg = 2. Default: 'Atlantic Ocean','Mediterranean Sea','Labrador Sea','GIN Sea','Arctic Ocean','Hudson Bay' Number of regions for all transport diagnostics. Default: 2 Flag for whether POP is coupled to another system. Default: .true. Flag to run pop in the CESM context. Default: .true. Flag to run POP in bit-for-bit mode. Default: .false. Flag to run POP with code that is bit-for-bit with the ccsm4 control run. (According to source notes, this option should have been removed in ccsm4_0_1!). Default: .false. If this is true, then various internal consistency checks are enabled. Default: DEBUG from env_run.xml, but overridable by user_nl_pop Flag for using parameterized overflows. Default: .true. for displaced pole grids, .false. for tripole grids. Flag for using interactive overflows. Default: .true. for displaced pole grids, .false. for tripole grids. File with overflow information. Default: Set by CESM scripts based on ocean grid. File for writing overflow diagnostics output. Default: '$RUNDIR/$CASENAME.do' Overflow restart type. Valid Values: 'ccsm_startup', 'ccsm_continue', 'ccsm_hybrid', 'ccsm_branch' Default: 'ccsm_$RUNTYPE' Overflow restart file name. Default: '$RUNDIR/$CASENAME.ro' Flag for using near inertial wave mixing. Default: .false. Fraction of near inertial wave energy available for mixing local to the generation region. Default: 0.5 Mixing efficiency (portion producing mixing rather than thermal heating). Default: 0.2 Ratio between observed and modeled near inertial wave strength. Default: 2.0 Fraction of near inertial wave energy absorbed in the boundary layer. Default: 0.7 Vertical decay scale for turbulence (cm). Default: 500.0e02 Maximum diffusivity for near inertial waves (cm^2/s). Default: 100.0 Type (internal or external) for near inertial wave energy source. Default: 'blke' Input file for reading near inertial wave energy flux. Default: Resolution-dependent niw_energy_file_fmt (binary or netCDF). Valid Values: 'bin', 'nc' Default: 'bin' Default: 3 Default: .false. Default: .true. Default: 'nmonth' 'nday' 'once' Default: 1 1 1 Default: 'nmonth' 'nmonth' 'once' Default: 1 1 1 Default: 'nmonth1' 'nday1' 'once' Default: 'nstep' 'nstep' 'nstep' Default: 0 0 0 Default: 'nc' 'nc' 'nc' Default: 'nc' 'nc' 'nc' Default: ' ' Default: .true. Default: ' ' Default: ' ' Default: .false. .false. .false. Default: 1 1 1 Default: 1 1 1 Default: 2 2 2 Default: .false. .false. .false. Flag for activating mcog, the multiple-column ocean grid parameterization. Default: .false., unless ecosys is turned on Flag for activating debugging statements in multiple-column ocean grid parameterization. Default: .false. call abort if abs(dagg_qsw) exceeds this threshold Default: 1.0e-10 bin index for each column Default: mcog_col_to_bin(nbin) = nbin Flag used for testing when introducing answer changes that will not be controlled by other namelist flags. Outside of specific tags, this flag will not have any affect on POP. Default: .false. Flag for using ecosys module. Default: 'Set by CESM scripts based on $OCN_TRACER_MODULES' Flag for using cfc module. Default: 'Set by CESM scripts based on $OCN_TRACER_MODULES' Flag for using sf6 module. Default: 'Set by CESM scripts based on $OCN_TRACER_MODULES' Flag for using iage module. Default: 'Set by CESM scripts based on $OCN_TRACER_MODULES' Flag for using abio_dic_dic14 module. Default: 'Set by CESM scripts based on $OCN_TRACER_MODULES' Flag for using IRF module. Default: 'Set by CESM scripts based on $OCN_TRACER_MODULES' Option for initialization of iage. Valid Values: 'ccsm_startup', 'zero', 'ccsm_startup_spunup', 'restart', 'ccsm_continue', 'ccsm_branch', 'ccsm_hybrid', 'file' Default: 'ccsm_$RUNTYPE' Filename for initializing iage (if init_iage_option='file'). Default: 'same_as_TS' Default: Default: Default: Default: Default: Default: init_iage_init_file format (binary or netCDF). Valid Values: 'bin', 'nc' Default: 'bin' Option for initialization of cfc. Valid Values: 'ccsm_startup', 'zero', 'ccsm_startup_spunup', 'restart', 'ccsm_continue', 'ccsm_branch', 'ccsm_hybrid', 'file' Default: ccsm_$runtype Filename for initializing cfc (if init_cfc_option='file'). Default: 'same_as_TS' init_cfc_init_file format (binary or netCDF). Valid Values: 'bin', 'nc' Default: 'bin' Default: Default: Default: Default: Default: Default: File name for ascii time series of atm cfc11. Default: '$DIN_LOC_ROOT/ocn/pop/res_indpt/forcing/cfc_atm_20170512.nc' first year of non-zero values in pcfc_file If the effective cfc calendar year is less than this, and cfc tracers are being read from a restart file, then a fallback of const=0 for I/O reading is registered. Default: 1936 Arbitrary model year. Default: 1850 for OCN_TRANSIENT=1850-2000, 372 for OCN_TRANSIENT=CORE2,CORE2OMIP, 366 for OCN_TRANSIENT=JRA,JRA_OMIP, 1 otherwise. Year in data that corresponds to model_year. Default: 1850 for OCN_TRANSIENT=1850-2000, 2009 for OCN_TRANSIENT=CORE2,CORE2OMIP, 2018 for OCN_TRANSIENT=JRA,JRA_OMIP, 1 otherwise. Flux formulation. Valid Values: 'ocmip', 'model' Default: 'model' Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Option for initialization of sf6. Valid Values: 'ccsm_startup', 'zero', 'ccsm_startup_spunup', 'restart', 'ccsm_continue', 'ccsm_branch', 'ccsm_hybrid', 'file' Default: ccsm_$runtype Filename for initializing sf6 (if init_sf6_option='file'). Default: 'same_as_TS' init_sf6_init_file format (binary or netCDF). Valid Values: 'bin', 'nc' Default: 'bin' Default: Default: Default: Default: Default: Default: File name for ascii time series of atm sf6. Default: '$DIN_LOC_ROOT/ocn/pop/res_indpt/forcing/sf6_atm_20160311.nc' first year of non-zero values in psf6_file If the effective sf6 calendar year is less than this, and the sf6 tracer is being read from a restart file, then a fallback of const=0 for I/O reading is registered. Default: 1953 Arbitrary model year. Default: 1850 for OCN_TRANSIENT=1850-2000, 372 for OCN_TRANSIENT=CORE2,CORE2OMIP, 366 for OCN_TRANSIENT=JRA,JRA_OMIP, 1 otherwise. Year in data that corresponds to model_year. Default: 1850 for OCN_TRANSIENT=1850-2000, 2009 for OCN_TRANSIENT=CORE2,CORE2OMIP, 2018 for OCN_TRANSIENT=JRA,JRA_OMIP, 1 otherwise. Flux formulation. Valid Values: 'ocmip', 'model' Default: 'model' Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: b.e21.B1850.f09_g17.CMIP6-piControl.001.pop.r.abio_dic_dic14.0391-01-01-00000.nc (gx1v7), none (otherwise) Default: Default: Default: Default: Default: Default: Default: Default: 'never' Default: '1' Default: Default: Source of atmos CO2 and D14C. Valid Values: 'file', 'const', 'drv_diag' Default: 'const' Source of atmos D14C. Valid Values: 'file', 'const', 'lat_bands' Default: 'lat_bands' Default: Default: Default: CCSM_CO2_PPMV value in env_run.xml Arbitrary model year. Default: 1 Year in data that corresponds to abio_atm_model_year. Default: 1 When turned on, ocn.ecosys.tavg.csh will accumulate ALL ecosys diagnostics When turned on, ocn.ecosys.tavg.csh will output alt_co2 related fields Default: 'driver' Default: dst79gnx_gx3v7_20100305.nc or dst79gnx_gx1v6_090416.nc Default: 'nc' Default: 'DSTSF' Default: 1.0e-1 Default: none provided Default: 'driver-derived' coarse/fine dust ratio threshold, used in iron_flux_source=='driver-derived' computation Default: 55.0 used in iron_flux_source=='driver-derived' computation Default: 0.01 used in iron_flux_source=='driver-derived' computation Default: 170.0 Default: solFe_scenario4_current_gx3v7_6gmol_cesm1_93_20161122.nc or solFe_scenario4_current_gx1v6_8gmol_cesm1_93_20161114.nc Default: 'nc' Default: 'DSTSF' Default: 1.79e6 Default: none provided Default: fesedflux_gx3v7_cesm1_97_2017.nc or fesedfluxTot_gx1v6_cesm2_2018_c180618.nc Default: 'FESEDFLUXIN' Default: 'nc' Default: 1.1574e-6 Default: none provided Default: feventflux_gx3v7_5gmol_cesm1_97_2017.nc or feventflux_gx1v6_5gmol_cesm1_97_2017.nc Default: 'FESEDFLUXIN' Default: 'nc' Default: 1.1574e-6 Default: none provided option for specification of o2_consumption_scalef Valid Values: 'const', 'file_time_invariant' Default: 'const' 'file_time_invariant' (gx1v6,gx1v7) for OCN_COUPLING='full' constant for o2_consumption_scalef_opt=const Default: 1.0 Default: o2_consumption_scalef_0.30_POP_gx1v6_20180623.nc (gx1v6,gx1v7) Default: 'o2_consumption_scalef' Default: 'nc' Default: 1.0 Default: none provided option for specification of p_remin_scalef Valid Values: 'const', 'file_time_invariant' Default: 'const' constant for p_remin_scalef_opt=const Default: 1.0 Default: none provided Default: 'p_remin_scalef' Default: 'nc' Default: 1.0 Default: none provided Default: 'monthly-calendar' or 'shr_stream' If .false., abort if the coupler passes NHx or NOy and ndep_data_type is not 'driver' Default: .false. Default: ndep_ocn_1850_w_nhx_emis_gx3v7_c180803.nc or ndep_ocn_1850_w_nhx_emis_gx1v6_c180803.nc Default: 'nc' Default: 'NOy_deposition' Default: 7.1429e6 Default: none provided Default: ndep_ocn_1850_w_nhx_emis_gx3v7_c180803.nc or ndep_ocn_1850_w_nhx_emis_gx1v6_c180803.nc Default: 'nc' Default: 'NHx_deposition' Default: 7.1429e6 Default: none provided Default: 1849 for OCN_TRANSIENT=1850-2000, 2004 for rcp runs, 2014 for ssp runs, 1637 for OCN_TRANSIENT=CORE2OMIP, 1652 for OCN_TRANSIENT=JRA_OMIP Default: 2006 for OCN_TRANSIENT=1850-2000, 2101 for rcp and ssp runs, 2010 for OCN_TRANSIENT=CORE2OMIP, 2019 for OCN_TRANSIENT=JRA_OMIP Default: 1849 for OCN_TRANSIENT=1850-2000, 2004 for rcp runs, 2014 for ssp runs, 0 for OCN_TRANSIENT=CORE2OMIP,JRA_OMIP Default: depends on grid and OCN_TRANSIENT Default: 7.1429e6 Default: riv_nut.gnews_gnm.gx3v7_nnsm_e1000r500.20170425.nc (gx3v7), riv_nut.gnews_gnm.gx1v7_nnsm_e1000r300.20170425.nc (gx1v6,gx1v7) riv_nut.gnews_gnm.gx3v7_nn_open_ocean_nnsm_e1000r500_marginal_sea.20170425.nc (gx3v7,estuary_type='vsf_ebm'), riv_nut.gnews_gnm.gx1v7_nn_open_ocean_nnsm_e1000r300_marginal_sea.20170425.nc (gx1v6,gx1v7,estuary_type='vsf_ebm') riv_nut.gnews_gnm.rx1_to_gx1v7_nn_open_ocean_nnsm_e1000r300_marginal_sea_170413.20190602.nc (gx1v6,gx1v7,estuary_type='vsf_ebm',rof_grid='rx1') riv_nut.gnews_gnm.JRA025m_to_gx1v7_nn_open_ocean_nnsm_e1000r300_marginal_sea_190214.20190602.nc (gx1v6,gx1v7,estuary_type='vsf_ebm',rof_grid='JRA025') Default: 1900 Default: 1900 for OCN_TRANSIENT=unset,CORE2,JRA, 2000 otherwise Default: 263 for OCN_TRANSIENT=CORE2_OMIP, 248 for OCN_TRANSIENT=JRA_OMIP, 1900 otherwise Default: 'din_riv_flux' Default: 1.0 Default: 'dip_riv_flux' Default: 1.0 Default: 'don_riv_flux' Default: 1.0 Default: 'dop_riv_flux' Default: 1.0 Default: 'dsi_riv_flux' Default: 1.0 Default: 'dfe_riv_flux' Default: 1.0 Default: 'dic_riv_flux' Default: 1.0 Default: 'alk_riv_flux' Default: 1.0 Default: 'doc_riv_flux' Default: 1.0 Default: 'drv' Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: depends on OCN_CO2_TYPE in env_run.xml Default: CCSM_CO2_PPMV value in env_run.xml Default: CCSM_CO2_PPMV value in env_run.xml Default: 'const' Default: CCSM_CO2_PPMV value in env_run.xml Default: none provided Default: none provided Default: none provided Default: Default: Default: Default: Default: Default: Default: Arbitrary model year. Default: 1 Year in atm data that corresponds to ciso_atm_model_year. Default: 1 Default: 'PO4','NO3','SiO3','O2','ALK' Default: none provided, constructed by build-namelist Default: ecosys_restore_POP_gx3v7_20170113.nc (gx3v7), ecosys_restore_POP_gx1v6_20170113.nc (gx1v6,gx1v7) Default: 'PO4','NO3','SiO3','O2','ALK' Default: 'file_time_invariant' for gx3v7, gx1v6, gx1v7 grids, 'const' otherwise Default: 0.0 Default: ecosys_restore_inv_tau_POP_gx3v7_20170125.nc (gx3v7), ecosys_restore_inv_tau_POP_gx1v6_20170125.nc (gx1v6,gx1v7) Default: 'RESTORE_INV_TAU_MARGINAL_SEA_ONLY' Default: 'nc' Default: 1.0 Default: none provided Default: 1944.0 Default: 2225.0 Default: 1944.0 Default: 1944.0 fraction, by weight, of iron in fine dust from atm Default: 0.035 fraction, by weight, of iron in coarse dust from atm Default: 0.035 fraction, by weight, of iron in dust from seaice Default: 0.035 fraction, by weight, of iron in black carbon from atm Default: 0.06 fraction, by weight, of iron in black carbon from seaice Default: 0.06 Default: 'ccsm_RUNTYPE' Default: ecosys_jan_IC_gx3v7_20180308.nc or ecosys_jan_IC_gx1v6_20180308.nc (none provided for tripole grids) Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: 'nc' Default: Default: Default: Default: Default: Default: Default: 'nc' Default: .true. Default: 'base model' Default: Default: 'marbl_in' for single instance, 'marbl_in_####' for multi-instance. Default: one of the following, depending on ocean grid and NK_MODE IRF_NK_precond_tracers_gx3v7_20150313.nc IRF_NK_precond_tracers_gx1v6_20150313.nc IRF_offline_transport_tracers_gx3v7_20150313.nc IRF_offline_transport_tracers_gx1v6_20150313.nc Default: 1 Default: none Default: none Default: none Default: auto-filled by CESM scripts Default: none Default: none Default: none Default: none Default: none Default: none Ratio of lower-layer depth to H at estuary mouth. Default: none Thickness (m) of upper layer of exchange flow. Default: none Thickness (m) of lower layer of exchange flow. Default: none CESM2.1.3_sourcemods/PaxHeaders.32795/forcing_coupled.F900000644000000000000000000000012413774500023017624 xustar0027 mtime=1609728019.261442 27 atime=1609728019.245611 30 ctime=1609728019.260894215 CESM2.1.3_sourcemods/forcing_coupled.F900000644006307300017500000016335113774500023020214 0ustar00islasncar00000000000000!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| module forcing_coupled !BOP !MODULE: forcing_coupled ! !DESCRIPTION: ! This module contains all the routines necessary for coupling POP to ! atmosphere and sea ice models using the NCAR CCSM flux coupler. To ! enable the routines in this module, the coupled ifdef option must ! be specified during the make process. ! ! !REVISION HISTORY: ! SVN:$Id$ ! ! Modified by Isla Simpson 28th May 2020, to include pacemaker option ! Based on CESM1 SourceMods at /glade/work/nanr/toolsPacemaker/SourceMods/src.pop2 ! !USES: use POP_KindsMod use POP_ErrorMod use POP_CommMod use POP_FieldMod use POP_GridHorzMod use POP_HaloMod use kinds_mod use blocks, only: nx_block, ny_block, block, get_block use domain_size use domain use io_types, only: stdout, nml_in use communicate use global_reductions use constants use io use time_management use grid use prognostic use exit_mod use ice, only: tfreez, tmelt, liceform,QFLUX, QICE, AQICE, tlast_ice use forcing_shf use forcing_sfwf use forcing_ws, only: ws_data_type use forcing_fields use timers !*** ccsm use ms_balance use tavg use registry use named_field_mod, only: named_field_register, named_field_get_index, & named_field_set, named_field_get use forcing_fields use estuary_vsf_mod, only: lestuary_on, lvsf_river, lebm_on use estuary_vsf_mod, only: MASK_ESTUARY, vsf_river_correction use estuary_vsf_mod, only: set_estuary_vsf_forcing, set_estuary_exch_circ use mcog, only: tavg_mcog use mcog, only: FRAC_BIN, QSW_RAW_BIN implicit none save !EOP !BOC !----------------------------------------------------------------------- ! ! module variables ! !----------------------------------------------------------------------- integer (int_kind) :: & coupled_freq_iopt, &! coupler frequency option coupled_freq, &! frequency of coupling ncouple_per_day ! num of coupler comms per day #if CCSMCOUPLED !----------------------------------------------------------------------- ! ! ids for tavg diagnostics computed from forcing_coupled ! !----------------------------------------------------------------------- integer (int_kind) :: & tavg_HEAT_F, &! tavg id for heating flux tavg_HOSE_F, &! tavg id for hosing flux tavg_EVAP_F, &! tavg id for evaporation flux tavg_PREC_F, &! tavg id for precipitation flux (rain + snow) tavg_SNOW_F, &! tavg id for snow flux tavg_MELT_F, &! tavg id for melt flux tavg_ROFF_F, &! tavg id for river runoff flux tavg_IOFF_F, &! tavg id for ice runoff flux due to land-model snow capping tavg_SALT_F, &! tavg id for salt flux tavg_SENH_F, &! tavg id for sensible heat flux tavg_LWUP_F, &! tavg id for longwave heat flux up tavg_LWDN_F, &! tavg id for longwave heat flux dn tavg_MELTH_F, &! tavg id for melt heat flux tavg_IFRAC ! tavg id for ice fraction #endif !----------------------------------------------------------------------- ! ! Options for distributing net shortwave heat flux over a coupling ! interval. All options preserve time-integrated flux. ! !----------------------------------------------------------------------- integer (int_kind), parameter :: & qsw_distrb_iopt_const = 1, &! qsw constant over a coupling interval qsw_distrb_iopt_12hr = 2, &! qsw smoothly spread over 12 hour window ! only works for daily coupling qsw_distrb_iopt_cosz = 3 ! qsw proportional to cos of solar zenith angle integer (int_kind) :: qsw_distrb_iopt real (r8), dimension(:), allocatable :: & qsw_12hr_factor !----------------------------------------------------------------------- ! variables for qsw cosz option !----------------------------------------------------------------------- integer (int_kind) :: timer_compute_cosz real (r8) :: & tday00_interval_beg, & ! model time at beginning of coupling interval orb_eccen, & ! Earth eccentricity orb_obliqr, & ! Earth Obliquity orb_lambm0, & ! longitude of perihelion at v-equinox orb_mvelpp ! Earths Moving vernal equinox of orbit +pi real (r8), dimension(:,:,:), allocatable :: & QSW_COSZ_WGHT, & ! weights QSW_COSZ_WGHT_NORM ! normalization for QSW_COSZ_WGHT integer (int_kind), private :: & cpl_ts ! flag id for coupled_ts flag !EOC !*********************************************************************** contains !*********************************************************************** !BOP ! !IROUTINE: pop_init_coupled ! !INTERFACE: subroutine pop_init_coupled ! !DESCRIPTION: ! This routine sets up everything necessary for coupling with CCSM4. ! ! !REVISION HISTORY: ! same as module !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- character (char_len) :: & coupled_freq_opt, qsw_distrb_opt namelist /coupled_nml/ coupled_freq_opt, coupled_freq, qsw_distrb_opt integer (int_kind) :: & k, iblock, nsend, & nml_error ! namelist i/o error flag type (block) :: & this_block ! block information for current block !----------------------------------------------------------------------- ! ! variables associated with qsw 12hr ! !----------------------------------------------------------------------- real (r8) :: & time_for_forcing, &! time of day for surface forcing frac_day_forcing, &! fraction of day based on time_for_forcing cycle_function, &! intermediate result weight_forcing, &! forcing weights sum_forcing ! sum of forcing weights integer (int_kind) :: & count_forcing ! time step counter (== nsteps_this_interval+1) integer (int_kind) :: & i,j,n !----------------------------------------------------------------------- ! ! read coupled_nml namelist to start coupling and determine ! coupling frequency ! !----------------------------------------------------------------------- coupled_freq_opt = 'never' coupled_freq_iopt = freq_opt_never coupled_freq = 100000 qsw_distrb_opt = 'const' if (my_task == master_task) then open (nml_in, file=nml_filename, status='old',iostat=nml_error) if (nml_error /= 0) then nml_error = -1 else nml_error = 1 endif do while (nml_error > 0) read(nml_in, nml=coupled_nml,iostat=nml_error) end do if (nml_error == 0) close(nml_in) endif call broadcast_scalar(nml_error, master_task) if (nml_error /= 0) then call exit_POP(sigAbort,'ERROR reading coupled_nml') endif if (my_task == master_task) then write(stdout,blank_fmt) write(stdout,ndelim_fmt) write(stdout,blank_fmt) write(stdout,*) ' Coupling:' write(stdout,blank_fmt) write(stdout,*) ' coupled_nml namelist settings:' write(stdout,blank_fmt) write(stdout, coupled_nml) write(stdout,blank_fmt) endif if (my_task == master_task) then select case (coupled_freq_opt) case ('nyear') coupled_freq_iopt = -1000 case ('nmonth') coupled_freq_iopt = -1000 case ('nday') if (coupled_freq == 1) then coupled_freq_iopt = freq_opt_nday ncouple_per_day = 1 else coupled_freq_iopt = -1000 endif case ('nhour') if (coupled_freq <= 24) then coupled_freq_iopt = freq_opt_nhour ncouple_per_day = 24/coupled_freq else coupled_freq_iopt = -1000 endif case ('nsecond') if (coupled_freq <= seconds_in_day) then coupled_freq_iopt = freq_opt_nsecond ncouple_per_day = seconds_in_day/coupled_freq else coupled_freq_iopt = -1000 endif case ('nstep') if (coupled_freq <= nsteps_per_day) then coupled_freq_iopt = freq_opt_nstep ncouple_per_day = nsteps_per_day/coupled_freq else coupled_freq_iopt = -1000 endif case ('never') coupled_freq_iopt = -9999 case default coupled_freq_iopt = -2000 end select select case (qsw_distrb_opt) case ('const') qsw_distrb_iopt = qsw_distrb_iopt_const case ('12hr') qsw_distrb_iopt = qsw_distrb_iopt_12hr case ('cosz') qsw_distrb_iopt = qsw_distrb_iopt_cosz call register_string('qsw_distrb_iopt_cosz') case default qsw_distrb_iopt = -1000 end select endif call broadcast_scalar(coupled_freq_iopt, master_task) call broadcast_scalar(coupled_freq , master_task) call broadcast_scalar(qsw_distrb_iopt , master_task) call broadcast_scalar(ncouple_per_day , master_task) if (coupled_freq_iopt == -1000) then call exit_POP(sigAbort, & 'ERROR: Coupling frequency must be at least once per day') else if (coupled_freq_iopt == -2000) then call exit_POP(sigAbort, & 'ERROR: Unknown option for coupling frequency') endif if (registry_match('lcoupled') .eqv. (coupled_freq_iopt == -9999) ) then call exit_POP(sigAbort, & 'ERROR: inconsistency between lcoupled and coupled_freq_iopt settings') endif if (qsw_distrb_iopt == -1000) then call exit_POP(sigAbort, & 'ERROR: Unknown option for qsw_distrb_opt') endif !----------------------------------------------------------------------- ! ! check consistency of the qsw_distrb_iopt option with various ! time manager options ! !----------------------------------------------------------------------- if ( (qsw_distrb_iopt == qsw_distrb_iopt_12hr) .or. & (qsw_distrb_iopt == qsw_distrb_iopt_cosz) ) then if ( tmix_iopt == tmix_avgfit .or. tmix_iopt == tmix_robert) then ! ok; these options are supported else call exit_POP(sigAbort, & 'ERROR: time_mix_opt must be set to avgfit for qsw_distrb_opt '/& &/ 'of 12hr or cosz') endif if ( dttxcel(1) /= c1 .or. dtuxcel /= c1 ) & call exit_POP(sigAbort, & 'ERROR: using the specified accelerated integration '/& &/ 'technique may not be appropriate for qsw_distrb_opt '/& &/ 'of 12hr or cosz') endif !----------------------------------------------------------------------- ! ! allocate and compute the short wave heat flux multiplier for qsw 12hr ! !----------------------------------------------------------------------- allocate ( qsw_12hr_factor(nsteps_per_interval)) qsw_12hr_factor = c1 if ( qsw_distrb_iopt == qsw_distrb_iopt_12hr ) then ! mimic a day time_for_forcing = c0 count_forcing = 1 sum_forcing = c0 do n=1,nsteps_per_interval frac_day_forcing = time_for_forcing / seconds_in_day cycle_function = cos( pi * ( c2 * frac_day_forcing - c1 ) ) qsw_12hr_factor(n) = c2 * ( cycle_function & + abs(cycle_function) ) & * cycle_function weight_forcing = c1 if ( count_forcing == 2 .or. & mod(count_forcing,time_mix_freq) == 0 ) & weight_forcing = p5 time_for_forcing = time_for_forcing + weight_forcing * dt(1) sum_forcing = sum_forcing & + weight_forcing * dt(1) * qsw_12hr_factor(n) count_forcing = count_forcing + 1 enddo qsw_12hr_factor = qsw_12hr_factor * seconds_in_day & / sum_forcing ! check the final integral count_forcing = 1 sum_forcing = c0 do n=1,nsteps_per_interval weight_forcing = c1 if ( count_forcing == 2 .or. & mod(count_forcing,time_mix_freq) == 0 ) & weight_forcing = p5 sum_forcing = sum_forcing & + weight_forcing * dt(1) * qsw_12hr_factor(n) count_forcing = count_forcing + 1 enddo if ( sum_forcing < (seconds_in_day - 1.0e-5_r8) .or. & sum_forcing > (seconds_in_day + 1.0e-5_r8) ) & call exit_POP (sigAbort, & 'ERROR: qsw 12hr temporal integral is incorrect') endif !----------------------------------------------------------------------- ! ! allocate space for qsw cosz fields ! !----------------------------------------------------------------------- if ( qsw_distrb_iopt == qsw_distrb_iopt_cosz ) then allocate( & QSW_COSZ_WGHT(nx_block,ny_block,nblocks_clinic), & QSW_COSZ_WGHT_NORM(nx_block,ny_block,nblocks_clinic)) endif #if CCSMCOUPLED !----------------------------------------------------------------------- ! ! define tavg fields computed from forcing_coupled routines ! !----------------------------------------------------------------------- if ( sfwf_formulation == 'hosing') then !CMB call define_tavg_field(tavg_HOSE_F,'HOSE_F',2, & long_name='Hosing Flux read into POP', & units='kg/m^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') endif if ( shf_formulation == 'heating' .or. & shf_formulation == 'alyssa_restoring' ) then !CMB call define_tavg_field(tavg_HEAT_F,'HEAT_F',2, & long_name='Heat Flux Forcing to POP', & units='W/m^2', grid_loc='2110', & coordinates='TLONG TLAT time') endif call define_tavg_field(tavg_EVAP_F,'EVAP_F',2, & long_name='Evaporation Flux from Coupler', & units='kg/m^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_PREC_F,'PREC_F',2, & long_name='Precipitation Flux from Cpl (rain+snow)', & units='kg/m^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_SNOW_F,'SNOW_F',2, & long_name='Snow Flux from Coupler', & units='kg/m^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_MELT_F,'MELT_F',2, & long_name='Melt Flux from Coupler', & units='kg/m^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_ROFF_F,'ROFF_F',2, & long_name='Runoff Flux from Coupler', & units='kg/m^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_IOFF_F,'IOFF_F',2, & long_name='Ice Runoff Flux from Coupler due to Land-Model Snow Capping', & units='kg/m^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_SALT_F,'SALT_F',2, & long_name='Salt Flux from Coupler (kg of salt/m^2/s)',& units='kg/m^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_SENH_F,'SENH_F',2, & long_name='Sensible Heat Flux from Coupler', & units='watt/m^2', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_LWUP_F,'LWUP_F',2, & long_name='Longwave Heat Flux (up) from Coupler', & units='watt/m^2', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_LWDN_F,'LWDN_F',2, & long_name='Longwave Heat Flux (dn) from Coupler', & units='watt/m^2', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_MELTH_F,'MELTH_F',2, & long_name='Melt Heat Flux from Coupler', & units='watt/m^2', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_IFRAC,'IFRAC',2, & long_name='Ice Fraction from Coupler', & units='fraction', grid_loc='2110', & coordinates='TLONG TLAT time') !----------------------------------------------------------------------- ! ! Initialize flags and shortwave absorption profile ! Note that the cpl_write_xxx flags have _no_ default value; ! therefore, they must be explicitly set .true. and .false. ! at the appropriate times ! !----------------------------------------------------------------------- call init_time_flag('coupled_ts', cpl_ts, & owner='pop_init_coupled', & freq_opt = coupled_freq_iopt, & freq = coupled_freq) !----------------------------------------------------------------------- ! ! If this is a restart, then read_restart knows the last timestep was ! a coupled timestep and has registered the string 'coupled_ts_last_true' ! (read_restart was called prior to the initialization of coupled_ts) ! !----------------------------------------------------------------------- if (registry_match('coupled_ts_last_true') ) & call override_time_flag (cpl_ts, old_value=.true.) lsmft_avail = .true. !----------------------------------------------------------------------- ! ! initialize timer for computing cosz ! !----------------------------------------------------------------------- if ( qsw_distrb_iopt == qsw_distrb_iopt_cosz ) then call get_timer (timer_compute_cosz, 'COMPUTE_COSZ', nblocks_clinic, & distrb_clinic%nprocs) endif !----------------------------------------------------------------------- ! ! register this subroutine ! !----------------------------------------------------------------------- call register_string('pop_init_coupled') #endif !----------------------------------------------------------------------- !EOC call flushm (stdout) end subroutine pop_init_coupled !*********************************************************************** !BOP ! !IROUTINE: pop_init_partially_coupled ! !INTERFACE: subroutine pop_init_partially_coupled ! !DESCRIPTION: ! This routine initializes and allocates arrays for the partially-coupled ! option ! ! !REVISION HISTORY: ! same as module !EOP !BOC #if CCSMCOUPLED !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- logical (log_kind) :: & lcoupled character (char_len) :: & message integer (int_kind) :: & number_of_fatal_errors lcoupled = registry_match('lcoupled') ! if ( lcoupled .and. shf_formulation /= 'partially-coupled' ) then if ( lcoupled .and. shf_formulation /= 'partially-coupled' .and. & shf_formulation /= 'heating' .and. shf_formulation /= 'alyssa_restoring') then shf_num_comps = 1 shf_comp_qsw = 1 allocate(SHF_COMP(nx_block,ny_block,max_blocks_clinic,shf_num_comps)) SHF_COMP = c0 endif !----------------------------------------------------------------------- ! ! initialize and allocate some partially coupled variables ! !----------------------------------------------------------------------- if ( lcoupled & .and. sfwf_formulation /= 'partially-coupled' & .and. sfc_layer_type == sfc_layer_varthick .and. & .not. lfw_as_salt_flx .and. liceform ) then sfwf_num_comps = 1 sfwf_comp_cpl = 1 tfw_num_comps = 1 tfw_comp_cpl = 1 allocate(SFWF_COMP(nx_block,ny_block, max_blocks_clinic,sfwf_num_comps)) allocate( TFW_COMP(nx_block,ny_block,nt,max_blocks_clinic, tfw_num_comps)) SFWF_COMP = c0 TFW_COMP = c0 endif !----------------------------------------------------------------------- ! ! check compatibility of partially-coupled option with other options ! !----------------------------------------------------------------------- number_of_fatal_errors = 0 if (.not. lcoupled .and. (shf_formulation == 'partially-coupled' .or. & sfwf_formulation == 'partially-coupled' ) ) then message = & 'ERROR: partially-coupled option is allowed only when coupled' write(stdout,*) message number_of_fatal_errors = number_of_fatal_errors + 1 endif if (lcoupled .and. (shf_formulation == 'partially-coupled' .and. & sfwf_formulation /= 'partially-coupled') .or. & (shf_formulation /= 'partially-coupled' .and. & sfwf_formulation == 'partially-coupled') ) then message = & 'partially-coupled must be used for both shf and sfwf' write(stdout,*) message number_of_fatal_errors = number_of_fatal_errors + 1 endif ! if (lcoupled .and. shf_formulation /= 'partially-coupled' .and. & ! shf_data_type /= 'none') then if (lcoupled .and. shf_formulation /= 'partially-coupled' .and. & shf_formulation /= 'heating' .and. & shf_formulation /= 'alyssa_restoring' .and. & shf_data_type /= 'none') then !CMB message = & 'shf_data_type must be set to none or '/& &/ 'shf_formulation must be partially_coupled when lcoupled is true' write(stdout,*) message number_of_fatal_errors = number_of_fatal_errors + 1 endif if (lcoupled .and. sfwf_formulation /= 'partially-coupled' .and. & sfwf_formulation /= 'hosing' .and. sfwf_data_type /= 'none') then ! CMB ! sfwf_data_type /= 'none') then message = & 'sfwf_data_type must be set to none or '/& &/ 'sfwf_formulation must be partially_coupled when lcoupled is true' write(stdout,*) message number_of_fatal_errors = number_of_fatal_errors + 1 endif !----------------------------------------------------------------------- ! ! check coupled compatibility with other forcing options ! !----------------------------------------------------------------------- if (lcoupled .and. ws_data_type /= 'none') then message = & 'ws_data_type must be set to none in coupled mode' write(stdout,*) message number_of_fatal_errors = number_of_fatal_errors + 1 endif if (number_of_fatal_errors /= 0) & call exit_POP(sigAbort,'subroutine pop_init_partially_coupled') #endif !----------------------------------------------------------------------- !EOC call flushm (stdout) end subroutine pop_init_partially_coupled !*********************************************************************** !BOP ! !IROUTINE: pop_set_coupled_forcing ! !INTERFACE: subroutine pop_set_coupled_forcing ! !DESCRIPTION: ! This routine is called immediately following the receipt of fluxes ! from the coupler. It combines fluxes received from the coupler into ! the STF array and converts from W/m**2 into model units. It also ! balances salt/freshwater in marginal seas and sets SHF_QSW_RAW ! and SHF_COMP. Compute QSW_COSZ_WGHT_NORM if needed. ! ! !REVISION HISTORY: ! same as module !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- #if CCSMCOUPLED integer (int_kind) :: n, nn, iblock real (r8) :: cosz_day ! time where cosz is computed real (r8) :: stf_sum1, stf_sum2 real (r8) :: rcalct1, rcalct2, psum1, psum2, esum1, esum2, msum1, msum2 real (r8) :: rsum1, rsum2, isum1, isum2, ssum1, ssum2 real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: & WORK1, WORK2 ! local work space !----------------------------------------------------------------------- ! ! combine heat flux components into STF array and convert from W/m**2 ! (note: latent heat flux = evaporation*latent_heat_vapor_mks) ! (note: snow melt heat flux = - snow_f*latent_heat_fusion_mks) ! !----------------------------------------------------------------------- !*** need to zero out any padded cells WORK1 = c0 WORK2 = c0 !$OMP PARALLEL DO PRIVATE(iblock) do iblock = 1, nblocks_clinic STF(:,:,1,iblock) = (EVAP_F(:,:,iblock)*latent_heat_vapor_mks & + SENH_F(:,:,iblock) + LWUP_F(:,:,iblock) & + LWDN_F(:,:,iblock) + MELTH_F(:,:,iblock) & -(SNOW_F(:,:,iblock)+IOFF_F(:,:,iblock)) * latent_heat_fusion_mks)* & RCALCT(:,:,iblock)*hflux_factor enddo !$OMP END PARALLEL DO !----------------------------------------------------------------------- ! ! combine freshwater flux components ! ! for variable thickness surface layer, compute fresh water and ! salt fluxes ! !----------------------------------------------------------------------- if (sfc_layer_type == sfc_layer_varthick .and. & .not. lfw_as_salt_flx) then !*** compute fresh water flux (cm/s) !$OMP PARALLEL DO PRIVATE(iblock,n) do iblock = 1, nblocks_clinic FW(:,:,iblock) = RCALCT(:,:,iblock) * & ( PREC_F(:,:,iblock)+EVAP_F(:,:,iblock) & +ROFF_F(:,:,iblock)+IOFF_F(:,:,iblock))*fwmass_to_fwflux WORK1(:,:,iblock) = RCALCT(:,:,iblock) * & MELT_F(:,:,iblock) * fwmass_to_fwflux !*** compute tracer concentration in fresh water !*** in principle, temperature of each water flux !*** could be different. e.g. !TFW(:,:,1,iblock) = RCALCT(:,:,iblock)*fwmass_to_fwflux & ! (PREC_F(:,:,iblock)*TEMP_PREC(:,:,iblock) + & ! EVAP_F(:,:,iblock)*TEMP_EVAP(:,:,iblock) + & ! MELT_F(:,:,iblock)*TEMP_MELT(:,:,iblock) + & ! ROFF_F(:,:,iblock)*TEMP_ROFF(:,:,iblock)) !*** currently assume water comes in at sea surface temp call tmelt(WORK2(:,:,iblock),TRACER(:,:,1,2,curtime,iblock)) TFW(:,:,1,iblock) = FW(:,:,iblock)*TRACER(:,:,1,1,curtime,iblock) & + WORK1(:,:,iblock) * WORK2(:,:,iblock) FW(:,:,iblock) = FW(:,:,iblock) + WORK1(:,:,iblock) !*** compute salt flux !*** again, salinity could be different for each !*** component of water flux !TFW(:,:,2,iblock) = RCALCT(:,:,iblock)*fwmass_to_fwflux & ! (PREC_F(:,:,iblock)*SALT_PREC(:,:,iblock) + & ! EVAP_F(:,:,iblock)*SALT_EVAP(:,:,iblock) + & ! MELT_F(:,:,iblock)*SALT_MELT(:,:,iblock) + & ! ROFF_F(:,:,iblock)*SALT_ROFF(:,:,iblock)) !*** currently assume prec, evap and roff are fresh !*** and all salt come from ice melt where (MELT_F(:,:,iblock) /= c0) WORK1(:,:,iblock) = & SALT_F(:,:,iblock)/MELT_F(:,:,iblock) ! salinity (msu) of melt water elsewhere WORK1(:,:,iblock) = c0 end where TFW(:,:,2,iblock) = RCALCT(:,:,iblock)*MELT_F(:,:,iblock)* & fwmass_to_fwflux*WORK1(:,:,iblock) ! + PREC_F(:,:,iblock)*c0 + EVAP_F(:,:,iblock)*c0 + ROFF_F(:,:,iblock)*c0 + IOFF_F(:,:,iblock)*c0 do n=3,nt TFW(:,:,n,iblock) = c0 ! no additional tracers in fresh water end do enddo !$OMP END PARALLEL DO else ! convert fresh water to virtual salinity flux !----------------------------------------------------------------------- ! ! if not a variable thickness surface layer or if fw_as_salt_flx ! flag is on, convert fresh and salt inputs to a virtual salinity flux ! ! Add ROFF_F to STF(:,:,2) where the ebm is not handling it ! !----------------------------------------------------------------------- ! CMB find global sum of STF before adding coupler fluxes stf_sum1 = global_sum(STF(:,:,2,:),distrb_clinic,field_loc_center) !$OMP PARALLEL DO PRIVATE(iblock) do iblock = 1, nblocks_clinic STF(:,:,2,iblock) = RCALCT(:,:,iblock)*( & (PREC_F(:,:,iblock)+EVAP_F(:,:,iblock)+ & MELT_F(:,:,iblock)+(c1-MASK_ESTUARY(:,:,iblock))*ROFF_F(:,:,iblock)+& IOFF_F(:,:,iblock))*salinity_factor & + SALT_F(:,:,iblock)*sflux_factor) enddo !$OMP END PARALLEL DO ! CMB find global sum of STF after adding coupler fluxes stf_sum2 = global_sum(STF(:,:,2,:),distrb_clinic,field_loc_center) if (my_task == master_task) then write(stdout,'(a30,2(e12.3))') & 'COUPLED STF FW global sums 1 and 2 ', stf_sum1, stf_sum2 ! write(stdout,'(9(e12.3))') & ! rcalct1,psum1,esum1,msum1,rsum1,isum1,ssum1,salinity_factor,sflux_factor endif if ( lestuary_on ) then ! Treat river runoff as the interior source if (lvsf_river) call set_estuary_vsf_forcing ! Include estuary exchange flow as vertical salt flux if (lebm_on) call set_estuary_exch_circ if (lvsf_river) THEN ! Add global correction for salt conservation, correcting for using local ! tracer concentration in application of ROFF_F. Analogous term for passive ! tracers is applied in passive_tracers.F90:set_sflux_passive_tracers, ! after STF has been computed. Correction is applied where MASK_ESTUARY=1. !$OMP PARALLEL DO PRIVATE(iblock) do iblock = 1, nblocks_clinic STF(:,:,2,iblock) = STF(:,:,2,iblock) + MASK_ESTUARY(:,:,iblock)*vsf_river_correction(2) enddo !$OMP END PARALLEL DO endif endif !----------------------------------------------------------------------- ! ! balance salt/freshwater in marginal seas ! !----------------------------------------------------------------------- if (lms_balance .and. sfwf_formulation /= 'partially-coupled' ) then call ms_balancing (STF(:,:,2,:),EVAP_F, PREC_F, MELT_F,ROFF_F,IOFF_F, & SALT_F, QFLUX, 'salt') endif endif !$OMP PARALLEL DO PRIVATE(iblock,n) do iblock = 1, nblocks_clinic SHF_QSW_RAW(:,:,iblock) = SHF_QSW(:,:,iblock) if ( shf_formulation == 'partially-coupled' ) then SHF_COMP(:,:,iblock,shf_comp_cpl) = STF(:,:,1,iblock) if ( .not. lms_balance ) then SHF_COMP(:,:,iblock,shf_comp_cpl) = & SHF_COMP(:,:,iblock,shf_comp_cpl) * MASK_SR(:,:,iblock) SHF_QSW(:,:,iblock) = SHF_QSW(:,:,iblock) * MASK_SR(:,:,iblock) endif endif if ( shf_formulation == 'heating' .or. & shf_formulation == 'alyssa_restoring' ) then SHF_COMP(:,:,iblock,shf_comp_cpl) = STF(:,:,1,iblock) endif SHF_COMP(:,:,iblock,shf_comp_qsw) = SHF_QSW(:,:,iblock) if ( sfwf_formulation == 'partially-coupled' ) then if (sfc_layer_type == sfc_layer_varthick .and. & .not. lfw_as_salt_flx) then SFWF_COMP(:,:,iblock,sfwf_comp_cpl) = & FW(:,:,iblock) * MASK_SR(:,:,iblock) do n=1,nt TFW_COMP(:,:,n,iblock,tfw_comp_cpl) = & TFW(:,:,n,iblock) * MASK_SR(:,:,iblock) enddo else SFWF_COMP(:,:,iblock,sfwf_comp_cpl) = & STF(:,:,2,iblock) * MASK_SR(:,:,iblock) endif else if ( sfwf_formulation == 'hosing' ) then ! CMB added if (sfc_layer_type == sfc_layer_varthick .and. & .not. lfw_as_salt_flx) then call exit_POP(sigAbort,'ERROR hosing should have lfw_as_salt_flx be true') ! CMB this might work but would still need much add'n coding elsewhere SFWF_COMP(:,:,iblock,sfwf_comp_cpl) = FW(:,:,iblock) do n=1,nt TFW_COMP(:,:,n,iblock,tfw_comp_cpl) = TFW(:,:,n,iblock) enddo else SFWF_COMP(:,:,iblock,sfwf_comp_cpl) = STF(:,:,2,iblock) endif else if ( sfc_layer_type == sfc_layer_varthick .and. & .not. lfw_as_salt_flx .and. liceform ) then SFWF_COMP(:,:,iblock,sfwf_comp_cpl) = FW(:,:,iblock) TFW_COMP (:,:,:,iblock,tfw_comp_cpl) = TFW(:,:,:,iblock) endif endif if ( luse_cpl_ifrac ) then OCN_WGT(:,:,iblock) = (c1-IFRAC(:,:,iblock)) * RCALCT(:,:,iblock) endif enddo !$OMP END PARALLEL DO !----------------------------------------------------------------------- ! Compute QSW_COSZ_WGHT_NORM. !----------------------------------------------------------------------- if ( qsw_distrb_iopt == qsw_distrb_iopt_cosz ) then tday00_interval_beg = tday00 !$OMP PARALLEL DO PRIVATE(iblock,nn,cosz_day) do iblock = 1, nblocks_clinic QSW_COSZ_WGHT_NORM(:,:,iblock) = c0 do nn = 1, nsteps_per_interval cosz_day = tday00_interval_beg + interval_cum_dayfrac(nn-1) & - interval_cum_dayfrac(nsteps_per_interval) call compute_cosz(cosz_day, iblock, QSW_COSZ_WGHT(:,:,iblock)) if (interval_avg_ts(nn)) then QSW_COSZ_WGHT_NORM(:,:,iblock) = & QSW_COSZ_WGHT_NORM(:,:,iblock) & + p5 * QSW_COSZ_WGHT(:,:,iblock) else QSW_COSZ_WGHT_NORM(:,:,iblock) = & QSW_COSZ_WGHT_NORM(:,:,iblock) & + QSW_COSZ_WGHT(:,:,iblock) endif enddo where (QSW_COSZ_WGHT_NORM(:,:,iblock) > c0) & QSW_COSZ_WGHT_NORM(:,:,iblock) = & (fullsteps_per_interval + p5 * halfsteps_per_interval) & / QSW_COSZ_WGHT_NORM(:,:,iblock) enddo !$OMP END PARALLEL DO endif #endif !----------------------------------------------------------------------- !EOC end subroutine pop_set_coupled_forcing !*********************************************************************** !BOP ! !IROUTINE: set_combined_forcing ! !INTERFACE: subroutine set_combined_forcing (STF,FW,TFW) ! !DESCRIPTION: ! ! This routine combines heat flux components into the STF array and ! converts from W/m**2, then combines terms when the "partially-coupled" ! has been selected ! ! !REVISION HISTORY: ! same as module ! !INPUT/OUTPUT PARAMETERS: real (r8), dimension(nx_block,ny_block,nt,max_blocks_clinic), & intent(inout) :: & STF, &! surface tracer fluxes at current timestep TFW ! tracer concentration in water flux real (r8), dimension(nx_block,ny_block,max_blocks_clinic), & intent(inout) :: & FW ! fresh water flux !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & iblock, &! local address of current block n ! index #if CCSMCOUPLED real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: & WORK1, WORK2 ! local work arrays real (r8) stf_sum2 !*** need to zero out any padded cells WORK1 = c0 WORK2 = c0 if ( shf_formulation == 'partially-coupled' ) then !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic STF(:,:,1,iblock) = SHF_COMP(:,:,iblock,shf_comp_wrest) & + SHF_COMP(:,:,iblock,shf_comp_srest) & + SHF_COMP(:,:,iblock,shf_comp_cpl) enddo !$OMP END PARALLEL DO else if ( shf_formulation == 'heating' .or. & shf_formulation == 'alyssa_restoring' ) then !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic STF(:,:,1,iblock) = SHF_COMP(:,:,iblock,shf_comp_heatflux) & + SHF_COMP(:,:,iblock,shf_comp_cpl) ! STF(:,:,1,iblock) = SHF_COMP(:,:,iblock,shf_comp_cpl) ! for testing enddo !$OMP END PARALLEL DO endif if ( sfwf_formulation == 'partially-coupled' ) then if (sfc_layer_type == sfc_layer_varthick .and. & .not. lfw_as_salt_flx) then !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic STF(:,:,2,iblock) = SFWF_COMP(:,:, iblock,sfwf_comp_wrest) & + SFWF_COMP(:,:, iblock,sfwf_comp_srest) FW(:,:,iblock) = SFWF_COMP(:,:, iblock,sfwf_comp_cpl) & + SFWF_COMP(:,:, iblock,sfwf_comp_flxio) TFW(:,:,:,iblock) = TFW_COMP(:,:,:,iblock, tfw_comp_cpl) & + TFW_COMP(:,:,:,iblock, tfw_comp_flxio) enddo !$OMP END PARALLEL DO else if ( lms_balance ) then !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic WORK1(:,:,iblock) = SFWF_COMP(:,:,iblock,sfwf_comp_flxio) / & salinity_factor WORK2(:,:,iblock) = SFWF_COMP(:,:,iblock,sfwf_comp_cpl) enddo !$OMP END PARALLEL DO call ms_balancing (WORK2, EVAP_F,PREC_F, MELT_F, ROFF_F, IOFF_F, & SALT_F, QFLUX, 'salt', ICEOCN_F=WORK1) !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic STF(:,:,2,iblock) = SFWF_COMP(:,:,iblock,sfwf_comp_wrest) & + SFWF_COMP(:,:,iblock,sfwf_comp_srest) & + WORK2(:,:,iblock) & + SFWF_COMP(:,:,iblock,sfwf_comp_flxio)* & MASK_SR(:,:,iblock) enddo !$OMP END PARALLEL DO else !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic STF(:,:,2,iblock) = SFWF_COMP(:,:,iblock,sfwf_comp_wrest) & + SFWF_COMP(:,:,iblock,sfwf_comp_srest) & + SFWF_COMP(:,:,iblock,sfwf_comp_cpl) & + SFWF_COMP(:,:,iblock,sfwf_comp_flxio) enddo !$OMP END PARALLEL DO endif endif else if ( sfwf_formulation == 'hosing' ) then if (sfc_layer_type == sfc_layer_varthick .and. & .not. lfw_as_salt_flx) then call exit_POP(sigAbort,'ERROR hosing should have lfw_as_salt_flx be true') else ! CMB note the balancing of freshwater in marginal seas is done above in set_forcing_coupled ! irrespective of hosing. Hence hosing can break balance if there is any in the marginal seas ! even if you set lms_balance to be T !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic STF(:,:,2,iblock) = SFWF_COMP(:,:,iblock,sfwf_comp_cpl) & + SFWF_COMP(:,:,iblock,sfwf_comp_hosing) enddo !$OMP END PARALLEL DO if (my_task == master_task) then write(stdout,'(a70)') & 'STF is combined coupler and hosing forcing and/or heating flux' ! stf_sum2 = global_sum(SFWF_COMP(:,:,:,sfwf_comp_hosing),distrb_clinic,field_loc_center) ! write(stdout,'(a30,e12.3)') & ! 'HOSING SFWF_COMP in combined forcing ', stf_sum2 endif endif ! if surf_layer_blah blah endif ! if sfwf_formulation == various things #endif !----------------------------------------------------------------------- !EOC end subroutine set_combined_forcing !*********************************************************************** !BOP ! !IROUTINE: tavg_coupled_forcing ! !INTERFACE: subroutine tavg_coupled_forcing ! !DESCRIPTION: ! This routine accumulates tavg diagnostics related to forcing_coupled ! forcing. ! ! !REVISION HISTORY: ! same as module !EOP !BOC #if CCSMCOUPLED !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & iblock ! block loop index type (block) :: & this_block ! block information for current block real (r8), dimension(nx_block,ny_block) :: & WORK ! local temp space for tavg diagnostics !----------------------------------------------------------------------- ! ! compute and accumulate tavg forcing diagnostics ! !----------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblock,this_block,WORK) do iblock = 1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) if ( sfwf_formulation == 'hosing') then !CMB WORK = SFWF_COMP(:,:,iblock,sfwf_comp_hosing)/salinity_factor call accumulate_tavg_field(WORK, tavg_HOSE_F,iblock,1) endif if ( shf_formulation == 'heating' .or. & shf_formulation == 'alyssa_restoring' ) then !CMB WORK = SHF_COMP(:,:,iblock,shf_comp_heatflux)/hflux_factor call accumulate_tavg_field(WORK, tavg_HEAT_F,iblock,1) endif call accumulate_tavg_field(EVAP_F(:,:,iblock), tavg_EVAP_F,iblock,1) call accumulate_tavg_field(PREC_F(:,:,iblock), tavg_PREC_F,iblock,1) call accumulate_tavg_field(SNOW_F(:,:,iblock), tavg_SNOW_F,iblock,1) call accumulate_tavg_field(MELT_F(:,:,iblock), tavg_MELT_F,iblock,1) call accumulate_tavg_field(ROFF_F(:,:,iblock), tavg_ROFF_F,iblock,1) call accumulate_tavg_field(IOFF_F(:,:,iblock), tavg_IOFF_F,iblock,1) call accumulate_tavg_field(SALT_F(:,:,iblock), tavg_SALT_F,iblock,1) call accumulate_tavg_field(SENH_F(:,:,iblock), tavg_SENH_F,iblock,1) call accumulate_tavg_field(LWUP_F(:,:,iblock), tavg_LWUP_F,iblock,1) call accumulate_tavg_field(LWDN_F(:,:,iblock), tavg_LWDN_F,iblock,1) call accumulate_tavg_field(MELTH_F(:,:,iblock),tavg_MELTH_F,iblock,1) call accumulate_tavg_field(IFRAC(:,:,iblock), tavg_IFRAC,iblock,1) end do !$OMP END PARALLEL DO call tavg_mcog #endif !----------------------------------------------------------------------- !EOC end subroutine tavg_coupled_forcing !*********************************************************************** !BOP ! !IROUTINE: update_ghost_cells_coupler_fluxes ! !INTERFACE: subroutine update_ghost_cells_coupler_fluxes(errorCode) ! !DESCRIPTION: ! This routine accumulates tavg diagnostics related to forcing_coupled ! forcing. ! ! !REVISION HISTORY: ! same as module ! !OUTPUT PARAMETERS: integer (POP_i4), intent(out) :: errorCode !EOP !BOC !----------------------------------------------------------------------- ! ! update halos for all coupler fields ! !----------------------------------------------------------------------- errorCode = POP_Success #if CCSMCOUPLED call POP_HaloUpdate(SNOW_F,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating SNOW_F') return endif call POP_HaloUpdate(PREC_F,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating PREC_F') return endif call POP_HaloUpdate(EVAP_F,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating EVAP_F') return endif call POP_HaloUpdate(MELT_F,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating MELT_F') return endif call POP_HaloUpdate(ROFF_F,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating ROFF_F') return endif call POP_HaloUpdate(IOFF_F,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating IOFF_F') return endif call POP_HaloUpdate(SALT_F,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating SALT_F') return endif call POP_HaloUpdate(SENH_F,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating SENH_F') return endif call POP_HaloUpdate(LWUP_F,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating LWUP_F') return endif call POP_HaloUpdate(LWDN_F,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating LWDN_F') return endif call POP_HaloUpdate(MELTH_F,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating MELTH_F') return endif call POP_HaloUpdate(SHF_QSW,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating SHF_QSW') return endif call POP_HaloUpdate(IFRAC,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating IFRAC') return endif call POP_HaloUpdate(ATM_PRESS,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating ATM_PRESS') return endif call POP_HaloUpdate(U10_SQR,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating U10_SQR') return endif ! QL, 150526, LAMULT, USTOKES and VSTOKES call POP_HaloUpdate(LAMULT,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating LAMULT') return endif call POP_HaloUpdate(USTOKES,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating USTOKES') return endif call POP_HaloUpdate(VSTOKES,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating VSTOKES') return endif call POP_HaloUpdate(ATM_FINE_DUST_FLUX,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating ATM_FINE_DUST_FLUX') return endif call POP_HaloUpdate(ATM_COARSE_DUST_FLUX,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating ATM_COARSE_DUST_FLUX') return endif call POP_HaloUpdate(SEAICE_DUST_FLUX,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating SEAICE_DUST_FLUX') return endif call POP_HaloUpdate(ATM_BLACK_CARBON_FLUX,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating ATM_BLACK_CARBON_FLUX') return endif call POP_HaloUpdate(SEAICE_BLACK_CARBON_FLUX,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating SEAICE_BLACK_CARBON_FLUX') return endif call POP_HaloUpdate(FRAC_BIN,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating FRAC_BIN') return endif call POP_HaloUpdate(QSW_RAW_BIN,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating QSW_RAW_BIN') return endif #endif !----------------------------------------------------------------------- !EOC end subroutine update_ghost_cells_coupler_fluxes !*********************************************************************** !BOP ! !IROUTINE: rotate_wind_stress ! !INTERFACE: subroutine rotate_wind_stress (WORK1,WORK2) ! !DESCRIPTION: ! This subroutine rotates true zonal/meridional wind stress into local ! coordinates, converts to dyne/cm**2, and shifts SMFT to the U grid ! ! !REVISION HISTORY: ! same as module ! !INPUT PARAMETERS: real (r8), dimension(nx_block,ny_block,max_blocks_clinic), intent(in) :: & WORK1, WORK2 ! contains taux and tauy from coupler !EOP !BOC #if CCSMCOUPLED !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (kind=int_kind) :: iblock integer (POP_i4) :: errorCode !----------------------------------------------------------------------- ! ! rotate and convert ! !----------------------------------------------------------------------- SMFT(:,:,1,:) = (WORK1(:,:,:)*cos(ANGLET(:,:,:)) + & WORK2(:,:,:)*sin(ANGLET(:,:,:)))* & RCALCT(:,:,:)*momentum_factor SMFT(:,:,2,:) = (WORK2(:,:,:)*cos(ANGLET(:,:,:)) - & WORK1(:,:,:)*sin(ANGLET(:,:,:)))* & RCALCT(:,:,:)*momentum_factor !----------------------------------------------------------------------- ! ! perform halo updates following the vector rotation ! !----------------------------------------------------------------------- call POP_HaloUpdate(SMFT(:,:,1,:),POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindVector, errorCode, & fillValue = 0.0_POP_r8) call POP_HaloUpdate(SMFT(:,:,2,:),POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindVector, errorCode, & fillValue = 0.0_POP_r8) !----------------------------------------------------------------------- ! ! shift SMFT to U grid ! !----------------------------------------------------------------------- do iblock=1,nblocks_clinic call tgrid_to_ugrid(SMF(:,:,1,iblock),SMFT(:,:,1,iblock),iblock) call tgrid_to_ugrid(SMF(:,:,2,iblock),SMFT(:,:,2,iblock),iblock) enddo ! iblock #endif !----------------------------------------------------------------------- !EOC end subroutine rotate_wind_stress !*********************************************************************** !BOP ! !IROUTINE: compute_cosz ! !INTERFACE: subroutine compute_cosz(tday, iblock, COSZ) ! !DESCRIPTION: ! This subroutine computes cos of the solar zenith angle. ! Negative values are set to zero. ! ! !REVISION HISTORY: ! same as module ! ! !USES: use shr_orb_mod, only: shr_orb_decl, shr_orb_cosz ! !INPUT PARAMETERS: real (r8), intent(in) :: tday integer (int_kind), intent(in) :: iblock ! !OUTPUT PARAMETERS: real (r8), dimension(:,:), intent(out) :: COSZ !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & i, j ! loop indices real (r8) :: & calday, & ! Calendar day, including fraction delta, & ! Solar declination angle in rad eccf ! Earth-sun distance factor (ie. (1/r)**2) !----------------------------------------------------------------------- call timer_start(timer_compute_cosz, block_id=iblock) ! shr_orb code assumes Jan 1 = calday 1, unlike Jan 1 = tday 0 calday = tday + c1 call shr_orb_decl(calday, orb_eccen, orb_mvelpp, orb_lambm0, & orb_obliqr, delta, eccf) do j = 1, ny_block do i = 1, nx_block COSZ(i,j) = shr_orb_cosz(calday, TLAT(i,j,iblock), & TLON(i,j,iblock), delta) COSZ(i,j) = max(c0, COSZ(i,j)) enddo enddo call timer_stop(timer_compute_cosz, block_id=iblock) !----------------------------------------------------------------------- !EOC end subroutine compute_cosz !*********************************************************************** end module forcing_coupled !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| CESM2.1.3_sourcemods/PaxHeaders.32795/namelist_definition_pop.xml-ORIG0000644000000000000000000000012213774500031022361 xustar0027 mtime=1609728025.184891 26 atime=1609728025.17101 29 ctime=1609728025.18423563 CESM2.1.3_sourcemods/namelist_definition_pop.xml-ORIG0000644006307300017500000046637113774500031022763 0ustar00islasncar00000000000000 Number of processors in the baroclinic distribution. Default: Set by CESM scripts Number of processors in the barotropic distribution. Default: Set by CESM scripts Selector for method used to distribute blocks in baroclinic distribution. Valid Values: 'cartesian', 'balanced', 'spacecurve', 'blockone' Default: 'cartesian' Selector for method used to distribute blocks in barotropic distribution. Valid Values: 'cartesian', 'balanced', 'spacecurve', 'blockone' Default: 'cartesian' Selector for type of boundary used in the logical east-west direction for global domain. Valid Values: 'cyclic', 'closed' Default: 'cyclic' Selector for type of boundary used in the logical north-south direction for global domain. Valid Values: 'cyclic', 'closed', 'tripole' Default: 'closed' Flag to add MPI_Barrier calls for timing studies in time-step module. Default: .false. Number of input / output tasks. Default: 1 Flag to redirect stdout to a log file. Default: '.true.' Root name for ocean-model log file. Default: Set by CESM scripts. Flag to activate the use of pointer files, which point to the location of restart files. Default: '.true.' Root filename of the file that points to location of restarts. Default: rpointer.ocn.* (found in $RUNDIR) The CESM identifier for the run. Default: $CASENAME Option for time mixing: avgbb = DEPRECATED OPTION. leapfrog with occasional time-averaging timestep, immediately followed by another time-averaging timestep ("back-to-back" avg). DO NOT USE THIS OPTION in scientific experiments. avgfit = leapfrog with occasional time-averaging timestep to control stability. The timestep is modified such that an integer number of full and half timesteps fits into each coupling interval. robert = leapfrog with modified Robert-Asselin time filtering to control stability. The timestep is modifed such that an integer number of full timesteps fits into each coupling interval. Valid Values: 'robert' 'avgfit', 'avgbb' Frequency of mixing timestep. Ignored when time_mix_opt = 'robert' Default: 17 Flag for implicit treatment of Coriolis terms. Default: .true. Flag for timestep acceleration. Default: .false. File containing vertical profile of timestep acceleration factors. Default: Set by CESM scripts based on ocean grid Factor to multiply momentum timestep in order to set the momentum timestep to a value different from the tracer timestep. Default: 1.0 Year at the start of the experiment. iyear0 remains fixed over the course of the integration; it does not change if experiment is continued. Default: 1 Month number at the start of the experiment. imonth0 remains fixed over the course of the integration; it does not change if experiment is continued. Default: 1 Day number at the start of the experiment. iday0 remains fixed over the course of the integration; it does not change if experiment is continued. Default: 2 Hours at the start of the experiment. ihour0 remains fixed over the course of the integration; it does not change if experiment is continued. Default: 0 Minutes at the start of the experiment. iminute0 remains fixed over the course of the integration; it does not change if experiment is continued. Default: 0 Seconds at the start of the experiment. isecond0 remains fixed over the course of the integration; it does not change if experiment is continued. Default: 0 Selector for units used in determining tracer timestep size; used in conjunction with dt_count to serve as a starting point from which POP determines the exact model timestep size. Not all permissible time_mix_opt values are compatible with all dt_option values. The recommended option is steps_per_day Valid Values: 'steps_per_year', 'steps_per_day', 'seconds', 'hours' Default: 'steps_per_day' Number of timesteps in dt_option units. Serves as a starting point from which POP determines the exact model timestep size. Default: Set by CESM scripts based on ocean grid Units of time for 'stop_count'. In conjunction with 'stop_count', determines stopping time. Valid Values: 'never', 'eoy', 'eom', 'eod', 'nyear', 'nyears', 'nmonth', 'nmonths', 'nday', 'ndays', 'nstep', 'nsteps', 'date' Default: 'nyear' Number of stop_option units before POP stops OR date (yyyymmdd) at which POP stops. Default: 1000 Single character used to separate yyyy mm dd in date string. Note a blank space (' ') can be used to indicate no separator, but this is not recommended. Default: "-" Flag to select calendar with leap years. Default: .false. Number of intervals per day into which full and half timesteps must exactly "fit" when using time_mix_opt='avgfit' Default: 1 Tuning parameter used in Robert filtering. Williams, Paul D. "A proposed Modification to the Robert-Asselin Time Filter." Monthly Weather Review, Vol 137, 2009. Default: 1.0 Tuning parameter used in Robert filtering. Williams, Paul D. "A proposed Modification to the Robert-Asselin Time Filter." Monthly Weather Review, Vol 137, 2009. Default: 0.20 Print time_manager info every timestep and print initial time-flag info. Default: .false. Conserve across each Robert Filtering step. Note that this option is unstable, so only use it as a sanity check over a few days at most. Default: .false. Option to define the horizontal grid by reading from an input file ('file') or generating the grid internally ('internal') Valid Values: 'internal', 'file' Default: 'file' Option to define the vertical grid by reading from an input file ('file') or generating the grid internally ('internal'). Valid Values: 'internal', 'file' Default: 'file' Option to define the bottom topography (KMT) by reading discretized values from an input file ('file') or generating an idealized flat-bottom topography internally ('internal'). Valid Values: 'bathymetry','file','internal' Default: 'file' Name of the input file (with path) containing horizontal grid information. Default: Set by CESM scripts based on ocean grid Name of the input file (with path) containing the thickness (cm) of each vertical layer. Default: Set by CESM scripts based on ocean grid Name of the input file containing integer indices of the deepest vertical grid level at each horizontal gridpoint. Default: Set by CESM scripts based on ocean grid Name of the output file for writing horizontal grid information. Default: '$RUNDIR/$CASENAME.pop.h.topography_bathymetry.ieeer8' Name of an input file containing bathymetry information. Default: 'unknown_bathymetry' Number of topography smoothing passes. Default: 0 Flag used to select flat-bottom topography. Default: .false. Flag for removing isolated or disconnected ocean gridpoints. Default: .false. Name of the input file containing integer region number at each horizontal gridpoint. Default: Set by CESM scripts based on ocean grid Name of the input file containing integer region identification numbers at each gridpoint. The information in this file associates region ids with a region name; a negative region id indicates a marginal sea. Default: Set by CESM scripts based on ocean grid Option for surface layer type: variable thickness ('varthick'), rigid lid ('rigid'), or old free-surface formulation ('oldfree'). The 'oldfree' option is obsolete. Valid Values: 'varthick', 'rigid', 'oldfree' Default: 'varthick' Flag to activate the use of partial bottom cells. Default: .false. Input file containing thickness (cm) of partial bottom cell for each column. Default: 'unknown_bottom_cell' Minimum allowable non-zero KMT value. Default: 3 Flag to run POP in 1D dynamics mode (recommend only using with T62_g37 resolution) Default: .false. Flag to treat all columns the same (true 1D run). Recommend only using with the T62_g37 resolution; can not be run without l1Ddyn = .true. Default: .false. Flag to run POP with a spatially-constant Coriolis parameter; can not be run without l1Ddyn = .true. Default: .false. Flag to run POP with a specified minimum value for the Coriolis parameter; can not be run without l1Ddyn = .true. Default: .false. if l1Ddyn = .false; .true. if l1Ddyn = .true. If lmin_Coriolis = .true., this is smallest value for Coriolis parameter. (units = 1/s) Default: 6.4e-6 (corresponds to ~2.5 degrees) If lconst_Coriolis = .true., use this value for Coriolis parameter. (units = 1/s) Default: 1e-4 If lidentical_columns = .true., use this value for tau_x in surface forcing. (units = N/m^2, converted in source code) Default: 0.1 If lidentical_columns = .true., use this value for SHF coefficient in surface forcing (units = W/m^2, converted in source code). Default: -100 Option for initializing ocean conditions. 'ccsm_startup' reads initial temperature and salinity from a file; 'ccsm_continue' and 'ccsm_branch' read ocean initial conditions from a restart file; 'ccsm_hybrid' reads ocean initial conditions from a restart file with a different model date; and 'PHC' remaps PHC Levitus data to POP grid. 'PHC' is a research option that is available but not publicly supported. Default: 'ccsm_RUNTYPE' Name of the input file containing ocean initial conditions. Contents of this file depend on init_ts_option. If luse_pointer_files = .true., and init_ts_option is 'ccsm_continue', 'ccsm_branch', or 'ccsm_hybrid', then init_ts_file is ignored and POP reads the file specified in the ocean rpointer files. Default: Set by CESM scripts based on ocean grid Data format type of init_ts_file file; either binary ('bin') or netCDF ('nc'). Valid Values: 'bin', 'nc' Default: 'bin' Suboption for initializing temperature and salinity. See CESM documentation. This option should only be used by experts. If init_ts_suboption = 'spunup', then init_ts_option is set (internally) to 'ccsm_startup_spunup'; otherwise, this option has no effect. If the spunup suboption is selected, the model T,S are initialized from the specified input file, but velocities are initialized to zero, as in a 'ccsm_startup' run. This option should only be used by experts. Default: 'null' Name of the output file for writing temperature and salinity. This file is only generated when init_ts_option = 'PHC' Default: '$RUNDIR/$CASENAME.pop.h.ts_ic' Data format type of init_ts_outfile file; either binary ('bin') or netCDF ('nc'). Valid Values: 'bin', 'nc' Default: 'nc' init_ts_perturb perturbation for ts. Default: 1.0e-3 Units of time for diag_global_freq (frequency of global diagnostics). Valid Values: 'never', 'nyear', 'nmonth', 'nday', 'nhour', 'nsecond', 'nstep' Default: 'nmonth' Frequency of computing and printing of global diagnostics. Default: 1 Units of time for diag_cfl_freq (frequency of CFL diagnostics). Valid Values: 'never', 'nyear', 'nmonth', 'nday', 'nhour', 'nsecond', 'nstep' Default: 'nmonth' Frequency of computing and printing CFL diagnostics. Default: 1 Units of time for diag_transp_freq (frequency of transport diagnostics). Valid Values: 'never', 'nyear', 'nmonth', 'nday', 'nhour', 'nsecond', 'nstep' Default: 'nmonth' Frequency of computing and printing transport diagnostics. Default: 1 Name of the file that contains information for choosing fields for output. (the "transport_contents" file name) Default: Set by CESM scripts based on ocean grid Flag to control the writing of some global diagnostics for all vertical levels. If true, tracer mean diagnostics at all vertical levels are computed and printed. Default: .false. Flag to control the writing of some CFL diagnostics for all vertical levels. If true, CFL diagnostics at all vertical levels are computed and printed. Default: .false. Name of the output file into which diagnostics are written. Default: '$RUNDIR/$CASENAME.pop.dd' Name of the output file into which transport diagnostics are written. Default: '$RUNDIR/$CASENAME.pop.dt' Name of the output file into which the velocity diagnostics are written. Default: '$RUNDIR/$CASENAME.pop.dv' Flag to activate the computation of the velocity diagnostics. Default: .true. Flag to control the computation of global budget diagnostics for tracers. Default: .true. Flag to control the printing Robert-filter budget terms in a human-eye-friendly manner. Default: .false. Flag to control the computation and printing of barotropic stream function diagnostics. Default: .true. Units of time for restart_freq (restart frequency). Valid Values: 'never', 'nyear', 'nmonth', 'nday', 'nhour', 'nsecond', 'nstep' Default: 'nyear' Number of 'restart_freq_opt' units between the writing of restart files. Default: 100000 Name of the restart output filename root. The model code will create the complete restart output filename based on the model date. Default: '$RUNDIR/$CASENAME.pop.r' Data format type of restart_outfile file; either binary ('bin') or netCDF ('nc'). Valid Values: 'bin', 'nc' Default: 'nc' Flag to turn even_odd restarts on. Default: .false. Frequency to write even/odd restart files (units = nstep). Default: 100000 Flag to apply correction to pressure upon restart. If .true., surface pressure is modified to correct for an error due to (possible) different timestep. Use .false. for exact restart. Default: .false. Units of time for restart_start. Take restart_start units prior to beginning the writing of regular restart files. Default: 'nstep' Wait prior to beginning to output restart files. Number of units of restart_start_opt before restart files are started in a run. Default: 0 Units of time for history_freq (frequency of writing history files). Valid Values: 'never', 'nyear', 'nmonth', 'nday', 'nhour', 'nsecond', 'nstep' Default: 'never' Frequency of writing history files. Default: 1 Root filename for history files. Default: '$CASENAME.pop.hs' Filename for choosing fields for output in history file. Default: Set by CESM scripts based on ocean grid Data format type of history_outfile file; either binary ('bin') or netCDF ('nc'). Valid Values: 'bin', 'nc' Default: 'nc' Units of time for movie_freq (frequency of writing movie files). Valid Values: 'never', 'nyear', 'nmonth', 'nday', 'nhour', 'nsecond', 'nstep' Default: 'never' Frequency of writing movie files. Default: 1 Root filename for movie files. Default: '$CASENAME.pop.hm' Filename for choosing fields for output in movie file. Default: Set by CESM scripts based on ocean grid Data format type of movie_outfile file; either binary ('bin') or netCDF ('nc'). Valid Values: 'bin', 'nc' Default: 'nc' Method to solve the two-dimensional elliptic equation for the surface pressure. Valid Values: 'ChronGear','pcg','PCSI' 'ChronGear' = Chronopoulos-Gear conjugate-gradient solver with preconditioner. 'pcg' = Preconditioned conjugate-gradient solver. 'PCSI' = Preconditioned Classical Stiefel Iteration. Default: 'ChronGear' Convergence error criterion: |δX/X| < convergenceCriterion Default: 1.0e-13 Upper limit on number of solver iterations. Default: 1000 Check for convergence every convergenceCheckFreq iterations. Default: 10 Start checking for convergence after convergenceCheckStart steps (starting step number of convergence checking). Default: 60 Preconditioner choice. Valid Values: 'diagonal', 'evp','file' 'diagonal' -- No preconditioner. 'file' -- A preconditioner is used to reduce number of iterations to convergence. No longer supported. 'evp' -- Edge-vertex preconditioner. Default: 'diagonal' File containing preconditioner coefficients for solver; used when preconditionerChoice='file'. Default: 'unknownPrecondFile' Convergence error criterion for Lanczos step. Default: 0.15 Maximum number of Lanczos steps taken to get eigenvalues. Default: 100 Selector for method of computing vertical diffusion. Valid Values: 'const', 'rich', 'kpp' 'const' -- use constant vertical mixing 'rich' -- use Richardson-number vertical mixing 'kpp' -- use Kpp vertical mixing Default: 'kpp' Time-centering parameter for implicit vertical mixing. Use of the default value (1.0) is recommended. Valid Values: in the range [0.5,1.0] Default: 1.0 Drag coefficient used in quadratic bottom drag formula (dimensionless). Default: 1.0e-3 Flag to activate computation of vertical mixing implicitly in time. Default: .true. Selector for convection method. Valid Values: 'adjustment', 'diffusion' 'adjustment' -- convection treated by adjustment. 'diffusion' -- convection treated by large mixing coefficients. Default: 'diffusion' Number of passes through the convective-adjustment algorithm. Default: 2 Tracer mixing coefficient to be used with diffusion option. Default: 10000.0 Momentum mixing coefficient to use with diffusion option. Default: 10000.0 !-- - - - - - - - - - - - - - - - - - --> Option for geothermal (bottom) heat flux. Valid Values: 'const', 'spatial' Default: 'const' Constant geothermal heat flux to apply to bottom layers. (W/m^2) Default: 0.0 Depth (cm) below which geothermal heat flux is applied. Default: 1000.0e2 Vertical viscosity coefficient (momentum mixing) (cm^2/s). Default: 0.25 Vertical diffusivity coefficient (tracer mixing) (cm^2/s). Default: 0.25 Background vertical viscosity (cm^2/s). Default: 1.0 Background vertical diffusivity (cm^2/s). Default: 0.1 Coefficient for Richardson-number function. Default: 50.0 Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Flag to activate Schmittner's method southern ocean modification. Default: .true. Flag for setting q==1 in construction of 3D tidal energy field from tidal constituents for plotting/testing' Do not activate this flag in a scientific experiment. Default: .false. Flag for setting q==0.33 in construction of 3D tidal energy field from tidal constituents for plotting/testing' Do not activate this flag in a scientific experiment. Default: .false. Flag to activate tidal mixing. Default: .true. Flag to impose tidal_mix_max on all TIDAL_DIFF values. Default: .true. Flag to impose tidal_mix_max on all TIDAL_DIFF values. Default: .true. Flag to activate collection of fields used to create Melet plot. Default: .false. Flag to activate 18.6-year lunar cycle. Default: .false. Selector for tidal mixing scheme method. 'jayne' Jayne, S. R., and L. C. St. Laurent, 2001: Parameterizing tidal dissipation over rough topography. Geophys. Res. Lett., v28, 811-814. Simmons, H. L., S. R. Jayne, L. C. St. Laurent, and A. J. Weaver, 2004: Tidally driven mixing in a numerical model of the ocean general circulation. Ocean Modelling, vol 6, 245-263. Jayne, Steven R., 2009: The Impact of Abyssal Mixing Parameterizations in an Ocean General Circulation Model. JPO, vol 39, 1756-1775. 'schmittner' Use with 3D datasets only. Schmittner, A. and G.D. Egbert, 2014: An improved parameterization of tidal mixing for ocean models. Geosci. Model Dev., 7, 211-224, 201 'polzin' Melet version is implemented. Polzin, K. L., 2009: An abyssal recipe. Ocean Modelling, vol 30, 298-309 Melet, A. et al, 2013: Sensitivity of the ocean state to the vertical distribution of the internal-tide-driven mixing. J. Phys Oceanography, vol 43, 602-615 Default: 'jayne' Selector for tidal mixing energy file source. 'jayne' Jayne 2009 'arbic' not yet available 'ER03' Egbert and Ray 2003 'GN13' Green and Nycander 2013 'LGM0' LGM present day Wilmes 2017 'LGMi5g21' LGM 21kyrbp sea-level reconstruction ig5 'LGMi6g21' LGM 21kyrbp sea-level reconstruction ig6 Default: 'jayne' Minimum value of N**2 used in tidal diffusion computations. Default: 1.0e-08 Fraction of energy available for mixing local to the generation region. Default: 0.33 Tidal mixing efficiency. (Gamma) Default: 0.2 Vertical decay scale for turbulence (cm). Default: 500.0e02 Input file containing initialization variables (urms and topographic roughness) for use in the Polzin tidal mixing method. Default: 'unknown_tidal_vars_file_polz' Tidal dissipation vertical threshhold in tidal-constituent dataset (cm). Energy above this level is not included in the parameterization. Active only when 3D tidal-constituent datasets are used. Default: 0.0e02 Maximum for vertical diffusivity and viscosity (cm^2/s). Default: 100.0 ################## TEST Apply minimum tidal mixing value in specified regions Default: .false. Number of regions where minimum tidal-mixing values will be applied Default: 2 Number of bottom k-levels where minimum tidal-mixing values will be applied Default: 6 Name of regions where minimum tidal-mixing values will be applied Default: 2 Array of minimum tidal-mixing values Default: 1.0 Array of tidal-mixing lower TLAT values Default: 1.0 Array of tidal-mixing upper TLAT values Default: 1.0 Array of tidal-mixing lower TLON values Default: 1.0 Array of tidal-mixing upper TLON values Default: 1.0 ################## TEST Input file containing tidal energy. Default: 'unknown_tidal_energy_file' File format of the tidal_energy_file file. Valid Values: 'bin,nc' Default: 'nc' Array of tidal energy timeseries modulation files (18.6 year tidal cycle), for each of the tidal constituents M2,S2,K1,O1. Ignored if the lunar cycle is not active. Default: 'unknown_tidal_energy_ts_files' File format of the tidal_energy_ts_file file. Ignored if the lunar cycle is not active. Valid Values: 'ascii' Default: 'ascii' tidal_energy_ts_file calendar type. Ignored if the lunar cycle is not active. Valid Values: '365' Default: '365' Model year assigned to the selected data year. Ignored if the lunar cycle is not active. Default: '1' Starting year used in the model from the lunar-cycle timeseries data record. The lunar-cycle timeseries data record starts at 1500-01-02 (yyyy-mm-dd). Ignored if the lunar cycle is not active. Default: '1948' Numerical representation of the starting month used in the model from the lunar-cycle timeseries data record. 1 ==> January, etc. The lunar-cycle timeseries data record starts at 1500-01-02 (yyyy-mm-dd). Ignored if the lunar cycle is not active. Default: '1' Starting day used in the model from the lunar-cycle timeseries data record. The lunar-cycle timeseries data record starts at 1500-01-02 (yyyy-mm-dd). There are no data points at 29-Feb, but the model can accomodate a Gregorian calendar anyway, by interpolating between 28-Feb and 01-Mar. Ignored if the lunar cycle is not active. Default: '1' Final year used in the model from the lunar-cycle timeseries data record. The lunar-cycle timeseries data record extends through 2200-12-31 (yyyy-mm-dd). Ignored if the lunar cycle is not active. Default: '2009' Numerical representation of the final month used in the model from the lunar-cycle timeseries data record. The lunar-cycle timeseries data record extends through 2200-12-31 (yyyy-mm-dd). Ignored if the lunar cycle is not active. Default: '' Final day used in the model from the lunar-cycle timeseries data record. The lunar-cycle timeseries data record extends through 2200-12-31 (yyyy-mm-dd). Ignored if the lunar cycle is not active. Default: '1' File format of the tidal_vars_file_polz file (netCDF only). Ignored if the 'polzin' tidal_mixing_method_choice option is not active. Default: 'nc' Vertical decay function used in the Schmittner subgridscale scheme. Ignored if the 'schmittner' tidal_mixing_method_choice option is not active. Valid Values: 'SSJ02','P09' Default: 'SSJ02' Background diffusivity (Ledwell). Default: 0.16 Variation in diffusivity. Default: 0.0 Equatorial diffusivity (Gregg). Default: 0.01 Maximum PSI-induced diffusivity (MacKinnon). Default: 0.13 Banda Sea diffusivity (Gordon). Default: 1.0 Depth at which diffusivity equals vdc1 Default: 1000.0e02 Inverse length for transition region. Default: 4.5e-05 Prandtl number. Default: 10.0 Coefficient for Richardson number term. Default: 50.0 Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Number of times to vertically smooth Ri. Default: 1 Flag for computing Ri-dependent mixing. Default: .true. Flag for computing double-diffusive mixing. Default: .true. Flag for computing short-wave forcing. Default: .true. Flag to check Ekman, Monin-Obhukov depth limit. Default: .false. Flag to decrease Arctic background diffusivity; typically only used as an option with niw_mixing in research mode. Default: .false. Flag to allow horizontally-varying background (need bckgrnd_vdc2=0.0). Default: .true. Flag for using inertial mixing parameterization. Default: .false. Flag for using CVMix for mixing instead of POP routines Default: .true. Langmuir mixing parameterization option. Valid Values: 'null', 'vr12-ma', 'vr12-en' Default: 'vr12-ma' Tracer advection choice. Valid Values: 'center','upwind','lw_lim' Default: 'upwind3' Type of horizontal momentum mixing. Valid Values: 'del2', 'del4', 'anis', 'gent' Default: 'anis' Type of horizontal tracer mixing. Valid Values: 'del2','del4','gent','gmaniso' Default: 'gent' Flag for submesoscale mixing. Default: .true. Flag to internally compute mixing coefficient. Default: .false. Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Flag to enable spatially-varying mixing. Default: .false. Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Horizontal momentum mixing coefficient. Default: 0.5e8 Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Flag to internally compute mixing coefficient. Default: .false. Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Flag to enable spatially-varying mixing. Default: .false. Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Horizontal tracer mixing coefficient. Default: 0.6e7 Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Flag to internally compute mixing coefficient. Default: .false. Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Flag to enable spatially-varying mixing. Default: .false. Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Horizontal momentum mixing coefficient. Default: -0.6e20 Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Flag to internally compute mixing coefficient. Default: .false. Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Flag to enable spatially-varying mixing. Default: .false. Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Horizontal tracer mixing coefficient. Default: -0.2e20 Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! choice for major axis direction Valid Values: 'shear', 'east', 'zonal', 'flow', 'pvgrid', 'read' Default: 'shear' choice for minor diffusivity Valid Values: 'simple', 'read' Default: 'simple' choice for diffusivity ratio (major/minor) Valid Values: 'shear', 'simple', 'read' Default: 'shear' Flag to add random fluctuation to orientation Default: .false. T reduce major only for cfl violations, F reduce entire tensor for cfl violations Default: .true. T Set isotropic diffusivity with minor: F set isotropic diffusivity with avg of major and minor Default: .true. T to do isotropic using diagnosis Default: .false. Save aniso time averaged diagnostics Default: .true. T to use simple subcell volume = 1/8 T-cell volume, F to use HTN & HTE Default: .false. T do VDC here, F to do in vertical_mix Default: .false. multiplication factor for cfl check Default: 0.175 constant eigenvalue ratio Default: 5.0 max negative factor of major to set minor, set to 0 to force minor to be positive Default: 0.0 minor eigenvalue multiplicative factor Default: 1.0 multiplicative coefficient for shear dispersion term: MAJOR = MINOR + shrdispfac/MINOR*<(U*dy)^2+(V*dx)^2> Default: 0.5 Choice for KAPPA_ISOP (isopycnal). Valid Values: 'cons', 'steer', 'depth', 'vmhs', 'hdgr', 'drad', 'bfre', 'bfvm', 'bfhd', 'bfdr', 'edgr' Default: 'bfre' Choice for KAPPA_THIC (thickness). Valid Values: 'cons', 'steer', 'depth', 'vmhs', 'hdgr', 'drad', 'bfre', 'bfvm', 'bfhd', 'bfdr', 'edgr' Default: 'bfre' Frequency of KAPPA computation. Valid Values: 'never', 'every_time_step', 'once_a_day' Default: 'once_a_day' Choice for slope control. Valid Values: 'tanh', 'notanh', 'clip', 'Gerd' Default: 'notanh' 1 of 2 parameters for variation of KAPPA with kappa_type_depth option. Default: 1.0 1 of 2 parameters for variation of KAPPA with kappa_type_depth option. Default: 0.0 Depth scale for variation of KAPPA with kappa_type_depth. Default: 150000.0 Isopycnal diffusivity. Default: 3.0e7 Note: You must specify both the variable name and namelist name if you change this variable in user_nl_pop! Thickness (GM bolus) diffusivity. Default: 3.0e7 Flag to use ag_bkg_srfbl as maxmium background horizontal diffusivity within the surface boundary layer (rather than using KAPPA_ISOP). Default: .true. Background horizontal diffusivity within the surface boundary layer. Default: 3.0e7 Background horizontal diffusivity at k = KMT Default: 0.0 specify isopcynal deep diffusivity as fraction of the reference value Default: 0.1 specify thickness deep diffusivity as fraction of the reference value Default: 0.1 Maximum slope allowed for redi diffusion. Default: 0.3 Maximum slope allowed for bolus transport. Default: 0.3 Flag for diagnostic bolus velocity computation. Default: .true. Flag for diagnostic steering level eddy flux computation. Default: .true. Flag for transition layer parameterization. Default: .true. Flag to use climatoligical N^2 data instead of model-dependent N^2. Default: .false. File name for the time-dependent buoyancy frequency (squared). Default: '$RUNDIR/buoyancy_freq' buoyancy_freq_filename format (binary or netCDF). Valid Values: 'bin', 'nc' Default: 'nc' Unitless tuning parameter. Default: 1.2 Effective upper limit for inverse eddy timescale (unitless). Default: 500.0 Minimum value for KAPPA (cm^2/s). Default: 0.35e7 Maximum value for KAPPA (cm^2/s). Default: 2.0e7 Efficiency factor: must be between 0.06 and 0.08 [inclusive]. Default: 0.07 Time scale constant in seconds -- must be between 1 and 4 days [86400 and 345600 seconds]. Default: 8.64e4 (1 day) Flag to use constant horizontal length scale given by hor_length_scale rather than varying length scale with space and time. Default: .false. Constant horizontal length scale in cm (if luse_const_horiz_len_scale=.true.). Default: 5.0e5 (5 km) Direction that breaks isotropy. Valid Values: 'flow', 'east', 'grid' Default: 'east' Flag to allow spatially variable anisotropic viscosity. Default: .true. Flag to use nonlinear Smagorinski viscosities (c_para/perp and u_para/perp) rather than input anisotropic viscosities (visc_para/perp). Default: .false. Viscosity parallel to alignment direction. Default: 50.0e7 Viscosity perpendicular to alignment direction. Default: 50.0e7 Dimensionless Smagorinksi coefficient parallel to alignment direction. Default: 8.0 Dimensionless Smagorinksi coefficient perpendicular to alignment direction. Default: 8.0 Velocity for grid Reynolds number viscous limit (parallel to alignment direction). Default: 5.0 Velocity for grid Reynolds number viscous limit (perpendicular to alignment direction). Default: 5.0 1 of 7 coefficients for variable viscosity form. Units are cm^2/s. Default: 0.6e7 1 of 7 coefficients for variable viscosity form. Default: 0.5 1 of 7 coefficients for variable viscosity form. Default: 0.16 1 of 7 coefficients for variable viscosity form. Units are 1/cm. Default: 2.e-8 1 of 7 coefficients for variable viscosity form. Default: 3 1 of 7 coefficients for variable viscosity form. Units are cm^2/s. Default: 0.6e7 1 of 7 coefficients for variable viscosity form. Units are degrees of latitude. Default: 45.0 Latitude at which to vary perpendicular Smagorinsky viscosity. Default: 20.0 Coefficient of latitude-dependent Smagorinsky viscosity. Default: 0.98 Gaussian width of latitude-dependent Smagorinksy viscosity. Default: 98.0 File name for variable viscosity factor. Default: 'ccsm-internal' var_viscosity_infile format (binary or netCDF). Valid Values: 'bin', 'nc' Default: 'bin' File for output of internally-computed viscosity. Default: '$RUNDIR/$CASENAME.pop.hv' var_viscosity_outfile format (binary or netCDF). Valid Values: 'bin', 'nc' Default: 'nc' Which equation of state to use. Valid Values: 'jmcd', 'mwjf', 'poly', 'line' Default: 'mwjf' File containing polynomial equation of state coefficients. Default: 'internal' Option for checking for valid temperature and salinity ranges. Valid Values: 'ignore', 'check', 'enforce' Default: 'enforce' Frequency (in steps) for checking validity of temperature and salinity ranges. Default: 100000 Flag to prevent very cold water. Default: .false. Lowest level from which to integrate ice formation. Default: 1 Option for frequency of computing ice. Valid Values: 'never', 'coupled', 'nyear', 'nmonth', 'nday', 'nhour', 'nsecond', 'nstep' Default: 'coupled' Frequency with which to compute ice (units of ice_freq_opt). Default: 100000 Flag for whether POP is coupled to an active ice model. Default: Depends on $OCN_ICE_FORCING ("inactive" => .false.) CESM2 default for forming ice every timestep when coupled Default: .true. Flag to turn on averaging of pressure across three time steps. Default: .true. Flag for adding correction to Boussinesq approximation. Default: .false. Flag to turn on topographic stress. Default: .false. Number of passes the topography smoother will make. Default: 0 Flag to damp UVEL and VVEL; currently the only method for damping is from private communication with Nick Klingaman (Univ. of Reading); it is a non-linear damping. Default: .false. Type or periodicity of wind stress forcing. Valid Values: 'none', 'analytic', 'annual', 'monthly', 'monthly-calendar', 'monthly-equal', 'n-hour' LANL Default: 'analytic' CESM Default: 'none' Increment (in hours) between forcing times if ws_data_type='nhour'. LANL Default: 1e20 CESM Default: 24. How often to temporally interpolate wind stress data to current time; value in namelist is ignored and value set to 'never' if ws_data_type is 'analytic', 'none', or 'annual'. Valid Values: 'never', 'n-hour', 'every-timestep' LANL Default: 'never' CESM Default: 'every-timestep' Type of temporal interpolation for wind stress data. Valid Values: 'nearest', 'linear', '4point' LANL Default: 'nearest' CESM Default: 'linear' Increment (in hours) between interpolation times if ws_interp_freq = 'n-hour'. LANL Default: 1e20 CESM Default: 72. Name of file containing wind stress, or root of filenames if ws_data_type='n-hour' Default: 'unknown-ws' ws_filename format (binary of netCDF) Valid Values: 'bin', 'nc' Default: 'bin' Renormalization constants for the components in the wind stress forcing file. LANL Default: 20*1. CESM Default: 10., 19*1. Surface heat flux formation. Valid Values: 'restoring', 'Barnier-restoring', 'bulk-NCEP', 'partially-coupled' LANL Default: 'restoring' CESM Default: 'partially-coupled' or 'restoring' depending on configuration Type or periodicity of surface heat flux forcing. Valid Values='none', 'analytic', 'annual', 'monthly', 'monthly-equal', 'monthly-calendar', 'n-hour' LANL Default: 'analytic' CESM Default: 'monthly' if formulation is 'partially-coupled', 'none' otherwise Increment (in hours) between forcing times if shf_data_type='n-hour'. LANL Default: 1e20 CESM Default: 24. How often to temporally interpolate surface heat flux data to current time. Valid Values: 'never', 'n-hour', 'every-timestep' LANL Default: 'never' CESM Default: 'every-timestep' Type of temporal interpolation for surface heat flux data. LANL Default: 'nearest' CESM Default: 'linear' Increment (in hours) between interpolation times if shf_interp_freq = 'n-hour'. LANL Default: 1e20 CESM Default: 72. Restoring timescale (days) if shf_formulation='restoring'. LANL Default: 1e20 CESM Default: 30. Name of file containing surface heat flux data, or root of filenames if shf_data_type='n-hour'. LANL Default: 'unknown-shf' CESM Default: '$shf_filename', auto-filled by CESM scripts shf_filename format (binary or netCDF) Valid Values: 'bin', 'nc' Default: 'bin' Renormalization constants for the components in the surface heat flux forcing file. LANL Default: 20*1. CESM Default: (0.94, 19*1.) Restoring flux for weak restoring in bulk-NCEP Default: 0. Restoring flux for strong restoring in bulk-NCEP LANL Default: 92.64 CESM Default: 0.0 Flag to control use of fractional ice coverage. LANL Default: N/A, CESM only CESM Default: .true. if shf_formulation='partially-coupled', .false. otherwise Restoring flux for strong restoring over marginal seas in bulk-NCEP LANL Default: N/A, CESM only CESM Default: 92.64 Surface fresh water flux formulation. Valid Values: 'restoring', 'bulk-NCEP', 'partially-coupled' LANL Default: 'restoring' CESM Default: 'restoring' or 'partially-coupled', depending on configuration Type or periodicity of surface fresh water flux forcing. Valid Values: 'none', 'analytic', 'annual', 'monthly', 'monthly-equal', 'monthly-calendar', 'n-hour' LANL Default: 'analytic' CESM Default: 'none' or 'monthly' Increment (hours) between forcing times if sfwf_data_type='n-hour'. LANL Default: 1e20 CESM Default: 24. How often to temporally interpolate surface fresh water flux data to current time. Valid Values: 'never', 'n-hour', 'every-timestep' LANL Default: 'never' CESM Default: 'every-timestep' Type of temporal interpolation for surface fresh water flux data. Valid Values: 'nearest', 'linear', '4point' LANL Default: 'nearest' CESM Default: 'linear' Increment (hours) between interpolation times if sfwf_interp_freq='n-hour'. LANL Default: 1e20 CESM Default: 72. Restoring timescale (days) if sfwf_formulation='restoring'. LANL Default: 1e20 CESM Default: 30. Name of file containing surface fresh water flux data, or root of filenames if sfwf_data_type='n-hour'. LANL Default: 'unknown_sfwf' CESM Default: '$sfwf_filename', auto-filled by CESM scripts sfwf_filename format (binary or netCDF). Valid Values: 'bin', 'nc' Default: 'bin' Renormalization constants for components in sfwf forcing file. LANL Default: 20*1. CESM Default: 0.001, 19*1. Restoring flux for weak restoring in 'bulk-NCEP' and 'partially-coupled' formulation. LANL Default: 0.092 CESM Default: 0.0115 Restoring flux for strong restoring in 'bulk-NCEP' and 'partially-coupled' formulation. LANL Default: 0.6648 CESM Default: 0.0 Restoring flux for strong restoring over marginal seas in CESM 'bulk-NCEP' and 'partially-coupled' formulations. LANL Default: N/A, CESM only CESM Default: 0.6648 Adjust precipitation to balance water budget. LANL Default: .false. CESM Default: .true. if sfwf_formulation='partially-coupled', .false. otherwise Balance E, P, M, R, and S in marginal seas. LANL Default: N/A, CESM only CESM Default: .true. if sfwf_formulation='partially-coupled', .false. otherwise Treat fresh water flux as virtual salt flux when using varthick sfc layer. LANL Default: .false. CESM Default: .true. Flag for sending precip_fact to CESM coupler for use in fresh-water balance. LANL Default: N/A, CESM only CESM Default: .true. if sfwf_formulation='partially-coupled', .false. otherwise Value used for precip_fact when ladjust_precip=.false.. LANL Default: N/A, CESM only CESM Default: 1.0 Type or periodicity of interior potential temperature forcing. Valid Values: 'none', 'annual', 'monthly', 'monthly-equal', 'monthly-calendar', 'n-hour', 'shr_stream' Default: 'none' Increment (hours) between forcing times if pt_interior_data_type='n-hour'. LANL Default: 1e20 CESM Default: 24 How often to temporally interpolate interior potential temperature data to current time. Valid Values: 'never', 'n-hour', 'every-timestep' LANL Default: 'never' CESM Default: 'every-timestep' Type of temporal interpolation for interior potential temperature data. Valid Values: 'nearest', 'linear', '4point' LANL Default: 'nearest' CESM Default: 'linear' Increment (hours) between interpolation times if interp_freq='n-hour' LANL Default: 1e20 CESM Default: 72 Restoring timescale (days) if pt_interior_formulation='restoring'. LANL Default: 1e20 CESM Default: 365 File containing interior potential temperature data, or root of filenames if pt_interior_data_type='n--hour'. Default: 'unknown-pt_interior' pt_interior_filename format (binary or netCDF). Valid Values: 'bin', 'nc' Default: 'bin' Maximum level for interior potential temperature restoring. Default: 0 Interior potential temperature formulation. Default: 'restoring' Renormalization constants for components in interior potential temperature forcing file. Default: 20*1. Enable variable interior potential temperature restoring. Default: .false. Name of file containing variable interior potential temperature restoring data. Default: 'unknown-pt_interior_restore' pt_interior_restore_filename format (binary or netCDF). Valid Values: 'bin', 'nc' Default: 'bin' PT interior restoring includes the surface layer Default: .false. Default: 1 Default: 1 Default: 1 Default: unknown-pt_interior_shr_stream Type or periodicity of interior salinity forcing. Valid Values: 'none', 'annual' ,'monthly', 'monthly-equal', 'monthly-calendar', 'n-hour', 'shr_stream' Default: 'none' Increment (hours) between forcing times if s_interior_data_type='n-hour'. LANL Default: 1e20 CESM Default: 24 How often to temporally interpolate interior salinity data to current time. Valid Values: 'never', 'n-hour', 'every-timestep' LANL Default: 'never' CESM Default: 'every-timestep' Type of temporal interpolation for interior salinity data. Valid Values: 'nearest', 'linear', '4point' LANL Default: 'nearest' CESM Default: 'linear' Increment (hours) between interpolation times if s_interior_interp_freq='n-hour'. LANL Default: 1e20 CESM Default: 72 Restoring timescale (days) if s_interior_formulation='restoring'. LANL Default: 1e20 CESM Default: 365 Name of file containing interior salinity data, or root of filenames if s_interior_data_type='n-hour'. Default: 'unknown-s_interior' s_interior_filename format (binary or netCDF) Valid Values: 'bin', 'nc' Default: 'bin' Maximum level for interior salinity restoring. Default: 0 Interior salinity formulation. Default: 'restoring' Renormalization constants for components in interior salinity forcing file. Default: 20*1. Enable variable interior salinity restoring. Default: .false. Name of file containing variable interior salinity restoring data. Default: 'unknown-s_interior_restore' s_interior_restore_filename format (binary or netCDF). Valid Values: 'bin', 'nc' Default: 'bin' S interior restoring includes the surface layer Default: .false. Default: 1 Default: 1 Default: 1 Default: unknown-s_interior_shr_stream Type or periodicity of atmospheric forcing. Valid Values: 'none', 'analytic', 'annual', 'monthly', 'monthly-equal', 'monthly-calendar', 'n-hour' Default: 'none' Increment (in hours) between forcing times if ap_data_type='n-hour'. Default: 1.e20 How often to temporally interpolate atmospheric forcing data to current time. Valid Values: 'never','n-hour','every-timestep' Default: 'never' Type of temporal interpolation for atmospheric pressure forcing data. Valid Values: 'nearest', 'linear', '4point' Default: 'nearest' Increment (in hours) between interpolation times if ap_interp_freq = 'n-hour'. Default: 1e20 Name of file containing atmospheric pressure forcing, or root of filenames if ap_data_type='n-hour'. Default: 'unknown-ap' ap_filename format (binary or netCDF) Valid Values: 'bin', 'nc' Default: 'bin' Renormalization constants for the components in the atmospheric pressure forcing file. Default: 20*1. Units of time for coupled_freq (frequency POP is coupled to atmosphere/sea ice models via CESM flux coupler). Valid Values: 'nyear', 'nmonth', 'nday', 'nhour', 'nsecond', 'nstep', 'never' Default: 'nhour' Frequency POP is coupled to atmosphere / sea ice models via CESM flux coupler (units given by coupled_freq_opt). Default: 24 Option for distributing net shortwave heat flux over a coupling interval (all options preserve time-integrated flux). Valid Values: 'const','12hr','cosz' Default: 'cosz' Short-wave absorption type. Valid Values: 'top-layer', 'jerlov', 'chlorophyll' Default: 'chlorophyll' Chlorophyll option. Valid Values: 'file', 'model' Default: auto-filled by CESM scripts Chlorophyll input filename. Default: auto-filled by CESM scripts chl_filename format (binary or netCDF). Valid Values: 'bin', 'nc' Default: 'bin' Jerlov water type. Valid Values: 1-5 (correspond to I, IA, IB, II, and III, respectively) Default: 3 Type of the auxiliary latitudinal grid. Valid Values: 'southern', 'full', 'user-specified' Default: 'southern' Beginning latitude for the auxiliary grid (degrees north). Default: -90.0 Ending latitude for the auxiliary grid (degrees north). Default: 90.0 Auxiliary grid dimension. Default: 180 Flag for turning on output for meridional overturning circulation. Default: .true. for displaced pole grids, .false. for tripole grids. Flag for outputting northward heat transport. Default: .true. for displaced pole grids, .false. for tripole grids. Flag for outputting northward salt transport. Default: .true. for displaced pole grids, .false. for tripole grids. Names of the selected input regions when n_transport_reg = 2. Default: 'Atlantic Ocean','Mediterranean Sea','Labrador Sea','GIN Sea','Arctic Ocean','Hudson Bay' Number of regions for all transport diagnostics. Default: 2 Flag for whether POP is coupled to another system. Default: .true. Flag to run pop in the CESM context. Default: .true. Flag to run POP in bit-for-bit mode. Default: .false. Flag to run POP with code that is bit-for-bit with the ccsm4 control run. (According to source notes, this option should have been removed in ccsm4_0_1!). Default: .false. If this is true, then various internal consistency checks are enabled. Default: DEBUG from env_run.xml, but overridable by user_nl_pop Flag for using parameterized overflows. Default: .true. for displaced pole grids, .false. for tripole grids. Flag for using interactive overflows. Default: .true. for displaced pole grids, .false. for tripole grids. File with overflow information. Default: Set by CESM scripts based on ocean grid. File for writing overflow diagnostics output. Default: '$RUNDIR/$CASENAME.do' Overflow restart type. Valid Values: 'ccsm_startup', 'ccsm_continue', 'ccsm_hybrid', 'ccsm_branch' Default: 'ccsm_$RUNTYPE' Overflow restart file name. Default: '$RUNDIR/$CASENAME.ro' Flag for using near inertial wave mixing. Default: .false. Fraction of near inertial wave energy available for mixing local to the generation region. Default: 0.5 Mixing efficiency (portion producing mixing rather than thermal heating). Default: 0.2 Ratio between observed and modeled near inertial wave strength. Default: 2.0 Fraction of near inertial wave energy absorbed in the boundary layer. Default: 0.7 Vertical decay scale for turbulence (cm). Default: 500.0e02 Maximum diffusivity for near inertial waves (cm^2/s). Default: 100.0 Type (internal or external) for near inertial wave energy source. Default: 'blke' Input file for reading near inertial wave energy flux. Default: Resolution-dependent niw_energy_file_fmt (binary or netCDF). Valid Values: 'bin', 'nc' Default: 'bin' Default: 3 Default: .false. Default: .true. Default: 'nmonth' 'nday' 'once' Default: 1 1 1 Default: 'nmonth' 'nmonth' 'once' Default: 1 1 1 Default: 'nmonth1' 'nday1' 'once' Default: 'nstep' 'nstep' 'nstep' Default: 0 0 0 Default: 'nc' 'nc' 'nc' Default: 'nc' 'nc' 'nc' Default: ' ' Default: .true. Default: ' ' Default: ' ' Default: .false. .false. .false. Default: 1 1 1 Default: 1 1 1 Default: 2 2 2 Default: .false. .false. .false. Flag for activating mcog, the multiple-column ocean grid parameterization. Default: .false., unless ecosys is turned on Flag for activating debugging statements in multiple-column ocean grid parameterization. Default: .false. call abort if abs(dagg_qsw) exceeds this threshold Default: 1.0e-10 bin index for each column Default: mcog_col_to_bin(nbin) = nbin Flag used for testing when introducing answer changes that will not be controlled by other namelist flags. Outside of specific tags, this flag will not have any affect on POP. Default: .false. Flag for using ecosys module. Default: 'Set by CESM scripts based on $OCN_TRACER_MODULES' Flag for using cfc module. Default: 'Set by CESM scripts based on $OCN_TRACER_MODULES' Flag for using sf6 module. Default: 'Set by CESM scripts based on $OCN_TRACER_MODULES' Flag for using iage module. Default: 'Set by CESM scripts based on $OCN_TRACER_MODULES' Flag for using abio_dic_dic14 module. Default: 'Set by CESM scripts based on $OCN_TRACER_MODULES' Flag for using IRF module. Default: 'Set by CESM scripts based on $OCN_TRACER_MODULES' Option for initialization of iage. Valid Values: 'ccsm_startup', 'zero', 'ccsm_startup_spunup', 'restart', 'ccsm_continue', 'ccsm_branch', 'ccsm_hybrid', 'file' Default: 'ccsm_$RUNTYPE' Filename for initializing iage (if init_iage_option='file'). Default: 'same_as_TS' Default: Default: Default: Default: Default: Default: init_iage_init_file format (binary or netCDF). Valid Values: 'bin', 'nc' Default: 'bin' Option for initialization of cfc. Valid Values: 'ccsm_startup', 'zero', 'ccsm_startup_spunup', 'restart', 'ccsm_continue', 'ccsm_branch', 'ccsm_hybrid', 'file' Default: ccsm_$runtype Filename for initializing cfc (if init_cfc_option='file'). Default: 'same_as_TS' init_cfc_init_file format (binary or netCDF). Valid Values: 'bin', 'nc' Default: 'bin' Default: Default: Default: Default: Default: Default: File name for ascii time series of atm cfc11. Default: '$DIN_LOC_ROOT/ocn/pop/res_indpt/forcing/cfc_atm_20170512.nc' first year of non-zero values in pcfc_file If the effective cfc calendar year is less than this, and cfc tracers are being read from a restart file, then a fallback of const=0 for I/O reading is registered. Default: 1936 Arbitrary model year. Default: 1850 for OCN_TRANSIENT=1850-2000, 372 for OCN_TRANSIENT=CORE2,CORE2OMIP, 366 for OCN_TRANSIENT=JRA,JRA_OMIP, 1 otherwise. Year in data that corresponds to model_year. Default: 1850 for OCN_TRANSIENT=1850-2000, 2009 for OCN_TRANSIENT=CORE2,CORE2OMIP, 2018 for OCN_TRANSIENT=JRA,JRA_OMIP, 1 otherwise. Flux formulation. Valid Values: 'ocmip', 'model' Default: 'model' Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Option for initialization of sf6. Valid Values: 'ccsm_startup', 'zero', 'ccsm_startup_spunup', 'restart', 'ccsm_continue', 'ccsm_branch', 'ccsm_hybrid', 'file' Default: ccsm_$runtype Filename for initializing sf6 (if init_sf6_option='file'). Default: 'same_as_TS' init_sf6_init_file format (binary or netCDF). Valid Values: 'bin', 'nc' Default: 'bin' Default: Default: Default: Default: Default: Default: File name for ascii time series of atm sf6. Default: '$DIN_LOC_ROOT/ocn/pop/res_indpt/forcing/sf6_atm_20160311.nc' first year of non-zero values in psf6_file If the effective sf6 calendar year is less than this, and the sf6 tracer is being read from a restart file, then a fallback of const=0 for I/O reading is registered. Default: 1953 Arbitrary model year. Default: 1850 for OCN_TRANSIENT=1850-2000, 372 for OCN_TRANSIENT=CORE2,CORE2OMIP, 366 for OCN_TRANSIENT=JRA,JRA_OMIP, 1 otherwise. Year in data that corresponds to model_year. Default: 1850 for OCN_TRANSIENT=1850-2000, 2009 for OCN_TRANSIENT=CORE2,CORE2OMIP, 2018 for OCN_TRANSIENT=JRA,JRA_OMIP, 1 otherwise. Flux formulation. Valid Values: 'ocmip', 'model' Default: 'model' Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: Default: b.e21.B1850.f09_g17.CMIP6-piControl.001.pop.r.abio_dic_dic14.0391-01-01-00000.nc (gx1v7), none (otherwise) Default: Default: Default: Default: Default: Default: Default: Default: 'never' Default: '1' Default: Default: Source of atmos CO2 and D14C. Valid Values: 'file', 'const', 'drv_diag' Default: 'const' Source of atmos D14C. Valid Values: 'file', 'const', 'lat_bands' Default: 'lat_bands' Default: Default: Default: CCSM_CO2_PPMV value in env_run.xml Arbitrary model year. Default: 1 Year in data that corresponds to abio_atm_model_year. Default: 1 When turned on, ocn.ecosys.tavg.csh will accumulate ALL ecosys diagnostics When turned on, ocn.ecosys.tavg.csh will output alt_co2 related fields Default: 'driver' Default: dst79gnx_gx3v7_20100305.nc or dst79gnx_gx1v6_090416.nc Default: 'nc' Default: 'DSTSF' Default: 1.0e-1 Default: none provided Default: 'driver-derived' coarse/fine dust ratio threshold, used in iron_flux_source=='driver-derived' computation Default: 55.0 used in iron_flux_source=='driver-derived' computation Default: 0.01 used in iron_flux_source=='driver-derived' computation Default: 170.0 Default: solFe_scenario4_current_gx3v7_6gmol_cesm1_93_20161122.nc or solFe_scenario4_current_gx1v6_8gmol_cesm1_93_20161114.nc Default: 'nc' Default: 'DSTSF' Default: 1.79e6 Default: none provided Default: fesedflux_gx3v7_cesm1_97_2017.nc or fesedfluxTot_gx1v6_cesm2_2018_c180618.nc Default: 'FESEDFLUXIN' Default: 'nc' Default: 1.1574e-6 Default: none provided Default: feventflux_gx3v7_5gmol_cesm1_97_2017.nc or feventflux_gx1v6_5gmol_cesm1_97_2017.nc Default: 'FESEDFLUXIN' Default: 'nc' Default: 1.1574e-6 Default: none provided option for specification of o2_consumption_scalef Valid Values: 'const', 'file_time_invariant' Default: 'const' 'file_time_invariant' (gx1v6,gx1v7) for OCN_COUPLING='full' constant for o2_consumption_scalef_opt=const Default: 1.0 Default: o2_consumption_scalef_0.30_POP_gx1v6_20180623.nc (gx1v6,gx1v7) Default: 'o2_consumption_scalef' Default: 'nc' Default: 1.0 Default: none provided option for specification of p_remin_scalef Valid Values: 'const', 'file_time_invariant' Default: 'const' constant for p_remin_scalef_opt=const Default: 1.0 Default: none provided Default: 'p_remin_scalef' Default: 'nc' Default: 1.0 Default: none provided Default: 'monthly-calendar' or 'shr_stream' If .false., abort if the coupler passes NHx or NOy and ndep_data_type is not 'driver' Default: .false. Default: ndep_ocn_1850_w_nhx_emis_gx3v7_c180803.nc or ndep_ocn_1850_w_nhx_emis_gx1v6_c180803.nc Default: 'nc' Default: 'NOy_deposition' Default: 7.1429e6 Default: none provided Default: ndep_ocn_1850_w_nhx_emis_gx3v7_c180803.nc or ndep_ocn_1850_w_nhx_emis_gx1v6_c180803.nc Default: 'nc' Default: 'NHx_deposition' Default: 7.1429e6 Default: none provided Default: 1849 for OCN_TRANSIENT=1850-2000, 2004 for rcp runs, 2014 for ssp runs, 1637 for OCN_TRANSIENT=CORE2OMIP, 1652 for OCN_TRANSIENT=JRA_OMIP Default: 2006 for OCN_TRANSIENT=1850-2000, 2101 for rcp and ssp runs, 2010 for OCN_TRANSIENT=CORE2OMIP, 2019 for OCN_TRANSIENT=JRA_OMIP Default: 1849 for OCN_TRANSIENT=1850-2000, 2004 for rcp runs, 2014 for ssp runs, 0 for OCN_TRANSIENT=CORE2OMIP,JRA_OMIP Default: depends on grid and OCN_TRANSIENT Default: 7.1429e6 Default: riv_nut.gnews_gnm.gx3v7_nnsm_e1000r500.20170425.nc (gx3v7), riv_nut.gnews_gnm.gx1v7_nnsm_e1000r300.20170425.nc (gx1v6,gx1v7) riv_nut.gnews_gnm.gx3v7_nn_open_ocean_nnsm_e1000r500_marginal_sea.20170425.nc (gx3v7,estuary_type='vsf_ebm'), riv_nut.gnews_gnm.gx1v7_nn_open_ocean_nnsm_e1000r300_marginal_sea.20170425.nc (gx1v6,gx1v7,estuary_type='vsf_ebm') riv_nut.gnews_gnm.rx1_to_gx1v7_nn_open_ocean_nnsm_e1000r300_marginal_sea_170413.20190602.nc (gx1v6,gx1v7,estuary_type='vsf_ebm',rof_grid='rx1') riv_nut.gnews_gnm.JRA025m_to_gx1v7_nn_open_ocean_nnsm_e1000r300_marginal_sea_190214.20190602.nc (gx1v6,gx1v7,estuary_type='vsf_ebm',rof_grid='JRA025') Default: 1900 Default: 1900 for OCN_TRANSIENT=unset,CORE2,JRA, 2000 otherwise Default: 263 for OCN_TRANSIENT=CORE2_OMIP, 248 for OCN_TRANSIENT=JRA_OMIP, 1900 otherwise Default: 'din_riv_flux' Default: 1.0 Default: 'dip_riv_flux' Default: 1.0 Default: 'don_riv_flux' Default: 1.0 Default: 'dop_riv_flux' Default: 1.0 Default: 'dsi_riv_flux' Default: 1.0 Default: 'dfe_riv_flux' Default: 1.0 Default: 'dic_riv_flux' Default: 1.0 Default: 'alk_riv_flux' Default: 1.0 Default: 'doc_riv_flux' Default: 1.0 Default: 'drv' Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: depends on OCN_CO2_TYPE in env_run.xml Default: CCSM_CO2_PPMV value in env_run.xml Default: CCSM_CO2_PPMV value in env_run.xml Default: 'const' Default: CCSM_CO2_PPMV value in env_run.xml Default: none provided Default: none provided Default: none provided Default: Default: Default: Default: Default: Default: Default: Arbitrary model year. Default: 1 Year in atm data that corresponds to ciso_atm_model_year. Default: 1 Default: 'PO4','NO3','SiO3','O2','ALK' Default: none provided, constructed by build-namelist Default: ecosys_restore_POP_gx3v7_20170113.nc (gx3v7), ecosys_restore_POP_gx1v6_20170113.nc (gx1v6,gx1v7) Default: 'PO4','NO3','SiO3','O2','ALK' Default: 'file_time_invariant' for gx3v7, gx1v6, gx1v7 grids, 'const' otherwise Default: 0.0 Default: ecosys_restore_inv_tau_POP_gx3v7_20170125.nc (gx3v7), ecosys_restore_inv_tau_POP_gx1v6_20170125.nc (gx1v6,gx1v7) Default: 'RESTORE_INV_TAU_MARGINAL_SEA_ONLY' Default: 'nc' Default: 1.0 Default: none provided Default: 1944.0 Default: 2225.0 Default: 1944.0 Default: 1944.0 fraction, by weight, of iron in fine dust from atm Default: 0.035 fraction, by weight, of iron in coarse dust from atm Default: 0.035 fraction, by weight, of iron in dust from seaice Default: 0.035 fraction, by weight, of iron in black carbon from atm Default: 0.06 fraction, by weight, of iron in black carbon from seaice Default: 0.06 Default: 'ccsm_RUNTYPE' Default: ecosys_jan_IC_gx3v7_20180308.nc or ecosys_jan_IC_gx1v6_20180308.nc (none provided for tripole grids) Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: none provided Default: 'nc' Default: Default: Default: Default: Default: Default: Default: 'nc' Default: .true. Default: 'base model' Default: Default: 'marbl_in' for single instance, 'marbl_in_####' for multi-instance. Default: one of the following, depending on ocean grid and NK_MODE IRF_NK_precond_tracers_gx3v7_20150313.nc IRF_NK_precond_tracers_gx1v6_20150313.nc IRF_offline_transport_tracers_gx3v7_20150313.nc IRF_offline_transport_tracers_gx1v6_20150313.nc Default: 1 Default: none Default: none Default: none Default: auto-filled by CESM scripts Default: none Default: none Default: none Default: none Default: none Default: none Ratio of lower-layer depth to H at estuary mouth. Default: none Thickness (m) of upper layer of exchange flow. Default: none Thickness (m) of lower layer of exchange flow. Default: none CESM2.1.3_sourcemods/PaxHeaders.32795/forcing_coupled.F90-ORIG0000644000000000000000000000012413774500023020362 xustar0027 mtime=1609728019.270141 27 atime=1609728019.262077 30 ctime=1609728019.269660479 CESM2.1.3_sourcemods/forcing_coupled.F90-ORIG0000644006307300017500000015150713774500023020752 0ustar00islasncar00000000000000!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| module forcing_coupled !BOP !MODULE: forcing_coupled ! !DESCRIPTION: ! This module contains all the routines necessary for coupling POP to ! atmosphere and sea ice models using the NCAR CCSM flux coupler. To ! enable the routines in this module, the coupled ifdef option must ! be specified during the make process. ! ! !REVISION HISTORY: ! SVN:$Id$ ! ! !USES: use POP_KindsMod use POP_ErrorMod use POP_CommMod use POP_FieldMod use POP_GridHorzMod use POP_HaloMod use kinds_mod use blocks, only: nx_block, ny_block, block, get_block use domain_size use domain use io_types, only: stdout, nml_in use communicate use global_reductions use constants use io use time_management use grid use prognostic use exit_mod use ice, only: tfreez, tmelt, liceform,QFLUX, QICE, AQICE, tlast_ice use forcing_shf use forcing_sfwf use forcing_ws, only: ws_data_type use forcing_fields use timers !*** ccsm use ms_balance use tavg use registry use named_field_mod, only: named_field_register, named_field_get_index, & named_field_set, named_field_get use forcing_fields use estuary_vsf_mod, only: lestuary_on, lvsf_river, lebm_on use estuary_vsf_mod, only: MASK_ESTUARY, vsf_river_correction use estuary_vsf_mod, only: set_estuary_vsf_forcing, set_estuary_exch_circ use mcog, only: tavg_mcog use mcog, only: FRAC_BIN, QSW_RAW_BIN implicit none save !EOP !BOC !----------------------------------------------------------------------- ! ! module variables ! !----------------------------------------------------------------------- integer (int_kind) :: & coupled_freq_iopt, &! coupler frequency option coupled_freq, &! frequency of coupling ncouple_per_day ! num of coupler comms per day #if CCSMCOUPLED !----------------------------------------------------------------------- ! ! ids for tavg diagnostics computed from forcing_coupled ! !----------------------------------------------------------------------- integer (int_kind) :: & tavg_EVAP_F, &! tavg id for evaporation flux tavg_PREC_F, &! tavg id for precipitation flux (rain + snow) tavg_SNOW_F, &! tavg id for snow flux tavg_MELT_F, &! tavg id for melt flux tavg_ROFF_F, &! tavg id for river runoff flux tavg_IOFF_F, &! tavg id for ice runoff flux due to land-model snow capping tavg_SALT_F, &! tavg id for salt flux tavg_SENH_F, &! tavg id for sensible heat flux tavg_LWUP_F, &! tavg id for longwave heat flux up tavg_LWDN_F, &! tavg id for longwave heat flux dn tavg_MELTH_F, &! tavg id for melt heat flux tavg_IFRAC ! tavg id for ice fraction #endif !----------------------------------------------------------------------- ! ! Options for distributing net shortwave heat flux over a coupling ! interval. All options preserve time-integrated flux. ! !----------------------------------------------------------------------- integer (int_kind), parameter :: & qsw_distrb_iopt_const = 1, &! qsw constant over a coupling interval qsw_distrb_iopt_12hr = 2, &! qsw smoothly spread over 12 hour window ! only works for daily coupling qsw_distrb_iopt_cosz = 3 ! qsw proportional to cos of solar zenith angle integer (int_kind) :: qsw_distrb_iopt real (r8), dimension(:), allocatable :: & qsw_12hr_factor !----------------------------------------------------------------------- ! variables for qsw cosz option !----------------------------------------------------------------------- integer (int_kind) :: timer_compute_cosz real (r8) :: & tday00_interval_beg, & ! model time at beginning of coupling interval orb_eccen, & ! Earth eccentricity orb_obliqr, & ! Earth Obliquity orb_lambm0, & ! longitude of perihelion at v-equinox orb_mvelpp ! Earths Moving vernal equinox of orbit +pi real (r8), dimension(:,:,:), allocatable :: & QSW_COSZ_WGHT, & ! weights QSW_COSZ_WGHT_NORM ! normalization for QSW_COSZ_WGHT integer (int_kind), private :: & cpl_ts ! flag id for coupled_ts flag !EOC !*********************************************************************** contains !*********************************************************************** !BOP ! !IROUTINE: pop_init_coupled ! !INTERFACE: subroutine pop_init_coupled ! !DESCRIPTION: ! This routine sets up everything necessary for coupling with CCSM4. ! ! !REVISION HISTORY: ! same as module !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- character (char_len) :: & coupled_freq_opt, qsw_distrb_opt namelist /coupled_nml/ coupled_freq_opt, coupled_freq, qsw_distrb_opt integer (int_kind) :: & k, iblock, nsend, & nml_error ! namelist i/o error flag type (block) :: & this_block ! block information for current block !----------------------------------------------------------------------- ! ! variables associated with qsw 12hr ! !----------------------------------------------------------------------- real (r8) :: & time_for_forcing, &! time of day for surface forcing frac_day_forcing, &! fraction of day based on time_for_forcing cycle_function, &! intermediate result weight_forcing, &! forcing weights sum_forcing ! sum of forcing weights integer (int_kind) :: & count_forcing ! time step counter (== nsteps_this_interval+1) integer (int_kind) :: & i,j,n !----------------------------------------------------------------------- ! ! read coupled_nml namelist to start coupling and determine ! coupling frequency ! !----------------------------------------------------------------------- coupled_freq_opt = 'never' coupled_freq_iopt = freq_opt_never coupled_freq = 100000 qsw_distrb_opt = 'const' if (my_task == master_task) then open (nml_in, file=nml_filename, status='old',iostat=nml_error) if (nml_error /= 0) then nml_error = -1 else nml_error = 1 endif do while (nml_error > 0) read(nml_in, nml=coupled_nml,iostat=nml_error) end do if (nml_error == 0) close(nml_in) endif call broadcast_scalar(nml_error, master_task) if (nml_error /= 0) then call exit_POP(sigAbort,'ERROR reading coupled_nml') endif if (my_task == master_task) then write(stdout,blank_fmt) write(stdout,ndelim_fmt) write(stdout,blank_fmt) write(stdout,*) ' Coupling:' write(stdout,blank_fmt) write(stdout,*) ' coupled_nml namelist settings:' write(stdout,blank_fmt) write(stdout, coupled_nml) write(stdout,blank_fmt) endif if (my_task == master_task) then select case (coupled_freq_opt) case ('nyear') coupled_freq_iopt = -1000 case ('nmonth') coupled_freq_iopt = -1000 case ('nday') if (coupled_freq == 1) then coupled_freq_iopt = freq_opt_nday ncouple_per_day = 1 else coupled_freq_iopt = -1000 endif case ('nhour') if (coupled_freq <= 24) then coupled_freq_iopt = freq_opt_nhour ncouple_per_day = 24/coupled_freq else coupled_freq_iopt = -1000 endif case ('nsecond') if (coupled_freq <= seconds_in_day) then coupled_freq_iopt = freq_opt_nsecond ncouple_per_day = seconds_in_day/coupled_freq else coupled_freq_iopt = -1000 endif case ('nstep') if (coupled_freq <= nsteps_per_day) then coupled_freq_iopt = freq_opt_nstep ncouple_per_day = nsteps_per_day/coupled_freq else coupled_freq_iopt = -1000 endif case ('never') coupled_freq_iopt = -9999 case default coupled_freq_iopt = -2000 end select select case (qsw_distrb_opt) case ('const') qsw_distrb_iopt = qsw_distrb_iopt_const case ('12hr') qsw_distrb_iopt = qsw_distrb_iopt_12hr case ('cosz') qsw_distrb_iopt = qsw_distrb_iopt_cosz call register_string('qsw_distrb_iopt_cosz') case default qsw_distrb_iopt = -1000 end select endif call broadcast_scalar(coupled_freq_iopt, master_task) call broadcast_scalar(coupled_freq , master_task) call broadcast_scalar(qsw_distrb_iopt , master_task) call broadcast_scalar(ncouple_per_day , master_task) if (coupled_freq_iopt == -1000) then call exit_POP(sigAbort, & 'ERROR: Coupling frequency must be at least once per day') else if (coupled_freq_iopt == -2000) then call exit_POP(sigAbort, & 'ERROR: Unknown option for coupling frequency') endif if (registry_match('lcoupled') .eqv. (coupled_freq_iopt == -9999) ) then call exit_POP(sigAbort, & 'ERROR: inconsistency between lcoupled and coupled_freq_iopt settings') endif if (qsw_distrb_iopt == -1000) then call exit_POP(sigAbort, & 'ERROR: Unknown option for qsw_distrb_opt') endif !----------------------------------------------------------------------- ! ! check consistency of the qsw_distrb_iopt option with various ! time manager options ! !----------------------------------------------------------------------- if ( (qsw_distrb_iopt == qsw_distrb_iopt_12hr) .or. & (qsw_distrb_iopt == qsw_distrb_iopt_cosz) ) then if ( tmix_iopt == tmix_avgfit .or. tmix_iopt == tmix_robert) then ! ok; these options are supported else call exit_POP(sigAbort, & 'ERROR: time_mix_opt must be set to avgfit for qsw_distrb_opt '/& &/ 'of 12hr or cosz') endif if ( dttxcel(1) /= c1 .or. dtuxcel /= c1 ) & call exit_POP(sigAbort, & 'ERROR: using the specified accelerated integration '/& &/ 'technique may not be appropriate for qsw_distrb_opt '/& &/ 'of 12hr or cosz') endif !----------------------------------------------------------------------- ! ! allocate and compute the short wave heat flux multiplier for qsw 12hr ! !----------------------------------------------------------------------- allocate ( qsw_12hr_factor(nsteps_per_interval)) qsw_12hr_factor = c1 if ( qsw_distrb_iopt == qsw_distrb_iopt_12hr ) then ! mimic a day time_for_forcing = c0 count_forcing = 1 sum_forcing = c0 do n=1,nsteps_per_interval frac_day_forcing = time_for_forcing / seconds_in_day cycle_function = cos( pi * ( c2 * frac_day_forcing - c1 ) ) qsw_12hr_factor(n) = c2 * ( cycle_function & + abs(cycle_function) ) & * cycle_function weight_forcing = c1 if ( count_forcing == 2 .or. & mod(count_forcing,time_mix_freq) == 0 ) & weight_forcing = p5 time_for_forcing = time_for_forcing + weight_forcing * dt(1) sum_forcing = sum_forcing & + weight_forcing * dt(1) * qsw_12hr_factor(n) count_forcing = count_forcing + 1 enddo qsw_12hr_factor = qsw_12hr_factor * seconds_in_day & / sum_forcing ! check the final integral count_forcing = 1 sum_forcing = c0 do n=1,nsteps_per_interval weight_forcing = c1 if ( count_forcing == 2 .or. & mod(count_forcing,time_mix_freq) == 0 ) & weight_forcing = p5 sum_forcing = sum_forcing & + weight_forcing * dt(1) * qsw_12hr_factor(n) count_forcing = count_forcing + 1 enddo if ( sum_forcing < (seconds_in_day - 1.0e-5_r8) .or. & sum_forcing > (seconds_in_day + 1.0e-5_r8) ) & call exit_POP (sigAbort, & 'ERROR: qsw 12hr temporal integral is incorrect') endif !----------------------------------------------------------------------- ! ! allocate space for qsw cosz fields ! !----------------------------------------------------------------------- if ( qsw_distrb_iopt == qsw_distrb_iopt_cosz ) then allocate( & QSW_COSZ_WGHT(nx_block,ny_block,nblocks_clinic), & QSW_COSZ_WGHT_NORM(nx_block,ny_block,nblocks_clinic)) endif #if CCSMCOUPLED !----------------------------------------------------------------------- ! ! define tavg fields computed from forcing_coupled routines ! !----------------------------------------------------------------------- call define_tavg_field(tavg_EVAP_F,'EVAP_F',2, & long_name='Evaporation Flux from Coupler', & units='kg/m^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_PREC_F,'PREC_F',2, & long_name='Precipitation Flux from Cpl (rain+snow)', & units='kg/m^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_SNOW_F,'SNOW_F',2, & long_name='Snow Flux from Coupler', & units='kg/m^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_MELT_F,'MELT_F',2, & long_name='Melt Flux from Coupler', & units='kg/m^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_ROFF_F,'ROFF_F',2, & long_name='Runoff Flux from Coupler', & units='kg/m^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_IOFF_F,'IOFF_F',2, & long_name='Ice Runoff Flux from Coupler due to Land-Model Snow Capping', & units='kg/m^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_SALT_F,'SALT_F',2, & long_name='Salt Flux from Coupler (kg of salt/m^2/s)',& units='kg/m^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_SENH_F,'SENH_F',2, & long_name='Sensible Heat Flux from Coupler', & units='watt/m^2', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_LWUP_F,'LWUP_F',2, & long_name='Longwave Heat Flux (up) from Coupler', & units='watt/m^2', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_LWDN_F,'LWDN_F',2, & long_name='Longwave Heat Flux (dn) from Coupler', & units='watt/m^2', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_MELTH_F,'MELTH_F',2, & long_name='Melt Heat Flux from Coupler', & units='watt/m^2', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_IFRAC,'IFRAC',2, & long_name='Ice Fraction from Coupler', & units='fraction', grid_loc='2110', & coordinates='TLONG TLAT time') !----------------------------------------------------------------------- ! ! Initialize flags and shortwave absorption profile ! Note that the cpl_write_xxx flags have _no_ default value; ! therefore, they must be explicitly set .true. and .false. ! at the appropriate times ! !----------------------------------------------------------------------- call init_time_flag('coupled_ts', cpl_ts, & owner='pop_init_coupled', & freq_opt = coupled_freq_iopt, & freq = coupled_freq) !----------------------------------------------------------------------- ! ! If this is a restart, then read_restart knows the last timestep was ! a coupled timestep and has registered the string 'coupled_ts_last_true' ! (read_restart was called prior to the initialization of coupled_ts) ! !----------------------------------------------------------------------- if (registry_match('coupled_ts_last_true') ) & call override_time_flag (cpl_ts, old_value=.true.) lsmft_avail = .true. !----------------------------------------------------------------------- ! ! initialize timer for computing cosz ! !----------------------------------------------------------------------- if ( qsw_distrb_iopt == qsw_distrb_iopt_cosz ) then call get_timer (timer_compute_cosz, 'COMPUTE_COSZ', nblocks_clinic, & distrb_clinic%nprocs) endif !----------------------------------------------------------------------- ! ! register this subroutine ! !----------------------------------------------------------------------- call register_string('pop_init_coupled') #endif !----------------------------------------------------------------------- !EOC call flushm (stdout) end subroutine pop_init_coupled !*********************************************************************** !BOP ! !IROUTINE: pop_init_partially_coupled ! !INTERFACE: subroutine pop_init_partially_coupled ! !DESCRIPTION: ! This routine initializes and allocates arrays for the partially-coupled ! option ! ! !REVISION HISTORY: ! same as module !EOP !BOC #if CCSMCOUPLED !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- logical (log_kind) :: & lcoupled character (char_len) :: & message integer (int_kind) :: & number_of_fatal_errors lcoupled = registry_match('lcoupled') if ( lcoupled .and. shf_formulation /= 'partially-coupled' ) then shf_num_comps = 1 shf_comp_qsw = 1 allocate(SHF_COMP(nx_block,ny_block,max_blocks_clinic,shf_num_comps)) SHF_COMP = c0 endif !----------------------------------------------------------------------- ! ! initialize and allocate some partially coupled variables ! !----------------------------------------------------------------------- if ( lcoupled & .and. sfwf_formulation /= 'partially-coupled' & .and. sfc_layer_type == sfc_layer_varthick .and. & .not. lfw_as_salt_flx .and. liceform ) then sfwf_num_comps = 1 sfwf_comp_cpl = 1 tfw_num_comps = 1 tfw_comp_cpl = 1 allocate(SFWF_COMP(nx_block,ny_block, max_blocks_clinic,sfwf_num_comps)) allocate( TFW_COMP(nx_block,ny_block,nt,max_blocks_clinic, tfw_num_comps)) SFWF_COMP = c0 TFW_COMP = c0 endif !----------------------------------------------------------------------- ! ! check compatibility of partially-coupled option with other options ! !----------------------------------------------------------------------- number_of_fatal_errors = 0 if (.not. lcoupled .and. (shf_formulation == 'partially-coupled' .or. & sfwf_formulation == 'partially-coupled' ) ) then message = & 'ERROR: partially-coupled option is allowed only when coupled' write(stdout,*) message number_of_fatal_errors = number_of_fatal_errors + 1 endif if (lcoupled .and. (shf_formulation == 'partially-coupled' .and. & sfwf_formulation /= 'partially-coupled') .or. & (shf_formulation /= 'partially-coupled' .and. & sfwf_formulation == 'partially-coupled') ) then message = & 'partially-coupled must be used for both shf and sfwf' write(stdout,*) message number_of_fatal_errors = number_of_fatal_errors + 1 endif if (lcoupled .and. shf_formulation /= 'partially-coupled' .and. & shf_data_type /= 'none') then message = & 'shf_data_type must be set to none or '/& &/ 'shf_formulation must be partially_coupled when lcoupled is true' write(stdout,*) message number_of_fatal_errors = number_of_fatal_errors + 1 endif if (lcoupled .and. sfwf_formulation /= 'partially-coupled' .and. & sfwf_data_type /= 'none') then message = & 'sfwf_data_type must be set to none or '/& &/ 'sfwf_formulation must be partially_coupled when lcoupled is true' write(stdout,*) message number_of_fatal_errors = number_of_fatal_errors + 1 endif !----------------------------------------------------------------------- ! ! check coupled compatibility with other forcing options ! !----------------------------------------------------------------------- if (lcoupled .and. ws_data_type /= 'none') then message = & 'ws_data_type must be set to none in coupled mode' write(stdout,*) message number_of_fatal_errors = number_of_fatal_errors + 1 endif if (number_of_fatal_errors /= 0) & call exit_POP(sigAbort,'subroutine pop_init_partially_coupled') #endif !----------------------------------------------------------------------- !EOC call flushm (stdout) end subroutine pop_init_partially_coupled !*********************************************************************** !BOP ! !IROUTINE: pop_set_coupled_forcing ! !INTERFACE: subroutine pop_set_coupled_forcing ! !DESCRIPTION: ! This routine is called immediately following the receipt of fluxes ! from the coupler. It combines fluxes received from the coupler into ! the STF array and converts from W/m**2 into model units. It also ! balances salt/freshwater in marginal seas and sets SHF_QSW_RAW ! and SHF_COMP. Compute QSW_COSZ_WGHT_NORM if needed. ! ! !REVISION HISTORY: ! same as module !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- #if CCSMCOUPLED integer (int_kind) :: n, nn, iblock real (r8) :: cosz_day ! time where cosz is computed real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: & WORK1, WORK2 ! local work space !----------------------------------------------------------------------- ! ! combine heat flux components into STF array and convert from W/m**2 ! (note: latent heat flux = evaporation*latent_heat_vapor_mks) ! (note: snow melt heat flux = - snow_f*latent_heat_fusion_mks) ! !----------------------------------------------------------------------- !*** need to zero out any padded cells WORK1 = c0 WORK2 = c0 !$OMP PARALLEL DO PRIVATE(iblock) do iblock = 1, nblocks_clinic STF(:,:,1,iblock) = (EVAP_F(:,:,iblock)*latent_heat_vapor_mks & + SENH_F(:,:,iblock) + LWUP_F(:,:,iblock) & + LWDN_F(:,:,iblock) + MELTH_F(:,:,iblock) & -(SNOW_F(:,:,iblock)+IOFF_F(:,:,iblock)) * latent_heat_fusion_mks)* & RCALCT(:,:,iblock)*hflux_factor enddo !$OMP END PARALLEL DO !----------------------------------------------------------------------- ! ! combine freshwater flux components ! ! for variable thickness surface layer, compute fresh water and ! salt fluxes ! !----------------------------------------------------------------------- if (sfc_layer_type == sfc_layer_varthick .and. & .not. lfw_as_salt_flx) then !*** compute fresh water flux (cm/s) !$OMP PARALLEL DO PRIVATE(iblock,n) do iblock = 1, nblocks_clinic FW(:,:,iblock) = RCALCT(:,:,iblock) * & ( PREC_F(:,:,iblock)+EVAP_F(:,:,iblock) & +ROFF_F(:,:,iblock)+IOFF_F(:,:,iblock))*fwmass_to_fwflux WORK1(:,:,iblock) = RCALCT(:,:,iblock) * & MELT_F(:,:,iblock) * fwmass_to_fwflux !*** compute tracer concentration in fresh water !*** in principle, temperature of each water flux !*** could be different. e.g. !TFW(:,:,1,iblock) = RCALCT(:,:,iblock)*fwmass_to_fwflux & ! (PREC_F(:,:,iblock)*TEMP_PREC(:,:,iblock) + & ! EVAP_F(:,:,iblock)*TEMP_EVAP(:,:,iblock) + & ! MELT_F(:,:,iblock)*TEMP_MELT(:,:,iblock) + & ! ROFF_F(:,:,iblock)*TEMP_ROFF(:,:,iblock)) !*** currently assume water comes in at sea surface temp call tmelt(WORK2(:,:,iblock),TRACER(:,:,1,2,curtime,iblock)) TFW(:,:,1,iblock) = FW(:,:,iblock)*TRACER(:,:,1,1,curtime,iblock) & + WORK1(:,:,iblock) * WORK2(:,:,iblock) FW(:,:,iblock) = FW(:,:,iblock) + WORK1(:,:,iblock) !*** compute salt flux !*** again, salinity could be different for each !*** component of water flux !TFW(:,:,2,iblock) = RCALCT(:,:,iblock)*fwmass_to_fwflux & ! (PREC_F(:,:,iblock)*SALT_PREC(:,:,iblock) + & ! EVAP_F(:,:,iblock)*SALT_EVAP(:,:,iblock) + & ! MELT_F(:,:,iblock)*SALT_MELT(:,:,iblock) + & ! ROFF_F(:,:,iblock)*SALT_ROFF(:,:,iblock)) !*** currently assume prec, evap and roff are fresh !*** and all salt come from ice melt where (MELT_F(:,:,iblock) /= c0) WORK1(:,:,iblock) = & SALT_F(:,:,iblock)/MELT_F(:,:,iblock) ! salinity (msu) of melt water elsewhere WORK1(:,:,iblock) = c0 end where TFW(:,:,2,iblock) = RCALCT(:,:,iblock)*MELT_F(:,:,iblock)* & fwmass_to_fwflux*WORK1(:,:,iblock) ! + PREC_F(:,:,iblock)*c0 + EVAP_F(:,:,iblock)*c0 + ROFF_F(:,:,iblock)*c0 + IOFF_F(:,:,iblock)*c0 do n=3,nt TFW(:,:,n,iblock) = c0 ! no additional tracers in fresh water end do enddo !$OMP END PARALLEL DO else ! convert fresh water to virtual salinity flux !----------------------------------------------------------------------- ! ! if not a variable thickness surface layer or if fw_as_salt_flx ! flag is on, convert fresh and salt inputs to a virtual salinity flux ! ! Add ROFF_F to STF(:,:,2) where the ebm is not handling it ! !----------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblock) do iblock = 1, nblocks_clinic STF(:,:,2,iblock) = RCALCT(:,:,iblock)*( & (PREC_F(:,:,iblock)+EVAP_F(:,:,iblock)+ & MELT_F(:,:,iblock)+(c1-MASK_ESTUARY(:,:,iblock))*ROFF_F(:,:,iblock)+& IOFF_F(:,:,iblock))*salinity_factor & + SALT_F(:,:,iblock)*sflux_factor) enddo !$OMP END PARALLEL DO if ( lestuary_on ) then ! Treat river runoff as the interior source if (lvsf_river) call set_estuary_vsf_forcing ! Include estuary exchange flow as vertical salt flux if (lebm_on) call set_estuary_exch_circ if (lvsf_river) THEN ! Add global correction for salt conservation, correcting for using local ! tracer concentration in application of ROFF_F. Analogous term for passive ! tracers is applied in passive_tracers.F90:set_sflux_passive_tracers, ! after STF has been computed. Correction is applied where MASK_ESTUARY=1. !$OMP PARALLEL DO PRIVATE(iblock) do iblock = 1, nblocks_clinic STF(:,:,2,iblock) = STF(:,:,2,iblock) + MASK_ESTUARY(:,:,iblock)*vsf_river_correction(2) enddo !$OMP END PARALLEL DO endif endif !----------------------------------------------------------------------- ! ! balance salt/freshwater in marginal seas ! !----------------------------------------------------------------------- if (lms_balance .and. sfwf_formulation /= 'partially-coupled' ) then call ms_balancing (STF(:,:,2,:),EVAP_F, PREC_F, MELT_F,ROFF_F,IOFF_F, & SALT_F, QFLUX, 'salt') endif endif !$OMP PARALLEL DO PRIVATE(iblock,n) do iblock = 1, nblocks_clinic SHF_QSW_RAW(:,:,iblock) = SHF_QSW(:,:,iblock) if ( shf_formulation == 'partially-coupled' ) then SHF_COMP(:,:,iblock,shf_comp_cpl) = STF(:,:,1,iblock) if ( .not. lms_balance ) then SHF_COMP(:,:,iblock,shf_comp_cpl) = & SHF_COMP(:,:,iblock,shf_comp_cpl) * MASK_SR(:,:,iblock) SHF_QSW(:,:,iblock) = SHF_QSW(:,:,iblock) * MASK_SR(:,:,iblock) endif endif SHF_COMP(:,:,iblock,shf_comp_qsw) = SHF_QSW(:,:,iblock) if ( sfwf_formulation == 'partially-coupled' ) then if (sfc_layer_type == sfc_layer_varthick .and. & .not. lfw_as_salt_flx) then SFWF_COMP(:,:,iblock,sfwf_comp_cpl) = & FW(:,:,iblock) * MASK_SR(:,:,iblock) do n=1,nt TFW_COMP(:,:,n,iblock,tfw_comp_cpl) = & TFW(:,:,n,iblock) * MASK_SR(:,:,iblock) enddo else SFWF_COMP(:,:,iblock,sfwf_comp_cpl) = & STF(:,:,2,iblock) * MASK_SR(:,:,iblock) endif else if ( sfc_layer_type == sfc_layer_varthick .and. & .not. lfw_as_salt_flx .and. liceform ) then SFWF_COMP(:,:,iblock,sfwf_comp_cpl) = FW(:,:,iblock) TFW_COMP (:,:,:,iblock,tfw_comp_cpl) = TFW(:,:,:,iblock) endif endif if ( luse_cpl_ifrac ) then OCN_WGT(:,:,iblock) = (c1-IFRAC(:,:,iblock)) * RCALCT(:,:,iblock) endif enddo !$OMP END PARALLEL DO !----------------------------------------------------------------------- ! Compute QSW_COSZ_WGHT_NORM. !----------------------------------------------------------------------- if ( qsw_distrb_iopt == qsw_distrb_iopt_cosz ) then tday00_interval_beg = tday00 !$OMP PARALLEL DO PRIVATE(iblock,nn,cosz_day) do iblock = 1, nblocks_clinic QSW_COSZ_WGHT_NORM(:,:,iblock) = c0 do nn = 1, nsteps_per_interval cosz_day = tday00_interval_beg + interval_cum_dayfrac(nn-1) & - interval_cum_dayfrac(nsteps_per_interval) call compute_cosz(cosz_day, iblock, QSW_COSZ_WGHT(:,:,iblock)) if (interval_avg_ts(nn)) then QSW_COSZ_WGHT_NORM(:,:,iblock) = & QSW_COSZ_WGHT_NORM(:,:,iblock) & + p5 * QSW_COSZ_WGHT(:,:,iblock) else QSW_COSZ_WGHT_NORM(:,:,iblock) = & QSW_COSZ_WGHT_NORM(:,:,iblock) & + QSW_COSZ_WGHT(:,:,iblock) endif enddo where (QSW_COSZ_WGHT_NORM(:,:,iblock) > c0) & QSW_COSZ_WGHT_NORM(:,:,iblock) = & (fullsteps_per_interval + p5 * halfsteps_per_interval) & / QSW_COSZ_WGHT_NORM(:,:,iblock) enddo !$OMP END PARALLEL DO endif #endif !----------------------------------------------------------------------- !EOC end subroutine pop_set_coupled_forcing !*********************************************************************** !BOP ! !IROUTINE: set_combined_forcing ! !INTERFACE: subroutine set_combined_forcing (STF,FW,TFW) ! !DESCRIPTION: ! ! This routine combines heat flux components into the STF array and ! converts from W/m**2, then combines terms when the "partially-coupled" ! has been selected ! ! !REVISION HISTORY: ! same as module ! !INPUT/OUTPUT PARAMETERS: real (r8), dimension(nx_block,ny_block,nt,max_blocks_clinic), & intent(inout) :: & STF, &! surface tracer fluxes at current timestep TFW ! tracer concentration in water flux real (r8), dimension(nx_block,ny_block,max_blocks_clinic), & intent(inout) :: & FW ! fresh water flux !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & iblock, &! local address of current block n ! index #if CCSMCOUPLED real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: & WORK1, WORK2 ! local work arrays !*** need to zero out any padded cells WORK1 = c0 WORK2 = c0 if ( shf_formulation == 'partially-coupled' ) then !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic STF(:,:,1,iblock) = SHF_COMP(:,:,iblock,shf_comp_wrest) & + SHF_COMP(:,:,iblock,shf_comp_srest) & + SHF_COMP(:,:,iblock,shf_comp_cpl) enddo !$OMP END PARALLEL DO endif if ( sfwf_formulation == 'partially-coupled' ) then if (sfc_layer_type == sfc_layer_varthick .and. & .not. lfw_as_salt_flx) then !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic STF(:,:,2,iblock) = SFWF_COMP(:,:, iblock,sfwf_comp_wrest) & + SFWF_COMP(:,:, iblock,sfwf_comp_srest) FW(:,:,iblock) = SFWF_COMP(:,:, iblock,sfwf_comp_cpl) & + SFWF_COMP(:,:, iblock,sfwf_comp_flxio) TFW(:,:,:,iblock) = TFW_COMP(:,:,:,iblock, tfw_comp_cpl) & + TFW_COMP(:,:,:,iblock, tfw_comp_flxio) enddo !$OMP END PARALLEL DO else if ( lms_balance ) then !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic WORK1(:,:,iblock) = SFWF_COMP(:,:,iblock,sfwf_comp_flxio) / & salinity_factor WORK2(:,:,iblock) = SFWF_COMP(:,:,iblock,sfwf_comp_cpl) enddo !$OMP END PARALLEL DO call ms_balancing (WORK2, EVAP_F,PREC_F, MELT_F, ROFF_F, IOFF_F, & SALT_F, QFLUX, 'salt', ICEOCN_F=WORK1) !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic STF(:,:,2,iblock) = SFWF_COMP(:,:,iblock,sfwf_comp_wrest) & + SFWF_COMP(:,:,iblock,sfwf_comp_srest) & + WORK2(:,:,iblock) & + SFWF_COMP(:,:,iblock,sfwf_comp_flxio)* & MASK_SR(:,:,iblock) enddo !$OMP END PARALLEL DO else !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic STF(:,:,2,iblock) = SFWF_COMP(:,:,iblock,sfwf_comp_wrest) & + SFWF_COMP(:,:,iblock,sfwf_comp_srest) & + SFWF_COMP(:,:,iblock,sfwf_comp_cpl) & + SFWF_COMP(:,:,iblock,sfwf_comp_flxio) enddo !$OMP END PARALLEL DO endif endif endif #endif !----------------------------------------------------------------------- !EOC end subroutine set_combined_forcing !*********************************************************************** !BOP ! !IROUTINE: tavg_coupled_forcing ! !INTERFACE: subroutine tavg_coupled_forcing ! !DESCRIPTION: ! This routine accumulates tavg diagnostics related to forcing_coupled ! forcing. ! ! !REVISION HISTORY: ! same as module !EOP !BOC #if CCSMCOUPLED !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & iblock ! block loop index type (block) :: & this_block ! block information for current block real (r8), dimension(nx_block,ny_block) :: & WORK ! local temp space for tavg diagnostics !----------------------------------------------------------------------- ! ! compute and accumulate tavg forcing diagnostics ! !----------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblock,this_block) do iblock = 1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) call accumulate_tavg_field(EVAP_F(:,:,iblock), tavg_EVAP_F,iblock,1) call accumulate_tavg_field(PREC_F(:,:,iblock), tavg_PREC_F,iblock,1) call accumulate_tavg_field(SNOW_F(:,:,iblock), tavg_SNOW_F,iblock,1) call accumulate_tavg_field(MELT_F(:,:,iblock), tavg_MELT_F,iblock,1) call accumulate_tavg_field(ROFF_F(:,:,iblock), tavg_ROFF_F,iblock,1) call accumulate_tavg_field(IOFF_F(:,:,iblock), tavg_IOFF_F,iblock,1) call accumulate_tavg_field(SALT_F(:,:,iblock), tavg_SALT_F,iblock,1) call accumulate_tavg_field(SENH_F(:,:,iblock), tavg_SENH_F,iblock,1) call accumulate_tavg_field(LWUP_F(:,:,iblock), tavg_LWUP_F,iblock,1) call accumulate_tavg_field(LWDN_F(:,:,iblock), tavg_LWDN_F,iblock,1) call accumulate_tavg_field(MELTH_F(:,:,iblock),tavg_MELTH_F,iblock,1) call accumulate_tavg_field(IFRAC(:,:,iblock), tavg_IFRAC,iblock,1) end do !$OMP END PARALLEL DO call tavg_mcog #endif !----------------------------------------------------------------------- !EOC end subroutine tavg_coupled_forcing !*********************************************************************** !BOP ! !IROUTINE: update_ghost_cells_coupler_fluxes ! !INTERFACE: subroutine update_ghost_cells_coupler_fluxes(errorCode) ! !DESCRIPTION: ! This routine accumulates tavg diagnostics related to forcing_coupled ! forcing. ! ! !REVISION HISTORY: ! same as module ! !OUTPUT PARAMETERS: integer (POP_i4), intent(out) :: errorCode !EOP !BOC !----------------------------------------------------------------------- ! ! update halos for all coupler fields ! !----------------------------------------------------------------------- errorCode = POP_Success #if CCSMCOUPLED call POP_HaloUpdate(SNOW_F,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating SNOW_F') return endif call POP_HaloUpdate(PREC_F,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating PREC_F') return endif call POP_HaloUpdate(EVAP_F,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating EVAP_F') return endif call POP_HaloUpdate(MELT_F,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating MELT_F') return endif call POP_HaloUpdate(ROFF_F,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating ROFF_F') return endif call POP_HaloUpdate(IOFF_F,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating IOFF_F') return endif call POP_HaloUpdate(SALT_F,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating SALT_F') return endif call POP_HaloUpdate(SENH_F,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating SENH_F') return endif call POP_HaloUpdate(LWUP_F,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating LWUP_F') return endif call POP_HaloUpdate(LWDN_F,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating LWDN_F') return endif call POP_HaloUpdate(MELTH_F,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating MELTH_F') return endif call POP_HaloUpdate(SHF_QSW,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating SHF_QSW') return endif call POP_HaloUpdate(IFRAC,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating IFRAC') return endif call POP_HaloUpdate(ATM_PRESS,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating ATM_PRESS') return endif call POP_HaloUpdate(U10_SQR,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating U10_SQR') return endif ! QL, 150526, LAMULT, USTOKES and VSTOKES call POP_HaloUpdate(LAMULT,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating LAMULT') return endif call POP_HaloUpdate(USTOKES,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating USTOKES') return endif call POP_HaloUpdate(VSTOKES,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating VSTOKES') return endif call POP_HaloUpdate(ATM_FINE_DUST_FLUX,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating ATM_FINE_DUST_FLUX') return endif call POP_HaloUpdate(ATM_COARSE_DUST_FLUX,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating ATM_COARSE_DUST_FLUX') return endif call POP_HaloUpdate(SEAICE_DUST_FLUX,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating SEAICE_DUST_FLUX') return endif call POP_HaloUpdate(ATM_BLACK_CARBON_FLUX,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating ATM_BLACK_CARBON_FLUX') return endif call POP_HaloUpdate(SEAICE_BLACK_CARBON_FLUX,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating SEAICE_BLACK_CARBON_FLUX') return endif call POP_HaloUpdate(FRAC_BIN,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating FRAC_BIN') return endif call POP_HaloUpdate(QSW_RAW_BIN,POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindScalar, errorCode, & fillValue = 0.0_POP_r8) if (errorCode /= POP_Success) then call POP_ErrorSet(errorCode, & 'update_ghost_cells_coupler: error updating QSW_RAW_BIN') return endif #endif !----------------------------------------------------------------------- !EOC end subroutine update_ghost_cells_coupler_fluxes !*********************************************************************** !BOP ! !IROUTINE: rotate_wind_stress ! !INTERFACE: subroutine rotate_wind_stress (WORK1,WORK2) ! !DESCRIPTION: ! This subroutine rotates true zonal/meridional wind stress into local ! coordinates, converts to dyne/cm**2, and shifts SMFT to the U grid ! ! !REVISION HISTORY: ! same as module ! !INPUT PARAMETERS: real (r8), dimension(nx_block,ny_block,max_blocks_clinic), intent(in) :: & WORK1, WORK2 ! contains taux and tauy from coupler !EOP !BOC #if CCSMCOUPLED !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (kind=int_kind) :: iblock integer (POP_i4) :: errorCode !----------------------------------------------------------------------- ! ! rotate and convert ! !----------------------------------------------------------------------- SMFT(:,:,1,:) = (WORK1(:,:,:)*cos(ANGLET(:,:,:)) + & WORK2(:,:,:)*sin(ANGLET(:,:,:)))* & RCALCT(:,:,:)*momentum_factor SMFT(:,:,2,:) = (WORK2(:,:,:)*cos(ANGLET(:,:,:)) - & WORK1(:,:,:)*sin(ANGLET(:,:,:)))* & RCALCT(:,:,:)*momentum_factor !----------------------------------------------------------------------- ! ! perform halo updates following the vector rotation ! !----------------------------------------------------------------------- call POP_HaloUpdate(SMFT(:,:,1,:),POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindVector, errorCode, & fillValue = 0.0_POP_r8) call POP_HaloUpdate(SMFT(:,:,2,:),POP_haloClinic, & POP_gridHorzLocCenter, & POP_fieldKindVector, errorCode, & fillValue = 0.0_POP_r8) !----------------------------------------------------------------------- ! ! shift SMFT to U grid ! !----------------------------------------------------------------------- do iblock=1,nblocks_clinic call tgrid_to_ugrid(SMF(:,:,1,iblock),SMFT(:,:,1,iblock),iblock) call tgrid_to_ugrid(SMF(:,:,2,iblock),SMFT(:,:,2,iblock),iblock) enddo ! iblock #endif !----------------------------------------------------------------------- !EOC end subroutine rotate_wind_stress !*********************************************************************** !BOP ! !IROUTINE: compute_cosz ! !INTERFACE: subroutine compute_cosz(tday, iblock, COSZ) ! !DESCRIPTION: ! This subroutine computes cos of the solar zenith angle. ! Negative values are set to zero. ! ! !REVISION HISTORY: ! same as module ! ! !USES: use shr_orb_mod, only: shr_orb_decl, shr_orb_cosz ! !INPUT PARAMETERS: real (r8), intent(in) :: tday integer (int_kind), intent(in) :: iblock ! !OUTPUT PARAMETERS: real (r8), dimension(:,:), intent(out) :: COSZ !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & i, j ! loop indices real (r8) :: & calday, & ! Calendar day, including fraction delta, & ! Solar declination angle in rad eccf ! Earth-sun distance factor (ie. (1/r)**2) !----------------------------------------------------------------------- call timer_start(timer_compute_cosz, block_id=iblock) ! shr_orb code assumes Jan 1 = calday 1, unlike Jan 1 = tday 0 calday = tday + c1 call shr_orb_decl(calday, orb_eccen, orb_mvelpp, orb_lambm0, & orb_obliqr, delta, eccf) do j = 1, ny_block do i = 1, nx_block COSZ(i,j) = shr_orb_cosz(calday, TLAT(i,j,iblock), & TLON(i,j,iblock), delta) COSZ(i,j) = max(c0, COSZ(i,j)) enddo enddo call timer_stop(timer_compute_cosz, block_id=iblock) !----------------------------------------------------------------------- !EOC end subroutine compute_cosz !*********************************************************************** end module forcing_coupled !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| CESM2.1.3_sourcemods/PaxHeaders.32795/forcing.F900000644000000000000000000000012413774500023016111 xustar0027 mtime=1609728019.277159 27 atime=1609728019.270917 30 ctime=1609728019.277129488 CESM2.1.3_sourcemods/forcing.F900000644006307300017500000005761113774500023016502 0ustar00islasncar00000000000000!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| module forcing !BOP ! !MODULE: forcing ! ! !DESCRIPTION: ! This is the main driver module for all surface and interior ! forcing. It contains necessary forcing fields as well as ! necessary routines for call proper initialization and ! update routines for those fields. ! ! !REVISION HISTORY: ! SVN:$Id$ ! ! !USES: use constants use blocks use distribution use domain use grid use ice, only: salice, tfreez, FW_FREEZE use forcing_ws use forcing_shf use forcing_sfwf use forcing_pt_interior use forcing_s_interior use forcing_ap use forcing_coupled, only: set_combined_forcing, tavg_coupled_forcing, & liceform, qsw_12hr_factor, qsw_distrb_iopt, qsw_distrb_iopt_cosz, & tday00_interval_beg, interval_cum_dayfrac, QSW_COSZ_WGHT_NORM, & QSW_COSZ_WGHT, compute_cosz use forcing_tools use passive_tracers, only: set_sflux_passive_tracers use prognostic use tavg use movie, only: define_movie_field, movie_requested, update_movie_field use time_management use exit_mod #ifdef CCSMCOUPLED use shr_sys_mod, only: shr_sys_abort #endif use running_mean_mod, only: running_mean_test_update_sflux_var !*** ccsm use sw_absorption, only: set_chl use registry use forcing_fields use mcog, only: mcog_nbins, QSW_BIN, QSW_RAW_BIN use estuary_vsf_mod, only:lvsf_river,MASK_ESTUARY,FLUX_ROFF_VSF_SRF use estuary_vsf_mod, only:vsf_river_correction implicit none private save ! !PUBLIC MEMBER FUNCTIONS: public :: init_forcing, & set_surface_forcing, & tavg_forcing, & movie_forcing !EOP !BOC integer (int_kind) :: & tavg_SHF, &! tavg_id for surface heat flux tavg_SHF_QSW, &! tavg_id for short-wave solar heat flux tavg_SFWF, &! tavg_id for surface freshwater flux tavg_SFWF_WRST, &! tavg_id for weak restoring freshwater flux tavg_TAUX, &! tavg_id for wind stress in X direction tavg_TAUX2, &! tavg_id for wind stress**2 in X direction tavg_TAUY, &! tavg_id for wind stress in Y direction tavg_TAUY2, &! tavg_id for wind stress**2 in Y direction tavg_FW, &! tavg_id for freshwater flux tavg_TFW_T, &! tavg_id for T flux due to freshwater flux tavg_TFW_S, &! tavg_id for S flux due to freshwater flux tavg_U10_SQR, &! tavg_id for U10_SQR 10m wind speed squared from cpl tavg_ATM_FINE_DUST_FLUX_CPL, &! tavg_id for ATM_FINE_DUST_FLUX from atm from cpl tavg_ATM_COARSE_DUST_FLUX_CPL, &! tavg_id for ATM_COARSE_DUST_FLUX from atm from cpl tavg_SEAICE_DUST_FLUX_CPL, &! tavg_id for SEAICE_DUST_FLUX from seaice from cpl tavg_ATM_BLACK_CARBON_FLUX_CPL, &! tavg_id for ATM_BLACK_CARBON_FLUX from atm from cpl tavg_SEAICE_BLACK_CARBON_FLUX_CPL ! tavg_id for SEAICE_BLACK_CARBON_FLUX from seaice from cpl !----------------------------------------------------------------------- ! ! movie ids ! !----------------------------------------------------------------------- integer (int_kind) :: & movie_SHF, &! movie id for surface heat flux movie_SFWF, &! movie id for surface freshwater flux movie_TAUX, &! movie id for wind stress in X direction movie_TAUY ! movie id for wind stress in Y direction !EOC !*********************************************************************** contains !*********************************************************************** !BOP ! !IROUTINE: init_forcing ! !INTERFACE: subroutine init_forcing ! !DESCRIPTION: ! Initializes forcing by calling a separate routines for ! wind stress, heat flux, fresh water flux, passive tracer flux, ! interior restoring, and atmospheric pressure. ! ! !REVISION HISTORY: ! same as module !----------------------------------------------------------------------- ! ! write out header for forcing options to stdout. ! !----------------------------------------------------------------------- if (my_task == master_task) then write(stdout,blank_fmt) write(stdout,ndelim_fmt) write(stdout,blank_fmt) write(stdout,'(a15)') 'Forcing options' write(stdout,blank_fmt) write(stdout,delim_fmt) endif !----------------------------------------------------------------------- ! ! initialize forcing arrays ! !----------------------------------------------------------------------- ATM_PRESS = c0 FW = c0 FW_OLD = c0 SMF = c0 SMFT = c0 STF = c0 STF_RIV = c0 TFW = c0 lhas_riv_flux = .false. !----------------------------------------------------------------------- ! ! call individual initialization routines ! !----------------------------------------------------------------------- call init_ws(SMF,SMFT,lsmft_avail) !*** NOTE: with bulk NCEP forcing init_shf must be called before !*** init_sfwf call init_shf (STF) call init_sfwf(STF) call init_pt_interior call init_s_interior call init_ap(ATM_PRESS) !----------------------------------------------------------------------- ! ! define tavg diagnostic fields ! !----------------------------------------------------------------------- call define_tavg_field(tavg_SHF, 'SHF', 2, & long_name='Total Surface Heat Flux, Including SW', & units='watt/m^2', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_SHF_QSW, 'SHF_QSW', 2, & long_name='Solar Short-Wave Heat Flux', & units='watt/m^2', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_SFWF,'SFWF',2, & long_name='Virtual Salt Flux in FW Flux formulation', & units='kg/m^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_SFWF_WRST,'SFWF_WRST',2, & long_name='Virtual Salt Flux due to weak restoring', & units='kg/m^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_TAUX,'TAUX',2, & long_name='Windstress in grid-x direction', & units='dyne/centimeter^2', grid_loc='2220', & coordinates='ULONG ULAT time') call define_tavg_field(tavg_TAUX2,'TAUX2',2, & long_name='Windstress**2 in grid-x direction', & units='dyne^2/centimeter^4', grid_loc='2220', & coordinates='ULONG ULAT time') call define_tavg_field(tavg_TAUY,'TAUY',2, & long_name='Windstress in grid-y direction', & units='dyne/centimeter^2', grid_loc='2220', & coordinates='ULONG ULAT time') call define_tavg_field(tavg_TAUY2,'TAUY2',2, & long_name='Windstress**2 in grid-y direction', & units='dyne^2/centimeter^4', grid_loc='2220', & coordinates='ULONG ULAT time') call define_tavg_field(tavg_FW,'FW',2, & long_name='Freshwater Flux', & units='centimeter/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_TFW_T,'TFW_T',2, & long_name='T flux due to freshwater flux', & units='watt/m^2', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_TFW_S,'TFW_S',2, & long_name='S flux due to freshwater flux (kg of salt/m^2/s)', & units='kg/m^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_U10_SQR,'U10_SQR',2, & long_name='10m wind speed squared', & units='cm^2/s^2', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_ATM_FINE_DUST_FLUX_CPL,'ATM_FINE_DUST_FLUX_CPL',2, & long_name='ATM_FINE_DUST_FLUX from cpl', & units='g/cm^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_ATM_COARSE_DUST_FLUX_CPL,'ATM_COARSE_DUST_FLUX_CPL',2, & long_name='ATM_COARSE_DUST_FLUX from cpl', & units='g/cm^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_SEAICE_DUST_FLUX_CPL,'SEAICE_DUST_FLUX_CPL',2, & long_name='SEAICE_DUST_FLUX from cpl', & units='g/cm^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_ATM_BLACK_CARBON_FLUX_CPL,'ATM_BLACK_CARBON_FLUX_CPL',2, & long_name='ATM_BLACK_CARBON_FLUX from cpl', & units='g/cm^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_SEAICE_BLACK_CARBON_FLUX_CPL,'SEAICE_BLACK_CARBON_FLUX_CPL',2, & long_name='SEAICE_BLACK_CARBON_FLUX from cpl', & units='g/cm^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') !----------------------------------------------------------------------- ! ! define movie diagnostic fields ! !----------------------------------------------------------------------- call define_movie_field(movie_SHF,'SHF',0, & long_name='Total Surface Heat Flux, Including SW', & units='watt/m^2', grid_loc='2110') call define_movie_field(movie_SFWF,'SFWF',0, & long_name='Virtual Salt Flux in FW Flux formulation', & units='kg/m^2/s', grid_loc='2110') call define_movie_field(movie_TAUX,'TAUX',0, & long_name='Windstress in grid-x direction', & units='dyne/centimeter^2', grid_loc='2220') call define_movie_field(movie_TAUY,'TAUY',0, & long_name='Windstress in grid-y direction', & units='dyne/centimeter^2', grid_loc='2220') !----------------------------------------------------------------------- !EOC end subroutine init_forcing !*********************************************************************** !BOP ! !IROUTINE: set_surface_forcing ! !INTERFACE: subroutine set_surface_forcing ! !DESCRIPTION: ! Calls surface forcing routines if necessary. ! If forcing does not depend on the ocean state, then update ! forcing if current time is greater than the appropriate ! interpolation time or if it is the first step. ! If forcing DOES depend on the ocean state, then call every ! timestep. interpolation check will be done within the set\_* ! routine. ! Interior restoring is assumed to take place every ! timestep and is set in subroutine tracer\_update, but ! updating the data fields must occur here outside ! any block loops. ! ! !REVISION HISTORY: ! same as module !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: & TFRZ integer (int_kind) :: index_qsw, iblock, nbin real (r8) :: & cosz_day, & qsw_eps #ifdef _HIRES qsw_eps = -1.e-3_r8 #else qsw_eps = c0 #endif !----------------------------------------------------------------------- ! ! Get any interior restoring data and interpolate if necessary. ! !----------------------------------------------------------------------- call get_pt_interior_data call get_s_interior_data !----------------------------------------------------------------------- ! ! Call individual forcing update routines. ! !----------------------------------------------------------------------- if (lsmft_avail) then call set_ws(SMF,SMFT=SMFT) else call set_ws(SMF) endif !*** NOTE: with bulk NCEP and partially-coupled forcing !*** set_shf must be called before set_sfwf call set_shf(STF) call set_sfwf(STF,FW,TFW) if ( shf_formulation == 'partially-coupled' .or. & sfwf_formulation == 'partially-coupled' .or. & sfwf_formulation == 'hosing' .or. & shf_formulation == 'heating' .or. & shf_formulation == 'alyssa_restoring') then call set_combined_forcing(STF,FW,TFW) endif !----------------------------------------------------------------------- ! ! apply qsw 12hr if chosen ! !----------------------------------------------------------------------- index_qsw = mod(nsteps_this_interval,nsteps_per_interval) + 1 if ( qsw_distrb_iopt == qsw_distrb_iopt_cosz ) then cosz_day = tday00_interval_beg + interval_cum_dayfrac(index_qsw-1) & - interval_cum_dayfrac(nsteps_per_interval) !$OMP PARALLEL DO PRIVATE(iblock,nbin) do iblock = 1, nblocks_clinic call compute_cosz(cosz_day, iblock, QSW_COSZ_WGHT(:,:,iblock)) where (QSW_COSZ_WGHT_NORM(:,:,iblock) > c0) QSW_COSZ_WGHT(:,:,iblock) = QSW_COSZ_WGHT(:,:,iblock) & * QSW_COSZ_WGHT_NORM(:,:,iblock) elsewhere QSW_COSZ_WGHT(:,:,iblock) = c1 endwhere SHF_QSW(:,:,iblock) = QSW_COSZ_WGHT(:,:,iblock) & * SHF_COMP(:,:,iblock,shf_comp_qsw) do nbin = 1, mcog_nbins QSW_BIN(:,:,nbin,iblock) = QSW_COSZ_WGHT(:,:,iblock) * QSW_RAW_BIN(:,:,nbin,iblock) enddo enddo !$OMP END PARALLEL DO else if (registry_match('lcoupled')) then SHF_QSW = qsw_12hr_factor(index_qsw)*SHF_COMP(:,:,:,shf_comp_qsw) endif QSW_BIN(:,:,:,:) = qsw_12hr_factor(index_qsw) * QSW_RAW_BIN(:,:,:,:) endif if ( registry_match('lcoupled') & .and. sfwf_formulation /= 'partially-coupled' & .and. sfc_layer_type == sfc_layer_varthick .and. & .not. lfw_as_salt_flx .and. liceform ) then FW = SFWF_COMP(:,:,:, sfwf_comp_cpl) TFW = TFW_COMP(:,:,:,:, tfw_comp_cpl) endif if ( sfc_layer_type == sfc_layer_varthick .and. & .not. lfw_as_salt_flx .and. liceform ) then FW = FW + FW_FREEZE !$OMP PARALLEL DO PRIVATE(iblock) do iblock = 1, nblocks_clinic call tfreez(TFRZ(:,:,iblock), TRACER(:,:,1,2,curtime,iblock)) enddo !$OMP END PARALLEL DO TFW(:,:,1,:) = TFW(:,:,1,:) + FW_FREEZE(:,:,:)*TFRZ(:,:,:) TFW(:,:,2,:) = TFW(:,:,2,:) + FW_FREEZE(:,:,:)*salice endif call set_ap(ATM_PRESS) if (nt > 2) then call set_sflux_passive_tracers(U10_SQR,IFRAC,ATM_PRESS,ATM_FINE_DUST_FLUX,ATM_COARSE_DUST_FLUX,SEAICE_DUST_FLUX, & ATM_BLACK_CARBON_FLUX,SEAICE_BLACK_CARBON_FLUX, & lvsf_river,MASK_ESTUARY,vsf_river_correction,STF,STF_RIV) endif ! running_mean_test_update_sflux_var is only necessary for test mode call running_mean_test_update_sflux_var call set_chl #ifdef CCSMCOUPLED if (ANY(SHF_QSW < qsw_eps)) then call shr_sys_abort('(set_surface_forcing) ERROR: SHF_QSW < qsw_eps in set_surface_forcing') endif #endif !----------------------------------------------------------------------- !EOC end subroutine set_surface_forcing !*********************************************************************** !BOP ! !IROUTINE: tavg_forcing ! !INTERFACE: subroutine tavg_forcing ! !DESCRIPTION: ! This routine accumulates tavg diagnostics related to surface ! forcing. ! ! !REVISION HISTORY: ! same as module !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & iblock ! block loop index type (block) :: & this_block ! block information for current block real (r8), dimension(nx_block,ny_block) :: & WORK ! local temp space for tavg diagnostics !----------------------------------------------------------------------- ! ! compute and accumulate tavg forcing diagnostics ! !----------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblock,this_block,WORK) do iblock = 1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) if (accumulate_tavg_now(tavg_SHF)) then where (KMT(:,:,iblock) > 0) WORK = (STF(:,:,1,iblock)+SHF_QSW(:,:,iblock))/ & hflux_factor ! W/m^2 elsewhere WORK = c0 end where call accumulate_tavg_field(WORK,tavg_SHF,iblock,1) endif if (accumulate_tavg_now(tavg_SHF_QSW)) then where (KMT(:,:,iblock) > 0) WORK = SHF_QSW(:,:,iblock)/hflux_factor ! W/m^2 elsewhere WORK = c0 end where call accumulate_tavg_field(WORK,tavg_SHF_QSW,iblock,1) endif if (accumulate_tavg_now(tavg_SFWF)) then if (sfc_layer_type == sfc_layer_varthick .and. & .not. lfw_as_salt_flx) then where (KMT(:,:,iblock) > 0) WORK = FW(:,:,iblock)*seconds_in_year*mpercm ! m/yr elsewhere WORK = c0 end where else if ( lvsf_river ) then ! ROFF_F should be included in the SFWF term in the open ocean ! ROFF_F in the Marginal Seas is already included in STF(:,:,2,iblock) where (KMT(:,:,iblock) > 0) ! convert to kg(freshwater)/m^2/s WORK =STF(:,:,2,iblock)/salinity_factor& -MASK_ESTUARY(:,:,iblock)*FLUX_ROFF_VSF_SRF(:,:,2,iblock)/salinity_factor elsewhere WORK = c0 end where else where (KMT(:,:,iblock) > 0) ! convert to kg(freshwater)/m^2/s WORK = STF(:,:,2,iblock)/salinity_factor elsewhere WORK = c0 end where endif endif call accumulate_tavg_field(WORK,tavg_SFWF,iblock,1) endif if (accumulate_tavg_now(tavg_SFWF_WRST)) then if ( sfwf_formulation == 'partially-coupled' ) then where (KMT(:,:,iblock) > 0) ! convert to kg(freshwater)/m^2/s WORK = SFWF_COMP(:,:,iblock,sfwf_comp_wrest)/salinity_factor elsewhere WORK = c0 end where else WORK = c0 endif call accumulate_tavg_field(WORK,tavg_SFWF_WRST,iblock,1) endif call accumulate_tavg_field(SMF(:,:,1,iblock), tavg_TAUX,iblock,1) call accumulate_tavg_field(SMF(:,:,1,iblock)**2, tavg_TAUX2,iblock,1) call accumulate_tavg_field(SMF(:,:,2,iblock), tavg_TAUY,iblock,1) call accumulate_tavg_field(SMF(:,:,2,iblock)**2, tavg_TAUY2,iblock,1) call accumulate_tavg_field(FW (:,:,iblock), tavg_FW,iblock,1) call accumulate_tavg_field(TFW(:,:,1,iblock)/hflux_factor, tavg_TFW_T,iblock,1) call accumulate_tavg_field(TFW(:,:,2,iblock)*rho_sw*c10, tavg_TFW_S,iblock,1) call accumulate_tavg_field(U10_SQR(:,:,iblock), tavg_U10_SQR,iblock,1) call accumulate_tavg_field(ATM_FINE_DUST_FLUX(:,:,iblock), tavg_ATM_FINE_DUST_FLUX_CPL,iblock,1) call accumulate_tavg_field(ATM_COARSE_DUST_FLUX(:,:,iblock), tavg_ATM_COARSE_DUST_FLUX_CPL,iblock,1) call accumulate_tavg_field(SEAICE_DUST_FLUX(:,:,iblock), tavg_SEAICE_DUST_FLUX_CPL,iblock,1) call accumulate_tavg_field(ATM_BLACK_CARBON_FLUX(:,:,iblock), tavg_ATM_BLACK_CARBON_FLUX_CPL,iblock,1) call accumulate_tavg_field(SEAICE_BLACK_CARBON_FLUX(:,:,iblock), tavg_SEAICE_BLACK_CARBON_FLUX_CPL,iblock,1) end do !$OMP END PARALLEL DO if (registry_match('lcoupled')) call tavg_coupled_forcing !----------------------------------------------------------------------- !EOC end subroutine tavg_forcing !*********************************************************************** !BOP ! !IROUTINE: movie_forcing ! !INTERFACE: subroutine movie_forcing ! !DESCRIPTION: ! This routine accumulates movie diagnostics related to surface ! forcing. ! ! !REVISION HISTORY: ! same as module !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & iblock ! block loop index type (block) :: & this_block ! block information for current block real (r8), dimension(nx_block,ny_block) :: & WORK ! local temp space for movie diagnostics !----------------------------------------------------------------------- ! ! compute and dump movie forcing diagnostics ! !----------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblock,this_block,WORK) do iblock = 1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) !----------------------------------------------------------------------- ! ! dump movie diagnostics if requested ! !----------------------------------------------------------------------- if (movie_requested(movie_SHF) ) then where (KMT(:,:,iblock) > 0) WORK = (STF(:,:,1,iblock)+SHF_QSW(:,:,iblock))/ & hflux_factor ! W/m^2 elsewhere WORK = c0 end where call update_movie_field(WORK, movie_SHF, iblock, 1) endif if (movie_requested(movie_SFWF) ) then if (sfc_layer_type == sfc_layer_varthick .and. & .not. lfw_as_salt_flx) then where (KMT(:,:,iblock) > 0) WORK = FW(:,:,iblock)*seconds_in_year*mpercm ! m/yr elsewhere WORK = c0 end where else where (KMT(:,:,iblock) > 0) ! convert to kg(freshwater)/m^2/s WORK = STF(:,:,2,iblock)/salinity_factor elsewhere WORK = c0 end where endif call update_movie_field(WORK, movie_SFWF, iblock, 1) endif if (movie_requested(movie_TAUX) ) then call update_movie_field(SMF(:,:,1,iblock), & movie_TAUX,iblock,1) endif if (movie_requested(movie_TAUY) ) then call update_movie_field(SMF(:,:,2,iblock), & movie_TAUY,iblock,1) endif end do !$OMP END PARALLEL DO !----------------------------------------------------------------------- !EOC end subroutine movie_forcing !*********************************************************************** end module forcing !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| CESM2.1.3_sourcemods/PaxHeaders.32795/forcing_shf.F90-ORIG0000644000000000000000000000012413774500023017507 xustar0027 mtime=1609728019.341331 27 atime=1609728019.330949 30 ctime=1609728019.340749624 CESM2.1.3_sourcemods/forcing_shf.F90-ORIG0000644006307300017500000024317113774500023020076 0ustar00islasncar00000000000000!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| module forcing_shf !BOP ! !MODULE: forcing_shf ! !DESCRIPTION: ! Contains routines and variables used for determining the surface ! heat flux. ! ! !REVISION HISTORY: ! SVN:$Id$ ! ! !USES: use kinds_mod use blocks use distribution use domain use constants use io use grid use forcing_tools use registry use time_management use prognostic use exit_mod implicit none private save ! !PUBLIC MEMBER FUNCTIONS: public :: init_shf, & set_shf ! !PUBLIC DATA MEMBERS: real (r8), dimension(nx_block,ny_block,max_blocks_clinic), & public, target :: & SHF_QSW, & ! incoming short wave SHF_QSW_RAW ! no masking, no diurnal cycle logical (log_kind), public :: & lsw_absorb ! true if short wave available as separate flux ! (use penetrative short wave) !*** the following must be shared with sfwf forcing in !*** bulk-NCEP option real (r8), allocatable, dimension(:,:,:,:), public :: & SHF_COMP real (r8), allocatable, dimension(:,:,:), public :: & OCN_WGT integer (int_kind), allocatable, dimension(:,:,:), public :: & MASK_SR ! strong restoring mask for marginal seas integer (int_kind), public :: & shf_data_tair, & shf_data_qair, & shf_data_cldfrac, & shf_data_windspd, & shf_comp_qsw, & shf_comp_qlw, & shf_comp_qlat, & shf_comp_qsens, & shf_comp_wrest, & shf_comp_srest, & shf_comp_cpl !*** the following are needed by restart real (r8), public :: & shf_interp_last ! time when last interpolation was done !EOP !BOC !----------------------------------------------------------------------- ! ! module variables ! !----------------------------------------------------------------------- real (r8), allocatable, dimension(:,:,:,:,:) :: & SHF_DATA ! forcing data to use for computing SHF real (r8), dimension(12) :: & shf_data_time ! time (hours) corresponding to surface heat fluxes real (r8), dimension(20) :: & shf_data_renorm ! factors for converting to model units real (r8), parameter, private :: & T_strong_restore_limit = -1.8_r8, & T_weak_restore_limit = -0.8_r8, & dT_restore_limit = T_weak_restore_limit - T_strong_restore_limit real (r8) :: & shf_data_inc, &! time increment between values of forcing data shf_data_next, &! time that will be used for the next value of forcing data that is needed shf_data_update, &! time when the a new forcing value needs to be added to interpolation set shf_interp_inc, &! time increment between interpolation shf_interp_next, &! time when next interpolation will be done shf_restore_tau, & shf_restore_rtau, & shf_weak_restore, &! heat flux weak restoring max time scale shf_strong_restore,&! heat flux strong restoring max time scale shf_strong_restore_ms integer (int_kind) :: & shf_interp_order, &! order of temporal interpolation shf_data_time_min_loc, &! time index for first shf_data point shf_data_num_fields integer (int_kind), public :: & shf_num_comps character (char_len), dimension(:), allocatable :: & shf_data_names ! short names for input data fields integer (int_kind), dimension(:), allocatable :: & shf_bndy_loc, &! location and field type for ghost shf_bndy_type ! cell updates ! the following is necessary for sst restoring and partially-coupled integer (int_kind) :: & shf_data_sst ! the following are necessary for Barnier-restoring integer (int_kind) :: & shf_data_tstar, & shf_data_tau, & shf_data_ice, & shf_data_qsw character (char_len) :: & shf_interp_freq, &! keyword for period of temporal interpolation shf_filename, &! file containing forcing data shf_file_fmt, &! format (bin or netcdf) of shf file shf_interp_type, & shf_data_label character (char_len), public :: & shf_data_type, &! keyword for period of forcing data shf_formulation ! the following is necessary for partially-coupled ! luse_cpl_ifrac = .T. use fractional ice coverage ! sent by the coupler from the (dummy) ice, ! .F. use fractional ice coverage based on the ! STR SST climatology. logical (log_kind), public :: & luse_cpl_ifrac !----------------------------------------------------------------------- ! ! the following are needed for long-wave heat flux ! with bulk-NCEP forcing ! !----------------------------------------------------------------------- real (r8), allocatable, dimension (:,:,:) :: & CCINT real (r8), dimension(21) :: & cc = (/ 0.88_r8, 0.84_r8, 0.80_r8, & 0.76_r8, 0.72_r8, 0.68_r8, & 0.63_r8, 0.59_r8, 0.52_r8, & 0.50_r8, 0.50_r8, 0.50_r8, & 0.52_r8, 0.59_r8, 0.63_r8, & 0.68_r8, 0.72_r8, 0.76_r8, & 0.80_r8, 0.84_r8, 0.88_r8 /) real (r8), dimension(21) :: & clat = (/ -90.0_r8, -80.0_r8, -70.0_r8, & -60.0_r8, -50.0_r8, -40.0_r8, & -30.0_r8, -20.0_r8, -10.0_r8, & -5.0_r8, 0.0_r8, 5.0_r8, & 10.0_r8, 20.0_r8, 30.0_r8, & 40.0_r8, 50.0_r8, 60.0_r8, & 70.0_r8, 80.0_r8, 90.0_r8 /) !EOC !*********************************************************************** contains !*********************************************************************** !BOP ! !IROUTINE: init_shf ! !INTERFACE: subroutine init_shf(STF) ! !DESCRIPTION: ! Initializes surface heat flux forcing by either calculating ! or reading in the surface heat flux. Also do initial ! book-keeping concerning when new data is needed for the temporal ! interpolation and when the forcing will need to be updated. ! ! !REVISION HISTORY: ! same as module ! !OUTPUT PARAMETERS: real (r8), dimension(nx_block,ny_block,nt,max_blocks_clinic), & intent(out) :: & STF ! surface tracer flux - this routine only modifies ! the slice corresponding to temperature (tracer 1) !EOP !BOC !---------------------------------------------------------------------- ! ! local variables ! !---------------------------------------------------------------------- integer (int_kind) :: & i,j, k, n, iblock, &! loop indices nml_error ! namelist error flag character (char_len) :: & forcing_filename ! temp for full filename of forcing file logical (log_kind) :: & no_region_mask ! flag for existence of region mask real (r8), dimension(:,:,:,:,:), target, allocatable :: & TEMP_DATA ! temporary data array for monthly forcing type (datafile) :: & forcing_file ! file containing forcing fields type (io_field_desc) :: & ! io descriptors for various input fields io_sst, & io_tstar, & io_tau, & io_ice, & io_qsw, & io_tair, & io_qair, & io_cldfrac, & io_windspd type (io_dim) :: & i_dim, j_dim, &! dimension descriptors for horiz dims month_dim ! dimension descriptor for monthly data namelist /forcing_shf_nml/ shf_data_type, shf_data_inc, & shf_interp_type, shf_interp_freq, & shf_interp_inc, shf_restore_tau, & shf_filename, shf_file_fmt, & shf_data_renorm, & shf_formulation, & shf_weak_restore, shf_strong_restore,& shf_strong_restore_ms, & luse_cpl_ifrac !----------------------------------------------------------------------- ! ! read surface heat flux namelist input after setting default values. ! !----------------------------------------------------------------------- shf_formulation = 'restoring' shf_data_type = 'analytic' shf_data_inc = 1.e20_r8 shf_interp_type = 'nearest' shf_interp_freq = 'never' shf_interp_inc = 1.e20_r8 shf_restore_tau = 1.e20_r8 shf_filename = 'unknown-shf' shf_file_fmt = 'bin' shf_data_renorm = c1 shf_weak_restore = c0 shf_strong_restore = 92.64_r8 shf_strong_restore_ms = 92.64_r8 luse_cpl_ifrac = .false. if (my_task == master_task) then open (nml_in, file=nml_filename, status='old',iostat=nml_error) if (nml_error /= 0) then nml_error = -1 else nml_error = 1 endif do while (nml_error > 0) read(nml_in, nml=forcing_shf_nml,iostat=nml_error) end do if (nml_error == 0) close(nml_in) endif call broadcast_scalar(nml_error, master_task) if (nml_error /= 0) then call exit_POP(sigAbort,'ERROR reading forcing_shf_nml') endif call broadcast_scalar(shf_formulation, master_task) call broadcast_scalar(shf_data_type, master_task) call broadcast_scalar(shf_data_inc, master_task) call broadcast_scalar(shf_interp_type, master_task) call broadcast_scalar(shf_interp_freq, master_task) call broadcast_scalar(shf_interp_inc, master_task) call broadcast_scalar(shf_restore_tau, master_task) call broadcast_scalar(shf_filename, master_task) call broadcast_scalar(shf_file_fmt, master_task) call broadcast_array (shf_data_renorm, master_task) call broadcast_scalar(shf_weak_restore, master_task) call broadcast_scalar(shf_strong_restore, master_task) call broadcast_scalar(shf_strong_restore_ms, master_task) call broadcast_scalar(luse_cpl_ifrac, master_task) !----------------------------------------------------------------------- ! ! convert data_type to 'monthly-calendar' if input is 'monthly' ! !----------------------------------------------------------------------- if (shf_data_type == 'monthly') shf_data_type = 'monthly-calendar' !----------------------------------------------------------------------- ! ! set values based on shf_formulation ! !----------------------------------------------------------------------- select case (shf_formulation) case ('restoring') lsw_absorb = .false. shf_data_num_fields = 1 allocate(shf_data_names(shf_data_num_fields), & shf_bndy_loc (shf_data_num_fields), & shf_bndy_type (shf_data_num_fields)) shf_data_sst = 1 shf_data_names(shf_data_sst) = 'SST' shf_bndy_loc (shf_data_sst) = field_loc_center shf_bndy_type (shf_data_sst) = field_type_scalar case ('Barnier-restoring') lsw_absorb = .true. shf_data_num_fields = 4 allocate(shf_data_names(shf_data_num_fields), & shf_bndy_loc (shf_data_num_fields), & shf_bndy_type (shf_data_num_fields)) shf_data_tstar = 1 shf_data_tau = 2 shf_data_ice = 3 shf_data_qsw = 4 shf_data_names(shf_data_tstar) = 'TSTAR' shf_bndy_loc (shf_data_tstar) = field_loc_center shf_bndy_type (shf_data_tstar) = field_type_scalar shf_data_names(shf_data_tau) = 'TAU' shf_bndy_loc (shf_data_tau) = field_loc_center shf_bndy_type (shf_data_tau) = field_type_scalar shf_data_names(shf_data_ice) = 'ICE' shf_bndy_loc (shf_data_ice) = field_loc_center shf_bndy_type (shf_data_ice) = field_type_scalar shf_data_names(shf_data_qsw) = 'QSW' shf_bndy_loc (shf_data_qsw) = field_loc_center shf_bndy_type (shf_data_qsw) = field_type_scalar case ('bulk-NCEP') lsw_absorb = .true. shf_data_num_fields = 6 allocate(shf_data_names(shf_data_num_fields), & shf_bndy_loc (shf_data_num_fields), & shf_bndy_type (shf_data_num_fields)) shf_data_sst = 1 shf_data_tair = 2 shf_data_qair = 3 shf_data_qsw = 4 shf_data_cldfrac = 5 shf_data_windspd = 6 shf_data_names(shf_data_sst) = 'SST' shf_bndy_loc (shf_data_sst) = field_loc_center shf_bndy_type (shf_data_sst) = field_type_scalar shf_data_names(shf_data_tair) = 'TAIR' shf_bndy_loc (shf_data_tair) = field_loc_center shf_bndy_type (shf_data_tair) = field_type_scalar shf_data_names(shf_data_qair) = 'QAIR' shf_bndy_loc (shf_data_qair) = field_loc_center shf_bndy_type (shf_data_qair) = field_type_scalar shf_data_names(shf_data_qsw) = 'QSW' shf_bndy_loc (shf_data_qsw) = field_loc_center shf_bndy_type (shf_data_qsw) = field_type_scalar shf_data_names(shf_data_cldfrac) = 'CLDFRAC' shf_bndy_loc (shf_data_cldfrac) = field_loc_center shf_bndy_type (shf_data_cldfrac) = field_type_scalar shf_data_names(shf_data_windspd) = 'WINDSPD' shf_bndy_loc (shf_data_windspd) = field_loc_center shf_bndy_type (shf_data_windspd) = field_type_scalar shf_num_comps = 6 shf_comp_qsw = 1 shf_comp_qlw = 2 shf_comp_qlat = 3 shf_comp_qsens = 4 shf_comp_wrest = 5 shf_comp_srest = 6 !*** initialize CCINT (cloud factor used in long-wave heat flux !*** with bulk-NCEP forcing). allocate(CCINT(nx_block,ny_block,max_blocks_clinic)) !$OMP PARALLEL DO PRIVATE(iblock,i,j) do iblock=1,nblocks_clinic do j=1,ny_block do i=1,20 where ((TLAT(:,j,iblock)*radian > clat(i )) .and. & (TLAT(:,j,iblock)*radian <= clat(i+1))) CCINT(:,j,iblock) = cc(i) + (cc(i+1)-cc(i))* & (TLAT(:,j,iblock)*radian - clat(i))/ & (clat(i+1)-clat(i)) endwhere end do ! i end do ! j end do ! block loop !$OMP END PARALLEL DO case ('partially-coupled') call register_string('partially-coupled') lsw_absorb = .false. shf_data_num_fields = 1 allocate(shf_data_names(shf_data_num_fields), & shf_bndy_loc (shf_data_num_fields), & shf_bndy_type (shf_data_num_fields)) shf_data_sst = 1 shf_data_names(shf_data_sst) = 'SST' shf_bndy_loc (shf_data_sst) = field_loc_center shf_bndy_type (shf_data_sst) = field_type_scalar shf_num_comps = 4 shf_comp_wrest = 1 shf_comp_srest = 2 shf_comp_cpl = 3 shf_comp_qsw = 4 case default call exit_POP(sigAbort, & 'init_shf: Unknown value for shf_formulation') end select !----------------------------------------------------------------------- ! ! calculate inverse of restoring time scale and convert to seconds. ! !----------------------------------------------------------------------- shf_restore_tau = seconds_in_day*shf_restore_tau shf_restore_rtau = c1/shf_restore_tau !----------------------------------------------------------------------- ! ! initialize SHF_QSW in case a value is needed but not ! supplied by data: for example, with KPP and restoring. ! !----------------------------------------------------------------------- SHF_QSW = c0 SHF_QSW_RAW = c0 !----------------------------------------------------------------------- ! ! set strong restoring mask to 0 only at ocean points that are ! marginal seas and land. ! !----------------------------------------------------------------------- if (allocated(REGION_MASK)) then allocate( MASK_SR(nx_block,ny_block,max_blocks_clinic)) no_region_mask = .false. !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic MASK_SR(:,:,iblock) = merge(0, 1, & REGION_MASK(:,:,iblock) <= 0) end do !$OMP END PARALLEL DO else no_region_mask = .true. endif !----------------------------------------------------------------------- ! ! convert interp_type to corresponding integer value. ! !----------------------------------------------------------------------- select case (shf_interp_type) case ('nearest') shf_interp_order = 1 case ('linear') shf_interp_order = 2 case ('4point') shf_interp_order = 4 case default call exit_POP(sigAbort, & 'init_shf: Unknown value for shf_interp_type') end select !----------------------------------------------------------------------- ! ! set values of the surface heat flux arrays (STF or SHF_DATA) ! depending on the type of the surface heat flux data. ! !----------------------------------------------------------------------- select case (shf_data_type) !----------------------------------------------------------------------- ! ! no surface heat flux, therefore no interpolation in time ! needed, nor are there any new values to be used. ! !----------------------------------------------------------------------- case ('none') STF(:,:,1,:) = c0 shf_data_next = never shf_data_update = never shf_interp_freq = 'never' !----------------------------------------------------------------------- ! ! simple analytic surface temperature that is constant in ! time, therefore no new values will be needed. ! !----------------------------------------------------------------------- case ('analytic') allocate( SHF_DATA(nx_block,ny_block,max_blocks_clinic, & shf_data_num_fields,1)) !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic select case (shf_formulation) case ('restoring') SHF_DATA(:,:,iblock,shf_data_sst,1) = & 28.0_r8*(c1 - sin(ULAT(:,:,iblock))) end select end do ! block loop !$OMP END PARALLEL DO shf_data_next = never shf_data_update = never shf_interp_freq = 'never' !----------------------------------------------------------------------- ! ! annual mean climatological surface temperature (read in from file) ! that is constant in time, therefore no new values will be needed ! (shf_data_next = shf_data_update = never). ! !----------------------------------------------------------------------- case ('annual') allocate( SHF_DATA(nx_block,ny_block,max_blocks_clinic, & shf_data_num_fields,1)) SHF_DATA = c0 forcing_file = construct_file(shf_file_fmt, & full_name=trim(shf_filename), & record_length = rec_type_dbl, & recl_words=nx_global*ny_global) call data_set(forcing_file,'open_read') i_dim = construct_io_dim('i',nx_global) j_dim = construct_io_dim('j',ny_global) select case (shf_formulation) case ('restoring') io_sst = construct_io_field( & trim(shf_data_names(shf_data_sst)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_sst), & field_type = shf_bndy_type(shf_data_sst), & d2d_array=SHF_DATA(:,:,:,shf_data_sst,1)) call data_set(forcing_file,'define',io_sst) call data_set(forcing_file,'read' ,io_sst) call destroy_io_field(io_sst) case ('partially-coupled') io_sst = construct_io_field( & trim(shf_data_names(shf_data_sst)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_sst), & field_type = shf_bndy_type(shf_data_sst), & d2d_array=SHF_DATA(:,:,:,shf_data_sst,1)) call data_set(forcing_file,'define',io_sst) call data_set(forcing_file,'read' ,io_sst) call destroy_io_field(io_sst) allocate(SHF_COMP(nx_block,ny_block,max_blocks_clinic, & shf_num_comps), & OCN_WGT (nx_block,ny_block,max_blocks_clinic)) SHF_COMP = c0 ! initialize case ('Barnier-restoring') io_tstar = construct_io_field( & trim(shf_data_names(shf_data_tstar)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_tstar), & field_type = shf_bndy_type(shf_data_tstar), & d2d_array=SHF_DATA(:,:,:,shf_data_tstar,1)) io_tau = construct_io_field( & trim(shf_data_names(shf_data_tau)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_tau), & field_type = shf_bndy_type(shf_data_tau), & d2d_array=SHF_DATA(:,:,:,shf_data_tau,1)) io_ice = construct_io_field( & trim(shf_data_names(shf_data_ice)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_ice), & field_type = shf_bndy_type(shf_data_ice), & d2d_array=SHF_DATA(:,:,:,shf_data_ice,1)) io_qsw = construct_io_field( & trim(shf_data_names(shf_data_qsw)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_qsw), & field_type = shf_bndy_type(shf_data_qsw), & d2d_array=SHF_DATA(:,:,:,shf_data_qsw,1)) call data_set(forcing_file,'define',io_tstar) call data_set(forcing_file,'define',io_tau) call data_set(forcing_file,'define',io_ice) call data_set(forcing_file,'define',io_qsw) call data_set(forcing_file,'read',io_tstar) call data_set(forcing_file,'read',io_tau) call data_set(forcing_file,'read',io_ice) call data_set(forcing_file,'read',io_qsw) call destroy_io_field(io_tstar) call destroy_io_field(io_tau) call destroy_io_field(io_ice) call destroy_io_field(io_qsw) SHF_DATA(:,:,:,shf_data_tau,1) = seconds_in_day* & SHF_DATA(:,:,:,shf_data_tau,1) case ('bulk-NCEP') io_sst = construct_io_field( & trim(shf_data_names(shf_data_sst)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_sst), & field_type = shf_bndy_type(shf_data_sst), & d2d_array=SHF_DATA(:,:,:,shf_data_sst,1)) io_tair = construct_io_field( & trim(shf_data_names(shf_data_tair)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_tair), & field_type = shf_bndy_type(shf_data_tair), & d2d_array=SHF_DATA(:,:,:,shf_data_tair,1)) io_qair = construct_io_field( & trim(shf_data_names(shf_data_qair)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_qair), & field_type = shf_bndy_type(shf_data_qair), & d2d_array=SHF_DATA(:,:,:,shf_data_qair,1)) io_qsw = construct_io_field( & trim(shf_data_names(shf_data_qsw)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_qsw), & field_type = shf_bndy_type(shf_data_qsw), & d2d_array=SHF_DATA(:,:,:,shf_data_qsw,1)) io_cldfrac = construct_io_field( & trim(shf_data_names(shf_data_cldfrac)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_cldfrac), & field_type = shf_bndy_type(shf_data_cldfrac), & d2d_array=SHF_DATA(:,:,:,shf_data_cldfrac,1)) io_windspd = construct_io_field( & trim(shf_data_names(shf_data_windspd)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_windspd), & field_type = shf_bndy_type(shf_data_windspd), & d2d_array=SHF_DATA(:,:,:,shf_data_windspd,1)) call data_set(forcing_file, 'define', io_sst) call data_set(forcing_file, 'define', io_tair) call data_set(forcing_file, 'define', io_qair) call data_set(forcing_file, 'define', io_qsw) call data_set(forcing_file, 'define', io_cldfrac) call data_set(forcing_file, 'define', io_windspd) call data_set(forcing_file, 'read', io_sst) call data_set(forcing_file, 'read', io_tair) call data_set(forcing_file, 'read', io_qair) call data_set(forcing_file, 'read', io_qsw) call data_set(forcing_file, 'read', io_cldfrac) call data_set(forcing_file, 'read', io_windspd) call destroy_io_field(io_sst) call destroy_io_field(io_tair) call destroy_io_field(io_qair) call destroy_io_field(io_qsw) call destroy_io_field(io_cldfrac) call destroy_io_field(io_windspd) allocate(SHF_COMP(nx_block,ny_block,max_blocks_clinic, & shf_num_comps), & OCN_WGT (nx_block,ny_block,max_blocks_clinic)) SHF_COMP = c0 ! initialize end select call data_set(forcing_file,'close') !*** renormalize values if necessary to compensate for different !*** units do n = 1,shf_data_num_fields if (shf_data_renorm(n) /= c1) SHF_DATA(:,:,:,n,:) = & shf_data_renorm(n)*SHF_DATA(:,:,:,n,:) enddo shf_data_next = never shf_data_update = never shf_interp_freq = 'never' if (my_task == master_task) then write(stdout,blank_fmt) write(stdout,'(a23,a)') ' SHF Annual file read: ', & trim(forcing_file%full_name) endif call destroy_file(forcing_file) !----------------------------------------------------------------------- ! monthly mean climatological surface heat flux. all ! 12 months are read in from a file. interpolation order ! (shf_interp_order) may be specified with namelist input. !----------------------------------------------------------------------- case ('monthly-equal','monthly-calendar') allocate(SHF_DATA(nx_block,ny_block,max_blocks_clinic, & shf_data_num_fields,0:12), & TEMP_DATA(nx_block,ny_block,12,max_blocks_clinic, & shf_data_num_fields)) SHF_DATA = c0 call find_forcing_times(shf_data_time, shf_data_inc, & shf_interp_type, shf_data_next, & shf_data_time_min_loc, shf_data_update, & shf_data_type) forcing_file = construct_file(shf_file_fmt, & full_name = trim(shf_filename), & record_length = rec_type_dbl, & recl_words=nx_global*ny_global) call data_set(forcing_file,'open_read') i_dim = construct_io_dim('i',nx_global) j_dim = construct_io_dim('j',ny_global) month_dim = construct_io_dim('month',12) select case (shf_formulation) case ('restoring') io_sst = construct_io_field( & trim(shf_data_names(shf_data_sst)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_sst), & field_type = shf_bndy_type(shf_data_sst), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_sst)) call data_set(forcing_file,'define',io_sst) call data_set(forcing_file,'read' ,io_sst) call destroy_io_field(io_sst) !$OMP PARALLEL DO PRIVATE(iblock, n) do iblock=1,nblocks_clinic do n=1,12 SHF_DATA (:,:,iblock,shf_data_sst,n) = & TEMP_DATA(:,:,n,iblock,shf_data_sst) end do end do !$OMP END PARALLEL DO case ('partially-coupled') io_sst = construct_io_field( & trim(shf_data_names(shf_data_sst)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_sst), & field_type = shf_bndy_type(shf_data_sst), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_sst)) call data_set(forcing_file,'define',io_sst) call data_set(forcing_file,'read' ,io_sst) call destroy_io_field(io_sst) !$OMP PARALLEL DO PRIVATE(iblock, n) do iblock=1,nblocks_clinic do n=1,12 SHF_DATA (:,:,iblock,shf_data_sst,n) = & TEMP_DATA(:,:,n,iblock,shf_data_sst) end do end do !$OMP END PARALLEL DO allocate(SHF_COMP(nx_block,ny_block,max_blocks_clinic, & shf_num_comps), & OCN_WGT (nx_block,ny_block,max_blocks_clinic)) SHF_COMP = c0 ! initialize case ('Barnier-restoring') io_tstar = construct_io_field( & trim(shf_data_names(shf_data_tstar)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_tstar), & field_type = shf_bndy_type(shf_data_tstar), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_tstar)) io_tau = construct_io_field( & trim(shf_data_names(shf_data_tau)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_tau), & field_type = shf_bndy_type(shf_data_tau), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_tau)) io_ice = construct_io_field( & trim(shf_data_names(shf_data_ice)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_ice), & field_type = shf_bndy_type(shf_data_ice), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_ice)) io_qsw = construct_io_field( & trim(shf_data_names(shf_data_qsw)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_qsw), & field_type = shf_bndy_type(shf_data_qsw), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_qsw)) call data_set(forcing_file,'define',io_tstar) call data_set(forcing_file,'define',io_tau) call data_set(forcing_file,'define',io_ice) call data_set(forcing_file,'define',io_qsw) call data_set(forcing_file,'read',io_tstar) call data_set(forcing_file,'read',io_tau) call data_set(forcing_file,'read',io_ice) call data_set(forcing_file,'read',io_qsw) !$OMP PARALLEL DO PRIVATE(iblock,n) do iblock=1,nblocks_clinic do n=1,12 SHF_DATA (:,:,iblock,shf_data_tstar,n) = & TEMP_DATA(:,:,n,iblock,shf_data_tstar) SHF_DATA (:,:,iblock,shf_data_tau,n) = & TEMP_DATA(:,:,n,iblock,shf_data_tau)*seconds_in_day SHF_DATA (:,:,iblock,shf_data_ice,n) = & TEMP_DATA(:,:,n,iblock,shf_data_ice) SHF_DATA (:,:,iblock,shf_data_qsw,n) = & TEMP_DATA(:,:,n,iblock,shf_data_qsw) end do end do !$OMP END PARALLEL DO call destroy_io_field(io_tstar) call destroy_io_field(io_tau) call destroy_io_field(io_ice) call destroy_io_field(io_qsw) case ('bulk-NCEP') io_sst = construct_io_field( & trim(shf_data_names(shf_data_sst)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_sst), & field_type = shf_bndy_type(shf_data_sst), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_sst)) io_tair = construct_io_field( & trim(shf_data_names(shf_data_tair)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_tair), & field_type = shf_bndy_type(shf_data_tair), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_tair)) io_qair = construct_io_field( & trim(shf_data_names(shf_data_qair)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_qair), & field_type = shf_bndy_type(shf_data_qair), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_qair)) io_qsw = construct_io_field( & trim(shf_data_names(shf_data_qsw)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_qsw), & field_type = shf_bndy_type(shf_data_qsw), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_qsw)) io_cldfrac = construct_io_field( & trim(shf_data_names(shf_data_cldfrac)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_cldfrac), & field_type = shf_bndy_type(shf_data_cldfrac), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_cldfrac)) io_windspd = construct_io_field( & trim(shf_data_names(shf_data_windspd)), & dim1=i_dim, dim2=j_dim, dim3=month_dim, & field_loc = shf_bndy_loc(shf_data_windspd), & field_type = shf_bndy_type(shf_data_windspd), & d3d_array=TEMP_DATA(:,:,:,:,shf_data_windspd)) call data_set(forcing_file, 'define', io_sst) call data_set(forcing_file, 'define', io_tair) call data_set(forcing_file, 'define', io_qair) call data_set(forcing_file, 'define', io_qsw) call data_set(forcing_file, 'define', io_cldfrac) call data_set(forcing_file, 'define', io_windspd) call data_set(forcing_file, 'read', io_sst) call data_set(forcing_file, 'read', io_tair) call data_set(forcing_file, 'read', io_qair) call data_set(forcing_file, 'read', io_qsw) call data_set(forcing_file, 'read', io_cldfrac) call data_set(forcing_file, 'read', io_windspd) !$OMP PARALLEL DO PRIVATE(iblock, n) do iblock=1,nblocks_clinic do n=1,12 SHF_DATA (:,:,iblock,shf_data_sst,n) = & TEMP_DATA(:,:,n,iblock,shf_data_sst) SHF_DATA (:,:,iblock,shf_data_tair,n) = & TEMP_DATA(:,:,n,iblock,shf_data_tair) SHF_DATA (:,:,iblock,shf_data_qair,n) = & TEMP_DATA(:,:,n,iblock,shf_data_qair) SHF_DATA (:,:,iblock,shf_data_qsw,n) = & TEMP_DATA(:,:,n,iblock,shf_data_qsw) SHF_DATA (:,:,iblock,shf_data_cldfrac,n) = & TEMP_DATA(:,:,n,iblock,shf_data_cldfrac) SHF_DATA (:,:,iblock,shf_data_windspd,n) = & TEMP_DATA(:,:,n,iblock,shf_data_windspd) end do end do !$OMP END PARALLEL DO call destroy_io_field(io_sst) call destroy_io_field(io_tair) call destroy_io_field(io_qair) call destroy_io_field(io_qsw) call destroy_io_field(io_cldfrac) call destroy_io_field(io_windspd) allocate( SHF_COMP(nx_block,ny_block,max_blocks_clinic, & shf_num_comps), & OCN_WGT(nx_block,ny_block,max_blocks_clinic)) SHF_COMP = c0 ! initialize end select deallocate(TEMP_DATA) call data_set(forcing_file,'close') call destroy_file(forcing_file) !*** renormalize values if necessary to compensate for different !*** units. do n = 1,shf_data_num_fields if (shf_data_renorm(n) /= c1) SHF_DATA(:,:,:,n,:) = & shf_data_renorm(n)*SHF_DATA(:,:,:,n,:) enddo if (my_task == master_task) then write(stdout,blank_fmt) write(stdout,'(a24,a)') ' SHF Monthly file read: ', & trim(shf_filename) endif !----------------------------------------------------------------------- ! ! surface temperature specified every n-hours, where the n-hour ! increment should be specified with namelist input ! (shf_data_inc). only as many times as are necessary based on ! the order of the temporal interpolation scheme ! (shf_interp_order) reside in memory at any given time. ! !----------------------------------------------------------------------- case ('n-hour') allocate(SHF_DATA(nx_block,ny_block,max_blocks_clinic, & shf_data_num_fields,0:shf_interp_order)) SHF_DATA = c0 call find_forcing_times(shf_data_time, shf_data_inc, & shf_interp_type, shf_data_next, & shf_data_time_min_loc, shf_data_update, & shf_data_type) do n = 1, shf_interp_order call get_forcing_filename(forcing_filename, shf_filename, & shf_data_time(n), shf_data_inc) forcing_file = construct_file(shf_file_fmt, & full_name=trim(forcing_filename), & record_length = rec_type_dbl, & recl_words = nx_global*ny_global) call data_set(forcing_file,'open_read') i_dim = construct_io_dim('i',nx_global) j_dim = construct_io_dim('j',ny_global) select case (shf_formulation) case ('restoring','partially-coupled') io_sst = construct_io_field( & trim(shf_data_names(shf_data_sst)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_sst), & field_type = shf_bndy_type(shf_data_sst), & d2d_array=SHF_DATA(:,:,:,shf_data_sst,n)) call data_set(forcing_file,'define',io_sst) call data_set(forcing_file,'read' ,io_sst) call destroy_io_field(io_sst) case ('Barnier-restoring') io_tstar = construct_io_field( & trim(shf_data_names(shf_data_tstar)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_tstar), & field_type = shf_bndy_type(shf_data_tstar), & d2d_array=SHF_DATA(:,:,:,shf_data_tstar,n)) io_tau = construct_io_field( & trim(shf_data_names(shf_data_tau)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_tau), & field_type = shf_bndy_type(shf_data_tau), & d2d_array=SHF_DATA(:,:,:,shf_data_tau ,n)) io_ice = construct_io_field( & trim(shf_data_names(shf_data_ice)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_ice), & field_type = shf_bndy_type(shf_data_ice), & d2d_array=SHF_DATA(:,:,:,shf_data_ice ,n)) io_qsw = construct_io_field( & trim(shf_data_names(shf_data_qsw)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_qsw), & field_type = shf_bndy_type(shf_data_qsw), & d2d_array=SHF_DATA(:,:,:,shf_data_qsw ,n)) call data_set(forcing_file,'define',io_tstar) call data_set(forcing_file,'define',io_tau) call data_set(forcing_file,'define',io_ice) call data_set(forcing_file,'define',io_qsw) call data_set(forcing_file,'read',io_tstar) call data_set(forcing_file,'read',io_tau) call data_set(forcing_file,'read',io_ice) call data_set(forcing_file,'read',io_qsw) call destroy_io_field(io_tstar) call destroy_io_field(io_tau) call destroy_io_field(io_ice) call destroy_io_field(io_qsw) SHF_DATA(:,:,:,shf_data_tau ,n) = & SHF_DATA(:,:,:,shf_data_tau ,n)*seconds_in_day case ('bulk-NCEP') io_sst = construct_io_field( & trim(shf_data_names(shf_data_sst)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_sst), & field_type = shf_bndy_type(shf_data_sst), & d2d_array=SHF_DATA(:,:,:,shf_data_sst,n)) io_tair = construct_io_field( & trim(shf_data_names(shf_data_tair)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_tair), & field_type = shf_bndy_type(shf_data_tair), & d2d_array=SHF_DATA(:,:,:,shf_data_tair,n)) io_qair = construct_io_field( & trim(shf_data_names(shf_data_qair)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_qair), & field_type = shf_bndy_type(shf_data_qair), & d2d_array=SHF_DATA(:,:,:,shf_data_qair,n)) io_qsw = construct_io_field( & trim(shf_data_names(shf_data_qsw)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_qsw), & field_type = shf_bndy_type(shf_data_qsw), & d2d_array=SHF_DATA(:,:,:,shf_data_qsw,n)) io_cldfrac = construct_io_field( & trim(shf_data_names(shf_data_cldfrac)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_cldfrac), & field_type = shf_bndy_type(shf_data_cldfrac), & d2d_array=SHF_DATA(:,:,:,shf_data_cldfrac,n)) io_windspd = construct_io_field( & trim(shf_data_names(shf_data_windspd)), & dim1=i_dim, dim2=j_dim, & field_loc = shf_bndy_loc(shf_data_windspd), & field_type = shf_bndy_type(shf_data_windspd), & d2d_array=SHF_DATA(:,:,:,shf_data_windspd,n)) call data_set(forcing_file, 'define', io_sst) call data_set(forcing_file, 'define', io_tair) call data_set(forcing_file, 'define', io_qair) call data_set(forcing_file, 'define', io_qsw) call data_set(forcing_file, 'define', io_cldfrac) call data_set(forcing_file, 'define', io_windspd) call data_set(forcing_file, 'read', io_sst) call data_set(forcing_file, 'read', io_tair) call data_set(forcing_file, 'read', io_qair) call data_set(forcing_file, 'read', io_qsw) call data_set(forcing_file, 'read', io_cldfrac) call data_set(forcing_file, 'read', io_windspd) call destroy_io_field(io_sst) call destroy_io_field(io_tair) call destroy_io_field(io_qair) call destroy_io_field(io_qsw) call destroy_io_field(io_cldfrac) call destroy_io_field(io_windspd) end select call data_set(forcing_file,'close') call destroy_file(forcing_file) if (my_task == master_task) then write(stdout,blank_fmt) write(stdout,'(a23,a)') ' SHF n-hour file read: ', & trim(forcing_filename) endif enddo if (shf_formulation == 'bulk-NCEP' .or. & shf_formulation == 'partially-coupled') then allocate(SHF_COMP(nx_block,ny_block,max_blocks_clinic, & shf_num_comps), & OCN_WGT(nx_block,ny_block,max_blocks_clinic)) SHF_COMP = c0 ! initialize endif !*** renormalize values if necessary to compensate for different !*** units. do n = 1,shf_data_num_fields if (shf_data_renorm(n) /= c1) SHF_DATA(:,:,:,n,:) = & shf_data_renorm(n)*SHF_DATA(:,:,:,n,:) enddo case default call exit_POP(sigAbort,'init_shf: Unknown value for shf_data_type') end select !----------------------------------------------------------------------- ! ! now check interpolation period (shf_interp_freq) to set the ! time for the next temporal interpolation (shf_interp_next). ! ! if no interpolation is to be done, set next interpolation time ! to a large number so the surface heat flux update test ! in routine set_surface_forcing will always be false. ! ! if interpolation is to be done every n-hours, find the first ! interpolation time greater than the current time. ! ! if interpolation is to be done every timestep, set next interpolation ! time to a large negative number so the surface heat flux ! update test in routine set_surface_forcing will always be true. ! !----------------------------------------------------------------------- select case (shf_interp_freq) case ('never') shf_interp_next = never shf_interp_last = never shf_interp_inc = c0 case ('n-hour') call find_interp_time(shf_interp_inc, shf_interp_next) case ('every-timestep') shf_interp_next = always shf_interp_inc = c0 case default call exit_POP(sigAbort, & 'init_shf: Unknown value for shf_interp_freq') end select if (nsteps_total == 0) shf_interp_last = thour00 !----------------------------------------------------------------------- ! ! echo forcing options to stdout. ! !----------------------------------------------------------------------- shf_data_label = 'Surface Heat Flux' call echo_forcing_options(shf_data_type, shf_formulation, & shf_data_inc, shf_interp_freq, & shf_interp_type, shf_interp_inc, & shf_data_label) !----------------------------------------------------------------------- !EOC call flushm (stdout) end subroutine init_shf !*********************************************************************** !BOP ! !IROUTINE: set_shf ! !INTERFACE: subroutine set_shf(STF) ! !DESCRIPTION: ! Updates the current value of the surface heat flux array ! (shf) by interpolating to the current time or calculating ! fluxes based on states at current time. If new data are ! required for interpolation, new data are read. ! ! !REVISION HISTORY: ! same as module ! !INPUT/OUTPUT PARAMETERS: real (r8), dimension(nx_block,ny_block,nt,max_blocks_clinic), & intent(inout) :: & STF ! surface tracer fluxes at current timestep !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & iblock !----------------------------------------------------------------------- ! ! check if new data is necessary for interpolation. if yes, then ! shuffle indices in SHF_DATA and shf_data_time arrays ! and read in new data if necessary ('n-hour' case). note ! that no new data is necessary for 'analytic' and 'annual' cases. ! then perform interpolation using updated shf data or compute fluxes ! based on current or interpolated state data. ! !----------------------------------------------------------------------- select case(shf_data_type) case ('analytic') select case (shf_formulation) case ('restoring') !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic STF(:,:,1,iblock) = (SHF_DATA(:,:,iblock,shf_data_sst,1) - & TRACER(:,:,1,1,curtime,iblock))* & shf_restore_rtau*dz(1) end do !$OMP END PARALLEL DO end select case ('annual') select case (shf_formulation) case ('restoring') !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic STF(:,:,1,iblock) = (SHF_DATA(:,:,iblock,shf_data_sst,1) - & TRACER(:,:,1,1,curtime,iblock))* & shf_restore_rtau*dz(1) end do !$OMP END PARALLEL DO case ('Barnier-restoring') call calc_shf_barnier_restoring(STF,1) case ('bulk-NCEP') call calc_shf_bulk_ncep(STF,1) case ('partially-coupled') call calc_shf_partially_coupled(1) end select case ('monthly-equal','monthly-calendar') shf_data_label = 'SHF Monthly' if (thour00 >= shf_data_update) then call update_forcing_data(shf_data_time, shf_data_time_min_loc,& shf_interp_type, shf_data_next, & shf_data_update, shf_data_type, & shf_data_inc, SHF_DATA(:,:,:,:,1:12),& shf_data_renorm, & shf_data_label, shf_data_names, & shf_bndy_loc, shf_bndy_type, & shf_filename, shf_file_fmt) endif if (thour00 >= shf_interp_next .or. nsteps_run == 0) then call interpolate_forcing(SHF_DATA(:,:,:,:,0), & SHF_DATA(:,:,:,:,1:12), & shf_data_time, shf_interp_type, & shf_data_time_min_loc, shf_interp_freq, & shf_interp_inc, shf_interp_next, & shf_interp_last, nsteps_run) if (nsteps_run /= 0) shf_interp_next = & shf_interp_next + shf_interp_inc endif select case (shf_formulation) case ('restoring') !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic STF(:,:,1,iblock) = (SHF_DATA(:,:,iblock,shf_data_sst,0) - & TRACER(:,:,1,1,curtime,iblock))* & shf_restore_rtau*dz(1) end do !$OMP END PARALLEL DO case ('Barnier-restoring') call calc_shf_barnier_restoring(STF,12) case ('bulk-NCEP') call calc_shf_bulk_ncep(STF,12) case ('partially-coupled') call calc_shf_partially_coupled(12) end select case('n-hour') shf_data_label = 'SHF n-hour' if (thour00 >= shf_data_update) then call update_forcing_data(shf_data_time, shf_data_time_min_loc,& shf_interp_type, shf_data_next, & shf_data_update, shf_data_type, & shf_data_inc, & SHF_DATA(:,:,:,:,1:shf_interp_order),& shf_data_renorm, & shf_data_label, shf_data_names, & shf_bndy_loc, shf_bndy_type, & shf_filename, shf_file_fmt) endif if (thour00 >= shf_interp_next .or. nsteps_run == 0) then call interpolate_forcing(SHF_DATA(:,:,:,:,0), & SHF_DATA(:,:,:,:,1:shf_interp_order), & shf_data_time, shf_interp_type, & shf_data_time_min_loc, shf_interp_freq, & shf_interp_inc, shf_interp_next, & shf_interp_last, nsteps_run) if (nsteps_run /= 0) shf_interp_next = & shf_interp_next + shf_interp_inc endif select case (shf_formulation) case ('restoring') !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic STF(:,:,1,iblock) = (SHF_DATA(:,:,iblock,shf_data_sst,0) - & TRACER(:,:,1,1,curtime,iblock))* & shf_restore_rtau*dz(1) end do !$OMP END PARALLEL DO case ('Barnier-restoring') call calc_shf_barnier_restoring(STF, shf_interp_order) case ('partially-coupled') call calc_shf_partially_coupled(shf_interp_order) case ('bulk-NCEP') call calc_shf_bulk_ncep(STF, shf_interp_order) end select end select ! shf_data_type !----------------------------------------------------------------------- !EOC end subroutine set_shf !*********************************************************************** !BOP ! !IROUTINE: calc_shf_barnier_restoring ! !INTERFACE: subroutine calc_shf_barnier_restoring(STF, time_dim) ! !DESCRIPTION: ! calculates surface heat fluxes ! ! !REVISION HISTORY: ! same as module ! !INPUT PARAMETERS: integer (int_kind), intent(in) :: & time_dim ! number of time points for interpolation ! !INPUT/OUTPUT PARAMETERS: real (r8), dimension(nx_block,ny_block,nt,max_blocks_clinic), & intent(inout) :: & STF ! surface heat flux at current timestep !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & nearest_data, now, &! indices for nearest,interpolated time slices iblock ! local address of current block real (r8) :: & tcheck, ice_cutoff, ice_restore_temp !----------------------------------------------------------------------- ! ! local parameters ! !----------------------------------------------------------------------- ice_cutoff = 0.9_r8 ice_restore_temp = -2.0_r8 !----------------------------------------------------------------------- ! ! if annual forcing, no interpolation to current time is necessary. ! otherwise, interpolated fields in index=0 slice of data array ! !----------------------------------------------------------------------- if (shf_data_type == 'annual') then now = 1 nearest_data = 1 else now = 0 !*** find nearest data time and use it for determining the ice !*** mask in place of interpolated field. !*** NOTE: this is for backward compatibility. perhaps !*** interpolating and using a cut-off of .45 would be acceptable. tcheck = (shf_data_update - thour00)/shf_data_inc select case(shf_interp_type) case ('nearest') nearest_data = shf_data_time_min_loc case ('linear') if (tcheck > 0.5) then nearest_data = shf_data_time_min_loc else nearest_data = shf_data_time_min_loc + 1 endif case ('4point') if (tcheck > 0.5) then nearest_data = shf_data_time_min_loc + 1 else nearest_data = shf_data_time_min_loc + 2 endif end select if ((nearest_data - time_dim) > 0 ) nearest_data = & nearest_data - time_dim endif !----------------------------------------------------------------------- ! ! calculate forcing for each block ! !----------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic !----------------------------------------------------------------------- ! ! check for ice concentration >= ice_cutoff in the nearest month. ! if there is ice, set TAU to be constant and set TSTAR to ! ice_restore_temp. ! !----------------------------------------------------------------------- where (SHF_DATA(:,:,iblock,shf_data_ice,nearest_data) >= & ice_cutoff) SHF_DATA(:,:,iblock,shf_data_tau,now) = shf_restore_tau SHF_DATA(:,:,iblock,shf_data_tstar,now) = ice_restore_temp endwhere !----------------------------------------------------------------------- ! ! apply restoring only where TAU is defined. ! !----------------------------------------------------------------------- where (SHF_DATA(:,:,iblock,shf_data_tau,now) > c0) STF(:,:,1,iblock) =(SHF_DATA(:,:,iblock,shf_data_tstar,now) - & TRACER(:,:,1,1,curtime,iblock))* & dz(1)/SHF_DATA(:,:,iblock,shf_data_tau,now) elsewhere STF(:,:,1,iblock) = c0 end where !----------------------------------------------------------------------- ! ! copy penetrative shortwave into its own array (SHF_QSW) and ! convert to T flux from W/m^2. ! !----------------------------------------------------------------------- SHF_QSW(:,:,iblock) = SHF_DATA(:,:,iblock,shf_data_qsw,now)* & hflux_factor SHF_QSW_RAW(:,:,iblock) = SHF_QSW(:,:,iblock) end do !$OMP END PARALLEL DO !----------------------------------------------------------------------- !EOC end subroutine calc_shf_barnier_restoring !*********************************************************************** !BOP ! !IROUTINE: calc_shf_bulk_ncep ! !INTERFACE: subroutine calc_shf_bulk_ncep(STF, time_dim) ! !DESCRIPTION: ! Calculates surface heat flux from a combination of ! air-sea fluxes (based on air temperature, specific humidity, ! solar short wave flux, cloud fraction, and windspeed) ! and restoring terms (due to restoring fields of SST). ! ! Notes: ! the forcing data (on t-grid) ! are computed as SHF\_DATA(:,:,shf\_comp\_*,now) where: ! ! shf\_data\_sst, restoring SST (C) ! shf\_data\_tair, surface air temp. at tair\_height (K) ! shf\_data\_qair, specific humidity at qair\_height (kg/kg) ! shf\_data\_qsw, surface short wave flux ($W/m^2$) ! shf\_data\_cldfrac, cloud fraction (0.-1.) ! shf\_data\_windspd , windspeed at height windspd\_height (m/s) ! ! !REVISION HISTORY: ! same as module ! !INPUT PARAMETERS: integer (int_kind), intent(in) :: & time_dim ! !INPUT/OUTPUT PARAMETERS: real (r8), dimension(nx_block,ny_block,nt,max_blocks_clinic), & intent(inout) :: & STF ! surface tracer fluxes at current timestep !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & n, now, k, & iblock ! local address of current block real (r8), dimension(nx_block,ny_block) :: & RTEA, &! work array FRAC_CLOUD_COVER ! fractional cloud cover real (r8), parameter :: & windspd_height = 10.0_r8, & tair_height = 2.0_r8, & qair_height = 2.0_r8, & qair_mod_fact = 0.94_r8, &! factor to modify humidity sw_mod_fact = 0.875_r8, &! factor to modify short-wave flux sw_mod_albedo = 0.93_r8 ! factor to modify albedo !----------------------------------------------------------------------- ! ! shf_weak_restore= weak(non-ice) restoring heatflux per degree (W/m2/C) ! shf_strong_restore= strong (ice) .. .. .. .. .. .. ! ! to calculate restoring factors, use mixed layer of 50m, ! and restoring time constant tau (days): ! ! Q (W/m2/C) ! tau = 6 : 386.0 ! tau = 30 : 77.2 ! tau = 182.5: 12.0 ! tau = 365 : 6.0 ! tau = 730 : 3.0 ! tau = Inf : 0.0 ! !--------------------------------------------------------------------- !----------------------------------------------------------------------- ! ! set location of interpolated data ! !----------------------------------------------------------------------- if (shf_data_type == 'annual') then now = 1 else now = 0 endif !---------------------------------------------------------------------- ! ! compute ocean weights (fraction of ocean vs. ice) every timestep ! !---------------------------------------------------------------------- call ocean_weights(now) !---------------------------------------------------------------------- ! ! do the rest of the computation for each block ! !---------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblock,FRAC_CLOUD_COVER,RTEA) do iblock=1,nblocks_clinic !---------------------------------------------------------------------- ! ! compute sensible and latent heat fluxes ! !---------------------------------------------------------------------- call sen_lat_flux( & SHF_DATA(:,:,iblock,shf_data_windspd,now), windspd_height, & TRACER(:,:,1,1,curtime,iblock), & SHF_DATA(:,:,iblock,shf_data_tair,now), tair_height, & SHF_DATA(:,:,iblock,shf_data_qair,now), qair_height, & T0_Kelvin, SHF_COMP(:,:,iblock,shf_comp_qsens), & SHF_COMP(:,:,iblock,shf_comp_qlat)) !---------------------------------------------------------------------- ! ! compute short wave and long wave fluxes ! !---------------------------------------------------------------------- SHF_COMP(:,:,iblock,shf_comp_qsw) = sw_mod_albedo*sw_mod_fact* & SHF_DATA(:,:,iblock,shf_data_qsw,now) FRAC_CLOUD_COVER = c1 - CCINT(:,:,iblock)* & SHF_DATA(:,:,iblock,shf_data_cldfrac,now)**2 RTEA = sqrt( c1000*SHF_DATA(:,:,iblock,shf_data_qair,now) & /(0.622_r8 + 0.378_r8 & *SHF_DATA(:,:,iblock,shf_data_qair,now)) + eps2 ) SHF_COMP(:,:,iblock,shf_comp_qlw) = -emissivity*stefan_boltzmann*& SHF_DATA(:,:,iblock,shf_data_tair,now)**3* & (SHF_DATA(:,:,iblock,shf_data_tair,now)* & (0.39_r8-0.05_r8*RTEA)*FRAC_CLOUD_COVER + & c4*(TRACER(:,:,1,1,curtime,iblock) + & T0_Kelvin - & SHF_DATA(:,:,iblock,shf_data_tair,now)) ) !---------------------------------------------------------------------- ! ! weak temperature restoring term (note: OCN_WGT = 0 at land pts) ! !---------------------------------------------------------------------- SHF_COMP(:,:,iblock,shf_comp_wrest) = shf_weak_restore* & MASK_SR(:,:,iblock)*OCN_WGT(:,:,iblock)* & (SHF_DATA(:,:,iblock,shf_data_sst,now) - & TRACER(:,:,1,1,curtime,iblock)) !---------------------------------------------------------------------- ! ! strong temperature restoring term ! !---------------------------------------------------------------------- where (KMT(:,:,iblock) > 0) SHF_COMP(:,:,iblock,shf_comp_srest) = shf_strong_restore* & (c1-OCN_WGT(:,:,iblock))* & (SHF_DATA(:,:,iblock,shf_data_sst,now) - & TRACER(:,:,1,1,curtime,iblock)) endwhere where (KMT(:,:,iblock) > 0 .and. MASK_SR(:,:,iblock) == 0) SHF_COMP(:,:,iblock,shf_comp_srest) = shf_strong_restore_ms* & (SHF_DATA(:,:,iblock,shf_data_sst,now) - & TRACER(:,:,1,1,curtime,iblock)) endwhere !---------------------------------------------------------------------- ! ! net surface heat flux (W/m^2) (except penetrative shortwave flux) ! convert to model units ! !---------------------------------------------------------------------- STF(:,:,1,iblock) = hflux_factor* & (OCN_WGT(:,:,iblock)*MASK_SR(:,:,iblock)* & (SHF_COMP(:,:,iblock,shf_comp_qsens) + & SHF_COMP(:,:,iblock,shf_comp_qlat ) + & SHF_COMP(:,:,iblock,shf_comp_qlw )) + & SHF_COMP(:,:,iblock,shf_comp_wrest) + & SHF_COMP(:,:,iblock,shf_comp_srest)) !---------------------------------------------------------------------- ! ! copy penetrative shortwave flux into its own array (SHF_QSW) and ! convert it and SHF to model units. ! !---------------------------------------------------------------------- SHF_QSW(:,:,iblock) = SHF_COMP(:,:,iblock,shf_comp_qsw)* & OCN_WGT(:,:,iblock)*MASK_SR(:,:,iblock)* & hflux_factor SHF_QSW_RAW(:,:,iblock) = SHF_COMP(:,:,iblock,shf_comp_qsw)* & hflux_factor end do !$OMP END PARALLEL DO !---------------------------------------------------------------------- !EOC end subroutine calc_shf_bulk_ncep !*********************************************************************** !BOP ! !IROUTINE: calc_shf_partially_coupled ! !INTERFACE: subroutine calc_shf_partially_coupled(time_dim) ! !DESCRIPTION: ! Calculates weak and strong restoring components of surface heat flux ! for partially-coupled formulation. These components will later be ! added to shf_comp_cpl component in set_coupled_forcing ! (forcing_coupled) to form the total surface heat flux. ! ! The only forcing dataset (on t-grid) is ! shf_data_sst, restoring SST ! ! ! !REVISION HISTORY: ! same as module ! !INPUT PARAMETERS: integer (int_kind), intent(in) :: & time_dim !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & n, now, k, & iblock ! local address of current block real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: & WORK1 ! work array !----------------------------------------------------------------------- ! ! set location of interpolated data ! !----------------------------------------------------------------------- if (shf_data_type == 'annual') then now = 1 else now = 0 endif !---------------------------------------------------------------------- ! ! compute ocean weights (fraction of ocean vs. ice) every timestep, ! if needed ! !---------------------------------------------------------------------- if ( .not. luse_cpl_ifrac ) then call ocean_weights (now) WORK1 = OCN_WGT*MASK_SR else WORK1 = MASK_SR endif !---------------------------------------------------------------------- ! ! do the rest of the computation for each block ! !---------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic !---------------------------------------------------------------------- ! ! weak temperature restoring term (note: MASK_SR = 0. at land and ! marginal sea points) ! note that weak restoring may be applied to every non-marginal-sea ! ocean point. ! !---------------------------------------------------------------------- SHF_COMP(:,:,iblock,shf_comp_wrest) = shf_weak_restore* & WORK1(:,:,iblock)* & (SHF_DATA(:,:,iblock,shf_data_sst,now) - & TRACER(:,:,1,1,curtime,iblock)) !---------------------------------------------------------------------- ! ! strong temperature restoring term ! note that strong restoring may be applied only in marginal seas. ! in under-ice regions, the ice formation term may replace the ! strong-restoring term. ! !---------------------------------------------------------------------- where (KMT(:,:,iblock) > 0) SHF_COMP(:,:,iblock,shf_comp_srest) = shf_strong_restore* & (c1-OCN_WGT(:,:,iblock))* & (SHF_DATA(:,:,iblock,shf_data_sst,now) - & TRACER(:,:,1,1,curtime,iblock)) endwhere where (KMT(:,:,iblock) > 0 .and. MASK_SR(:,:,iblock) == 0) SHF_COMP(:,:,iblock,shf_comp_srest) = shf_strong_restore_ms* & (SHF_DATA(:,:,iblock,shf_data_sst,now) - & TRACER(:,:,1,1,curtime,iblock)) endwhere !---------------------------------------------------------------------- ! ! convert to model units: (W/m^2) to (C*cm/s) ! !---------------------------------------------------------------------- SHF_COMP(:,:,iblock,shf_comp_wrest) = & SHF_COMP(:,:,iblock,shf_comp_wrest)*hflux_factor SHF_COMP(:,:,iblock,shf_comp_srest) = & SHF_COMP(:,:,iblock,shf_comp_srest)*hflux_factor end do !$OMP END PARALLEL DO !---------------------------------------------------------------------- !EOC end subroutine calc_shf_partially_coupled !*********************************************************************** !BOP ! !IROUTINE: sen_lat_flux ! !INTERFACE: subroutine sen_lat_flux(US,hu,SST,TH,ht,QH,hq,tk0,HS,HL) ! !DESCRIPTION: ! Computes latent and sensible heat fluxes following bulk formulae and ! coefficients in Large and Pond (1981; 1982) ! ! Assume 1) a neutral 10m drag coefficient = cdn = ! .0027/u10 + .000142 + .0000764 u10 ! 2) a neutral 10m stanton number ctn= .0327 sqrt(cdn), unstable ! ctn= .0180 sqrt(cdn), stable ! 3) a neutral 10m dalton number cen= .0346 sqrt(cdn) ! 4) the saturation humidity of air at t(k) = qsat(t) ($kg/m^3$) ! ! note 1) here, tstar = /u*, and qstar = /u*. ! 2) wind speedx should all be above a minimum speed say 0.5 m/s ! 3) with optional interation loop, niter=3, should suffice ! ! *** this version is for analyses inputs with hu = 10m and ht = hq ** ! *** also, SST enters in Celsius *************************** ! ! !REVISION HISTORY: ! same as module ! !INPUT PARAMETERS: real (r8), dimension (nx_block,ny_block), intent(in) :: & US, &! mean wind speed (m/s) at height hu (m) TH, &! mean air temperature (k) at height ht (m) QH, &! mean air humidity (kg/kg) at height hq (m) SST ! sea surface temperature (K) real (r8), intent(in) :: & hu, &! height (m) for mean wind speed ht, &! height (m) for mean air temperature hq, &! height (m) for mean air humidity tk0 ! Celsius zero point ! !OUTPUT PARAMETERS: real (r8), dimension (nx_block,ny_block), intent(out) :: & HS, &! sensible heat flux (w/m^2), into ocean HL ! latent heat flux (w/m^2), into ocean !EOP !BOC !-------------------------------------------------------------------------- ! ! local variables ! !-------------------------------------------------------------------------- real (r8), dimension (nx_block,ny_block) :: & SH,T0,DELP,DELQ,STABLETMP,RDN,RHN,USTARR,TSTARR,QSTARR,TAU, & HUOL,HTOL,HQOL,SSHUM,PSIMH,PSIXH,RD,UZN,RH,RE,QSAT real (r8) :: & ren,umin,zolmin,vonk,lapse_rate,gravity_mks,f1,refhgt,aln,czol !----------------------------------------------------------------------- ! ! constants ! !----------------------------------------------------------------------- umin = 0.5_r8 ! minimum wind speed zolmin = -100._r8 ! minimum stability parameter vonk = 0.4_r8 ! Von Karman''s constant lapse_rate = 0.01_r8 ! abiabatic lapse rate deg/m gravity_mks = grav/100.0_r8 ! gravity m/s/s f1 = 0.606_r8 refhgt = 10.0_r8 ! reference height aln = log(ht/refhgt) czol = hu*vonk*gravity_mks SH = max(US,umin) !----------------------------------------------------------------------- ! ! initial guess z/l=0.0; hu=ht=hq=z ! !----------------------------------------------------------------------- T0 = TH * (c1 + f1 * QH) ! virtual temperature (k) QSAT = 640380._r8 / exp(5107.4_r8/(SST+tk0)) SSHUM = 0.98_r8 * QSAT/rho_air ! sea surface humidity (kg/kg) DELP = TH + lapse_rate*ht - SST - tk0 ! pot temperature diff (k) DELQ = QH - SSHUM STABLETMP = 0.5_r8 + sign(0.5_r8 , DELP) RDN = sqrt(CDN(SH)) RHN = (c1-STABLETMP)* 0.0327_r8 + STABLETMP * 0.0180_r8 ren = 0.0346_r8 USTARR = RDN * SH TSTARR = RHN * DELP QSTARR = REN * DELQ !----------------------------------------------------------------------- ! ! first iteration loop ! !----------------------------------------------------------------------- HUOL = czol * (TSTARR/T0 + QSTARR/(c1/f1+QH)) / USTARR**2 HUOL = max(HUOL,zolmin) STABLETMP = 0.5_r8 + sign(0.5_r8 , HUOL) HTOL = HUOL * ht / hu HQOL = HUOL * hq / hu !----------------------------------------------------------------------- ! ! evaluate all stability functions assuming hq = ht ! !----------------------------------------------------------------------- SSHUM = max(sqrt(abs(c1 - 16._r8*HUOL)),c1) SSHUM = sqrt(SSHUM) PSIMH = -5._r8 * HUOL * STABLETMP + (c1-STABLETMP) & * log((c1+SSHUM*(c2+SSHUM))*(c1+SSHUM*SSHUM)/8._r8) & - c2*atan(SSHUM)+1.571_r8 SSHUM = max(sqrt(abs(c1 - 16._r8*HTOL)),c1) PSIXH = -5._r8*HTOL*STABLETMP + (c1-STABLETMP)*c2*log((c1+SSHUM)/c2) !----------------------------------------------------------------------- ! ! shift wind speed using old coefficient ! !----------------------------------------------------------------------- RD = RDN / (c1-RDN/vonk*PSIMH ) UZN = max(SH * RD / RDN , umin) !----------------------------------------------------------------------- ! ! update the transfer coefficients at 10 meters and neutral stability ! !----------------------------------------------------------------------- RDN = sqrt(CDN(UZN)) ren = 0.0346_r8 RHN = (c1-STABLETMP)*0.0327_r8 + STABLETMP *0.0180_r8 !----------------------------------------------------------------------- ! ! shift all coefficients to the measurement height and stability ! !----------------------------------------------------------------------- RD = RDN / (c1-RDN/vonk*PSIMH ) RH = RHN / (c1+RHN/vonk*( aln -PSIXH) ) RE = ren / (c1+ren/vonk*( aln -PSIXH) ) !----------------------------------------------------------------------- ! ! update USTARR, TSTARR, QSTARR using updated, shifted coefficients ! !----------------------------------------------------------------------- USTARR = RD * SH QSTARR = RE * DELQ TSTARR = RH * DELP !----------------------------------------------------------------------- ! ! second iteration to converge on z/l and hence the fluxes ! !----------------------------------------------------------------------- HUOL= czol * (TSTARR/T0+QSTARR/(c1/f1+QH)) / USTARR**2 HUOL= max(HUOL,zolmin) STABLETMP = 0.5_r8 + sign(0.5_r8 , HUOL) HTOL = HUOL * ht / hu HQOL = HUOL * hq / hu !----------------------------------------------------------------------- ! ! evaluate all stability functions assuming hq = ht ! !----------------------------------------------------------------------- SSHUM = max(sqrt(abs(c1 - 16.*HUOL)),c1) SSHUM = sqrt(SSHUM) PSIMH = -5._r8 * HUOL * STABLETMP + (c1-STABLETMP) & * log((c1+SSHUM*(c2+SSHUM))*(c1+SSHUM*SSHUM)/8._r8) & - c2*atan(SSHUM)+1.571_r8 SSHUM = max(sqrt(abs(c1 - 16._r8*HTOL)),c1) PSIXH = -5._r8*HTOL*STABLETMP + (c1-STABLETMP)*c2*log((c1+SSHUM)/c2) !----------------------------------------------------------------------- ! ! shift wind speed using old coefficient ! !----------------------------------------------------------------------- RD = RDN / (c1-RDN/vonk*PSIMH ) UZN = max(SH * RD / RDN , umin) !----------------------------------------------------------------------- ! ! update the transfer coefficients at 10 meters and neutral stability ! !----------------------------------------------------------------------- RDN = sqrt(CDN(UZN)) ren = 0.0346_r8 RHN = (c1-STABLETMP)*0.0327_r8 + STABLETMP*0.0180_r8 !----------------------------------------------------------------------- ! ! shift all coefficients to the measurement height and stability ! !----------------------------------------------------------------------- RD = RDN / (c1-RDN/vonk*PSIMH ) RH = RHN / (c1+RHN/vonk*( aln -PSIXH) ) RE = ren / (c1+ren/vonk*( aln -PSIXH) ) !----------------------------------------------------------------------- ! ! update USTARR, TSTARR, QSTARR using updated, shifted coefficients ! !----------------------------------------------------------------------- USTARR = RD * SH QSTARR = RE * DELQ TSTARR = RH * DELP !----------------------------------------------------------------------- ! ! done >>>> compute the fluxes ! !----------------------------------------------------------------------- TAU = rho_air * USTARR**2 TAU = TAU * US / SH HS = cp_air* TAU * TSTARR / USTARR HL = latent_heat_vapor_mks * TAU * QSTARR / USTARR !----------------------------------------------------------------------- !EOC end subroutine sen_lat_flux !*********************************************************************** !BOP ! !IROUTINE: CDN ! !INTERFACE: function CDN(UMPS) ! !DESCRIPTION: ! ! !REVISION HISTORY: ! same as module ! !INPUT PARAMETERS: real (r8), dimension(nx_block,ny_block), intent(in) :: & UMPS ! !OUTPUT PARAMETERS: real (r8), dimension(nx_block,ny_block) :: & CDN !EOP !BOC !----------------------------------------------------------------------- !----------------------------------------------------------------------- CDN = 0.0027_r8/UMPS + .000142_r8 + .0000764_r8*UMPS !----------------------------------------------------------------------- !EOC end function CDN !*********************************************************************** !BOP ! !IROUTINE: ocean_weights ! !INTERFACE: subroutine ocean_weights(now) ! !DESCRIPTION: ! Compute ocean weights (fraction of ocean vs. ice) every timestep ! ! !REVISION HISTORY: ! same as module ! !INPUT PARAMETERS: integer (int_kind), intent(in) :: & now !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & iblock !---------------------------------------------------------------------- ! ! compute ocean weights (fraction of ocean vs. ice) every timestep ! !---------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblock) do iblock=1,nblocks_clinic where (SHF_DATA(:,:,iblock,shf_data_sst,now) <= & T_strong_restore_limit) OCN_WGT(:,:,iblock) = c0 elsewhere OCN_WGT(:,:,iblock) =(SHF_DATA(:,:,iblock,shf_data_sst,now) - & T_strong_restore_limit)/dT_restore_limit endwhere where (SHF_DATA(:,:,iblock,shf_data_sst,now) >= & T_weak_restore_limit) OCN_WGT(:,:,iblock) = c1 !*** zero OCN_WGT at land pts where (KMT(:,:,iblock) == 0) OCN_WGT(:,:,iblock) = c0 end do !$OMP END PARALLEL DO !----------------------------------------------------------------------- !EOC end subroutine ocean_weights end module forcing_shf !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| CESM2.1.3_sourcemods/PaxHeaders.32795/forcing.F90-ORIG0000644000000000000000000000012413774500023016647 xustar0027 mtime=1609728019.290427 27 atime=1609728019.277662 30 ctime=1609728019.289922988 CESM2.1.3_sourcemods/forcing.F90-ORIG0000644006307300017500000005737113774500023017243 0ustar00islasncar00000000000000!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| module forcing !BOP ! !MODULE: forcing ! ! !DESCRIPTION: ! This is the main driver module for all surface and interior ! forcing. It contains necessary forcing fields as well as ! necessary routines for call proper initialization and ! update routines for those fields. ! ! !REVISION HISTORY: ! SVN:$Id$ ! ! !USES: use constants use blocks use distribution use domain use grid use ice, only: salice, tfreez, FW_FREEZE use forcing_ws use forcing_shf use forcing_sfwf use forcing_pt_interior use forcing_s_interior use forcing_ap use forcing_coupled, only: set_combined_forcing, tavg_coupled_forcing, & liceform, qsw_12hr_factor, qsw_distrb_iopt, qsw_distrb_iopt_cosz, & tday00_interval_beg, interval_cum_dayfrac, QSW_COSZ_WGHT_NORM, & QSW_COSZ_WGHT, compute_cosz use forcing_tools use passive_tracers, only: set_sflux_passive_tracers use prognostic use tavg use movie, only: define_movie_field, movie_requested, update_movie_field use time_management use exit_mod #ifdef CCSMCOUPLED use shr_sys_mod, only: shr_sys_abort #endif use running_mean_mod, only: running_mean_test_update_sflux_var !*** ccsm use sw_absorption, only: set_chl use registry use forcing_fields use mcog, only: mcog_nbins, QSW_BIN, QSW_RAW_BIN use estuary_vsf_mod, only:lvsf_river,MASK_ESTUARY,FLUX_ROFF_VSF_SRF use estuary_vsf_mod, only:vsf_river_correction implicit none private save ! !PUBLIC MEMBER FUNCTIONS: public :: init_forcing, & set_surface_forcing, & tavg_forcing, & movie_forcing !EOP !BOC integer (int_kind) :: & tavg_SHF, &! tavg_id for surface heat flux tavg_SHF_QSW, &! tavg_id for short-wave solar heat flux tavg_SFWF, &! tavg_id for surface freshwater flux tavg_SFWF_WRST, &! tavg_id for weak restoring freshwater flux tavg_TAUX, &! tavg_id for wind stress in X direction tavg_TAUX2, &! tavg_id for wind stress**2 in X direction tavg_TAUY, &! tavg_id for wind stress in Y direction tavg_TAUY2, &! tavg_id for wind stress**2 in Y direction tavg_FW, &! tavg_id for freshwater flux tavg_TFW_T, &! tavg_id for T flux due to freshwater flux tavg_TFW_S, &! tavg_id for S flux due to freshwater flux tavg_U10_SQR, &! tavg_id for U10_SQR 10m wind speed squared from cpl tavg_ATM_FINE_DUST_FLUX_CPL, &! tavg_id for ATM_FINE_DUST_FLUX from atm from cpl tavg_ATM_COARSE_DUST_FLUX_CPL, &! tavg_id for ATM_COARSE_DUST_FLUX from atm from cpl tavg_SEAICE_DUST_FLUX_CPL, &! tavg_id for SEAICE_DUST_FLUX from seaice from cpl tavg_ATM_BLACK_CARBON_FLUX_CPL, &! tavg_id for ATM_BLACK_CARBON_FLUX from atm from cpl tavg_SEAICE_BLACK_CARBON_FLUX_CPL ! tavg_id for SEAICE_BLACK_CARBON_FLUX from seaice from cpl !----------------------------------------------------------------------- ! ! movie ids ! !----------------------------------------------------------------------- integer (int_kind) :: & movie_SHF, &! movie id for surface heat flux movie_SFWF, &! movie id for surface freshwater flux movie_TAUX, &! movie id for wind stress in X direction movie_TAUY ! movie id for wind stress in Y direction !EOC !*********************************************************************** contains !*********************************************************************** !BOP ! !IROUTINE: init_forcing ! !INTERFACE: subroutine init_forcing ! !DESCRIPTION: ! Initializes forcing by calling a separate routines for ! wind stress, heat flux, fresh water flux, passive tracer flux, ! interior restoring, and atmospheric pressure. ! ! !REVISION HISTORY: ! same as module !----------------------------------------------------------------------- ! ! write out header for forcing options to stdout. ! !----------------------------------------------------------------------- if (my_task == master_task) then write(stdout,blank_fmt) write(stdout,ndelim_fmt) write(stdout,blank_fmt) write(stdout,'(a15)') 'Forcing options' write(stdout,blank_fmt) write(stdout,delim_fmt) endif !----------------------------------------------------------------------- ! ! initialize forcing arrays ! !----------------------------------------------------------------------- ATM_PRESS = c0 FW = c0 FW_OLD = c0 SMF = c0 SMFT = c0 STF = c0 STF_RIV = c0 TFW = c0 lhas_riv_flux = .false. !----------------------------------------------------------------------- ! ! call individual initialization routines ! !----------------------------------------------------------------------- call init_ws(SMF,SMFT,lsmft_avail) !*** NOTE: with bulk NCEP forcing init_shf must be called before !*** init_sfwf call init_shf (STF) call init_sfwf(STF) call init_pt_interior call init_s_interior call init_ap(ATM_PRESS) !----------------------------------------------------------------------- ! ! define tavg diagnostic fields ! !----------------------------------------------------------------------- call define_tavg_field(tavg_SHF, 'SHF', 2, & long_name='Total Surface Heat Flux, Including SW', & units='watt/m^2', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_SHF_QSW, 'SHF_QSW', 2, & long_name='Solar Short-Wave Heat Flux', & units='watt/m^2', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_SFWF,'SFWF',2, & long_name='Virtual Salt Flux in FW Flux formulation', & units='kg/m^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_SFWF_WRST,'SFWF_WRST',2, & long_name='Virtual Salt Flux due to weak restoring', & units='kg/m^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_TAUX,'TAUX',2, & long_name='Windstress in grid-x direction', & units='dyne/centimeter^2', grid_loc='2220', & coordinates='ULONG ULAT time') call define_tavg_field(tavg_TAUX2,'TAUX2',2, & long_name='Windstress**2 in grid-x direction', & units='dyne^2/centimeter^4', grid_loc='2220', & coordinates='ULONG ULAT time') call define_tavg_field(tavg_TAUY,'TAUY',2, & long_name='Windstress in grid-y direction', & units='dyne/centimeter^2', grid_loc='2220', & coordinates='ULONG ULAT time') call define_tavg_field(tavg_TAUY2,'TAUY2',2, & long_name='Windstress**2 in grid-y direction', & units='dyne^2/centimeter^4', grid_loc='2220', & coordinates='ULONG ULAT time') call define_tavg_field(tavg_FW,'FW',2, & long_name='Freshwater Flux', & units='centimeter/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_TFW_T,'TFW_T',2, & long_name='T flux due to freshwater flux', & units='watt/m^2', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_TFW_S,'TFW_S',2, & long_name='S flux due to freshwater flux (kg of salt/m^2/s)', & units='kg/m^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_U10_SQR,'U10_SQR',2, & long_name='10m wind speed squared', & units='cm^2/s^2', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_ATM_FINE_DUST_FLUX_CPL,'ATM_FINE_DUST_FLUX_CPL',2, & long_name='ATM_FINE_DUST_FLUX from cpl', & units='g/cm^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_ATM_COARSE_DUST_FLUX_CPL,'ATM_COARSE_DUST_FLUX_CPL',2, & long_name='ATM_COARSE_DUST_FLUX from cpl', & units='g/cm^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_SEAICE_DUST_FLUX_CPL,'SEAICE_DUST_FLUX_CPL',2, & long_name='SEAICE_DUST_FLUX from cpl', & units='g/cm^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_ATM_BLACK_CARBON_FLUX_CPL,'ATM_BLACK_CARBON_FLUX_CPL',2, & long_name='ATM_BLACK_CARBON_FLUX from cpl', & units='g/cm^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') call define_tavg_field(tavg_SEAICE_BLACK_CARBON_FLUX_CPL,'SEAICE_BLACK_CARBON_FLUX_CPL',2, & long_name='SEAICE_BLACK_CARBON_FLUX from cpl', & units='g/cm^2/s', grid_loc='2110', & coordinates='TLONG TLAT time') !----------------------------------------------------------------------- ! ! define movie diagnostic fields ! !----------------------------------------------------------------------- call define_movie_field(movie_SHF,'SHF',0, & long_name='Total Surface Heat Flux, Including SW', & units='watt/m^2', grid_loc='2110') call define_movie_field(movie_SFWF,'SFWF',0, & long_name='Virtual Salt Flux in FW Flux formulation', & units='kg/m^2/s', grid_loc='2110') call define_movie_field(movie_TAUX,'TAUX',0, & long_name='Windstress in grid-x direction', & units='dyne/centimeter^2', grid_loc='2220') call define_movie_field(movie_TAUY,'TAUY',0, & long_name='Windstress in grid-y direction', & units='dyne/centimeter^2', grid_loc='2220') !----------------------------------------------------------------------- !EOC end subroutine init_forcing !*********************************************************************** !BOP ! !IROUTINE: set_surface_forcing ! !INTERFACE: subroutine set_surface_forcing ! !DESCRIPTION: ! Calls surface forcing routines if necessary. ! If forcing does not depend on the ocean state, then update ! forcing if current time is greater than the appropriate ! interpolation time or if it is the first step. ! If forcing DOES depend on the ocean state, then call every ! timestep. interpolation check will be done within the set\_* ! routine. ! Interior restoring is assumed to take place every ! timestep and is set in subroutine tracer\_update, but ! updating the data fields must occur here outside ! any block loops. ! ! !REVISION HISTORY: ! same as module !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: & TFRZ integer (int_kind) :: index_qsw, iblock, nbin real (r8) :: & cosz_day, & qsw_eps #ifdef _HIRES qsw_eps = -1.e-3_r8 #else qsw_eps = c0 #endif !----------------------------------------------------------------------- ! ! Get any interior restoring data and interpolate if necessary. ! !----------------------------------------------------------------------- call get_pt_interior_data call get_s_interior_data !----------------------------------------------------------------------- ! ! Call individual forcing update routines. ! !----------------------------------------------------------------------- if (lsmft_avail) then call set_ws(SMF,SMFT=SMFT) else call set_ws(SMF) endif !*** NOTE: with bulk NCEP and partially-coupled forcing !*** set_shf must be called before set_sfwf call set_shf(STF) call set_sfwf(STF,FW,TFW) if ( shf_formulation == 'partially-coupled' .or. & sfwf_formulation == 'partially-coupled' ) then call set_combined_forcing(STF,FW,TFW) endif !----------------------------------------------------------------------- ! ! apply qsw 12hr if chosen ! !----------------------------------------------------------------------- index_qsw = mod(nsteps_this_interval,nsteps_per_interval) + 1 if ( qsw_distrb_iopt == qsw_distrb_iopt_cosz ) then cosz_day = tday00_interval_beg + interval_cum_dayfrac(index_qsw-1) & - interval_cum_dayfrac(nsteps_per_interval) !$OMP PARALLEL DO PRIVATE(iblock,nbin) do iblock = 1, nblocks_clinic call compute_cosz(cosz_day, iblock, QSW_COSZ_WGHT(:,:,iblock)) where (QSW_COSZ_WGHT_NORM(:,:,iblock) > c0) QSW_COSZ_WGHT(:,:,iblock) = QSW_COSZ_WGHT(:,:,iblock) & * QSW_COSZ_WGHT_NORM(:,:,iblock) elsewhere QSW_COSZ_WGHT(:,:,iblock) = c1 endwhere SHF_QSW(:,:,iblock) = QSW_COSZ_WGHT(:,:,iblock) & * SHF_COMP(:,:,iblock,shf_comp_qsw) do nbin = 1, mcog_nbins QSW_BIN(:,:,nbin,iblock) = QSW_COSZ_WGHT(:,:,iblock) * QSW_RAW_BIN(:,:,nbin,iblock) enddo enddo !$OMP END PARALLEL DO else if (registry_match('lcoupled')) then SHF_QSW = qsw_12hr_factor(index_qsw)*SHF_COMP(:,:,:,shf_comp_qsw) endif QSW_BIN(:,:,:,:) = qsw_12hr_factor(index_qsw) * QSW_RAW_BIN(:,:,:,:) endif if ( registry_match('lcoupled') & .and. sfwf_formulation /= 'partially-coupled' & .and. sfc_layer_type == sfc_layer_varthick .and. & .not. lfw_as_salt_flx .and. liceform ) then FW = SFWF_COMP(:,:,:, sfwf_comp_cpl) TFW = TFW_COMP(:,:,:,:, tfw_comp_cpl) endif if ( sfc_layer_type == sfc_layer_varthick .and. & .not. lfw_as_salt_flx .and. liceform ) then FW = FW + FW_FREEZE !$OMP PARALLEL DO PRIVATE(iblock) do iblock = 1, nblocks_clinic call tfreez(TFRZ(:,:,iblock), TRACER(:,:,1,2,curtime,iblock)) enddo !$OMP END PARALLEL DO TFW(:,:,1,:) = TFW(:,:,1,:) + FW_FREEZE(:,:,:)*TFRZ(:,:,:) TFW(:,:,2,:) = TFW(:,:,2,:) + FW_FREEZE(:,:,:)*salice endif call set_ap(ATM_PRESS) if (nt > 2) then call set_sflux_passive_tracers(U10_SQR,IFRAC,ATM_PRESS,ATM_FINE_DUST_FLUX,ATM_COARSE_DUST_FLUX,SEAICE_DUST_FLUX, & ATM_BLACK_CARBON_FLUX,SEAICE_BLACK_CARBON_FLUX, & lvsf_river,MASK_ESTUARY,vsf_river_correction,STF,STF_RIV) endif ! running_mean_test_update_sflux_var is only necessary for test mode call running_mean_test_update_sflux_var call set_chl #ifdef CCSMCOUPLED if (ANY(SHF_QSW < qsw_eps)) then call shr_sys_abort('(set_surface_forcing) ERROR: SHF_QSW < qsw_eps in set_surface_forcing') endif #endif !----------------------------------------------------------------------- !EOC end subroutine set_surface_forcing !*********************************************************************** !BOP ! !IROUTINE: tavg_forcing ! !INTERFACE: subroutine tavg_forcing ! !DESCRIPTION: ! This routine accumulates tavg diagnostics related to surface ! forcing. ! ! !REVISION HISTORY: ! same as module !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & iblock ! block loop index type (block) :: & this_block ! block information for current block real (r8), dimension(nx_block,ny_block) :: & WORK ! local temp space for tavg diagnostics !----------------------------------------------------------------------- ! ! compute and accumulate tavg forcing diagnostics ! !----------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblock,this_block,WORK) do iblock = 1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) if (accumulate_tavg_now(tavg_SHF)) then where (KMT(:,:,iblock) > 0) WORK = (STF(:,:,1,iblock)+SHF_QSW(:,:,iblock))/ & hflux_factor ! W/m^2 elsewhere WORK = c0 end where call accumulate_tavg_field(WORK,tavg_SHF,iblock,1) endif if (accumulate_tavg_now(tavg_SHF_QSW)) then where (KMT(:,:,iblock) > 0) WORK = SHF_QSW(:,:,iblock)/hflux_factor ! W/m^2 elsewhere WORK = c0 end where call accumulate_tavg_field(WORK,tavg_SHF_QSW,iblock,1) endif if (accumulate_tavg_now(tavg_SFWF)) then if (sfc_layer_type == sfc_layer_varthick .and. & .not. lfw_as_salt_flx) then where (KMT(:,:,iblock) > 0) WORK = FW(:,:,iblock)*seconds_in_year*mpercm ! m/yr elsewhere WORK = c0 end where else if ( lvsf_river ) then ! ROFF_F should be included in the SFWF term in the open ocean ! ROFF_F in the Marginal Seas is already included in STF(:,:,2,iblock) where (KMT(:,:,iblock) > 0) ! convert to kg(freshwater)/m^2/s WORK =STF(:,:,2,iblock)/salinity_factor& -MASK_ESTUARY(:,:,iblock)*FLUX_ROFF_VSF_SRF(:,:,2,iblock)/salinity_factor elsewhere WORK = c0 end where else where (KMT(:,:,iblock) > 0) ! convert to kg(freshwater)/m^2/s WORK = STF(:,:,2,iblock)/salinity_factor elsewhere WORK = c0 end where endif endif call accumulate_tavg_field(WORK,tavg_SFWF,iblock,1) endif if (accumulate_tavg_now(tavg_SFWF_WRST)) then if ( sfwf_formulation == 'partially-coupled' ) then where (KMT(:,:,iblock) > 0) ! convert to kg(freshwater)/m^2/s WORK = SFWF_COMP(:,:,iblock,sfwf_comp_wrest)/salinity_factor elsewhere WORK = c0 end where else WORK = c0 endif call accumulate_tavg_field(WORK,tavg_SFWF_WRST,iblock,1) endif call accumulate_tavg_field(SMF(:,:,1,iblock), tavg_TAUX,iblock,1) call accumulate_tavg_field(SMF(:,:,1,iblock)**2, tavg_TAUX2,iblock,1) call accumulate_tavg_field(SMF(:,:,2,iblock), tavg_TAUY,iblock,1) call accumulate_tavg_field(SMF(:,:,2,iblock)**2, tavg_TAUY2,iblock,1) call accumulate_tavg_field(FW (:,:,iblock), tavg_FW,iblock,1) call accumulate_tavg_field(TFW(:,:,1,iblock)/hflux_factor, tavg_TFW_T,iblock,1) call accumulate_tavg_field(TFW(:,:,2,iblock)*rho_sw*c10, tavg_TFW_S,iblock,1) call accumulate_tavg_field(U10_SQR(:,:,iblock), tavg_U10_SQR,iblock,1) call accumulate_tavg_field(ATM_FINE_DUST_FLUX(:,:,iblock), tavg_ATM_FINE_DUST_FLUX_CPL,iblock,1) call accumulate_tavg_field(ATM_COARSE_DUST_FLUX(:,:,iblock), tavg_ATM_COARSE_DUST_FLUX_CPL,iblock,1) call accumulate_tavg_field(SEAICE_DUST_FLUX(:,:,iblock), tavg_SEAICE_DUST_FLUX_CPL,iblock,1) call accumulate_tavg_field(ATM_BLACK_CARBON_FLUX(:,:,iblock), tavg_ATM_BLACK_CARBON_FLUX_CPL,iblock,1) call accumulate_tavg_field(SEAICE_BLACK_CARBON_FLUX(:,:,iblock), tavg_SEAICE_BLACK_CARBON_FLUX_CPL,iblock,1) end do !$OMP END PARALLEL DO if (registry_match('lcoupled')) call tavg_coupled_forcing !----------------------------------------------------------------------- !EOC end subroutine tavg_forcing !*********************************************************************** !BOP ! !IROUTINE: movie_forcing ! !INTERFACE: subroutine movie_forcing ! !DESCRIPTION: ! This routine accumulates movie diagnostics related to surface ! forcing. ! ! !REVISION HISTORY: ! same as module !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & iblock ! block loop index type (block) :: & this_block ! block information for current block real (r8), dimension(nx_block,ny_block) :: & WORK ! local temp space for movie diagnostics !----------------------------------------------------------------------- ! ! compute and dump movie forcing diagnostics ! !----------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblock,this_block,WORK) do iblock = 1,nblocks_clinic this_block = get_block(blocks_clinic(iblock),iblock) !----------------------------------------------------------------------- ! ! dump movie diagnostics if requested ! !----------------------------------------------------------------------- if (movie_requested(movie_SHF) ) then where (KMT(:,:,iblock) > 0) WORK = (STF(:,:,1,iblock)+SHF_QSW(:,:,iblock))/ & hflux_factor ! W/m^2 elsewhere WORK = c0 end where call update_movie_field(WORK, movie_SHF, iblock, 1) endif if (movie_requested(movie_SFWF) ) then if (sfc_layer_type == sfc_layer_varthick .and. & .not. lfw_as_salt_flx) then where (KMT(:,:,iblock) > 0) WORK = FW(:,:,iblock)*seconds_in_year*mpercm ! m/yr elsewhere WORK = c0 end where else where (KMT(:,:,iblock) > 0) ! convert to kg(freshwater)/m^2/s WORK = STF(:,:,2,iblock)/salinity_factor elsewhere WORK = c0 end where endif call update_movie_field(WORK, movie_SFWF, iblock, 1) endif if (movie_requested(movie_TAUX) ) then call update_movie_field(SMF(:,:,1,iblock), & movie_TAUX,iblock,1) endif if (movie_requested(movie_TAUY) ) then call update_movie_field(SMF(:,:,2,iblock), & movie_TAUY,iblock,1) endif end do !$OMP END PARALLEL DO !----------------------------------------------------------------------- !EOC end subroutine movie_forcing !*********************************************************************** end module forcing !|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||