From ee4bea5cc69d366562e7b5f19b861bfed9ec4e4f Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Wed, 8 Mar 2017 15:43:27 -0700 Subject: [PATCH 01/91] Divergence constraint capability from Xiaowen Tang of Nanjing University, China modified: Registry/registry.var modified: var/build/depend.txt modified: var/da/da_define_structures/da_define_structures.f90 new file: var/da/da_dynamics/da_divergence_constraint.inc new file: var/da/da_dynamics/da_divergence_constraint_adj.inc modified: var/da/da_dynamics/da_dynamics.f90 modified: var/da/da_minimisation/da_calculate_gradj.inc modified: var/da/da_minimisation/da_calculate_j.inc modified: var/da/da_minimisation/da_get_var_diagnostics.inc modified: var/da/da_minimisation/da_minimisation.f90 modified: var/da/da_test/da_check.inc new file: var/da/da_test/da_check_dynamics_adjoint.inc modified: var/da/da_test/da_test.f90 --- Registry/registry.var | 2 + var/build/depend.txt | 4 +- .../da_define_structures.f90 | 1 + .../da_dynamics/da_divergence_constraint.inc | 130 +++++++++ .../da_divergence_constraint_adj.inc | 159 +++++++++++ var/da/da_dynamics/da_dynamics.f90 | 2 + var/da/da_minimisation/da_calculate_gradj.inc | 37 ++- var/da/da_minimisation/da_calculate_j.inc | 36 ++- .../da_get_var_diagnostics.inc | 1 + var/da/da_minimisation/da_minimisation.f90 | 5 +- var/da/da_test/da_check.inc | 8 + var/da/da_test/da_check_dynamics_adjoint.inc | 262 ++++++++++++++++++ var/da/da_test/da_test.f90 | 4 +- 13 files changed, 637 insertions(+), 14 deletions(-) create mode 100644 var/da/da_dynamics/da_divergence_constraint.inc create mode 100644 var/da/da_dynamics/da_divergence_constraint_adj.inc create mode 100644 var/da/da_test/da_check_dynamics_adjoint.inc diff --git a/Registry/registry.var b/Registry/registry.var index a32e861706..f48bfa95d2 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -334,6 +334,8 @@ rconfig logical calculate_cg_cost_fn namelist,wrfvar11 1 .false. - "ca rconfig logical write_detail_grad_fn namelist,wrfvar11 1 .false. - "write_detail_grad_fn" "calculate and write out gradient of each iteration in grad_fn" "" rconfig logical lat_stats_option namelist,wrfvar11 1 .false. - "lat_stats_option" "" "" rconfig integer interp_option namelist,wrfvar11 1 1 - "interp_option" "" "" +rconfig logical use_divc namelist,wrfvar12 1 .false. - "use_divc" "switch for divergence constraint" "" +rconfig real divc_factor namelist,wrfvar12 1 1000. - "divc_factor" "" "" rconfig integer balance_type namelist,wrfvar12 1 3 - "balance_type" "" "For use_wpec: 1 = geostrophic; 2 = cyclostrophic; 3 = both" rconfig logical use_wpec namelist,wrfvar12 1 .false. - "use_wpec" "" "" rconfig real wpec_factor namelist,wrfvar12 1 0.001 - "wpec_factor" "" "Inverse of WPEC gamma factor" diff --git a/var/build/depend.txt b/var/build/depend.txt index 6e0c66fb02..626a9480fe 100644 --- a/var/build/depend.txt +++ b/var/build/depend.txt @@ -112,7 +112,7 @@ da_buoy.o : da_buoy.f90 da_calculate_grady_buoy.inc da_get_innov_vector_buoy.inc da_control.o : da_control.f90 module_driver_constants.o da_crtm.o : da_crtm.f90 da_det_crtm_climat.inc da_crtm_sensor_descriptor.inc da_crtm_init.inc da_crtm_ad.inc da_crtm_direct.inc da_crtm_k.inc da_crtm_tl.inc da_get_innov_vector_crtm.inc da_transform_xtoy_crtm_adj.inc da_transform_xtoy_crtm.inc da_tracing.o da_tools.o da_tools_serial.o da_reporting.o da_radiance1.o module_dm.o da_interpolation.o da_control.o module_radiance.o da_define_structures.o module_domain.o da_define_structures.o : da_define_structures.f90 da_gauss_noise.inc da_random_seed.inc da_initialize_cv.inc da_zero_vp_type.inc da_zero_y.inc da_zero_x.inc da_deallocate_y.inc da_deallocate_observations.inc da_deallocate_background_errors.inc da_allocate_y.inc da_allocate_observations.inc da_allocate_background_errors.inc da_wavelet.o da_reporting.o da_tools_serial.o da_tracing.o da_control.o module_domain.o da_allocate_y_rain.inc da_allocate_y_radar.inc da_allocate_observations_rain.inc da_allocate_obs_info.inc -da_dynamics.o : da_dynamics.f90 da_wz_base.inc da_uv_to_vorticity.inc da_w_adjustment_adj.inc da_w_adjustment_lin.inc da_uv_to_divergence_adj.inc da_uv_to_divergence.inc da_psichi_to_uv_adj.inc da_psichi_to_uv.inc da_hydrostaticp_to_rho_lin.inc da_hydrostaticp_to_rho_adj.inc da_balance_geoterm_lin.inc da_balance_geoterm_adj.inc da_balance_equation_lin.inc da_balance_equation_adj.inc da_balance_cycloterm_lin.inc da_balance_cycloterm_adj.inc da_balance_cycloterm.inc da_wpec_constraint.inc da_wpec_constraint_adj.inc da_wpec_constraint_cycloterm.inc da_wpec_constraint_geoterm.inc da_wpec_constraint_lin.inc da_tools.o da_tracing.o da_ffts.o da_reporting.o da_define_structures.o module_comm_dm.o module_dm.o module_domain.o da_control.o +da_dynamics.o : da_dynamics.f90 da_wz_base.inc da_uv_to_vorticity.inc da_w_adjustment_adj.inc da_w_adjustment_lin.inc da_uv_to_divergence_adj.inc da_uv_to_divergence.inc da_psichi_to_uv_adj.inc da_psichi_to_uv.inc da_hydrostaticp_to_rho_lin.inc da_hydrostaticp_to_rho_adj.inc da_balance_geoterm_lin.inc da_balance_geoterm_adj.inc da_balance_equation_lin.inc da_balance_equation_adj.inc da_balance_cycloterm_lin.inc da_balance_cycloterm_adj.inc da_balance_cycloterm.inc da_wpec_constraint.inc da_wpec_constraint_adj.inc da_wpec_constraint_cycloterm.inc da_wpec_constraint_geoterm.inc da_wpec_constraint_lin.inc da_tools.o da_tracing.o da_ffts.o da_reporting.o da_define_structures.o module_comm_dm.o module_dm.o module_domain.o da_control.o da_divergence_constraint.inc da_divergence_constraint_adj.inc da_etkf.o : da_etkf.f90 da_solve_etkf.inc da_matmultiover.inc da_matmulti.inc da_innerprod.inc da_lapack.o da_gen_be.o da_control.o da_ffts.o : da_ffts.f90 da_solve_poissoneqn_fst_adj.inc da_solve_poissoneqn_fst.inc da_solve_poissoneqn_fct_adj.inc da_solve_poissoneqn_fct.inc module_ffts.o module_comm_dm.o module_dm.o da_wrf_interfaces.o da_tracing.o da_par_util.o da_define_structures.o da_control.o module_domain.o da_gen_be.o : da_gen_be.f90 da_recursive_filter_1d.inc da_perform_2drf.inc da_eof_decomposition_test.inc da_eof_decomposition.inc da_transform_vptovv.inc da_stage0_initialize.inc da_readwrite_be_stage4.inc da_readwrite_be_stage3.inc da_readwrite_be_stage2.inc da_readwrite_be_stage1.inc da_print_be_stats_v.inc da_print_be_stats_p.inc da_print_be_stats_h_regional.inc da_print_be_stats_h_global.inc da_get_trh.inc da_get_height.inc da_get_field.inc da_filter_regcoeffs.inc da_create_bins.inc da_wavelet.o da_lapack.o da_tools_serial.o da_reporting.o da_control.o @@ -160,7 +160,7 @@ da_ssmi.o : da_ssmi.f90 da_sigma_v_tl.inc da_epsalt_tl.inc da_effang_tl.inc da_s da_statistics.o : da_statistics.f90 da_print_qcstat.inc da_stats_calculate.inc da_data_distribution.inc da_correlation_coeff2d.inc da_correlation_coeff1d.inc da_maxmin_in_field.inc da_analysis_stats.inc da_reporting.o da_tools_serial.o da_tracing.o da_par_util.o da_par_util1.o da_define_structures.o da_control.o module_domain.o da_synop.o : da_synop.f90 da_check_buddy_synop.inc da_calculate_grady_synop.inc da_check_max_iv_synop.inc da_get_innov_vector_synop.inc da_transform_xtoy_synop_adj.inc da_transform_xtoy_synop.inc da_print_stats_synop.inc da_oi_stats_synop.inc da_residual_synop.inc da_jo_synop_uvtq.inc da_jo_and_grady_synop.inc da_ao_stats_synop.inc da_tracing.o da_tools.o da_statistics.o da_physics.o da_grid_definitions.o da_par_util.o da_par_util1.o da_interpolation.o da_define_structures.o da_control.o module_domain.o da_tamdar.o : da_tamdar.f90 da_calculate_grady_tamdar_sfc.inc da_check_max_iv_tamdar_sfc.inc da_get_innov_vector_tamdar_sfc.inc da_transform_xtoy_tamdar_sfc_adj.inc da_transform_xtoy_tamdar_sfc.inc da_print_stats_tamdar_sfc.inc da_oi_stats_tamdar_sfc.inc da_residual_tamdar_sfc.inc da_jo_tamdar_sfc_uvtq.inc da_jo_and_grady_tamdar_sfc.inc da_ao_stats_tamdar_sfc.inc da_calculate_grady_tamdar.inc da_get_innov_vector_tamdar.inc da_check_max_iv_tamdar.inc da_transform_xtoy_tamdar_adj.inc da_transform_xtoy_tamdar.inc da_print_stats_tamdar.inc da_oi_stats_tamdar.inc da_residual_tamdar.inc da_jo_tamdar_uvtq.inc da_jo_and_grady_tamdar.inc da_ao_stats_tamdar.inc da_tracing.o da_physics.o da_grid_definitions.o da_par_util1.o da_par_util.o da_tools.o da_statistics.o da_interpolation.o module_domain.o da_define_structures.o da_control.o -da_test.o : da_test.f90 da_test_vxtransform.inc da_check_gradient.inc da_get_y_lhs_value.inc da_check_vtoy_adjoint.inc da_set_tst_trnsf_fld.inc da_check_psfc.inc da_check_sfc_assi.inc da_setup_testfield.inc da_check_xtoy_adjoint_buoy.inc da_check_xtoy_adjoint_profiler.inc da_check_xtoy_adjoint_ssmt2.inc da_check_xtoy_adjoint_ssmt1.inc da_check_xtoy_adjoint_qscat.inc da_check_xtoy_adjoint_pseudo.inc da_dot_cv.inc da_dot.inc da_check.inc da_check_gradient.inc da_transform_xtovp.inc da_check_xtoy_adjoint_rad.inc da_check_xtoy_adjoint_synop.inc da_check_xtoy_adjoint_tamdar_sfc.inc da_check_xtoy_adjoint_tamdar.inc da_check_xtoy_adjoint_mtgirs.inc da_check_xtoy_adjoint_sonde_sfc.inc da_check_xtoy_adjoint_sound.inc da_check_xtoy_adjoint_bogus.inc da_check_xtoy_adjoint_rain.inc da_check_xtoy_adjoint_radar.inc da_check_xtoy_adjoint_ships.inc da_check_xtoy_adjoint_polaramv.inc da_check_xtoy_adjoint_geoamv.inc da_check_xtoy_adjoint_satem.inc da_check_xtoy_adjoint_ssmi_tb.inc da_check_xtoy_adjoint_ssmi_rv.inc da_check_xtoy_adjoint_pilot.inc da_check_xtoy_adjoint_metar.inc da_check_xtoy_adjoint_gpsref.inc da_check_xtoy_adjoint_gpspw.inc da_check_xtoy_adjoint_airep.inc da_check_xtoy_adjoint.inc da_check_xtovptox_errors.inc da_check_vvtovp_adjoint.inc da_check_vp_errors.inc da_check_vptox_adjoint.inc da_check_vtox_adjoint.inc da_check_cvtovv_adjoint.inc da_check_balance.inc da_4dvar.o da_vtox_transforms.o da_wrfvar_io.o da_wrf_interfaces.o da_transfer_model.o da_tracing.o da_tools_serial.o da_statistics.o da_ssmi.o da_spectral.o da_reporting.o da_physics.o da_par_util1.o da_par_util.o da_obs.o da_minimisation.o da_ffts.o da_dynamics.o da_define_structures.o module_state_description.o module_domain.o da_control.o module_comm_dm.o module_dm.o module_configure.o da_rain.o +da_test.o : da_test.f90 da_test_vxtransform.inc da_check_gradient.inc da_get_y_lhs_value.inc da_check_vtoy_adjoint.inc da_set_tst_trnsf_fld.inc da_check_psfc.inc da_check_sfc_assi.inc da_setup_testfield.inc da_check_xtoy_adjoint_buoy.inc da_check_xtoy_adjoint_profiler.inc da_check_xtoy_adjoint_ssmt2.inc da_check_xtoy_adjoint_ssmt1.inc da_check_xtoy_adjoint_qscat.inc da_check_xtoy_adjoint_pseudo.inc da_dot_cv.inc da_dot.inc da_check.inc da_check_gradient.inc da_transform_xtovp.inc da_check_xtoy_adjoint_rad.inc da_check_xtoy_adjoint_synop.inc da_check_xtoy_adjoint_tamdar_sfc.inc da_check_xtoy_adjoint_tamdar.inc da_check_xtoy_adjoint_mtgirs.inc da_check_xtoy_adjoint_sonde_sfc.inc da_check_xtoy_adjoint_sound.inc da_check_xtoy_adjoint_bogus.inc da_check_xtoy_adjoint_rain.inc da_check_xtoy_adjoint_radar.inc da_check_xtoy_adjoint_ships.inc da_check_xtoy_adjoint_polaramv.inc da_check_xtoy_adjoint_geoamv.inc da_check_xtoy_adjoint_satem.inc da_check_xtoy_adjoint_ssmi_tb.inc da_check_xtoy_adjoint_ssmi_rv.inc da_check_xtoy_adjoint_pilot.inc da_check_xtoy_adjoint_metar.inc da_check_xtoy_adjoint_gpsref.inc da_check_xtoy_adjoint_gpspw.inc da_check_xtoy_adjoint_airep.inc da_check_xtoy_adjoint.inc da_check_xtovptox_errors.inc da_check_vvtovp_adjoint.inc da_check_vp_errors.inc da_check_vptox_adjoint.inc da_check_vtox_adjoint.inc da_check_cvtovv_adjoint.inc da_check_balance.inc da_4dvar.o da_vtox_transforms.o da_wrfvar_io.o da_wrf_interfaces.o da_transfer_model.o da_tracing.o da_tools_serial.o da_statistics.o da_ssmi.o da_spectral.o da_reporting.o da_physics.o da_par_util1.o da_par_util.o da_obs.o da_minimisation.o da_ffts.o da_dynamics.o da_define_structures.o module_state_description.o module_domain.o da_control.o module_comm_dm.o module_dm.o module_configure.o da_rain.o da_check_dynamics_adjoint.inc da_tools.o : da_tools.f90 da_geo2msl1.inc da_msl2geo1.inc da_get_time_slots.inc da_get_julian_time.inc da_get_print_lvl.inc da_get_3d_sum.inc da_get_2d_sum.inc da_set_boundary_3d.inc da_set_boundary_xb.inc da_set_boundary_xa.inc da_ludcmp.inc da_lubksb.inc da_eof_decomposition.inc da_eof_decomposition_test.inc da_buddy_qc.inc da_unifva.inc da_togrid.inc da_togrid_new.inc da_smooth_anl.inc da_openfile.inc da_gaus_noise.inc da_set_randomcv.inc da_random_omb.inc da_max_error_qc.inc da_add_noise_new.inc da_add_noise.inc da_residual_new.inc da_residual.inc da_diff_seconds.inc da_mo_correction.inc da_intpsfc_tem.inc da_intpsfc_prs.inc da_sfcprs.inc da_obs_sfc_correction.inc da_1d_eigendecomposition.inc da_convert_zk.inc da_lc_cone.inc da_set_merc.inc da_map_set.inc da_map_init.inc da_set_ps.inc da_set_lc.inc da_xyll_ps.inc da_xyll_merc.inc da_xyll_lc.inc da_xyll_latlon.inc da_xyll_default.inc da_xyll.inc da_llxy_wrf_new.inc da_llxy_wrf.inc da_llxy_ps_new.inc da_llxy_ps.inc da_llxy_merc_new.inc da_llxy_merc.inc da_llxy_lc_new.inc da_llxy_lc.inc da_llxy_latlon_new.inc da_llxy_latlon.inc da_llxy_rotated_latlon.inc da_llxy_global_new.inc da_llxy_global.inc da_llxy_kma_global_new.inc da_llxy_kma_global.inc da_llxy_default_new.inc da_llxy_default.inc da_llxy_new.inc da_llxy.inc da_map_utils_defines.inc da_lapack.o da_reporting.o da_tracing.o da_tools_serial.o da_define_structures.o da_control.o module_domain.o module_dm.o module_bc.o da_sfc_hori_interp_weights.inc da_tools_serial.o : da_tools_serial.f90 da_find_fft_trig_funcs.inc da_find_fft_factors.inc da_advance_time.inc da_advance_cymdh.inc da_array_print.inc da_change_date.inc da_free_unit.inc da_get_unit.inc da_reporting.o da_control.o da_tracing.o : da_tracing.f90 da_trace_report.inc da_trace_real_sort.inc da_trace_int_sort.inc da_trace_exit.inc da_trace.inc da_trace_entry.inc da_trace_init.inc da_reporting.o da_par_util1.o da_control.o diff --git a/var/da/da_define_structures/da_define_structures.f90 b/var/da/da_define_structures/da_define_structures.f90 index 2b8f981b2f..3000ff4195 100644 --- a/var/da/da_define_structures/da_define_structures.f90 +++ b/var/da/da_define_structures/da_define_structures.f90 @@ -941,6 +941,7 @@ module da_define_structures real :: js real :: jl real :: jd + real :: jm type (jo_type) :: jo end type j_type diff --git a/var/da/da_dynamics/da_divergence_constraint.inc b/var/da/da_dynamics/da_divergence_constraint.inc new file mode 100644 index 0000000000..b76254787c --- /dev/null +++ b/var/da/da_dynamics/da_divergence_constraint.inc @@ -0,0 +1,130 @@ +subroutine da_divergence_constraint(xb, u, v, div) + + !--------------------------------------------------------------------------- + ! Purpose: Calculate divergence on a co-ordinate surface, given an input + ! wind field. + ! + ! d U d V + ! Div = m^2 *[---(---) + ---(---) ] + ! dx m dy M + !--------------------------------------------------------------------------- + + implicit none + + type (xb_type), intent(in) :: xb ! First guess structure. + real, intent(in) :: u(ims:ime,jms:jme,kms:kme) ! u wind comp. + real, intent(in) :: v(ims:ime,jms:jme,kms:kme) ! v wind comp. + real, intent(inout):: div(ims:ime,jms:jme,kms:kme) ! Divergence. + + integer :: i, j, k ! Loop counters. + integer :: is, ie ! 1st dim. end points. + integer :: js, je ! 2nd dim. end points. + real :: one_third ! 1/3. + + real :: coeff, inv_2ds + real :: um(ims:ime,jms:jme) ! Temp. storage of mu*u/m. + real :: vm(ims:ime,jms:jme) ! Temp. storage of mu*v/m. + real :: mu(ims:ime,jms:jme) ! Temp. storage of mu + + if (trace_use) call da_trace_entry("da_divergence_constraint") + + !--------------------------------------------------------------------------- + ! [1.0] Initialise: + !--------------------------------------------------------------------------- + + one_third = 1.0 / 3.0 + div = 0.0 + + !--------------------------------------------------------------------------- + ! Computation to check for edge of domain: + !--------------------------------------------------------------------------- + + is = its; ie = ite; js = jts; je = jte + if (.not. global .and. its == ids) is = ids+1 + if (.not. global .and. ite == ide) ie = ide-1 + if (jts == jds) js = jds+1; if (jte == jde) je = jde-1 + + if (.not.global) inv_2ds = 0.5 / xb%ds + + mu = xb%psfc - xb%ptop + + !--------------------------------------------------------------------------- + ! [2.0] Calculate divergence: + !--------------------------------------------------------------------------- + + if (global) then + do k = kts, kte + ! [2.1] Compute fd divergence at interior points: + + do j = js, je + do i = is, ie + div(i,j,k) = xb%coefx(i,j) * (u(i+1,j,k) - u(i-1,j,k)) + & + xb%coefy(i,j) * (v(i,j+1,k) - v(i,j-1,k)) + end do + end do + end do + call da_set_boundary_3d(div) + else + do k = kts, kte + + um(is-1:ie+1,js-1:je+1) = u(is-1:ie+1,js-1:je+1,k) * & + mu(is-1:ie+1,js-1:je+1) / & + xb%map_factor(is-1:ie+1,js-1:je+1) + vm(is-1:ie+1,js-1:je+1) = v(is-1:ie+1,js-1:je+1,k) * & + mu(is-1:ie+1,js-1:je+1) / & + xb%map_factor(is-1:ie+1,js-1:je+1) + + ! [2.1] Compute fd divergence at interior points: + + do j = js, je + do i = is, ie + coeff = xb%map_factor(i,j) * xb%map_factor(i,j) * inv_2ds + div(i,j,k) = (um(i+1,j) - um(i-1,j) + vm(i,j+1) - vm(i,j-1)) * coeff + end do + end do + + ! [2.2] Impose zero divergence gradient condition at boundaries: + + ! [2.2.1] Bottom boundaries: + + if (its == ids) then + i = its + do j = jts, jte + div(i,j,k) = one_third * (4.0 * div(i+1,j,k) - div(i+2,j,k)) + end do + end if + + ! [2.2.2] Top boundaries: + + if (ite == ide) then + i = ite + do j = jts, jte + div(i,j,k) = one_third * (4.0 * div(i-1,j,k) - div(i-2,j,k)) + end do + end if + + ! [2.2.3] Left boundaries: + + if (jts == jds) then + j = jts + do i = its, ite + div(i,j,k) = one_third * (4.0 * div(i,j+1,k) - div(i,j+2,k)) + end do + end if + + ! [2.2.4] right boundaries: + + if (jte == jde) then + j = jte + do i = its, ite + div(i,j,k) = one_third * (4.0 * div(i,j-1,k) - div(i,j-2,k)) + end do + end if + end do + end if + + if (trace_use) call da_trace_exit("da_divergence_constraint") + +end subroutine da_divergence_constraint + + diff --git a/var/da/da_dynamics/da_divergence_constraint_adj.inc b/var/da/da_dynamics/da_divergence_constraint_adj.inc new file mode 100644 index 0000000000..14fe32b64b --- /dev/null +++ b/var/da/da_dynamics/da_divergence_constraint_adj.inc @@ -0,0 +1,159 @@ +subroutine da_divergence_constraint_adj(grid, u, v, div) + + !--------------------------------------------------------------------------- + ! Purpose: Adjoint of the subroutine da_divergence_constraint + ! d U d V + ! Div = m^2 *[---(---) + ---(---) ] + ! dx m dy M + !--------------------------------------------------------------------------- + + implicit none + + type (domain), intent(inout) :: grid + + real, intent(out) :: u(ims:ime,jms:jme,kms:kme) ! u wind comp. + real, intent(out) :: v(ims:ime,jms:jme,kms:kme) ! v wind comp. + real, intent(inout):: div(ims:ime,jms:jme,kms:kme) ! Divergence. + + integer :: i, j, k ! Loop counters. + integer :: is, ie ! 1st dim. end points. + integer :: js, je ! 2nd dim. end points. + real :: one_third ! 1/3. + + real :: coeff, inv_2ds + real :: um(ims:ime,jms:jme) ! Temp. storage of mu*u/m. + real :: vm(ims:ime,jms:jme) ! Temp. storage of mu*v/m + real :: mu(ims:ime,jms:jme) ! Temp. storage of mu + + if (trace_use) call da_trace_entry("da_divergence_constraint_adj") + + !--------------------------------------------------------------------------- + ! [1.0] Initialise: + !--------------------------------------------------------------------------- + + one_third = 1.0 / 3.0 + + is = its - 1; ie = ite + 1; js = jts - 1; je = jte + 1 + + if (.not. global .and. its == ids) is = ids+1 + if (.not. global .and. ite == ide) ie = ide-1 + if (jts == jds) js = jds+1; if (jte == jde) je = jde-1 + + mu = grid%xb%psfc - grid%xb%ptop + + !--------------------------------------------------------------------------- + ! [2.0] Calculate divergence: + !--------------------------------------------------------------------------- + + if (.not. global) then + inv_2ds = 0.5 / grid%xb%ds + do k =kds, kde + um(ims:ime,jms:jme) = 0.0 + vm(ims:ime,jms:jme) = 0.0 + ! [2.2] Impose zero divergence gradient condition at boundaries: + + ! [2.2.4] Right boundaries: + + if (jte == jde) then + j = jte + do i = its, ite ! This is different to original + div(i,j-1,k)=div(i,j-1,k)+div(i,j,k)*one_third*4.0 + div(i,j-2,k)=div(i,j-2,k)-div(i,j,k)*one_third + div(i,j,k)=0.0 + end do + end if + + ! [2.2.3] Left boundaries: + + if (jts == jds) then + j = jts + do i = its, ite ! This is different to original + div(i,j+1,k)=div(i,j+1,k)+div(i,j,k)*one_third*4.0 + div(i,j+2,k)=div(i,j+2,k)-div(i,j,k)*one_third + div(i,j,k)=0.0 + end do + end if + + ! [2.2.2] Top boundaries: + + if (ite == ide) then + i = ite + do j = jts, jte + div(i-1,j,k)=div(i-1,j,k)+div(i,j,k)*one_third*4.0 + div(i-2,j,k)=div(i-2,j,k)-div(i,j,k)*one_third + div(i,j,k)=0.0 + end do + end if + + ! [2.2.1] Bottom boundaries: + + if (its == ids) then + i = its + do j = jts, jte + div(i+1,j,k)=div(i+1,j,k)+div(i,j,k)*one_third*4.0 + div(i+2,j,k)=div(i+2,j,k)-div(i,j,k)*one_third + div(i,j,k)=0.0 + end do + end if + + ! [2.1] Compute fd divergence at interior points: + ! Computation to check for edge of domain: + ! This is only for adjoint, as we have to cross the processor boundary + ! to get the contribution. + + grid%xp%vxy(its:ite, jts:jte) = div(its:ite, jts:jte, k) +#ifdef DM_PARALLEL +#include "HALO_2D_WORK.inc" +#endif + + div(is, js:je, k) = grid%xp%vxy(is, js:je) + div(ie, js:je, k) = grid%xp%vxy(ie, js:je) + div(is:ie, js, k) = grid%xp%vxy(is:ie, js) + div(is:ie, je, k) = grid%xp%vxy(is:ie, je) + + do j = js, je + do i = is, ie + coeff = grid%xb%map_factor(i,j) * grid%xb%map_factor(i,j) * inv_2ds + um(i+1,j)=um(i+1,j)+div(i,j,k)*coeff + um(i-1,j)=um(i-1,j)-div(i,j,k)*coeff + vm(i,j+1)=vm(i,j+1)+div(i,j,k)*coeff + vm(i,j-1)=vm(i,j-1)-div(i,j,k)*coeff + end do + end do + + u(is-1:ie+1,js-1:je+1,k) = u(is-1:ie+1,js-1:je+1,k) + & + um(is-1:ie+1,js-1:je+1) * & + mu(is-1:ie+1,js-1:je+1) / & + grid%xb%map_factor(is-1:ie+1,js-1:je+1) + v(is-1:ie+1,js-1:je+1,k) = v(is-1:ie+1,js-1:je+1,k) + & + vm(is-1:ie+1,js-1:je+1) * & + mu(is-1:ie+1,js-1:je+1) / & + grid%xb%map_factor(is-1:ie+1,js-1:je+1) + end do + + else ! global + call da_set_boundary_3d(div) + + do k =kds, kde + !------------------------------------------------------------------------- + ! [2.1] Compute fd divergence at interior points: + !------------------------------------------------------------------------- + + do j = je, js, -1 + do i = ie, is, -1 + u(i+1,j,k) = u(i+1,j,k) + grid%xb%coefx(i,j) * div(i,j,k) + u(i-1,j,k) = u(i-1,j,k) - grid%xb%coefx(i,j) * div(i,j,k) + v(i,j+1,k) = v(i,j+1,k) + grid%xb%coefy(i,j) * div(i,j,k) + v(i,j-1,k) = v(i,j-1,k) - grid%xb%coefy(i,j) * div(i,j,k) + end do + end do + end do + end if + + div = 0.0 + + if (trace_use) call da_trace_exit("da_divergence_constraint_adj") + +end subroutine da_divergence_constraint_adj + + diff --git a/var/da/da_dynamics/da_dynamics.f90 b/var/da/da_dynamics/da_dynamics.f90 index a1e62aa282..d6460108e6 100644 --- a/var/da/da_dynamics/da_dynamics.f90 +++ b/var/da/da_dynamics/da_dynamics.f90 @@ -49,6 +49,8 @@ module da_dynamics #include "da_wpec_constraint_cycloterm.inc" #include "da_wpec_constraint_geoterm.inc" #include "da_wpec_constraint_lin.inc" +#include "da_divergence_constraint.inc" +#include "da_divergence_constraint_adj.inc" end module da_dynamics diff --git a/var/da/da_minimisation/da_calculate_gradj.inc b/var/da/da_minimisation/da_calculate_gradj.inc index e0256d8511..afeade6839 100644 --- a/var/da/da_minimisation/da_calculate_gradj.inc +++ b/var/da/da_minimisation/da_calculate_gradj.inc @@ -38,9 +38,13 @@ subroutine da_calculate_gradj(it, iter, cv_size, cv_size_jb, cv_size_je, cv_size real :: grad_jp(cv_size) real :: grad_js(cv_size) real :: grad_jl(cv_size) + real :: grad_jm(cv_size) real :: gnorm_j, gnorm_jo, gnorm_jb, gnorm_je, gnorm_jd, gnorm_jp, gnorm_js, gnorm_jl + real :: gnorm_jm logical :: jcdf_flag + real :: inc_div(ims:ime,jms:jme,kms:kme) ! Temp storage + ! Variables for VarBC background constraint integer :: jp_start, jp_end ! Start/end indices of Jp. integer :: inst, ichan, npred, ipred, id @@ -66,6 +70,9 @@ subroutine da_calculate_gradj(it, iter, cv_size, cv_size_jb, cv_size_je, cv_size grad_jp = 0.0 grad_js = 0.0 grad_jl = 0.0 + grad_jm = 0.0 + + inc_div = 0.0 jcdf_flag = .false. @@ -186,10 +193,31 @@ subroutine da_calculate_gradj(it, iter, cv_size, cv_size_jb, cv_size_je, cv_size !------------------------------------------------------------------------- if (cv_size_jl > 0) grad_jl(jl_start:jl_end) = cv(jl_start:jl_end) + !------------------------------------------------------------------------- + ! [6.1] calculate grad_v (jm): + !------------------------------------------------------------------------- + if (use_divc) then + call da_transform_vtox(grid, cv_size, xbx, be, grid%ep, cv, grid%vv, grid%vp) + if ( be%ne > 0 .and. alphacv_method == alphacv_method_xa ) then + call da_transform_vpatox(grid, be, grid%ep, grid%vp) + call da_add_xa(grid%xa, grid%xa_ens) !grid%xa = grid%xa + xa_ens + end if + call da_transform_xtoxa(grid) + call da_divergence_constraint(grid%xb, grid%xa%u, grid%xa%v, inc_div) + inc_div = inc_div/divc_factor + call da_zero_x(grid%xa) + call da_divergence_constraint_adj(grid, grid%xa%u, grid%xa%v, inc_div) + call da_transform_xtoxa_adj(grid) + if (be % ne > 0 .and. alphacv_method == alphacv_method_xa) then + call da_transform_vpatox_adj(grid, be, grid%ep, grid%vp) + end if + call da_transform_vtox_adj(grid, cv_size, xbx, be, grid%ep, grid%vp, grid%vv, grad_jm) + end if + !-------------------------------------------------------------------------------------------------- ! [7.0] calculate grad_v (j) = grad_v (jb) + grad_v (jo) + grad_v (je) + grad_v (jd) + grad_v (jp) + grad_v (js) + grad_v (jl) !-------------------------------------------------------------------------------------------------- - grad = grad_jo + grad_jb + grad_je + grad_jd + grad_jp + grad_js + grad_jl + grad = grad_jo + grad_jb + grad_je + grad_jd + grad_jp + grad_js + grad_jl + grad_jm !------------------------------------------------------------------------- ! [8.0] write Gradient: @@ -210,10 +238,11 @@ subroutine da_calculate_gradj(it, iter, cv_size, cv_size_jb, cv_size_je, cv_size gnorm_jp = sqrt(da_dot_cv(cv_size, grad_jp, grad_jp, grid, be%cv_mz, be%ncv_mz, jp_start, jp_end)) gnorm_js = sqrt(da_dot_cv(cv_size, grad_js, grad_js, grid, be%cv_mz, be%ncv_mz)) gnorm_jl = sqrt(da_dot_cv(cv_size, grad_jl, grad_jl, grid, be%cv_mz, be%ncv_mz)) - + gnorm_jm = sqrt(da_dot_cv(cv_size, grad_jm, grad_jm, grid, be%cv_mz, be%ncv_mz)) + if (rootproc) & - write(grad_unit,fmt='(2x,i2,1x,e10.3,2x,i4,8(1x,f10.3))') & - it, eps(it), iter, gnorm_j, gnorm_jb, gnorm_jo, gnorm_je, gnorm_jd, gnorm_jp, gnorm_js, gnorm_jl + write(grad_unit,fmt='(2x,i2,1x,e10.3,2x,i4,9(1x,f10.3))') & + it, eps(it), iter, gnorm_j, gnorm_jb, gnorm_jo, gnorm_je, gnorm_jd, gnorm_jp, gnorm_js, gnorm_jl, gnorm_jm end if if (trace_use) call da_trace_exit("da_calculate_gradj") diff --git a/var/da/da_minimisation/da_calculate_j.inc b/var/da/da_minimisation/da_calculate_j.inc index 1fb77b71b3..ab9033879a 100644 --- a/var/da/da_minimisation/da_calculate_j.inc +++ b/var/da/da_minimisation/da_calculate_j.inc @@ -46,8 +46,12 @@ subroutine da_calculate_j(it, iter, cv_size, cv_size_jb, cv_size_je, cv_size_jp, integer :: n, cldtoplevel(1), icld, nclouds, ncv, minlev_cld real :: jd_local real :: js_local + real :: jm_local real, allocatable :: cc(:) - + + real :: inc_div(ims:ime,jms:jme,kms:kme) + real :: bkg_div(ims:ime,jms:jme,kms:kme) + if (trace_use) call da_trace_entry("da_calculate_j") !------------------------------------------------------------------------- @@ -60,6 +64,9 @@ subroutine da_calculate_j(it, iter, cv_size, cv_size_jb, cv_size_je, cv_size_jp, jl_start = cv_size_jb + cv_size_je + cv_size_jp + 1 jl_end = cv_size_jb + cv_size_je + cv_size_jp + cv_size_jl + inc_div = 0.0 + bkg_div = 0.0 + call da_allocate_y(iv, jo_grad_y) !------------------------------------------------------------------------- @@ -289,11 +296,30 @@ subroutine da_calculate_j(it, iter, cv_size, cv_size_jb, cv_size_je, cv_size_jp, j % js = wrf_dm_sum_real(js_local) end if + !------------------------------------------------------------------------- + ! [6.1] calculate jm: + !------------------------------------------------------------------------- + j % jm = 0.0 + if (use_divc) then + call da_transform_vtox(grid, cv_size, xbx, be, grid%ep, xhat+cv, grid%vv, grid%vp) + if ( be%ne > 0 .and. alphacv_method == alphacv_method_xa ) then + call da_transform_vpatox(grid, be, grid%ep, grid%vp) + call da_add_xa(grid%xa, grid%xa_ens) !grid%xa = grid%xa + xa_ens + end if + call da_transform_xtoxa(grid) + call da_divergence_constraint(grid%xb, grid%xa%u, grid%xa%v, inc_div) + j % jm = 0.5* SUM(inc_div(its:ite, jts:jte, kts:kte)* & + inc_div(its:ite, jts:jte, kts:kte))/divc_factor + jm_local = j % jm + ! summation across processors: + j % jm = wrf_dm_sum_real(jm_local) + end if + !------------------------------------------------------------------------- ! [7.0] calculate total cost function j = jo + jb + jc + je + jd + jp + js: !------------------------------------------------------------------------- - j % total = j % jb + j % jo % total + j % je + j % jd + j % jp + j % js + j % total = j % jb + j % jo % total + j % je + j % jd + j % jp + j % js + j % jm if (grid%jcdfi_use) j % total = j % total + j % jc if (var4d) j % total = j % total + j % jl @@ -302,12 +328,12 @@ subroutine da_calculate_j(it, iter, cv_size, cv_size_jb, cv_size_je, cv_size_jp, !------------------------------------------------------------------------- if (rootproc) then if (it == 1 .and. iter == 0) then - write(unit=cost_unit,fmt='(a)')'Outer EPS Inner J Jb Jo Jc Je Jd Jp Js jl' + write(unit=cost_unit,fmt='(a)')'Outer EPS Inner J Jb Jo Jc Je Jd Jp Js Jl Jm' write(unit=cost_unit,fmt='(a)')'Iter Iter ' end if - write(unit=cost_unit,fmt='(2x,i2,1x,e10.3,2x,i4,9(1x,f10.3))') & - it, EPS(it), iter, j % total, j % jb, j % jo % total, j % jc, j % je, j % jd, j % jp, j%js, j%jl + write(unit=cost_unit,fmt='(2x,i2,1x,e10.3,2x,i4,10(1x,f10.3))') & + it, EPS(it), iter, j % total, j % jb, j % jo % total, j % jc, j % je, j % jd, j % jp, j%js, j%jl, j%jm end if call da_deallocate_y (jo_grad_y) diff --git a/var/da/da_minimisation/da_get_var_diagnostics.inc b/var/da/da_minimisation/da_get_var_diagnostics.inc index dca77ca532..9812abb19b 100644 --- a/var/da/da_minimisation/da_get_var_diagnostics.inc +++ b/var/da/da_minimisation/da_get_var_diagnostics.inc @@ -214,6 +214,7 @@ subroutine da_get_var_diagnostics(it, iv, j) write(unit=stdout,fmt='(a,f15.5)') ' Final value of Je = ', j % je write(unit=stdout,fmt='(a,f15.5)') ' Final value of Jp = ', j % jp write(unit=stdout,fmt='(a,f15.5)') ' Final value of Jl = ', j % jl + write(unit=stdout,fmt='(a,f15.5)') ' Final value of Jm = ', j % jm if (num_stats_tot > 0) & write(unit=stdout,fmt='(a,f15.5)') ' Final J / total num_obs = ', j % total / & real(num_stats_tot) diff --git a/var/da/da_minimisation/da_minimisation.f90 b/var/da/da_minimisation/da_minimisation.f90 index 0d21028952..9b4dc3c843 100644 --- a/var/da/da_minimisation/da_minimisation.f90 +++ b/var/da/da_minimisation/da_minimisation.f90 @@ -54,11 +54,12 @@ module da_minimisation use_satcv, sensitivity_option, print_detail_outerloop, adj_sens, filename_len, & ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe, fgat_rain_flags, var4d_bin_rain, freeze_varbc, & use_wpec, wpec_factor, use_4denvar, anal_type_hybrid_dual_res, alphacv_method, alphacv_method_xa, & - write_detail_grad_fn, pseudo_uvtpq, lanczos_ep_filename + write_detail_grad_fn, pseudo_uvtpq, lanczos_ep_filename, use_divc, divc_factor, use_radarobs use da_define_structures, only : iv_type, y_type, j_type, be_type, & xbx_type, jo_type, da_allocate_y,da_zero_x,da_zero_y,da_deallocate_y, & da_zero_vp_type, qhat_type - use da_dynamics, only : da_wpec_constraint_lin,da_wpec_constraint_adj + use da_dynamics, only : da_wpec_constraint_lin,da_wpec_constraint_adj, & + da_divergence_constraint, da_divergence_constraint_adj use da_obs, only : da_transform_xtoy_adj,da_transform_xtoy, & da_add_noise_to_ob,da_random_omb_all, da_obs_sensitivity use da_geoamv, only : da_calculate_grady_geoamv, da_ao_stats_geoamv, & diff --git a/var/da/da_test/da_check.inc b/var/da/da_test/da_check.inc index 76b3ad15e6..d1fc29433a 100644 --- a/var/da/da_test/da_check.inc +++ b/var/da/da_test/da_check.inc @@ -86,6 +86,14 @@ subroutine da_check(grid, config_flags, cv_size, xbx, be, ep, iv, vv, vp, y) call da_deallocate_y(y) + !---------------------------------------------------------------------------- + ! [3] Perform dynamical constraint test: + !---------------------------------------------------------------------------- + call da_message((/"Performing dynamical constraint adjoint tests"/)) + call da_zero_x(grid%xa) + call da_setup_testfield(grid) + call da_check_dynamics_adjoint(cv_size, cvtest, xbx, be, grid, config_flags) + !---------------------------------------------------------------------------- ! [4] Perform spectral test: !---------------------------------------------------------------------------- diff --git a/var/da/da_test/da_check_dynamics_adjoint.inc b/var/da/da_test/da_check_dynamics_adjoint.inc new file mode 100644 index 0000000000..08c3ea5eec --- /dev/null +++ b/var/da/da_test/da_check_dynamics_adjoint.inc @@ -0,0 +1,262 @@ +subroutine da_check_dynamics_adjoint(cv_size, cv, xbx, be, grid, config_flags) + + !-------------------------------------------------------------------------- + ! Purpose: Test observation operator transform and adjoint for compatibility. + ! + ! Method: Standard adjoint test: < y, y > = < x, x_adj >. + ! Updated for Analysis on Arakawa-C grid + ! Author: Xiaowen Tang, MMM/ESSL/NCAR, Date: 10/22/2008 + !--------------------------------------------------------------------------- + + implicit none + + integer, intent(in) :: cv_size ! Size of cv array. + type (be_type), intent(in) :: be ! background error structure. + real, intent(inout) :: cv(1:cv_size) ! control variables. + type (xbx_type), intent(inout) :: xbx ! Header & non-gridded vars. + type (domain), intent(inout) :: grid + type(grid_config_rec_type), intent(inout) :: config_flags + + real :: adj_ttl_lhs ! < y, y > + real :: adj_ttl_rhs ! < x, x_adj > + + real :: partial_lhs ! < y, y > + real :: partial_rhs ! < x, x_adj > + + real :: pertile_lhs ! < y, y > + real :: pertile_rhs ! < x, x_adj > + + real, dimension(ims:ime, jms:jme, kms:kme) :: xa2_u, xa2_v, xa2_t, & + xa2_p, xa2_q, xa2_rh + real, dimension(ims:ime, jms:jme, kms:kme) :: xa2_w + real, dimension(ims:ime, jms:jme) :: xa2_psfc + real, dimension(ims:ime, jms:jme, kms:kme) :: xa2_qcw, xa2_qci, xa2_qrn, xa2_qsn, xa2_qgr + real, dimension(ims:ime, jms:jme, kms:kme) :: x6a2_u, x6a2_v, x6a2_t, & + x6a2_p, x6a2_q, x6a2_rh + real, dimension(ims:ime, jms:jme, kms:kme) :: x6a2_w + real, dimension(ims:ime, jms:jme) :: x6a2_psfc + real, dimension(ims:ime, jms:jme, kms:kme) :: x6a2_qcw, x6a2_qci, x6a2_qrn, x6a2_qsn, x6a2_qgr + real, dimension(ims:ime, jms:jme, kms:kme) :: tempv + + integer :: nobwin, i, j, k, fgat_rain + character(len=4) :: filnam + character(len=256) :: timestr + integer :: time_step_seconds + type(x_type) :: shuffle + real :: subarea, whole_area + + if (trace_use) call da_trace_entry("da_check_dynamics_adjoint") + + write (unit=stdout, fmt='(/a/)') 'da_check_dynamics_adjoint: Test Results:' + + !---------------------------------------------------------------------- + ! [1.0] Initialise: + !---------------------------------------------------------------------- + + partial_lhs = 0.0 + pertile_lhs = 0.0 + +#ifdef A2C + if ((fg_format==fg_format_wrf_arw_regional .or. & + fg_format==fg_format_wrf_arw_global ) .and. ide == ipe ) then + ipe = ipe + 1 + ide = ide + 1 + end if + + if ((fg_format==fg_format_wrf_arw_regional .or. & + fg_format==fg_format_wrf_arw_global ) .and. jde == jpe ) then + jpe = jpe + 1 + jde = jde + 1 + end if +#endif + +#ifdef DM_PARALLEL +#include "HALO_XA.inc" +#endif + +#ifdef A2C + if ((fg_format==fg_format_wrf_arw_regional .or. & + fg_format==fg_format_wrf_arw_global ) .and. ide == ipe ) then + ipe = ipe - 1 + ide = ide - 1 + end if + + if ((fg_format==fg_format_wrf_arw_regional .or. & + fg_format==fg_format_wrf_arw_global ) .and. jde == jpe ) then + jpe = jpe - 1 + jde = jde - 1 + end if +#endif + + call da_transform_vtox(grid, cv_size, xbx, be, grid%ep, cv, grid%vv, grid%vp) + call da_transform_xtoxa(grid) + + xa2_u(ims:ime, jms:jme, kms:kme) = grid%xa%u(ims:ime, jms:jme, kms:kme) + xa2_v(ims:ime, jms:jme, kms:kme) = grid%xa%v(ims:ime, jms:jme, kms:kme) + xa2_t(ims:ime, jms:jme, kms:kme) = grid%xa%t(ims:ime, jms:jme, kms:kme) + xa2_p(ims:ime, jms:jme, kms:kme) = grid%xa%p(ims:ime, jms:jme, kms:kme) + xa2_q(ims:ime, jms:jme, kms:kme) = grid%xa%q(ims:ime, jms:jme, kms:kme) + xa2_w(ims:ime, jms:jme, kms:kme) = grid%xa%w(ims:ime, jms:jme, kms:kme) + xa2_rh(ims:ime, jms:jme, kms:kme)= grid%xa%rh(ims:ime, jms:jme, kms:kme) + xa2_psfc(ims:ime, jms:jme) = grid%xa%psfc(ims:ime, jms:jme) + + xa2_qcw(ims:ime, jms:jme, kms:kme) = grid%xa%qcw(ims:ime, jms:jme, kms:kme) + xa2_qci(ims:ime, jms:jme, kms:kme) = grid%xa%qci(ims:ime, jms:jme, kms:kme) + xa2_qrn(ims:ime, jms:jme, kms:kme) = grid%xa%qrn(ims:ime, jms:jme, kms:kme) + xa2_qsn(ims:ime, jms:jme, kms:kme) = grid%xa%qsn(ims:ime, jms:jme, kms:kme) + xa2_qgr(ims:ime, jms:jme, kms:kme) = grid%xa%qgr(ims:ime, jms:jme, kms:kme) + + x6a2_u = 0.0 + x6a2_v = 0.0 + x6a2_t = 0.0 + x6a2_p = 0.0 + x6a2_q = 0.0 + x6a2_w = 0.0 + x6a2_rh = 0.0 + x6a2_psfc = 0.0 + + x6a2_qcw = 0.0 + x6a2_qci = 0.0 + x6a2_qrn = 0.0 + x6a2_qsn = 0.0 + x6a2_qgr = 0.0 + +#ifdef A2C + if( ite == ide ) & +print*,__FILE__,jte,' xa2_u.xa2_u for col= ',ite+1,sum(xa2_u(ite+1, jts:jte, kts:kte) * xa2_u(ite+1, jts:jte, kts:kte)) + if( jte == jde ) & +print*,__FILE__,jte,' xa2_v.xa2_v for row= ',jte+1,sum(xa2_v(its:ite, jte+1, kts:kte) * xa2_v(its:ite, jte+1, kts:kte)) +#endif + + if ( num_fgat_time > 1 ) then + call domain_clock_get (grid, stop_timestr=timestr) + call domain_clock_set( grid, current_timestr=timestr ) + call domain_clock_set (grid, time_step_seconds=-1*var4d_bin) + call domain_clockprint(150, grid, 'get CurrTime from clock,') + endif + + fgat_rain = num_fgat_time + do nobwin= num_fgat_time, 1, -1 + !---------------------------------------------------------------------- + ! [1.0] Perform y = Hx transform: + !---------------------------------------------------------------------- + ! call da_uv_to_divergence(grid%xb, grid%xa%u, grid%xa%v, tempv) + call da_divergence_constraint(grid%xb, grid%xa%u, grid%xa%v, tempv) + partial_lhs = partial_lhs + SUM( tempv(ims:ime, jms:jme, kms:kme) * tempv(ims:ime, jms:jme, kms:kme) ) + pertile_lhs = pertile_lhs + SUM( tempv(its:ite, jts:jte, kts:kte) * tempv(its:ite, jts:jte, kts:kte) ) + + !---------------------------------------------------------------------- + ! [5.0] Perform adjoint operation: + !---------------------------------------------------------------------- + call da_zero_x (grid%xa) + ! call da_uv_to_divergence_adj(grid, grid%xa%u, grid%xa%v, tempv) + call da_divergence_constraint_adj(grid, grid%xa%u, grid%xa%v, tempv) + + if ( nobwin > 1 ) call domain_clockadvance (grid) + call domain_clockprint(150, grid, 'DEBUG Adjoint Check: get CurrTime from clock,') + + end do + + if ( num_fgat_time > 1 ) then + call nl_get_time_step ( grid%id, time_step_seconds) + call domain_clock_set (grid, time_step_seconds=time_step_seconds) + call domain_clockprint(150, grid, 'get CurrTime from clock,') + endif + + + pertile_rhs = sum (grid%xa%u(ims:ime, jms:jme, kms:kme) * xa2_u(ims:ime, jms:jme, kms:kme)) & + + sum (grid%xa%v(ims:ime, jms:jme, kms:kme) * xa2_v(ims:ime, jms:jme, kms:kme)) & + + sum (grid%xa%w(ims:ime, jms:jme, kms:kme) * xa2_w(ims:ime, jms:jme, kms:kme)) & + + sum (grid%xa%t(ims:ime, jms:jme, kms:kme) * xa2_t(ims:ime, jms:jme, kms:kme)) & + + sum (grid%xa%p(ims:ime, jms:jme, kms:kme) * xa2_p(ims:ime, jms:jme, kms:kme)) & + + sum (grid%xa%q(ims:ime, jms:jme, kms:kme) * xa2_q(ims:ime, jms:jme, kms:kme)) & + + sum (grid%xa%rh(ims:ime, jms:jme, kms:kme)* xa2_rh(ims:ime, jms:jme, kms:kme)) & + + sum (grid%xa%psfc(ims:ime, jms:jme) * xa2_psfc(ims:ime, jms:jme)) & + + sum (grid%x6a%u(ims:ime, jms:jme, kms:kme) * x6a2_u(ims:ime, jms:jme, kms:kme)) & + + sum (grid%x6a%v(ims:ime, jms:jme, kms:kme) * x6a2_v(ims:ime, jms:jme, kms:kme)) & + + sum (grid%x6a%w(ims:ime, jms:jme, kms:kme) * x6a2_w(ims:ime, jms:jme, kms:kme)) & + + sum (grid%x6a%t(ims:ime, jms:jme, kms:kme) * x6a2_t(ims:ime, jms:jme, kms:kme)) & + + sum (grid%x6a%p(ims:ime, jms:jme, kms:kme) * x6a2_p(ims:ime, jms:jme, kms:kme)) & + + sum (grid%x6a%q(ims:ime, jms:jme, kms:kme) * x6a2_q(ims:ime, jms:jme, kms:kme)) & + + sum (grid%x6a%rh(ims:ime, jms:jme, kms:kme)* x6a2_rh(ims:ime, jms:jme, kms:kme)) & + + sum (grid%x6a%psfc(ims:ime, jms:jme) * x6a2_psfc(ims:ime, jms:jme)) + pertile_rhs = pertile_rhs & + + sum (grid%xa%qcw(ims:ime, jms:jme, kms:kme) * xa2_qcw(ims:ime, jms:jme, kms:kme)) & + + sum (grid%xa%qci(ims:ime, jms:jme, kms:kme) * xa2_qci(ims:ime, jms:jme, kms:kme)) & + + sum (grid%xa%qrn(ims:ime, jms:jme, kms:kme) * xa2_qrn(ims:ime, jms:jme, kms:kme)) & + + sum (grid%xa%qsn(ims:ime, jms:jme, kms:kme) * xa2_qsn(ims:ime, jms:jme, kms:kme)) & + + sum (grid%xa%qgr(ims:ime, jms:jme, kms:kme) * xa2_qgr(ims:ime, jms:jme, kms:kme)) & + + sum (grid%x6a%qcw(ims:ime, jms:jme, kms:kme) * x6a2_qcw(ims:ime, jms:jme, kms:kme)) & + + sum (grid%x6a%qci(ims:ime, jms:jme, kms:kme) * x6a2_qci(ims:ime, jms:jme, kms:kme)) & + + sum (grid%x6a%qrn(ims:ime, jms:jme, kms:kme) * x6a2_qrn(ims:ime, jms:jme, kms:kme)) & + + sum (grid%x6a%qsn(ims:ime, jms:jme, kms:kme) * x6a2_qsn(ims:ime, jms:jme, kms:kme)) & + + sum (grid%x6a%qgr(ims:ime, jms:jme, kms:kme) * x6a2_qgr(ims:ime, jms:jme, kms:kme)) + + + !---------------------------------------------------------------------- + ! [6.0] Calculate RHS of adjoint test equation: + !---------------------------------------------------------------------- + + partial_rhs = sum (grid%xa%u(its:ite, jts:jte, kts:kte) * xa2_u(its:ite, jts:jte, kts:kte)) & + + sum (grid%xa%v(its:ite, jts:jte, kts:kte) * xa2_v(its:ite, jts:jte, kts:kte)) & + + sum (grid%xa%w(its:ite, jts:jte, kts:kte+1) * xa2_w(its:ite, jts:jte, kts:kte+1)) & + + sum (grid%xa%t(its:ite, jts:jte, kts:kte) * xa2_t(its:ite, jts:jte, kts:kte)) & + + sum (grid%xa%p(its:ite, jts:jte, kts:kte) * xa2_p(its:ite, jts:jte, kts:kte)) & + + sum (grid%xa%q(its:ite, jts:jte, kts:kte) * xa2_q(its:ite, jts:jte, kts:kte)) & + + sum (grid%xa%rh(its:ite, jts:jte, kts:kte)* xa2_rh(its:ite, jts:jte, kts:kte)) & + + sum (grid%xa%psfc(its:ite, jts:jte) * xa2_psfc(its:ite, jts:jte)) & + + sum (grid%x6a%u(its:ite, jts:jte, kts:kte) * x6a2_u(its:ite, jts:jte, kts:kte)) & + + sum (grid%x6a%v(its:ite, jts:jte, kts:kte) * x6a2_v(its:ite, jts:jte, kts:kte)) & + + sum (grid%x6a%w(its:ite, jts:jte, kts:kte+1) * x6a2_w(its:ite, jts:jte, kts:kte+1)) & + + sum (grid%x6a%t(its:ite, jts:jte, kts:kte) * x6a2_t(its:ite, jts:jte, kts:kte)) & + + sum (grid%x6a%p(its:ite, jts:jte, kts:kte) * x6a2_p(its:ite, jts:jte, kts:kte)) & + + sum (grid%x6a%q(its:ite, jts:jte, kts:kte) * x6a2_q(its:ite, jts:jte, kts:kte)) & + + sum (grid%x6a%rh(its:ite, jts:jte, kts:kte)* x6a2_rh(its:ite, jts:jte, kts:kte)) & + + sum (grid%x6a%psfc(its:ite, jts:jte) * x6a2_psfc(its:ite, jts:jte)) + + partial_rhs = partial_rhs & + + sum (grid%xa%qcw(its:ite, jts:jte, kts:kte) * xa2_qcw(its:ite, jts:jte, kts:kte)) & + + sum (grid%xa%qci(its:ite, jts:jte, kts:kte) * xa2_qci(its:ite, jts:jte, kts:kte)) & + + sum (grid%xa%qrn(its:ite, jts:jte, kts:kte) * xa2_qrn(its:ite, jts:jte, kts:kte)) & + + sum (grid%xa%qsn(its:ite, jts:jte, kts:kte) * xa2_qsn(its:ite, jts:jte, kts:kte)) & + + sum (grid%xa%qgr(its:ite, jts:jte, kts:kte) * xa2_qgr(its:ite, jts:jte, kts:kte)) & + + sum (grid%x6a%qcw(its:ite, jts:jte, kts:kte) * x6a2_qcw(its:ite, jts:jte, kts:kte)) & + + sum (grid%x6a%qci(its:ite, jts:jte, kts:kte) * x6a2_qci(its:ite, jts:jte, kts:kte)) & + + sum (grid%x6a%qrn(its:ite, jts:jte, kts:kte) * x6a2_qrn(its:ite, jts:jte, kts:kte)) & + + sum (grid%x6a%qsn(its:ite, jts:jte, kts:kte) * x6a2_qsn(its:ite, jts:jte, kts:kte)) & + + sum (grid%x6a%qgr(its:ite, jts:jte, kts:kte) * x6a2_qgr(its:ite, jts:jte, kts:kte)) + +#ifdef A2C + if( ite == ide ) then +print*,__FILE__,' contribution from ',ite+1,' col for U : ',sum (grid%xa%u(ite+1, jts:jte, kts:kte) * xa2_u(ite+1, jts:jte, kts:kte)) + partial_rhs = partial_rhs & + + sum (grid%xa%u(ite+1, jts:jte, kts:kte) * xa2_u(ite+1, jts:jte, kts:kte)) + end if + if( jte == jde ) then +print*,__FILE__,' contribution from ',jte+1,' row for V : ',sum(grid%xa%v(its:ite, jte+1, kts:kte) * xa2_v(its:ite, jte+1, kts:kte)) + partial_rhs = partial_rhs & + + sum (grid%xa%v(its:ite, jte+1, kts:kte) * xa2_v(its:ite, jte+1, kts:kte)) + end if +#endif + + !---------------------------------------------------------------------- + ! [7.0] Print output: + !---------------------------------------------------------------------- + write (unit=stdout, fmt='(A,1pe22.14)') ' Single Domain < y, y > = ', pertile_lhs + write (unit=stdout, fmt='(A,1pe22.14)') ' Single Domain < x, x_adj > = ', pertile_rhs + + adj_ttl_lhs = wrf_dm_sum_real (partial_lhs) + adj_ttl_rhs = wrf_dm_sum_real (partial_rhs) + + if (rootproc) then + write(unit=stdout, fmt='(/)') + write (unit=stdout, fmt='(A,1pe22.14)') ' Whole Domain < y, y > = ', adj_ttl_lhs + write (unit=stdout, fmt='(A,1pe22.14)') ' Whole Domain < x, x_adj > = ', adj_ttl_rhs + end if + + write (unit=stdout, fmt='(/a/)') 'da_check_dynamics_adjoint: Test Finished:' + if (trace_use) call da_trace_exit("da_check_dynamics_adjoint") + +end subroutine da_check_dynamics_adjoint + + diff --git a/var/da/da_test/da_test.f90 b/var/da/da_test/da_test.f90 index f5af029721..5cc8bd4483 100644 --- a/var/da/da_test/da_test.f90 +++ b/var/da/da_test/da_test.f90 @@ -49,7 +49,8 @@ module da_test use da_define_structures, only : da_zero_x,da_zero_vp_type,da_allocate_y, & da_deallocate_y,be_type, xbx_type, iv_type, y_type, j_type, da_initialize_cv use da_dynamics, only : da_uv_to_divergence,da_uv_to_vorticity, & - da_psichi_to_uv, da_psichi_to_uv_adj + da_psichi_to_uv, da_psichi_to_uv_adj, da_uv_to_divergence_adj, & + da_divergence_constraint, da_divergence_constraint_adj use da_ffts, only : da_solve_poissoneqn_fct use da_minimisation, only : da_transform_vtoy_adj,da_transform_vtoy, da_swap_xtraj, & da_read_basicstates, da_calculate_j, da_calculate_gradj @@ -146,5 +147,6 @@ module da_test #include "da_check_vtoy_adjoint.inc" #include "da_get_y_lhs_value.inc" #include "da_check_gradient.inc" +#include "da_check_dynamics_adjoint.inc" end module da_test From 1c43efffa6a5fe5a3352fe0897537260b5b0b0f9 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Wed, 8 Mar 2017 15:47:22 -0700 Subject: [PATCH 02/91] Large Scale Analysis Constraint (LSAC) capability from Xiaowen Tang of Nanjing University, China modified: Registry/registry.var modified: var/build/depend.txt modified: var/da/da_obs/da_fill_obs_structures.inc modified: var/da/da_obs_io/da_obs_io.f90 new file: var/da/da_obs_io/da_read_lsac_util.inc new file: var/da/da_obs_io/da_read_obs_lsac.inc new file: var/da/da_obs_io/da_scan_obs_lsac.inc modified: var/da/da_setup_structures/da_setup_obs_structures.inc modified: var/da/da_setup_structures/da_setup_obs_structures_ascii.inc modified: var/da/da_setup_structures/da_setup_structures.f90 --- Registry/registry.var | 5 + var/build/depend.txt | 2 +- var/da/da_obs/da_fill_obs_structures.inc | 24 +- var/da/da_obs_io/da_obs_io.f90 | 7 +- var/da/da_obs_io/da_read_lsac_util.inc | 314 ++++++++++++++++++ var/da/da_obs_io/da_read_obs_lsac.inc | 19 ++ var/da/da_obs_io/da_scan_obs_lsac.inc | 15 + .../da_setup_obs_structures.inc | 2 +- .../da_setup_obs_structures_ascii.inc | 16 + .../da_setup_structures.f90 | 5 +- 10 files changed, 393 insertions(+), 16 deletions(-) create mode 100644 var/da/da_obs_io/da_read_lsac_util.inc create mode 100644 var/da/da_obs_io/da_read_obs_lsac.inc create mode 100644 var/da/da_obs_io/da_scan_obs_lsac.inc diff --git a/Registry/registry.var b/Registry/registry.var index f48bfa95d2..0516b9135f 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -339,6 +339,11 @@ rconfig real divc_factor namelist,wrfvar12 1 1000. - "di rconfig integer balance_type namelist,wrfvar12 1 3 - "balance_type" "" "For use_wpec: 1 = geostrophic; 2 = cyclostrophic; 3 = both" rconfig logical use_wpec namelist,wrfvar12 1 .false. - "use_wpec" "" "" rconfig real wpec_factor namelist,wrfvar12 1 0.001 - "wpec_factor" "" "Inverse of WPEC gamma factor" +rconfig logical use_lsac namelist,wrfvar12 1 .false. - "use_lsac" "switch for large scale analysis constraint" "" +rconfig integer lsac_nhskip namelist,wrfvar12 1 5 - "lsac_nhskip" "number of horizontal grid points to skip" "" +rconfig integer lsac_nvskip namelist,wrfvar12 1 4 - "lsac_nvskip" "number of vertical grid points to skip" "" +rconfig logical lsac_calcerr namelist,wrfvar12 1 .false. - "lsac_calcerr" "switch for using fixed (false) or scaled (true) error" "" +rconfig logical lsac_print_details namelist,wrfvar12 1 .false. - "lsac_print_details" "switch for printout" "" rconfig integer vert_corr namelist,wrfvar13 1 2 - "vert_corr" "" "" rconfig integer vertical_ip namelist,wrfvar13 1 0 - "vertical_ip" "" "" rconfig integer vert_evalue namelist,wrfvar13 1 1 - "vert_evalue" "" "" diff --git a/var/build/depend.txt b/var/build/depend.txt index 626a9480fe..933e07040f 100644 --- a/var/build/depend.txt +++ b/var/build/depend.txt @@ -131,7 +131,7 @@ da_module_couple_uv_ad.o : da_module_couple_uv_ad.f90 da_couple_ad.inc da_calc_m da_mtgirs.o : da_mtgirs.f90 da_calculate_grady_mtgirs.inc da_get_innov_vector_mtgirs.inc da_check_max_iv_mtgirs.inc da_transform_xtoy_mtgirs_adj.inc da_transform_xtoy_mtgirs.inc da_print_stats_mtgirs.inc da_oi_stats_mtgirs.inc da_residual_mtgirs.inc da_jo_mtgirs_uvtq.inc da_jo_and_grady_mtgirs.inc da_ao_stats_mtgirs.inc da_tracing.o da_physics.o da_grid_definitions.o da_par_util1.o da_par_util.o da_tools.o da_statistics.o da_interpolation.o module_domain.o da_define_structures.o da_control.o da_netcdf_interface.o : da_netcdf_interface.f90 da_atotime.inc da_get_bdytimestr_cdf.inc da_get_bdyfrq.inc da_put_att_cdf.inc da_get_att_cdf.inc da_put_var_2d_int_cdf.inc da_get_var_2d_int_cdf.inc da_put_var_2d_real_cdf.inc da_put_var_3d_real_cdf.inc da_get_var_2d_real_cdf.inc da_get_var_3d_real_cdf.inc da_get_gl_att_real_cdf.inc da_get_gl_att_int_cdf.inc da_get_dims_cdf.inc da_get_times_cdf.inc da_get_var_1d_real_cdf.inc da_obs.o : da_obs.f90 da_grid_definitions.o da_set_obs_missing.inc da_obs_sensitivity.inc da_count_filtered_obs.inc da_store_obs_grid_info_rad.inc da_store_obs_grid_info.inc da_random_omb_all.inc da_fill_obs_structures.inc da_fill_obs_structures_rain.inc da_fill_obs_structures_radar.inc da_check_missing.inc da_add_noise_to_ob.inc da_transform_xtoy_adj.inc da_transform_xtoy.inc da_obs_proc_station.inc module_dm.o da_tracing.o da_tools.o da_tools_serial.o da_synop.o da_ssmi.o da_tamdar.o da_mtgirs.o da_sound.o da_ships.o da_satem.o da_rttov.o da_reporting.o da_rain.o da_radar.o da_qscat.o da_pseudo.o da_profiler.o da_polaramv.o da_pilot.o da_physics.o da_metar.o da_gpsref.o da_gpspw.o da_geoamv.o da_crtm.o da_control.o da_buoy.o da_bogus.o da_airsr.o da_airep.o module_domain.o da_define_structures.o -da_obs_io.o : da_obs_io.f90 da_grid_definitions.o da_final_write_modified_filtered_obs.inc da_final_write_filtered_obs.inc da_write_noise_to_ob.inc da_read_omb_tmp.inc da_read_rand_unit.inc da_read_y_unit.inc da_final_write_y.inc da_final_write_obs.inc da_read_obs_bufrgpsro.inc da_read_obs_bufr.inc da_write_y.inc da_write_modified_filtered_obs.inc da_write_filtered_obs.inc da_write_obs_etkf.inc da_search_obs.inc da_read_iv_for_multi_inc.inc da_write_iv_for_multi_inc.inc da_write_obs.inc da_use_obs_errfac.inc da_read_errfac.inc da_read_obs_rain.inc da_scan_obs_rain.inc da_scan_obs_radar.inc da_read_obs_radar.inc da_scan_obs_ascii.inc da_read_obs_ascii.inc da_par_util.o gsi_thinning.o module_radiance.o da_tracing.o da_tools_serial.o da_tools.o da_reporting.o da_physics.o da_par_util1.o da_obs.o da_grid_definitions.o da_define_structures.o da_control.o module_domain.o +da_obs_io.o : da_obs_io.f90 da_grid_definitions.o da_final_write_modified_filtered_obs.inc da_final_write_filtered_obs.inc da_write_noise_to_ob.inc da_read_omb_tmp.inc da_read_rand_unit.inc da_read_y_unit.inc da_final_write_y.inc da_final_write_obs.inc da_read_obs_bufrgpsro.inc da_read_obs_bufr.inc da_write_y.inc da_write_modified_filtered_obs.inc da_write_filtered_obs.inc da_write_obs_etkf.inc da_search_obs.inc da_read_iv_for_multi_inc.inc da_write_iv_for_multi_inc.inc da_write_obs.inc da_use_obs_errfac.inc da_read_errfac.inc da_read_obs_rain.inc da_scan_obs_rain.inc da_scan_obs_radar.inc da_read_obs_radar.inc da_scan_obs_ascii.inc da_read_obs_ascii.inc da_par_util.o gsi_thinning.o module_radiance.o da_tracing.o da_tools_serial.o da_tools.o da_reporting.o da_physics.o da_par_util1.o da_obs.o da_grid_definitions.o da_define_structures.o da_control.o module_domain.o da_read_lsac_util.inc da_read_obs_lsac.inc da_scan_obs_lsac.inc da_netcdf_interface.o da_par_util.o : da_par_util.f90 da_proc_maxmin_combine.inc da_proc_stats_combine.inc da_system.inc da_y_facade_to_global.inc da_generic_boilerplate.inc da_deallocate_global_synop.inc da_deallocate_global_sound.inc da_deallocate_global_sonde_sfc.inc da_generic_methods.inc da_patch_to_global_3d.inc da_patch_to_global_dual_res.inc da_patch_to_global_2d.inc da_cv_to_global.inc da_transpose_y2x_v2.inc da_transpose_x2y_v2.inc da_transpose_z2y.inc da_transpose_y2z.inc da_transpose_x2z.inc da_transpose_z2x.inc da_transpose_y2x.inc da_transpose_x2y.inc da_unpack_count_obs.inc da_pack_count_obs.inc da_copy_tile_dims.inc da_copy_dims.inc da_alloc_and_copy_be_arrays.inc da_vv_to_cv.inc da_cv_to_vv.inc da_generic_typedefs.inc da_wrf_interfaces.o da_tracing.o da_reporting.o da_define_structures.o da_par_util1.o module_dm.o module_domain.o da_control.o da_par_util1.o : da_par_util1.f90 da_proc_sum_real.inc da_proc_sum_ints.inc da_proc_sum_int.inc da_control.o da_physics.o : da_physics.f90 da_uv_to_sd_lin.inc da_uv_to_sd_adj.inc da_integrat_dz.inc da_wdt.inc da_filter_adj.inc da_filter.inc da_evapo_lin.inc da_condens_lin.inc da_condens_adj.inc da_moist_phys_lin.inc da_moist_phys_adj.inc da_sfc_pre_adj.inc da_sfc_pre_lin.inc da_sfc_pre.inc da_transform_xtowtq_adj.inc da_transform_xtowtq.inc da_transform_xtopsfc_adj.inc da_transform_xtopsfc.inc da_sfc_wtq_adj.inc da_sfc_wtq_lin.inc da_sfc_wtq.inc da_julian_day.inc da_roughness_from_lanu.inc da_get_q_error.inc da_check_rh_simple.inc da_check_rh.inc da_transform_xtogpsref_lin.inc da_transform_xtogpsref_adj.inc da_transform_xtogpsref.inc da_transform_xtotpw_adj.inc da_transform_xtotpw.inc da_transform_xtoztd_adj.inc da_transform_xtoztd_lin.inc da_transform_xtoztd.inc da_tv_profile_tl.inc da_thickness_tl.inc da_find_layer_adj.inc da_thickness.inc da_tv_profile_adj.inc da_find_layer.inc da_thickness_adj.inc da_find_layer_tl.inc da_tv_profile.inc da_tpq_to_slp_adj.inc da_tpq_to_slp_lin.inc da_wrf_tpq_2_slp.inc da_tpq_to_slp.inc da_trh_to_td.inc da_tp_to_qs_lin1.inc da_tp_to_qs_lin.inc da_tp_to_qs_adj1.inc da_tp_to_qs_adj.inc da_tp_to_qs1.inc da_tp_to_qs.inc da_tprh_to_q_lin1.inc da_tprh_to_q_lin.inc da_tprh_to_q_adj1.inc da_tprh_to_q_adj.inc da_tpq_to_rh_lin1.inc da_tpq_to_rh_lin.inc da_tpq_to_rh.inc da_pt_to_rho_lin.inc da_pt_to_rho_adj.inc da_uvprho_to_w_adj.inc da_uvprho_to_w_lin.inc da_prho_to_t_lin.inc da_prho_to_t_adj.inc da_wrf_interfaces.o da_reporting.o da_dynamics.o da_interpolation.o da_tracing.o da_par_util.o da_define_structures.o da_control.o module_comm_dm.o module_dm.o module_domain.o da_grid_definitions.o diff --git a/var/da/da_obs/da_fill_obs_structures.inc b/var/da/da_obs/da_fill_obs_structures.inc index 0e54073d5e..87f975e296 100644 --- a/var/da/da_obs/da_fill_obs_structures.inc +++ b/var/da/da_obs/da_fill_obs_structures.inc @@ -487,17 +487,19 @@ subroutine da_fill_obs_structures(iv, ob, uvq_direct) ob % bogus(n) % q(k) = iv % bogus(n) % q(k) % inv ! Calculate q error from rh error: - - rh_error = iv%bogus(n)%q(k)%error ! q error is rh at this stage! - call da_get_q_error(iv % bogus(n) % p(k), & - ob % bogus(n) % t(k), & - ob % bogus(n) % q(k), & - iv % bogus(n) % t(k) % error, & - rh_error, q_error) - - iv % bogus(n) % q(k) % error = q_error - if (iv%bogus(n)% q(k) % error == missing_r) & - iv%bogus(n)% q(k) % qc = missing_data + ! the conversion is not needed for LSAC + if (iv%info(bogus)%name(n)(1:4) /= "LSAC") then + rh_error = iv%bogus(n)%q(k)%error ! q error is rh at this stage! + call da_get_q_error(iv % bogus(n) % p(k), & + ob % bogus(n) % t(k), & + ob % bogus(n) % q(k), & + iv % bogus(n) % t(k) % error, & + rh_error, q_error) + + iv % bogus(n) % q(k) % error = q_error + if (iv%bogus(n)% q(k) % error == missing_r) & + iv%bogus(n)% q(k) % qc = missing_data + end if !LSAC end do ob % bogus(n) % slp = iv % bogus(n) % slp % inv end do diff --git a/var/da/da_obs_io/da_obs_io.f90 b/var/da/da_obs_io/da_obs_io.f90 index 3a5ae9068b..2365d4e33a 100644 --- a/var/da/da_obs_io/da_obs_io.f90 +++ b/var/da/da_obs_io/da_obs_io.f90 @@ -29,7 +29,7 @@ module da_obs_io pi, ob_format_gpsro, ob_format_ascii, analysis_date, kms,kme, v_interp_h,v_interp_p, & wind_sd,wind_sd_synop,wind_sd_tamdar,wind_sd_mtgirs,wind_sd_profiler,wind_sd_geoamv,wind_sd_polaramv, & wind_sd_airep,wind_sd_sound,wind_sd_metar,wind_sd_ships,wind_sd_qscat,wind_sd_buoy,wind_sd_pilot,wind_stats_sd,& - thin_conv, thin_conv_ascii + thin_conv, thin_conv_ascii, lsac_nhskip, lsac_nvskip, lsac_calcerr, lsac_print_details use da_define_structures, only : iv_type, multi_level_type, multi_level_type_BUFR, & radar_multi_level_type, y_type, field_type, each_level_type, & @@ -56,6 +56,8 @@ module da_obs_io #endif use da_reporting, only : message, da_message use da_interpolation, only : da_to_zk + use da_netcdf_interface, only : da_get_var_3d_real_cdf, da_get_dims_cdf, & + da_get_var_2d_real_cdf implicit none @@ -91,5 +93,8 @@ module da_obs_io #include "da_write_noise_to_ob.inc" #include "da_final_write_filtered_obs.inc" #include "da_final_write_modified_filtered_obs.inc" +#include "da_read_lsac_util.inc" +#include "da_read_obs_lsac.inc" +#include "da_scan_obs_lsac.inc" end module da_obs_io diff --git a/var/da/da_obs_io/da_read_lsac_util.inc b/var/da/da_obs_io/da_read_lsac_util.inc new file mode 100644 index 0000000000..ba259ca165 --- /dev/null +++ b/var/da/da_obs_io/da_read_lsac_util.inc @@ -0,0 +1,314 @@ + +subroutine da_read_lsac_wrfinput(iv, onlyscan) + +implicit none + +type (iv_type), intent(inout) :: iv +logical , intent(in) :: onlyscan + +type (multi_level_type) :: platform +logical :: outside, outside_all + +integer :: i, j, k, ki, ndims, nrecs, nlocal, iunit, nlevels, ilevel +integer :: u_qc, v_qc, t_qc, q_qc, ierror +real :: u_ferr, v_ferr, t_ferr, q_ferr +character(len=512) :: lsac_wrfinput, lsac_output +integer, dimension(4) :: dims_u, dims_v, dims_t, dims_p, dims_q +integer, dimension(4) :: dims_lat, dims_lon, dims_alt, dims_phb, dims_ph +real, allocatable, dimension(:,:,:) :: u_lsac, v_lsac, w_lsac, t_lsac, p_lsac, q_lsac, taux_lsac +real, allocatable, dimension(:,:,:) :: pb_lsac, ph_lsac, phb_lsac, height_lsac, press +real, allocatable, dimension(:,:) :: lat_lsac, lon_lsac +logical :: debug +logical, external :: wrf_dm_on_monitor + +! If the errors are not calculated from equation, then a minimum value is set. +!Minimum Error +real, parameter :: u_ferrmin=2.5 ! [m/s] +real, parameter :: v_ferrmin=2.5 ! [m/s] +real, parameter :: t_ferrmin=2.0 ! [C] +real, parameter :: q_ferrmin=0.002 ! [Kg/Kg] + +! If the errors are calculated from equation, then the errors are a percentage of the full values +!Percentage +real, parameter :: u_err=25.0 ! [%] +real, parameter :: v_err=25.0 ! [%] +real, parameter :: t_err=15.0 ! [%] +real, parameter :: q_err=30.0 ! [%] + + +if (trace_use) call da_trace_entry("da_read_lsac_util") + +lsac_wrfinput = 'fg_l' +debug=.false. + +if (onlyscan) then + + call da_get_dims_cdf( lsac_wrfinput, 'XLAT', dims_lat, ndims, debug) + call da_get_dims_cdf( lsac_wrfinput, 'XLONG', dims_lon, ndims, debug) + call da_get_dims_cdf( lsac_wrfinput, 'T', dims_t, ndims, debug) + + allocate(lat_lsac(dims_lat(1), dims_lat(2))) + allocate(lon_lsac(dims_lon(1), dims_lon(2))) + + nlevels = dims_t(3)/lsac_nvskip + + !--------------------------------------------------------- + ! Reading data from WRF Input file + !--------------------------------------------------------- + call da_get_var_2d_real_cdf( lsac_wrfinput, 'XLAT', lat_lsac, dims_lat(1), dims_lat(2), 1, debug) + call da_get_var_2d_real_cdf( lsac_wrfinput, 'XLONG', lon_lsac, dims_lon(1), dims_lon(2), 1, debug) + + ! Calculating the errors and fill the iv type + nlocal=0 + nrecs =0 + do i=1, dims_lon(1), lsac_nhskip + do j=1, dims_lat(2), lsac_nhskip + platform%info%lat = lat_lsac(i,j) + platform%info%lon = lon_lsac(i,j) + platform%info%elv = 0.0 + platform%info%name = 'LSAC' + platform%info%platform = 'FM-??? LSAC' + platform%info%id = '?????' + platform%info%date_char= '????-??-??_??:??:??' + platform%info%pstar = 0.000000000000000 + platform%info%levels = nlevels + if (platform%info%lon == 180.0 ) platform%info%lon =-180.000 + if (platform%info%lat < -89.9999 .or. platform%info%lat > 89.9999) then + platform%info%lon = 0.0 + endif + + call da_llxy (platform%info, platform%loc, outside, outside_all) + if (.not.outside) then + nlocal = nlocal+1 + endif + if (.not.outside_all) then + nrecs = nrecs+1 + endif + enddo + enddo + iv%info(bogus)%max_lev = nlevels + iv%info(bogus)%nlocal = nlocal + iv%info(bogus)%ntotal = nrecs + deallocate(lat_lsac) + deallocate(lon_lsac) +else + !--------------------------------------------------------- + ! Getting information from NETCDF files (WRF Input file) + !--------------------------------------------------------- + call da_get_dims_cdf( lsac_wrfinput, 'U', dims_u, ndims, debug) + call da_get_dims_cdf( lsac_wrfinput, 'V', dims_v, ndims, debug) + call da_get_dims_cdf( lsac_wrfinput, 'T', dims_t, ndims, debug) + call da_get_dims_cdf( lsac_wrfinput, 'PB', dims_p, ndims, debug) + call da_get_dims_cdf( lsac_wrfinput, 'QVAPOR', dims_q, ndims, debug) + call da_get_dims_cdf( lsac_wrfinput, 'XLAT', dims_lat, ndims, debug) + call da_get_dims_cdf( lsac_wrfinput, 'XLONG', dims_lon, ndims, debug) + call da_get_dims_cdf( lsac_wrfinput, 'PHB', dims_phb, ndims, debug) + call da_get_dims_cdf( lsac_wrfinput, 'PH', dims_ph, ndims, debug) + + ! It will be assimilated every "lsac_nhskip" data point in the horizontal and "lsac_nvskip" + ! in the vertical + nrecs = ( 1 + ( dims_lat(1) - 1 )/lsac_nhskip ) * ( 1 + ( dims_lat(2) - 1 )/lsac_nhskip ) + nlevels = dims_t(3)/lsac_nvskip + + !--------------------------------------------------------- + ! Allocating memory + !--------------------------------------------------------- + allocate(u_lsac(dims_u(1), dims_u(2), dims_u(3) )) + allocate(v_lsac(dims_v(1), dims_v(2), dims_v(3) )) + allocate(t_lsac(dims_t(1), dims_t(2), dims_t(3) )) + allocate(taux_lsac(dims_t(1), dims_t(2), dims_t(3) )) + allocate(p_lsac(dims_p(1), dims_p(2), dims_p(3) )) + allocate(pb_lsac(dims_p(1), dims_p(2), dims_p(3) )) + allocate(q_lsac(dims_q(1), dims_q(2), dims_q(3) )) + allocate(lat_lsac(dims_lat(1), dims_lat(2) )) + allocate(lon_lsac(dims_lon(1), dims_lon(2) )) + allocate(phb_lsac(dims_phb(1), dims_phb(2), dims_phb(3) )) + allocate(ph_lsac(dims_ph(1), dims_ph(2), dims_ph(3) )) + allocate(height_lsac(dims_ph(1), dims_ph(2), dims_ph(3) )) + allocate(press(dims_p(1), dims_p(2), dims_p(3) )) + + !--------------------------------------------------------- + ! Reading data from WRF Input file + !--------------------------------------------------------- + call da_get_var_3d_real_cdf( lsac_wrfinput, 'U', u_lsac, dims_u(1), dims_u(2), dims_u(3), 1, debug) + call da_get_var_3d_real_cdf( lsac_wrfinput, 'V', v_lsac, dims_v(1), dims_v(2), dims_v(3), 1, debug) + call da_get_var_3d_real_cdf( lsac_wrfinput, 'T', t_lsac, dims_t(1), dims_t(2), dims_t(3), 1, debug) + call da_get_var_3d_real_cdf( lsac_wrfinput, 'P', p_lsac, dims_p(1), dims_p(2), dims_p(3), 1, debug) + call da_get_var_3d_real_cdf( lsac_wrfinput, 'PB', pb_lsac, dims_p(1), dims_p(2), dims_p(3), 1, debug) + call da_get_var_3d_real_cdf( lsac_wrfinput, 'QVAPOR', q_lsac, dims_q(1), dims_q(2), dims_q(3), 1, debug) + call da_get_var_2d_real_cdf( lsac_wrfinput, 'XLAT', lat_lsac, dims_lat(1), dims_lat(2), 1, debug) + call da_get_var_2d_real_cdf( lsac_wrfinput, 'XLONG', lon_lsac, dims_lon(1), dims_lon(2), 1, debug) + call da_get_var_3d_real_cdf( lsac_wrfinput, 'PHB', phb_lsac, dims_phb(1), dims_phb(2), dims_phb(3), 1, debug) + call da_get_var_3d_real_cdf( lsac_wrfinput, 'PH', ph_lsac, dims_ph(1), dims_ph(2), dims_ph(3), 1, debug) + + !--------------------------------------------------------- + !Calculating the height + !--------------------------------------------------------- + height_lsac= (phb_lsac + ph_lsac)/9.8 + press=(p_lsac+pb_lsac)*0.01 + + !Temperature from potential temperature + taux_lsac=(300.0+t_lsac) * ( ( press/1000.0 )**(287.04/1004.5) ) + + if (lsac_print_details .and. wrf_dm_on_monitor() ) then + call da_get_unit(iunit) + open(iunit, file='lsac_details') + endif + + ! Calculating the errors and fill the iv type + nlocal=0 + do i=1, dims_lon(1), lsac_nhskip + do j=1, dims_lat(2), lsac_nhskip + ilevel = 0 + do k=1, dims_t(3), lsac_nvskip + ilevel = ilevel+1 + u_qc = 0 + v_qc = 0 + t_qc = 0 + q_qc = 0 + + if(lsac_calcerr) then + u_ferr=max( u_ferrmin , abs((u_lsac(i,j,k )*u_err)/100.0) ) + v_ferr=max( v_ferrmin , abs((v_lsac(i,j,k )*v_err)/100.0) ) + t_ferr=max( t_ferrmin , abs(((taux_lsac(i,j,k)-273.15)*t_err)/100.0) ) + q_ferr=max( q_ferrmin , abs((q_lsac(i,j,k )*q_err)/100.0) ) + else + u_ferr=u_ferrmin + v_ferr=v_ferrmin + t_ferr=t_ferrmin + q_ferr=q_ferrmin + endif + + platform%each(ilevel)%height=height_lsac(i,j,k) + + platform%each(ilevel)%u%inv=u_lsac(i,j,k) + platform%each(ilevel)%u%error=u_ferr + platform%each(ilevel)%u%qc=u_qc + + platform%each(ilevel)%v%inv=v_lsac(i,j,k) + platform%each(ilevel)%v%error=v_ferr + platform%each(ilevel)%v%qc=v_qc + + platform%each(ilevel)%t%inv=taux_lsac(i,j,k) + platform%each(ilevel)%t%error=t_ferr + platform%each(ilevel)%t%qc=t_qc + + platform%each(ilevel)%q%inv=q_lsac(i,j,k) + platform%each(ilevel)%q%error=q_ferr + platform%each(ilevel)%q%qc=q_qc + + if(lsac_print_details .and. wrf_dm_on_monitor() ) then + write(iunit,'(3f10.3,x,4(f10.3,x,f10.3,x,i4))') height_lsac(i,j,k), lat_lsac(i,j), lon_lsac(i,j), & + u_lsac(i,j,k) , u_ferr , u_qc, & + v_lsac(i,j,k) , v_ferr , v_qc, & + taux_lsac(i,j,k) , t_ferr , t_qc, & + q_lsac(i,j,k)*1000 , q_ferr*1000, q_qc + endif + enddo + platform%info%lat = lat_lsac(i,j) + platform%info%lon = lon_lsac(i,j) + platform%info%elv = height_lsac(i,j,dims_t(3)) + platform%info%name = 'LSAC' + platform%info%platform = 'FM-??? LSAC' + platform%info%id = '?????' + platform%info%date_char= '????-??-??_??:??:??' + platform%info%pstar = 0.000000000000000 + platform%info%levels = nlevels + if (platform%info%lon == 180.0 ) platform%info%lon =-180.000 + if (platform%info%lat < -89.9999 .or. platform%info%lat > 89.9999) then + platform%info%lon = 0.0 + endif + + call da_llxy (platform%info, platform%loc, outside, outside_all) + if (outside) then + cycle + endif + nlocal = nlocal+1 + + if (nlevels > 0) then + allocate (iv%bogus(nlocal)%h (1:nlevels)) + allocate (iv%bogus(nlocal)%p (1:nlevels)) + allocate (iv%bogus(nlocal)%u (1:nlevels)) + allocate (iv%bogus(nlocal)%v (1:nlevels)) + allocate (iv%bogus(nlocal)%t (1:nlevels)) + allocate (iv%bogus(nlocal)%q (1:nlevels)) + do ki = 1, nlevels + iv%bogus(nlocal)%h(ki) = platform%each(ki)%height + iv%bogus(nlocal)%p(ki) = missing_r + iv%bogus(nlocal)%u(ki) = platform%each(ki)%u + iv%bogus(nlocal)%v(ki) = platform%each(ki)%v + iv%bogus(nlocal)%t(ki) = platform%each(ki)%t + iv%bogus(nlocal)%q(ki) = platform%each(ki)%q + iv%bogus(nlocal)%slp%inv = 0. + iv%bogus(nlocal)%slp%qc = missing_data + iv%bogus(nlocal)%slp%error = missing_r + end do + else + nlevels = 1 + allocate (iv%bogus(nlocal)%h (1:nlevels)) + allocate (iv%bogus(nlocal)%p (1:nlevels)) + allocate (iv%bogus(nlocal)%u (1:nlevels)) + allocate (iv%bogus(nlocal)%v (1:nlevels)) + allocate (iv%bogus(nlocal)%t (1:nlevels)) + allocate (iv%bogus(nlocal)%q (1:nlevels)) + iv%bogus(nlocal)%h = missing_r + iv%bogus(nlocal)%p = missing_r + iv%bogus(nlocal)%u%inv = missing_r + iv%bogus(nlocal)%u%qc = missing + iv%bogus(nlocal)%u%error = abs(missing_r) + iv%bogus(nlocal)%v = iv%bogus(nlocal)%u + iv%bogus(nlocal)%t = iv%bogus(nlocal)%u + iv%bogus(nlocal)%q = iv%bogus(nlocal)%u + end if + + iv%info(bogus)%name(nlocal) = platform%info%name + iv%info(bogus)%platform(nlocal) = platform%info%platform + iv%info(bogus)%id(nlocal) = platform%info%id + iv%info(bogus)%date_char(nlocal) = platform%info%date_char + iv%info(bogus)%levels(nlocal) = platform%info%levels + iv%info(bogus)%lat(:,nlocal) = platform%info%lat + iv%info(bogus)%lon(:,nlocal) = platform%info%lon + iv%info(bogus)%elv(nlocal) = platform%info%elv + iv%info(bogus)%pstar(nlocal) = platform%info%pstar + iv%info(bogus)%max_lev = platform%info%levels + + iv%info(bogus)%slp(nlocal) = platform%loc%slp + iv%info(bogus)%pw(nlocal) = platform%loc%pw + iv%info(bogus)%x(:,nlocal) = platform%loc%x + iv%info(bogus)%y(:,nlocal) = platform%loc%y + iv%info(bogus)%i(:,nlocal) = platform%loc%i + iv%info(bogus)%j(:,nlocal) = platform%loc%j + iv%info(bogus)%dx(:,nlocal) = platform%loc%dx + iv%info(bogus)%dxm(:,nlocal) = platform%loc%dxm + iv%info(bogus)%dy(:,nlocal) = platform%loc%dy + iv%info(bogus)%dym(:,nlocal) = platform%loc%dym + iv%info(bogus)%proc_domain(:,nlocal) = platform%loc%proc_domain + ! iv%info(bogus)%proc_domain(:,nlocal) = .true. + ! iv%info(bogus)%proc_domain = .true. + ! iv%info(bogus)%proc_domain(1,1) = .true. + + iv%info(bogus)%obs_global_index(nlocal) = nlocal + enddo + enddo + deallocate(u_lsac) + deallocate(v_lsac) + deallocate(t_lsac) + deallocate(taux_lsac) + deallocate(p_lsac) + deallocate(pb_lsac) + deallocate(q_lsac) + deallocate(lat_lsac) + deallocate(lon_lsac) + deallocate(phb_lsac) + deallocate(ph_lsac) + deallocate(height_lsac) + deallocate(press) +endif + +if (lsac_print_details .and. wrf_dm_on_monitor() ) then + close(iunit) +endif + +if (trace_use) call da_trace_exit("da_read_lsac_util") + +end subroutine da_read_lsac_wrfinput diff --git a/var/da/da_obs_io/da_read_obs_lsac.inc b/var/da/da_obs_io/da_read_obs_lsac.inc new file mode 100644 index 0000000000..0be4ff73a7 --- /dev/null +++ b/var/da/da_obs_io/da_read_obs_lsac.inc @@ -0,0 +1,19 @@ +subroutine da_read_obs_lsac (iv) + + !----------------------------------------------------------------------- + ! Purpose: Read the lsac "observation" file + !----------------------------------------------------------------------- + + implicit none + + type (iv_type), intent(inout) :: iv + + + if (trace_use) call da_trace_entry("da_read_obs_lsac") + + call da_read_lsac_wrfinput(iv, .false.) + + if (trace_use) call da_trace_exit("da_read_obs_lsac") + +end subroutine da_read_obs_lsac + diff --git a/var/da/da_obs_io/da_scan_obs_lsac.inc b/var/da/da_obs_io/da_scan_obs_lsac.inc new file mode 100644 index 0000000000..34404f1706 --- /dev/null +++ b/var/da/da_obs_io/da_scan_obs_lsac.inc @@ -0,0 +1,15 @@ +subroutine da_scan_obs_lsac (iv) + + !--------------------------------------------------------------------------- + ! Purpose: Scan the radar observation file + !--------------------------------------------------------------------------- + + implicit none + + type (iv_type), intent(inout) :: iv + + call da_read_lsac_wrfinput(iv, .true.) + + if (trace_use) call da_trace_exit("da_scan_obs_lsac") + +end subroutine da_scan_obs_lsac diff --git a/var/da/da_setup_structures/da_setup_obs_structures.inc b/var/da/da_setup_structures/da_setup_obs_structures.inc index 04d729739c..95385bd80e 100644 --- a/var/da/da_setup_structures/da_setup_obs_structures.inc +++ b/var/da/da_setup_structures/da_setup_obs_structures.inc @@ -78,7 +78,7 @@ subroutine da_setup_obs_structures( grid, ob, iv, j_cost) use_satemobs .OR. use_geoamvobs .OR. use_polaramvobs .OR. use_airepobs .OR. use_tamdarobs .OR. & use_gpspwobs .OR. use_gpsztdobs .OR. use_gpsrefobs .OR. use_ssmiretrievalobs .OR. & use_ssmitbobs .OR. use_ssmt1obs .OR. use_ssmt2obs .OR. use_qscatobs .OR. & - use_airsretobs) then + use_airsretobs .OR. use_lsac) then use_obsgts = .true. else diff --git a/var/da/da_setup_structures/da_setup_obs_structures_ascii.inc b/var/da/da_setup_structures/da_setup_obs_structures_ascii.inc index 7ab3908d69..a1b494a802 100644 --- a/var/da/da_setup_structures/da_setup_obs_structures_ascii.inc +++ b/var/da/da_setup_structures/da_setup_obs_structures_ascii.inc @@ -103,6 +103,10 @@ subroutine da_setup_obs_structures_ascii( ob, iv, grid ) call da_scan_obs_ssmi (iv, filename) end if + if (use_lsac) then + call da_scan_obs_lsac(iv) + endif + iv%info(:)%plocal(n) = iv%info(:)%nlocal iv%info(:)%ptotal(n) = iv%info(:)%ntotal end do @@ -116,6 +120,10 @@ subroutine da_setup_obs_structures_ascii( ob, iv, grid ) call da_scan_obs_ssmi(iv, 'ob.ssmi') end if + if (use_lsac) then + call da_scan_obs_lsac(iv) + endif + do i=1,num_ob_indexes if (i == radar) cycle iv%info(i)%plocal(iv%time) = iv%info(i)%nlocal @@ -145,6 +153,10 @@ subroutine da_setup_obs_structures_ascii( ob, iv, grid ) call da_read_obs_ssmi (iv, filename) end if + if (use_lsac) then + call da_read_obs_lsac(iv) + end if + do i=1,num_ob_indexes if (i == radar) cycle iv%info(i)%thin_ptotal(n) = iv%info(i)%thin_ntotal @@ -161,6 +173,10 @@ subroutine da_setup_obs_structures_ascii( ob, iv, grid ) call da_read_obs_ssmi (iv, 'ob.ssmi') end if + if (use_lsac) then + call da_read_obs_lsac(iv) + end if + do i=1,num_ob_indexes if (i == radar) cycle iv%info(i)%thin_ptotal(iv%time) = iv%info(i)%thin_ntotal diff --git a/var/da/da_setup_structures/da_setup_structures.f90 b/var/da/da_setup_structures/da_setup_structures.f90 index c2cab99c95..e1a1277d14 100644 --- a/var/da/da_setup_structures/da_setup_structures.f90 +++ b/var/da/da_setup_structures/da_setup_structures.f90 @@ -66,7 +66,7 @@ module da_setup_structures chi_u_t_factor, chi_u_ps_factor,chi_u_rh_factor, t_u_rh_factor, ps_u_rh_factor, & interpolate_stats, be_eta, thin_rainobs, fgat_rain_flags, use_iasiobs, & use_seviriobs, jds_int, jde_int, anal_type_hybrid_dual_res, use_amsr2obs, nrange, use_4denvar - use da_control, only: rden_bin + use da_control, only: rden_bin, use_lsac use da_control, only: use_cv_w use da_control, only: pseudo_tpw, pseudo_ztd, pseudo_ref, pseudo_uvtpq, pseudo_elv, anal_type_qcobs @@ -74,7 +74,8 @@ module da_setup_structures da_fill_obs_structures_rain, da_fill_obs_structures_radar, da_set_obs_missing,da_set_3d_obs_missing use da_obs_io, only : da_read_obs_bufr,da_read_obs_radar, & da_scan_obs_radar,da_scan_obs_ascii,da_read_obs_ascii, & - da_read_obs_bufrgpsro, da_scan_obs_rain, da_read_obs_rain + da_read_obs_bufrgpsro, da_scan_obs_rain, da_read_obs_rain, & + da_read_obs_lsac, da_scan_obs_lsac use da_par_util1, only : da_proc_sum_real, da_proc_sum_int, da_proc_sum_ints use da_par_util, only : da_patch_to_global use da_lapack, only : dsyev From 2c71e61c434ec7f65954120cf45ec5133293b4f0 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Wed, 8 Mar 2017 16:03:22 -0700 Subject: [PATCH 03/91] Radar neighborhood no-rain scheme (radar_non_precip_opt=2) from Shibo Gao of Nanjing University of Information Science & Technology, China. MPI re-coded by Jamie Bresch of NCAR. modified: Registry/registry.var modified: var/da/da_minimisation/da_get_innov_vector.inc modified: var/da/da_minimisation/da_minimisation.f90 modified: var/da/da_radar/da_get_innov_vector_radar.inc modified: var/da/da_radar/da_radar.f90 --- Registry/registry.var | 2 +- .../da_minimisation/da_get_innov_vector.inc | 10 +- var/da/da_radar/da_get_innov_vector_radar.inc | 225 +++++++++++++++++- var/da/da_radar/da_radar.f90 | 4 + 4 files changed, 233 insertions(+), 8 deletions(-) diff --git a/Registry/registry.var b/Registry/registry.var index 0516b9135f..8d5b262dac 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -457,7 +457,7 @@ rconfig character pseudo_var namelist,wrfvar19 1 "t" rconfig character documentation_url namelist,wrfvar20 1 "http://www.mmm.ucar.edu/people/wrfhelp/wrfvar/code/trunk" - "documentation_url" "" "" rconfig character time_window_min namelist,wrfvar21 1 "2002-08-02_21:00:00.0000" - "time_window_min" "" "" rconfig character time_window_max namelist,wrfvar22 1 "2002-08-03_03:00:00.0000" - "time_window_max" "" "" -rconfig integer radar_non_precip_opt namelist,radar_da 1 0 - "radar_non_precip_opt" "" "0: off, 1: KNU scheme" +rconfig integer radar_non_precip_opt namelist,radar_da 1 0 - "radar_non_precip_opt" "" "0: off, 1: KNU scheme, 2: NCAR neighborhood scheme" rconfig real radar_non_precip_rf namelist,radar_da 1 -999.99 - "radar_non_precip_rf" "rf value used to indicate non-precip ob" "dBZ" rconfig real radar_non_precip_rh_w namelist,radar_da 1 95.0 - "radar_non_precip_rh_w" "RH wrt water for non_precip rqv" "%" rconfig real radar_non_precip_rh_i namelist,radar_da 1 85.0 - "radar_non_precip_rh_i" "RH wrt ice for non_precip rqv" "%" diff --git a/var/da/da_minimisation/da_get_innov_vector.inc b/var/da/da_minimisation/da_get_innov_vector.inc index b1a49bdb98..4e90e6d894 100644 --- a/var/da/da_minimisation/da_get_innov_vector.inc +++ b/var/da/da_minimisation/da_get_innov_vector.inc @@ -2,9 +2,11 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) !----------------------------------------------------------------------- - ! Purpose: TBD - ! Updated for Analysis on Arakawa-C grid - ! Author: Syed RH Rizvi, MMM/ESSL/NCAR, Date: 10/22/2008 + ! Purpose: driver routine for getting innovation vectors + ! History:$ + ! 10/22/2008 - Updated for Analysis on Arakawa-C grid (Syed RH Rizvi, NCAR) + ! 03/2017 - Radar neighborhood no-rain scheme (radar_non_precip_opt=2) + ! requires all processors to call da_get_innov_vector_radar !----------------------------------------------------------------------- implicit none @@ -146,7 +148,7 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) call da_get_innov_vector_ssmt2 (it, num_qcstat_conv,grid, ob, iv) if (iv%info(satem)%nlocal > 0) & call da_get_innov_vector_satem (it, num_qcstat_conv,grid, ob, iv) - if (iv%info(radar)%nlocal > 0) & + if (iv%info(radar)%nlocal >= 0 .and. use_radarobs) & call da_get_innov_vector_radar (it, grid, ob, iv) if (iv%info(qscat)%nlocal > 0) & call da_get_innov_vector_qscat (it, num_qcstat_conv,grid, ob, iv) diff --git a/var/da/da_radar/da_get_innov_vector_radar.inc b/var/da/da_radar/da_get_innov_vector_radar.inc index 9de66c8670..19ebe261ae 100644 --- a/var/da/da_radar/da_get_innov_vector_radar.inc +++ b/var/da/da_radar/da_get_innov_vector_radar.inc @@ -8,9 +8,14 @@ subroutine da_get_innov_vector_radar (it, grid, ob, iv) ! 08/08/2016 - Updated to include null-echo assimilation ! (Yu-Shin Kim and Ki-Hong Min, School of Earth System ! Sciences/Kyungpook National University, Daegu, S.Korea) + ! 03/2017 - radar neighborhood no-rain scheme (radar_non_precip_opt=2) + ! requires all processors to call this subroutine !----------------------------------------------------------------------- implicit none +#ifdef DM_PARALLEL + include 'mpif.h' +#endif integer, intent(in) :: it ! External iteration. type(domain), intent(in) :: grid ! first guess state. @@ -62,6 +67,20 @@ subroutine da_get_innov_vector_radar (it, grid, ob, iv) logical :: echo_non_precip, echo_rf_good + ! variables for neighborhood no-rain scheme (radar_non_precip_opt=2) + integer :: proc, i_start, i_end, itmp1, itmp2 + integer :: norain + integer :: nk, ncount_local, ncount_sum, s + integer, allocatable :: ncount_all(:), rec(:) + integer, allocatable :: counts(:), displs(:) + integer, allocatable :: decrease(:), decrease_glob(:), decrease_local(:) + real :: range_x, range_y, range_z + real :: coefa, coefb, coefc + real, allocatable :: rf_local(:), i_local(:), j_local(:), z_local(:) + real, allocatable :: qrn_local(:), qs_local(:), qv_local(:) + real, allocatable :: obs_global(:), x_global(:), y_global(:), z_global(:) + real, allocatable :: qrn_global(:), qs_global(:), qv_global(:) + alog_10 = alog(10.0) ! Ze=zv*(ro*v)**1.75 @@ -76,7 +95,6 @@ subroutine da_get_innov_vector_radar (it, grid, ob, iv) irv = 0; irvf = 0; irf = 0; irff = 0 - ! No point in going through and allocating all these variables if we're just going to quit anyway if ( use_radar_rf .and. use_radar_rhv ) then @@ -85,7 +103,7 @@ subroutine da_get_innov_vector_radar (it, grid, ob, iv) call da_error(__FILE__,__LINE__,message(1:2)) end if - +if ( iv%info(radar)%nlocal > 0 ) then allocate (model_p(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) allocate (model_u(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) allocate (model_v(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) @@ -203,6 +221,8 @@ END IF end do end if +end if ! nlocal>0 + ! calculate background/model LCL to be used by use_radar_rqv if ( use_radar_rqv .and. cloudbase_calc_opt == 2 ) then do j = jts, jte @@ -212,6 +232,7 @@ END IF end do end if ! lcl for use_radar_rqv +if ( iv%info(radar)%nlocal > 0 ) then do n=iv%info(radar)%n1,iv%info(radar)%n2 if ( use_radar_rf ) then @@ -460,7 +481,7 @@ END IF iv % radar(n) % rqv(k) % qc = -5 if ( echo_non_precip ) then ! ob is non-precip - if ( radar_non_precip_opt > 0 ) then ! assimilate non_precip echo + if ( radar_non_precip_opt == 1 ) then ! assimilate non_precip echo if ( bg_rf >= 20.0 .and. iv%radar(n)%height(k) > model_lcl(n) ) then iv % radar(n) % rqv(k) % qc = 0 @@ -529,11 +550,207 @@ END IF end if ! not surface or model lid end do level_loop end do +end if ! nlocal>0 + + if ( use_radar_rqv .and. radar_non_precip_opt == 2 ) then ! neighborhood no-rain scheme + + ncount_local = 0 + if ( iv%info(radar)%nlocal > 0 ) then + do n = iv%info(radar)%n1,iv%info(radar)%n2 + do k = 1,iv%info(radar)%levels(n) + ncount_local = ncount_local + 1 + end do + end do + end if + + allocate (ncount_all(0:num_procs-1)) +#ifdef DM_PARALLEL + call mpi_allgather( ncount_local, 1, mpi_integer, & + ncount_all, 1, mpi_integer, comm, ierr ) +#else + ncount_all(:) = ncount_local +#endif + ncount_sum = sum(ncount_all) + + allocate ( rf_local(ncount_local)) + allocate ( i_local(ncount_local)) + allocate ( j_local(ncount_local)) + allocate ( z_local(ncount_local)) + allocate (qrn_local(ncount_local)) + allocate ( qs_local(ncount_local)) + allocate ( qv_local(ncount_local)) + + if ( iv%info(radar)%nlocal > 0 ) then + nk = 0 + do n = iv%info(radar)%n1,iv%info(radar)%n2 + do k = 1,iv%info(radar)%levels(n) + nk = nk + 1 + rf_local(nk) = ob%radar(n)%rf(k) + i_local(nk) = iv%info(radar)%i(k,n) + j_local(nk) = iv%info(radar)%j(k,n) + z_local(nk) = iv%radar(n)%height(k) - iv%radar(n)%stn_loc%elv + qrn_local(nk) = model_qrn(k,n) + qs_local(nk) = model_qs(k,n) + qv_local(nk) = model_qv(k,n) + end do + end do + end if + + allocate (obs_global(ncount_sum)) + allocate ( x_global(ncount_sum)) + allocate ( y_global(ncount_sum)) + allocate ( z_global(ncount_sum)) + allocate (qrn_global(ncount_sum)) + allocate ( qs_global(ncount_sum)) + allocate ( qv_global(ncount_sum)) + +#ifdef DM_PARALLEL + allocate (counts(0:num_procs-1)) + allocate (displs(0:num_procs-1)) + counts(:) = ncount_all(:) + displs(0) = 0 + do proc = 1, num_procs-1 + displs(proc) = displs(proc-1) + counts(proc-1) + end do + call mpi_allgatherv( rf_local, ncount_local, true_mpi_real, & + obs_global, counts, displs, true_mpi_real, & + comm, ierr ) + call mpi_allgatherv( i_local, ncount_local, true_mpi_real, & + x_global, counts, displs, true_mpi_real, & + comm, ierr ) + call mpi_allgatherv( j_local, ncount_local, true_mpi_real, & + y_global, counts, displs, true_mpi_real, & + comm, ierr ) + call mpi_allgatherv( z_local, ncount_local, true_mpi_real, & + z_global, counts, displs, true_mpi_real, & + comm, ierr ) + call mpi_allgatherv( qrn_local, ncount_local, true_mpi_real, & + qrn_global, counts, displs, true_mpi_real, & + comm, ierr ) + call mpi_allgatherv( qs_local, ncount_local, true_mpi_real, & + qs_global, counts, displs, true_mpi_real, & + comm, ierr ) + call mpi_allgatherv( qv_local, ncount_local, true_mpi_real, & + qv_global, counts, displs, true_mpi_real, & + comm, ierr ) +#else + obs_global(:) = rf_local(:) + x_global(:) = i_local(:) + y_global(:) = j_local(:) + z_global(:) = z_local(:) + qrn_global(:) = qrn_local(:) + qs_global(:) = qs_local(:) + qv_global(:) = qv_local(:) +#endif + + deallocate ( rf_local) + deallocate ( i_local) + deallocate ( j_local) + deallocate ( z_local) + deallocate (qrn_local) + deallocate ( qs_local) + deallocate ( qv_local) + deallocate(ncount_all) + + ! determine the loop indices (i_start, i_end) for each proc given ncount_sum + itmp1 = ncount_sum/num_procs + itmp2 = mod(ncount_sum, num_procs) + i_start = myproc * itmp1 + 1 + min(myproc, itmp2) + i_end = i_start + itmp1 - 1 + if (itmp2 > myproc) i_end = i_end + 1 + + !todo: range_x/y/z should be namelist variables + range_x = 30000.0 !meter + range_y = 30000.0 !meter + range_z = 3000.0 !meter + coefa = (grid%dx/range_x)**2 + coefb = (grid%dx/range_y)**2 + coefc = (1.0/range_z)**2 + + allocate ( rec(ncount_sum)) + allocate ( decrease(ncount_sum)) + decrease(:) = 0 + do s = i_start, i_end + ! if non-precip obs (rf = radar_non_precip_rf) + echo_non_precip = abs(obs_global(s) - radar_non_precip_rf) < 0.1 + if ( echo_non_precip .and. qrn_global(s)>0.0 .and. qv_global(s) > 0.85*qs_global(s))then + i=0 + do n = 1, ncount_sum + if ( ((x_global(s)-x_global(n))**2*coefa + & + (y_global(s)-y_global(n))**2*coefb + & + (z_global(s)-z_global(n))**2*coefc) <= 1 ) then + i = i+1 + rec(i) = n + end if + end do + if ( i > 0 ) then + norain = 0 + do n = 1, i + if ( abs(obs_global(rec(n)) - radar_non_precip_rf) < 0.1 ) then + norain = norain + 1 + end if + end do + if ( float(norain)/float(i) >= 0.85 ) then + decrease(s) = 1 + end if + end if + end if + end do + deallocate (rec) + deallocate (obs_global) + deallocate ( x_global) + deallocate ( y_global) + deallocate ( z_global) + deallocate (qrn_global) + deallocate ( qs_global) + deallocate ( qv_global) + + allocate (decrease_local(ncount_local)) +#ifdef DM_PARALLEL + allocate ( decrease_glob(ncount_sum)) + call mpi_reduce(decrease, decrease_glob, ncount_sum, & + mpi_integer, mpi_sum, root, comm, ierr) + call mpi_scatterv(decrease_glob, counts, displs, mpi_integer, & + decrease_local, ncount_local, mpi_integer, & + root, comm, ierr) + deallocate (decrease_glob) +#else + decrease_local = decrease +#endif + + if ( iv%info(radar)%nlocal > 0 ) then + nk = 0 + do n = iv%info(radar)%n1, iv%info(radar)%n2 + do k = 1, iv%info(radar)%levels(n) + nk = nk + 1 !index for decrease_local array + echo_non_precip = abs(ob%radar(n)%rf(k) - radar_non_precip_rf) < 0.1 + if ( echo_non_precip .and. decrease_local(nk)==1 .and. & + model_qrn(k,n)>0.0 .and. model_qv(k,n) > 0.85*model_qs(k,n) .and. & + iv%radar(n)%height(k) > model_lcl(n) ) then + iv % radar(n) % rqv(k) % qc = 0 + iv % radar(n) % rf(k) % qc = 0 + iv % radar(n) % rqvo(k) = 0.9*model_qv(k,n) + iv % radar(n) % rqv(k) % inv = iv % radar(n) % rqvo(k) - model_qv(k,n) + iv % radar(n) % rqv(k) % error = amax1(0.001,0.20*iv % radar(n) % rqvo(k)) + end if + end do !k loop + end do !n1-n2 loop + end if !nlocal>0 + + deallocate (decrease) + deallocate (decrease_local) +#ifdef DM_PARALLEL + deallocate(counts) + deallocate(displs) +#endif + + end if ! use_radar_rqv and radar_non_precip_opt=2 !------------------------------------------------------------------------ ! [4.0] Perform optional maximum error check: !------------------------------------------------------------------------ +if ( iv%info(radar)%nlocal > 0 ) then if (check_max_iv) then call da_check_max_iv_radar(iv, it, irv, irf, irvf, irff) end if @@ -578,6 +795,8 @@ END IF deallocate (model_qs_ice) end if +end if ! nlocal>0 + if (trace_use) call da_trace_exit("da_get_innov_vector_radar") end subroutine da_get_innov_vector_radar diff --git a/var/da/da_radar/da_radar.f90 b/var/da/da_radar/da_radar.f90 index 2cf005901c..fe8316d0a1 100644 --- a/var/da/da_radar/da_radar.f90 +++ b/var/da/da_radar/da_radar.f90 @@ -30,6 +30,10 @@ module da_radar use da_tracing, only : da_trace_entry, da_trace_exit use da_reporting, only : da_error, da_warning, da_message, message use da_tools_serial, only : da_get_unit, da_free_unit +#ifdef DM_PARALLEL + use da_control, only : root + use da_par_util1, only : true_mpi_real +#endif ! The "stats_radar_type" is ONLY used locally in da_radar: From ba040683af53d6ec87cb4aa1f7e15ce05b31f526 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Wed, 19 Apr 2017 11:51:14 -0600 Subject: [PATCH 04/91] Add README.CWB_v39a new file: README.CWB_v39a --- README.CWB_v39a | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) create mode 100644 README.CWB_v39a diff --git a/README.CWB_v39a b/README.CWB_v39a new file mode 100644 index 0000000000..20fc091e2c --- /dev/null +++ b/README.CWB_v39a @@ -0,0 +1,22 @@ +This CWB_v39a code is branched off from the offical V3.9 release (commit hash eee16e3) +with the following new features added. + +New features (only in the CWB branch): + 1. Divergence constaint capability. + 2. Large Scale Analysis Constraint capability. + 3. Radar neighborhood no-rain scheme (radar_non_precip_opt=2). + +General WRFDA improvements in V3.9 that are relevant to CWB's applications. + 1. Implementation of WRFDA cloud control variables is improved. + (1) Namelist cloud_cv_options default is changed from 1 to 0 (no cloud cv). + (2) Namelist variable use_3dvar_phy is removed. + (3) Setting environment variable CLOUD_CV is no longer needed. + -- Make the allocations of cloud variables in the be (background error) + structure depend on cloud_cv_options. + (4) Separate the w (z-wind) control variable from the handling of + cloud control variables and add a new namelist use_cv_w for it. + 2. Dual-resolution hybrid code is fixed and cleaned up. + 3. Pseudo ob implementation for ref/tpw/ztd is fixed and improved. + +Note that this version of code requires more memory due to the implementation +of new 4D-Ensemble-Var capability. From b6fc6034b0cc7aeeed303880866ccc47555f6b9d Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Mon, 1 May 2017 11:14:18 -0600 Subject: [PATCH 05/91] Multi-Resolution-Incremental 4DVAR from Jake Liu of NCAR. git cherry-pick -n 070d870 96fb5f3 ------ Merge 2016's MRI-4DVAR code changes into WRFDA V3.9. Tested on NCAR HPC cheyenne and obtained similar result to previous V3.8-based code ran on yellowstone. ------ modified: Registry/registry.var modified: var/build/depend.txt modified: var/da/da_main/da_solve.inc modified: var/da/da_main/da_wrfvar_top.f90 modified: var/da/da_recursive_filter/da_recursive_filter.f90 new file: var/da/da_recursive_filter/da_recursive_filter_1d_inv.inc modified: var/da/da_recursive_filter/da_transform_through_rf.inc new file: var/da/da_recursive_filter/da_transform_through_rf_inv.inc modified: var/da/da_setup_structures/da_setup_structures.f90 new file: var/da/da_setup_structures/da_write_vp.inc modified: var/da/da_vtox_transforms/da_transform_vptox.inc new file: var/da/da_vtox_transforms/da_transform_vptox_inv.inc new file: var/da/da_vtox_transforms/da_transform_vtovv_inv.inc new file: var/da/da_vtox_transforms/da_transform_vtox_inv.inc modified: var/da/da_vtox_transforms/da_transform_vvtovp.inc modified: var/da/da_vtox_transforms/da_transform_vvtovp_adj.inc new file: var/da/da_vtox_transforms/da_transform_vvtovp_inv.inc modified: var/da/da_vtox_transforms/da_vertical_transform.inc modified: var/da/da_vtox_transforms/da_vtox_transforms.f90 --- Registry/registry.var | 2 + var/build/depend.txt | 6 +- var/da/da_main/da_solve.inc | 150 ++++++-- var/da/da_main/da_wrfvar_top.f90 | 8 +- .../da_recursive_filter.f90 | 2 + .../da_recursive_filter_1d_inv.inc | 88 +++++ .../da_transform_through_rf.inc | 9 +- .../da_transform_through_rf_inv.inc | 189 ++++++++++ .../da_setup_structures.f90 | 3 +- var/da/da_setup_structures/da_write_vp.inc | 136 +++++++ .../da_vtox_transforms/da_transform_vptox.inc | 85 +++-- .../da_transform_vptox_inv.inc | 348 ++++++++++++++++++ .../da_transform_vtovv_inv.inc | 249 +++++++++++++ .../da_transform_vtox_inv.inc | 87 +++++ .../da_transform_vvtovp.inc | 10 +- .../da_transform_vvtovp_adj.inc | 2 +- .../da_transform_vvtovp_inv.inc | 62 ++++ .../da_vertical_transform.inc | 101 +++-- .../da_vtox_transforms/da_vtox_transforms.f90 | 6 +- 19 files changed, 1407 insertions(+), 136 deletions(-) create mode 100644 var/da/da_recursive_filter/da_recursive_filter_1d_inv.inc create mode 100644 var/da/da_recursive_filter/da_transform_through_rf_inv.inc create mode 100644 var/da/da_setup_structures/da_write_vp.inc create mode 100644 var/da/da_vtox_transforms/da_transform_vptox_inv.inc create mode 100644 var/da/da_vtox_transforms/da_transform_vtovv_inv.inc create mode 100644 var/da/da_vtox_transforms/da_transform_vtox_inv.inc create mode 100644 var/da/da_vtox_transforms/da_transform_vvtovp_inv.inc diff --git a/Registry/registry.var b/Registry/registry.var index 8d5b262dac..e279ea2b38 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -246,6 +246,8 @@ rconfig logical gpsref_thinning namelist,wrfvar5 1 .false. - "gps rconfig logical outer_loop_restart namelist,wrfvar6 1 .false. - "outer_loop_restart" "" "" rconfig integer max_ext_its namelist,wrfvar6 1 1 - "max_ext_its" "" "" rconfig integer ntmax namelist,wrfvar6 max_outer_iterations 200 - "ntmax" "" "" +rconfig logical use_inverse_squarerootb namelist,wrfvar6 1 .false. - "use_inverse_squarerootb" "" "" +rconfig logical use_interpolate_cvt namelist,wrfvar6 1 .false. - "use_interpolate_cvt" "" "" rconfig integer nsave namelist,wrfvar6 1 4 - "nsave" "" "" rconfig integer write_interval namelist,wrfvar6 1 5 - "write_interval" "" "" rconfig real eps namelist,wrfvar6 max_outer_iterations 0.01 - "eps" "" "" diff --git a/var/build/depend.txt b/var/build/depend.txt index 933e07040f..72ff725fc3 100644 --- a/var/build/depend.txt +++ b/var/build/depend.txt @@ -145,14 +145,14 @@ da_radar.o : da_radar.f90 da_write_oa_radar_ascii.inc da_max_error_qc_radar.inc da_radiance.o : da_radiance.f90 da_blacklist_rad.inc da_read_pseudo_rad.inc da_get_innov_vector_radiance.inc da_radiance_init.inc da_setup_radiance_structures.inc da_sort_rad.inc da_read_kma1dvar.inc da_initialize_rad_iv.inc da_allocate_rad_iv.inc da_read_obs_bufrssmis.inc da_read_obs_bufrairs.inc da_read_obs_bufriasi.inc da_read_obs_bufrseviri.inc da_read_obs_bufrtovs.inc da_write_filtered_rad.inc da_read_simulated_rad.inc da_read_filtered_rad.inc da_calculate_grady_rad.inc gsi_thinning.o da_wrf_interfaces.o da_varbc.o da_tracing.o da_tools.o da_statistics.o da_rttov.o da_reporting.o da_radiance1.o da_physics.o da_par_util.o da_par_util1.o da_tools_serial.o da_interpolation.o da_define_structures.o da_crtm.o da_control.o module_radiance.o module_domain.o amsr2time_.c da_read_obs_hdf5amsr2.inc da_deallocate_radiance.inc da_radiance1.o : da_radiance1.f90 da_mspps_ts.inc da_mspps_emis.inc da_setup_satcv.inc da_qc_rad.inc da_print_stats_rad.inc da_oi_stats_rad.inc da_ao_stats_rad.inc da_cld_eff_radius.inc da_detsurtyp.inc da_write_oa_rad_ascii.inc da_write_iv_rad_ascii.inc da_qc_mhs.inc da_qc_ssmis.inc da_qc_hirs.inc da_qc_amsub.inc da_qc_amsua.inc da_qc_airs.inc da_cloud_detect_airs.inc da_cloud_sim.inc da_qc_seviri.inc da_qc_iasi.inc da_cloud_detect_iasi.inc da_qc_crtm.inc da_predictor_crtm.inc da_predictor_rttov.inc da_write_biasprep.inc da_biasprep.inc da_read_biascoef.inc da_biascorr.inc da_residual_rad.inc da_jo_and_grady_rad.inc gsi_constants.o da_tracing.o da_tools_serial.o da_tools.o da_statistics.o da_reporting.o da_par_util1.o da_par_util.o module_dm.o da_define_structures.o da_control.o module_radiance.o da_qc_amsr2.inc da_rain.o : da_rain.f90 da_calculate_grady_rain.inc da_get_innov_vector_rain.inc da_get_hr_rain.inc da_check_max_iv_rain.inc da_transform_xtoy_rain_adj.inc da_transform_xtoy_rain.inc da_print_stats_rain.inc da_oi_stats_rain.inc da_residual_rain.inc da_jo_and_grady_rain.inc da_ao_stats_rain.inc da_tracing.o da_tools.o da_statistics.o da_par_util.o da_par_util1.o da_interpolation.o da_define_structures.o da_control.o module_comm_dm.o module_dm.o module_domain.o -da_recursive_filter.o : da_recursive_filter.f90 da_apply_rf_adj.inc da_apply_rf.inc da_apply_rf_1v_adj.inc da_apply_rf_1v.inc da_transform_through_rf_adj.inc da_transform_through_rf.inc da_recursive_filter_1d_adj.inc da_recursive_filter_1d.inc da_calculate_rf_factors.inc da_transform_through_rf_dual_res.inc da_transform_through_rf_adj_dual_res.inc da_perform_2drf.inc da_rf_cv3.o da_rfz_cv3.o da_tracing.o da_par_util.o da_define_structures.o da_control.o module_domain.o +da_recursive_filter.o : da_recursive_filter.f90 da_apply_rf_adj.inc da_apply_rf.inc da_apply_rf_1v_adj.inc da_apply_rf_1v.inc da_transform_through_rf_adj.inc da_transform_through_rf.inc da_transform_through_rf_inv.inc da_recursive_filter_1d_adj.inc da_recursive_filter_1d.inc da_recursive_filter_1d_inv.inc da_calculate_rf_factors.inc da_transform_through_rf_dual_res.inc da_transform_through_rf_adj_dual_res.inc da_perform_2drf.inc da_rf_cv3.o da_rfz_cv3.o da_tracing.o da_par_util.o da_define_structures.o da_control.o module_domain.o da_reporting.o : da_reporting.f90 da_message2.inc da_message.inc da_warning.inc da_error.inc da_control.o da_rf_cv3.o : da_rf_cv3.f90 da_mat_cv3.o da_rfz_cv3.o : da_rfz_cv3.f90 da_rsl_interfaces.o : da_rsl_interfaces.f90 da_rttov.o : da_rttov.f90 da_rttov_ad.inc da_rttov_tl.inc da_rttov_direct.inc da_rttov_init.inc da_transform_xtoy_rttov_adj.inc da_transform_xtoy_rttov.inc da_get_innov_vector_rttov.inc da_rttov_k.inc da_wrf_interfaces.o da_tracing.o da_tools.o da_radiance1.o da_par_util.o da_tools_serial.o da_interpolation.o da_control.o module_radiance.o da_reporting.o module_domain.o da_define_structures.o da_satem.o : da_satem.f90 da_calculate_grady_satem.inc da_get_innov_vector_satem.inc da_check_max_iv_satem.inc da_transform_xtoy_satem_adj.inc da_transform_xtoy_satem.inc da_print_stats_satem.inc da_oi_stats_satem.inc da_residual_satem.inc da_jo_and_grady_satem.inc da_ao_stats_satem.inc da_tracing.o da_tools.o da_statistics.o da_physics.o da_par_util1.o da_par_util.o da_define_structures.o da_control.o module_domain.o -da_setup_structures.o : da_setup_structures.f90 da_truncate_spectra.inc da_get_bins_info.inc da_write_kma_increments.inc da_write_increments_for_wrf_nmm_regional.inc da_write_increments.inc da_qfrmrh.inc da_cumulus.inc da_lcl.inc da_cloud_model.inc da_setup_runconstants.inc da_setup_obs_interp_wts.inc da_setup_obs_structures_madis.inc da_setup_obs_structures_bufr.inc da_setup_obs_structures_ascii.inc da_setup_obs_structures_rain.inc da_setup_obs_structures_radar.inc da_setup_obs_structures.inc da_setup_flow_predictors.inc da_setup_flow_predictors_para_read_opt1.inc da_chgvres.inc da_setup_cv.inc da_setup_be_nmm_regional.inc da_setup_be_regional.inc da_setup_be_ncep_gfs.inc da_setup_be_global.inc da_setup_background_errors.inc da_scale_background_errors.inc da_scale_background_errors_cv3.inc da_rescale_background_errors.inc da_interpolate_regcoeff.inc da_get_vertical_truncation.inc gsi_thinning.o module_radiance.o da_rf_cv3.o da_rfz_cv3.o da_vtox_transforms.o da_tracing.o da_tools.o da_tools_serial.o da_ssmi.o da_spectral.o da_recursive_filter.o da_reporting.o da_radiance.o da_par_util.o da_par_util1.o da_obs_io.o da_obs.o da_control.o da_wrf_interfaces.o da_define_structures.o module_domain.o da_wavelet.o da_chg_be_Vres.inc da_gen_eigen.inc da_eigen_to_covmatrix.inc da_setup_pseudo_obs.inc +da_setup_structures.o : da_setup_structures.f90 da_write_vp.inc da_truncate_spectra.inc da_get_bins_info.inc da_write_kma_increments.inc da_write_increments_for_wrf_nmm_regional.inc da_write_increments.inc da_qfrmrh.inc da_cumulus.inc da_lcl.inc da_cloud_model.inc da_setup_runconstants.inc da_setup_obs_interp_wts.inc da_setup_obs_structures_madis.inc da_setup_obs_structures_bufr.inc da_setup_obs_structures_ascii.inc da_setup_obs_structures_rain.inc da_setup_obs_structures_radar.inc da_setup_obs_structures.inc da_setup_flow_predictors.inc da_setup_flow_predictors_para_read_opt1.inc da_chgvres.inc da_setup_cv.inc da_setup_be_nmm_regional.inc da_setup_be_regional.inc da_setup_be_ncep_gfs.inc da_setup_be_global.inc da_setup_background_errors.inc da_scale_background_errors.inc da_scale_background_errors_cv3.inc da_rescale_background_errors.inc da_interpolate_regcoeff.inc da_get_vertical_truncation.inc gsi_thinning.o module_radiance.o da_rf_cv3.o da_rfz_cv3.o da_vtox_transforms.o da_tracing.o da_tools.o da_tools_serial.o da_ssmi.o da_spectral.o da_recursive_filter.o da_reporting.o da_radiance.o da_par_util.o da_par_util1.o da_obs_io.o da_obs.o da_control.o da_wrf_interfaces.o da_define_structures.o module_domain.o da_wavelet.o da_chg_be_Vres.inc da_gen_eigen.inc da_eigen_to_covmatrix.inc da_setup_pseudo_obs.inc da_ships.o : da_ships.f90 da_calculate_grady_ships.inc da_get_innov_vector_ships.inc da_check_max_iv_ships.inc da_transform_xtoy_ships_adj.inc da_transform_xtoy_ships.inc da_print_stats_ships.inc da_oi_stats_ships.inc da_residual_ships.inc da_jo_and_grady_ships.inc da_ao_stats_ships.inc da_tracing.o da_tools.o da_statistics.o da_physics.o da_grid_definitions.o da_par_util1.o da_par_util.o da_interpolation.o da_define_structures.o da_control.o module_domain.o da_sound.o : da_sound.f90 da_calculate_grady_sonde_sfc.inc da_check_max_iv_sonde_sfc.inc da_get_innov_vector_sonde_sfc.inc da_transform_xtoy_sonde_sfc_adj.inc da_transform_xtoy_sonde_sfc.inc da_print_stats_sonde_sfc.inc da_oi_stats_sonde_sfc.inc da_residual_sonde_sfc.inc da_jo_sonde_sfc_uvtq.inc da_jo_and_grady_sonde_sfc.inc da_ao_stats_sonde_sfc.inc da_check_buddy_sound.inc da_calculate_grady_sound.inc da_get_innov_vector_sound.inc da_check_max_iv_sound.inc da_transform_xtoy_sound_adj.inc da_transform_xtoy_sound.inc da_print_stats_sound.inc da_oi_stats_sound.inc da_residual_sound.inc da_jo_sound_uvtq.inc da_jo_and_grady_sound.inc da_ao_stats_sound.inc da_tracing.o da_physics.o da_grid_definitions.o da_par_util1.o da_par_util.o da_tools.o da_statistics.o da_interpolation.o module_domain.o da_define_structures.o da_control.o da_spectral.o : da_spectral.f90 da_apply_power.inc da_legtra_inv_adj.inc da_vtovv_spectral_adj.inc da_vv_to_v_spectral.inc da_vtovv_spectral.inc da_test_spectral.inc da_setlegpol.inc da_setlegpol_test.inc da_legtra.inc da_legtra_inv.inc da_initialize_h.inc da_get_reglats.inc da_get_gausslats.inc da_calc_power_spectrum.inc da_asslegpol.inc da_tracing.o da_tools_serial.o da_reporting.o da_par_util1.o da_define_structures.o da_control.o @@ -180,7 +180,7 @@ da_verif_tools.o : da_verif_tools.f90 da_verif_obs_control.o : da_verif_obs_control.f90 da_verif_obs_init.o : da_verif_obs_init.f90 da_verif_obs_control.o -da_vtox_transforms.o : da_vtox_transforms.f90 da_apply_be_adj.inc da_apply_be.inc da_transform_bal_adj.inc da_transform_bal.inc da_transform_vtovv_global_adj.inc da_transform_vtovv_global.inc da_get_aspoles.inc da_get_avpoles.inc da_get_spoles.inc da_get_vpoles.inc da_vertical_transform.inc da_transform_vptovv.inc da_transform_vvtovp_adj.inc da_transform_vvtovp.inc da_transform_vptox_adj.inc da_transform_vptox.inc da_transform_xtoxa_adj.inc da_transform_vtox_adj.inc da_transform_xtoxa.inc da_transform_vtox.inc da_transform_rescale.inc da_transform_vtovv_adj.inc da_transform_vtovv.inc da_check_eof_decomposition.inc da_add_flow_dependence_xa_adj.inc da_add_flow_dependence_xa.inc da_add_flow_dependence_vp_adj.inc da_add_flow_dependence_vp.inc da_transform_vvtovp_dual_res.inc da_transform_vvtovp_adj_dual_res.inc da_wavelet.o da_wrf_interfaces.o da_tracing.o da_tools.o da_ssmi.o da_spectral.o da_reporting.o da_recursive_filter.o da_par_util.o da_physics.o da_dynamics.o da_define_structures.o da_control.o module_domain.o module_comm_dm.o module_dm.o interp_fcn.o da_copy_xa.inc da_add_xa.inc da_calc_flow_dependence_xa_adj.inc da_calc_flow_dependence_xa.inc da_calc_flow_dependence_xa_dual_res.inc da_calc_flow_dependence_xa_adj_dual_res.inc da_transform_vpatox.inc da_transform_vpatox_adj.inc +da_vtox_transforms.o : da_vtox_transforms.f90 da_apply_be_adj.inc da_apply_be.inc da_transform_bal_adj.inc da_transform_bal.inc da_transform_vtovv_global_adj.inc da_transform_vtovv_global.inc da_get_aspoles.inc da_get_avpoles.inc da_get_spoles.inc da_get_vpoles.inc da_vertical_transform.inc da_transform_vptovv.inc da_transform_vvtovp_adj.inc da_transform_vvtovp.inc da_transform_vvtovp_inv.inc da_transform_vptox_adj.inc da_transform_vptox.inc da_transform_vptox_inv.inc da_transform_xtoxa_adj.inc da_transform_vtox_adj.inc da_transform_xtoxa.inc da_transform_vtox.inc da_transform_vtox_inv.inc da_transform_rescale.inc da_transform_vtovv_adj.inc da_transform_vtovv.inc da_transform_vtovv_inv.inc da_check_eof_decomposition.inc da_add_flow_dependence_xa_adj.inc da_add_flow_dependence_xa.inc da_add_flow_dependence_vp_adj.inc da_add_flow_dependence_vp.inc da_transform_vvtovp_dual_res.inc da_transform_vvtovp_adj_dual_res.inc da_wavelet.o da_wrf_interfaces.o da_tracing.o da_tools.o da_ssmi.o da_spectral.o da_reporting.o da_recursive_filter.o da_par_util.o da_physics.o da_dynamics.o da_define_structures.o da_control.o module_domain.o module_comm_dm.o module_dm.o interp_fcn.o da_copy_xa.inc da_add_xa.inc da_calc_flow_dependence_xa_adj.inc da_calc_flow_dependence_xa.inc da_calc_flow_dependence_xa_dual_res.inc da_calc_flow_dependence_xa_adj_dual_res.inc da_transform_vpatox.inc da_transform_vpatox_adj.inc diff --git a/var/da/da_main/da_solve.inc b/var/da/da_main/da_solve.inc index 98998f624a..5a65172fbf 100644 --- a/var/da/da_main/da_solve.inc +++ b/var/da/da_main/da_solve.inc @@ -45,6 +45,7 @@ type(x_type) :: shuffle real, allocatable :: grid_box_area(:,:), mapfac(:,:) + real, allocatable :: v1(:,:,:),v2(:,:,:),v3(:,:,:),v4(:,:,:),v5(:,:,:) character (len=10) :: variable_name integer :: iwin, num_subtwindow @@ -53,8 +54,12 @@ real, external :: nest_loc_of_cg ! from share/interp_fcn.F integer, external :: compute_CGLL ! from share/interp_fcn.F - integer :: cvt_unit, iost - character(len=8) :: cvtfile + integer :: vp_unit, iost + character(len=13) :: vpfile ! vp_input.0001 + integer :: i1,i2,i3,i4,i5,i6 + !integer :: i11,i22,i33,i44,i55,i66 + !integer :: dim1, dim2, dim3 + !integer :: mz1, mz2, mz3, mz4, mz5 logical :: ex if (trace_use) call da_trace_entry("da_solve") @@ -493,6 +498,19 @@ cv_size_domain_je = (ide_int - ids_int + 1) * (jde_int - jds_int + 1) * be % alpha % mz * be % ne endif + !write (*,*) "--------- Debug ---------------" + !write (*,*) "ids,ide,jds,jde,kds,kde= ", ids,ide,jds,jde,kds,kde + !write (*,*) "ips,ipe,jps,jpe,kps,kpe= ", ips,ipe,jps,jpe,kps,kpe + !write (*,*) "its,ite,jts,jte,kts,kte= ", its,ite,jts,jte,kts,kte + !write (*,*) "ims,ime,jms,jme,kms,kme= ", ims,ime,jms,jme,kms,kme + !write (*,*) "mz 1-5= ",be%v1%mz, be%v2%mz, be%v3%mz, be%v4%mz, be%v5%mz + !write (*,*) "be % cv % size_jb = ", be % cv % size_jb + !write (*,*) "be % cv % size_jp = ", be % cv % size_jp + !write (*,*) "be % cv % size_js = ", be % cv % size_js + !write (*,*) "be % cv % size_jl = ", be % cv % size_jl + !write (*,*) "be % cv % size_je = ", be % cv % size_je + !write (*,*) "--------- Debug ---------------" + !--------------------------------------------------------------------------- ! [5.2] Set up observation bias correction (VarBC): !--------------------------------------------------------------------------- @@ -543,35 +561,95 @@ ! allocate (full_eignvec(cv_size)) ! end if - if ( outer_loop_restart ) then - !call da_get_unit(cvt_unit) - cvt_unit=600 +! liuz: if multi_inc == 0: run normal 3D/4D-Var +!------------------------------------------------------------------------ + call da_initialize_cv (cv_size, cvt) + call da_zero_vp_type (grid%vp) + call da_zero_vp_type (grid%vv) + + if ( multi_inc == 2 ) then if ( max_ext_its > 1 ) then max_ext_its=1 - write(unit=message(1),fmt='(a)') "Re-set max_ext_its = 1 for outer_loop_restart" + write(unit=message(1),fmt='(a)') "Re-set max_ext_its = 1 for multi_inc==2" call da_message(message(1:1)) end if - write(unit=cvtfile,fmt='(a,i4.4)') 'cvt_',myproc - inquire(file=trim(cvtfile), exist=ex) + + ! read vp files for different PEs + !---------------------------------- + write(unit=vpfile,fmt='(a,i4.4)') 'vp_input.',myproc + inquire(file=trim(vpfile), exist=ex) if ( ex ) then - open(unit=cvt_unit,file=trim(cvtfile),iostat=iost,form='UNFORMATTED',status='OLD') + call da_get_unit(vp_unit) + open(unit=vp_unit,file=trim(vpfile),iostat=iost,form='UNFORMATTED',status='OLD') if (iost /= 0) then write(unit=message(1),fmt='(A,I5,A)') & - "Error ",iost," opening cvt file "//trim(cvtfile) + "Error ",iost," opening vp file "//trim(vpfile) call da_error(__FILE__,__LINE__,message(1:1)) end if - write(unit=message(1),fmt='(a)') 'Reading cvt from : '//trim(cvtfile) + if ( use_interpolate_cvt ) then ! works for CV3?, 3D RF + write(unit=message(1),fmt='(a)') 'Reading vv from : '//trim(vpfile) + elseif ( use_inverse_squarerootb ) then ! works for CV5,6,7, vertical EOF + write(unit=message(1),fmt='(a)') 'Reading vp from : '//trim(vpfile) + end if call da_message(message(1:1)) - read(cvt_unit) cvt - close(cvt_unit) + !read(vp_unit) mz1, mz2, mz3, mz4, mz5 + !print *, 'mz1-5=',mz1, mz2, mz3, mz4, mz5 + read(vp_unit) i1, i2, i3, i4, i5, i6 ! read dimension of patch for current processor + ! i11, i22, i33, i44, i55, i66, & + ! dim1, dim2, dim3 + !if ( i1 /= ips ) print *, "task=", myproc, "i1=",i1, "ips=",ips + !if ( i2 /= ipe ) print *, "task=", myproc, "i2=",i2, "ipe=",ipe + !if ( i3 /= jps ) print *, "task=", myproc, "i3=",i3, "jps=",jps + !if ( i4 /= jpe ) print *, "task=", myproc, "i4=",i4, "jpe=",jpe + !if ( i5 /= kps ) print *, "task=", myproc, "i5=",i5, "kps=",kps + !if ( i6 /= kpe ) print *, "task=", myproc, "i6=",i6, "kpe=",kpe + allocate( v1(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) + allocate( v2(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) + allocate( v3(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) + allocate( v4(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) + allocate( v5(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) + + read(vp_unit) v1, v2, v3, v4, v5 + + if ( use_interpolate_cvt ) then + grid%vv%v1(ips:ipe,jps:jpe,kps:kpe) = v1(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vv%v2(ips:ipe,jps:jpe,kps:kpe) = v2(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vv%v3(ips:ipe,jps:jpe,kps:kpe) = v3(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vv%v4(ips:ipe,jps:jpe,kps:kpe) = v4(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vv%v5(ips:ipe,jps:jpe,kps:kpe) = v5(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + call da_vv_to_cv( grid%vv, grid%xp, be%cv_mz, be%ncv_mz, cv_size, cvt ) + elseif ( use_inverse_squarerootb ) then + grid%vp%v1(ips:ipe,jps:jpe,kps:kpe) = v1(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vp%v2(ips:ipe,jps:jpe,kps:kpe) = v2(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vp%v3(ips:ipe,jps:jpe,kps:kpe) = v3(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vp%v4(ips:ipe,jps:jpe,kps:kpe) = v4(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vp%v5(ips:ipe,jps:jpe,kps:kpe) = v5(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + !call da_write_vp(grid,grid%vp,'vp_input.global ') ! to verify correctness + print '(/10X,"===> Use inverse transform of square-root B for outer-loop=",i2)', it + if ( cv_options == 3 ) then + write(unit=message(1),fmt='(A,I5,A)') & + "Error: inverse U transform not for cv_options = 3" + call da_error(__FILE__,__LINE__,message(1:1)) + end if + call da_transform_vtox_inv (grid,be%cv%size_jb,xbx,be,grid%ep,cvt(1:be%cv%size_jb),grid%vv,grid%vp) + end if + + deallocate( v1 ) + deallocate( v2 ) + deallocate( v3 ) + deallocate( v4 ) + deallocate( v5 ) + + close(vp_unit) + call da_free_unit(vp_unit) + else - write(unit=message(1),fmt='(a)') "cvt file '"//trim(cvtfile)//"' does not exists, initializing cvt." + write(unit=message(1),fmt='(a)') "vp files '"//trim(vpfile)//"' does not exists, initiallizing cvt." call da_message(message(1:1)) call da_initialize_cv (cv_size, cvt) end if - else - call da_initialize_cv (cv_size, cvt) end if +! liuz: ------------------------------------------- call da_zero_vp_type (grid%vv) call da_zero_vp_type (grid%vp) @@ -608,6 +686,24 @@ call da_initialize_cv (cv_size, xhat) +! liuz:---------------------- +! Apply inverse transform of squareroot(B) for full-resolution non-stop Var +! from 2nd outer loop, this is to check correctness of inverse U transform +! does not apply this setting for real world application +!----------------------------- + if (multi_inc == 0 .and. it > 1 .and. use_inverse_squarerootb .and. cv_options /= 3) then + print '(/10X,"===> Use inverse transform of square-root B for outer-loop=",i2)', it + call da_transform_vtox_inv (grid,be%cv%size_jb,xbx,be,grid%ep,cvt(1:be%cv%size_jb),grid%vv,grid%vp) + endif + +! Reinitialize cvt=0 for full-resolution non-stop Var for each loop +!------------------------------ + if (multi_inc == 0 .and. it > 1 .and. use_interpolate_cvt) then + print '(/10X,"===> Reinitialize cvt as zeros for outer loop ",i2)', it + call da_initialize_cv (cv_size, cvt) + endif +! liuz:------------------------ + ! [8.1] Calculate nonlinear model trajectory ! if (var4d .and. multi_inc /= 2 ) then @@ -779,18 +875,9 @@ ! Update outer-loop control variable cvt = cvt + xhat - if ( outer_loop_restart ) then - open(unit=cvt_unit,status='unknown',file=trim(cvtfile),iostat=iost,form='UNFORMATTED') - if (iost /= 0) then - write(unit=message(1),fmt='(A,I5,A)') & - "Error ",iost," opening cvt file "//trim(cvtfile) - call da_error(__FILE__,__LINE__,message(1:1)) - end if - write(unit=message(1),fmt='(a)') 'Writing cvt to : '//trim(cvtfile) - call da_message(message(1:1)) - write(cvt_unit) cvt - close(cvt_unit) - !call da_free_unit(cvt_unit) + if ( multi_inc == 2 .and. use_interpolate_cvt ) then + call da_cv_to_vv( cv_size, cvt, be%cv_mz, be%ncv_mz, grid%vv ) + call da_write_vp(grid,grid%vv,'vp_output.global') ! wrtie vv to vp file end if !------------------------------------------------------------------------ @@ -820,6 +907,13 @@ call da_transform_vtox (grid,be%cv%size_jb,xbx,be,grid%ep,xhat(1:be%cv%size_jb),grid%vv,grid%vp) call da_transform_vpatox (grid,be,grid%ep,grid%vp) endif + +! liuz:------------------------ + if (multi_inc == 2 .and. use_inverse_squarerootb) then + call da_write_vp(grid,grid%vp,'vp_output.global') ! write vp to vp file + end if +! liuz:-------------------------- + call da_transform_xtoxa (grid) ! [8.6] Only when use_radarobs = .false. and calc_w_increment =.true., diff --git a/var/da/da_main/da_wrfvar_top.f90 b/var/da/da_main/da_wrfvar_top.f90 index 8576e58586..618b4c0b95 100644 --- a/var/da/da_main/da_wrfvar_top.f90 +++ b/var/da/da_main/da_wrfvar_top.f90 @@ -55,7 +55,8 @@ module da_wrfvar_top use da_obs, only : da_transform_xtoy_adj use da_obs_io, only : da_write_filtered_obs, da_write_obs, da_final_write_obs , & da_write_obs_etkf, da_write_modified_filtered_obs - use da_par_util, only : da_system,da_copy_tile_dims,da_copy_dims + use da_par_util, only : da_system,da_copy_tile_dims,da_copy_dims, & + da_vv_to_cv, da_cv_to_vv use da_physics, only : da_uvprho_to_w_lin #if defined (CRTM) || defined (RTTOV) use da_radiance, only : da_deallocate_radiance @@ -65,7 +66,7 @@ module da_wrfvar_top use da_varbc, only : da_varbc_init,da_varbc_update #endif use da_reporting, only : message, da_warning, da_error, da_message - use da_setup_structures, only : da_setup_obs_structures, & + use da_setup_structures, only : da_setup_obs_structures, da_write_vp, & da_setup_background_errors,da_setup_flow_predictors, & da_setup_cv, da_scale_background_errors, da_scale_background_errors_cv3 use da_setup_structures, only : da_setup_flow_predictors_para_read_opt1 @@ -75,7 +76,8 @@ module da_wrfvar_top use da_transfer_model, only : da_transfer_xatoanalysis,da_setup_firstguess, & da_transfer_wrftltoxa_adj use da_vtox_transforms, only : da_transform_vtox, da_transform_xtoxa, & - da_transform_xtoxa_adj, da_copy_xa, da_add_xa, da_transform_vpatox + da_transform_xtoxa_adj, da_copy_xa, da_add_xa, da_transform_vpatox, & + da_transform_vtox_inv use da_wrfvar_io, only : da_med_initialdata_input, da_update_firstguess use da_tools, only : da_set_randomcv, da_get_julian_time diff --git a/var/da/da_recursive_filter/da_recursive_filter.f90 b/var/da/da_recursive_filter/da_recursive_filter.f90 index 12798251c6..54eae7ce6f 100644 --- a/var/da/da_recursive_filter/da_recursive_filter.f90 +++ b/var/da/da_recursive_filter/da_recursive_filter.f90 @@ -31,8 +31,10 @@ module da_recursive_filter #include "da_calculate_rf_factors.inc" #include "da_recursive_filter_1d.inc" #include "da_recursive_filter_1d_adj.inc" +#include "da_recursive_filter_1d_inv.inc" #include "da_transform_through_rf.inc" #include "da_transform_through_rf_adj.inc" +#include "da_transform_through_rf_inv.inc" #include "da_apply_rf_1v.inc" #include "da_apply_rf_1v_adj.inc" diff --git a/var/da/da_recursive_filter/da_recursive_filter_1d_inv.inc b/var/da/da_recursive_filter/da_recursive_filter_1d_inv.inc new file mode 100644 index 0000000000..cbc175bb5b --- /dev/null +++ b/var/da/da_recursive_filter/da_recursive_filter_1d_inv.inc @@ -0,0 +1,88 @@ +subroutine da_recursive_filter_1d_inv(pass, alpha, field, n) + + !--------------------------------------------------------------------------- + ! Purpose: Perform one pass of inverse of recursive filter on 1D array. + ! + ! Method: Inverse filter is non-recursive. References: + ! + ! Lorenc, A. (1992), Iterative Analysis Using Covariance Functions and Filters. + ! Q.J.R. Meteorol. Soc., 118: 569-591. Equation (A2) + ! + ! Christopher M. Hayden and R. James Purser, 1995: Recursive Filter Objective Analysis of + ! Meteorological Fields: Applications to NESDIS Operational Processing. + ! J. Appl. Meteor., 34, 3-15. + ! + ! Dale Barker etal., 2004, A 3DVAR data assimilation system for use with MM5, + ! NCAR Tech Note 393. + ! + ! Author: Zhiquan (Jake) Liu, NCAR/MMM, 2015-09 + !--------------------------------------------------------------------------- + + implicit none + + integer, intent(in) :: pass ! Current pass of filter. + real*8, intent(in) :: alpha ! Alpha coefficient for RF. + real*8, intent(inout) :: field(:) ! Array to be filtered. + integer, intent(in) :: n ! Size of field array. + + integer :: j ! Loop counter. + real :: one_alpha ! 1 - alpha. + real :: a(1:n) ! Input field. + real :: b(1:n) ! Field after left-right pass. + real :: c(1:n) ! Field after right-left pass. + + if (trace_use_dull) call da_trace_entry("da_recursive_filter_1d_inv") + + !------------------------------------------------------------------------- + ! [1.0] Initialise: + !------------------------------------------------------------------------- + + one_alpha = 1.0 - alpha + + c(1:n) = field(1:n) + + !------------------------------------------------------------------------- + ! [2.0] Perform non-recursive inverse filter: + !------------------------------------------------------------------------- + + ! Follow the appendix Eq. (A2) of Lorenc (1992): + + do j = 2, n-1 + a(j) = c(j) - (alpha/one_alpha**2) * (c(j-1)-2.0*c(j)+c(j+1)) + end do + + !------------------------------------------------------------------------- + ! [3.0] Perform inverse filter at boundary points 1 & n: + !------------------------------------------------------------------------- + + ! use turning conditions as in the appendix of Hayden & Purser (1995): + ! also see Barker etal., 2004, chapter 5a. + + if (pass == 1) then + b(1) = (c(1)-alpha*c(2))/one_alpha + a(1) = b(1)/one_alpha + + b(n-1) = (c(n-1)-alpha*c(n))/one_alpha + b(n) = c(n)*(1.0+alpha) + a(n) = (b(n) - alpha*b(n-1))/one_alpha + else if ( pass == 2) then + b(1) = (c(1)-alpha*c(2))/one_alpha + a(1) = b(1)*(1.0+alpha) + + b(n-1) = (c(n-1)-alpha*c(n))/one_alpha + b(n) = c(n)*(1.0-alpha**2)**2/one_alpha+alpha**3*b(n-1) + a(n) = (b(n) - alpha*b(n-1))/one_alpha + else + b(1) = (c(1)-alpha*c(2))/one_alpha + a(1) = b(1)*(1.0-alpha**2)**2/one_alpha+alpha**3*a(2) + + b(n-1) = (c(n-1)-alpha*c(n))/one_alpha + b(n) = c(n)*(1.0-alpha**2)**2/one_alpha+alpha**3*b(n-1) + a(n) = (b(n) - alpha*b(n-1))/one_alpha + end if + + field(1:n) = a(1:n) + + if (trace_use_dull) call da_trace_exit("da_recursive_filter_1d_inv") + +end subroutine da_recursive_filter_1d_inv diff --git a/var/da/da_recursive_filter/da_transform_through_rf.inc b/var/da/da_recursive_filter/da_transform_through_rf.inc index 71af24539a..fa2cd76d99 100644 --- a/var/da/da_recursive_filter/da_transform_through_rf.inc +++ b/var/da/da_recursive_filter/da_transform_through_rf.inc @@ -79,7 +79,8 @@ subroutine da_transform_through_rf(grid,mz, rf_alpha, val,field, scaling) !------------------------------------------------------------------------- ! [2.1] Apply (i',j',k -> i,j',k') (grid%xp%v1z -> grid%xp%v1x) - ! convert from vertical column to x-stripe + ! convert from z-strip to x-stripe (i.e., no decomposition in x-dir) + ! Liuz NOTE: in order to do global recursive filter in x-direction call da_transpose_z2x (grid) @@ -108,7 +109,7 @@ subroutine da_transform_through_rf(grid,mz, rf_alpha, val,field, scaling) !------------------------------------------------------------------------- ! [3.1] Apply (i, j' ,k' -> i', j ,k') (grid%xp%v1x -> grid%xp%v1y) - ! convert from vertical column to y-stripe + ! convert from x-strip to y-stripe call da_transpose_x2y (grid) @@ -133,11 +134,11 @@ subroutine da_transform_through_rf(grid,mz, rf_alpha, val,field, scaling) !$OMP END PARALLEL DO !------------------------------------------------------------------------- - ! [4.0]: Perform 1D recursive filter in y-direction: + ! [4.0]: convert back from y-trip to normal z-strip: !------------------------------------------------------------------------- ! [4.1] Apply (i',j,k' -> i',j',k) (grid%xp%v1y -> grid%xp%v1z) - ! convert from y-stripe to vertical column. + ! convert from y-stripe to z-strip. call da_transpose_y2z (grid) diff --git a/var/da/da_recursive_filter/da_transform_through_rf_inv.inc b/var/da/da_recursive_filter/da_transform_through_rf_inv.inc new file mode 100644 index 0000000000..ffbc1f7983 --- /dev/null +++ b/var/da/da_recursive_filter/da_transform_through_rf_inv.inc @@ -0,0 +1,189 @@ +subroutine da_transform_through_rf_inv(grid, mz,rf_alpha, val, field, scaling) + + !--------------------------------------------------------------------------- + ! Purpose: Inverse transform of the recursive filter. + ! Based on da_transform_through_rf_adj + ! + ! Author: Zhiquan (Jake) Liu, NCAR/MMM, 2015-09 + ! + ! Method: 1) Apply inverse filter first in y-direction. + ! 2) then apply inverse filter in x-direction + !--------------------------------------------------------------------------- + + implicit none + + type(domain), intent(inout) :: grid + integer, intent(in) :: mz ! Vertical truncation. + real*8, intent(in) :: rf_alpha(mz) ! RF scale parameter. + real*8, intent(in) :: val(jds:jde,mz) ! Error standard deviation. + real, intent(inout) :: field(ims:ime,jms:jme,kms:kme) ! Field to be transformed. + + integer :: rf_passes_over_two ! rf_passes / 2 + integer :: i, j, m, n, pass, ij ! Loop counters. + real :: p_x(ims:ime,jms:jme) ! sqrt(Grid box area). + real*8 :: val_j(grid%xp%jtsy:grid%xp%jtey) + real*8 :: val_i(grid%xp%itsx:grid%xp%itex) + + logical, optional, intent(in) :: scaling + + !------------------------------------------------------------------------- + ! [1.0]: Initialise: + !------------------------------------------------------------------------- + + if (trace_use_dull) call da_trace_entry("da_transform_through_rf_inv") + + write (*,*) 'mz= ', mz + write (*,*) 'rf_alpha= ', rf_alpha + write (*,*) 'eigval= ', val + write (*,*) 'vert_corr=', vert_corr, ' vert_corr_1=', vert_corr_1 + + + rf_passes_over_two = rf_passes / 2 + + ! [1.1] Define inner product (square root of grid box area): + !$OMP PARALLEL DO & + !$OMP PRIVATE (ij, i, j) + do ij = 1 , grid%num_tiles + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + p_x(i,j) = sqrt(grid%xb%grid_box_area(i,j)) + end do + end do + end do + !$OMP END PARALLEL DO + + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij, m, i, j ) + do ij = 1 , grid%num_tiles + do m = 1, mz + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + grid%xp%v1z(i,j,m) = 0.0 + end do + end do + end do + end do + !$OMP END PARALLEL DO + + !------------------------------------------------------------------------- + ! [4.0]: Perform 1D recursive filter in y-direction: + !------------------------------------------------------------------------- + + ! [4.3] Optionally scale by background error: + ! be_s % val = Gridpoint standard deviation - only required for + ! vert_corr = vert_corr_1 as scaling is performed in vertical transform + ! for vert_corr = vert_corr_2: + + if (vert_corr == vert_corr_1 .or. (present(scaling))) then + if (scaling .or. vert_corr == vert_corr_1) then + do m = 1, mz + do i = its, ite + field(i,jts:jte,m) = field(i,jts:jte,m) / val(jts:jte,m) + end do + end do + end if + end if + + ! [4.2] Transform filtered field to dimensional space: + + !$OMP PARALLEL DO & + !$OMP PRIVATE (ij ,m, j, i) + do ij = 1 , grid%num_tiles + do m = 1, mz + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + grid%xp%v1z(i,j,m) = field(i,j,m) / p_x(i,j) + end do + end do + end do + end do + !$OMP END PARALLEL DO + + ! [4.1] Apply (i',j',k -> i',j,k') (grid%xp%v1z -> grid%xp%v1y) + ! convert z-strip to y-stripe + + call da_transpose_z2y (grid) + + !------------------------------------------------------------------------- + ! [3.0]: Perform 1D recursive filter in y-direction: + !------------------------------------------------------------------------- + + ! [3.2] Apply 1D filter in y direction: + + n=grid%xp%jtey-grid%xp%jtsy+1 + !$OMP PARALLEL DO & + !$OMP PRIVATE (m, i, val_j, pass, j) + do m = grid%xp%ktsy, min(grid%xp%ktey, mz) + do i = grid%xp%itsy, grid%xp%itey + do j = grid%xp%jtsy, grid%xp%jtey + val_j(j) = grid%xp%v1y(i,j,m) + end do + do pass = rf_passes_over_two, 1, -1 + call da_recursive_filter_1d_inv(pass, rf_alpha(m), val_j, n) + end do + do j = grid%xp%jtsy, grid%xp%jtey + grid%xp%v1y(i,j,m) = val_j(j) + end do + end do + end do + !$OMP END PARALLEL DO + + ! [3.1] Apply (i',j,k' -> i,j',k') (grid%xp%v1y -> grid%xp%v1x) + ! convert from y-stripe to x-stripe + + call da_transpose_y2x (grid) + + !------------------------------------------------------------------------- + ! [2.0]: Perform 1D recursive filter in x-direction: + !------------------------------------------------------------------------- + + ! [2.2] Apply 1D filter in x direction: + + n = grid%xp%itex-grid%xp%itsx+1 + + !$OMP PARALLEL DO & + !$OMP PRIVATE ( m, j, pass, i, val_i) + do m = grid%xp%ktsx, min(grid%xp%ktex,mz) + do j = grid%xp%jtsx, grid%xp%jtex + do i = grid%xp%itsx, grid%xp%itex + val_i(i) = grid%xp%v1x(i,j,m) + end do + do pass = rf_passes_over_two, 1, -1 + call da_recursive_filter_1d_inv(pass, rf_alpha(m), val_i, n) + end do + do i = grid%xp%itsx, grid%xp%itex + grid%xp%v1x(i,j,m) = val_i(i) + end do + end do + end do + !$OMP END PARALLEL DO + + ! [2.1] Apply (i,j',k' -> i',j',k) (grid%xp%v1x -> grid%xp%v1z) + ! convert from x-stripe to normal z-strip + + call da_transpose_x2z (grid) + + !------------------------------------------------------------------------- + ! [1.0]: Initialise: + !------------------------------------------------------------------------- + + ! [1.2] Transform to nondimensional v_hat space: + + !$OMP PARALLEL DO & + !$OMP PRIVATE (ij ,m, i, j) + do ij = 1 , grid%num_tiles + do m = 1, mz + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + field(i,j,m) = grid%xp%v1z(i,j,m) * p_x(i,j) + end do + end do + end do + end do + !$OMP END PARALLEL DO + + if (trace_use_dull) call da_trace_exit("da_transform_through_rf_inv") + +end subroutine da_transform_through_rf_inv + + diff --git a/var/da/da_setup_structures/da_setup_structures.f90 b/var/da/da_setup_structures/da_setup_structures.f90 index e1a1277d14..ee74e79b66 100644 --- a/var/da/da_setup_structures/da_setup_structures.f90 +++ b/var/da/da_setup_structures/da_setup_structures.f90 @@ -5,7 +5,7 @@ module da_setup_structures !--------------------------------------------------------------------------- use da_wavelet, only: lf,namw,nb,nij,ws - use module_domain, only : xb_type, ep_type, domain + use module_domain, only : xb_type, ep_type, domain, vp_type use da_define_structures, only : xbx_type,be_subtype, be_type, y_type, j_type, & iv_type,da_allocate_background_errors,da_allocate_observations, & @@ -137,6 +137,7 @@ module da_setup_structures #include "da_lcl.inc" #include "da_cumulus.inc" #include "da_qfrmrh.inc" +#include "da_write_vp.inc" #include "da_write_increments.inc" #include "da_write_increments_for_wrf_nmm_regional.inc" #include "da_write_kma_increments.inc" diff --git a/var/da/da_setup_structures/da_write_vp.inc b/var/da/da_setup_structures/da_write_vp.inc new file mode 100644 index 0000000000..a6d2ba1aa8 --- /dev/null +++ b/var/da/da_setup_structures/da_write_vp.inc @@ -0,0 +1,136 @@ +subroutine da_write_vp (grid,vp,filename) + + !---------------------------------------------------------------------- + ! Purpose: Write vp, full varibles after balance transform Up + ! will be interpolated into higher resolution by offline program + ! Method: based on da_write_increments.inc + ! Author: Zhiquan (Jake) Liu, NCAR/MMM, 2015-09 + !---------------------------------------------------------------------- + + implicit none + + type (domain), intent(in) :: grid + type(vp_type), intent(in) :: vp + character(len=16), intent(in) :: filename + + ! Arrays for write out increments: + integer :: ix, jy, kz +#ifdef DM_PARALLEL + !real, dimension(1:grid%xb%mix,1:grid%xb%mjy) :: gbuf_2d + !real, dimension(1:grid%xb%mix+1,1:grid%xb%mjy+1) :: gbuf_2dd + real, dimension(1:grid%xb%mix,1:grid%xb%mjy,1:grid%xb%mkz) :: gbuf + + !real, dimension(1:grid%xb%mix,1:grid%xb%mjy,1:grid%xb%mkz+1) :: wgbuf + real, dimension(:,:,:), allocatable :: v1_global, v2_global, & + v3_global, v4_global + real, dimension(:,:,:) , allocatable :: v5_global +#endif + + integer :: vp_unit, vp_local_unit + character(len=7) :: vpfile + + if (trace_use) call da_trace_entry("da_write_vp") + + + ! Dimension of the domain (unstagered): + ix = grid%xb%mix + jy = grid%xb%mjy + kz = grid%xb%mkz + +#ifdef DM_PARALLEL + + ! 3-d and 2-d increments: + + allocate ( v1_global (1:ix,1:jy,1:kz)) + allocate ( v2_global (1:ix,1:jy,1:kz)) + allocate ( v3_global (1:ix,1:jy,1:kz)) + allocate ( v4_global (1:ix,1:jy,1:kz)) + allocate ( v5_global (1:ix,1:jy,1:kz)) + + call da_patch_to_global(grid, vp % v1, gbuf) ! psi or u + if (rootproc) then + v1_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) + end if + + call da_patch_to_global(grid, vp % v2, gbuf) ! chi_u or v + if (rootproc) then + v2_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) + end if + + !call da_patch_to_global(grid, grid%xa % t, gbuf) ! t_u or t + call da_patch_to_global(grid, vp % v3, gbuf) ! t_u or t + if (rootproc) then + v3_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) + end if + + call da_patch_to_global(grid, vp % v4, gbuf) ! q/qs + if (rootproc) then + v4_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) + end if + + !print *, "local size v5: ", size(vp % v5,1),size(vp % v5,2),size(vp % v5,3) + call da_patch_to_global(grid, vp % v5, gbuf) ! Ps (:,:,1) + if (rootproc) then + v5_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) + end if + + !write(unit=vpfile,fmt='(a,i4.4)') 'vp_',myproc + !call da_get_unit(vp_local_unit) + !open(unit=vp_local_unit, file=trim(vpfile), form='unformatted') + + !print *, "local: ips,ipe,jps,jpe,kps,kpe=", ips,ipe,jps,jpe,kps,kpe + !print *, "local: ims,ime,jms,jme,kms,kme=", ims,ime,jms,jme,kms,kme + !print *, "local: dimx, dimy, dimz=", size(vp%v5,1),size(vp%v5,2),size(vp%v5,3) + + !write (unit=vp_local_unit) ips,ipe,jps,jpe,kps,kpe, & + ! ims,ime,jms,jme,kms,kme, & + ! size(vp%v5,1),size(vp%v5,2),size(vp%v5,3) + + !write (unit=vp_local_unit) vp%v1, vp%v2, & + ! vp%v3, vp%v4, vp%v5 + + !close(vp_local_unit) + !call da_free_unit(vp_local_unit) + + +#endif + + if (rootproc) then + call da_get_unit(vp_unit) + open(unit=vp_unit, file=trim(filename), form='unformatted') + + !print *, "ANALYSIS_DATE= ", ANALYSIS_DATE + !write (unit=vp_unit) ANALYSIS_DATE + + print *, "write_vp: Global ix, jy, kz=", ix, jy, kz + write (unit=vp_unit) ix, jy, kz + +#ifdef DM_PARALLEL + + ! 3d- and 2d-increments in vp space: + write (unit=vp_unit) v1_global, v2_global, & + v3_global, v4_global, v5_global + + close(vp_unit) + call da_free_unit(vp_unit) + +#else + + ! 3d- and 2d-increments: + write (unit=vp_unit) vp%v1(1:ix,1:jy,1:kz), & + vp%v2(1:ix,1:jy,1:kz), & + vp%v3(1:ix,1:jy,1:kz), & + vp%v4(1:ix,1:jy,1:kz), & + vp%v5(1:ix,1:jy,1) + + close(vp_unit) + call da_free_unit(vp_unit) +#endif + + end if + + if (trace_use) call da_trace_exit("da_write_vp") + +end subroutine da_write_vp + + diff --git a/var/da/da_vtox_transforms/da_transform_vptox.inc b/var/da/da_vtox_transforms/da_transform_vptox.inc index 35b75ceffd..a72d6faae5 100644 --- a/var/da/da_vtox_transforms/da_transform_vptox.inc +++ b/var/da/da_vtox_transforms/da_transform_vptox.inc @@ -9,6 +9,12 @@ subroutine da_transform_vptox(grid, vp, be, ep) ! ! Implementation of multi-variate BE for cv_options=6 ! Syed RH Rizvi, MMM/NESL/NCAR, Date: 02/01/2010 + !------------------------ + ! Zhiquan (Jake) Liu, NCAR/MMM, 2015-09 + ! re-order transforms to avoid local chi_u and store full variables in vp + ! full vp will be written out and used as input of inverse U transform + ! for multi-resolution incremental 4DVAR + ! order: v4 (rh), v3 (T), v5 (Ps), v2 (Chi_u -> Chi) !----------------------------------------------------------------------- implicit none @@ -21,7 +27,7 @@ subroutine da_transform_vptox(grid, vp, be, ep) ! integer, intent(in), optional :: nobwin integer :: i, k, j, k1, ij ! Loop counters. - real, allocatable :: chi_u(:,:,:) ! Unbalanced chi + !real, allocatable :: chi_u(:,:,:) ! Unbalanced chi if (trace_use) call da_trace_entry("da_transform_vptox") @@ -41,43 +47,38 @@ subroutine da_transform_vptox(grid, vp, be, ep) !$OMP PRIVATE ( ij, k1, k, j, i) do ij = 1 , grid%num_tiles + ! 2.1 Pseudo rh_u to Pseudo rh (only for cv6) + ! do moisture first to avoid local (chi_u,t_t,Ps_u) variables + !-------------------------------------------------------------- if ( cv_options == 6 ) then - allocate (chi_u(its:ite,grid%j_start(ij):grid%j_end(ij),kts:kte) ) - do k = kts, kte - do j = grid%j_start(ij), grid%j_end(ij) - do i = its, ite - chi_u(i,j,k) = vp%v2(i,j,k) + do k1 = kts, kte + do k = kts, kte + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + vp%v4(i,j,k1) = vp%v4(i,j,k1) + be%reg_psi_rh(j,k1,k)*vp%v1(i,j,k) + & + be%reg_chi_u_rh(j,k1,k)*vp%v2(i,j,k) + be%reg_t_u_rh(j,k1,k)*vp%v3(i,j,k) + end do end do end do end do - end if - - ! Chi: - if (cv_options /= 7) then +! do k = kts, kte do j = grid%j_start(ij), grid%j_end(ij) do i = its, ite - vp%v2(i,j,k) = vp%v2(i,j,k) + be%reg_psi_chi(j,k)* vp%v1(i,j,k) + vp%v4(i,j,k) = vp%v4(i,j,k) + be%reg_ps_u_rh(j,k)*vp%v5(i,j,1) end do end do end do end if - - ! Temperature: - do k = kts, kte - do j = grid%j_start(ij), grid%j_end(ij) - do i = its, ite - grid%xa%t(i,j,k) = vp%v3(i,j,k) - end do - end do - end do + ! 2.2 t_u --> t, do this before chi_u --> chi + !---------------------------------------------- if (cv_options /= 7) then do k1 = kts, kte do k = kts, kte do j = grid%j_start(ij), grid%j_end(ij) do i = its, ite - grid%xa%t(i,j,k) = grid%xa%t(i,j,k) + be%reg_psi_t(j,k,k1)*vp%v1(i,j,k1) + vp%v3(i,j,k) = vp%v3(i,j,k) + be%reg_psi_t(j,k,k1)*vp%v1(i,j,k1) end do end do end do @@ -89,25 +90,28 @@ subroutine da_transform_vptox(grid, vp, be, ep) do k = kts, kte do j = grid%j_start(ij), grid%j_end(ij) do i = its, ite - grid%xa%t(i,j,k) = grid%xa%t(i,j,k) + be%reg_chi_u_t(j,k,k1)*chi_u(i,j,k1) + vp%v3(i,j,k) = vp%v3(i,j,k) + be%reg_chi_u_t(j,k,k1)*vp%v2(i,j,k1) end do end do end do end do end if - ! Surface Pressure - do j = grid%j_start(ij), grid%j_end(ij) - do i = its, ite - grid%xa%psfc(i,j) = vp%v5(i,j,1) + do k = kts, kte + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + grid%xa%t(i,j,k) = vp%v3(i,j,k) + end do end do end do + ! 2.3 Ps_u --> Ps, do this before chi_u --> chi + !------------------------------------------------- if (cv_options /= 7) then do k = kts,kte do j = grid%j_start(ij), grid%j_end(ij) do i = its, ite - grid%xa%psfc(i,j) = grid%xa%psfc(i,j) + be%reg_psi_ps(j,k)*vp%v1(i,j,k) + vp%v5(i,j,1) = vp%v5(i,j,1) + be%reg_psi_ps(j,k)*vp%v1(i,j,k) end do end do end do @@ -117,36 +121,31 @@ subroutine da_transform_vptox(grid, vp, be, ep) do k = kts,kte do j = grid%j_start(ij), grid%j_end(ij) do i = its, ite - grid%xa%psfc(i,j) = grid%xa%psfc(i,j) + be%reg_chi_u_ps(j,k)*chi_u(i,j,k) + vp%v5(i,j,1) = vp%v5(i,j,1) + be%reg_chi_u_ps(j,k)*vp%v2(i,j,k) end do end do end do end if - ! Moisture - if ( cv_options == 6 ) then - do k1 = kts, kte - do k = kts, kte - do j = grid%j_start(ij), grid%j_end(ij) - do i = its, ite - vp%v4(i,j,k1) = vp%v4(i,j,k1) + be%reg_psi_rh(j,k1,k)*vp%v1(i,j,k) + & - be%reg_chi_u_rh(j,k1,k)*chi_u(i,j,k) + be%reg_t_u_rh(j,k1,k)*vp%v3(i,j,k) - end do - end do - end do + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + grid%xa%psfc(i,j) = vp%v5(i,j,1) end do -! + end do + + ! 2.4 Chi_u --> Chi, do this last + !----------------------------------- + if (cv_options /= 7) then do k = kts, kte do j = grid%j_start(ij), grid%j_end(ij) do i = its, ite - vp%v4(i,j,k) = vp%v4(i,j,k) + be%reg_ps_u_rh(j,k)*vp%v5(i,j,1) + vp%v2(i,j,k) = vp%v2(i,j,k) + be%reg_psi_chi(j,k)* vp%v1(i,j,k) end do end do end do end if - ! - if ( cv_options == 6 ) deallocate (chi_u ) +! if ( cv_options == 6 ) deallocate (chi_u ) end do !$OMP END PARALLEL DO diff --git a/var/da/da_vtox_transforms/da_transform_vptox_inv.inc b/var/da/da_vtox_transforms/da_transform_vptox_inv.inc new file mode 100644 index 0000000000..0727111762 --- /dev/null +++ b/var/da/da_vtox_transforms/da_transform_vptox_inv.inc @@ -0,0 +1,348 @@ +subroutine da_transform_vptox_inv(grid, vp, be, ep) + + !----------------------------------------------------------------------- + ! Purpose: Inverse of balance (physical) transform of increment + ! + ! Author: Zhiquan (Jake) Liu, NCAR/MMM, 2015-9 + !----------------------------------------------------------------------- + + implicit none + + type (domain), intent(inout) :: grid + + type (vp_type), intent(inout) :: vp ! input: full variables + ! output: unbalanced variables on model grid + type (be_type), intent(in), optional :: be ! Background errors. + type (ep_type), intent(in), optional :: ep ! Ensemble perturbations. + + integer :: i, k, j, k1, ij ! Loop counters. + real, allocatable :: chi_u(:,:,:) ! Unbalanced chi + + if (trace_use) call da_trace_entry("da_transform_vptox_inv") + + !--------------------------------------------------------------------------- + ! [1] Add flow-dependent increments in control variable space (vp): + !--------------------------------------------------------------------------- + + if (be % ne > 0 .and. alphacv_method == alphacv_method_vp) then + call da_add_flow_dependence_vp(be % ne, ep, vp, its,ite, jts,jte, kts,kte) + end if + + !-------------------------------------------------------------------------- + ! [2] Impose statistical balance constraints: + ! Assume input vp%* is full variable, out vp% is unbalanced variables + ! to avoid (Psi,Chi) -> (U,V) transform, which has no exact inverse, + ! we need to store full variables at vp%* after each outloop. + ! da_transform_vptox.inc is also modified for this purpose. + ! + ! for cv7, control variables are all full variables w/o multi-variate correlation. + ! so there is no need for balance transform and its inverse. + !-------------------------------------------------------------------------- + + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij, k1, k, j, i) + do ij = 1 , grid%num_tiles + + ! 2.1 Psi, Chi --> Psi, Chi_u + !------------------------- + ! there is no need for Psi --> Psi transform + + ! Chi --> Chi_u + !-------------------- + if (cv_options /= 7) then + do k = kts, kte + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + vp%v2(i,j,k) = vp%v2(i,j,k) - be%reg_psi_chi(j,k)* vp%v1(i,j,k) + end do + end do + end do + end if + + ! 2.2 T --> T_u + !------------------- + if (cv_options /= 7) then ! - balance contri. from psi + do k1 = kts, kte + do k = kts, kte + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + !vp%v3(i,j,k) = grid%xa%t(i,j,k) - be%reg_psi_t(j,k,k1)*vp%v1(i,j,k1) + vp%v3(i,j,k) = vp%v3(i,j,k) - be%reg_psi_t(j,k,k1)*vp%v1(i,j,k1) + end do + end do + end do + end do + end if + + if ( cv_options == 6 ) then ! - balance contri. from Chi_u + do k1 = kts, kte + do k = kts, kte + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + vp%v3(i,j,k) = vp%v3(i,j,k) - be%reg_chi_u_t(j,k,k1)*vp%v2(i,j,k1) + end do + end do + end do + end do + end if + + ! 2.3 Ps --> Ps_u + !------------------------ + !do j = grid%j_start(ij), grid%j_end(ij) + ! do i = its, ite + ! grid%xa%psfc(i,j) = vp%v5(i,j,1) + ! end do + !end do + + if (cv_options /= 7) then ! - balance contri. from psi + do k = kts,kte + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + !vp%v5(i,j,1) = grid%xa%psfc(i,j) - be%reg_psi_ps(j,k)*vp%v1(i,j,k) + vp%v5(i,j,1) = vp%v5(i,j,1) - be%reg_psi_ps(j,k)*vp%v1(i,j,k) + end do + end do + end do + end if + + if ( cv_options == 6 ) then ! - balance contri. from Chi_u + do k = kts,kte + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + vp%v5(i,j,1) = vp%v5(i,j,1) - be%reg_chi_u_ps(j,k)*vp%v2(i,j,k) + end do + end do + end do + end if + + ! 2.4 q --> pseudo rh=q/qs(background) + !---------------------------- + ! if cv5 or cv7, no need for pseudo rh transform + + !do k = kts, kte + ! do j = grid%j_start(ij), grid%j_end(ij) + ! do i = its, ite + ! vp%v4(i,j,k) = grid%xa % q(i,j,k) / grid%xb%qs(i,j,k) + ! enddo + ! enddo + !enddo + + if ( cv_options == 6 ) then + do k1 = kts, kte + do k = kts, kte + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + vp%v4(i,j,k1) = vp%v4(i,j,k1) - & + be%reg_psi_rh(j,k1,k)*vp%v1(i,j,k) - & + be%reg_chi_u_rh(j,k1,k)*vp%v2(i,j,k) - & + be%reg_t_u_rh(j,k1,k)*vp%v3(i,j,k) + end do + end do + end do + end do +! + do k = kts, kte + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + vp%v4(i,j,k) = vp%v4(i,j,k) - be%reg_ps_u_rh(j,k)*vp%v5(i,j,1) + end do + end do + end do + end if + + end do + !$OMP END PARALLEL DO + !-------------------------------------------------------------------------- + ! [3] Transform to model variable space: + !-------------------------------------------------------------------------- + +!!#ifdef A2C +! if ((fg_format==fg_format_wrf_arw_regional .or. & +! fg_format==fg_format_wrf_arw_global ) .and. ide == ipe ) then +! ipe = ipe + 1 +! ide = ide + 1 +! end if +! +! if ((fg_format==fg_format_wrf_arw_regional .or. & +! fg_format==fg_format_wrf_arw_global ) .and. jde == jpe ) then +! jpe = jpe + 1 +! jde = jde + 1 +! end if +!!#endif + +!!#ifdef DM_PARALLEL +!!#include "HALO_PSICHI_UV.inc" +!!#endif + +!!#ifdef A2C +!! if ((fg_format==fg_format_wrf_arw_regional .or. & +! fg_format==fg_format_wrf_arw_global ) .and. ide == ipe ) then +! ipe = ipe - 1 +! ide = ide - 1 +! end if + +! if ((fg_format==fg_format_wrf_arw_regional .or. & +! fg_format==fg_format_wrf_arw_global ) .and. jde == jpe ) then +! jpe = jpe - 1 +! jde = jde - 1 +! end if +!#endif + + ! Psi and chi to u and v: +! if ( cv_options == 5 .or. cv_options == 6 ) then +! call da_psichi_to_uv(vp % v1, vp % v2, grid%xb % coefx, & +! grid%xb % coefy , grid%xa % u, grid%xa % v) +! else if ( cv_options == 7 ) then +! grid%xa%u = vp%v1 +! grid%xa%v = vp%v2 +! end if + + if ( (use_radarobs .and. use_radar_rf) .or. (use_rad .and. crtm_cloud).or. & + (use_radarobs .and. use_radar_rhv) .or. (use_radarobs .and. use_radar_rqv) .or. cloud_cv_options .ge. 2 .or. & + (grid%pseudo_var(1:1).eq.'q' .and. grid%pseudo_var(2:2).ne.' ') .or. & + (grid%pseudo_var(1:1).eq.'Q' .and. grid%pseudo_var(2:2).ne.' ') ) then + +! if ( cloud_cv_options == 1 .and. use_3dvar_phy) then +! ! Pseudo RH --> Total water mixing ratio: +! !$OMP PARALLEL DO & +! !$OMP PRIVATE ( ij, i, j, k ) +! do ij = 1 , grid%num_tiles +! do k = kts, kte +! do j = grid%j_start(ij), grid%j_end(ij) +! do i = its, ite +! grid%xa % qt(i,j,k) = vp%v4(i,j,k) * grid%xb%qs(i,j,k) +! enddo +! enddo +! enddo +! enddo +! !$OMP END PARALLEL DO +! end if +! if ( cloud_cv_options .ge. 2 ) then +! ! Pseudo RH --> Water vapor mixing ratio: +! !$OMP PARALLEL DO & +! !$OMP PRIVATE ( ij, i, j, k ) +! do ij = 1 , grid%num_tiles +! do k = kts, kte +! do j = grid%j_start(ij), grid%j_end(ij) +! do i = its, ite +! grid%xa % q(i,j,k) = vp%v4(i,j,k) * grid%xb%qs(i,j,k) +! enddo +! enddo +! enddo +! enddo +! !$OMP END PARALLEL DO +#ifdef CLOUD_CV + !qcloud + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij, i, j, k ) + do ij = 1 , grid%num_tiles + do k = kts, kte + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + vp%v6(i,j,k) = grid%xa % qcw(i,j,k) + enddo + enddo + enddo + enddo + !$OMP END PARALLEL DO + !qrain + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij, i, j, k ) + do ij = 1 , grid%num_tiles + do k = kts, kte + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + vp%v7(i,j,k) = grid%xa % qrn(i,j,k) + enddo + enddo + enddo + enddo + !$OMP END PARALLEL DO + !qice + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij, i, j, k ) + do ij = 1 , grid%num_tiles + do k = kts, kte + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + vp%v8(i,j,k) = grid%xa % qci(i,j,k) + enddo + enddo + enddo + enddo + !$OMP END PARALLEL DO + !qsnow + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij, i, j, k ) + do ij = 1 , grid%num_tiles + do k = kts, kte + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + vp%v9(i,j,k) = grid%xa % qsn(i,j,k) + enddo + enddo + enddo + enddo + !$OMP END PARALLEL DO + !qgraupel + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij, i, j, k ) + do ij = 1 , grid%num_tiles + do k = kts, kte + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + vp%v10(i,j,k) = grid%xa % qgr(i,j,k) + enddo + enddo + enddo + enddo + !$OMP END PARALLEL DO + !vertical velocity + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij, i, j, k ) + do ij = 1 , grid%num_tiles + do k = kts, kte + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + vp%v11(i,j,k) = grid%xa % w(i,j,k) + enddo + enddo + enddo + enddo + !$OMP END PARALLEL DO +#endif +! end if + !else ! no rf or cloud radiance + ! ! Pseudo RH --> Water vapor mixing ratio: + ! !$OMP PARALLEL DO & + ! !$OMP PRIVATE ( ij, i, j, k ) + ! do ij = 1 , grid%num_tiles + ! do k = kts, kte + ! do j = grid%j_start(ij), grid%j_end(ij) + ! do i = its, ite + ! grid%xa % q(i,j,k) = vp%v4(i,j,k) * grid%xb%qs(i,j,k) + ! enddo + ! enddo + ! enddo + ! enddo + ! !$OMP END PARALLEL DO + end if ! RF or Radiance + !--------------------------------------------------------------------------- + ! [4] Add flow-dependent increments in model space (grid%xa): + !--------------------------------------------------------------------------- + +! if (be % ne > 0 .and. alphacv_method == alphacv_method_xa) then +! call da_add_flow_dependence_xa(grid, be % ne, ep, vp) +! end if +! if (be % ne > 0 .and. alphacv_method == alphacv_method_xa) then +! if ( anal_type_hybrid_dual_res ) then +! call da_add_flow_dependence_xa_dual_res(grid, be % ne, ep, vp) +! else +! call da_add_flow_dependence_xa(grid, be % ne, ep, vp) +! endif +! end if + + if (trace_use) call da_trace_exit("da_transform_vptox_inv") + +end subroutine da_transform_vptox_inv + diff --git a/var/da/da_vtox_transforms/da_transform_vtovv_inv.inc b/var/da/da_vtox_transforms/da_transform_vtovv_inv.inc new file mode 100644 index 0000000000..8bb438a55f --- /dev/null +++ b/var/da/da_vtox_transforms/da_transform_vtovv_inv.inc @@ -0,0 +1,249 @@ +subroutine da_transform_vtovv_inv(grid, cv_size, be, cv, vv) + + !----------------------------------------------------------------------- + ! Purpose: perform inverse transform of horizontal recursive filter + ! + ! Author: Zhiquan (Jake) Liu, NCAR/MMM, 2015-09 + !----------------------------------------------------------------------- + + implicit none + + type(domain), intent(inout) :: grid + integer, intent(in) :: cv_size ! Size of cv array. + type(be_type), intent(in) :: be ! Background error structure. + real, intent(inout) :: cv(cv_size) ! control variables. + type(vp_type), intent(inout) :: vv ! Grid point/EOF control var. + + integer :: s(4) ! Index bounds into arrays. + integer :: n ! Loop counter. + integer :: mz ! Vertical truncation. + integer :: ne ! Ensemble size. + + logical :: scaling + + if (trace_use) call da_trace_entry("da_transform_vtovv_inv") + + if( .not. use_rf .or. do_normalize ) s(1:2)=1 + + + !------------------------------------------------------------------------- + ! [2.0] Perform inverse of VToVV Transform: + !------------------------------------------------------------------------- + + ! [2.1] Transform 1st control variable: + mz = be % v1 % mz + !s(3)=s(1)+mz-1 + !if( do_normalize )call da_transform_rescale(mz,be%sd(:,:,s(1):s(3)),vv%v1) + if( use_rf .and. mz > 0 .and. len_scaling1(1) /= 0.0) then + call da_transform_through_rf_inv(grid, mz, be % v1 % rf_alpha, be % v1 % val, vv % v1) + !elseif( mz > 0 ) then + ! s(4)=s(2)+nij(0,0,2)*nij(0,1,2)*mz-1 + ! call da_transform_through_wavelet_inv(grid,mz,be%wsd(:,:,s(1):s(3)),cv(s(2):s(4)),vv%v1) + ! s(2)=s(4)+1 + !else + ! !print'(a,": be%v1%mz=",I0)',__FILE__,mz + endif + !s(1)=s(3)+1 + + ! [2.2] Transform 2nd control variable: + + mz = be % v2 % mz + !s(3)=s(1)+mz-1 + !if( do_normalize )call da_transform_rescale(mz,be%sd(:,:,s(1):s(3)),vv%v2) + if( use_rf .and. mz > 0 .and. len_scaling2(1) /= 0.0) then + call da_transform_through_rf_inv(grid, mz, be % v2 % rf_alpha, be % v2 % val, vv % v2) + !elseif( mz > 0 ) then + ! s(4)=s(2)+nij(0,0,2)*nij(0,1,2)*mz-1 + ! call da_transform_through_wavelet_inv(grid,mz,be%wsd(:,:,s(1):s(3)),cv(s(2):s(4)),vv%v2) + ! s(2)=s(4)+1 + !else + ! !print'(a,": be%v2%mz=",I0)',__FILE__,mz + endif + !s(1)=s(3)+1 + + ! [2.3] Transform 3rd control variable + + mz = be % v3 % mz + !s(3)=s(1)+mz-1 + !if( do_normalize )call da_transform_rescale(mz,be%sd(:,:,s(1):s(3)),vv%v3) + if( use_rf .and. mz > 0 .and. len_scaling3(1) /= 0.0) then + call da_transform_through_rf_inv(grid, mz, be % v3 % rf_alpha, be % v3 % val, vv % v3) + !elseif( mz > 0 ) then + ! s(4)=s(2)+nij(0,0,2)*nij(0,1,2)*mz-1 + ! call da_transform_through_wavelet_inv(grid,mz,be%wsd(:,:,s(1):s(3)),cv(s(2):s(4)),vv%v3) + ! s(2)=s(4)+1 + !else + ! !print'(a,": be%v3%mz=",I0)',__FILE__,mz + endif + !s(1)=s(3)+1 + + ! [2.4] Transform 4th control variable + + mz = be % v4 % mz + !s(3)=s(1)+mz-1 + !if( do_normalize )call da_transform_rescale(mz,be%sd(:,:,s(1):s(3)),vv%v4) + if( use_rf .and. mz > 0 .and. len_scaling4(1) /= 0.0) then + call da_transform_through_rf_inv(grid, mz, be % v4 % rf_alpha, be % v4 % val, vv % v4) + !elseif( mz > 0 ) then + ! s(4)=s(2)+nij(0,0,2)*nij(0,1,2)*mz-1 + ! call da_transform_through_wavelet_inv(grid,mz,be%wsd(:,:,s(1):s(3)),cv(s(2):s(4)),vv%v4) + ! s(2)=s(4)+1 + !else + ! !print'(a,": be%v4%mz=",I0)',__FILE__,mz + endif + !s(1)=s(3)+1 + + ! [2.5] Transform 5th control variable + + mz = be % v5 % mz + !s(3)=s(1)+mz-1 + !if( do_normalize )call da_transform_rescale(mz,be%sd(:,:,s(1):s(3)),vv%v5) + if( use_rf .and. mz > 0 .and. len_scaling5(1) /= 0.0) then + call da_transform_through_rf_inv(grid, mz, be % v5 % rf_alpha, be % v5 % val, vv % v5) + !elseif( mz > 0 ) then + ! s(4)=s(2)+nij(0,0,2)*nij(0,1,2)*mz-1 + ! call da_transform_through_wavelet_inv(grid,mz,be%wsd(:,:,s(1):s(3)),cv(s(2):s(4)),vv%v5) + ! s(2)=s(4)+1 + !else + ! !print'(a,": be%v5%mz=",I0)',__FILE__,mz + endif + !s(1)=s(3)+1 + +#ifdef CLOUD_CV + ! [2.6] Transform 6th control variable + if (cloud_cv_options == 3)then + scaling = .true. + else + scaling = .false. + endif + mz = be % v6 % mz + if( use_rf .and. mz > 0 .and. len_scaling6(1) /= 0.0) then + if(cloud_cv_options == 1)then + vv % v6 = 0.0 + elseif(cloud_cv_options == 2)then + call da_transform_through_rf_inv(grid, mz, be % v6 % rf_alpha, be % v6 % val, vv % v6) + elseif(cloud_cv_options == 3)then + call da_transform_through_rf_inv(grid, mz, be % v6 % rf_alpha, be % v6 % val, vv % v6, scaling) +! call da_transform_through_rf2_inv(grid, mz, be % v6 % rf_alpha, be % v6 % val, vv % v6) + endif + elseif( .not. use_rf ) then + call da_error(__FILE__,__LINE__,(/"no da_transform_through_wavelet_inv for v6"/)) + endif + + ! [2.7] Transform 7th control variable + + mz = be % v7 % mz + if( use_rf .and. mz > 0 .and. len_scaling7(1) /= 0.0) then + if(cloud_cv_options == 1)then + vv % v7 = 0.0 + elseif(cloud_cv_options == 2)then + call da_transform_through_rf_inv(grid, mz, be % v7 % rf_alpha, be % v7 % val, vv % v7) + elseif(cloud_cv_options == 3)then + call da_transform_through_rf_inv(grid, mz, be % v7 % rf_alpha, be % v7 % val, vv % v7, scaling) +! call da_transform_through_rf2_inv(grid, mz, be % v7 % rf_alpha, be % v7 % val, vv % v7) + endif + elseif( .not. use_rf ) then + call da_error(__FILE__,__LINE__,(/"no da_transform_through_wavelet_inv for v7"/)) + endif + + ! [2.8] Transform 8th control variable + + mz = be % v8 % mz + if( use_rf .and. mz > 0 .and. len_scaling8(1) /= 0.0) then + if(cloud_cv_options == 1)then + vv % v8 = 0.0 + elseif(cloud_cv_options == 2)then + call da_transform_through_rf_inv(grid, mz, be % v8 % rf_alpha, be % v8 % val, vv % v8) + elseif(cloud_cv_options == 3)then + call da_transform_through_rf_inv(grid, mz, be % v8 % rf_alpha, be % v8 % val, vv % v8, scaling) +! call da_transform_through_rf2_inv(grid, mz, be % v8 % rf_alpha, be % v8 % val, vv % v8) + endif + elseif( .not. use_rf ) then + call da_error(__FILE__,__LINE__,(/"no da_transform_through_wavelet_inv for v8"/)) + endif + + ! [2.9] Transform 9th control variable + + mz = be % v9 % mz + if( use_rf .and. mz > 0 .and. len_scaling9(1) /= 0.0) then + if(cloud_cv_options == 1)then + vv % v9 = 0.0 + elseif(cloud_cv_options == 2)then + call da_transform_through_rf_inv(grid, mz, be % v9 % rf_alpha, be % v9 % val, vv % v9) + elseif(cloud_cv_options == 3)then + call da_transform_through_rf_inv(grid, mz, be % v9 % rf_alpha, be % v9 % val, vv % v9, scaling) + endif + elseif( .not. use_rf ) then + call da_error(__FILE__,__LINE__,(/"no da_transform_through_wavelet_inv for v9"/)) + endif + + ! [2.10] Transform 10th control variable + + mz = be % v10 % mz + if( use_rf .and. mz > 0 .and. len_scaling10(1) /= 0.0) then + if(cloud_cv_options == 1)then + vv % v10 = 0.0 + elseif(cloud_cv_options == 2)then + call da_transform_through_rf_inv(grid, mz, be % v10 % rf_alpha, be % v10 % val, vv % v10) + elseif(cloud_cv_options == 3)then + call da_transform_through_rf_inv(grid, mz, be % v10 % rf_alpha, be % v10 % val, vv % v10, scaling) + endif + elseif( .not. use_rf ) then + call da_error(__FILE__,__LINE__,(/"no da_transform_through_wavelet_inv for v10"/)) + endif + + ! [2.11] Transform 11th control variable + + mz = be % v11 % mz + if( use_rf .and. mz > 0 .and. len_scaling11(1) /= 0.0) then + if(cloud_cv_options == 1)then + vv % v11 = 0.0 + elseif(cloud_cv_options == 2)then + call da_transform_through_rf_inv(grid, mz, be % v11 % rf_alpha, be % v11 % val, vv % v11) + elseif(cloud_cv_options == 3)then + call da_transform_through_rf_inv(grid, mz, be % v11 % rf_alpha, be % v11 % val, vv % v11, scaling) + endif + elseif( .not. use_rf ) then + call da_error(__FILE__,__LINE__,(/"no da_transform_through_wavelet_inv for v11"/)) + endif + +#endif + + ! [2.12] Transform alpha control variable + + ne = be % ne + if (ne > 0) then + mz = be % alpha % mz + !if( do_normalize )then + ! do n = 1, ne + ! call da_transform_rescale(mz,be%alpha%sd,vv%alpha(:,:,:,n)) + ! end do + !endif + if( use_rf )then + do n = 1, ne + !if ( anal_type_hybrid_dual_res ) then + ! call da_transform_through_rf_inv_dual_res(grid % intermediate_grid, mz, be % alpha % rf_alpha, & + ! be % alpha % val, vv % alpha(:,:,:,n)) + !else + call da_transform_through_rf_inv(grid, mz, be % alpha % rf_alpha, be % alpha % val, vv % alpha(:,:,:,n)) + !endif + end do + !else + !do n = 1, ne + ! s(4)=s(2)+nij(0,0,2)*nij(0,1,2)*mz-1 + ! call da_transform_through_wavelet_inv(grid,mz,be%alpha%wsd,cv(s(2):s(4)),vv%alpha(:,:,:,n)) + ! s(2)=s(4)+1 + !end do + endif + endif + + if( use_rf )then + !------------------------------------------------------------------------- + ! [1.0] Fill 1D cv array from 3-dimensional vv arrays. + !------------------------------------------------------------------------- + call da_vv_to_cv( vv, grid%xp, be%cv_mz, be%ncv_mz, cv_size, cv) + endif + + if (trace_use) call da_trace_exit("da_transform_vtovv_inv") + +endsubroutine da_transform_vtovv_inv diff --git a/var/da/da_vtox_transforms/da_transform_vtox_inv.inc b/var/da/da_vtox_transforms/da_transform_vtox_inv.inc new file mode 100644 index 0000000000..2d96a40452 --- /dev/null +++ b/var/da/da_vtox_transforms/da_transform_vtox_inv.inc @@ -0,0 +1,87 @@ +subroutine da_transform_vtox_inv(grid, cv_size, xbx, be, ep, cv, vv, vp) + + !-------------------------------------------------------------------------- + ! Purpose: Inverse control variable transform v = U^{-1} x'. + !-------------------------------------------------------------------------- + + implicit none + + type(domain), intent(inout) :: grid + integer, intent(in) :: cv_size ! Size of cv array. + type(xbx_type), intent(in) :: xbx ! For header & non-grid arrays. + type(be_type), intent(in) :: be ! background errors. + type(ep_type), intent(in) :: ep ! Ensemble perturbations. + real, intent(out) :: cv(1:cv_size) ! control variables. + type(vp_type), intent(out) :: vv ! grdipt/eof cv (local). + type(vp_type), intent(inout) :: vp ! grdipt/level cv (local). + + if (trace_use) call da_trace_entry("da_transform_vtox_inv") + + call da_zero_x (grid%xa) + + if (.not. use_background_errors) then + if (trace_use) call da_trace_exit("da_transform_vtox_inv") + return + end if + + !---------------------------------------------------------------------- + ! [1.0]: Perform inverse of balance tranform: vp = u_p^{-1} dx + !---------------------------------------------------------------------- + + if ( cv_options /= 7 ) call da_transform_vptox_inv(grid, vp, be, ep) + + !---------------------------------------------------------------------- + ! [2.0]: Perform inverse of vertical transform: vv = L^{-1/2} E^T vp + !---------------------------------------------------------------------- + + !if ( cv_options == 3 ) then + ! + ! call da_apply_be( be, cv, vp, grid) + ! call da_transform_bal( vp, be, grid) + ! + !else + + if (vert_corr == vert_corr_2) then + call da_vertical_transform(grid, 'u_inv', be, grid%xb % vertical_inner_product, vv, vp) + !call da_write_vp(grid,vv,'vv_afterUvTransf') + else + vv % v1(its:ite,jts:jte,kts:kte) = vp % v1(its:ite,jts:jte,kts:kte) + vv % v2(its:ite,jts:jte,kts:kte) = vp % v2(its:ite,jts:jte,kts:kte) + vv % v3(its:ite,jts:jte,kts:kte) = vp % v3(its:ite,jts:jte,kts:kte) + vv % v4(its:ite,jts:jte,kts:kte) = vp % v4(its:ite,jts:jte,kts:kte) + vv % v5(its:ite,jts:jte,kts:kte) = vp % v5(its:ite,jts:jte,kts:kte) +#ifdef CLOUD_CV + vv % v6(its:ite,jts:jte,kts:kte) = vp % v6(its:ite,jts:jte,kts:kte) + vv % v7(its:ite,jts:jte,kts:kte) = vp % v7(its:ite,jts:jte,kts:kte) + vv % v8(its:ite,jts:jte,kts:kte) = vp % v8(its:ite,jts:jte,kts:kte) + vv % v9(its:ite,jts:jte,kts:kte) = vp % v9(its:ite,jts:jte,kts:kte) + vv % v10(its:ite,jts:jte,kts:kte) = vp % v10(its:ite,jts:jte,kts:kte) + vv % v11(its:ite,jts:jte,kts:kte) = vp % v11(its:ite,jts:jte,kts:kte) +#endif + if (be % ne > 0) then +! vv % alpha(its:ite,jts:jte,kts:kte,1:be%ne) = vp%alpha(its:ite,jts:jte,kts:kte,1:be%ne) + vv % alpha(its_int:ite_int,jts_int:jte_int,kts_int:kte_int,1:be%ne) = & + vp%alpha(its_int:ite_int,jts_int:jte_int,kts_int:kte_int,1:be%ne) + end if + end if + + !---------------------------------------------------------------------- + ! [3.0]: Perform inverse of recursive filter: cv = u_h^{-1} vv + !---------------------------------------------------------------------- + + !if (global) then + ! call da_transform_vtovv_global(cv_size, xbx, be, cv, vv) + !else if ( (fg_format == fg_format_wrf_arw_regional .or. & + ! fg_format == fg_format_wrf_nmm_regional) .and. & + ! (.not. cv_options == 3) )then + + call da_transform_vtovv_inv(grid, cv_size, be, cv, vv) + + !end if + + !end if + + if (trace_use) call da_trace_exit("da_transform_vtox_inv") + +end subroutine da_transform_vtox_inv + diff --git a/var/da/da_vtox_transforms/da_transform_vvtovp.inc b/var/da/da_vtox_transforms/da_transform_vvtovp.inc index e4fa05d871..dfce751467 100644 --- a/var/da/da_vtox_transforms/da_transform_vvtovp.inc +++ b/var/da/da_vtox_transforms/da_transform_vvtovp.inc @@ -4,7 +4,15 @@ subroutine da_transform_vvtovp(grid, evec, eval, vertical_wgt, vv, vp, mz, level ! Purpose: Transform from fields on vertical EOFS to fields on vertical ! levels. ! - ! Method: Perform vp(i,j,k) = P E L^{1/2} vv(i,j,m) transform. + ! Method: Perform vp(i,j,k) = E L^{1/2} vv(i,j,m) transform. + ! + ! Zhiquan (Jake) liu's note: 2015-09 + !------------------------------------------------------------------------- + ! 1. evec/eval assumed to vary in y direction (jds:jde) though it may not + ! be true in BE file (e.g., likely domain-averaged BE with bin_type=5). + ! 2. evec/eval truncated to number of EOF mode mz<=levels + ! 3. eval here is in fact square root of eigen values (see da_allocate_background_errors) + ! 4. by default, vertical weight not calculated/used !--------------------------------------------------------------------------- implicit none diff --git a/var/da/da_vtox_transforms/da_transform_vvtovp_adj.inc b/var/da/da_vtox_transforms/da_transform_vvtovp_adj.inc index ad820375da..c615c01c15 100644 --- a/var/da/da_vtox_transforms/da_transform_vvtovp_adj.inc +++ b/var/da/da_vtox_transforms/da_transform_vvtovp_adj.inc @@ -31,7 +31,7 @@ subroutine da_transform_vvtovp_adj(grid, evec, eval, vertical_wgt, vp, vv, mz, l end if !------------------------------------------------------------------- - ! [2.0] Perform vp(i,j,k) = E L^{1/2} vv(i,j,m) transform: + ! [2.0] Perform vv(i,j,m) = L^{1/2} E^T vp(i,j,k) transform: !------------------------------------------------------------------- !$OMP PARALLEL DO & diff --git a/var/da/da_vtox_transforms/da_transform_vvtovp_inv.inc b/var/da/da_vtox_transforms/da_transform_vvtovp_inv.inc new file mode 100644 index 0000000000..fa620d7f61 --- /dev/null +++ b/var/da/da_vtox_transforms/da_transform_vvtovp_inv.inc @@ -0,0 +1,62 @@ +subroutine da_transform_vvtovp_inv(grid, evec, eval, vertical_wgt, vp, vv, mz, levels) + + !--------------------------------------------------------------------------- + ! Purpose: Inverse of da_transform_vvtovp. + ! based on da_transform_vvtovp_adj + ! + ! Author: Zhiquan (Jake) Liu, NCAR/MMM, 2015-09 + !--------------------------------------------------------------------------- + + implicit none + + type (domain), intent(in) :: grid + integer, intent(in) :: mz ! # vertical modes. + integer, intent(in) :: levels ! no. of vertical levels + + real*8, intent(in) :: evec(jds:jde,kds:kde,1:mz) ! Eigenvectors. + real*8, intent(in) :: eval(jds:jde,1:mz) ! Eigenvalues. + real, intent(in) :: vertical_wgt(ims:ime,jms:jme,kms:kme) ! Weighting. + real, intent(inout) :: vp(ims:ime,jms:jme,kms:kme)! CV in level space. + real, intent(out) :: vv(ims:ime,jms:jme,kms:kme)! CV in EOF space. + + integer :: i, j, m, k, ij ! Loop counters. + real :: temp + + if (trace_use_dull) call da_trace_entry("da_transform_vvtovp_inv") + + !------------------------------------------------------------------- + ! [1.0] Apply inner-product weighting if vertical_ip /= vertical_ip_0: + !------------------------------------------------------------------- + + if (vertical_ip /= vertical_ip_0) then + vp(its:ite,jts:jte,kts:levels) = vp(its:ite,jts:jte,kts:levels) * & + vertical_wgt(its:ite,jts:jte,kts:levels) + end if + + !------------------------------------------------------------------- + ! [2.0] Perform vv(i,j,m) = L^{-1/2} E^T vp(i,j,k) transform: + !------------------------------------------------------------------- + + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij, m, k, j, i, temp ) + do ij = 1 , grid%num_tiles + vv(:,grid%j_start(ij):grid%j_end(ij),:) = 0.0 + do m = 1, mz + do k = kts, levels + do j = grid%j_start(ij), grid%j_end(ij) + temp = evec(j,k,m) / eval(j,m) + + do i = its, ite + vv(i,j,m) = vv(i,j,m) + temp * vp(i,j,k) + end do + end do + end do + end do + end do + !$OMP END PARALLEL DO + + if (trace_use_dull) call da_trace_exit("da_transform_vvtovp_inv") + +end subroutine da_transform_vvtovp_inv + + diff --git a/var/da/da_vtox_transforms/da_vertical_transform.inc b/var/da/da_vtox_transforms/da_vertical_transform.inc index e709bd423a..2fa70c1d00 100644 --- a/var/da/da_vtox_transforms/da_vertical_transform.inc +++ b/var/da/da_vtox_transforms/da_vertical_transform.inc @@ -1,7 +1,13 @@ subroutine da_vertical_transform(grid, string, be, vertical_wgt, vv, vp) !--------------------------------------------------------------------- - ! Purpose: TBD + ! Purpose: perform vertical transform Uv using eigenvector/eigenvalue + ! of vertical covariance + ! + ! Zhiquan (Jake) Liu, NCAR/MMM, 2015-09 + ! 1. add appropriate comments on transform and variables + ! 2. replace inverse transform da_transform_vptovv + ! by da_transform_vvtovp_inv !--------------------------------------------------------------------- implicit none @@ -30,28 +36,28 @@ subroutine da_vertical_transform(grid, string, be, vertical_wgt, vv, vp) if (be % v1 % mz > 0) then call da_transform_vvtovp (grid, be % v1 % evec, be % v1 % val, vertical_wgt, & - vv % v1, vp % v1, be % v1 % mz, kte) + vv % v1, vp % v1, be % v1 % mz, kte) ! psi (stream function) or u (if cv7) else vp % v1(its:ite,jts:jte,kts:kte) = 0.0 end if if (be % v2 % mz > 0) then call da_transform_vvtovp (grid, be % v2 % evec, be % v2 % val, vertical_wgt, & - vv % v2, vp % v2, be % v2 % mz, kte) + vv % v2, vp % v2, be % v2 % mz, kte) ! chi_u (unbalanced chi) or v (if cv7) else vp % v2(its:ite,jts:jte,kts:kte) = 0.0 end if if (be % v3 % mz > 0) then call da_transform_vvtovp (grid, be % v3 % evec, be % v3 % val, vertical_wgt, & - vv % v3, vp % v3, be % v3 % mz, kte) + vv % v3, vp % v3, be % v3 % mz, kte) ! T_u (unbalanced T) or T (if cv7) else vp % v3(its:ite,jts:jte,kts:kte) = 0.0 end if if (be % v4 % mz > 0) then call da_transform_vvtovp (grid, be % v4 % evec, be % v4 % val, vertical_wgt, & - vv % v4, vp % v4, be % v4 % mz, kte) + vv % v4, vp % v4, be % v4 % mz, kte) ! pseudo rh=q/qs(background) else vp % v4(its:ite,jts:jte,kts:kte) = 0.0 end if @@ -61,19 +67,19 @@ subroutine da_vertical_transform(grid, string, be, vertical_wgt, vv, vp) vp % v5(its:ite,jts:jte,1) = vv % v5(its:ite,jts:jte,1) else call da_transform_vvtovp (grid, be % v5 % evec, be % v5 % val, vertical_wgt, & - vv % v5, vp % v5, be % v5 % mz, kts) + vv % v5, vp % v5, be % v5 % mz, kts) ! Ps_u (unbalanced Ps) or Ps (if cv7) end if else vp % v5(its:ite,jts:jte,kts:kts) = 0.0 end if ! for cloud_cv_options<=1 and not use_cv_w - vp % v6 = 0.0 - vp % v7 = 0.0 - vp % v8 = 0.0 - vp % v9 = 0.0 - vp % v10 = 0.0 - vp % v11 = 0.0 + vp % v6 = 0.0 ! cloud water qcw + vp % v7 = 0.0 ! rain water qrain + vp % v8 = 0.0 ! cloud ice qice + vp % v9 = 0.0 ! snow qsnow + vp % v10 = 0.0 ! qgraupel + vp % v11 = 0.0 ! vertical velocity w if ( cloud_cv_options == 2 ) then if (be % v6 % mz > 0) then @@ -142,72 +148,62 @@ subroutine da_vertical_transform(grid, string, be, vertical_wgt, vv, vp) case ('u_inv'); !------------------------------------------------------------------- - ! [2.0] Perform vv(i,j,m) = L^{-1/2} E^T vp(i,j,k) transform: + ! [2.0] Perform inverse transform: vv(i,j,m) = L^{-1/2} E^T vp(i,j,k) !------------------------------------------------------------------- if (be % v1 % mz > 0) then - call da_transform_vptovv (be % v1 % evec, be % v1 % val, vertical_wgt, & - vp % v1, vv % v1, be % v1 % mz, kds,kde, ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) + call da_transform_vvtovp_inv (grid, be % v1 % evec, be % v1 % val, vertical_wgt, & + vp % v1, vv % v1, be % v1 % mz, kte) end if if (be % v2 % mz > 0) then - call da_transform_vptovv (be % v2 % evec, be % v2 % val, vertical_wgt, & - vp % v2, vv % v2, be % v2 % mz, kds,kde, ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) + call da_transform_vvtovp_inv (grid, be % v2 % evec, be % v2 % val, vertical_wgt, & + vp % v2, vv % v2, be % v2 % mz, kte) end if if (be % v3 % mz > 0) then - call da_transform_vptovv (be % v3 % evec, be % v3 % val, vertical_wgt, & - vp % v3, vv % v3, be % v3 % mz, kds,kde, ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) + call da_transform_vvtovp_inv (grid, be % v3 % evec, be % v3 % val, vertical_wgt, & + vp % v3, vv % v3, be % v3 % mz, kte) end if if (be % v4 % mz > 0) then - call da_transform_vptovv (be % v4 % evec, be % v4 % val, vertical_wgt, & - vp % v4, vv % v4, be % v4 % mz, kds,kde, ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) + call da_transform_vvtovp_inv (grid, be % v4 % evec, be % v4 % val, vertical_wgt, & + vp % v4, vv % v4, be % v4 % mz, kte) end if if (be % v5 % mz > 0) then if (global) then vv % v5(its:ite,jts:jte,1) = vp % v5(its:ite,jts:jte,1) else - call da_transform_vptovv (be % v5 % evec, be % v5 % val, vertical_wgt, & - vp % v5, vv % v5, be % v5 % mz, kds,kde, ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) + call da_transform_vvtovp_inv (grid, be % v5 % evec, be % v5 % val, vertical_wgt, & + vp % v5, vv % v5, be % v5 % mz, kts) end if end if if ( cloud_cv_options == 2 ) then if (be % v6 % mz > 0) then - call da_transform_vptovv (be % v6 % evec, be % v6 % val, vertical_wgt, & - vp % v6, vv % v6, be % v6 % mz, kds,kde, ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) + call da_transform_vvtovp_inv (grid, be % v6 % evec, be % v6 % val, vertical_wgt, & + vp % v6, vv % v6, be % v6 % mz, kte) end if if (be % v7 % mz > 0) then - call da_transform_vptovv (be % v7 % evec, be % v7 % val, vertical_wgt, & - vp % v7, vv % v7, be % v7 % mz, kds,kde, ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) + call da_transform_vvtovp_inv (grid, be % v7 % evec, be % v7 % val, vertical_wgt, & + vp % v7, vv % v7, be % v7 % mz, kte) end if if (be % v8 % mz > 0) then - call da_transform_vptovv (be % v8 % evec, be % v8 % val, vertical_wgt, & - vp % v8, vv % v8, be % v8 % mz, kds,kde, ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) + call da_transform_vvtovp_inv (grid, be % v8 % evec, be % v8 % val, vertical_wgt, & + vp % v8, vv % v8, be % v8 % mz, kte) end if if (be % v9 % mz > 0) then - call da_transform_vptovv (be % v9 % evec, be % v9 % val, vertical_wgt, & - vp % v9, vv % v9, be % v9 % mz, kds,kde, ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) + call da_transform_vvtovp_inv (grid, be % v9 % evec, be % v9 % val, vertical_wgt, & + vp % v9, vv % v9, be % v9 % mz, kte) end if if (be % v10 % mz > 0) then - call da_transform_vptovv (be % v10 % evec, be % v10 % val, vertical_wgt, & - vp % v10, vv % v10, be % v10 % mz, kds,kde, ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) + call da_transform_vvtovp_inv (grid, be % v10 % evec, be % v10 % val, vertical_wgt, & + vp % v10, vv % v10, be % v10 % mz, kte) end if else if ( cloud_cv_options == 3 ) then @@ -236,9 +232,8 @@ subroutine da_vertical_transform(grid, string, be, vertical_wgt, vv, vp) if ( use_cv_w ) then if (be % v11 % mz > 0) then if ( cloud_cv_options == 2 ) then - call da_transform_vptovv (be % v11 % evec, be % v11 % val, vertical_wgt, & - vp % v11, vv % v11, be % v11 % mz, kds,kde, ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) + call da_transform_vvtovp_inv (grid, be % v11 % evec, be % v11 % val, vertical_wgt, & + vp % v11, vv % v11, be % v11 % mz, kte) else if ( cloud_cv_options == 3 ) then vv % v11 = vp % v11 end if @@ -250,17 +245,21 @@ subroutine da_vertical_transform(grid, string, be, vertical_wgt, vv, vp) ! call da_transform_vptovv (be % alpha % evec, be % alpha % val, vertical_wgt, & ! vp % alpha(:,:,:,n), vv % alpha(:,:,:,n), be % alpha % mz, kds,kde, & ! ims,ime, jms,jme, kms,kme, its,ite, jts,jte, kts,kte) - call da_transform_vptovv (be % alpha % evec, be % alpha % val, vertical_wgt, & - vp % alpha(:,:,:,n), vv % alpha(:,:,:,n), be % alpha % mz, kds_int,kde_int, & - ims_int,ime_int, jms_int,jme_int, kms_int,kme_int, its_int,ite_int, & - jts_int,jte_int, kts_int,kte_int) +! call da_transform_vptovv (be % alpha % evec, be % alpha % val, vertical_wgt, & +! vp % alpha(:,:,:,n), vv % alpha(:,:,:,n), be % alpha % mz, kds_int,kde_int, & +! ims_int,ime_int, jms_int,jme_int, kms_int,kme_int, its_int,ite_int, & +! jts_int,jte_int, kts_int,kte_int) + + call da_transform_vvtovp_inv (grid, be % alpha % evec, be % alpha % val, vertical_wgt, & + vp % alpha(:,:,:,n), vv % alpha(:,:,:,n), be % alpha % mz, kte) + end do end if case ('u_adj'); !------------------------------------------------------------------- - ! [3.0] Perform vv_adj = U_{v}^{T} vp_adj transform: + ! [3.0] Perform adjoint transform: vv_adj = L^{1/2} E^T vp_adj !------------------------------------------------------------------- if (be % v1 % mz > 0) then diff --git a/var/da/da_vtox_transforms/da_vtox_transforms.f90 b/var/da/da_vtox_transforms/da_vtox_transforms.f90 index 44778ffec9..91a3bde22e 100644 --- a/var/da/da_vtox_transforms/da_vtox_transforms.f90 +++ b/var/da/da_vtox_transforms/da_vtox_transforms.f90 @@ -64,6 +64,7 @@ module da_vtox_transforms use da_par_util, only : da_vv_to_cv, da_cv_to_vv use da_recursive_filter, only : da_transform_through_rf, & + da_transform_through_rf_inv, & da_transform_through_rf_adj, da_apply_rf, da_apply_rf_adj, & da_transform_through_rf_dual_res, da_transform_through_rf_adj_dual_res use da_reporting, only : da_error, message, da_warning, da_message @@ -85,16 +86,19 @@ module da_vtox_transforms #include "da_check_eof_decomposition.inc" #include "da_transform_vtovv.inc" #include "da_transform_vtovv_adj.inc" +#include "da_transform_vtovv_inv.inc" #include "da_transform_rescale.inc" #include "da_transform_vtox.inc" +#include "da_transform_vtox_inv.inc" #include "da_transform_xtoxa.inc" #include "da_transform_vtox_adj.inc" #include "da_transform_xtoxa_adj.inc" #include "da_transform_vptox.inc" #include "da_transform_vptox_adj.inc" +#include "da_transform_vptox_inv.inc" #include "da_transform_vvtovp.inc" #include "da_transform_vvtovp_adj.inc" -#include "da_transform_vptovv.inc" +#include "da_transform_vvtovp_inv.inc" #include "da_transform_vpatox.inc" #include "da_transform_vpatox_adj.inc" #include "da_vertical_transform.inc" From 59f53972acc8bd39e7874b49c7fb3f3b4911c5b4 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Mon, 1 May 2017 11:22:59 -0600 Subject: [PATCH 06/91] Update README.CWB_v39a to include info for MRI-4DVAR and radar_non_precip_opt=1 bug fix. modified: README.CWB_v39a --- README.CWB_v39a | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/README.CWB_v39a b/README.CWB_v39a index 20fc091e2c..757277ec03 100644 --- a/README.CWB_v39a +++ b/README.CWB_v39a @@ -5,6 +5,13 @@ New features (only in the CWB branch): 1. Divergence constaint capability. 2. Large Scale Analysis Constraint capability. 3. Radar neighborhood no-rain scheme (radar_non_precip_opt=2). + 4. Multi-Resolution-Incremental 4DVAR. + +Bug fixes since V3.9 (April 17, 2017) + 1. Bug fix for radar_non_precip_opt == 1. + radar_non_precip_rh_w and radar_non_precip_rh_i namelist settings + were incorrectly modified within a loop, causing them to eventually + go to zero. General WRFDA improvements in V3.9 that are relevant to CWB's applications. 1. Implementation of WRFDA cloud control variables is improved. From 21373d1b1c2b603d5784d624a10df8b3416d0dea Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Wed, 24 May 2017 14:44:32 -0600 Subject: [PATCH 07/91] Bug fix and minor cleanup for divergence constraint. DIVC works fine with the CWB_v381a code. CWB_v39a (CWB_v39f2a) includes the new 4DEnsVar capability that requires "call da_zero_vp_type (vp)" to be removed from subroutine da_transform_vtox_adj. Therefore, da_zero_vp_type must now be called before "call da_transform_vtox_adj". modified: README.CWB_v39a modified: var/da/da_minimisation/da_calculate_gradj.inc modified: var/da/da_minimisation/da_calculate_j.inc --- README.CWB_v39a | 7 ++++++- var/da/da_minimisation/da_calculate_gradj.inc | 3 ++- var/da/da_minimisation/da_calculate_j.inc | 2 -- 3 files changed, 8 insertions(+), 4 deletions(-) diff --git a/README.CWB_v39a b/README.CWB_v39a index 757277ec03..5f04903ff8 100644 --- a/README.CWB_v39a +++ b/README.CWB_v39a @@ -2,11 +2,16 @@ This CWB_v39a code is branched off from the offical V3.9 release (commit hash ee with the following new features added. New features (only in the CWB branch): - 1. Divergence constaint capability. + 1. Divergence constraint capability. 2. Large Scale Analysis Constraint capability. 3. Radar neighborhood no-rain scheme (radar_non_precip_opt=2). 4. Multi-Resolution-Incremental 4DVAR. +Bug fixes since May 1, 2017 (only in the CWB branch) + 1. Bug fix for divergence constraint + grid%vp needs to be zeroed out before calling da_transform_vtox_adj + due to the introduction of the new 4DEnsVar capability. + Bug fixes since V3.9 (April 17, 2017) 1. Bug fix for radar_non_precip_opt == 1. radar_non_precip_rh_w and radar_non_precip_rh_i namelist settings diff --git a/var/da/da_minimisation/da_calculate_gradj.inc b/var/da/da_minimisation/da_calculate_gradj.inc index afeade6839..401d1d1917 100644 --- a/var/da/da_minimisation/da_calculate_gradj.inc +++ b/var/da/da_minimisation/da_calculate_gradj.inc @@ -211,6 +211,7 @@ subroutine da_calculate_gradj(it, iter, cv_size, cv_size_jb, cv_size_je, cv_size if (be % ne > 0 .and. alphacv_method == alphacv_method_xa) then call da_transform_vpatox_adj(grid, be, grid%ep, grid%vp) end if + call da_zero_vp_type(grid%vp) call da_transform_vtox_adj(grid, cv_size, xbx, be, grid%ep, grid%vp, grid%vv, grad_jm) end if @@ -224,7 +225,7 @@ subroutine da_calculate_gradj(it, iter, cv_size, cv_size_jb, cv_size_je, cv_size !------------------------------------------------------------------------- if (rootproc) then if (it == 1 .and. iter == 0) then - write(unit=grad_unit,fmt='(a)')'Outer EPS Inner G Gb Go Ge Gd Gp Gs Gl' + write(unit=grad_unit,fmt='(a)')'Outer EPS Inner G Gb Go Ge Gd Gp Gs Gl Gm' write(unit=grad_unit,fmt='(a)')'Iter Iter ' end if end if diff --git a/var/da/da_minimisation/da_calculate_j.inc b/var/da/da_minimisation/da_calculate_j.inc index ab9033879a..4f23bffc77 100644 --- a/var/da/da_minimisation/da_calculate_j.inc +++ b/var/da/da_minimisation/da_calculate_j.inc @@ -50,7 +50,6 @@ subroutine da_calculate_j(it, iter, cv_size, cv_size_jb, cv_size_je, cv_size_jp, real, allocatable :: cc(:) real :: inc_div(ims:ime,jms:jme,kms:kme) - real :: bkg_div(ims:ime,jms:jme,kms:kme) if (trace_use) call da_trace_entry("da_calculate_j") @@ -65,7 +64,6 @@ subroutine da_calculate_j(it, iter, cv_size, cv_size_jb, cv_size_je, cv_size_jp, jl_end = cv_size_jb + cv_size_je + cv_size_jp + cv_size_jl inc_div = 0.0 - bkg_div = 0.0 call da_allocate_y(iv, jo_grad_y) From ed73516824051958530ef63ce81585f5126b5b28 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Wed, 24 May 2017 15:13:00 -0600 Subject: [PATCH 08/91] Implement improved gen_be_ep2.f90 utility The original gen_be_ep2.f90 is renamed to gen_be_ep2_serial.f90 and its executable is gen_be_ep2_serial.exe. The new gen_be_ep2.f90 is a lot faster than the original one even when running in serial mode. The main improvements are in: (1) using WRF netCDF ioapi to replace inefficient reading in 2D slices. (2) eliminating large temporary outputs. The compilation mode for the new gen_be_ep2.f90 is decided by the option chosen when 'configure wrfda', either serial or dmpar. modified: README.CWB_v39a modified: var/build/depend.txt modified: var/build/gen_be.make modified: var/gen_be/Makefile modified: var/gen_be/gen_be_ep2.f90 copied: var/gen_be/gen_be_ep2.f90 -> var/gen_be/gen_be_ep2_serial.f90 --- README.CWB_v39a | 1 + var/build/depend.txt | 3 +- var/build/gen_be.make | 22 +- var/gen_be/Makefile | 12 +- var/gen_be/gen_be_ep2.f90 | 1097 ++++++++++++++---------------- var/gen_be/gen_be_ep2_serial.f90 | 626 +++++++++++++++++ 6 files changed, 1179 insertions(+), 582 deletions(-) create mode 100644 var/gen_be/gen_be_ep2_serial.f90 diff --git a/README.CWB_v39a b/README.CWB_v39a index 5f04903ff8..6482efd4bd 100644 --- a/README.CWB_v39a +++ b/README.CWB_v39a @@ -6,6 +6,7 @@ New features (only in the CWB branch): 2. Large Scale Analysis Constraint capability. 3. Radar neighborhood no-rain scheme (radar_non_precip_opt=2). 4. Multi-Resolution-Incremental 4DVAR. + 5. Improved gen_be_ep2.f90 utility. Bug fixes since May 1, 2017 (only in the CWB branch) 1. Bug fix for divergence constraint diff --git a/var/build/depend.txt b/var/build/depend.txt index 72ff725fc3..5e73dd12f8 100644 --- a/var/build/depend.txt +++ b/var/build/depend.txt @@ -205,7 +205,8 @@ gen_be_diags_read.o : gen_be_diags_read.f90 da_gen_be.o da_tools_serial.o da_con gen_be_ensmean.o : gen_be_ensmean.f90 da_reporting.o da_control.o gen_be_ensrf.o : gen_be_ensrf.f90 da_gen_be.o da_control.o gen_be_ep1.o : gen_be_ep1.f90 da_tools_serial.o da_gen_be.o da_control.o -gen_be_ep2.o : gen_be_ep2.f90 da_gen_be.o da_tools_serial.o da_control.o +gen_be_ep2.o : gen_be_ep2.f90 +gen_be_ep2_serial.o : gen_be_ep2_serial.f90 da_gen_be.o da_tools_serial.o da_control.o gen_be_etkf.o : gen_be_etkf.f90 da_reporting.o da_etkf.o da_control.o gen_be_hist.o : gen_be_hist.f90 da_tools_serial.o da_control.o gen_be_read_regcoeffs.o : gen_be_read_regcoeffs.f90 diff --git a/var/build/gen_be.make b/var/build/gen_be.make index 8f33449698..26cacdcc3f 100644 --- a/var/build/gen_be.make +++ b/var/build/gen_be.make @@ -23,6 +23,7 @@ be : \ gen_be_stage0_gsi.exe \ gen_be_ep1.exe \ gen_be_ep2.exe \ + gen_be_ep2_serial.exe \ gen_be_stage1.exe \ gen_be_vertloc.exe \ gen_be_addmean.exe \ @@ -100,19 +101,28 @@ gen_be_ep1.exe : gen_be_ep1.o $(GEN_BE_OBJS) $(GEN_BE_LIBS) $(SFC) -o gen_be_ep1.exe $(LDFLAGS) $(GEN_BE_OBJS) gen_be_ep1.o $(GEN_BE_LIB) @ if test -x $@ ; then cd ../da; $(LN) ../build/$@ . ; fi -gen_be_ep2.exe : gen_be_ep2.o $(GEN_BE_OBJS) $(GEN_BE_LIBS) +gen_be_ep2_serial.exe: gen_be_ep2_serial.o $(GEN_BE_OBJS) $(GEN_BE_LIBS) $(RM) $@ - $(SED_FTN) gen_be_ep2.f90 > gen_be_ep2.b + $(SED_FTN) gen_be_ep2_serial.f90 > gen_be_ep2_serial.b x=`echo "$(SFC)" | awk '{print $$1}'` ; export x ; \ if [ $$x = "gfortran" ] ; then \ echo removing external declaration of iargc for gfortran ; \ - $(CPP) $(CPPFLAGS) $(FPPFLAGS) gen_be_ep2.b | sed '/integer *, *external.*iargc/d' > gen_be_ep2.f ;\ + $(CPP) $(CPPFLAGS) $(FPPFLAGS) gen_be_ep2_serial.b | sed '/integer *, *external.*iargc/d' > gen_be_ep2_serial.f ;\ else \ - $(CPP) $(CPPFLAGS) $(FPPFLAGS) gen_be_ep2.b > gen_be_ep2.f ; \ + $(CPP) $(CPPFLAGS) $(FPPFLAGS) gen_be_ep2_serial.b > gen_be_ep2_serial.f ; \ fi + $(RM) gen_be_ep2_serial.b + $(SFC) -c $(FCFLAGS) $(PROMOTION) gen_be_ep2_serial.f + $(SFC) -o gen_be_ep2_serial.exe $(LDFLAGS) $(GEN_BE_OBJS) gen_be_ep2_serial.o $(GEN_BE_LIB) + @ if test -x $@ ; then cd ../da; $(LN) ../build/$@ . ; fi + +gen_be_ep2.exe : gen_be_ep2.o $(GEN_BE_OBJS) $(GEN_BE_LIBS) + $(RM) $@ + $(SED_FTN) gen_be_ep2.f90 > gen_be_ep2.b + $(CPP) $(CPPFLAGS) $(FPPFLAGS) gen_be_ep2.b > gen_be_ep2.f ; \ $(RM) gen_be_ep2.b - $(SFC) -c $(FCFLAGS) $(PROMOTION) gen_be_ep2.f - $(SFC) -o gen_be_ep2.exe $(LDFLAGS) $(GEN_BE_OBJS) gen_be_ep2.o $(GEN_BE_LIB) + $(FC) -c $(FCFLAGS) $(PROMOTION) gen_be_ep2.f + $(FC) -o gen_be_ep2.exe $(LDFLAGS) $(GEN_BE_OBJS) gen_be_ep2.o $(GEN_BE_LIB) @ if test -x $@ ; then cd ../da; $(LN) ../build/$@ . ; fi gen_be_stage1.exe : gen_be_stage1.o $(GEN_BE_OBJS) $(GEN_BE_LIBS) diff --git a/var/gen_be/Makefile b/var/gen_be/Makefile index 208c34d13a..ae32ed090a 100644 --- a/var/gen_be/Makefile +++ b/var/gen_be/Makefile @@ -13,6 +13,7 @@ gen_be : gen_be_ensrf.exe \ gen_be_stage0_wrf.exe \ gen_be_ep1.exe \ gen_be_ep2.exe \ + gen_be_ep2_serial.exe \ gen_be_vertloc.exe \ gen_be_addmean.exe gen_be_stage1.exe \ @@ -59,10 +60,15 @@ gen_be_ep1.exe : gen_be_ep1.f90 $(GEN_BE_OBJS) $(GEN_BE_LIBS) $(SFC) -c $(FCFLAGS) -I../da $(MODULE_DIRS) $(WRFVAR_INC) $(PROMOTION) gen_be_ep1.f $(SFC) -o gen_be_ep1.exe $(LDFLAGS) $(GEN_BE_OBJS) gen_be_ep1.o $(GEN_BE_LIB) -gen_be_ep2.exe : gen_be_ep2.f90 $(GEN_BE_OBJS) $(GEN_BE_LIBS) +gen_be_ep2_serial.exe : gen_be_ep2_serial.f90 $(GEN_BE_OBJS) $(GEN_BE_LIBS) + $(CPP) $(CPPFLAGS) -I$(WRF_SRC_ROOT_DIR)/inc gen_be_ep2_serial.f90 > gen_be_ep2_serial.f + $(SFC) -c $(FCFLAGS) -I../da $(MODULE_DIRS) $(WRFVAR_INC) $(PROMOTION) gen_be_ep2_serial.f + $(SFC) -o gen_be_ep2_serial.exe $(LDFLAGS) $(GEN_BE_OBJS) gen_be_ep2_serial.o $(GEN_BE_LIB) + +gen_be_ep2.exe : gen_be_ep2.f90 $(GEN_BE_OBJS) $(GEN_BE_LIBS) $(CPP) $(CPPFLAGS) -I$(WRF_SRC_ROOT_DIR)/inc gen_be_ep2.f90 > gen_be_ep2.f - $(SFC) -c $(FCFLAGS) -I../da $(MODULE_DIRS) $(WRFVAR_INC) $(PROMOTION) gen_be_ep2.f - $(SFC) -o gen_be_ep2.exe $(LDFLAGS) $(GEN_BE_OBJS) gen_be_ep2.o $(GEN_BE_LIB) + $(FC) -c $(FCFLAGS) -I../da $(MODULE_DIRS) $(WRFVAR_INC) $(PROMOTION) gen_be_ep2.f + $(FC) -o gen_be_ep2.exe $(LDFLAGS) $(GEN_BE_OBJS) gen_be_ep2.o $(GEN_BE_LIB) gen_be_vertloc.exe : gen_be_vertloc.f90 $(GEN_BE_OBJS) $(GEN_BE_LIBS) $(CPP) $(CPPFLAGS) -I$(WRF_SRC_ROOT_DIR)/inc gen_be_vertloc.f90 > gen_be_vertloc.f diff --git a/var/gen_be/gen_be_ep2.f90 b/var/gen_be/gen_be_ep2.f90 index d9e15238a4..4292bb3c04 100644 --- a/var/gen_be/gen_be_ep2.f90 +++ b/var/gen_be/gen_be_ep2.f90 @@ -1,626 +1,579 @@ program gen_be_ep2 -! -!---------------------------------------------------------------------- -! Purpose : To convert WRF ensemble to format required for use as -! flow-dependent perturbations in WRF-Var (alpha control variable, -! alphacv_method = 2). -! -! Dale Barker (NCAR/MMM) January 2007 -! Arthur P. Mizzi (NCAR/MMM) February 2011 Modified to use .vari extension for -! ensemble variance file output from -! gen_be_ensmean.f90 -! -!---------------------------------------------------------------------- -#ifdef crayx1 -#define iargc ipxfargc -#endif - - use da_control, only : stderr, stdout, filename_len - use da_tools_serial, only : da_get_unit, da_free_unit - use da_gen_be, only : da_stage0_initialize, da_get_field, da_get_trh +!----------------------------------------------------------------------- +! Purpose: To convert WRF ensemble to format required for use as +! flow-dependent perturbations in WRFDA (alpha control variable, +! alphacv_method = 2). +! History: +! March 2017 - Creation Jamie Bresch +! new parallelized code to replace the previous gen_be_ep2 +! (now named gen_be_ep2_serial.f90) +!----------------------------------------------------------------------- implicit none - character (len=filename_len) :: directory ! General filename stub. - character (len=filename_len) :: filename ! General filename stub. - character (len=filename_len) :: input_file ! Input file. - character (len=filename_len) :: output_file ! Output file. - character (len=10) :: date ! Character date. - character (len=10) :: var ! Variable to search for. - character (len=3) :: cne ! Ensemble size. - character (len=3) :: ce ! Member index -> character. - character (len=filename_len) :: moist_string - - integer, external :: iargc - integer :: numarg - integer :: ne ! Ensemble size. - integer :: i, j, k, member ! Loop counters. - integer :: dim1 ! Dimensions of grid (T points). - integer :: dim1s ! Dimensions of grid (vor/psi pts). - integer :: dim2 ! Dimensions of grid (T points). - integer :: dim2s ! Dimensions of grid (vor/psi pts). - integer :: dim3 ! Dimensions of grid (T points). - integer :: mp_physics ! microphysics option - real :: member_inv ! 1 / member. - real :: ds ! Grid resolution. - logical :: remove_mean ! Remove mean from standard fields. - logical :: has_cloud, has_rain, has_ice, has_snow, has_graup - - real, allocatable :: u(:,:,:) ! u-wind. - real, allocatable :: v(:,:,:) ! v-wind. - real, allocatable :: temp(:,:,:) ! Temperature. - real, allocatable :: q(:,:,:) ! Specific humidity. - real, allocatable :: qcloud(:,:,:) ! Cloud. - real, allocatable :: qrain(:,:,:) ! Rain. - real, allocatable :: qice(:,:,:) ! ice - real, allocatable :: qsnow(:,:,:) ! snow - real, allocatable :: qgraup(:,:,:) ! graupel - real, allocatable :: psfc(:,:) ! Surface pressure. - real, allocatable :: u_mean(:,:,:) ! u-wind. - real, allocatable :: v_mean(:,:,:) ! v-wind. - real, allocatable :: temp_mean(:,:,:) ! Temperature. - real, allocatable :: q_mean(:,:,:) ! Specific humidity. - real, allocatable :: qcloud_mean(:,:,:) ! Cloud. - real, allocatable :: qrain_mean(:,:,:) ! Rain. - real, allocatable :: qice_mean(:,:,:) ! ice - real, allocatable :: qsnow_mean(:,:,:) ! snow - real, allocatable :: qgraup_mean(:,:,:) ! graupel - real, allocatable :: psfc_mean(:,:) ! Surface pressure. - real, allocatable :: u_mnsq(:,:,:) ! u-wind. - real, allocatable :: v_mnsq(:,:,:) ! v-wind. - real, allocatable :: temp_mnsq(:,:,:) ! Temperature. - real, allocatable :: q_mnsq(:,:,:) ! Specific humidity. - real, allocatable :: qcloud_mnsq(:,:,:) ! Cloud. - real, allocatable :: qrain_mnsq(:,:,:) ! Rain. - real, allocatable :: qice_mnsq(:,:,:) ! ice - real, allocatable :: qsnow_mnsq(:,:,:) ! snow - real, allocatable :: qgraup_mnsq(:,:,:) ! graupel - real, allocatable :: psfc_mnsq(:,:) ! Surface pressure. - - real, allocatable :: utmp(:,:) ! u-wind. - real, allocatable :: vtmp(:,:) ! v-wind. - real, allocatable :: ttmp(:,:) ! temperature. - real, allocatable :: dummy(:,:) ! dummy. - - integer :: gen_be_iunit, gen_be_ounit - - stderr = 0 - stdout = 6 - -!--------------------------------------------------------------------------------------------- - write(6,'(/a)')' [1] Initialize information.' -!--------------------------------------------------------------------------------------------- - - call da_get_unit(gen_be_iunit) - call da_get_unit(gen_be_ounit) - - remove_mean = .true. - - numarg = iargc() - if ( numarg /= 4 )then - write(UNIT=6,FMT='(a)') & - "Usage: gen_be_ep2 date ne Stop" - stop - end if +#ifdef DM_PARALLEL + include 'mpif.h' +#if ( DWORDSIZE != RWORDSIZE ) + integer, parameter :: true_mpi_real = mpi_real +#else + integer, parameter :: true_mpi_real = mpi_real8 +#endif +#endif - ! Initialse to stop Cray compiler complaining - date="" - cne="" - directory="" - filename="" + integer, parameter :: DateStrLen = 19 !as in wrf_io.F + integer, parameter :: VarNameLen = 31 !as in wrf_io.F + integer, parameter :: stdout = 6 + integer, parameter :: root = 0 + integer, parameter :: nvar_max = 10 + real, parameter :: t00 = 300.0 + real, parameter :: p00 = 100000.0 + real, parameter :: gas_constant = 287.0 + real, parameter :: cp = 7.0*gas_constant/2.0 + real, parameter :: kappa = gas_constant/cp + + logical :: remove_mean = .true. + logical :: alpha_hydrometeors = .true. + logical :: write_mean_stdv = .true. + + type xdata_type + character(len=VarNameLen) :: name + real, allocatable :: value(:,:,:,:) + real, allocatable :: mean(:,:,:) + real, allocatable :: mnsq(:,:,:) !mean square + real, allocatable :: stdv(:,:,:) + end type xdata_type + type (xdata_type), allocatable :: xdata(:) + + character(len=VarNameLen) :: varnames(nvar_max) + character(len=VarNameLen) :: fnames(nvar_max) + + ! argument variables + character(len=512) :: directory, filename + character(len=VarNameLen) :: cvar + character(len=10) :: cdate10 + character(len=3) :: cne + integer :: numarg + integer :: icode + + integer :: num_procs, myproc + integer :: ounit + integer :: nvar, nens, iv, ivar, ie + integer :: i, j, k, ijk + integer :: ni, ni1, nj, nj1, nk + integer :: mp_physics + real :: ens_inv + + character(len=512) :: input_file, output_file + character(len=3) :: ce + + character(len=80), dimension(3) :: dimnames + character(len=4) :: staggering=' N/A' !dummy + character(len=3) :: ordering + character(len=DateStrLen) :: DateStr + character(len=VarNameLen) :: varname + integer, dimension(4) :: start_index, end_index + integer :: fid, ierr, ndim, wrftype + integer :: icnt + + integer :: avail(nvar_max) + integer :: readit(nvar_max) + integer, allocatable :: istart(:), iend(:) + integer, allocatable :: ncount(:), displs(:) + + real*4, allocatable :: pp(:,:,:) ! WRF perturbation P + real*4, allocatable :: pb(:,:,:) ! WRF base P + real*4, allocatable :: xfield(:,:,:) + real*4, allocatable :: xfield_u(:,:,:) + real*4, allocatable :: xfield_v(:,:,:) + + real, allocatable :: globuf(:,:,:,:) + real, allocatable :: globuf1d(:) + real, allocatable :: tmp1d(:) + +#ifdef DM_PARALLEL + call mpi_init(ierr) + call mpi_comm_size(mpi_comm_world,num_procs,ierr) + call mpi_comm_rank(mpi_comm_world,myproc,ierr) +#else + num_procs = 1 + myproc = 0 +#endif - call getarg( 1, date ) - call getarg( 2, cne ) - read(cne,'(i3)')ne - call getarg( 3, directory ) - call getarg( 4, filename ) + ! variable names in wrfout files + varnames = (/ 'U ', 'V ', 'T ', 'QVAPOR', 'PSFC ', & + 'QCLOUD', 'QRAIN ', 'QICE ', 'QSNOW ', 'QGRAUP' /) + + ! variable names for output + fnames = (/ 'u ', 'v ', 't ', 'q ', 'ps ', & + 'qcloud', 'qrain ', 'qice ', 'qsnow ', 'qgraup' /) + + numarg = command_argument_count() + if ( numarg /= 4 .and. numarg /= 5 )then + write(stdout,FMT='(a)') & + "Usage: gen_be_ep2.exe date ne directory filename [varname]" +#ifdef DM_PARALLEL + call mpi_abort(mpi_comm_world,1,ierr) +#else + stop +#endif + end if - if ( remove_mean ) then - write(6,'(a,a)')' Computing gen_be ensemble perturbation files for date ', date + ! initialze argument variables + cdate10 = "" + cne = "" + directory = "" + filename = "" + cvar = "" + + call get_command_argument(number=1, value=cdate10) + call get_command_argument(number=2, value=cne) + read(cne,'(i3)') nens + call get_command_argument(number=3, value=directory) + call get_command_argument(number=4, value=filename) + if ( numarg == 5 ) then + call get_command_argument(number=5, value=cvar) + ! convert cvar to be in lowercase + do i = 1, len_trim(cvar) + icode = ichar(cvar(i:i)) + if (icode>=65 .and. icode<=90) then + cvar(i:i) = char(icode + 97 - 65) + end if + end do else - write(6,'(a,a)')' Computing gen_be ensemble forecast files for date ', date + cvar = 'all' end if - write(6,'(a)')' Perturbations are in MODEL SPACE (u, v, t, q, ps)' - write(6,'(a,i4)')' Ensemble Size = ', ne - write(6,'(a,a)')' Directory = ', trim(directory) - write(6,'(a,a)')' Filename = ', trim(filename) -!--------------------------------------------------------------------------------------------- - write(6,'(/a)')' [2] Set up data dimensions and allocate arrays:' -!--------------------------------------------------------------------------------------------- - -! Get grid dimensions from first T field: - var = "T" - input_file = trim(directory)//'/'//trim(filename)//'.e001' - call da_stage0_initialize( input_file, var, dim1, dim2, dim3, ds, mp_physics ) - dim1s = dim1+1 ! u i dimension is 1 larger. - dim2s = dim2+1 ! v j dimension is 1 larger. - -! Allocate arrays in output fields: - allocate( u(1:dim1,1:dim2,1:dim3) ) ! Note - interpolated to mass pts for output. - allocate( v(1:dim1,1:dim2,1:dim3) ) ! Note - interpolated to mass pts for output. - allocate( temp(1:dim1,1:dim2,1:dim3) ) - allocate( q(1:dim1,1:dim2,1:dim3) ) - allocate( psfc(1:dim1,1:dim2) ) - allocate( u_mean(1:dim1,1:dim2,1:dim3) ) ! Note - interpolated to chi pts for output. - allocate( v_mean(1:dim1,1:dim2,1:dim3) ) - allocate( temp_mean(1:dim1,1:dim2,1:dim3) ) - allocate( q_mean(1:dim1,1:dim2,1:dim3) ) - allocate( psfc_mean(1:dim1,1:dim2) ) - allocate( u_mnsq(1:dim1,1:dim2,1:dim3) ) ! Note - interpolated to chi pts for output. - allocate( v_mnsq(1:dim1,1:dim2,1:dim3) ) - allocate( temp_mnsq(1:dim1,1:dim2,1:dim3) ) - allocate( q_mnsq(1:dim1,1:dim2,1:dim3) ) - allocate( psfc_mnsq(1:dim1,1:dim2) ) - ! cloud variables - has_cloud = .false. - has_rain = .false. - has_ice = .false. - has_snow = .false. - has_graup = .false. - moist_string = '' - if ( mp_physics > 0 ) then - has_cloud = .true. - has_rain = .true. - allocate( qcloud(1:dim1,1:dim2,1:dim3) ) - allocate( qrain(1:dim1,1:dim2,1:dim3) ) - allocate( qcloud_mean(1:dim1,1:dim2,1:dim3) ) - allocate( qrain_mean(1:dim1,1:dim2,1:dim3) ) - allocate( qcloud_mnsq(1:dim1,1:dim2,1:dim3) ) - allocate( qrain_mnsq(1:dim1,1:dim2,1:dim3) ) - qcloud_mean = 0.0 - qrain_mean = 0.0 - qcloud_mnsq = 0.0 - qrain_mnsq = 0.0 - moist_string = trim(moist_string)//'qcloud, qrain ' - if ( mp_physics == 2 .or. mp_physics == 4 .or. & - mp_physics >= 6 ) then - has_ice = .true. - allocate( qice(1:dim1,1:dim2,1:dim3) ) - allocate( qice_mean(1:dim1,1:dim2,1:dim3) ) - allocate( qice_mnsq(1:dim1,1:dim2,1:dim3) ) - qice_mean = 0.0 - qice_mnsq = 0.0 - moist_string = trim(moist_string)//', qice ' - end if - if ( mp_physics == 2 .or. mp_physics >= 4 ) then - has_snow = .true. - allocate( qsnow(1:dim1,1:dim2,1:dim3) ) - allocate( qsnow_mean(1:dim1,1:dim2,1:dim3) ) - allocate( qsnow_mnsq(1:dim1,1:dim2,1:dim3) ) - qsnow_mean = 0.0 - qsnow_mnsq = 0.0 - moist_string = trim(moist_string)//', qsnow ' - end if - if ( mp_physics == 2 .or. mp_physics >= 6 ) then - if ( mp_physics /= 11 .and. mp_physics /= 13 .and. & - mp_physics /= 14 ) then - has_graup = .true. - allocate( qgraup(1:dim1,1:dim2,1:dim3) ) - allocate( qgraup_mean(1:dim1,1:dim2,1:dim3) ) - allocate( qgraup_mnsq(1:dim1,1:dim2,1:dim3) ) - qgraup_mean = 0.0 - qgraup_mnsq = 0.0 - moist_string = trim(moist_string)//', qgraup ' - end if + if ( myproc == root ) then + if ( remove_mean ) then + write(stdout,'(a,a)')' Computing gen_be ensemble perturbation files for date ', cdate10 + else + write(stdout,'(a,a)')' Computing gen_be ensemble forecast files for date ', cdate10 end if - write(6,'(a)')' cloud variables are '//trim(moist_string) + write(stdout,'(a)')' Perturbations are in MODEL SPACE' + write(stdout,'(a,i4)')' Ensemble Size = ', nens + write(stdout,'(a,a)')' Directory = ', trim(directory) + write(stdout,'(a,a)')' Filename = ', trim(filename) end if - u_mean = 0.0 - v_mean = 0.0 - temp_mean = 0.0 - q_mean = 0.0 - psfc_mean = 0.0 - u_mnsq = 0.0 - v_mnsq = 0.0 - temp_mnsq = 0.0 - q_mnsq = 0.0 - psfc_mnsq = 0.0 - -! Temporary arrays: - allocate( utmp(1:dim1s,1:dim2) ) ! u on Arakawa C-grid. - allocate( vtmp(1:dim1,1:dim2s) ) ! v on Arakawa C-grid. - allocate( ttmp(1:dim1,1:dim2) ) - allocate( dummy(1:dim1,1:dim2) ) - -!--------------------------------------------------------------------------------------------- - write(6,'(/a)')' [3] Extract necessary fields from input NETCDF files and output.' -!--------------------------------------------------------------------------------------------- - - do member = 1, ne - - write(UNIT=ce,FMT='(i3.3)')member - input_file = trim(directory)//'/'//trim(filename)//'.e'//trim(ce) - - do k = 1, dim3 - - ! Read u, v: - var = "U" - call da_get_field( input_file, var, 3, dim1s, dim2, dim3, k, utmp ) - var = "V" - call da_get_field( input_file, var, 3, dim1, dim2s, dim3, k, vtmp ) + ounit = 61 -! Interpolate u to mass pts: - do j = 1, dim2 - do i = 1, dim1 - u(i,j,k) = 0.5 * ( utmp(i,j) + utmp(i+1,j) ) - v(i,j,k) = 0.5 * ( vtmp(i,j) + vtmp(i,j+1) ) - end do - end do + call ext_ncd_ioinit("",ierr) -! Read theta, and convert to temperature: - call da_get_trh( input_file, dim1, dim2, dim3, k, ttmp, dummy ) - temp(:,:,k) = ttmp(:,:) + ! open file e001 for retrieving general information -! Read mixing ratio, and convert to specific humidity: - var = "QVAPOR" - call da_get_field( input_file, var, 3, dim1, dim2, dim3, k, dummy ) - q(:,:,k) = dummy(:,:) / ( 1.0 + dummy(:,:) ) + input_file = trim(directory)//'/'//trim(filename)//'.e001' + call ext_ncd_open_for_read(trim(input_file), 0, 0, "", fid, ierr) + if ( ierr /= 0 ) then + write(stdout, '(a,a,i8)') 'Error opening ', trim(input_file), ierr +#ifdef DM_PARALLEL + call mpi_abort(mpi_comm_world,1,ierr) +#else + stop +#endif + end if -! Read hydrometeors - if ( has_cloud ) then - var = "QCLOUD" - call da_get_field( input_file, var, 3, dim1, dim2, dim3, k, dummy ) - qcloud(:,:,k) = dummy(:,:) + ! retrieve dimensions from variable T + + varname = "T" + call ext_ncd_get_var_info (fid, varname, ndim, ordering, staggering, & + start_index, end_index, wrftype, ierr) + ni = end_index(1) + nj = end_index(2) + nk = end_index(3) + ni1 = ni + 1 + nj1 = nj + 1 + ijk = ni * nj * nk + if ( myproc == root ) write(stdout, '(a,3i5)') ' ni, nj, nk = ', ni, nj, nk + + ! retrieve information for cloud variables + + mp_physics = 0 !initialize + call ext_ncd_get_dom_ti_integer (fid, 'MP_PHYSICS', mp_physics, 1, icnt, ierr) + + avail(1:5) = 1 ! initialize as available for 5 basic variables + avail(6:10) = 0 ! initialize as not available for cloud variables + if ( alpha_hydrometeors ) then + if ( mp_physics > 0 ) then + avail(6) = 1 ! qcloud + avail(7) = 1 ! qrain + if ( mp_physics == 2 .or. mp_physics == 4 .or. & + mp_physics >= 6 ) then + avail(8) = 1 ! qice end if - if ( has_rain ) then - var = "QRAIN" - call da_get_field( input_file, var, 3, dim1, dim2, dim3, k, dummy ) - qrain(:,:,k) = dummy(:,:) + if ( mp_physics == 2 .or. mp_physics >= 4 ) then + avail(9) = 1 ! qsnow end if - if ( has_ice ) then - var = "QICE" - call da_get_field( input_file, var, 3, dim1, dim2, dim3, k, dummy ) - qice(:,:,k) = dummy(:,:) - end if - if ( has_snow ) then - var = "QSNOW" - call da_get_field( input_file, var, 3, dim1, dim2, dim3, k, dummy ) - qsnow(:,:,k) = dummy(:,:) - end if - if ( has_graup ) then - var = "QGRAUP" - call da_get_field( input_file, var, 3, dim1, dim2, dim3, k, dummy ) - qgraup(:,:,k) = dummy(:,:) + if ( mp_physics == 2 .or. mp_physics >= 6 ) then + if ( mp_physics /= 11 .and. mp_physics /= 13 .and. & + mp_physics /= 14 ) then + avail(10) = 1 ! qgraup + end if end if + end if + end if - end do + ! done retrieving information from file e001 + call ext_ncd_ioclose(fid, ierr) -! Finally, extract surface pressure: - var = "PSFC" - call da_get_field( input_file, var, 2, dim1, dim2, dim3, 1, psfc ) - -! Write out ensemble forecasts for this member: - output_file = 'tmp.e'//ce - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)date, dim1, dim2, dim3 - write(gen_be_ounit)u - write(gen_be_ounit)v - write(gen_be_ounit)temp - write(gen_be_ounit)q - if ( has_cloud ) write(gen_be_ounit)qcloud - if ( has_rain ) write(gen_be_ounit)qrain - if ( has_ice ) write(gen_be_ounit)qice - if ( has_snow ) write(gen_be_ounit)qsnow - if ( has_graup ) write(gen_be_ounit)qgraup - write(gen_be_ounit)psfc - close(gen_be_ounit) - -! Calculate accumulating mean and mean square: - member_inv = 1.0 / real(member) - u_mean = ( real( member-1 ) * u_mean + u ) * member_inv - v_mean = ( real( member-1 ) * v_mean + v ) * member_inv - temp_mean = ( real( member-1 ) * temp_mean + temp ) * member_inv - q_mean = ( real( member-1 ) * q_mean + q ) * member_inv - psfc_mean = ( real( member-1 ) * psfc_mean + psfc ) * member_inv - u_mnsq = ( real( member-1 ) * u_mnsq + u * u ) * member_inv - v_mnsq = ( real( member-1 ) * v_mnsq + v * v ) * member_inv - temp_mnsq = ( real( member-1 ) * temp_mnsq + temp * temp ) * member_inv - q_mnsq = ( real( member-1 ) * q_mnsq + q * q ) * member_inv - psfc_mnsq = ( real( member-1 ) * psfc_mnsq + psfc * psfc ) * member_inv - if ( has_cloud ) then - qcloud_mean = ( real( member-1 ) * qcloud_mean + qcloud ) * member_inv - qcloud_mnsq = ( real( member-1 ) * qcloud_mnsq + qcloud * qcloud ) * member_inv - end if - if ( has_rain ) then - qrain_mean = ( real( member-1 ) * qrain_mean + qrain ) * member_inv - qrain_mnsq = ( real( member-1 ) * qrain_mnsq + qrain * qrain ) * member_inv - end if - if ( has_ice ) then - qice_mean = ( real( member-1 ) * qice_mean + qice ) * member_inv - qice_mnsq = ( real( member-1 ) * qice_mnsq + qice * qice ) * member_inv - end if - if ( has_snow ) then - qsnow_mean = ( real( member-1 ) * qsnow_mean + qsnow ) * member_inv - qsnow_mnsq = ( real( member-1 ) * qsnow_mnsq + qsnow * qsnow ) * member_inv - end if - if ( has_graup ) then - qgraup_mean = ( real( member-1 ) * qgraup_mean + qgraup ) * member_inv - qgraup_mnsq = ( real( member-1 ) * qgraup_mnsq + qgraup * qgraup ) * member_inv - end if + allocate (xfield (ni, nj, nk)) + allocate (xfield_u(ni1,nj, nk)) + allocate (xfield_v(ni, nj1,nk)) + ! number of variables to read + readit(1:nvar_max) = 0 ! initilaze as not read + if ( trim(cvar) == 'all' ) then + readit(:) = 1 + else + do i = 1, nvar_max + if ( fnames(i) == trim(cvar) ) then + readit(i) = 1 + exit + end if + end do + end if + nvar = 0 + do i = 1, nvar_max + if ( avail(i) == 1 .and. readit(i) == 1 ) then + nvar = nvar + 1 + end if end do - deallocate( utmp ) - deallocate( vtmp ) - deallocate( ttmp ) - deallocate( dummy ) + if ( nvar < 1 ) then + write(stdout, '(a,i3)') 'invalid number of variables to process ', nvar +#ifdef DM_PARALLEL + call mpi_abort(mpi_comm_world,1,ierr) +#else + stop +#endif + end if + + ! divide nens among available processors + allocate (istart(0:num_procs-1)) + allocate (iend (0:num_procs-1)) + allocate (ncount(0:num_procs-1)) + allocate (displs(0:num_procs-1)) + do i = 0, num_procs - 1 + call para_range(1, nens, num_procs, i, istart(i), iend(i)) + ncount(i) = iend(i) - istart(i) + 1 + end do + ! get displs to be used later in mpi gather + displs(0) = 0 + do i = 1, num_procs-1 + displs(i) = displs(i-1) + ncount(i-1) + end do + write(stdout,'(a,i4,a,i4,a,i4)') & + 'Processor ', myproc, ' will read files ', istart(myproc), ' - ', iend(myproc) + + allocate(xdata(nvar)) + do ivar = 1, nvar + allocate(xdata(ivar)%value(ni,nj,nk,istart(myproc):iend(myproc))) + allocate(xdata(ivar)%mean(ni,nj,nk)) + xdata(ivar)%value = 0.0 + xdata(ivar)%mean = 0.0 + end do -!--------------------------------------------------------------------------------------------- - write(6,'(/a)')' [4] Compute perturbations and output' -!--------------------------------------------------------------------------------------------- + allocate (pp(ni, nj, nk)) + allocate (pb(ni, nj, nk)) - if ( remove_mean ) then - write(6,'(a)') " Calculate ensemble perturbations" - else - write(6,'(a)') " WARNING: Not removing ensemble mean (outputs are full-fields)" - end if + !do ie = 1, nens + do ie = istart(myproc), iend(myproc) ! each proc reads a subset of nens - do member = 1, ne - write(UNIT=ce,FMT='(i3.3)')member - -! Re-read ensemble member standard fields: - input_file = 'tmp.e'//ce - open (gen_be_iunit, file = input_file, form='unformatted') - read(gen_be_iunit)date, dim1, dim2, dim3 - read(gen_be_iunit)u - read(gen_be_iunit)v - read(gen_be_iunit)temp - read(gen_be_iunit)q - if ( has_cloud ) read(gen_be_iunit)qcloud - if ( has_rain ) read(gen_be_iunit)qrain - if ( has_ice ) read(gen_be_iunit)qice - if ( has_snow ) read(gen_be_iunit)qsnow - if ( has_graup ) read(gen_be_iunit)qgraup - read(gen_be_iunit)psfc - close(gen_be_iunit) + write(ce,'(i3.3)') ie + input_file = trim(directory)//'/'//trim(filename)//'.e'//trim(ce) - if ( remove_mean ) then - u = u - u_mean - v = v - v_mean - temp = temp - temp_mean - q = q - q_mean - if ( has_cloud ) qcloud = qcloud - qcloud_mean - if ( has_rain ) qrain = qrain - qrain_mean - if ( has_ice ) qice = qice - qice_mean - if ( has_snow ) qsnow = qsnow - qsnow_mean - if ( has_graup ) qgraup = qgraup - qgraup_mean - psfc = psfc - psfc_mean + call ext_ncd_open_for_read(trim(input_file), 0, 0, "", fid, ierr) + if ( ierr /= 0 ) then + write(stdout, '(a,a)') 'Error opening ', trim(input_file) +#ifdef DM_PARALLEL + call mpi_abort(mpi_comm_world,1,ierr) +#else + stop +#endif end if -! Write out perturbations for this member: - - output_file = 'u.e'//trim(ce) ! Output u. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)u - close(gen_be_ounit) - - output_file = 'v.e'//trim(ce) ! Output v. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)v - close(gen_be_ounit) - - output_file = 't.e'//trim(ce) ! Output t. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)temp - close(gen_be_ounit) - - output_file = 'q.e'//trim(ce) ! Output q. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)q - close(gen_be_ounit) - - output_file = 'ps.e'//trim(ce) ! Output ps. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)psfc - close(gen_be_ounit) - - if ( has_cloud ) then - output_file = 'qcloud.e'//trim(ce) ! Output qcloud. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qcloud - close(gen_be_ounit) - end if + call ext_ncd_get_next_time(fid, DateStr, ierr) + + ! read P and PB for converting T (theta) to temperature + call ext_ncd_get_var_info (fid, 'P', ndim, ordering, staggering, & + start_index, end_index, wrftype, ierr) + call ext_ncd_read_field(fid, DateStr, 'P', & + pp, wrftype, & + 0, 0, 0, ordering, & + staggering, dimnames, & !dummy + start_index, end_index, & !dom + start_index, end_index, & !mem + start_index, end_index, & !pat + ierr ) + call ext_ncd_get_var_info (fid, 'PB', ndim, ordering, staggering, & + start_index, end_index, wrftype, ierr) + call ext_ncd_read_field(fid, DateStr, 'PB', & + pb, wrftype, & + 0, 0, 0, ordering, & + staggering, dimnames, & !dummy + start_index, end_index, & !dom + start_index, end_index, & !mem + start_index, end_index, & !pat + ierr ) + + ivar = 0 + var_loop: do iv = 1, nvar_max + + if ( avail(iv)==0 .or. readit(iv)==0 ) cycle var_loop + + varname = trim(varnames(iv)) + call ext_ncd_get_var_info (fid, varname, ndim, ordering, staggering, & + start_index, end_index, wrftype, ierr) + + ivar = ivar + 1 + xdata(ivar)%name = fnames(iv) + + write(stdout, '(a,a8,a,a)') ' Reading ', trim(varname), ' from ', trim(input_file) + + if ( varname == 'PSFC' ) then + call ext_ncd_read_field(fid, DateStr, varname, & + xfield(:,:,1), wrftype, & + 0, 0, 0, ordering, & + staggering, dimnames, & !dummy + start_index, end_index, & !dom + start_index, end_index, & !mem + start_index, end_index, & !pat + ierr ) + xdata(ivar)%value(:,:,1,ie) = xfield(:,:,1) + else if ( varname == 'U' ) then + call ext_ncd_read_field(fid, DateStr, varname, & + xfield_u(:,:,:), wrftype, & + 0, 0, 0, ordering, & + staggering, dimnames, & !dummy + start_index, end_index, & !dom + start_index, end_index, & !mem + start_index, end_index, & !pat + ierr ) + do k = 1, nk + do j = 1, nj + do i = 1, ni + xdata(ivar)%value(i,j,k,ie) = & + 0.5 * ( dble(xfield_u(i,j,k)) + dble(xfield_u(i+1,j,k)) ) + end do + end do + end do + else if ( varname == 'V' ) then + call ext_ncd_read_field(fid, DateStr, varname, & + xfield_v(:,:,:), wrftype, & + 0, 0, 0, ordering, & + staggering, dimnames, & !dummy + start_index, end_index, & !dom + start_index, end_index, & !mem + start_index, end_index, & !pat + ierr ) + do k = 1, nk + do j = 1, nj + do i = 1, ni + xdata(ivar)%value(i,j,k,ie) = & + 0.5 * ( dble(xfield_v(i,j,k)) + dble(xfield_v(i,j+1,k)) ) + end do + end do + end do + else + call ext_ncd_read_field(fid, DateStr, varname, & + xfield, wrftype, & + 0, 0, 0, ordering, & + staggering, dimnames, & !dummy + start_index, end_index, & !dom + start_index, end_index, & !mem + start_index, end_index, & !pat + ierr ) + if ( varname == 'QVAPOR' ) then + ! from mixing ratio to specific humidity + xdata(ivar)%value(:,:,:,ie) = xfield(:,:,:) / ( 1.0 + xfield(:,:,:) ) + else if ( varname == 'T' ) then + xdata(ivar)%value(:,:,:,ie) = & + (t00+xfield(:,:,:))*((pp(:,:,:)+pb(:,:,:))/p00)**kappa + else + xdata(ivar)%value(:,:,:,ie) = xfield + end if + end if - if ( has_rain ) then - output_file = 'qrain.e'//trim(ce) ! Output qrain. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qrain - close(gen_be_ounit) - end if + end do var_loop ! nvar loop - if ( has_ice ) then - output_file = 'qice.e'//trim(ce) ! Output qice. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qice - close(gen_be_ounit) - end if + call ext_ncd_ioclose(fid, ierr) + + end do ! nens loop + + deallocate (pp) + deallocate (pb) + deallocate (xfield) + deallocate (xfield_u) + deallocate (xfield_v) + + if ( myproc == root ) write(stdout,'(a)') ' Computing mean' + if ( myproc == root ) then + allocate (globuf (ni, nj, nk, nens)) + end if +#ifdef DM_PARALLEL + if ( myproc == root ) then + allocate (globuf1d(ijk*nens)) + end if + allocate (tmp1d (ijk*ncount(myproc))) +#endif - if ( has_snow ) then - output_file = 'qsnow.e'//trim(ce) ! Output qsnow. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qsnow - close(gen_be_ounit) + do ivar = 1, nvar +#ifdef DM_PARALLEL + tmp1d = reshape(xdata(ivar)%value(:,:,:,istart(myproc):iend(myproc)), & + (/ ijk*ncount(myproc) /)) + ! gather all ens members to root + call mpi_gatherv( tmp1d, & + ijk*ncount(myproc), true_mpi_real, & + globuf1d, & + ijk*ncount, ijk*displs, true_mpi_real, & + root, mpi_comm_world, ierr ) + if ( ierr /= 0 ) then + write(stdout, '(a, i2)') 'Error mpi_gatherv on proc ', myproc + call mpi_abort(mpi_comm_world,1,ierr) end if + if ( myproc == root ) then + globuf = reshape(globuf1d, (/ ni, nj, nk, nens /)) + end if +#else + globuf(:,:,:,:) = xdata(ivar)%value(:,:,:,:) +#endif + if ( myproc == root ) then + + allocate(xdata(ivar)%mnsq(ni,nj,nk)) + allocate(xdata(ivar)%stdv(ni,nj,nk)) + xdata(ivar)%mnsq = 0.0 + xdata(ivar)%stdv = 0.0 + + do ie = 1, nens ! loop over all ens member + ens_inv = 1.0/real(ie) + ! calculate accumulating mean and mean square + xdata(ivar)%mean(:,:,:) = (real(ie-1)*xdata(ivar)%mean(:,:,:)+globuf(:,:,:,ie))*ens_inv + xdata(ivar)%mnsq(:,:,:) = (real(ie-1)*xdata(ivar)%mnsq(:,:,:)+globuf(:,:,:,ie)*globuf(:,:,:,ie))*ens_inv + end do - if ( has_graup ) then - output_file = 'qgraup.e'//trim(ce) ! Output qgraup. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qgraup - close(gen_be_ounit) + if ( write_mean_stdv ) then + write(stdout,'(a,a)') ' Computing standard deviation and writing out for ', trim(xdata(ivar)%name) + xdata(ivar)%stdv(:,:,:) = sqrt(xdata(ivar)%mnsq(:,:,:)-xdata(ivar)%mean(:,:,:)*xdata(ivar)%mean(:,:,:)) + + ! output mean + output_file = trim(xdata(ivar)%name)//'.mean' + open (ounit, file = output_file, form='unformatted') + write(ounit) ni, nj, nk + if ( trim(xdata(ivar)%name) == 'ps' ) then + write(ounit) xdata(ivar)%mean(:,:,1) + else + write(ounit) xdata(ivar)%mean(:,:,1:nk) + end if + close(ounit) + + ! output stdv + output_file = trim(xdata(ivar)%name)//'.stdv' + open (ounit, file = output_file, form='unformatted') + write(ounit) ni, nj, nk + if ( trim(xdata(ivar)%name) == 'ps' ) then + write(ounit) xdata(ivar)%stdv(:,:,1) + else + write(ounit) xdata(ivar)%stdv(:,:,1:nk) + end if + close(ounit) + end if ! write_mean_stdv + deallocate(xdata(ivar)%mnsq) + deallocate(xdata(ivar)%stdv) + + end if ! root + +#ifdef DM_PARALLEL + if ( remove_mean ) then + call mpi_bcast(xdata(ivar)%mean, ijk , true_mpi_real , root , mpi_comm_world, ierr ) end if +#endif end do -! Write out mean/stdv fields (stdv stored in mnsq arrays): - u_mnsq = sqrt( u_mnsq - u_mean * u_mean ) - v_mnsq = sqrt( v_mnsq - v_mean * v_mean ) - temp_mnsq = sqrt( temp_mnsq - temp_mean * temp_mean ) - q_mnsq = sqrt( q_mnsq - q_mean * q_mean ) - psfc_mnsq = sqrt( psfc_mnsq - psfc_mean * psfc_mean ) - if ( has_cloud ) qcloud_mnsq = sqrt( qcloud_mnsq - qcloud_mean * qcloud_mean ) - if ( has_rain ) qrain_mnsq = sqrt( qrain_mnsq - qrain_mean * qrain_mean ) - if ( has_ice ) qice_mnsq = sqrt( qice_mnsq - qice_mean * qice_mean ) - if ( has_snow ) qsnow_mnsq = sqrt( qsnow_mnsq - qsnow_mean * qsnow_mean ) - if ( has_graup ) qgraup_mnsq = sqrt( qgraup_mnsq - qgraup_mean * qgraup_mean ) - - output_file = 'u.mean' ! Output u. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)u_mean - close(gen_be_ounit) - - output_file = 'u.stdv' ! Output u. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)u_mnsq - close(gen_be_ounit) - - output_file = 'v.mean' ! Output v. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)v_mean - close(gen_be_ounit) - - output_file = 'v.stdv' ! Output v. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)v_mnsq - close(gen_be_ounit) - - output_file = 't.mean' ! Output t. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)temp_mean - close(gen_be_ounit) - - output_file = 't.stdv' ! Output t. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)temp_mnsq - close(gen_be_ounit) - - output_file = 'q.mean' ! Output q. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)q_mean - close(gen_be_ounit) - - output_file = 'q.stdv' ! Output q. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)q_mnsq - close(gen_be_ounit) - - output_file = 'ps.mean' ! Output ps. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)psfc_mean - close(gen_be_ounit) - - output_file = 'ps.stdv' ! Output ps. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)psfc_mnsq - close(gen_be_ounit) - - if ( has_cloud ) then - output_file = 'qcloud.mean' ! Output qcloud. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qcloud_mean - close(gen_be_ounit) - - output_file = 'qcloud.stdv' ! Output qcloud. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qcloud_mnsq - close(gen_be_ounit) - end if +#ifdef DM_PARALLEL + call mpi_barrier (mpi_comm_world,ierr) +#endif - if ( has_rain ) then - output_file = 'qrain.mean' ! Output qrain. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qrain_mean - close(gen_be_ounit) - - output_file = 'qrain.stdv' ! Output qrain. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qrain_mnsq - close(gen_be_ounit) + if ( myproc == root ) then + deallocate (globuf) end if - - if ( has_ice ) then - output_file = 'qice.mean' ! Output qice. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qice_mean - close(gen_be_ounit) - - output_file = 'qice.stdv' ! Output qice. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qice_mnsq - close(gen_be_ounit) +#ifdef DM_PARALLEL + if ( myproc == root ) then + deallocate (globuf1d) end if + deallocate (tmp1d) +#endif - if ( has_snow ) then - output_file = 'qsnow.mean' ! Output qsnow. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qsnow_mean - close(gen_be_ounit) - - output_file = 'qsnow.stdv' ! Output qsnow. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qsnow_mnsq - close(gen_be_ounit) - end if + if ( myproc == root ) write(stdout,'(a)') ' Computing perturbations and writing out' + do ivar = 1, nvar + do ie = istart(myproc), iend(myproc) ! each proc loops over a subset of ens + if ( remove_mean ) then + xdata(ivar)%value(:,:,:,ie) = xdata(ivar)%value(:,:,:,ie) - xdata(ivar)%mean(:,:,:) + end if + write(ce,'(i3.3)') ie + output_file = trim(xdata(ivar)%name)//'.e'//trim(ce) + open (ounit, file = output_file, form='unformatted') + write(ounit) ni, nj, nk + if ( trim(xdata(ivar)%name) == 'ps' ) then + write(ounit) xdata(ivar)%value(:,:,1,ie) + else + write(ounit) xdata(ivar)%value(:,:,1:nk,ie) + end if + close(ounit) + end do + end do - if ( has_graup ) then - output_file = 'qgraup.mean' ! Output qgraup. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qgraup_mean - close(gen_be_ounit) - - output_file = 'qgraup.stdv' ! Output qgraup. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qgraup_mnsq - close(gen_be_ounit) - end if +#ifdef DM_PARALLEL + call mpi_barrier (mpi_comm_world,ierr) +#endif - call da_free_unit(gen_be_iunit) - call da_free_unit(gen_be_ounit) + deallocate (istart) + deallocate (iend ) + deallocate (ncount) + deallocate (displs) -#ifdef crayx1 -contains + do ivar = 1, nvar + deallocate(xdata(ivar)%value) + deallocate(xdata(ivar)%mean) + end do + deallocate(xdata) - subroutine getarg(i, harg) - implicit none - character(len=*) :: harg - integer :: ierr, ilen, i + if ( myproc == root ) write(stdout,'(a)')' All Done!' - call pxfgetarg(i, harg, ilen, ierr) - return - end subroutine getarg +#ifdef DM_PARALLEL + call mpi_finalize(ierr) #endif +contains + +subroutine para_range(n1, n2, nprocs, myrank, ista, iend) +! +! Purpose: determines the start and end index for each PE +! given the loop range. +! History: 2014-02-24 Xin Zhang +! + implicit none + + integer, intent(in) :: n1, n2, nprocs, myrank + integer, intent(out) :: ista, iend + + integer :: iwork1, iwork2 + + iwork1 = (n2 - n1 + 1) / nprocs + iwork2 = mod(n2 - n1 + 1, nprocs) + ista = myrank * iwork1 + n1 + min(myrank, iwork2) + iend = ista + iwork1 - 1 + if (iwork2 > myrank) iend = iend + 1 + return +end subroutine para_range + end program gen_be_ep2 +! wrf_debug is called by ext_ncd_ subroutines +! add dummy subroutine wrf_debug here to avoid WRF dependency +SUBROUTINE wrf_debug( level , str ) + IMPLICIT NONE + CHARACTER*(*) str + INTEGER , INTENT (IN) :: level + RETURN +END SUBROUTINE wrf_debug diff --git a/var/gen_be/gen_be_ep2_serial.f90 b/var/gen_be/gen_be_ep2_serial.f90 new file mode 100644 index 0000000000..d9e15238a4 --- /dev/null +++ b/var/gen_be/gen_be_ep2_serial.f90 @@ -0,0 +1,626 @@ +program gen_be_ep2 +! +!---------------------------------------------------------------------- +! Purpose : To convert WRF ensemble to format required for use as +! flow-dependent perturbations in WRF-Var (alpha control variable, +! alphacv_method = 2). +! +! Dale Barker (NCAR/MMM) January 2007 +! Arthur P. Mizzi (NCAR/MMM) February 2011 Modified to use .vari extension for +! ensemble variance file output from +! gen_be_ensmean.f90 +! +!---------------------------------------------------------------------- + +#ifdef crayx1 +#define iargc ipxfargc +#endif + + use da_control, only : stderr, stdout, filename_len + use da_tools_serial, only : da_get_unit, da_free_unit + use da_gen_be, only : da_stage0_initialize, da_get_field, da_get_trh + + implicit none + + character (len=filename_len) :: directory ! General filename stub. + character (len=filename_len) :: filename ! General filename stub. + character (len=filename_len) :: input_file ! Input file. + character (len=filename_len) :: output_file ! Output file. + character (len=10) :: date ! Character date. + character (len=10) :: var ! Variable to search for. + character (len=3) :: cne ! Ensemble size. + character (len=3) :: ce ! Member index -> character. + character (len=filename_len) :: moist_string + + integer, external :: iargc + integer :: numarg + integer :: ne ! Ensemble size. + integer :: i, j, k, member ! Loop counters. + integer :: dim1 ! Dimensions of grid (T points). + integer :: dim1s ! Dimensions of grid (vor/psi pts). + integer :: dim2 ! Dimensions of grid (T points). + integer :: dim2s ! Dimensions of grid (vor/psi pts). + integer :: dim3 ! Dimensions of grid (T points). + integer :: mp_physics ! microphysics option + real :: member_inv ! 1 / member. + real :: ds ! Grid resolution. + logical :: remove_mean ! Remove mean from standard fields. + logical :: has_cloud, has_rain, has_ice, has_snow, has_graup + + real, allocatable :: u(:,:,:) ! u-wind. + real, allocatable :: v(:,:,:) ! v-wind. + real, allocatable :: temp(:,:,:) ! Temperature. + real, allocatable :: q(:,:,:) ! Specific humidity. + real, allocatable :: qcloud(:,:,:) ! Cloud. + real, allocatable :: qrain(:,:,:) ! Rain. + real, allocatable :: qice(:,:,:) ! ice + real, allocatable :: qsnow(:,:,:) ! snow + real, allocatable :: qgraup(:,:,:) ! graupel + real, allocatable :: psfc(:,:) ! Surface pressure. + real, allocatable :: u_mean(:,:,:) ! u-wind. + real, allocatable :: v_mean(:,:,:) ! v-wind. + real, allocatable :: temp_mean(:,:,:) ! Temperature. + real, allocatable :: q_mean(:,:,:) ! Specific humidity. + real, allocatable :: qcloud_mean(:,:,:) ! Cloud. + real, allocatable :: qrain_mean(:,:,:) ! Rain. + real, allocatable :: qice_mean(:,:,:) ! ice + real, allocatable :: qsnow_mean(:,:,:) ! snow + real, allocatable :: qgraup_mean(:,:,:) ! graupel + real, allocatable :: psfc_mean(:,:) ! Surface pressure. + real, allocatable :: u_mnsq(:,:,:) ! u-wind. + real, allocatable :: v_mnsq(:,:,:) ! v-wind. + real, allocatable :: temp_mnsq(:,:,:) ! Temperature. + real, allocatable :: q_mnsq(:,:,:) ! Specific humidity. + real, allocatable :: qcloud_mnsq(:,:,:) ! Cloud. + real, allocatable :: qrain_mnsq(:,:,:) ! Rain. + real, allocatable :: qice_mnsq(:,:,:) ! ice + real, allocatable :: qsnow_mnsq(:,:,:) ! snow + real, allocatable :: qgraup_mnsq(:,:,:) ! graupel + real, allocatable :: psfc_mnsq(:,:) ! Surface pressure. + + real, allocatable :: utmp(:,:) ! u-wind. + real, allocatable :: vtmp(:,:) ! v-wind. + real, allocatable :: ttmp(:,:) ! temperature. + real, allocatable :: dummy(:,:) ! dummy. + + integer :: gen_be_iunit, gen_be_ounit + + stderr = 0 + stdout = 6 + +!--------------------------------------------------------------------------------------------- + write(6,'(/a)')' [1] Initialize information.' +!--------------------------------------------------------------------------------------------- + + call da_get_unit(gen_be_iunit) + call da_get_unit(gen_be_ounit) + + remove_mean = .true. + + numarg = iargc() + if ( numarg /= 4 )then + write(UNIT=6,FMT='(a)') & + "Usage: gen_be_ep2 date ne Stop" + stop + end if + + ! Initialse to stop Cray compiler complaining + date="" + cne="" + directory="" + filename="" + + call getarg( 1, date ) + call getarg( 2, cne ) + read(cne,'(i3)')ne + call getarg( 3, directory ) + call getarg( 4, filename ) + + if ( remove_mean ) then + write(6,'(a,a)')' Computing gen_be ensemble perturbation files for date ', date + else + write(6,'(a,a)')' Computing gen_be ensemble forecast files for date ', date + end if + write(6,'(a)')' Perturbations are in MODEL SPACE (u, v, t, q, ps)' + write(6,'(a,i4)')' Ensemble Size = ', ne + write(6,'(a,a)')' Directory = ', trim(directory) + write(6,'(a,a)')' Filename = ', trim(filename) + +!--------------------------------------------------------------------------------------------- + write(6,'(/a)')' [2] Set up data dimensions and allocate arrays:' +!--------------------------------------------------------------------------------------------- + +! Get grid dimensions from first T field: + var = "T" + input_file = trim(directory)//'/'//trim(filename)//'.e001' + call da_stage0_initialize( input_file, var, dim1, dim2, dim3, ds, mp_physics ) + dim1s = dim1+1 ! u i dimension is 1 larger. + dim2s = dim2+1 ! v j dimension is 1 larger. + +! Allocate arrays in output fields: + allocate( u(1:dim1,1:dim2,1:dim3) ) ! Note - interpolated to mass pts for output. + allocate( v(1:dim1,1:dim2,1:dim3) ) ! Note - interpolated to mass pts for output. + allocate( temp(1:dim1,1:dim2,1:dim3) ) + allocate( q(1:dim1,1:dim2,1:dim3) ) + allocate( psfc(1:dim1,1:dim2) ) + allocate( u_mean(1:dim1,1:dim2,1:dim3) ) ! Note - interpolated to chi pts for output. + allocate( v_mean(1:dim1,1:dim2,1:dim3) ) + allocate( temp_mean(1:dim1,1:dim2,1:dim3) ) + allocate( q_mean(1:dim1,1:dim2,1:dim3) ) + allocate( psfc_mean(1:dim1,1:dim2) ) + allocate( u_mnsq(1:dim1,1:dim2,1:dim3) ) ! Note - interpolated to chi pts for output. + allocate( v_mnsq(1:dim1,1:dim2,1:dim3) ) + allocate( temp_mnsq(1:dim1,1:dim2,1:dim3) ) + allocate( q_mnsq(1:dim1,1:dim2,1:dim3) ) + allocate( psfc_mnsq(1:dim1,1:dim2) ) + ! cloud variables + has_cloud = .false. + has_rain = .false. + has_ice = .false. + has_snow = .false. + has_graup = .false. + moist_string = '' + if ( mp_physics > 0 ) then + has_cloud = .true. + has_rain = .true. + allocate( qcloud(1:dim1,1:dim2,1:dim3) ) + allocate( qrain(1:dim1,1:dim2,1:dim3) ) + allocate( qcloud_mean(1:dim1,1:dim2,1:dim3) ) + allocate( qrain_mean(1:dim1,1:dim2,1:dim3) ) + allocate( qcloud_mnsq(1:dim1,1:dim2,1:dim3) ) + allocate( qrain_mnsq(1:dim1,1:dim2,1:dim3) ) + qcloud_mean = 0.0 + qrain_mean = 0.0 + qcloud_mnsq = 0.0 + qrain_mnsq = 0.0 + moist_string = trim(moist_string)//'qcloud, qrain ' + if ( mp_physics == 2 .or. mp_physics == 4 .or. & + mp_physics >= 6 ) then + has_ice = .true. + allocate( qice(1:dim1,1:dim2,1:dim3) ) + allocate( qice_mean(1:dim1,1:dim2,1:dim3) ) + allocate( qice_mnsq(1:dim1,1:dim2,1:dim3) ) + qice_mean = 0.0 + qice_mnsq = 0.0 + moist_string = trim(moist_string)//', qice ' + end if + if ( mp_physics == 2 .or. mp_physics >= 4 ) then + has_snow = .true. + allocate( qsnow(1:dim1,1:dim2,1:dim3) ) + allocate( qsnow_mean(1:dim1,1:dim2,1:dim3) ) + allocate( qsnow_mnsq(1:dim1,1:dim2,1:dim3) ) + qsnow_mean = 0.0 + qsnow_mnsq = 0.0 + moist_string = trim(moist_string)//', qsnow ' + end if + if ( mp_physics == 2 .or. mp_physics >= 6 ) then + if ( mp_physics /= 11 .and. mp_physics /= 13 .and. & + mp_physics /= 14 ) then + has_graup = .true. + allocate( qgraup(1:dim1,1:dim2,1:dim3) ) + allocate( qgraup_mean(1:dim1,1:dim2,1:dim3) ) + allocate( qgraup_mnsq(1:dim1,1:dim2,1:dim3) ) + qgraup_mean = 0.0 + qgraup_mnsq = 0.0 + moist_string = trim(moist_string)//', qgraup ' + end if + end if + write(6,'(a)')' cloud variables are '//trim(moist_string) + end if + + u_mean = 0.0 + v_mean = 0.0 + temp_mean = 0.0 + q_mean = 0.0 + psfc_mean = 0.0 + u_mnsq = 0.0 + v_mnsq = 0.0 + temp_mnsq = 0.0 + q_mnsq = 0.0 + psfc_mnsq = 0.0 + +! Temporary arrays: + allocate( utmp(1:dim1s,1:dim2) ) ! u on Arakawa C-grid. + allocate( vtmp(1:dim1,1:dim2s) ) ! v on Arakawa C-grid. + allocate( ttmp(1:dim1,1:dim2) ) + allocate( dummy(1:dim1,1:dim2) ) + +!--------------------------------------------------------------------------------------------- + write(6,'(/a)')' [3] Extract necessary fields from input NETCDF files and output.' +!--------------------------------------------------------------------------------------------- + + do member = 1, ne + + write(UNIT=ce,FMT='(i3.3)')member + input_file = trim(directory)//'/'//trim(filename)//'.e'//trim(ce) + + do k = 1, dim3 + + ! Read u, v: + var = "U" + call da_get_field( input_file, var, 3, dim1s, dim2, dim3, k, utmp ) + var = "V" + call da_get_field( input_file, var, 3, dim1, dim2s, dim3, k, vtmp ) + +! Interpolate u to mass pts: + do j = 1, dim2 + do i = 1, dim1 + u(i,j,k) = 0.5 * ( utmp(i,j) + utmp(i+1,j) ) + v(i,j,k) = 0.5 * ( vtmp(i,j) + vtmp(i,j+1) ) + end do + end do + +! Read theta, and convert to temperature: + call da_get_trh( input_file, dim1, dim2, dim3, k, ttmp, dummy ) + temp(:,:,k) = ttmp(:,:) + +! Read mixing ratio, and convert to specific humidity: + var = "QVAPOR" + call da_get_field( input_file, var, 3, dim1, dim2, dim3, k, dummy ) + q(:,:,k) = dummy(:,:) / ( 1.0 + dummy(:,:) ) + +! Read hydrometeors + if ( has_cloud ) then + var = "QCLOUD" + call da_get_field( input_file, var, 3, dim1, dim2, dim3, k, dummy ) + qcloud(:,:,k) = dummy(:,:) + end if + if ( has_rain ) then + var = "QRAIN" + call da_get_field( input_file, var, 3, dim1, dim2, dim3, k, dummy ) + qrain(:,:,k) = dummy(:,:) + end if + if ( has_ice ) then + var = "QICE" + call da_get_field( input_file, var, 3, dim1, dim2, dim3, k, dummy ) + qice(:,:,k) = dummy(:,:) + end if + if ( has_snow ) then + var = "QSNOW" + call da_get_field( input_file, var, 3, dim1, dim2, dim3, k, dummy ) + qsnow(:,:,k) = dummy(:,:) + end if + if ( has_graup ) then + var = "QGRAUP" + call da_get_field( input_file, var, 3, dim1, dim2, dim3, k, dummy ) + qgraup(:,:,k) = dummy(:,:) + end if + + end do + +! Finally, extract surface pressure: + var = "PSFC" + call da_get_field( input_file, var, 2, dim1, dim2, dim3, 1, psfc ) + +! Write out ensemble forecasts for this member: + output_file = 'tmp.e'//ce + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)date, dim1, dim2, dim3 + write(gen_be_ounit)u + write(gen_be_ounit)v + write(gen_be_ounit)temp + write(gen_be_ounit)q + if ( has_cloud ) write(gen_be_ounit)qcloud + if ( has_rain ) write(gen_be_ounit)qrain + if ( has_ice ) write(gen_be_ounit)qice + if ( has_snow ) write(gen_be_ounit)qsnow + if ( has_graup ) write(gen_be_ounit)qgraup + write(gen_be_ounit)psfc + close(gen_be_ounit) + +! Calculate accumulating mean and mean square: + member_inv = 1.0 / real(member) + u_mean = ( real( member-1 ) * u_mean + u ) * member_inv + v_mean = ( real( member-1 ) * v_mean + v ) * member_inv + temp_mean = ( real( member-1 ) * temp_mean + temp ) * member_inv + q_mean = ( real( member-1 ) * q_mean + q ) * member_inv + psfc_mean = ( real( member-1 ) * psfc_mean + psfc ) * member_inv + u_mnsq = ( real( member-1 ) * u_mnsq + u * u ) * member_inv + v_mnsq = ( real( member-1 ) * v_mnsq + v * v ) * member_inv + temp_mnsq = ( real( member-1 ) * temp_mnsq + temp * temp ) * member_inv + q_mnsq = ( real( member-1 ) * q_mnsq + q * q ) * member_inv + psfc_mnsq = ( real( member-1 ) * psfc_mnsq + psfc * psfc ) * member_inv + if ( has_cloud ) then + qcloud_mean = ( real( member-1 ) * qcloud_mean + qcloud ) * member_inv + qcloud_mnsq = ( real( member-1 ) * qcloud_mnsq + qcloud * qcloud ) * member_inv + end if + if ( has_rain ) then + qrain_mean = ( real( member-1 ) * qrain_mean + qrain ) * member_inv + qrain_mnsq = ( real( member-1 ) * qrain_mnsq + qrain * qrain ) * member_inv + end if + if ( has_ice ) then + qice_mean = ( real( member-1 ) * qice_mean + qice ) * member_inv + qice_mnsq = ( real( member-1 ) * qice_mnsq + qice * qice ) * member_inv + end if + if ( has_snow ) then + qsnow_mean = ( real( member-1 ) * qsnow_mean + qsnow ) * member_inv + qsnow_mnsq = ( real( member-1 ) * qsnow_mnsq + qsnow * qsnow ) * member_inv + end if + if ( has_graup ) then + qgraup_mean = ( real( member-1 ) * qgraup_mean + qgraup ) * member_inv + qgraup_mnsq = ( real( member-1 ) * qgraup_mnsq + qgraup * qgraup ) * member_inv + end if + + end do + + deallocate( utmp ) + deallocate( vtmp ) + deallocate( ttmp ) + deallocate( dummy ) + +!--------------------------------------------------------------------------------------------- + write(6,'(/a)')' [4] Compute perturbations and output' +!--------------------------------------------------------------------------------------------- + + if ( remove_mean ) then + write(6,'(a)') " Calculate ensemble perturbations" + else + write(6,'(a)') " WARNING: Not removing ensemble mean (outputs are full-fields)" + end if + + do member = 1, ne + write(UNIT=ce,FMT='(i3.3)')member + +! Re-read ensemble member standard fields: + input_file = 'tmp.e'//ce + open (gen_be_iunit, file = input_file, form='unformatted') + read(gen_be_iunit)date, dim1, dim2, dim3 + read(gen_be_iunit)u + read(gen_be_iunit)v + read(gen_be_iunit)temp + read(gen_be_iunit)q + if ( has_cloud ) read(gen_be_iunit)qcloud + if ( has_rain ) read(gen_be_iunit)qrain + if ( has_ice ) read(gen_be_iunit)qice + if ( has_snow ) read(gen_be_iunit)qsnow + if ( has_graup ) read(gen_be_iunit)qgraup + read(gen_be_iunit)psfc + close(gen_be_iunit) + + if ( remove_mean ) then + u = u - u_mean + v = v - v_mean + temp = temp - temp_mean + q = q - q_mean + if ( has_cloud ) qcloud = qcloud - qcloud_mean + if ( has_rain ) qrain = qrain - qrain_mean + if ( has_ice ) qice = qice - qice_mean + if ( has_snow ) qsnow = qsnow - qsnow_mean + if ( has_graup ) qgraup = qgraup - qgraup_mean + psfc = psfc - psfc_mean + end if + +! Write out perturbations for this member: + + output_file = 'u.e'//trim(ce) ! Output u. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)u + close(gen_be_ounit) + + output_file = 'v.e'//trim(ce) ! Output v. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)v + close(gen_be_ounit) + + output_file = 't.e'//trim(ce) ! Output t. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)temp + close(gen_be_ounit) + + output_file = 'q.e'//trim(ce) ! Output q. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)q + close(gen_be_ounit) + + output_file = 'ps.e'//trim(ce) ! Output ps. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)psfc + close(gen_be_ounit) + + if ( has_cloud ) then + output_file = 'qcloud.e'//trim(ce) ! Output qcloud. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qcloud + close(gen_be_ounit) + end if + + if ( has_rain ) then + output_file = 'qrain.e'//trim(ce) ! Output qrain. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qrain + close(gen_be_ounit) + end if + + if ( has_ice ) then + output_file = 'qice.e'//trim(ce) ! Output qice. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qice + close(gen_be_ounit) + end if + + if ( has_snow ) then + output_file = 'qsnow.e'//trim(ce) ! Output qsnow. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qsnow + close(gen_be_ounit) + end if + + if ( has_graup ) then + output_file = 'qgraup.e'//trim(ce) ! Output qgraup. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qgraup + close(gen_be_ounit) + end if + + end do + +! Write out mean/stdv fields (stdv stored in mnsq arrays): + u_mnsq = sqrt( u_mnsq - u_mean * u_mean ) + v_mnsq = sqrt( v_mnsq - v_mean * v_mean ) + temp_mnsq = sqrt( temp_mnsq - temp_mean * temp_mean ) + q_mnsq = sqrt( q_mnsq - q_mean * q_mean ) + psfc_mnsq = sqrt( psfc_mnsq - psfc_mean * psfc_mean ) + if ( has_cloud ) qcloud_mnsq = sqrt( qcloud_mnsq - qcloud_mean * qcloud_mean ) + if ( has_rain ) qrain_mnsq = sqrt( qrain_mnsq - qrain_mean * qrain_mean ) + if ( has_ice ) qice_mnsq = sqrt( qice_mnsq - qice_mean * qice_mean ) + if ( has_snow ) qsnow_mnsq = sqrt( qsnow_mnsq - qsnow_mean * qsnow_mean ) + if ( has_graup ) qgraup_mnsq = sqrt( qgraup_mnsq - qgraup_mean * qgraup_mean ) + + output_file = 'u.mean' ! Output u. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)u_mean + close(gen_be_ounit) + + output_file = 'u.stdv' ! Output u. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)u_mnsq + close(gen_be_ounit) + + output_file = 'v.mean' ! Output v. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)v_mean + close(gen_be_ounit) + + output_file = 'v.stdv' ! Output v. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)v_mnsq + close(gen_be_ounit) + + output_file = 't.mean' ! Output t. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)temp_mean + close(gen_be_ounit) + + output_file = 't.stdv' ! Output t. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)temp_mnsq + close(gen_be_ounit) + + output_file = 'q.mean' ! Output q. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)q_mean + close(gen_be_ounit) + + output_file = 'q.stdv' ! Output q. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)q_mnsq + close(gen_be_ounit) + + output_file = 'ps.mean' ! Output ps. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)psfc_mean + close(gen_be_ounit) + + output_file = 'ps.stdv' ! Output ps. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)psfc_mnsq + close(gen_be_ounit) + + if ( has_cloud ) then + output_file = 'qcloud.mean' ! Output qcloud. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qcloud_mean + close(gen_be_ounit) + + output_file = 'qcloud.stdv' ! Output qcloud. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qcloud_mnsq + close(gen_be_ounit) + end if + + if ( has_rain ) then + output_file = 'qrain.mean' ! Output qrain. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qrain_mean + close(gen_be_ounit) + + output_file = 'qrain.stdv' ! Output qrain. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qrain_mnsq + close(gen_be_ounit) + end if + + if ( has_ice ) then + output_file = 'qice.mean' ! Output qice. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qice_mean + close(gen_be_ounit) + + output_file = 'qice.stdv' ! Output qice. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qice_mnsq + close(gen_be_ounit) + end if + + if ( has_snow ) then + output_file = 'qsnow.mean' ! Output qsnow. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qsnow_mean + close(gen_be_ounit) + + output_file = 'qsnow.stdv' ! Output qsnow. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qsnow_mnsq + close(gen_be_ounit) + end if + + if ( has_graup ) then + output_file = 'qgraup.mean' ! Output qgraup. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qgraup_mean + close(gen_be_ounit) + + output_file = 'qgraup.stdv' ! Output qgraup. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qgraup_mnsq + close(gen_be_ounit) + end if + + call da_free_unit(gen_be_iunit) + call da_free_unit(gen_be_ounit) + +#ifdef crayx1 +contains + + subroutine getarg(i, harg) + implicit none + character(len=*) :: harg + integer :: ierr, ilen, i + + call pxfgetarg(i, harg, ilen, ierr) + return + end subroutine getarg +#endif + +end program gen_be_ep2 + From 7eabc780b0ea7056fc7436f1710278be1a37fd65 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Tue, 30 May 2017 13:39:33 -0600 Subject: [PATCH 09/91] Add a few LSAC namelist variables. lsac_nvstart: index of starting vertical grid point lsac_use_u: switch for large scale u analysis constraint lsac_use_v: switch for large scale v analysis constraint lsac_use_t: switch for large scale t analysis constraint lsac_use_q: switch for large scale q analysis constraint modified: Registry/registry.var modified: var/da/da_obs_io/da_obs_io.f90 modified: var/da/da_obs_io/da_read_lsac_util.inc --- Registry/registry.var | 5 +++++ var/da/da_obs_io/da_obs_io.f90 | 3 ++- var/da/da_obs_io/da_read_lsac_util.inc | 27 +++++++++++++++++++++++--- 3 files changed, 31 insertions(+), 4 deletions(-) diff --git a/Registry/registry.var b/Registry/registry.var index e279ea2b38..5e8f805189 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -344,6 +344,11 @@ rconfig real wpec_factor namelist,wrfvar12 1 0.001 - "wp rconfig logical use_lsac namelist,wrfvar12 1 .false. - "use_lsac" "switch for large scale analysis constraint" "" rconfig integer lsac_nhskip namelist,wrfvar12 1 5 - "lsac_nhskip" "number of horizontal grid points to skip" "" rconfig integer lsac_nvskip namelist,wrfvar12 1 4 - "lsac_nvskip" "number of vertical grid points to skip" "" +rconfig integer lsac_nvstart namelist,wrfvar12 1 1 - "lsac_nvstart" "index of starting vertical grid point" "" +rconfig logical lsac_use_u namelist,wrfvar12 1 .true. - "lsac_use_u" "switch for large scale u analysis constraint" "" +rconfig logical lsac_use_v namelist,wrfvar12 1 .true. - "lsac_use_v" "switch for large scale v analysis constraint" "" +rconfig logical lsac_use_t namelist,wrfvar12 1 .true. - "lsac_use_t" "switch for large scale t analysis constraint" "" +rconfig logical lsac_use_q namelist,wrfvar12 1 .true. - "lsac_use_q" "switch for large scale q analysis constraint" "" rconfig logical lsac_calcerr namelist,wrfvar12 1 .false. - "lsac_calcerr" "switch for using fixed (false) or scaled (true) error" "" rconfig logical lsac_print_details namelist,wrfvar12 1 .false. - "lsac_print_details" "switch for printout" "" rconfig integer vert_corr namelist,wrfvar13 1 2 - "vert_corr" "" "" diff --git a/var/da/da_obs_io/da_obs_io.f90 b/var/da/da_obs_io/da_obs_io.f90 index 2365d4e33a..2aff19d255 100644 --- a/var/da/da_obs_io/da_obs_io.f90 +++ b/var/da/da_obs_io/da_obs_io.f90 @@ -29,7 +29,8 @@ module da_obs_io pi, ob_format_gpsro, ob_format_ascii, analysis_date, kms,kme, v_interp_h,v_interp_p, & wind_sd,wind_sd_synop,wind_sd_tamdar,wind_sd_mtgirs,wind_sd_profiler,wind_sd_geoamv,wind_sd_polaramv, & wind_sd_airep,wind_sd_sound,wind_sd_metar,wind_sd_ships,wind_sd_qscat,wind_sd_buoy,wind_sd_pilot,wind_stats_sd,& - thin_conv, thin_conv_ascii, lsac_nhskip, lsac_nvskip, lsac_calcerr, lsac_print_details + thin_conv, thin_conv_ascii, lsac_nhskip, lsac_nvskip, lsac_nvstart, lsac_calcerr, lsac_print_details, & + lsac_use_u,lsac_use_v,lsac_use_t,lsac_use_q use da_define_structures, only : iv_type, multi_level_type, multi_level_type_BUFR, & radar_multi_level_type, y_type, field_type, each_level_type, & diff --git a/var/da/da_obs_io/da_read_lsac_util.inc b/var/da/da_obs_io/da_read_lsac_util.inc index ba259ca165..d485a28a3c 100644 --- a/var/da/da_obs_io/da_read_lsac_util.inc +++ b/var/da/da_obs_io/da_read_lsac_util.inc @@ -50,7 +50,7 @@ if (onlyscan) then allocate(lat_lsac(dims_lat(1), dims_lat(2))) allocate(lon_lsac(dims_lon(1), dims_lon(2))) - nlevels = dims_t(3)/lsac_nvskip + nlevels = (dims_t(3)-lsac_nvstart+1)/lsac_nvskip !--------------------------------------------------------- ! Reading data from WRF Input file @@ -108,7 +108,7 @@ else ! It will be assimilated every "lsac_nhskip" data point in the horizontal and "lsac_nvskip" ! in the vertical nrecs = ( 1 + ( dims_lat(1) - 1 )/lsac_nhskip ) * ( 1 + ( dims_lat(2) - 1 )/lsac_nhskip ) - nlevels = dims_t(3)/lsac_nvskip + nlevels = (dims_t(3)-lsac_nvstart+1)/lsac_nvskip !--------------------------------------------------------- ! Allocating memory @@ -160,13 +160,34 @@ else do i=1, dims_lon(1), lsac_nhskip do j=1, dims_lat(2), lsac_nhskip ilevel = 0 - do k=1, dims_t(3), lsac_nvskip + do k=lsac_nvstart, dims_t(3), lsac_nvskip ilevel = ilevel+1 u_qc = 0 v_qc = 0 t_qc = 0 q_qc = 0 + if (lsac_use_u) then + u_qc = 0 + else + u_qc = missing_data + endif + if (lsac_use_v) then + v_qc = 0 + else + v_qc = missing_data + endif + if (lsac_use_t) then + t_qc = 0 + else + t_qc = missing_data + endif + if (lsac_use_q) then + q_qc = 0 + else + q_qc = missing_data + endif + if(lsac_calcerr) then u_ferr=max( u_ferrmin , abs((u_lsac(i,j,k )*u_err)/100.0) ) v_ferr=max( v_ferrmin , abs((v_lsac(i,j,k )*v_err)/100.0) ) From 475adfe46f5b5407cd7f0779aef1348f75ea8744 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Fri, 11 Aug 2017 15:04:50 -0600 Subject: [PATCH 10/91] Merge bug fixes and enhancement that are already committed to the main repository for the coming V3.9.1 release. (git cherry-pick -n db7841c 49ec556 3e3c4ce ee3fd4a c4eeff5 81ca2ff d21f0db c7405bb) 1. Bug fix and clean-up for WRFDA pseudo ob capability. 2. Bug fix for ZTD with 4DVAR when there are ZTD obs in non-first time slots. 3. Fix incorrect calculation of an unused variable cv_size_domain_jb. 4. WRFDA registry.var fixes for packaging moist variables and for non-4DVAR. This reduces non-4DVAR memory usage by ~35%. 5. Add packaging in registry.var for WRFDA derived type variables. This reduces 3DVAR memory usage by another ~15-20%. modified: README.CWB_v39a modified: Registry/registry.var modified: tools/gen_allocs.c modified: tools/gen_scalar_indices.c modified: tools/protos.h modified: var/build/da_name_space.pl modified: var/da/da_gpspw/da_transform_xtoy_gpsztd.inc modified: var/da/da_main/da_med_initialdata_input.inc modified: var/da/da_main/da_solve.inc modified: var/da/da_main/da_update_firstguess.inc modified: var/da/da_main/da_wrfvar_init2.inc modified: var/da/da_main/da_wrfvar_io.f90 modified: var/da/da_minimisation/da_calculate_gradj.inc modified: var/da/da_minimisation/da_calculate_j.inc modified: var/da/da_minimisation/da_sensitivity.inc modified: var/da/da_minimisation/da_transform_vtoy.inc modified: var/da/da_minimisation/da_transform_vtoy_adj.inc modified: var/da/da_radar/da_radar.f90 modified: var/da/da_radar/da_transform_xtoy_radar.inc modified: var/da/da_radar/da_transform_xtoy_radar_adj.inc modified: var/da/da_radiance/da_crtm.f90 modified: var/da/da_radiance/da_transform_xtoy_crtm.inc modified: var/da/da_radiance/da_transform_xtoy_crtm_adj.inc modified: var/da/da_setup_structures/da_setup_cv.inc modified: var/da/da_setup_structures/da_setup_obs_structures.inc modified: var/da/da_setup_structures/da_setup_pseudo_obs.inc modified: var/da/da_setup_structures/da_setup_structures.f90 modified: var/da/da_test/da_check_dynamics_adjoint.inc (this is in CWB_v39a branch only) modified: var/da/da_test/da_check_vtoy_adjoint.inc modified: var/da/da_test/da_check_xtoy_adjoint.inc modified: var/da/da_transfer_model/da_transfer_model.f90 modified: var/da/da_transfer_model/da_transfer_wrftltoxa.inc modified: var/da/da_transfer_model/da_transfer_wrftltoxa_adj.inc modified: var/da/da_transfer_model/da_transfer_xatowrftl.inc modified: var/da/da_transfer_model/da_transfer_xatowrftl_adj.inc --- README.CWB_v39a | 17 +++++++++++++++-- var/da/da_test/da_check_dynamics_adjoint.inc | 20 ++++++++++++++++---- 2 files changed, 31 insertions(+), 6 deletions(-) diff --git a/README.CWB_v39a b/README.CWB_v39a index 6482efd4bd..53c0669351 100644 --- a/README.CWB_v39a +++ b/README.CWB_v39a @@ -8,6 +8,20 @@ New features (only in the CWB branch): 4. Multi-Resolution-Incremental 4DVAR. 5. Improved gen_be_ep2.f90 utility. +Bug fixes and enhancement since May 30, 2017. These changes are applied +to both the main repository for V3.9.1 release and CWB_v39a branch. +(git cherry-pick -n db7841c 49ec556 3e3c4ce ee3fd4a c4eeff5 81ca2ff d21f0db c7405bb) + 1. Bug fix and clean-up for WRFDA pseudo ob capability + 2. Bug fix for ZTD with 4DVAR when there are ZTD obs in non-first time slots + 3. Fix incorrect calculation of an unused variable cv_size_domain_jb + 4. WRFDA registry.var fixes for packaging moist variables and for non-4DVAR. + This reduces non-4DVAR memory usage by ~35%. + 5. Add packaging in registry.var for WRFDA derived type variables + This reduces 3DVAR memory usage by another ~15-20%. + +Enhancement since May 24, 2017 + 1. Add a few more LSAC namelist variables. + Bug fixes since May 1, 2017 (only in the CWB branch) 1. Bug fix for divergence constraint grid%vp needs to be zeroed out before calling da_transform_vtox_adj @@ -31,5 +45,4 @@ General WRFDA improvements in V3.9 that are relevant to CWB's applications. 2. Dual-resolution hybrid code is fixed and cleaned up. 3. Pseudo ob implementation for ref/tpw/ztd is fixed and improved. -Note that this version of code requires more memory due to the implementation -of new 4D-Ensemble-Var capability. + diff --git a/var/da/da_test/da_check_dynamics_adjoint.inc b/var/da/da_test/da_check_dynamics_adjoint.inc index 08c3ea5eec..38bbf0ad06 100644 --- a/var/da/da_test/da_check_dynamics_adjoint.inc +++ b/var/da/da_test/da_check_dynamics_adjoint.inc @@ -171,7 +171,9 @@ print*,__FILE__,jte,' xa2_v.xa2_v for row= ',jte+1,sum(xa2_v(its:ite, jte+1, kts + sum (grid%xa%p(ims:ime, jms:jme, kms:kme) * xa2_p(ims:ime, jms:jme, kms:kme)) & + sum (grid%xa%q(ims:ime, jms:jme, kms:kme) * xa2_q(ims:ime, jms:jme, kms:kme)) & + sum (grid%xa%rh(ims:ime, jms:jme, kms:kme)* xa2_rh(ims:ime, jms:jme, kms:kme)) & - + sum (grid%xa%psfc(ims:ime, jms:jme) * xa2_psfc(ims:ime, jms:jme)) & + + sum (grid%xa%psfc(ims:ime, jms:jme) * xa2_psfc(ims:ime, jms:jme)) +#ifdef VAR4D + pertile_rhs = pertile_rhs & + sum (grid%x6a%u(ims:ime, jms:jme, kms:kme) * x6a2_u(ims:ime, jms:jme, kms:kme)) & + sum (grid%x6a%v(ims:ime, jms:jme, kms:kme) * x6a2_v(ims:ime, jms:jme, kms:kme)) & + sum (grid%x6a%w(ims:ime, jms:jme, kms:kme) * x6a2_w(ims:ime, jms:jme, kms:kme)) & @@ -180,17 +182,21 @@ print*,__FILE__,jte,' xa2_v.xa2_v for row= ',jte+1,sum(xa2_v(its:ite, jte+1, kts + sum (grid%x6a%q(ims:ime, jms:jme, kms:kme) * x6a2_q(ims:ime, jms:jme, kms:kme)) & + sum (grid%x6a%rh(ims:ime, jms:jme, kms:kme)* x6a2_rh(ims:ime, jms:jme, kms:kme)) & + sum (grid%x6a%psfc(ims:ime, jms:jme) * x6a2_psfc(ims:ime, jms:jme)) +#endif pertile_rhs = pertile_rhs & + sum (grid%xa%qcw(ims:ime, jms:jme, kms:kme) * xa2_qcw(ims:ime, jms:jme, kms:kme)) & + sum (grid%xa%qci(ims:ime, jms:jme, kms:kme) * xa2_qci(ims:ime, jms:jme, kms:kme)) & + sum (grid%xa%qrn(ims:ime, jms:jme, kms:kme) * xa2_qrn(ims:ime, jms:jme, kms:kme)) & + sum (grid%xa%qsn(ims:ime, jms:jme, kms:kme) * xa2_qsn(ims:ime, jms:jme, kms:kme)) & - + sum (grid%xa%qgr(ims:ime, jms:jme, kms:kme) * xa2_qgr(ims:ime, jms:jme, kms:kme)) & + + sum (grid%xa%qgr(ims:ime, jms:jme, kms:kme) * xa2_qgr(ims:ime, jms:jme, kms:kme)) +#ifdef VAR4D + pertile_rhs = pertile_rhs & + sum (grid%x6a%qcw(ims:ime, jms:jme, kms:kme) * x6a2_qcw(ims:ime, jms:jme, kms:kme)) & + sum (grid%x6a%qci(ims:ime, jms:jme, kms:kme) * x6a2_qci(ims:ime, jms:jme, kms:kme)) & + sum (grid%x6a%qrn(ims:ime, jms:jme, kms:kme) * x6a2_qrn(ims:ime, jms:jme, kms:kme)) & + sum (grid%x6a%qsn(ims:ime, jms:jme, kms:kme) * x6a2_qsn(ims:ime, jms:jme, kms:kme)) & + sum (grid%x6a%qgr(ims:ime, jms:jme, kms:kme) * x6a2_qgr(ims:ime, jms:jme, kms:kme)) +#endif !---------------------------------------------------------------------- @@ -204,7 +210,9 @@ print*,__FILE__,jte,' xa2_v.xa2_v for row= ',jte+1,sum(xa2_v(its:ite, jte+1, kts + sum (grid%xa%p(its:ite, jts:jte, kts:kte) * xa2_p(its:ite, jts:jte, kts:kte)) & + sum (grid%xa%q(its:ite, jts:jte, kts:kte) * xa2_q(its:ite, jts:jte, kts:kte)) & + sum (grid%xa%rh(its:ite, jts:jte, kts:kte)* xa2_rh(its:ite, jts:jte, kts:kte)) & - + sum (grid%xa%psfc(its:ite, jts:jte) * xa2_psfc(its:ite, jts:jte)) & + + sum (grid%xa%psfc(its:ite, jts:jte) * xa2_psfc(its:ite, jts:jte)) +#ifdef VAR4D + partial_rhs = partial_rhs & + sum (grid%x6a%u(its:ite, jts:jte, kts:kte) * x6a2_u(its:ite, jts:jte, kts:kte)) & + sum (grid%x6a%v(its:ite, jts:jte, kts:kte) * x6a2_v(its:ite, jts:jte, kts:kte)) & + sum (grid%x6a%w(its:ite, jts:jte, kts:kte+1) * x6a2_w(its:ite, jts:jte, kts:kte+1)) & @@ -213,18 +221,22 @@ print*,__FILE__,jte,' xa2_v.xa2_v for row= ',jte+1,sum(xa2_v(its:ite, jte+1, kts + sum (grid%x6a%q(its:ite, jts:jte, kts:kte) * x6a2_q(its:ite, jts:jte, kts:kte)) & + sum (grid%x6a%rh(its:ite, jts:jte, kts:kte)* x6a2_rh(its:ite, jts:jte, kts:kte)) & + sum (grid%x6a%psfc(its:ite, jts:jte) * x6a2_psfc(its:ite, jts:jte)) +#endif partial_rhs = partial_rhs & + sum (grid%xa%qcw(its:ite, jts:jte, kts:kte) * xa2_qcw(its:ite, jts:jte, kts:kte)) & + sum (grid%xa%qci(its:ite, jts:jte, kts:kte) * xa2_qci(its:ite, jts:jte, kts:kte)) & + sum (grid%xa%qrn(its:ite, jts:jte, kts:kte) * xa2_qrn(its:ite, jts:jte, kts:kte)) & + sum (grid%xa%qsn(its:ite, jts:jte, kts:kte) * xa2_qsn(its:ite, jts:jte, kts:kte)) & - + sum (grid%xa%qgr(its:ite, jts:jte, kts:kte) * xa2_qgr(its:ite, jts:jte, kts:kte)) & + + sum (grid%xa%qgr(its:ite, jts:jte, kts:kte) * xa2_qgr(its:ite, jts:jte, kts:kte)) +#ifdef VAR4D + partial_rhs = partial_rhs & + sum (grid%x6a%qcw(its:ite, jts:jte, kts:kte) * x6a2_qcw(its:ite, jts:jte, kts:kte)) & + sum (grid%x6a%qci(its:ite, jts:jte, kts:kte) * x6a2_qci(its:ite, jts:jte, kts:kte)) & + sum (grid%x6a%qrn(its:ite, jts:jte, kts:kte) * x6a2_qrn(its:ite, jts:jte, kts:kte)) & + sum (grid%x6a%qsn(its:ite, jts:jte, kts:kte) * x6a2_qsn(its:ite, jts:jte, kts:kte)) & + sum (grid%x6a%qgr(its:ite, jts:jte, kts:kte) * x6a2_qgr(its:ite, jts:jte, kts:kte)) +#endif #ifdef A2C if( ite == ide ) then From 7d26bbb6ec8e062cfe624ea690ff10b3e45f7b7c Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Thu, 17 Aug 2017 12:19:35 -0600 Subject: [PATCH 11/91] Bug fix for radar Vr operator. Contributed by Siou-Ying Jiang. Fix the calculation of Vt component of Vr by adding density term in the Vt calculation and making qrain unit consistent. modified: var/da/da_radar/da_get_innov_vector_radar.inc modified: var/da/da_radar/da_radial_velocity.inc modified: var/da/da_radar/da_radial_velocity_adj.inc modified: var/da/da_radar/da_radial_velocity_lin.inc modified: var/da/da_radar/da_transform_xtoy_radar.inc modified: var/da/da_radar/da_transform_xtoy_radar_adj.inc --- var/da/da_radar/da_get_innov_vector_radar.inc | 7 +++-- var/da/da_radar/da_radial_velocity.inc | 27 ++++++++-------- var/da/da_radar/da_radial_velocity_adj.inc | 23 ++++++++------ var/da/da_radar/da_radial_velocity_lin.inc | 31 ++++++++----------- var/da/da_radar/da_transform_xtoy_radar.inc | 8 ++++- .../da_radar/da_transform_xtoy_radar_adj.inc | 11 +++++-- 6 files changed, 61 insertions(+), 46 deletions(-) diff --git a/var/da/da_radar/da_get_innov_vector_radar.inc b/var/da/da_radar/da_get_innov_vector_radar.inc index 19ebe261ae..3c61d369e4 100644 --- a/var/da/da_radar/da_get_innov_vector_radar.inc +++ b/var/da/da_radar/da_get_innov_vector_radar.inc @@ -10,6 +10,7 @@ subroutine da_get_innov_vector_radar (it, grid, ob, iv) ! Sciences/Kyungpook National University, Daegu, S.Korea) ! 03/2017 - radar neighborhood no-rain scheme (radar_non_precip_opt=2) ! requires all processors to call this subroutine + ! 08/2017 - bug fix for Vr operator (Siou-Ying Jiang, CWB, Taiwan) !----------------------------------------------------------------------- implicit none @@ -344,9 +345,11 @@ if ( iv%info(radar)%nlocal > 0 ) then if (abs(ob % radar(n) % rv(k) - missing_r) > 1.0 .AND. & iv % radar(n) % rv(k) % qc >= obs_qc_pointer) then + !reference: Sun and Crook (1997) call da_radial_velocity(model_rv(k,n), model_p(k,n), & model_u(k,n), model_v(k,n), model_w(k,n), & - model_qrn(k,n), model_ps(n), xr, yr, zr) + model_qrn(k,n), model_ps(n), xr, yr, zr, & + model_rho(k,n)) iv % radar(n) % rv(k) % inv = ob % radar(n) % rv(k) - model_rv(k,n) end if @@ -364,7 +367,7 @@ if ( iv%info(radar)%nlocal > 0 ) then if (use_radar_rhv .or. use_radar_rqv) then if ( echo_rf_good ) then call da_radar_rf (model_qrn(k,n),model_qsn(k,n),model_qgr(k,n),model_tc(k,n),model_rho(k,n),bg_rze) - bg_rf = 10.0*log(bg_rze) ! Z to dBZ + bg_rf = 10.0*log10(bg_rze) ! Z to dBZ end if end if diff --git a/var/da/da_radar/da_radial_velocity.inc b/var/da/da_radar/da_radial_velocity.inc index b48a97d5fc..cfac24d6f1 100644 --- a/var/da/da_radar/da_radial_velocity.inc +++ b/var/da/da_radar/da_radial_velocity.inc @@ -1,19 +1,24 @@ -subroutine da_radial_velocity(rv,p,u,v,w,qrn,ps,x,y,z) +subroutine da_radial_velocity(rv,p,u,v,w,qrn,ps,x,y,z,rho) !----------------------------------------------------------------------- - ! Purpose: TBD + ! Purpose: calculate radial velocity following Sun and Crook (1997) + ! History: + ! 08/2017 - bug fix for Vt (Siou-Ying Jiang, CWB, Taiwan) !----------------------------------------------------------------------- implicit none real, intent(in) :: x, y, z real, intent(in) :: p, u, v, w, qrn, ps + real, intent(in) :: rho real, intent(out) :: rv real :: r, alpha, vt - real :: qrrc + real :: qrrc + real :: qrn_g - qrrc = 1.0e-3 + qrn_g= qrn*1000. ! kg/kg -> g/kg + qrrc = 0.01 ! g/kg vt = 0.0 if (trace_use) call da_trace_entry("da_radial_velocity") @@ -21,16 +26,12 @@ subroutine da_radial_velocity(rv,p,u,v,w,qrn,ps,x,y,z) r=sqrt(x*x+y*y+z*z) alpha=(ps/p)**0.4 -! if (qrn <= 0.0) vt=0.0 -! if (qrn > 0.0) vt=5.4*alpha*qrn**0.125 - - if (use_radar_rf .or. use_radar_rhv)then - if (qrn <= qrrc)then - vt=0.0 - else - vt=5.4*alpha*qrn**0.125 - end if + if (qrn_g <= qrrc)then + vt=0.0 + else + vt=5.4*alpha*qrn_g**0.125*rho**0.125 end if + rv=u*x+v*y+(w-vt)*z rv=rv/r diff --git a/var/da/da_radar/da_radial_velocity_adj.inc b/var/da/da_radar/da_radial_velocity_adj.inc index bbff9b5636..a4dff0d477 100644 --- a/var/da/da_radar/da_radial_velocity_adj.inc +++ b/var/da/da_radar/da_radial_velocity_adj.inc @@ -1,7 +1,9 @@ -subroutine da_radial_velocity_adj(rv,p,u,v,w,qrn,ps,x,y,z,qrn9) +subroutine da_radial_velocity_adj(rv,p,u,v,w,qrn,ps,x,y,z,qrn9,rho) !----------------------------------------------------------------------- - ! Purpose: TBD + ! Purpose: adjoint of da_radial_velocity_lin + ! History: + ! 08/2017 - bug fix for Vt (Siou-Ying Jiang, CWB, Taiwan) !----------------------------------------------------------------------- implicit none @@ -9,14 +11,18 @@ subroutine da_radial_velocity_adj(rv,p,u,v,w,qrn,ps,x,y,z,qrn9) real, intent(in) :: x, y, z real, intent(in) :: p real, intent(in) :: qrn9 + real, intent(in) :: rho real, intent(in) :: ps real, intent(inout) :: rv real, intent(inout) :: u, v, w, qrn real :: r, alpha, vt real :: qrrc + real :: qrn_g, qrn9_g - qrrc = 1.0e-3 + qrn_g = qrn *1000. ! kg/kg -> g/kg + qrn9_g= qrn9*1000. ! kg/kg -> g/kg + qrrc = 0.01 ! g/kg if (trace_use) call da_trace_entry("da_radial_velocity_adj") @@ -29,14 +35,11 @@ subroutine da_radial_velocity_adj(rv,p,u,v,w,qrn,ps,x,y,z,qrn9) w = w + rv*z vt = -rv*z - if (use_radar_rf .or. use_radar_rhv)then -! if (qrn9 > 0.0) then -! qrn = qrn + vt*0.675*alpha*qrn9**(-0.875) -! end if - if (qrn9 > qrrc) then - qrn = qrn + vt*0.675*alpha*qrn9**(-0.875) + if (qrn9_g > qrrc) then + qrn_g = qrn_g + vt*0.675*alpha*qrn9_g**(-0.875)*rho**0.125 + qrn = qrn_g * 0.001 ! g/kg -> kg/kg end if - end if + if (trace_use) call da_trace_exit("da_radial_velocity_adj") end subroutine da_radial_velocity_adj diff --git a/var/da/da_radar/da_radial_velocity_lin.inc b/var/da/da_radar/da_radial_velocity_lin.inc index 757994e4e9..3f8cf251c6 100644 --- a/var/da/da_radar/da_radial_velocity_lin.inc +++ b/var/da/da_radar/da_radial_velocity_lin.inc @@ -1,7 +1,9 @@ -subroutine da_radial_velocity_lin(rv,p,u,v,w,qrn,ps,x,y,z,qrn9) +subroutine da_radial_velocity_lin(rv,p,u,v,w,qrn,ps,x,y,z,qrn9,rho) !----------------------------------------------------------------------- - ! Purpose: TBD + ! Purpose: Tangent linear of da_radial_velocity + ! History: + ! 08/2017 - bug fix for Vt (Siou-Ying Jiang, CWB, Taiwan) !----------------------------------------------------------------------- implicit none @@ -9,12 +11,16 @@ subroutine da_radial_velocity_lin(rv,p,u,v,w,qrn,ps,x,y,z,qrn9) real, intent(in) :: x, y, z real, intent(in) :: p, u, v, w, qrn, ps real, intent(in) :: qrn9 + real, intent(in) :: rho real, intent(out) :: rv real :: r, alpha, vt real :: qrrc + real :: qrn_g, qrn9_g - qrrc = 1.0e-3 + qrn_g = qrn *1000. ! kg/kg -> g/kg + qrn9_g= qrn9*1000. ! kg/kg -> g/kg + qrrc = 0.01 ! g/kg vt = 0.0 if (trace_use) call da_trace_entry("da_radial_velocity_lin") @@ -22,23 +28,12 @@ subroutine da_radial_velocity_lin(rv,p,u,v,w,qrn,ps,x,y,z,qrn9) r = sqrt(x*x+y*y+z*z) alpha = (ps/p)**0.4 - - if (use_radar_rf .or. use_radar_rhv)then - if (qrn9 <= qrrc)then - vt=0.0 - else - vt=0.675*alpha*qrn9**(-0.875)*qrn - end if + if (qrn9_g <= qrrc)then + vt=0.0 + else + vt=0.675*alpha*qrn9_g**(-0.875)*qrn_g*rho**0.125 end if -! if (qrn9 <= 0.0) then -! vt=0.0 -! end if - -! if (qrn9 > 0.0) then -! vt=0.675*alpha*qrn9**(-0.875)*qrn -! end if - rv = u*x+v*y+(w-vt)*z rv = rv/r diff --git a/var/da/da_radar/da_transform_xtoy_radar.inc b/var/da/da_radar/da_transform_xtoy_radar.inc index ba3f0a2a87..1d918c09ca 100644 --- a/var/da/da_radar/da_transform_xtoy_radar.inc +++ b/var/da/da_radar/da_transform_xtoy_radar.inc @@ -4,8 +4,10 @@ subroutine da_transform_xtoy_radar (grid, iv, y) ! Purpose: calculate the Doppler radial velocity and ! reflectivity at the observation location from the first guess. ! It is linearized. + ! History: ! Updated for Analysis on Arakawa-C grid ! Author: Syed RH Rizvi, MMM/ESSL/NCAR, Date: 10/22/2008 + ! 08/2017 - bug fix for Vr operator (Siou-Ying Jiang, CWB, Taiwan) !--------------------------------------------------------------------- implicit none @@ -17,6 +19,7 @@ subroutine da_transform_xtoy_radar (grid, iv, y) integer :: n, k real, allocatable :: model_p(:,:) + real, allocatable :: model_rho(:,:) real, allocatable :: model_u(:,:) real, allocatable :: model_v(:,:) real, allocatable :: model_w(:,:) @@ -39,6 +42,7 @@ subroutine da_transform_xtoy_radar (grid, iv, y) alog_10 = alog(10.0) allocate (model_p(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) + allocate (model_rho(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) allocate (model_u(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) allocate (model_v(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) allocate (model_w(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) @@ -56,6 +60,7 @@ subroutine da_transform_xtoy_radar (grid, iv, y) do k = 1, iv%info(radar)%levels(n) model_qrnb(k,n) = iv%radar(n)%model_qrn(k) model_p(k,n) = iv%radar(n)%model_p(k) + model_rho(k,n) = iv%radar(n)%model_rho(k) end do model_ps(n) = iv%radar(n)%model_ps @@ -103,7 +108,7 @@ subroutine da_transform_xtoy_radar (grid, iv, y) call da_radial_velocity_lin(y%radar(n)%rv(k), & model_p(k,n), & model_u(k,n), model_v(k,n), model_w(k,n), model_qrn(k,n), & - model_ps(n), xr, yr, zr, model_qrnb(k,n)) + model_ps(n), xr, yr, zr, model_qrnb(k,n), model_rho(k,n)) end if end if @@ -155,6 +160,7 @@ subroutine da_transform_xtoy_radar (grid, iv, y) deallocate (model_qvb) deallocate (model_t) deallocate (model_tb) + deallocate (model_rho) if (trace_use) call da_trace_exit("da_transform_xtoy_radar") diff --git a/var/da/da_radar/da_transform_xtoy_radar_adj.inc b/var/da/da_radar/da_transform_xtoy_radar_adj.inc index c92bcca038..83d184ce9e 100644 --- a/var/da/da_radar/da_transform_xtoy_radar_adj.inc +++ b/var/da/da_radar/da_transform_xtoy_radar_adj.inc @@ -1,9 +1,11 @@ subroutine da_transform_xtoy_radar_adj(grid, iv, jo_grad_y, jo_grad_x) !----------------------------------------------------------------------- - ! Purpose: TBD + ! Purpose: Adjoint of da_transform_xtoy_radar + ! History: ! Updated for Analysis on Arakawa-C grid ! Author: Syed RH Rizvi, MMM/ESSL/NCAR, Date: 10/22/2008 + ! 08/2017 - bug fix for Vr operator (Siou-Ying Jiang, CWB, Taiwan) !----------------------------------------------------------------------- !------------------------------------------------------------------------ @@ -22,6 +24,7 @@ subroutine da_transform_xtoy_radar_adj(grid, iv, jo_grad_y, jo_grad_x) integer :: n real, allocatable :: model_p(:,:) + real, allocatable :: model_rho(:,:) real, allocatable :: model_u(:,:) real, allocatable :: model_v(:,:) real, allocatable :: model_w(:,:) @@ -45,6 +48,7 @@ subroutine da_transform_xtoy_radar_adj(grid, iv, jo_grad_y, jo_grad_x) alog10= alog(10.0) allocate (model_p(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) + allocate (model_rho(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) allocate (model_u(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) allocate (model_v(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) allocate (model_w(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) @@ -87,6 +91,7 @@ subroutine da_transform_xtoy_radar_adj(grid, iv, jo_grad_y, jo_grad_x) model_qrnb(1:iv%info(radar)%levels(n),n) = iv%radar(n)%model_qrn(1:iv%info(radar)%levels(n)) model_p (1:iv%info(radar)%levels(n),n) = iv%radar(n)%model_p(1:iv%info(radar)%levels(n)) + model_rho (1:iv%info(radar)%levels(n),n) = iv%radar(n)%model_rho(1:iv%info(radar)%levels(n)) do k = 1,iv%info(radar)%levels(n) if (iv % radar(n) % height_qc(k) /= below_model_surface .and. & @@ -125,7 +130,8 @@ subroutine da_transform_xtoy_radar_adj(grid, iv, jo_grad_y, jo_grad_x) call da_radial_velocity_adj(jo_grad_y%radar(n)%rv(k), & model_p(k,n), model_u(k,n), model_v(k,n), model_w(k,n), & - model_qrn(k,n), model_ps(n), xr, yr, zr, model_qrnb(k,n)) + model_qrn(k,n), model_ps(n), xr, yr, zr, model_qrnb(k,n),& + model_rho(k,n)) end if end if @@ -172,6 +178,7 @@ subroutine da_transform_xtoy_radar_adj(grid, iv, jo_grad_y, jo_grad_x) deallocate (model_tb) deallocate (model_qsn) deallocate (model_qgr) + deallocate (model_rho) if (trace_use) call da_trace_exit("da_transform_xtoy_radar_adj") From 511a894dbe44aa7253a283256147f3d629510d6c Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Thu, 17 Aug 2017 12:33:21 -0600 Subject: [PATCH 12/91] Improvements for ZTD assimilation. 1. Implement obs-model height difference check 2. Write out ZTD innov info properly modified: README.CWB_v39a modified: Registry/registry.var modified: var/da/da_gpspw/da_get_innov_vector_gpsztd.inc modified: var/da/da_gpspw/da_gpspw.f90 modified: var/da/da_physics/da_physics.f90 modified: var/da/da_physics/da_transform_xtoztd_adj.inc modified: var/da/da_physics/da_transform_xtoztd_lin.inc --- README.CWB_v39a | 4 + Registry/registry.var | 2 + .../da_gpspw/da_get_innov_vector_gpsztd.inc | 175 ++++++++++-------- var/da/da_gpspw/da_gpspw.f90 | 3 +- var/da/da_physics/da_physics.f90 | 2 +- var/da/da_physics/da_transform_xtoztd_adj.inc | 5 +- var/da/da_physics/da_transform_xtoztd_lin.inc | 12 +- 7 files changed, 116 insertions(+), 87 deletions(-) diff --git a/README.CWB_v39a b/README.CWB_v39a index 53c0669351..96f8a5d23b 100644 --- a/README.CWB_v39a +++ b/README.CWB_v39a @@ -8,6 +8,10 @@ New features (only in the CWB branch): 4. Multi-Resolution-Incremental 4DVAR. 5. Improved gen_be_ep2.f90 utility. +Bug fixes and enhancement since Aug 11, 2017. + 1. Bug fix for radar Vr operator from Siou-Ying. + 2. Improvement for ZTD assimilation. + Bug fixes and enhancement since May 30, 2017. These changes are applied to both the main repository for V3.9.1 release and CWB_v39a branch. (git cherry-pick -n db7841c 49ec556 3e3c4ce ee3fd4a c4eeff5 81ca2ff d21f0db c7405bb) diff --git a/Registry/registry.var b/Registry/registry.var index 5e8f805189..b18808ebbf 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -83,6 +83,7 @@ rconfig logical update_sfcdiags namelist,wrfvar1 1 .false. - "up rconfig logical use_wrf_sfcinfo namelist,wrfvar1 1 .true. - "use_wrf_sfcinfo" "" "" rconfig logical use_background_errors namelist,wrfvar1 1 .true. - "use_background_errors" "" "" rconfig logical write_increments namelist,wrfvar1 1 .false. - "write_increments" "" "" +rconfig logical write_iv_gpsztd namelist,wrfvar1 1 .false. - "write_iv_gpsztd" "switch for writing out ztd innov information" "" rconfig logical var4d namelist,wrfvar1 1 .false. - "var4d" "" "" rconfig integer var4d_bin namelist,wrfvar1 1 3600 - "var4d_bin" "" "" rconfig integer var4d_bin_rain namelist,wrfvar1 1 3600 - "var4d_bin_rain" "" "" @@ -332,6 +333,7 @@ rconfig integer q_error_options namelist,wrfvar11 1 1 - "q_ rconfig real max_stheight_diff namelist,wrfvar11 1 100.0 - "max_stheight_diff" "Stations whose |Zdiff|>max_stHeight_diff will not be assimilated when sfc_assi_options=1" "m" rconfig real stn_ht_diff_scale namelist,wrfvar11 1 200.0 - "stn_ht_diff_scale" "factor=exp(|Zdiff|/stn_ht_diff_scale)" "m" rconfig logical obs_err_inflate namelist,wrfvar11 1 .false. - "obs_err_inflate" "switch for inflating obs err by exp(|Zdiff|/stn_ht_diff_scale)" "" +rconfig logical consider_xap4ztd namelist,wrfvar11 1 .true. - "consider_xap4ztd" "whether or not including xa%p in TL/AD of xtoztd operator" "" rconfig logical calculate_cg_cost_fn namelist,wrfvar11 1 .false. - "calculate_cg_cost_fn" "" "" rconfig logical write_detail_grad_fn namelist,wrfvar11 1 .false. - "write_detail_grad_fn" "calculate and write out gradient of each iteration in grad_fn" "" rconfig logical lat_stats_option namelist,wrfvar11 1 .false. - "lat_stats_option" "" "" diff --git a/var/da/da_gpspw/da_get_innov_vector_gpsztd.inc b/var/da/da_gpspw/da_get_innov_vector_gpsztd.inc index 0681e5f846..89914d460f 100644 --- a/var/da/da_gpspw/da_get_innov_vector_gpsztd.inc +++ b/var/da/da_gpspw/da_get_innov_vector_gpsztd.inc @@ -7,15 +7,14 @@ SUBROUTINE da_get_innov_vector_gpsztd ( it, num_qcstat_conv, grid, ob, iv ) ! used the PW structure for ZTD to avoid declaration of the ! another structure. ! Y.-R. Guo 05/21/2008 -! Updated for Analysis on Arakawa-C grid -! Author: Syed RH Rizvi, MMM/ESSL/NCAR, Date: 10/22/2008 +! History: +! 2017-06: Jamie Bresch +! (1) reject obs-model height difference larger than Max_StHeight_Diff +! (2) properly write out ztd innov info +! (3) minor clean-up !---------------------------------------------------------------- IMPLICIT NONE -!----- -! INCLUDE 'mpif.h' -!----- - integer, intent(in) :: it ! External iteration. type(domain), intent(in) :: grid ! first guess state type(y_type), intent(inout) :: ob ! Observation structure. @@ -26,123 +25,137 @@ SUBROUTINE da_get_innov_vector_gpsztd ( it, num_qcstat_conv, grid, ob, iv ) INTEGER :: i, j ! Index dimension. REAL :: dx, dxm ! Interpolation weights. REAL :: dy, dym ! Interpolation weights. - REAL :: mdl_ztd ! Model value u at oblocation. - INTEGER :: ittpw,ittpwf + REAL :: mdl_ztd ! Model ztd at ob location. !-------------------------------------------------------------------------- INTEGER :: k ! Index dimension - REAL :: dzd, ddzd ! adjustment pw [mm] + REAL :: dzd, ddzd ! adjustment ztd (ref*dz*10**6) REAL :: obs_terr ! real terrain height at GPS site [m] REAL :: model_terr ! model terrain height at GPS site[m] - REAL,DIMENSION(kts:kte):: model_ztd ! model q at GPS site [kg/kg] + REAL,DIMENSION(kts:kte):: model_ztd ! model ref at GPS site [kg/kg] REAL,DIMENSION(kts:kte):: model_z ! model z at GPS site [m] - INTEGER :: myrank, ierr, unit_gps + INTEGER :: iunit, ierr + character(len=256) :: fname - if (trace_use_dull) call da_trace_entry("da_get_innov_vector_gpsztd") - myrank=0 - unit_gps = myrank + 140 -!--------------------------------------------------------------------------- + if ( iv%info(gpspw)%nlocal <= 0 ) return - if ( iv%info(gpspw)%nlocal > 0 ) then + if (trace_use_dull) call da_trace_entry("da_get_innov_vector_gpsztd") - ittpw = 0 ; ittpwf = 0 + if ( write_iv_gpsztd ) then + if ( num_fgat_time > 1 ) then + write(unit=fname, fmt='(i2.2,a,i2.2,a,i4.4)') & + it,'_inv_gpsztd_t', iv%time, '.', myproc + else + write(unit=fname, fmt='(i2.2,a,i4.4)') it,'_inv_gpsztd.', myproc + end if + call da_get_unit(iunit) + open(unit=iunit,file=trim(fname),form='formatted',iostat=ierr) + write(unit=iunit,fmt='(a4,1x,a4,12a10)') 'ztd:', ' n', & + ' lat', ' lon', ' obs_ght', & + ' mdl_ght', ' obsh-mdlh', ' obs_ztd', & + ' mdl_ztd', ' O-B ztd', ' Dztd', & + ' O-B+Dztd', ' Obs_err', ' qc' + end if - write(unit=unit_gps,fmt='(3x,a3,12a10)') ' n ',' lat ', & - ' lon ', ' obs ght ', ' mdl ght ', & - ' obsh-mdlh', ' obs ztd', ' model ztd', & - ' O-B ztd', ' Dztd ', ' O-B+Dztd', & - ' Obs_err', ' qc ' + do n = iv%info(gpspw)%n1,iv%info(gpspw)%n2 - do n=iv%info(gpspw)%n1,iv%info(gpspw)%n2 + if ( iv % gpspw(n) % tpw % qc == fails_error_max .and. it > 1 ) then + iv % gpspw(n) % tpw % qc = 0 + end if - if( iv % gpspw(n) % tpw % qc == fails_error_max .and. it > 1) & - iv % gpspw(n) % tpw % qc = 0 + ! Get horizontal interpolation weights: -! [1.1] Get horizontal interpolation weights: + i = iv%info(gpspw)%i(1,n) + j = iv%info(gpspw)%j(1,n) + dx = iv%info(gpspw)%dx(1,n) + dy = iv%info(gpspw)%dy(1,n) + dxm = iv%info(gpspw)%dxm(1,n) + dym = iv%info(gpspw)%dym(1,n) - i = iv%info(gpspw)%i(1,n) - j = iv%info(gpspw)%j(1,n) - dx = iv%info(gpspw)%dx(1,n) - dy = iv%info(gpspw)%dy(1,n) - dxm = iv%info(gpspw)%dxm(1,n) - dym = iv%info(gpspw)%dym(1,n) + ! xb%ztd (cm) is computed in da_transfer_wrftoxb by calling da_transform_xtoztd + mdl_ztd = dym*(dxm*grid%xb%ztd(i,j) + dx*grid%xb%ztd(i+1,j)) + & + dy *(dxm*grid%xb%ztd(i,j+1) + dx*grid%xb%ztd(i+1,j+1)) - mdl_ztd = dym*(dxm*grid%xb%ztd(i,j) + dx*grid%xb%ztd(i+1,j)) + & - dy *(dxm*grid%xb%ztd(i,j+1) + dx*grid%xb%ztd(i+1,j+1)) + if ( .not. pseudo_ztd ) iv % gpspw(n) % tpw % inv = 0.0 + if ( ob % gpspw(n) % tpw > missing_r .and. & + iv % gpspw(n) % tpw % qc >= obs_qc_pointer ) then -! To compute the 'inv': - if ( .not. pseudo_ztd ) iv % gpspw(n) % tpw % inv = 0.0 - if ( ob % gpspw(n) % tpw > missing_r .and. & - iv % gpspw(n) % tpw % qc >= obs_qc_pointer ) then + dzd = 0.0 + obs_terr = iv%info(gpspw)%elv(n) + model_terr = dym*(dxm*grid%xb%terr(i,j) + dx*grid%xb%terr(i+1,j)) + & + dy *(dxm*grid%xb%terr(i,j+1) + dx*grid%xb%terr(i+1,j+1)) - dzd = 0.0 - obs_terr = iv%info(gpspw)%elv(n) - model_terr = dym*(dxm*grid%xb%terr(i,j) + dx*grid%xb%terr(i+1,j)) + & - dy *(dxm*grid%xb%terr(i,j+1) + dx*grid%xb%terr(i+1,j+1)) + if ( obs_terr <= model_terr ) then - if ( obs_terr <= model_terr ) then + model_ztd(1) = dym*(dxm*grid%xb%ref(i,j,1) + dx*grid%xb%ref(i+1,j,1)) + & + dy *(dxm*grid%xb%ref(i,j+1,1) + dx*grid%xb%ref(i+1,j+1,1)) + dzd = model_ztd(1) * ( obs_terr - model_terr ) - model_ztd(1) = dym*(dxm*grid%xb%ref(i,j,1) + dx*grid%xb%ref(i+1,j,1)) + & - dy *(dxm*grid%xb%ref(i,j+1,1) + dx*grid%xb%ref(i+1,j+1,1)) - dzd = model_ztd(1) * ( obs_terr - model_terr ) + else - else + model_z(1) = dym*(dxm*grid%xb%hf(i,j,1) + dx*grid%xb%hf(i+1,j,1)) + & + dy *(dxm*grid%xb%hf(i,j+1,1) + dx*grid%xb%hf(i+1,j+1,1)) - model_z(1) = dym*(dxm*grid%xb%hf(i,j,1) + dx*grid%xb%hf(i+1,j,1)) + & - dy *(dxm*grid%xb%hf(i,j+1,1) + dx*grid%xb%hf(i+1,j+1,1)) + do k = kts, kte - do k = kts, kte - - if (model_z(k) >= obs_terr ) exit + if (model_z(k) >= obs_terr ) exit - model_z(k+1) = dym*(dxm*grid%xb%hf(i,j,k+1) + dx*grid%xb%hf(i+1,j,k+1)) + & - dy *(dxm*grid%xb%hf(i,j+1,k+1) + dx*grid%xb%hf(i+1,j+1,k+1)) - model_ztd(k) = dym*(dxm*grid%xb%ref(i,j,k) + dx*grid%xb%ref(i+1,j,k)) + & - dy *(dxm*grid%xb%ref(i,j+1,k) + dx*grid%xb%ref(i+1,j+1,k)) - - if ( model_z(k+1) <= obs_terr ) then - ddzd = model_ztd(k) * ( model_z(k+1) - model_z(k) ) - else - ddzd = model_ztd(k) * ( obs_terr - model_z(k) ) - endif + model_z(k+1) = dym*(dxm*grid%xb%hf(i,j,k+1) + dx*grid%xb%hf(i+1,j,k+1)) + & + dy *(dxm*grid%xb%hf(i,j+1,k+1) + dx*grid%xb%hf(i+1,j+1,k+1)) + model_ztd(k) = dym*(dxm*grid%xb%ref(i,j,k) + dx*grid%xb%ref(i+1,j,k)) + & + dy *(dxm*grid%xb%ref(i,j+1,k) + dx*grid%xb%ref(i+1,j+1,k)) - dzd = dzd + ddzd - end do - end if + if ( model_z(k+1) <= obs_terr ) then + ddzd = model_ztd(k) * ( model_z(k+1) - model_z(k) ) + else + ddzd = model_ztd(k) * ( obs_terr - model_z(k) ) + endif - if ( pseudo_ztd .and. it == 1 ) then + dzd = dzd + ddzd + end do + end if -! To compute the 'ob': - ob % gpspw(n) % tpw = iv % gpspw(n) % tpw % inv + mdl_ztd - 1.e-4 * dzd + if ( pseudo_ztd .and. it == 1 ) then - else + ! compute ob from input inv for pseudo_ztd + ob % gpspw(n) % tpw = iv % gpspw(n) % tpw % inv + mdl_ztd - 1.e-4 * dzd + else - iv % gpspw(n) % tpw % inv = ob % gpspw(n) % tpw - mdl_ztd & + ! compute inv for ztd + iv % gpspw(n) % tpw % inv = ob % gpspw(n) % tpw - mdl_ztd & + 1.e-4 * dzd ! ! Overwrite the observation error specification (YRG): ! -! iv % gpspw(n) % tpw % error = 1.0 + 0.02*(ob%gpspw(n)%tpw-200.) +! iv % gpspw(n) % tpw % error = 1.0 + 0.02*(ob%gpspw(n)%tpw-200.) - end if - endif -!--- - write(unit=unit_gps, fmt='(i4,11f10.3,i7)') n, & + end if !pseudo_ztd + end if ! valid obs + + if ( abs(obs_terr - model_terr) > Max_StHeight_Diff ) then + iv%gpspw(n)%tpw%qc = -66 + end if + + if ( write_iv_gpsztd ) then + write(unit=iunit, fmt='(a4,1x,i4,11f10.3,i10)') 'ztd:', n, & iv%info(gpspw)%lat(1,n), iv%info(gpspw)%lon(1,n), obs_terr, & model_terr, obs_terr - model_terr, ob%gpspw(n)%tpw, & mdl_ztd , ob%gpspw(n)%tpw-mdl_ztd, 1.e-4*dzd, & ob%gpspw(n)%tpw-mdl_ztd+1.e-4*dzd, iv%gpspw(n)%tpw%error,& iv%gpspw(n)%tpw%qc -!--- - end do + end if -!------------------------------------------------------------------------ -! [5.0] Perform optional maximum error check: -!------------------------------------------------------------------------ - if ( .not. pseudo_ztd .and. check_max_iv ) & + end do ! n1-n2 loop + + ! Perform optional maximum error check: + if ( .not. pseudo_ztd .and. check_max_iv ) & call da_check_max_iv_gpspw(iv, it, num_qcstat_conv) + + if ( write_iv_gpsztd ) then + call da_free_unit(iunit) + close(iunit) end if if (trace_use_dull) call da_trace_exit("da_get_innov_vector_gpsztd") diff --git a/var/da/da_gpspw/da_gpspw.f90 b/var/da/da_gpspw/da_gpspw.f90 index 8f6cc027a9..fe4a069f1a 100644 --- a/var/da/da_gpspw/da_gpspw.f90 +++ b/var/da/da_gpspw/da_gpspw.f90 @@ -13,7 +13,7 @@ module da_gpspw fails_error_max,pseudo_err,pseudo_x, pseudo_y, stdout, & pseudo_z,pseudo_val,max_error_ref, trace_use_dull, pseudo, its,ite,jts,jte,& ob_vars,qcstat_conv_unit - use da_control, only : pseudo_tpw, pseudo_ztd + use da_control, only : pseudo_tpw, pseudo_ztd, myproc, num_fgat_time, write_iv_gpsztd use da_define_structures, only : maxmin_type, iv_type, y_type, jo_type, & bad_data_type, x_type, number_type, bad_data_type, & maxmin_type, da_allocate_observations @@ -22,6 +22,7 @@ module da_gpspw use da_reporting, only : da_error, da_message, message use da_statistics, only : da_stats_calculate use da_tools, only : da_max_error_qc, da_residual,da_get_print_lvl + use da_tools_serial, only : da_get_unit, da_free_unit use da_tracing, only : da_trace_entry, da_trace_exit ! The "stats_gpspw_type" is ONLY used locally in da_gpspw: diff --git a/var/da/da_physics/da_physics.f90 b/var/da/da_physics/da_physics.f90 index c808023ca3..c386010d16 100644 --- a/var/da/da_physics/da_physics.f90 +++ b/var/da/da_physics/da_physics.f90 @@ -19,7 +19,7 @@ module da_physics trace_use, missing_r, maximum_rh, minimum_rh,cv_options_hum,coeff,l_over_rv, & es_gammakelvin, es_gammabeta, rd_over_rv1,t_kelvin, es_alpha, es_gamma, & es_beta, rd_over_rv, trace_use_frequent,gamma, print_detail_xa, stdout, & - cv_options_hum_specific_humidity, trace_use_dull, pi + cv_options_hum_specific_humidity, trace_use_dull, pi, consider_xap4ztd use da_par_util, only : da_transpose_z2y, da_transpose_y2x, & da_transpose_x2z, da_transpose_z2x, da_transpose_x2y, da_transpose_y2z use da_tracing, only : da_trace_entry, da_trace_exit diff --git a/var/da/da_physics/da_transform_xtoztd_adj.inc b/var/da/da_physics/da_transform_xtoztd_adj.inc index 4b50f322ae..e9ba92866c 100644 --- a/var/da/da_physics/da_transform_xtoztd_adj.inc +++ b/var/da/da_physics/da_transform_xtoztd_adj.inc @@ -20,6 +20,7 @@ SUBROUTINE DA_Transform_XToZTD_Adj( grid ) do i=its, ite wzd = grid%xa%ztd(i,j) * 1.e2 hzd = grid%xa%ztd(i,j) * 1.e2 + grid%xa%ztd(i,j) = 0.0 ! zf = (1.0 - zdk2*cos(2.0*grid%xb%lat(i,j)*radian) - zdk3*grid%xb%terr(i,j)) grid%xa%psfc(i,j) = grid%xa%psfc(i,j) + zdk1 * hzd / zf @@ -37,7 +38,9 @@ SUBROUTINE DA_Transform_XToZTD_Adj( grid ) parta = parta + term1 * const * wdk1 - grid%xa%p(i,j,k) = grid%xa%p(i,j,k) + grid%xb%q(i,j,k)*parta/grid%xb%t(i,j,k) + if ( consider_xap4ztd ) then + grid%xa%p(i,j,k) = grid%xa%p(i,j,k) + grid%xb%q(i,j,k)*parta/grid%xb%t(i,j,k) + end if grid%xa%q(i,j,k) = grid%xa%q(i,j,k) + grid%xb%p(i,j,k)*parta/grid%xb%t(i,j,k) grid%xa%t(i,j,k) = grid%xa%t(i,j,k) - grid%xb%p(i,j,k)*grid%xb%q(i,j,k)*parta & / (grid%xb%t(i,j,k)*grid%xb%t(i,j,k)) diff --git a/var/da/da_physics/da_transform_xtoztd_lin.inc b/var/da/da_physics/da_transform_xtoztd_lin.inc index c740247a0c..0d2f768bee 100644 --- a/var/da/da_physics/da_transform_xtoztd_lin.inc +++ b/var/da/da_physics/da_transform_xtoztd_lin.inc @@ -24,9 +24,15 @@ SUBROUTINE DA_Transform_XToZTD_Lin( grid ) const = (grid%xb%hf(i,j,k+1)-grid%xb%hf(i,j,k)) / a_ew part = grid%xb%p(i,j,k)*grid%xb%q(i,j,k) / grid%xb%t(i,j,k) - parta = (grid%xb%q(i,j,k)*grid%xa%p(i,j,k) + grid%xb%p(i,j,k)*grid%xa%q(i,j,k) & - - grid%xb%p(i,j,k)*grid%xb%q(i,j,k)*grid%xa%t(i,j,k) / grid%xb%t(i,j,k)) & - / grid%xb%t(i,j,k) + if ( consider_xap4ztd ) then + parta = (grid%xb%q(i,j,k)*grid%xa%p(i,j,k) + grid%xb%p(i,j,k)*grid%xa%q(i,j,k) & + - grid%xb%p(i,j,k)*grid%xb%q(i,j,k)*grid%xa%t(i,j,k) / grid%xb%t(i,j,k)) & + / grid%xb%t(i,j,k) + else + parta = ( grid%xb%p(i,j,k)*grid%xa%q(i,j,k) & + - grid%xb%p(i,j,k)*grid%xb%q(i,j,k)*grid%xa%t(i,j,k) / grid%xb%t(i,j,k)) & + / grid%xb%t(i,j,k) + end if term1 = parta * const * wdk1 term2 = (parta * const * wdk2 & - part * const * wdk2 * grid%xa%t(i,j,k) / grid%xb%t(i,j,k)) & From fda5d89bec3b712cef965dc345089b21686f7985 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Wed, 23 Aug 2017 13:44:12 -0600 Subject: [PATCH 13/91] Fixes for LSAC from Xiaowen Tang of NJU. 1. fix the staggering variable problem 2. update namelists lsac_calcerr is removed, some names are changed and some optinos are added. The current LSAC namelist options and the defaults are: use_lsac .false. lsac_nh_step 1 lsac_nv_step 1 lsac_nv_start 1 lsac_use_u .true. lsac_use_v .true. lsac_use_t .true. lsac_use_q .true. lsac_u_error 2.5 (m/s) lsac_v_error 2.5 (m/s) lsac_t_error 2.0 (C) lsac_q_error 0.002 (kg/kg) lsac_print_details .false. modified: Registry/registry.var modified: var/da/da_obs_io/da_obs_io.f90 modified: var/da/da_obs_io/da_read_lsac_util.inc --- Registry/registry.var | 11 +- var/da/da_obs_io/da_obs_io.f90 | 6 +- var/da/da_obs_io/da_read_lsac_util.inc | 253 ++++++++++++++----------- 3 files changed, 155 insertions(+), 115 deletions(-) diff --git a/Registry/registry.var b/Registry/registry.var index b18808ebbf..3122a901aa 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -344,14 +344,17 @@ rconfig integer balance_type namelist,wrfvar12 1 3 - "ba rconfig logical use_wpec namelist,wrfvar12 1 .false. - "use_wpec" "" "" rconfig real wpec_factor namelist,wrfvar12 1 0.001 - "wpec_factor" "" "Inverse of WPEC gamma factor" rconfig logical use_lsac namelist,wrfvar12 1 .false. - "use_lsac" "switch for large scale analysis constraint" "" -rconfig integer lsac_nhskip namelist,wrfvar12 1 5 - "lsac_nhskip" "number of horizontal grid points to skip" "" -rconfig integer lsac_nvskip namelist,wrfvar12 1 4 - "lsac_nvskip" "number of vertical grid points to skip" "" -rconfig integer lsac_nvstart namelist,wrfvar12 1 1 - "lsac_nvstart" "index of starting vertical grid point" "" +rconfig integer lsac_nh_step namelist,wrfvar12 1 1 - "lsac_nh_step" "increment step in grid points in the horizontal direction" "" +rconfig integer lsac_nv_step namelist,wrfvar12 1 1 - "lsac_nv_step" "increment step in grid points in the vertical direction" "" +rconfig integer lsac_nv_start namelist,wrfvar12 1 1 - "lsac_nv_start" "index of starting grid point in the vertical direction" "" rconfig logical lsac_use_u namelist,wrfvar12 1 .true. - "lsac_use_u" "switch for large scale u analysis constraint" "" rconfig logical lsac_use_v namelist,wrfvar12 1 .true. - "lsac_use_v" "switch for large scale v analysis constraint" "" rconfig logical lsac_use_t namelist,wrfvar12 1 .true. - "lsac_use_t" "switch for large scale t analysis constraint" "" rconfig logical lsac_use_q namelist,wrfvar12 1 .true. - "lsac_use_q" "switch for large scale q analysis constraint" "" -rconfig logical lsac_calcerr namelist,wrfvar12 1 .false. - "lsac_calcerr" "switch for using fixed (false) or scaled (true) error" "" +rconfig real lsac_u_error namelist,wrfvar12 1 2.5 - "lsac_u_error" "" "m/s" +rconfig real lsac_v_error namelist,wrfvar12 1 2.5 - "lsac_v_error" "" "m/s" +rconfig real lsac_t_error namelist,wrfvar12 1 2.0 - "lsac_t_error" "" "degree C" +rconfig real lsac_q_error namelist,wrfvar12 1 0.002 - "lsac_q_error" "" "kg/kg" rconfig logical lsac_print_details namelist,wrfvar12 1 .false. - "lsac_print_details" "switch for printout" "" rconfig integer vert_corr namelist,wrfvar13 1 2 - "vert_corr" "" "" rconfig integer vertical_ip namelist,wrfvar13 1 0 - "vertical_ip" "" "" diff --git a/var/da/da_obs_io/da_obs_io.f90 b/var/da/da_obs_io/da_obs_io.f90 index 2aff19d255..8a8d522959 100644 --- a/var/da/da_obs_io/da_obs_io.f90 +++ b/var/da/da_obs_io/da_obs_io.f90 @@ -13,7 +13,7 @@ module da_obs_io max_ob_levels, missing_data, max_bogus_input, myproc, convert_uv2fd, convert_fd2uv, & fails_error_max,standard_atmosphere,zero_t_td,print_detail_f_obs, & print_detail_radar,use_satemobs,use_polaramvobs,use_ssmt1obs, & - use_ssmt2obs, use_airsretobs,convert_fd2uv,anal_type_qcobs,gravity, & + use_ssmt2obs, use_airsretobs,convert_fd2uv,anal_type_qcobs,gravity,gas_constant,cp, & filename_len, t0, max_airep_input, max_bogus_input, max_ssmi_rv_input, & max_buoy_input, max_gpsref_input, max_gpspw_input, max_geoamv_input, & max_airsr_input, max_polaramv_input, max_radar_input, & @@ -29,8 +29,8 @@ module da_obs_io pi, ob_format_gpsro, ob_format_ascii, analysis_date, kms,kme, v_interp_h,v_interp_p, & wind_sd,wind_sd_synop,wind_sd_tamdar,wind_sd_mtgirs,wind_sd_profiler,wind_sd_geoamv,wind_sd_polaramv, & wind_sd_airep,wind_sd_sound,wind_sd_metar,wind_sd_ships,wind_sd_qscat,wind_sd_buoy,wind_sd_pilot,wind_stats_sd,& - thin_conv, thin_conv_ascii, lsac_nhskip, lsac_nvskip, lsac_nvstart, lsac_calcerr, lsac_print_details, & - lsac_use_u,lsac_use_v,lsac_use_t,lsac_use_q + thin_conv, thin_conv_ascii, lsac_nh_step, lsac_nv_step, lsac_nv_start, lsac_print_details, & + lsac_use_u, lsac_use_v, lsac_use_t, lsac_use_q, lsac_u_error, lsac_v_error, lsac_t_error, lsac_q_error use da_define_structures, only : iv_type, multi_level_type, multi_level_type_BUFR, & radar_multi_level_type, y_type, field_type, each_level_type, & diff --git a/var/da/da_obs_io/da_read_lsac_util.inc b/var/da/da_obs_io/da_read_lsac_util.inc index d485a28a3c..f1d6f2555f 100644 --- a/var/da/da_obs_io/da_read_lsac_util.inc +++ b/var/da/da_obs_io/da_read_lsac_util.inc @@ -1,6 +1,13 @@ - subroutine da_read_lsac_wrfinput(iv, onlyscan) + !----------------------------------------------------------------------- + ! Purpose: extract pseduo-observations from wrfinput and use them as bogus + ! observations to constrain the large-scale pattern of WRFDA analysis + ! + ! Author: Xiaowen Tang, NJU, Date: 5/2/2016 + ! Update 7/15/2017: fix the problem of staggering variables + !--------------------------------------------------------------------- + implicit none type (iv_type), intent(inout) :: iv @@ -10,30 +17,16 @@ type (multi_level_type) :: platform logical :: outside, outside_all integer :: i, j, k, ki, ndims, nrecs, nlocal, iunit, nlevels, ilevel -integer :: u_qc, v_qc, t_qc, q_qc, ierror -real :: u_ferr, v_ferr, t_ferr, q_ferr -character(len=512) :: lsac_wrfinput, lsac_output -integer, dimension(4) :: dims_u, dims_v, dims_t, dims_p, dims_q +integer :: u_qc, v_qc, t_qc, q_qc +character(len=512) :: lsac_wrfinput +integer, dimension(4) :: dims_u, dims_v, dims_t, dims_p, dims_pb, dims_q integer, dimension(4) :: dims_lat, dims_lon, dims_alt, dims_phb, dims_ph -real, allocatable, dimension(:,:,:) :: u_lsac, v_lsac, w_lsac, t_lsac, p_lsac, q_lsac, taux_lsac +real, allocatable, dimension(:,:,:) :: u_lsac, v_lsac, w_lsac, theta_lsac, p_lsac, q_lsac, tk_lsac real, allocatable, dimension(:,:,:) :: pb_lsac, ph_lsac, phb_lsac, height_lsac, press real, allocatable, dimension(:,:) :: lat_lsac, lon_lsac logical :: debug logical, external :: wrf_dm_on_monitor - -! If the errors are not calculated from equation, then a minimum value is set. -!Minimum Error -real, parameter :: u_ferrmin=2.5 ! [m/s] -real, parameter :: v_ferrmin=2.5 ! [m/s] -real, parameter :: t_ferrmin=2.0 ! [C] -real, parameter :: q_ferrmin=0.002 ! [Kg/Kg] - -! If the errors are calculated from equation, then the errors are a percentage of the full values -!Percentage -real, parameter :: u_err=25.0 ! [%] -real, parameter :: v_err=25.0 ! [%] -real, parameter :: t_err=15.0 ! [%] -real, parameter :: q_err=30.0 ! [%] +logical :: isfile if (trace_use) call da_trace_entry("da_read_lsac_util") @@ -41,28 +34,46 @@ if (trace_use) call da_trace_entry("da_read_lsac_util") lsac_wrfinput = 'fg_l' debug=.false. -if (onlyscan) then - - call da_get_dims_cdf( lsac_wrfinput, 'XLAT', dims_lat, ndims, debug) - call da_get_dims_cdf( lsac_wrfinput, 'XLONG', dims_lon, ndims, debug) - call da_get_dims_cdf( lsac_wrfinput, 'T', dims_t, ndims, debug) +inquire(file=trim(lsac_wrfinput), exist=isfile) +if ( .not. isfile ) then + write(unit=message(1),fmt='(a,a,a)') 'File ',trim(lsac_wrfinput),' for LSAC is missing.' + call da_error(__FILE__,__LINE__,message(1:1)) +endif +if (onlyscan) then + if (rootproc) then + call da_get_dims_cdf( lsac_wrfinput, 'XLAT', dims_lat, ndims, debug) + call da_get_dims_cdf( lsac_wrfinput, 'XLONG', dims_lon, ndims, debug) + call da_get_dims_cdf( lsac_wrfinput, 'T', dims_t, ndims, debug) + endif + call wrf_dm_bcast_integer(dims_lon, 4) + call wrf_dm_bcast_integer(dims_lat, 4) + call wrf_dm_bcast_integer(dims_t, 4) +#ifdef DEBUG_LSAC + print *, '****SCAN LSAC lat_dims: ', myproc, dims_lat(1), dims_lat(2), dims_lat(3), dims_lat(4) + print *, '****SCAN LSAC lon_dims: ', myproc, dims_lon(1), dims_lon(2), dims_lon(3), dims_lon(4) + print *, '****SCAN LSAC t_dims: ', myproc, dims_t(1), dims_t(2), dims_t(3), dims_t(4) +#endif allocate(lat_lsac(dims_lat(1), dims_lat(2))) allocate(lon_lsac(dims_lon(1), dims_lon(2))) - nlevels = (dims_t(3)-lsac_nvstart+1)/lsac_nvskip + nlevels = (dims_t(3)-lsac_nv_start+1)/lsac_nv_step !--------------------------------------------------------- ! Reading data from WRF Input file !--------------------------------------------------------- - call da_get_var_2d_real_cdf( lsac_wrfinput, 'XLAT', lat_lsac, dims_lat(1), dims_lat(2), 1, debug) - call da_get_var_2d_real_cdf( lsac_wrfinput, 'XLONG', lon_lsac, dims_lon(1), dims_lon(2), 1, debug) + if (rootproc) then + call da_get_var_2d_real_cdf( lsac_wrfinput, 'XLAT', lat_lsac, dims_lat(1), dims_lat(2), 1, debug) + call da_get_var_2d_real_cdf( lsac_wrfinput, 'XLONG', lon_lsac, dims_lon(1), dims_lon(2), 1, debug) + endif + call wrf_dm_bcast_real(lat_lsac, dims_lat(1)*dims_lat(2)) + call wrf_dm_bcast_real(lon_lsac, dims_lon(1)*dims_lon(2)) - ! Calculating the errors and fill the iv type + !Assigning max_lev and counts in the iv type in onlyscan mode nlocal=0 nrecs =0 - do i=1, dims_lon(1), lsac_nhskip - do j=1, dims_lat(2), lsac_nhskip + do i=1, dims_lon(1), lsac_nh_step + do j=1, dims_lat(2), lsac_nh_step platform%info%lat = lat_lsac(i,j) platform%info%lon = lon_lsac(i,j) platform%info%elv = 0.0 @@ -70,7 +81,7 @@ if (onlyscan) then platform%info%platform = 'FM-??? LSAC' platform%info%id = '?????' platform%info%date_char= '????-??-??_??:??:??' - platform%info%pstar = 0.000000000000000 + platform%info%pstar = 0.D0 platform%info%levels = nlevels if (platform%info%lon == 180.0 ) platform%info%lon =-180.000 if (platform%info%lat < -89.9999 .or. platform%info%lat > 89.9999) then @@ -86,6 +97,9 @@ if (onlyscan) then endif enddo enddo +#ifdef DEBUG_LSAC + print *, '******SCAN LSAC: ', myproc, nlevels, nlocal, nrecs +#endif iv%info(bogus)%max_lev = nlevels iv%info(bogus)%nlocal = nlocal iv%info(bogus)%ntotal = nrecs @@ -95,78 +109,110 @@ else !--------------------------------------------------------- ! Getting information from NETCDF files (WRF Input file) !--------------------------------------------------------- - call da_get_dims_cdf( lsac_wrfinput, 'U', dims_u, ndims, debug) - call da_get_dims_cdf( lsac_wrfinput, 'V', dims_v, ndims, debug) - call da_get_dims_cdf( lsac_wrfinput, 'T', dims_t, ndims, debug) - call da_get_dims_cdf( lsac_wrfinput, 'PB', dims_p, ndims, debug) - call da_get_dims_cdf( lsac_wrfinput, 'QVAPOR', dims_q, ndims, debug) - call da_get_dims_cdf( lsac_wrfinput, 'XLAT', dims_lat, ndims, debug) - call da_get_dims_cdf( lsac_wrfinput, 'XLONG', dims_lon, ndims, debug) - call da_get_dims_cdf( lsac_wrfinput, 'PHB', dims_phb, ndims, debug) - call da_get_dims_cdf( lsac_wrfinput, 'PH', dims_ph, ndims, debug) - - ! It will be assimilated every "lsac_nhskip" data point in the horizontal and "lsac_nvskip" - ! in the vertical - nrecs = ( 1 + ( dims_lat(1) - 1 )/lsac_nhskip ) * ( 1 + ( dims_lat(2) - 1 )/lsac_nhskip ) - nlevels = (dims_t(3)-lsac_nvstart+1)/lsac_nvskip + if (rootproc) then + call da_get_dims_cdf( lsac_wrfinput, 'XLAT', dims_lat, ndims, debug) + call da_get_dims_cdf( lsac_wrfinput, 'XLONG', dims_lon, ndims, debug) + call da_get_dims_cdf( lsac_wrfinput, 'U', dims_u, ndims, debug) + call da_get_dims_cdf( lsac_wrfinput, 'V', dims_v, ndims, debug) + call da_get_dims_cdf( lsac_wrfinput, 'T', dims_t, ndims, debug) + call da_get_dims_cdf( lsac_wrfinput, 'PB', dims_pb, ndims, debug) + call da_get_dims_cdf( lsac_wrfinput, 'P', dims_p, ndims, debug) + call da_get_dims_cdf( lsac_wrfinput, 'QVAPOR', dims_q, ndims, debug) + call da_get_dims_cdf( lsac_wrfinput, 'PHB', dims_phb, ndims, debug) + call da_get_dims_cdf( lsac_wrfinput, 'PH', dims_ph, ndims, debug) + endif + +#ifdef DEBUG_LSAC + print *, 'lat_dims: ', myproc, dims_lat(1), dims_lat(2), dims_lat(3), dims_lat(4) + print *, 'lon_dims: ', myproc, dims_lon(1), dims_lon(2), dims_lon(3), dims_lon(4) + print *, 'u_dims: ', myproc, dims_u(1), dims_u(2), dims_u(3), dims_u(4) + print *, 'v_dims: ', myproc, dims_v(1), dims_v(2), dims_v(3), dims_v(4) + print *, 't_dims: ', myproc, dims_t(1), dims_t(2), dims_t(3), dims_t(4) + print *, 'p_dims: ', myproc, dims_p(1), dims_p(2), dims_p(3), dims_p(4) + print *, 'pb_dims: ', myproc, dims_pb(1), dims_pb(2), dims_pb(3), dims_pb(4) + print *, 'q_dims: ', myproc, dims_q(1), dims_q(2), dims_q(3), dims_q(4) + print *, 'ph_dims: ', myproc, dims_ph(1), dims_ph(2), dims_ph(3), dims_ph(4) + print *, 'phb_dims: ', myproc, dims_phb(1), dims_phb(2), dims_phb(3), dims_phb(4) +#endif + + call wrf_dm_bcast_integer(dims_u, 4) + call wrf_dm_bcast_integer(dims_v, 4) + call wrf_dm_bcast_integer(dims_t, 4) + call wrf_dm_bcast_integer(dims_p, 4) + call wrf_dm_bcast_integer(dims_pb, 4) + call wrf_dm_bcast_integer(dims_q, 4) + call wrf_dm_bcast_integer(dims_lat, 4) + call wrf_dm_bcast_integer(dims_lon, 4) + call wrf_dm_bcast_integer(dims_phb, 4) + call wrf_dm_bcast_integer(dims_ph, 4) + + nrecs = (1 + (dims_lat(1) - 1)/lsac_nh_step) * (1 + (dims_lat(2) - 1) / lsac_nh_step) + nlevels = (dims_t(3) - lsac_nv_start + 1) / lsac_nv_step !--------------------------------------------------------- ! Allocating memory !--------------------------------------------------------- + allocate(lat_lsac(dims_lat(1), dims_lat(2))) + allocate(lon_lsac(dims_lon(1), dims_lon(2))) allocate(u_lsac(dims_u(1), dims_u(2), dims_u(3) )) allocate(v_lsac(dims_v(1), dims_v(2), dims_v(3) )) - allocate(t_lsac(dims_t(1), dims_t(2), dims_t(3) )) - allocate(taux_lsac(dims_t(1), dims_t(2), dims_t(3) )) + allocate(theta_lsac(dims_t(1), dims_t(2), dims_t(3) )) allocate(p_lsac(dims_p(1), dims_p(2), dims_p(3) )) - allocate(pb_lsac(dims_p(1), dims_p(2), dims_p(3) )) + allocate(pb_lsac(dims_pb(1), dims_pb(2), dims_pb(3) )) allocate(q_lsac(dims_q(1), dims_q(2), dims_q(3) )) - allocate(lat_lsac(dims_lat(1), dims_lat(2) )) - allocate(lon_lsac(dims_lon(1), dims_lon(2) )) allocate(phb_lsac(dims_phb(1), dims_phb(2), dims_phb(3) )) allocate(ph_lsac(dims_ph(1), dims_ph(2), dims_ph(3) )) allocate(height_lsac(dims_ph(1), dims_ph(2), dims_ph(3) )) allocate(press(dims_p(1), dims_p(2), dims_p(3) )) + allocate(tk_lsac(dims_t(1), dims_t(2), dims_t(3) )) !--------------------------------------------------------- ! Reading data from WRF Input file !--------------------------------------------------------- - call da_get_var_3d_real_cdf( lsac_wrfinput, 'U', u_lsac, dims_u(1), dims_u(2), dims_u(3), 1, debug) - call da_get_var_3d_real_cdf( lsac_wrfinput, 'V', v_lsac, dims_v(1), dims_v(2), dims_v(3), 1, debug) - call da_get_var_3d_real_cdf( lsac_wrfinput, 'T', t_lsac, dims_t(1), dims_t(2), dims_t(3), 1, debug) - call da_get_var_3d_real_cdf( lsac_wrfinput, 'P', p_lsac, dims_p(1), dims_p(2), dims_p(3), 1, debug) - call da_get_var_3d_real_cdf( lsac_wrfinput, 'PB', pb_lsac, dims_p(1), dims_p(2), dims_p(3), 1, debug) - call da_get_var_3d_real_cdf( lsac_wrfinput, 'QVAPOR', q_lsac, dims_q(1), dims_q(2), dims_q(3), 1, debug) - call da_get_var_2d_real_cdf( lsac_wrfinput, 'XLAT', lat_lsac, dims_lat(1), dims_lat(2), 1, debug) - call da_get_var_2d_real_cdf( lsac_wrfinput, 'XLONG', lon_lsac, dims_lon(1), dims_lon(2), 1, debug) - call da_get_var_3d_real_cdf( lsac_wrfinput, 'PHB', phb_lsac, dims_phb(1), dims_phb(2), dims_phb(3), 1, debug) - call da_get_var_3d_real_cdf( lsac_wrfinput, 'PH', ph_lsac, dims_ph(1), dims_ph(2), dims_ph(3), 1, debug) + if (rootproc) then + call da_get_var_2d_real_cdf( lsac_wrfinput, 'XLAT', lat_lsac, dims_lat(1), dims_lat(2), 1, debug) + call da_get_var_2d_real_cdf( lsac_wrfinput, 'XLONG', lon_lsac, dims_lon(1), dims_lon(2), 1, debug) + call da_get_var_3d_real_cdf( lsac_wrfinput, 'U', u_lsac, dims_u(1), dims_u(2), dims_u(3), 1, debug) + call da_get_var_3d_real_cdf( lsac_wrfinput, 'V', v_lsac, dims_v(1), dims_v(2), dims_v(3), 1, debug) + call da_get_var_3d_real_cdf( lsac_wrfinput, 'T', theta_lsac,dims_t(1), dims_t(2), dims_t(3), 1, debug) + call da_get_var_3d_real_cdf( lsac_wrfinput, 'P', p_lsac, dims_p(1), dims_p(2), dims_p(3), 1, debug) + call da_get_var_3d_real_cdf( lsac_wrfinput, 'PB', pb_lsac, dims_p(1), dims_p(2), dims_p(3), 1, debug) + call da_get_var_3d_real_cdf( lsac_wrfinput, 'QVAPOR', q_lsac, dims_q(1), dims_q(2), dims_q(3), 1, debug) + call da_get_var_3d_real_cdf( lsac_wrfinput, 'PHB', phb_lsac, dims_phb(1), dims_phb(2), dims_phb(3), 1, debug) + call da_get_var_3d_real_cdf( lsac_wrfinput, 'PH', ph_lsac, dims_ph(1), dims_ph(2), dims_ph(3), 1, debug) + endif + call wrf_dm_bcast_real(lat_lsac, PRODUCT(dims_lat(1:2))) + call wrf_dm_bcast_real(lon_lsac, PRODUCT(dims_lon(1:2))) + call wrf_dm_bcast_real(u_lsac, PRODUCT(dims_u(1:3)) ) + call wrf_dm_bcast_real(v_lsac, PRODUCT(dims_v(1:3)) ) + call wrf_dm_bcast_real(theta_lsac, PRODUCT(dims_t(1:3)) ) + call wrf_dm_bcast_real(p_lsac, PRODUCT(dims_p(1:3)) ) + call wrf_dm_bcast_real(pb_lsac, PRODUCT(dims_p(1:3)) ) + call wrf_dm_bcast_real(q_lsac, PRODUCT(dims_q(1:3)) ) + call wrf_dm_bcast_real(phb_lsac, PRODUCT(dims_phb(1:3))) + call wrf_dm_bcast_real(ph_lsac, PRODUCT(dims_ph(1:3)) ) !--------------------------------------------------------- !Calculating the height !--------------------------------------------------------- - height_lsac= (phb_lsac + ph_lsac)/9.8 - press=(p_lsac+pb_lsac)*0.01 + height_lsac = (phb_lsac + ph_lsac) / gravity + press = (p_lsac + pb_lsac) * 0.01 !Temperature from potential temperature - taux_lsac=(300.0+t_lsac) * ( ( press/1000.0 )**(287.04/1004.5) ) + tk_lsac = (t0 + theta_lsac) * ((press / 1000.0) ** (gas_constant / cp)) - if (lsac_print_details .and. wrf_dm_on_monitor() ) then + if (lsac_print_details .and. rootproc) then call da_get_unit(iunit) open(iunit, file='lsac_details') endif - ! Calculating the errors and fill the iv type + ! Assigning errors, heights and inv in the iv type nlocal=0 - do i=1, dims_lon(1), lsac_nhskip - do j=1, dims_lat(2), lsac_nhskip + do i=1, dims_lon(1), lsac_nh_step + do j=1, dims_lat(2), lsac_nh_step ilevel = 0 - do k=lsac_nvstart, dims_t(3), lsac_nvskip + do k=lsac_nv_start, dims_t(3), lsac_nv_step ilevel = ilevel+1 - u_qc = 0 - v_qc = 0 - t_qc = 0 - q_qc = 0 - if (lsac_use_u) then u_qc = 0 else @@ -188,52 +234,41 @@ else q_qc = missing_data endif - if(lsac_calcerr) then - u_ferr=max( u_ferrmin , abs((u_lsac(i,j,k )*u_err)/100.0) ) - v_ferr=max( v_ferrmin , abs((v_lsac(i,j,k )*v_err)/100.0) ) - t_ferr=max( t_ferrmin , abs(((taux_lsac(i,j,k)-273.15)*t_err)/100.0) ) - q_ferr=max( q_ferrmin , abs((q_lsac(i,j,k )*q_err)/100.0) ) - else - u_ferr=u_ferrmin - v_ferr=v_ferrmin - t_ferr=t_ferrmin - q_ferr=q_ferrmin - endif - - platform%each(ilevel)%height=height_lsac(i,j,k) + platform%each(ilevel)%height= (height_lsac(i,j,k)+height_lsac(i,j,k+1))/2. - platform%each(ilevel)%u%inv=u_lsac(i,j,k) - platform%each(ilevel)%u%error=u_ferr + platform%each(ilevel)%u%inv= (u_lsac(i,j,k)+u_lsac(i+1,j,k))/2. + platform%each(ilevel)%u%error=lsac_u_error platform%each(ilevel)%u%qc=u_qc - platform%each(ilevel)%v%inv=v_lsac(i,j,k) - platform%each(ilevel)%v%error=v_ferr + platform%each(ilevel)%v%inv= (v_lsac(i,j,k)+v_lsac(i,j+1,k))/2. + platform%each(ilevel)%v%error=lsac_v_error platform%each(ilevel)%v%qc=v_qc - platform%each(ilevel)%t%inv=taux_lsac(i,j,k) - platform%each(ilevel)%t%error=t_ferr + platform%each(ilevel)%t%inv=tk_lsac(i,j,k) + platform%each(ilevel)%t%error=lsac_t_error platform%each(ilevel)%t%qc=t_qc platform%each(ilevel)%q%inv=q_lsac(i,j,k) - platform%each(ilevel)%q%error=q_ferr + platform%each(ilevel)%q%error=lsac_q_error platform%each(ilevel)%q%qc=q_qc - if(lsac_print_details .and. wrf_dm_on_monitor() ) then - write(iunit,'(3f10.3,x,4(f10.3,x,f10.3,x,i4))') height_lsac(i,j,k), lat_lsac(i,j), lon_lsac(i,j), & - u_lsac(i,j,k) , u_ferr , u_qc, & - v_lsac(i,j,k) , v_ferr , v_qc, & - taux_lsac(i,j,k) , t_ferr , t_qc, & - q_lsac(i,j,k)*1000 , q_ferr*1000, q_qc + if(lsac_print_details .and. rootproc) then + write(iunit,'(3I5,3f10.3,x,4(f10.3,x,f10.3,x,i4))') i, j, k, & + (height_lsac(i,j,k) + height_lsac(i,j,k+1))/2., lat_lsac(i,j), lon_lsac(i,j), & + (u_lsac(i,j,k)+u_lsac(i+1,j,k))/2., lsac_u_error , u_qc, & + (v_lsac(i,j,k)+v_lsac(i,j+1,k))/2., lsac_v_error , v_qc, & + tk_lsac(i,j,k) , lsac_t_error , t_qc, & + q_lsac(i,j,k)*1000. , lsac_q_error*1000., q_qc endif enddo platform%info%lat = lat_lsac(i,j) platform%info%lon = lon_lsac(i,j) - platform%info%elv = height_lsac(i,j,dims_t(3)) + platform%info%elv = 0. platform%info%name = 'LSAC' platform%info%platform = 'FM-??? LSAC' platform%info%id = '?????' platform%info%date_char= '????-??-??_??:??:??' - platform%info%pstar = 0.000000000000000 + platform%info%pstar = 0.D0 platform%info%levels = nlevels if (platform%info%lon == 180.0 ) platform%info%lon =-180.000 if (platform%info%lat < -89.9999 .or. platform%info%lat > 89.9999) then @@ -313,8 +348,8 @@ else enddo deallocate(u_lsac) deallocate(v_lsac) - deallocate(t_lsac) - deallocate(taux_lsac) + deallocate(theta_lsac) + deallocate(tk_lsac) deallocate(p_lsac) deallocate(pb_lsac) deallocate(q_lsac) @@ -324,11 +359,13 @@ else deallocate(ph_lsac) deallocate(height_lsac) deallocate(press) -endif -if (lsac_print_details .and. wrf_dm_on_monitor() ) then - close(iunit) -endif + if (lsac_print_details .and. rootproc) then + close(iunit) + call da_free_unit(iunit) + endif + +endif !onlyscan if (trace_use) call da_trace_exit("da_read_lsac_util") From aada5fb224150727d64120ecfec6c7f20804c6c9 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Mon, 13 Nov 2017 17:34:31 -0700 Subject: [PATCH 14/91] Merge 2017's Multi-Resolution-Incremental 4DVAR from Jake Liu of NCAR. git cherry-pick -n 5e94060 606ac0e 4cc9707 85e4d11 baa3fe6 1. add offline programs and scripts for MRI-4DVAR 2. add w and cloud control variables for MRI-4DVAR 3. allow properly reading of BE file with cloud/w variables generated by stand-alone GEN_BE 4. bug fix for radar data OMB file I/O for MRI-4DVAR modified: var/da/da_main/da_solve.inc modified: var/da/da_obs_io/da_search_obs.inc modified: var/da/da_recursive_filter/da_transform_through_rf_inv.inc modified: var/da/da_setup_structures/da_setup_be_regional.inc modified: var/da/da_setup_structures/da_write_vp.inc modified: var/da/da_vtox_transforms/da_transform_vptox_inv.inc modified: var/da/da_vtox_transforms/da_transform_vtovv_inv.inc modified: var/da/da_vtox_transforms/da_transform_vtox_inv.inc new file: var/mri4dvar/Makefile new file: var/mri4dvar/README.Multi_inc new file: var/mri4dvar/da_bdy.f90 new file: var/mri4dvar/da_bilin.f90 new file: var/mri4dvar/da_thin.f90 new file: var/mri4dvar/da_vp_bilin.f90 new file: var/mri4dvar/da_vp_split.f90 new file: var/mri4dvar/nc_increment.ncl new file: var/mri4dvar/nc_vpglobal.ncl new file: var/mri4dvar/nc_vphires.ncl new file: var/mri4dvar/nc_vpinput.ncl new file: var/mri4dvar/nc_vplocal.ncl new file: var/mri4dvar/rsl_lite.h new file: var/mri4dvar/run_mri3d4dvar.csh_lsf new file: var/mri4dvar/run_mri3d4dvar.csh_pbs new file: var/mri4dvar/task_for_point.c new file: var/mri4dvar/wraper_mri3d4dvar.csh --- var/da/da_main/da_solve.inc | 39 + var/da/da_obs_io/da_search_obs.inc | 5 +- .../da_transform_through_rf_inv.inc | 6 +- .../da_setup_be_regional.inc | 85 +- var/da/da_setup_structures/da_write_vp.inc | 65 +- .../da_transform_vptox_inv.inc | 182 +--- .../da_transform_vtovv_inv.inc | 180 ++-- .../da_transform_vtox_inv.inc | 16 +- var/mri4dvar/Makefile | 42 + var/mri4dvar/README.Multi_inc | 86 ++ var/mri4dvar/da_bdy.f90 | 681 ++++++++++++++ var/mri4dvar/da_bilin.f90 | 369 ++++++++ var/mri4dvar/da_thin.f90 | 277 ++++++ var/mri4dvar/da_vp_bilin.f90 | 384 ++++++++ var/mri4dvar/da_vp_split.f90 | 368 ++++++++ var/mri4dvar/nc_increment.ncl | 56 ++ var/mri4dvar/nc_vpglobal.ncl | 65 ++ var/mri4dvar/nc_vphires.ncl | 64 ++ var/mri4dvar/nc_vpinput.ncl | 64 ++ var/mri4dvar/nc_vplocal.ncl | 64 ++ var/mri4dvar/rsl_lite.h | 168 ++++ var/mri4dvar/run_mri3d4dvar.csh_lsf | 742 +++++++++++++++ var/mri4dvar/run_mri3d4dvar.csh_pbs | 862 ++++++++++++++++++ var/mri4dvar/task_for_point.c | 165 ++++ var/mri4dvar/wraper_mri3d4dvar.csh | 28 + 25 files changed, 4736 insertions(+), 327 deletions(-) create mode 100644 var/mri4dvar/Makefile create mode 100644 var/mri4dvar/README.Multi_inc create mode 100644 var/mri4dvar/da_bdy.f90 create mode 100644 var/mri4dvar/da_bilin.f90 create mode 100644 var/mri4dvar/da_thin.f90 create mode 100644 var/mri4dvar/da_vp_bilin.f90 create mode 100644 var/mri4dvar/da_vp_split.f90 create mode 100644 var/mri4dvar/nc_increment.ncl create mode 100644 var/mri4dvar/nc_vpglobal.ncl create mode 100644 var/mri4dvar/nc_vphires.ncl create mode 100644 var/mri4dvar/nc_vpinput.ncl create mode 100644 var/mri4dvar/nc_vplocal.ncl create mode 100644 var/mri4dvar/rsl_lite.h create mode 100755 var/mri4dvar/run_mri3d4dvar.csh_lsf create mode 100755 var/mri4dvar/run_mri3d4dvar.csh_pbs create mode 100644 var/mri4dvar/task_for_point.c create mode 100755 var/mri4dvar/wraper_mri3d4dvar.csh diff --git a/var/da/da_main/da_solve.inc b/var/da/da_main/da_solve.inc index 5a65172fbf..50e1194865 100644 --- a/var/da/da_main/da_solve.inc +++ b/var/da/da_main/da_solve.inc @@ -46,6 +46,7 @@ real, allocatable :: grid_box_area(:,:), mapfac(:,:) real, allocatable :: v1(:,:,:),v2(:,:,:),v3(:,:,:),v4(:,:,:),v5(:,:,:) + real, allocatable :: v6(:,:,:),v7(:,:,:),v8(:,:,:),v9(:,:,:),v10(:,:,:),v11(:,:,:) character (len=10) :: variable_name integer :: iwin, num_subtwindow @@ -608,8 +609,18 @@ allocate( v3(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) allocate( v4(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) allocate( v5(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) + if ( cloud_cv_options >= 2 ) then + allocate( v6(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) + allocate( v7(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) + allocate( v8(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) + allocate( v9(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) + allocate( v10(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) + end if + if ( use_cv_w ) allocate( v11(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) read(vp_unit) v1, v2, v3, v4, v5 + if ( cloud_cv_options >= 2 ) read(vp_unit) v6, v7, v8, v9, v10 + if ( use_cv_w ) read(vp_unit) v11 if ( use_interpolate_cvt ) then grid%vv%v1(ips:ipe,jps:jpe,kps:kpe) = v1(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) @@ -617,6 +628,16 @@ grid%vv%v3(ips:ipe,jps:jpe,kps:kpe) = v3(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) grid%vv%v4(ips:ipe,jps:jpe,kps:kpe) = v4(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) grid%vv%v5(ips:ipe,jps:jpe,kps:kpe) = v5(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + if ( cloud_cv_options >= 2 ) then + grid%vv%v6(ips:ipe,jps:jpe,kps:kpe) = v6(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vv%v7(ips:ipe,jps:jpe,kps:kpe) = v7(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vv%v8(ips:ipe,jps:jpe,kps:kpe) = v8(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vv%v9(ips:ipe,jps:jpe,kps:kpe) = v9(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vv%v10(ips:ipe,jps:jpe,kps:kpe) = v10(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + end if + if ( use_cv_w ) then + grid%vv%v11(ips:ipe,jps:jpe,kps:kpe) = v11(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + end if call da_vv_to_cv( grid%vv, grid%xp, be%cv_mz, be%ncv_mz, cv_size, cvt ) elseif ( use_inverse_squarerootb ) then grid%vp%v1(ips:ipe,jps:jpe,kps:kpe) = v1(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) @@ -624,6 +645,16 @@ grid%vp%v3(ips:ipe,jps:jpe,kps:kpe) = v3(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) grid%vp%v4(ips:ipe,jps:jpe,kps:kpe) = v4(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) grid%vp%v5(ips:ipe,jps:jpe,kps:kpe) = v5(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + if ( cloud_cv_options >= 2 ) then + grid%vp%v6(ips:ipe,jps:jpe,kps:kpe) = v6(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vp%v7(ips:ipe,jps:jpe,kps:kpe) = v7(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vp%v8(ips:ipe,jps:jpe,kps:kpe) = v8(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vp%v9(ips:ipe,jps:jpe,kps:kpe) = v9(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vp%v10(ips:ipe,jps:jpe,kps:kpe) = v10(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + end if + if ( use_cv_w ) then ! vertical stagging +1? + grid%vp%v11(ips:ipe,jps:jpe,kps:kpe) = v11(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + end if !call da_write_vp(grid,grid%vp,'vp_input.global ') ! to verify correctness print '(/10X,"===> Use inverse transform of square-root B for outer-loop=",i2)', it if ( cv_options == 3 ) then @@ -639,6 +670,14 @@ deallocate( v3 ) deallocate( v4 ) deallocate( v5 ) + if ( cloud_cv_options >= 2 ) then + deallocate( v6 ) + deallocate( v7 ) + deallocate( v8 ) + deallocate( v9 ) + deallocate( v10 ) + end if + if ( use_cv_w ) deallocate( v11 ) close(vp_unit) call da_free_unit(vp_unit) diff --git a/var/da/da_obs_io/da_search_obs.inc b/var/da/da_obs_io/da_search_obs.inc index 89d47b08f0..1576a82b27 100644 --- a/var/da/da_obs_io/da_search_obs.inc +++ b/var/da/da_obs_io/da_search_obs.inc @@ -344,7 +344,6 @@ subroutine da_search_obs (ob_type_string, unit_in, num_obs, nth, iv, found_flag) do n = 1, num_obs read(unit_in,'(2i8,2E22.13)') n_dummy, levels, lat, lon - if ( abs(iv%info(radar)%lat(1,nth) - lat ) < MIN_ERR .and. & abs(iv%info(radar)%lon(1,nth) - lon ) < MIN_ERR ) then @@ -359,7 +358,9 @@ subroutine da_search_obs (ob_type_string, unit_in, num_obs, nth, iv, found_flag) if (trace_use) call da_trace_exit("da_search_obs") return else - read(unit_in,*) + do k = 1, levels + read(unit_in,*) + enddo endif enddo !found_flag = .false. diff --git a/var/da/da_recursive_filter/da_transform_through_rf_inv.inc b/var/da/da_recursive_filter/da_transform_through_rf_inv.inc index ffbc1f7983..5576f66203 100644 --- a/var/da/da_recursive_filter/da_transform_through_rf_inv.inc +++ b/var/da/da_recursive_filter/da_transform_through_rf_inv.inc @@ -33,9 +33,9 @@ subroutine da_transform_through_rf_inv(grid, mz,rf_alpha, val, field, scaling) if (trace_use_dull) call da_trace_entry("da_transform_through_rf_inv") write (*,*) 'mz= ', mz - write (*,*) 'rf_alpha= ', rf_alpha - write (*,*) 'eigval= ', val - write (*,*) 'vert_corr=', vert_corr, ' vert_corr_1=', vert_corr_1 + !write (*,*) 'rf_alpha= ', rf_alpha + !write (*,*) 'eigval= ', val + !write (*,*) 'vert_corr=', vert_corr, ' vert_corr_1=', vert_corr_1 rf_passes_over_two = rf_passes / 2 diff --git a/var/da/da_setup_structures/da_setup_be_regional.inc b/var/da/da_setup_structures/da_setup_be_regional.inc index 73755c8497..731ca3b1f5 100644 --- a/var/da/da_setup_structures/da_setup_be_regional.inc +++ b/var/da/da_setup_structures/da_setup_be_regional.inc @@ -121,7 +121,7 @@ subroutine da_setup_be_regional(xb, be, grid) real, allocatable :: regcoeff_chi_u_rh(:,:,:) ! chi_u/rh regression coefficient real, allocatable :: regcoeff_t_u_rh(:,:,:) ! t_u/rh regression coefficient real, allocatable :: regcoeff_ps_u_rh(:,:) ! ps_u/rh regression coefficient - real :: qrain_th_low, qrain_th_high + !real :: qrain_th_low, qrain_th_high integer :: be_unit, ier, be_rf_unit, be_print_unit, it, idummy @@ -171,11 +171,13 @@ subroutine da_setup_be_regional(xb, be, grid) rewind (be_unit) read (be_unit, iostat=ier) ni, nj, nk + print *, 'ni, nj, nk = ', ni, nj, nk if (ier /= 0) then write (unit=message(1),fmt='(a,i3)') 'Error in reading be.dat, unit= ',be_unit call da_error(__FILE__,__LINE__,message(1:1)) end if read (be_unit) bin_type + print *, 'bin_type = ', bin_type !-----------for interpolating CV5-------------------------------------------------------------- if ( .not. interpolate_stats ) then @@ -222,20 +224,26 @@ subroutine da_setup_be_regional(xb, be, grid) allocate (bin(1:ni,1:nj,1:nk)) allocate (bin2d(1:ni,1:nj)) - if(cloud_cv_options.eq.2)then - read (be_unit)num_bins, num_bins2d - read (be_unit)lat_min, lat_max, binwidth_lat - read (be_unit)hgt_min, hgt_max, binwidth_hgt - read (be_unit)qrain_th_low, qrain_th_high - read (be_unit)bin(1:ni,1:nj,1:nk) - read (be_unit)bin2d(1:ni,1:nj) - else + !if(cloud_cv_options.eq.2)then + ! read (be_unit)num_bins, num_bins2d + ! read (be_unit)lat_min, lat_max, binwidth_lat + ! read (be_unit)hgt_min, hgt_max, binwidth_hgt + ! read (be_unit)qrain_th_low, qrain_th_high + ! read (be_unit)bin(1:ni,1:nj,1:nk) + ! read (be_unit)bin2d(1:ni,1:nj) + !else read (be_unit)lat_min, lat_max, binwidth_lat read (be_unit)hgt_min, hgt_max, binwidth_hgt read (be_unit)num_bins, num_bins2d read (be_unit)bin(1:ni,1:nj,1:nk) read (be_unit)bin2d(1:ni,1:nj) - end if + !end if + + print *, lat_min, lat_max, binwidth_lat + print *, hgt_min, hgt_max, binwidth_hgt + print *, 'num_bins, num_bins2d = ', num_bins, num_bins2d + print *, 'bin = ', bin(1:1,1:1,1:1) + print *, 'bin2d = ', bin2d(1:1,1:1) num_cv_3d_basic = 4 num_cv_3d_extra = 0 @@ -583,14 +591,14 @@ subroutine da_setup_be_regional(xb, be, grid) be % v7 % name = "qrain" be % v8 % name = "qice" be % v9 % name = "qsnow" - be % v10 % name = "qgraupel" + be % v10 % name = "qgraup" be6_eval_glo = 1.0e-6 be7_eval_glo = 1.0e-6 be8_eval_glo = 1.0e-6 be9_eval_glo = 1.0e-6 be10_eval_glo = 1.0e-6 if ( use_cv_w ) then - be % v11 % name = "z-wind" + be % v11 % name = "w" be11_eval_glo = 1.0 end if if ( use_rf ) then @@ -607,9 +615,11 @@ subroutine da_setup_be_regional(xb, be, grid) ! 2.2 Read in the eigenvector and eigenvalue + print *, '-------- reading eigen vector/value -------' do i = 1 , num_cv_3d_basic read (be_unit) variable read (be_unit) nk, num_bins2d + print *, trim(adjustl(variable)), nk, num_bins2d if ( i == 1 ) then allocate (evec_loc(1:nk,1:nk,1:num_bins2d)) allocate (eval_loc(1:nk, 1:num_bins2d)) @@ -677,6 +687,7 @@ subroutine da_setup_be_regional(xb, be, grid) read (be_unit) variable read (be_unit) nk, num_bins2d + print *, trim(adjustl(variable)), nk, num_bins2d select case( trim(adjustl(variable)) ) @@ -728,9 +739,9 @@ subroutine da_setup_be_regional(xb, be, grid) be9_eval_loc(j,1:nk ) = eval_loc(1:nk,b) end do - case ('qgraupel' ) + case ('qgraup' ) be % v10 % name = trim(adjustl(variable)) - read (be_unit) nk, num_bins2d + !read (be_unit) nk, num_bins2d read (be_unit) be10_evec_glo read (be_unit) be10_eval_glo read (be_unit) evec_loc @@ -741,15 +752,9 @@ subroutine da_setup_be_regional(xb, be, grid) be10_eval_loc(j,1:nk ) = eval_loc(1:nk,b) end do - case default; - message(1)=' Read problem in eigen vectors/values in BE file ' - write (unit=message(2),fmt='(A,A)') ' Trying to read Eigenvectors for variable: ',trim(adjustl(variable)) - write (unit=message(3),fmt='(A)') ' Make sure you are using the correct be.dat file for your cv_options setting!' - call da_error(__FILE__,__LINE__,message(1:3)) - end select - - if ( use_cv_w ) then - if ( trim(adjustl(variable)) == 'z-wind' ) then + case ('w' ) + !if ( use_cv_w ) then + ! if ( trim(adjustl(variable)) == 'w' ) then be % v11 % name = trim(adjustl(variable)) read (be_unit) be11_evec_glo read (be_unit) be11_eval_glo @@ -760,10 +765,17 @@ subroutine da_setup_be_regional(xb, be, grid) be11_evec_loc(j,1:nk,1:nk) = evec_loc(1:nk,1:nk,b) be11_eval_loc(j,1:nk ) = eval_loc(1:nk,b) end do - end if - end if + ! end if + !end if - end do ! num_cv_3d_basic+1 - num_cv_3d_basic+num_cv_3d_extra + case default; + message(1)=' Read problem in eigen vectors/values in BE file ' + write (unit=message(2),fmt='(A,A)') ' Trying to read Eigenvectors for variable: ',trim(adjustl(variable)) + write (unit=message(3),fmt='(A)') ' Make sure you are using the correct be.dat file for your cv_options setting!' + call da_error(__FILE__,__LINE__,message(1:3)) + end select + + end do ! num_cv_3d_basic+1 - num_cv_3d_basic+num_cv_3d_extra-1 end if ! cloud_cv_options=2 @@ -774,6 +786,8 @@ subroutine da_setup_be_regional(xb, be, grid) read (be_unit) variable read (be_unit) nk_2d, num_bins2d + print *, trim(adjustl(variable)), nk_2d, num_bins2d + !hcl-why !#ifdef CLOUD_CV ! nk_2d=1 @@ -822,7 +836,7 @@ subroutine da_setup_be_regional(xb, be, grid) end if if ( use_cv_w ) then write (unit=message(5),fmt='(3x,A)') & - 'z-wind control variable is activated' + 'w control variable is activated' end if call da_message(message(1:5)) @@ -857,8 +871,10 @@ subroutine da_setup_be_regional(xb, be, grid) ! 3.2 read in the scale lengths + print *, '----- read lengthscale --------' do i = 1 , num_cv_3d_basic read (be_unit) variable + print *, trim(adjustl(variable)) select case( trim(adjustl(variable)) ) case ('psi', 'u') read(be_unit) rfls1_be @@ -882,6 +898,7 @@ subroutine da_setup_be_regional(xb, be, grid) if ( cloud_cv_options == 2 ) then do i = num_cv_3d_basic+1 , num_cv_3d_basic+num_cv_3d_extra read (be_unit) variable + print *, trim(adjustl(variable)) select case( trim(adjustl(variable)) ) case ('qcloud') read(be_unit) be6_rf_lengthscale @@ -891,24 +908,26 @@ subroutine da_setup_be_regional(xb, be, grid) read(be_unit) be8_rf_lengthscale case ('qsnow') read(be_unit) be9_rf_lengthscale - case ('qgraupel') + case ('qgraup') read(be_unit) be10_rf_lengthscale + case ('w') + !if ( use_cv_w ) then + ! if ( trim(adjustl(variable)) == 'w' ) then + read(be_unit) be11_rf_lengthscale + ! end if + !end if case default; message(1)='Read problem in lengthscales in be.dat' write(message(2),'("Trying to read lengthscales for variable ",I0,": ",A)')i,trim(adjustl(variable)) call da_error(__FILE__,__LINE__,message(1:2)) end select - if ( use_cv_w ) then - if ( trim(adjustl(variable)) == 'z-wind' ) then - read(be_unit) be11_rf_lengthscale - end if - end if end do ! num_cv_3d_basic+1 - num_cv_3d_basic+num_cv_3d_extra end if ! Read in lengthscale of 2D Control variable ps_u read (be_unit) variable + print *, trim(adjustl(variable)) if ( trim(adjustl(variable)) /= 'ps_u' .and. & trim(adjustl(variable)) /= 'ps' ) then message(1)='Read problem in lengthscales in be.dat' diff --git a/var/da/da_setup_structures/da_write_vp.inc b/var/da/da_setup_structures/da_write_vp.inc index a6d2ba1aa8..75bcf4d42f 100644 --- a/var/da/da_setup_structures/da_write_vp.inc +++ b/var/da/da_setup_structures/da_write_vp.inc @@ -5,6 +5,7 @@ subroutine da_write_vp (grid,vp,filename) ! will be interpolated into higher resolution by offline program ! Method: based on da_write_increments.inc ! Author: Zhiquan (Jake) Liu, NCAR/MMM, 2015-09 + ! add cloud and w variables, 2017-07 !---------------------------------------------------------------------- implicit none @@ -22,8 +23,9 @@ subroutine da_write_vp (grid,vp,filename) !real, dimension(1:grid%xb%mix,1:grid%xb%mjy,1:grid%xb%mkz+1) :: wgbuf real, dimension(:,:,:), allocatable :: v1_global, v2_global, & - v3_global, v4_global - real, dimension(:,:,:) , allocatable :: v5_global + v3_global, v4_global, v5_global + real, dimension(:,:,:), allocatable :: v6_global, v7_global, & + v8_global, v9_global, v10_global, v11_global #endif integer :: vp_unit, vp_local_unit @@ -46,6 +48,16 @@ subroutine da_write_vp (grid,vp,filename) allocate ( v3_global (1:ix,1:jy,1:kz)) allocate ( v4_global (1:ix,1:jy,1:kz)) allocate ( v5_global (1:ix,1:jy,1:kz)) + if ( cloud_cv_options >= 2 ) then + allocate ( v6_global (1:ix,1:jy,1:kz)) + allocate ( v7_global (1:ix,1:jy,1:kz)) + allocate ( v8_global (1:ix,1:jy,1:kz)) + allocate ( v9_global (1:ix,1:jy,1:kz)) + allocate ( v10_global (1:ix,1:jy,1:kz)) + end if + if ( use_cv_w ) then + allocate ( v11_global (1:ix,1:jy,1:kz)) + end if call da_patch_to_global(grid, vp % v1, gbuf) ! psi or u if (rootproc) then @@ -57,7 +69,6 @@ subroutine da_write_vp (grid,vp,filename) v2_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) end if - !call da_patch_to_global(grid, grid%xa % t, gbuf) ! t_u or t call da_patch_to_global(grid, vp % v3, gbuf) ! t_u or t if (rootproc) then v3_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) @@ -74,6 +85,40 @@ subroutine da_write_vp (grid,vp,filename) v5_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) end if + if ( cloud_cv_options >= 2 ) then + call da_patch_to_global(grid, vp % v6, gbuf) ! qcloud + if (rootproc) then + v6_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) + end if + + call da_patch_to_global(grid, vp % v7, gbuf) ! qrain + if (rootproc) then + v7_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) + end if + + call da_patch_to_global(grid, vp % v8, gbuf) ! qice + if (rootproc) then + v8_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) + end if + + call da_patch_to_global(grid, vp % v9, gbuf) ! qsnow + if (rootproc) then + v9_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) + end if + + call da_patch_to_global(grid, vp % v10, gbuf) ! qgraupel + if (rootproc) then + v10_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) + end if + end if ! cloud_cv_options + + if ( use_cv_w ) then + call da_patch_to_global(grid, vp % v11, gbuf) ! w + if (rootproc) then + v11_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) + end if + end if + !write(unit=vpfile,fmt='(a,i4.4)') 'vp_',myproc !call da_get_unit(vp_local_unit) !open(unit=vp_local_unit, file=trim(vpfile), form='unformatted') @@ -111,6 +156,12 @@ subroutine da_write_vp (grid,vp,filename) write (unit=vp_unit) v1_global, v2_global, & v3_global, v4_global, v5_global + if ( cloud_cv_options >= 2 ) then + write (unit=vp_unit) v6_global, v7_global, & + v8_global, v9_global, v10_global + end if + if ( use_cv_w ) write (unit=vp_unit) v11_global + close(vp_unit) call da_free_unit(vp_unit) @@ -122,6 +173,14 @@ subroutine da_write_vp (grid,vp,filename) vp%v3(1:ix,1:jy,1:kz), & vp%v4(1:ix,1:jy,1:kz), & vp%v5(1:ix,1:jy,1) + if ( cloud_cv_options >= 2 ) then + write (unit=vp_unit) vp%v6(1:ix,1:jy,1:kz), & + vp%v7(1:ix,1:jy,1:kz), & + vp%v8(1:ix,1:jy,1:kz), & + vp%v9(1:ix,1:jy,1:kz), & + vp%v10(1:ix,1:jy,1:kz) + end if + if ( use_cv_w ) write (unit=vp_unit) vp%v11(1:ix,1:jy,1:kz) close(vp_unit) call da_free_unit(vp_unit) diff --git a/var/da/da_vtox_transforms/da_transform_vptox_inv.inc b/var/da/da_vtox_transforms/da_transform_vptox_inv.inc index 0727111762..93649b675e 100644 --- a/var/da/da_vtox_transforms/da_transform_vptox_inv.inc +++ b/var/da/da_vtox_transforms/da_transform_vptox_inv.inc @@ -24,9 +24,10 @@ subroutine da_transform_vptox_inv(grid, vp, be, ep) ! [1] Add flow-dependent increments in control variable space (vp): !--------------------------------------------------------------------------- - if (be % ne > 0 .and. alphacv_method == alphacv_method_vp) then - call da_add_flow_dependence_vp(be % ne, ep, vp, its,ite, jts,jte, kts,kte) - end if + !if (be % ne > 0 .and. alphacv_method == alphacv_method_vp) then + ! call da_add_flow_dependence_vp(be % ne, ep, vp, its,ite, jts,jte, kts,kte) + ! call da_add_flow_dependence_vp_inv !!! ?? + !end if !-------------------------------------------------------------------------- ! [2] Impose statistical balance constraints: @@ -151,182 +152,7 @@ subroutine da_transform_vptox_inv(grid, vp, be, ep) end if end do - !$OMP END PARALLEL DO - !-------------------------------------------------------------------------- - ! [3] Transform to model variable space: - !-------------------------------------------------------------------------- - -!!#ifdef A2C -! if ((fg_format==fg_format_wrf_arw_regional .or. & -! fg_format==fg_format_wrf_arw_global ) .and. ide == ipe ) then -! ipe = ipe + 1 -! ide = ide + 1 -! end if -! -! if ((fg_format==fg_format_wrf_arw_regional .or. & -! fg_format==fg_format_wrf_arw_global ) .and. jde == jpe ) then -! jpe = jpe + 1 -! jde = jde + 1 -! end if -!!#endif -!!#ifdef DM_PARALLEL -!!#include "HALO_PSICHI_UV.inc" -!!#endif - -!!#ifdef A2C -!! if ((fg_format==fg_format_wrf_arw_regional .or. & -! fg_format==fg_format_wrf_arw_global ) .and. ide == ipe ) then -! ipe = ipe - 1 -! ide = ide - 1 -! end if - -! if ((fg_format==fg_format_wrf_arw_regional .or. & -! fg_format==fg_format_wrf_arw_global ) .and. jde == jpe ) then -! jpe = jpe - 1 -! jde = jde - 1 -! end if -!#endif - - ! Psi and chi to u and v: -! if ( cv_options == 5 .or. cv_options == 6 ) then -! call da_psichi_to_uv(vp % v1, vp % v2, grid%xb % coefx, & -! grid%xb % coefy , grid%xa % u, grid%xa % v) -! else if ( cv_options == 7 ) then -! grid%xa%u = vp%v1 -! grid%xa%v = vp%v2 -! end if - - if ( (use_radarobs .and. use_radar_rf) .or. (use_rad .and. crtm_cloud).or. & - (use_radarobs .and. use_radar_rhv) .or. (use_radarobs .and. use_radar_rqv) .or. cloud_cv_options .ge. 2 .or. & - (grid%pseudo_var(1:1).eq.'q' .and. grid%pseudo_var(2:2).ne.' ') .or. & - (grid%pseudo_var(1:1).eq.'Q' .and. grid%pseudo_var(2:2).ne.' ') ) then - -! if ( cloud_cv_options == 1 .and. use_3dvar_phy) then -! ! Pseudo RH --> Total water mixing ratio: -! !$OMP PARALLEL DO & -! !$OMP PRIVATE ( ij, i, j, k ) -! do ij = 1 , grid%num_tiles -! do k = kts, kte -! do j = grid%j_start(ij), grid%j_end(ij) -! do i = its, ite -! grid%xa % qt(i,j,k) = vp%v4(i,j,k) * grid%xb%qs(i,j,k) -! enddo -! enddo -! enddo -! enddo -! !$OMP END PARALLEL DO -! end if -! if ( cloud_cv_options .ge. 2 ) then -! ! Pseudo RH --> Water vapor mixing ratio: -! !$OMP PARALLEL DO & -! !$OMP PRIVATE ( ij, i, j, k ) -! do ij = 1 , grid%num_tiles -! do k = kts, kte -! do j = grid%j_start(ij), grid%j_end(ij) -! do i = its, ite -! grid%xa % q(i,j,k) = vp%v4(i,j,k) * grid%xb%qs(i,j,k) -! enddo -! enddo -! enddo -! enddo -! !$OMP END PARALLEL DO -#ifdef CLOUD_CV - !qcloud - !$OMP PARALLEL DO & - !$OMP PRIVATE ( ij, i, j, k ) - do ij = 1 , grid%num_tiles - do k = kts, kte - do j = grid%j_start(ij), grid%j_end(ij) - do i = its, ite - vp%v6(i,j,k) = grid%xa % qcw(i,j,k) - enddo - enddo - enddo - enddo - !$OMP END PARALLEL DO - !qrain - !$OMP PARALLEL DO & - !$OMP PRIVATE ( ij, i, j, k ) - do ij = 1 , grid%num_tiles - do k = kts, kte - do j = grid%j_start(ij), grid%j_end(ij) - do i = its, ite - vp%v7(i,j,k) = grid%xa % qrn(i,j,k) - enddo - enddo - enddo - enddo - !$OMP END PARALLEL DO - !qice - !$OMP PARALLEL DO & - !$OMP PRIVATE ( ij, i, j, k ) - do ij = 1 , grid%num_tiles - do k = kts, kte - do j = grid%j_start(ij), grid%j_end(ij) - do i = its, ite - vp%v8(i,j,k) = grid%xa % qci(i,j,k) - enddo - enddo - enddo - enddo - !$OMP END PARALLEL DO - !qsnow - !$OMP PARALLEL DO & - !$OMP PRIVATE ( ij, i, j, k ) - do ij = 1 , grid%num_tiles - do k = kts, kte - do j = grid%j_start(ij), grid%j_end(ij) - do i = its, ite - vp%v9(i,j,k) = grid%xa % qsn(i,j,k) - enddo - enddo - enddo - enddo - !$OMP END PARALLEL DO - !qgraupel - !$OMP PARALLEL DO & - !$OMP PRIVATE ( ij, i, j, k ) - do ij = 1 , grid%num_tiles - do k = kts, kte - do j = grid%j_start(ij), grid%j_end(ij) - do i = its, ite - vp%v10(i,j,k) = grid%xa % qgr(i,j,k) - enddo - enddo - enddo - enddo - !$OMP END PARALLEL DO - !vertical velocity - !$OMP PARALLEL DO & - !$OMP PRIVATE ( ij, i, j, k ) - do ij = 1 , grid%num_tiles - do k = kts, kte - do j = grid%j_start(ij), grid%j_end(ij) - do i = its, ite - vp%v11(i,j,k) = grid%xa % w(i,j,k) - enddo - enddo - enddo - enddo - !$OMP END PARALLEL DO -#endif -! end if - !else ! no rf or cloud radiance - ! ! Pseudo RH --> Water vapor mixing ratio: - ! !$OMP PARALLEL DO & - ! !$OMP PRIVATE ( ij, i, j, k ) - ! do ij = 1 , grid%num_tiles - ! do k = kts, kte - ! do j = grid%j_start(ij), grid%j_end(ij) - ! do i = its, ite - ! grid%xa % q(i,j,k) = vp%v4(i,j,k) * grid%xb%qs(i,j,k) - ! enddo - ! enddo - ! enddo - ! enddo - ! !$OMP END PARALLEL DO - end if ! RF or Radiance !--------------------------------------------------------------------------- ! [4] Add flow-dependent increments in model space (grid%xa): !--------------------------------------------------------------------------- diff --git a/var/da/da_vtox_transforms/da_transform_vtovv_inv.inc b/var/da/da_vtox_transforms/da_transform_vtovv_inv.inc index 8bb438a55f..cf047eb450 100644 --- a/var/da/da_vtox_transforms/da_transform_vtovv_inv.inc +++ b/var/da/da_vtox_transforms/da_transform_vtovv_inv.inc @@ -109,107 +109,87 @@ subroutine da_transform_vtovv_inv(grid, cv_size, be, cv, vv) endif !s(1)=s(3)+1 -#ifdef CLOUD_CV - ! [2.6] Transform 6th control variable - if (cloud_cv_options == 3)then - scaling = .true. - else - scaling = .false. - endif - mz = be % v6 % mz - if( use_rf .and. mz > 0 .and. len_scaling6(1) /= 0.0) then - if(cloud_cv_options == 1)then - vv % v6 = 0.0 - elseif(cloud_cv_options == 2)then - call da_transform_through_rf_inv(grid, mz, be % v6 % rf_alpha, be % v6 % val, vv % v6) - elseif(cloud_cv_options == 3)then - call da_transform_through_rf_inv(grid, mz, be % v6 % rf_alpha, be % v6 % val, vv % v6, scaling) -! call da_transform_through_rf2_inv(grid, mz, be % v6 % rf_alpha, be % v6 % val, vv % v6) - endif - elseif( .not. use_rf ) then - call da_error(__FILE__,__LINE__,(/"no da_transform_through_wavelet_inv for v6"/)) - endif - - ! [2.7] Transform 7th control variable - - mz = be % v7 % mz - if( use_rf .and. mz > 0 .and. len_scaling7(1) /= 0.0) then - if(cloud_cv_options == 1)then - vv % v7 = 0.0 - elseif(cloud_cv_options == 2)then - call da_transform_through_rf_inv(grid, mz, be % v7 % rf_alpha, be % v7 % val, vv % v7) - elseif(cloud_cv_options == 3)then - call da_transform_through_rf_inv(grid, mz, be % v7 % rf_alpha, be % v7 % val, vv % v7, scaling) -! call da_transform_through_rf2_inv(grid, mz, be % v7 % rf_alpha, be % v7 % val, vv % v7) - endif - elseif( .not. use_rf ) then - call da_error(__FILE__,__LINE__,(/"no da_transform_through_wavelet_inv for v7"/)) - endif - - ! [2.8] Transform 8th control variable - - mz = be % v8 % mz - if( use_rf .and. mz > 0 .and. len_scaling8(1) /= 0.0) then - if(cloud_cv_options == 1)then - vv % v8 = 0.0 - elseif(cloud_cv_options == 2)then - call da_transform_through_rf_inv(grid, mz, be % v8 % rf_alpha, be % v8 % val, vv % v8) - elseif(cloud_cv_options == 3)then - call da_transform_through_rf_inv(grid, mz, be % v8 % rf_alpha, be % v8 % val, vv % v8, scaling) -! call da_transform_through_rf2_inv(grid, mz, be % v8 % rf_alpha, be % v8 % val, vv % v8) - endif - elseif( .not. use_rf ) then - call da_error(__FILE__,__LINE__,(/"no da_transform_through_wavelet_inv for v8"/)) - endif - - ! [2.9] Transform 9th control variable - - mz = be % v9 % mz - if( use_rf .and. mz > 0 .and. len_scaling9(1) /= 0.0) then - if(cloud_cv_options == 1)then - vv % v9 = 0.0 - elseif(cloud_cv_options == 2)then - call da_transform_through_rf_inv(grid, mz, be % v9 % rf_alpha, be % v9 % val, vv % v9) - elseif(cloud_cv_options == 3)then - call da_transform_through_rf_inv(grid, mz, be % v9 % rf_alpha, be % v9 % val, vv % v9, scaling) - endif - elseif( .not. use_rf ) then - call da_error(__FILE__,__LINE__,(/"no da_transform_through_wavelet_inv for v9"/)) - endif - - ! [2.10] Transform 10th control variable - - mz = be % v10 % mz - if( use_rf .and. mz > 0 .and. len_scaling10(1) /= 0.0) then - if(cloud_cv_options == 1)then - vv % v10 = 0.0 - elseif(cloud_cv_options == 2)then - call da_transform_through_rf_inv(grid, mz, be % v10 % rf_alpha, be % v10 % val, vv % v10) - elseif(cloud_cv_options == 3)then - call da_transform_through_rf_inv(grid, mz, be % v10 % rf_alpha, be % v10 % val, vv % v10, scaling) - endif - elseif( .not. use_rf ) then - call da_error(__FILE__,__LINE__,(/"no da_transform_through_wavelet_inv for v10"/)) - endif - - ! [2.11] Transform 11th control variable - - mz = be % v11 % mz - if( use_rf .and. mz > 0 .and. len_scaling11(1) /= 0.0) then - if(cloud_cv_options == 1)then + if ( use_rf .and. cloud_cv_options <= 1 ) then + vv % v6 = 0.0 + vv % v7 = 0.0 + vv % v8 = 0.0 + vv % v9 = 0.0 + vv % v10 = 0.0 + vv % v11 = 0.0 + end if + + + ! [2.6] Transform 6th-10th cloud control variables + + if ( use_rf .and. cloud_cv_options >= 2 ) then + select case ( cloud_cv_options ) + case ( 2 ) +!hcl-check array index of len_scaling + mz = be % v6 % mz + if ( mz > 0 .and. len_scaling6(1) > 0.0 ) then + call da_transform_through_rf_inv(grid, mz, be % v6 % rf_alpha, be % v6 % val, vv % v6) + end if + mz = be % v7 % mz + if ( mz > 0 .and. len_scaling7(1) > 0.0 ) then + call da_transform_through_rf_inv(grid, mz, be % v7 % rf_alpha, be % v7 % val, vv % v7) + end if + mz = be % v8 % mz + if ( mz > 0 .and. len_scaling8(1) > 0.0 ) then + call da_transform_through_rf_inv(grid, mz, be % v8 % rf_alpha, be % v8 % val, vv % v8) + end if + mz = be % v9 % mz + if ( mz > 0 .and. len_scaling9(1) > 0.0 ) then + call da_transform_through_rf_inv(grid, mz, be % v9 % rf_alpha, be % v9 % val, vv % v9) + end if + mz = be % v10 % mz + if ( mz > 0 .and. len_scaling10(1) > 0.0 ) then + call da_transform_through_rf_inv(grid, mz, be % v10 % rf_alpha, be % v10 % val, vv % v10) + end if + case ( 3 ) + scaling = .true. + mz = be % v6 % mz + if ( mz > 0 .and. len_scaling6(1) > 0.0 ) then + call da_transform_through_rf_inv(grid, mz, be % v6 % rf_alpha, be % v6 % val, vv % v6, scaling) + end if + mz = be % v7 % mz + if ( mz > 0 .and. len_scaling7(1) > 0.0 ) then + call da_transform_through_rf_inv(grid, mz, be % v7 % rf_alpha, be % v7 % val, vv % v7, scaling) + end if + mz = be % v8 % mz + if ( mz > 0 .and. len_scaling8(1) > 0.0 ) then + call da_transform_through_rf_inv(grid, mz, be % v8 % rf_alpha, be % v8 % val, vv % v8, scaling) + end if + mz = be % v9 % mz + if ( mz > 0 .and. len_scaling9(1) > 0.0 ) then + call da_transform_through_rf_inv(grid, mz, be % v9 % rf_alpha, be % v9 % val, vv % v9, scaling) + end if + mz = be % v10 % mz + if ( mz > 0 .and. len_scaling10(1) > 0.0 ) then + call da_transform_through_rf_inv(grid, mz, be % v10 % rf_alpha, be % v10 % val, vv % v10, scaling) + end if + end select + end if + + ! [2.7] Transform w control variable + + if ( use_rf ) then + if ( .not. use_cv_w ) then vv % v11 = 0.0 - elseif(cloud_cv_options == 2)then - call da_transform_through_rf_inv(grid, mz, be % v11 % rf_alpha, be % v11 % val, vv % v11) - elseif(cloud_cv_options == 3)then - call da_transform_through_rf_inv(grid, mz, be % v11 % rf_alpha, be % v11 % val, vv % v11, scaling) - endif - elseif( .not. use_rf ) then - call da_error(__FILE__,__LINE__,(/"no da_transform_through_wavelet_inv for v11"/)) - endif - -#endif - - ! [2.12] Transform alpha control variable + else + mz = be % v11 % mz + if ( mz > 0 .and. len_scaling11(1) > 0.0 ) then + if ( cloud_cv_options == 2 ) then + call da_transform_through_rf_inv(grid, mz, be % v11 % rf_alpha, be % v11 % val, vv % v11) + else if ( cloud_cv_options == 3 ) then + scaling = .true. + call da_transform_through_rf_inv(grid, mz, be % v11 % rf_alpha, be % v11 % val, vv % v11, scaling) + end if + end if + end if + end if + + + ! [2.8] Transform alpha control variable ne = be % ne if (ne > 0) then diff --git a/var/da/da_vtox_transforms/da_transform_vtox_inv.inc b/var/da/da_vtox_transforms/da_transform_vtox_inv.inc index 2d96a40452..56c56c2433 100644 --- a/var/da/da_vtox_transforms/da_transform_vtox_inv.inc +++ b/var/da/da_vtox_transforms/da_transform_vtox_inv.inc @@ -50,14 +50,14 @@ subroutine da_transform_vtox_inv(grid, cv_size, xbx, be, ep, cv, vv, vp) vv % v3(its:ite,jts:jte,kts:kte) = vp % v3(its:ite,jts:jte,kts:kte) vv % v4(its:ite,jts:jte,kts:kte) = vp % v4(its:ite,jts:jte,kts:kte) vv % v5(its:ite,jts:jte,kts:kte) = vp % v5(its:ite,jts:jte,kts:kte) -#ifdef CLOUD_CV - vv % v6(its:ite,jts:jte,kts:kte) = vp % v6(its:ite,jts:jte,kts:kte) - vv % v7(its:ite,jts:jte,kts:kte) = vp % v7(its:ite,jts:jte,kts:kte) - vv % v8(its:ite,jts:jte,kts:kte) = vp % v8(its:ite,jts:jte,kts:kte) - vv % v9(its:ite,jts:jte,kts:kte) = vp % v9(its:ite,jts:jte,kts:kte) - vv % v10(its:ite,jts:jte,kts:kte) = vp % v10(its:ite,jts:jte,kts:kte) - vv % v11(its:ite,jts:jte,kts:kte) = vp % v11(its:ite,jts:jte,kts:kte) -#endif + if ( cloud_cv_options >= 2 ) then + vv % v6(its:ite,jts:jte,kts:kte) = vp % v6(its:ite,jts:jte,kts:kte) + vv % v7(its:ite,jts:jte,kts:kte) = vp % v7(its:ite,jts:jte,kts:kte) + vv % v8(its:ite,jts:jte,kts:kte) = vp % v8(its:ite,jts:jte,kts:kte) + vv % v9(its:ite,jts:jte,kts:kte) = vp % v9(its:ite,jts:jte,kts:kte) + vv % v10(its:ite,jts:jte,kts:kte) = vp % v10(its:ite,jts:jte,kts:kte) + end if + if ( use_cv_w ) vv % v11(its:ite,jts:jte,kts:kte) = vp % v11(its:ite,jts:jte,kts:kte) if (be % ne > 0) then ! vv % alpha(its:ite,jts:jte,kts:kte,1:be%ne) = vp%alpha(its:ite,jts:jte,kts:kte,1:be%ne) vv % alpha(its_int:ite_int,jts_int:jte_int,kts_int:kte_int,1:be%ne) = & diff --git a/var/mri4dvar/Makefile b/var/mri4dvar/Makefile new file mode 100644 index 0000000000..77cd279fa7 --- /dev/null +++ b/var/mri4dvar/Makefile @@ -0,0 +1,42 @@ +all: da_thin.exe da_bilin.exe da_bdy.exe da_vp_bilin.exe da_vp_split.exe + +include ../../configure.wrf +FCOPTION=$(FCFLAGS) $(PROMOTION) $(FCSUFFIX) +CCOPTION=$(CFLAGS) +LIB_EXTERNAL=-L${NETCDFPATH}/lib -lnetcdf -lnetcdff + +da_thin.exe: da_thin.o + $(SFC) -o $@ da_thin.o ${FCOPTION} $(LIB_EXTERNAL) + +da_thin.o: da_thin.f90 + $(SFC) -c ${FCOPTION} -I$(NETCDFPATH)/include $< -o $@ + +da_bilin.exe: da_bilin.o + $(SFC) -o $@ ${FCOPTION} da_bilin.o $(LIB_EXTERNAL) + +da_bilin.o: da_bilin.f90 + $(SFC) -c ${FCOPTION} -I$(NETCDFPATH)/include $< -o $@ + +da_vp_bilin.exe: da_vp_bilin.o + $(SFC) -o $@ ${FCOPTION} da_vp_bilin.o + +da_vp_bilin.o: da_vp_bilin.f90 + $(SFC) -c ${FCOPTION} $< -o $@ + +da_bdy.exe: da_bdy.o + $(SFC) -o $@ ${FCOPTION} da_bdy.o $(LIB_EXTERNAL) + +da_bdy.o: da_bdy.f90 + $(SFC) -c ${FCOPTION} -I$(NETCDFPATH)/include $< -o $@ + +task_for_point.o: task_for_point.c + $(DM_CC) -c ${CCOPTION} $< -o $@ + +da_vp_split.exe: da_vp_split.o task_for_point.o + $(DM_FC) -o $@ ${FCOPTION} da_vp_split.o task_for_point.o + +da_vp_split.o: da_vp_split.f90 + $(DM_FC) -c ${FCOPTION} $< -o $@ + +clean: + rm -rf *.o da_thin.exe da_bilin.exe da_bdy.exe da_vp_bilin.exe da_vp_split.exe diff --git a/var/mri4dvar/README.Multi_inc b/var/mri4dvar/README.Multi_inc new file mode 100644 index 0000000000..2efac074db --- /dev/null +++ b/var/mri4dvar/README.Multi_inc @@ -0,0 +1,86 @@ +1. How to build the 'tools' + +Set 'NETCDF' to your netcdf path and 'SFC' to the same Fortran 90 compiler +which used to build the NETCDF lib + + For csh, tcsh + setenv NETCDF /your/netcdf/path + setenv SFC pgf90 + For bash, ksh + export NETCDF=/your/netcdf/path + export SFC=pgf90 + +then run 'make' to build the tools + +notes: It depends on how NETCDF was build, '-lcurl' may need to be removed +or the path of libcurl need to be specified. + +2. Domain size requirment + +Only WRF input files at high resolution are required to run multi-inc 4DVAR. +WRF input files at low reselution are thinned from those at high resolution. +This requires that grid number at high/low reselutions to satify: + ( n - 1 ) mod m = 0 +where n is the grid number of high resolution in x or y direction, m is the +grid number of low resolution in x or y direction. + +The ratio of the high/low resolution must be odd, the default ration is 1:3. + +3. First guess files + +Multi-incremental 4DVAR run needs 2 time-level first guess files (fg & fg02), + +fg is at the analysis time + +fg02 is at the end of the analysis time window, or the 2nd time level of boundary +if boundary interval is less then analysis time window + +4. BE +Multi-incremental 4DVAR run only needs the low resolution BE + +5. How the wrapper script works + +What does this wrapper script CAN NOT DO? + + This wrapper script DOES NOT DO these + + link/copy any run-time files which needed by 4DVAR run + generate/prepare namelist.input for 4DVAR run + update boundary condition + +What does this wrapper CAN DO? + + This wrapper script DOES these + + generate low resolution fg & bdy by using the high resolution fg & fg02 + switch da_wrfvar.exe between stage1 & stage2 + amend namelist.input for appropriate stage + interpolate low resolution incremental to high resolution + +This wrapper script supposes these are done + +1) EVERYTHING IS OK FOR A STANDARD 4DVAR RUN under the run direcotry, +such as be.dat, namelist.input, *.tbl, fg, fg02, wrfbdy_d01, da_wrfvar.exe, +da_update_bc, ob*, etc. + +2) Environment variables 'MULTI_INC_TOOLS' points to the location of these +tools + +da_bdy.exe +da_bilin.exe +da_thin.exe + +3) Environment variables 'RUN_CMD' is already set to specific job submit command +instead of the default "mpirun -np 16 " + +4) namelist.input is already for a standard 4DVAR RUN (in high resolution) + +If everything is ready to go, just link/copy the wrapper script to the run +directory, call this wrapper script instead of da_wrfvar.exe for the +Multi-incremental 4DVAR run. + +6. Platform + +All the commands involved by this script are GNU/Linux commands on CentOS box. +If involved this script other than CentOS, commands may not run as your expect, +double check it before using. diff --git a/var/mri4dvar/da_bdy.f90 b/var/mri4dvar/da_bdy.f90 new file mode 100644 index 0000000000..8567d04e2b --- /dev/null +++ b/var/mri4dvar/da_bdy.f90 @@ -0,0 +1,681 @@ +program da_bdy + +!---------------------------------------------------------------------- +! Purpose: Generates boundary file by using wrfinput +! +! Input : fg -- first time level wrfinput generated by real +! fg02 -- second time level wrfinput generated by real +! wrfbdy_ref -- reference boundary file generated by real +! +! Output : wrfbdy_out -- the output boundary file +! +! Notes : 1. variable name and attributes, dimension name, bdy_width +! come from wrfbdy. +! 2. domain size and time come from fg +! 3. boundary and tendency are calculated by using fg & fg02 +! 4. the output boundary file only contain the 1st time level +! +! jliu@ucar.edu , 2011-12-15 +!---------------------------------------------------------------------- + + use netcdf + + implicit none + + integer :: i, n, offset, bdyfrq, domainsize, fg_jd, fg02_jd + + integer :: ncid, ncidfg, ncidfg02, ncidwrfbdy, ncidvarbdy, varid, varid_out, status + integer :: nDims, nVars, nGlobalAtts, numsAtts + integer :: dLen, attLen, xtype, unlimDimID + integer :: bdy_width, varbdy_dimID, wrfbdy_dimID, fg_dimID, vTimes_ID, MSF_ID + integer :: MU_fgID, MU_fg02ID, MUB_fgID, MUB_fg02ID, fg_varid, fg02_varid, tenid + + integer, dimension(4) :: dsizes + integer, dimension(4), target :: start_u, start_v, start_mass + integer, dimension(4) :: cnt_4d, map_4d + integer, dimension(3) :: start_3d, cnt_3d, map_3d + integer, dimension(3), target :: start_msfu, start_msfv, cnt_msfu, cnt_msfv, map_msfu, map_msfv + integer, dimension(:), pointer :: start_msf, cnt_msf, map_msf, start_4d + + integer :: south_north, south_north_stag + integer :: west_east, west_east_stag + integer :: bottom_top, bottom_top_stag + + integer, dimension(nf90_max_var_dims) :: vDimIDs + integer, dimension(:), allocatable :: vdimsizes + integer, dimension(:,:,:,:), allocatable :: iVar + + real, dimension(:,:,:,:), allocatable :: fVar_fg, fVar_fg02, Tend + real, dimension(:,:,:), allocatable , target :: MU_fg, MU_fg02, MUB_fg, MUB_fg02, MSF + + real, dimension(:,:,:), pointer :: MU_fgptr, MU_fg02ptr, MUB_fgptr, MUB_fg02ptr, MSF_ptr + + character (len = 19), dimension(:), allocatable :: times + character (len = 19) :: fg_time, fg02_time + character (len = 5) :: tenname + character (len = NF90_MAX_NAME) :: vNam, dNam, attNam + character (len = 9) :: MSF_NAME + character (len = 255) :: err_msg="" + character (len=8) :: i_char + character (len=255) :: arg = "" + character (len=255) :: appname ="" + character (len=255) :: fg = "fg" + character (len=255) :: fg02 = "fg02" + character (len=255) :: wrfbdy = "wrfbdy_ref" + character (len=255) :: varbdy = "wrfbdy_out" + + logical :: reverse, couple, stag + + integer iargc + + call getarg(0, appname) + n=index(appname, '/', BACK=.true.) + appname = trim(appname(n+1:)) + + DO i = 1, iargc(), 2 + call getarg(i, arg) + select case ( trim(arg) ) + case ("-fg") + call getarg(i+1, arg) + fg=trim(arg) + case ("-fg02") + call getarg(i+1, arg) + fg02=trim(arg) + case ("-bdy") + call getarg(i+1, arg) + wrfbdy=trim(arg) + case ("-o") + call getarg(i+1, arg) + varbdy=trim(arg) + case default + Write(*,*) "Usage : "//trim(appname)//" [-fg filename] [-fg02 filename] [-bdy filename] [-o outputfile] [-h]" + Write(*,*) " -fg Optional, 1st time levle first guess file, default - fg" + Write(*,*) " -fg02 Optional, 2nd time levle first guess file, default - fg02" + Write(*,*) " -bdy Optional, reference boundary file comes from real, default - wrfbdy_ref" + Write(*,*) " -o Optional, output boundary file, default - varbdy_out" + Write(*,*) " -h Show this usage" + call exit(0) + end select + END DO + + + status = nf90_open(fg, NF90_NOWRITE, ncidfg) + if ( status /= nf90_noerr ) then + err_msg="Failed to open "//trim(fg) + call nf90_handle_err(status, err_msg) + endif + + status = nf90_open(fg02, NF90_NOWRITE, ncidfg02) + if ( status /= nf90_noerr ) then + err_msg="Failed to open "//trim(fg02) + call nf90_handle_err(status, err_msg) + endif + + status = nf90_inq_varid(ncidfg, "Times", vTimes_ID ) + if ( status /= nf90_noerr ) then + err_msg="Please make sure fg has a vaild Times variable" + call nf90_handle_err(status, err_msg) + endif + + status = nf90_get_var(ncidfg, vTimes_ID, fg_time) + if ( status /= nf90_noerr ) then + err_msg="Please make sure fg has a vaild Time value" + call nf90_handle_err(status, err_msg) + endif + + status = nf90_inq_varid(ncidfg02, "Times", vTimes_ID ) + if ( status /= nf90_noerr ) then + err_msg="Please make sure fg02 has a vaild Times variable" + call nf90_handle_err(status, err_msg) + endif + + status = nf90_get_var(ncidfg02, vTimes_ID, fg02_time) + if ( status /= nf90_noerr ) then + err_msg="Please make sure fg02 has a vaild Time value" + call nf90_handle_err(status, err_msg) + endif + + status = nf90_open(wrfbdy, NF90_NOWRITE, ncidwrfbdy) + if ( status /= nf90_noerr ) then + err_msg="Failed to open "//trim(wrfbdy) + call nf90_handle_err(status, err_msg) + endif + + status = nf90_create(varbdy, NF90_CLOBBER, ncidvarbdy) + if ( status /= nf90_noerr ) then + err_msg="Please make sure have write access" + call nf90_handle_err(status, err_msg) + endif + + bdyfrq = datediff(fg_time, fg02_time) + + select case ( bdyfrq ) + case ( 0 ) + bdyfrq = 1 + case ( : -1 ) + Write (*,*) "***WARNNING : time levle of fg is LATER then fg02's.***" + end select + + write(i_char, '(i8)') bdyfrq + + Write(*,*) " Input :" + Write(*,*) " fg "//fg_time + Write(*,*) " fg02 "//fg02_time + Write(*,*) " Reference bdy "//trim(wrfbdy) + Write(*,*) "Output : " + Write(*,*) " wrfbdy_out "//fg_time + Write(*,*) " bdyfrq ",adjustl(i_char) + + status = nf90_inquire(ncidfg, nAttributes=nGlobalAtts) + do i=1, nGlobalAtts + status = nf90_inq_attname(ncidfg, NF90_GLOBAL, i, attNam) + status = nf90_copy_att(ncidfg, NF90_GLOBAL, attNam, ncidvarbdy, NF90_GLOBAL) + end do + + status = nf90_inquire(ncidwrfbdy, nDims, nVars, nGlobalAtts, unlimDimID) + if ( status /= nf90_noerr ) then + err_msg="Please make sure have a valid wrf boundary file" + call nf90_handle_err(status, err_msg) + endif + + allocate (vdimsizes(nDims), stat=status) + + do i=1, nDims + + status = nf90_inquire_dimension(ncidwrfbdy, i, name=dNam, len = dLen) + + vdimsizes(i) = dLen + select case (trim(dNam)) + case ("south_north") + status = nf90_inq_dimid(ncidfg, dNam, fg_dimID) + status = nf90_inquire_dimension(ncidfg, fg_dimID, len=dLen) + vdimsizes(i) = dLen + south_north = vdimsizes(i) + case ("west_east") + status = nf90_inq_dimid(ncidfg, dNam, fg_dimID) + status = nf90_inquire_dimension(ncidfg, fg_dimID, len=dLen) + vdimsizes(i) = dLen + west_east = vdimsizes(i) + case ("south_north_stag") + status = nf90_inq_dimid(ncidfg, dNam, fg_dimID) + status = nf90_inquire_dimension(ncidfg, fg_dimID, len=dLen) + vdimsizes(i) = dLen + south_north_stag = vdimsizes(i) + case ("west_east_stag") + status = nf90_inq_dimid(ncidfg, dNam, fg_dimID) + status = nf90_inquire_dimension(ncidfg, fg_dimID, len=dLen) + vdimsizes(i) = dLen + west_east_stag = vdimsizes(i) + case ("bottom_top") + status = nf90_inq_dimid(ncidfg, dNam, fg_dimID) + status = nf90_inquire_dimension(ncidfg, fg_dimID, len=dLen) + vdimsizes(i) = dLen + bottom_top = vdimsizes(i) + case ("bottom_top_stag") + status = nf90_inq_dimid(ncidfg, dNam, fg_dimID) + status = nf90_inquire_dimension(ncidfg, fg_dimID, len=dLen) + vdimsizes(i) = dLen + bottom_top_stag = vdimsizes(i) + case ("Time") + vdimsizes(i) = 1 + allocate(times(vdimsizes(i)), stat=status) + case ("bdy_width") + bdy_width = dLen + end select + + if ( i == unlimDimID ) dLen = NF90_UNLIMITED + + status = nf90_def_dim(ncidvarbdy, dNam, dLen, varbdy_dimID) + + end do + + status = nf90_inq_varid(ncidfg , "MU" , MU_fgID ) + status = nf90_inq_varid(ncidfg , "MUB", MUB_fgID ) + status = nf90_inq_varid(ncidfg02, "MU" , MU_fg02ID ) + status = nf90_inq_varid(ncidfg02, "MUB", MUB_fg02ID) + + status = nf90_inq_varid(ncidfg, "Times", vTimes_ID ) + + do varid=1, nVars + + status = nf90_inquire_variable(ncidwrfbdy,varid,name=vNam,xtype=xtype,ndims=nDims,dimids=vDimIDs,natts=numsAtts) + status = nf90_def_var(ncidvarbdy, trim(vNam), xtype, vDimIDs(1:nDims), varid_out) + if ( status /= nf90_noerr ) then + err_msg="Failed to define variable : "//trim(vNam) + call nf90_handle_err(status, err_msg) + endif + + do i=1, numsAtts + status = nf90_inq_attname(ncidwrfbdy, varid, i, attNam) + status = nf90_copy_att(ncidwrfbdy, varid, trim(attNam), ncidvarbdy, varid_out) + if ( status /= nf90_noerr ) then + err_msg="Failed to copy att : "//trim(attNam) + call nf90_handle_err(status, err_msg) + endif + end do + + end do + + status = nf90_enddef(ncidvarbdy) + + do varid=1, nVars + + status = nf90_inquire_variable(ncidwrfbdy,varid,name=vNam,xtype=xtype,ndims=nDims,dimids=vDimIDs) + if ( status /= nf90_noerr ) then + err_msg="Failed to inquire varialbe '"//trim(vNam)//"' for wrfbdy" + call nf90_handle_err(status, err_msg) + endif + + dsizes = 1 + do i = 1 , nDims + dsizes(i) = vdimsizes(vDimIDs(i)) + end do + + offset = index(vNam, '_', BACK=.True.) + if ( offset <= 0 ) offset = Len(Trim(vNam)) + + ! fg + ! U (west_east_stag, south_north, bottom_top, time) + ! V (west_east, south_north_stag, bottom_top, time) + ! T, QVAPOR (west_east, south_north, bottom_top, time) + ! PH (west_east, south_north, bottom_top_stag, time) + ! MU (west_east, south_north, time) + ! MAPFAC_U (west_east_stag, south_north, time) + ! MAPFAC_V (west_east, south_north_stag, time) + ! bdy + ! west & east + ! U (south_north, bottom_top, bdy_width, time) + ! V (south_north_stag, bottom_top, bdy_width, time) + ! T, QVAPOR (south_north, bottom_top, bdy_width, time) + ! PH (south_north, bottom_top_stag, bdy_width, time) + ! MU (south_north, bdy_width, time) + ! north & south + ! U (west_east_stag, bottom_top, bdy_width, time) + ! V (west_east, bottom_top, bdy_width, time) + ! T, QVAPOR (west_east, bottom_top, bdy_width, time) + ! PH (west_east, bottom_top_stag, bdy_width, time) + ! MU (west_east, bdy_width, time) + + select case (Trim(vNam(offset:))) + case ("_BXS") ! West Boundary + start_u = (/1,1,1,1/) + start_v = (/1,1,1,1/) + start_mass = (/1,1,1,1/) + start_3d = (/1,1,1/) + start_msfu = (/1,1,1/) + start_msfv = (/1,1,1/) + + cnt_4d = (/dsizes(3),dsizes(1),dsizes(2),1/) + cnt_3d = (/bdy_width,south_north,1/) + cnt_msfu = (/bdy_width,south_north,1/) + cnt_msfv = (/bdy_width,south_north_stag,1/) + + map_4d = (/dsizes(1)*dsizes(2), 1, dsizes(1), dsizes(1)*dsizes(2)*dsizes(3)/) + map_3d = (/south_north, 1, bdy_width*south_north/) + map_msfu = (/south_north, 1, bdy_width*south_north/) + map_msfv = (/south_north_stag, 1, bdy_width*south_north_stag/) + + reverse = .False. + tenname = "_BTXS" + case ("_BXE") ! East Boundary + start_u = (/west_east_stag - bdy_width + 1, 1, 1, 1/) + start_v = (/west_east - bdy_width + 1, 1, 1, 1/) + start_mass = (/west_east - bdy_width + 1, 1, 1, 1/) + start_3d = (/west_east - bdy_width + 1, 1, 1/) + start_msfu = (/west_east_stag - bdy_width + 1, 1, 1/) + start_msfv = (/west_east - bdy_width + 1, 1, 1/) + + cnt_4d = (/dsizes(3),dsizes(1),dsizes(2),1/) + cnt_3d = (/bdy_width,south_north,1/) + cnt_msfu = (/bdy_width,south_north,1/) + cnt_msfv = (/bdy_width,south_north_stag,1/) + + map_4d = (/dsizes(1)*dsizes(2), 1, dsizes(1), dsizes(1)*dsizes(2)*dsizes(3)/) + map_3d = (/south_north, 1, bdy_width*south_north/) + map_msfu = (/south_north, 1, bdy_width*south_north/) + map_msfv = (/south_north_stag, 1, bdy_width*south_north_stag/) + + reverse = .True. + tenname = "_BTXE" + case ("_BYE") ! North Boundary + start_u = (/1, south_north - bdy_width + 1, 1, 1/) + start_v = (/1, south_north_stag - bdy_width + 1, 1, 1/) + start_mass = (/1, south_north - bdy_width + 1, 1, 1/) + start_3d = (/1, south_north - bdy_width + 1, 1/) + start_msfu = (/1, south_north - bdy_width + 1, 1/) + start_msfv = (/1, south_north_stag - bdy_width + 1, 1/) + + cnt_4d = (/dsizes(1),dsizes(3),dsizes(2),1/) + cnt_3d = (/west_east, bdy_width,1/) + cnt_msfu = (/west_east_stag, bdy_width,1/) + cnt_msfv = (/west_east, bdy_width,1/) + + map_4d = (/1, dsizes(1)*dsizes(2), dsizes(1), dsizes(3)*dsizes(1)*dsizes(2)/) + map_3d = (/1, west_east, west_east*bdy_width/) + map_msfu = (/1, west_east_stag, west_east_stag*bdy_width/) + map_msfv = (/1, west_east, west_east*bdy_width/) + + reverse = .True. + tenname = "_BTYE" + + case ("_BYS") ! South Boundary + start_u = (/1, 1, 1, 1/) + start_v = (/1, 1, 1, 1/) + start_mass = (/1, 1, 1, 1/) + start_3d = (/1, 1, 1/) + start_msfu = (/1, 1, 1/) + start_msfv = (/1, 1, 1/) + + cnt_4d = (/dsizes(1),dsizes(3),dsizes(2),1/) + cnt_3d = (/west_east, bdy_width,1/) + cnt_msfu = (/west_east_stag, bdy_width,1/) + cnt_msfv = (/west_east, bdy_width,1/) + + map_4d = (/1, dsizes(1)*dsizes(2), dsizes(1), dsizes(3)*dsizes(1)*dsizes(2)/) + map_3d = (/1, west_east, west_east*bdy_width/) + map_msfu = (/1, west_east_stag, west_east_stag*bdy_width/) + map_msfv = (/1, west_east, west_east*bdy_width/) + + reverse = .False. + tenname = "_BTYS" + + case ("_BTXS", "_BTXE","_BTYS","_BTYE") + cycle + end select + + select case (nDims) + case (2) + if (vNam(1:offset) == "Times") then + ncid = ncidfg + else + n = index(vNam, "bdytime") + if ( n <= 0 ) cycle + select case (vNam(n-4:n-1)) + case ("this") + ncid = ncidfg + case ("next") + ncid = ncidfg02 + case default + cycle + end select + end if + status = nf90_get_var(ncid, vTimes_ID, times) + status = nf90_put_var(ncidvarbdy, varid, times) + case (3,4) + + Write(*,*) "Processing for "//trim(vNam) + + couple = .true. + + allocate(MU_fg (dsizes(1),bdy_width,1), stat=status) + allocate(MU_fg02 (dsizes(1),bdy_width,1), stat=status) + allocate(MUB_fg (dsizes(1),bdy_width,1), stat=status) + allocate(MUB_fg02(dsizes(1),bdy_width,1), stat=status) + allocate(MSF (dsizes(1),bdy_width,1), stat=status) + + allocate(Tend(dsizes(1), dsizes(2), dsizes(3), dsizes(4)), stat=status) + + if ( dsizes(1) == west_east_stag .or. dsizes(1) == south_north_stag ) then + MU_fgptr => MU_fg (2:,:,:) + MU_fg02ptr => MU_fg02 (2:,:,:) + MUB_fgptr => MUB_fg (2:,:,:) + MUB_fg02ptr => MUB_fg02(2:,:,:) + stag = .True. + else + MU_fgptr => MU_fg + MU_fg02ptr => MU_fg02 + MUB_fgptr => MUB_fg + MUB_fg02ptr => MUB_fg02 + stag = .False. + end if + + err_msg="Failed to get variable : "//trim(vNam) + status = nf90_get_var(ncidfg, MU_fgID, MU_fgptr, start=start_3d, count=cnt_3d, map=map_3d) + if ( status /= nf90_noerr ) call nf90_handle_err(status, err_msg) + + status = nf90_get_var(ncidfg02, MU_fg02ID, MU_fg02ptr, start=start_3d,count=cnt_3d, map=map_3d) + if(status /= nf90_noerr) call nf90_handle_err(status,err_msg) + + status = nf90_get_var(ncidfg, MUB_fgID, MUB_fgptr, start=start_3d, count=cnt_3d,map=map_3d) + if(status /= nf90_noerr) call nf90_handle_err(status,err_msg) + + status = nf90_get_var(ncidfg02, MUB_fg02ID, MUB_fg02ptr, start=start_3d, count=cnt_3d, map=map_3d) + if(status /= nf90_noerr) call nf90_handle_err(status, err_msg) + + err_msg="Failed to inquire tendency id for "//trim(vNam)//" for output file" + status = nf90_inq_varid(ncidvarbdy, vNam(1:offset-1)//tenname, tenid) + if(status /= nf90_noerr) call nf90_handle_err(status, err_msg) + + if ( reverse ) then + MU_fg = MU_fg (:,bdy_width:1:-1,:) + MU_fg02 = MU_fg02 (:,bdy_width:1:-1,:) + MUB_fg = MUB_fg (:,bdy_width:1:-1,:) + MUB_fg02 = MUB_fg02(:,bdy_width:1:-1,:) + end if + + select case (vNam(1:offset)) + case ("U_", "V_") + if ( stag ) then + MU_fg (1,:,:) = MU_fg (2,:,:) + MU_fg02 (1,:,:) = MU_fg02 (2,:,:) + MUB_fg (1,:,:) = MUB_fg (2,:,:) + MUB_fg02(1,:,:) = MUB_fg02(2,:,:) + + MU_fg (2:dsizes(1)-1,:,:) = (MU_fg (2:dsizes(1)-1,:,:) + MU_fg (3:dsizes(1),:,:))*0.5 + MU_fg02 (2:dsizes(1)-1,:,:) = (MU_fg02 (2:dsizes(1)-1,:,:) + MU_fg02 (3:dsizes(1),:,:))*0.5 + MUB_fg (2:dsizes(1)-1,:,:) = (MUB_fg (2:dsizes(1)-1,:,:) + MUB_fg (3:dsizes(1),:,:))*0.5 + MUB_fg02(2:dsizes(1)-1,:,:) = (MUB_fg02(2:dsizes(1)-1,:,:) + MUB_fg02(3:dsizes(1),:,:))*0.5 + else + MU_fg (:,2:bdy_width,:) = (MU_fg (:,1:bdy_width-1,:) + MU_fg (:,2:bdy_width,:))*0.5 + MU_fg02 (:,2:bdy_width,:) = (MU_fg02 (:,1:bdy_width-1,:) + MU_fg02 (:,2:bdy_width,:))*0.5 + MUB_fg (:,2:bdy_width,:) = (MUB_fg (:,1:bdy_width-1,:) + MUB_fg (:,2:bdy_width,:))*0.5 + MUB_fg02(:,2:bdy_width,:) = (MUB_fg02(:,1:bdy_width-1,:) + MUB_fg02(:,2:bdy_width,:))*0.5 + end if + + if ( vNam(1:offset) == "U_" ) then + start_4d => start_u + start_msf => start_msfu + cnt_msf => cnt_msfu + map_msf => map_msfu + MSF_NAME = "MAPFAC_U" + else + start_4d => start_v + start_msf => start_msfv + cnt_msf => cnt_msfv + map_msf => map_msfv + MSF_NAME = "MAPFAC_V" + end if + + status = nf90_inq_varid(ncidfg , MSF_NAME , MSF_ID ) + err_msg="Failed to get varialbe MSF" + status = nf90_get_var(ncidfg, MSF_ID, MSF, start=start_msf, count=cnt_msf, map=map_msf) + if(status /= nf90_noerr) call nf90_handle_err(status, err_msg) + + if ( reverse ) MSF = MSF(:,bdy_width:1:-1,:) + + case ("T_","PH_","QVAPOR_") + MSF = 1.0 + start_4d => start_mass + case ("MU_") + status = nf90_inq_varid(ncidvarbdy, "MU"//tenname, tenid) + Tend(:,:,:,1) = ( MU_fg02 - MU_fg ) / bdyfrq + status = nf90_put_var(ncidvarbdy, varid, MU_fg) + !status = nf90_put_var(ncidvarbdy, varid, MU_fg02) + err_msg="Failed to put variable "//trim(vNam) + if(status /= nf90_noerr) call nf90_handle_err(status,err_msg) + status = nf90_put_var(ncidvarbdy, tenid, Tend(:,:,:,1)) + err_msg="Failed to put tendency for "//trim(vNam) + if(status /= nf90_noerr) call nf90_handle_err(status,err_msg) + couple = .false. + + case default + Tend = 0.0 + couple = .false. + select case (xtype) + case (nf90_float) + allocate(fVar_fg( dsizes(1), dsizes(2), dsizes(3), dsizes(4) ), stat=status) + fVar_fg = 0.0 + status = nf90_put_var(ncidvarbdy, varid, fVar_fg) + err_msg="Failed to put variable "//trim(vNam) + if(status /= nf90_noerr) call nf90_handle_err(status,err_msg) + status = nf90_put_var(ncidvarbdy, tenid, Tend) + err_msg="Failed to put tendency for "//trim(vNam) + if(status /= nf90_noerr) call nf90_handle_err(status,err_msg) + deallocate (fVar_fg) + case (nf90_int) + allocate(iVar( dsizes(1), dsizes(2), dsizes(3), dsizes(4) ), stat=status) + iVar = 0 + status = nf90_put_var(ncidvarbdy, varid, iVar) + err_msg="Failed to put variable "//trim(vNam) + if(status /= nf90_noerr) call nf90_handle_err(status,err_msg) + status = nf90_put_var(ncidvarbdy, tenid, Tend) + err_msg="Failed to put tendency for "//trim(vNam) + if(status /= nf90_noerr) call nf90_handle_err(status,err_msg) + deallocate (iVar) + end select ! end of xtype + + end select ! end of vNam + + if ( couple ) then + + allocate( fVar_fg(dsizes(1), dsizes(2), dsizes(3), dsizes(4)), stat=status) + allocate(fVar_fg02(dsizes(1), dsizes(2), dsizes(3), dsizes(4)), stat=status) + + err_msg="Failed to inquire variable id for "//vNam(1:offset-1)//" for fg" + status = nf90_inq_varid(ncidfg, vNam(1:offset-1), fg_varid) + if(status /= nf90_noerr) call nf90_handle_err(status,err_msg) + + err_msg="Failed to inquire variable id for "//vNam(1:offset-1)//" for fg02" + status = nf90_inq_varid(ncidfg02, vNam(1:offset-1), fg02_varid) + if(status /= nf90_noerr) call nf90_handle_err(status, err_msg) + + err_msg="Failed to inquire tendency id for "//trim(vNam(1:offset-1))//" for output file" + status = nf90_inq_varid(ncidvarbdy, vNam(1:offset-1)//tenname, tenid) + if(status /= nf90_noerr) call nf90_handle_err(status,err_msg) + + err_msg="Failed to get variable "//vNam(1:offset-1)//" from fg" + status = nf90_get_var(ncidfg, fg_varid, fVar_fg, start=start_4d, count=cnt_4d, map=map_4d) + if(status /= nf90_noerr) call nf90_handle_err(status,err_msg) + + err_msg="Failed to get variable "//vNam(1:offset-1)//" from fg02" + status = nf90_get_var(ncidfg02, fg02_varid, fVar_fg02, start=start_4d, count=cnt_4d, map=map_4d) + if(status /= nf90_noerr) call nf90_handle_err(status,err_msg) + + MU_fg = MU_fg + MUB_fg + MU_fg02 = MU_fg02 + MUB_fg + !MU_fg02 = MU_fg02 + MUB_fg02 + + if ( reverse ) then + fVar_fg = fVar_fg (:,:,bdy_width:1:-1,:) + fVar_fg02 = fVar_fg02(:,:,bdy_width:1:-1,:) + end if + + do i = 1, dsizes(2) + fVar_fg(:,i,:,:) = (fVar_fg (:,i,:,:) * MU_fg ) / MSF + fVar_fg02(:,i,:,:) = (fVar_fg02(:,i,:,:) * MU_fg02) / MSF + end do + + Tend = ( fVar_fg02 - fVar_fg ) / bdyfrq + + err_msg="Failed to put variable "//trim(vNam) + status = nf90_put_var(ncidvarbdy, varid, fVar_fg) + !status = nf90_put_var(ncidvarbdy, varid, fVar_fg02) + if(status /= nf90_noerr) call nf90_handle_err(status,err_msg) + + err_msg="Failed to put tendency for "//trim(vNam) + status = nf90_put_var(ncidvarbdy, tenid, Tend) + if(status /= nf90_noerr) call nf90_handle_err(status,err_msg) + + deallocate (fVar_fg) + deallocate (fVar_fg02) + + end if + + NULLIFY (MU_fgptr) + NULLIFY (MU_fg02ptr) + NULLIFY (MUB_fgptr) + NULLIFY (MUB_fg02ptr) + NULLIFY (MSF_ptr) + + deallocate (Tend) + deallocate (MU_fg) + deallocate (MU_fg02) + deallocate (MUB_fg) + deallocate (MUB_fg02) + deallocate (MSF) + case default + cycle + end select ! end of nDims + + end do + + deallocate (times) + + status = nf90_close(ncidfg) + status = nf90_close(ncidfg02) + status = nf90_close(ncidwrfbdy) + status = nf90_close(ncidvarbdy) + + Write(*,*) "Boundary file generated successfully" + +contains + + subroutine nf90_handle_err(status, err_msg) + integer, intent (in) :: status + character (len=*), intent(in) :: err_msg + + if(status /= nf90_noerr) then + print *, trim(nf90_strerror(status)) + print *, trim(err_msg) + call exit(-1) + end if + end subroutine nf90_handle_err + + function jd(yyyy, mm, dd) result(ival) + + integer, intent(in) :: yyyy + integer, intent(in) :: mm + integer, intent(in) :: dd + integer :: ival + + ! DATE ROUTINE JD(YYYY, MM, DD) CONVERTS CALENDER DATE TO + ! JULIAN DATE. SEE CACM 1968 11(10):657, LETTER TO THE + ! EDITOR BY HENRY F. FLIEGEL AND THOMAS C. VAN FLANDERN. + ! EXAMPLE JD(1970, 1, 1) = 2440588 + + ival = dd - 32075 + 1461*(yyyy+4800+(mm-14)/12)/4 + & + 367*(mm-2-((mm-14)/12)*12)/12 - 3*((yyyy+4900+(mm-14)/12)/100)/4 + + return + end function jd + + function datediff(date_1, date_2) result(ival) + + character(len=*), intent(in) :: date_1 + character(len=*), intent(in) :: date_2 + integer :: ival + integer :: jd1, jd2 + integer :: yyyy,mm,dd + integer :: hh1,nn1,ss1 + integer :: hh2,nn2,ss2 + + + ! date string : yyyy-mm-dd_hh:mm:ss + ! calculate the difference between date_1 and date_2 in seconds + + read(date_1(1:19), '(i4,5(1x,i2))') & + yyyy, mm, dd, hh1, nn1, ss1 + + jd1=jd(yyyy,mm,dd) + + read(date_2(1:19), '(i4,5(1x,i2))') & + yyyy, mm, dd, hh2, nn2, ss2 + + jd2=jd(yyyy,mm,dd) + + ival=(jd2-jd1)*86400 + ( hh2-hh1)*3600 + (nn2-nn1)*60 + (ss2-ss1) + + return + end function datediff + +end program da_bdy diff --git a/var/mri4dvar/da_bilin.f90 b/var/mri4dvar/da_bilin.f90 new file mode 100644 index 0000000000..d80417c187 --- /dev/null +++ b/var/mri4dvar/da_bilin.f90 @@ -0,0 +1,369 @@ +program da_bilin + +!---------------------------------------------------------------------- +! Purpose: Regridding increment from low-resolution to high-resolution +! by using bilinear interpolation +! +! Input : fg -- low resolution first guess file +! wrfvar_output -- low resolution analysis file +! wrfinput_hires -- high resolution first guess file +! +! Output : wrfvar_output_hires -- regridded high resolution analysis +! +! Increment = an_lores - fg_lores +! wrfvar_output_hires = Increment + wrfinput_hires +! +! In order to keep the domain size, it needs to match ( n - 1 )*ns + 1 +! +! where n is the grid number in x or y +! ns is the refinement ratio between two resulotions +! +! Compile: +! +! pgf90 -o da_bilin.exe -I$NETCDF/include -L$NETCDF/lib -lnetcdf da_bilin.f90 +! +! Usage: +! +! da_bilin.exe [-h] [-fg_lores filename] [-an_lores filename] +! [-fg_hires filename] [-ns n ] [-o outputfile] +! +! -fg_lores Optional, low resulotion first guess file, default - fg" +! -an_lores Optional, low resulotion analysis file comes from wrfvar, default - wrfvar_output" +! -fg_hires Optional, high resultion first guess file, default - wrfinput_hires" +! -ns Optional, the refinement ratio between two resulotions, default - 3" +! -o Optional, output high resulotion analysis file, default - wrfvar_output_hires" +! -h Show this help" +! +! jliu@ucar.edu , 2011-12-15 +!---------------------------------------------------------------------- + + use netcdf + + implicit none + + !These variables' incremental will be regridded by default + character (len=6), dimension(1:19) :: vNam + + integer :: i, j, k, n, status + integer :: nLat, nLon, oLat, oLon + integer :: sLat, eLat, sLon, eLon + integer :: rLat, rLon + + integer :: ncidfg, ncidan, ncidout + integer :: varid, nDims, dLen, varid_fg, varid_an, dimid + integer :: regridsize, domainsize_out + + real, dimension(:,:,:,:), allocatable :: fg, an, increment, var_out + real, dimension(:,:), allocatable :: iVar, oVar + + integer, dimension(nf90_max_var_dims) :: vDimIDs + integer, dimension(4) :: vdimsizes + + character (len = 19), dimension(:), allocatable :: times + character (len = 255) :: appname = "" + character (len = 255) :: arg = "" + character (len = 255) :: fg_lores = "fg" + character (len = 255) :: an_lores = "wrfvar_output" + character (len = 255) :: fg_hires = "wrfinput_hires" + character (len = 255) :: f_out = "wrfvar_output_hires" + character (len = 255) :: errmsg = "" + character (len = 8) :: i_char = "" + + integer :: ns = 3 + !integer :: cloud_cv_options = 0 + !integer :: cv_w = 0 + + LOGICAL :: file_exists + + integer iargc + + !These variables' incremental will be regridded by default + + vNam(1)="U" + vNam(2)="V" + vNam(3)="T" + vNam(4)="QVAPOR" + vNam(5)="PH" + vNam(6)="P" + vNam(7)="MU" + vNam(8)="U10" + vNam(9)="V10" + vNam(10)="T2" + vNam(11)="Q2" + vNam(12)="PSFC" + vNam(13)="TH2" + + vNam(14)="QCLOUD" + vNam(15)="QRAIN" + vNam(16)="QICE" + vNam(17)="QSNOW" + vNam(18)="QGRAUP" + vNam(19)="W" + + call getarg(0, appname) + n=index(appname, '/', BACK=.true.) + appname = trim(appname(n+1:)) + + DO i = 1, iargc(), 2 + arg="" + call getarg(i, arg) + select case ( trim(arg) ) + case ("-fg_lores") + call getarg(i+1, arg) + fg_lores=trim(arg) + case ("-an_lores") + call getarg(i+1, arg) + an_lores=trim(arg) + case ("-fg_hires") + call getarg(i+1, arg) + fg_hires=trim(arg) + case ("-ns") + call getarg(i+1, arg) + read(arg, '(i3)') ns + case ("-o") + call getarg(i+1, arg) + f_out=trim(arg) + !case ("-cloud_cv_options") + ! call getarg(i+1, arg) + ! read(arg, '(i3)') cloud_cv_options + !case ("-cv_w") + ! call getarg(i+1, arg) + ! read(arg, '(i3)') cv_w + case default + call show_usage() + call exit(0) + end select + END DO + + write (i_char, '(i8)') ns + + inquire(FILE=trim(fg_hires), EXIST=file_exists) + + if ( .not. file_exists ) then + Write(*,*) "\nError: "//trim(fg_hires)//" not exists\n" + call show_usage() + call exit(-1) + endif + + call system("cp "//fg_hires//" "//f_out) + + status = nf90_open(fg_lores, NF90_NOWRITE, ncidfg) + errmsg = trim(fg_lores) + if ( status /= nf90_noerr ) call nf90_handle_err(status, errmsg) + + status = nf90_open(an_lores, NF90_NOWRITE, ncidan) + errmsg = trim(an_lores) + if ( status /= nf90_noerr ) call nf90_handle_err(status, errmsg) + + status = nf90_open(f_out, NF90_WRITE, ncidout) + errmsg= trim(f_out) + if ( status /= nf90_noerr ) call nf90_handle_err(status, errmsg) + + status = nf90_inq_dimid(ncidout, "west_east_stag", dimid) + status = nf90_inquire_dimension(ncidout, dimid, len=dLen) + domainsize_out = dLen + + status = nf90_inq_dimid(ncidout, "south_north_stag", dimid) + status = nf90_inquire_dimension(ncidout, dimid, len=dLen) + domainsize_out = domainsize_out * dLen + + status = nf90_inq_dimid(ncidfg, "west_east_stag", dimid) + status = nf90_inquire_dimension(ncidfg, dimid, len=dLen) + regridsize = (dLen-1)*ns+1 + + status = nf90_inq_dimid(ncidfg, "south_north_stag", dimid) + status = nf90_inquire_dimension(ncidfg, dimid, len=dLen) + regridsize = regridsize * ( (dLen-1)*ns+1 ) + + if ( regridsize /= domainsize_out ) then + Write(*,'(a,i2,a)') "Error : It needs to match m = (n-1)*",ns, & + "+1 where n is coarse grid number in x or y, "// & + "m is fine grid number in x or y." + call exit(-1) + end if + + write (i_char, '(i8)') ns + + Write(*,*) " Input :" + Write(*,*) " Low resolution first guess : "//trim(fg_lores) + Write(*,*) " Low resolution analysis : "//trim(an_lores) + Write(*,*) " High resolution first guess : "//trim(fg_hires) + Write(*,*) " ns : "//adjustl(i_char) + Write(*,*) "Output :" + Write(*,*) " High resolution analysis : "//trim(f_out) + + errmsg = "" + + n = ubound(vNam,1) + do i=1,n + + Write (*,*) "Regridding increment for "//trim(vNam(i)) + + status = nf90_inq_varid(ncidout, trim(vNam(i)), varid) + status = nf90_inquire_variable(ncidout, varid, ndims=nDims,dimids=vDimIDs) + + vdimsizes = 1 + do j=1, nDims + status = nf90_inquire_dimension(ncidout, vDimIDs(j), len = dLen ) + vdimsizes(j) = dLen + end do + + allocate(var_out(vdimsizes(1), vdimsizes(2), vdimsizes(3), vdimsizes(4)), stat=status) + + status = nf90_get_var(ncidout, varid, var_out) + + status = nf90_inq_varid(ncidfg, trim(vNam(i)), varid_fg) + status = nf90_inq_varid(ncidan, trim(vNam(i)), varid_an) + + status = nf90_inquire_variable(ncidfg, varid_fg, ndims=nDims,dimids=vDimIDs) + + vdimsizes = 1 + do j=1, nDims + status = nf90_inquire_dimension(ncidfg, vDimIDs(j), len = dLen ) + vdimsizes(j) = dLen + end do + + allocate(fg(vdimsizes(1), vdimsizes(2), vdimsizes(3), vdimsizes(4)), stat=status) + allocate(an(vdimsizes(1), vdimsizes(2), vdimsizes(3), vdimsizes(4)), stat=status) + allocate(increment(vdimsizes(1), vdimsizes(2), vdimsizes(3), vdimsizes(4)), stat=status) + + status = nf90_get_var(ncidfg, varid_fg, fg) + status = nf90_get_var(ncidan, varid_an, an) + + increment = an - fg + + nLon = vdimsizes(1) + nLat = vdimsizes(2) + + if ( trim(vNam(i) ) == "U" ) then + rLat = nLat * ns + rLon = (nLon-1) * ns + 1 + nLat = nLat + 2 + else + rLon = nLon * ns + rLat = (nLat-1) * ns + 1 + nLon = nLon + 2 + if ( trim(vNam(i)) /= "V" ) then + rLat = nLat * ns + nLat = nLat + 2 + endif + endif + + oLon = ( nLon - 1 ) * ns + 1 + oLat = ( nLat - 1 ) * ns + 1 + + elat = (oLat - rLat) / 2 + slat = oLat - rLat - elat + 1 + + elon = (oLon - rLon) / 2 + slon = oLon - rLon - elon + 1 + + allocate(iVar(nLon, nLat), stat=status) + allocate(oVar(oLon, oLat), stat=status) + + do j=1, vdimsizes(4) + do k=1, vdimsizes(3) + + iVar = 0 + oVar = 0 + + select case ( trim(vNam(i)) ) + case ("U") + iVar(:,2:nlat-1) = increment(:,:,k,j) + iVar(:,1) = iVar(:,2) + iVar(:,nlat) = iVar(:,nlat-1) + case ("V") + iVar(2:nlon-1,:) = increment(:,:,k,j) + iVar(1,:) = iVar(2,:) + iVar(nlon,:) = iVar(nlon-1,:) + case default + iVar(2:nlon-1,2:nlat-1) = increment(:,:,k,j) + iVar(1,:) = iVar(2,:) + iVar(nlon,:) = iVar(nlon-1,:) + iVar(:,1) = iVar(:,2) + iVar(:,nlat) = iVar(:,nlat-1) + end select + + call bilin(iVar, nLon, nLat, ns, oVar, oLon, oLat) + + select case ( trim(vNam(i)) ) + case ("U") + var_out(:,:,k,j) = var_out(:,:,k,j) + oVar(:,slat:olat-elat) + case ("V") + var_out(:,:,k,j) = var_out(:,:,k,j) + oVar(slon:olon-elon,:) + case default + var_out(:,:,k,j) = var_out(:,:,k,j) + oVar(slon:olon-elon,slat:olat-elat) + end select + + end do + end do + + status = nf90_put_var(ncidout, varid, var_out) + + deallocate(var_out, stat=status) + deallocate(iVar, stat=status) + deallocate(oVar, stat=status) + deallocate(fg, stat=status) + deallocate(an, stat=status) + deallocate(increment, stat=status) + + end do + + status = nf90_close(ncidfg) + status = nf90_close(ncidan) + status = nf90_close(ncidout) + + Write(*,*) "Regridding increment completed successfully" + +contains + subroutine show_usage() + Write(*,*) 'Usage :'//trim(appname)// & + '[-h] [-fg_lores filename] [-an_lores filename] [-fg_hires filename] [-ns n ] [-o outputfile]' + Write(*,*) " -fg_lores Optional, low resulotion first guess file, default - fg" + Write(*,*) " -an_lores Optional, low resulotion analysis file comes from wrfvar, default - wrfvar_output" + Write(*,*) " -fg_hires Optional, high resultion first guess file, default - wrfinput_hires" + Write(*,*) " -ns Optional, the refinement ratio between two resulotions, default - 3" + Write(*,*) " -o Optional, output high resulotion analysis file, default - wrfvar_output_hires" + Write(*,*) " -h Show this help" + end subroutine show_usage + + subroutine nf90_handle_err(status, errmsg) + integer, intent(in) :: status + character(len=*), intent(in) :: errmsg + + if(status /= nf90_noerr) then + print *, trim(nf90_strerror(status))//" : "//trim(errmsg) + Stop + end if + end subroutine nf90_handle_err + + subroutine bilin(old,xi,yi,ns,new,xo,yo) + + implicit none + + integer, intent(in) :: xi,yi,xo,yo + real, dimension(xi,yi), intent(in) :: old + integer, intent(in) :: ns + real, dimension(xo,yo), intent(out):: new + + real :: im(1:ns+1,2) + integer:: i,j,jm1,im1,ix1,ix2,iy1,iy2 + + forall(i=1:ns+1) im(i,2) = real(i-1)/ns + im(:,1) = 1 - im(:,2) + + do j=2,yi + jm1 = j - 1 + iy2 = jm1 * ns + 1 + iy1 = iy2 - ns + do i=2,xi + im1 = i - 1 + ix2 = im1 * ns + 1 + ix1 = ix2 - ns + new(ix1:ix2,iy1:iy2) = matmul(im,matmul(old(im1:i,jm1:j),transpose(im))) + end do + end do + + end subroutine bilin + +end program da_bilin diff --git a/var/mri4dvar/da_thin.f90 b/var/mri4dvar/da_thin.f90 new file mode 100644 index 0000000000..2127c77a9f --- /dev/null +++ b/var/mri4dvar/da_thin.f90 @@ -0,0 +1,277 @@ +program da_thin +!---------------------------------------------------------------------- +! Purpose: Thinning wrfinput by using decimation +! +! Input : wrfinput_hires -- High resolution wrfinput +! +! Output : wrfinput_lores -- Thinned wrfinput +! +! jliu@ucar.edu, 2011-12-15 +!---------------------------------------------------------------------- + + use netcdf + + implicit none + + integer :: i, n + + integer :: ncidin, ncidout, varid, varid_out, status + integer :: nDims, nVars, nGlobalAtts, numsAtts, nTimes + integer :: dLen, attLen, xtype, dID, unlimDimID, TID + integer :: divided_exactly, dimid + + integer :: dsizes(4), start(4), stride(4) + + integer, dimension(nf90_max_var_dims) :: vDimIDs + + integer, dimension(:), allocatable :: vdimsizes + + real :: fVal + + real, dimension(:,:,:,:), allocatable :: fVar + integer, dimension(:,:,:,:), allocatable :: iVar + character (len = 19), dimension(:), allocatable :: times + + character (len = 14 ) :: coordinates + character (len = NF90_MAX_NAME) :: vNam, dNam, attNam + + integer :: decimation_factor = 3 + integer :: offset = 2 + character (len=255) :: filin = "wrfinput_hires" + character (len=255) :: filout = "wrfinput_lores" + character (len=255) :: arg = "" + character (len=255) :: appname = "" + character(len=8) :: i_char ="" + + integer iargc + + call getarg(0, appname) + n=index(appname, '/', BACK=.true.) + appname = trim(appname(n+1:)) + + DO i = 1, iargc(), 2 + call getarg(i, arg) + select case ( trim(arg) ) + case ("-i") + call getarg(i+1, arg) + filin=trim(arg) + case ("-o") + call getarg(i+1, arg) + filout=trim(arg) + case ("-thin") + call getarg(i+1, arg) + read(arg, '(i3)') decimation_factor + case default + Write(*,*) "Usage : "//trim(appname)//" [-i inputfile] [-o outputfile] [-thin decimation_factor] [-h]" + Write(*,*) " -i Optional, input filename, default - wrfinput_hires" + Write(*,*) " -o Optional, output filename, default - wrfinput_lores" + Write(*,*) " -thin Optional, decimation factor, default - 3" + Write(*,*) " -h Shwo this usage" + call exit(0) + end select + END DO + + if ( mod(decimation_factor,2) == 0 ) then + Write(*,*) "\nError : decimation factor must be odd number\n" + call exit(-1) + endif + + status = nf90_open(filin, NF90_NOWRITE, ncidin) + if ( status /= nf90_noerr ) then + Write (*,*) "File open error. Please link the input file to "//trim(filin) + call exit(-1) + endif + + status = nf90_inq_dimid(ncidin, "west_east_stag", dimid) + status = nf90_inquire_dimension(ncidin, dimid, len=dLen) + divided_exactly = mod((dLen-1),decimation_factor) + + status = nf90_inq_dimid(ncidin, "south_north_stag", dimid) + status = nf90_inquire_dimension(ncidin, dimid, len=dLen) + divided_exactly = divided_exactly + mod((dLen-1),decimation_factor) + + if ( divided_exactly /= 0 ) then + Write (*,fmt='(a,i2,a)') "Failed to thinning. Grids need to match : ( n - 1 ) mod ",decimation_factor," = 0" + call exit(-1) + endif + + status = nf90_create(filout, NF90_CLOBBER, ncidout) + if ( status /= nf90_noerr) call nf90_handle_err(status) + + status = nf90_inquire(ncidin, nDims, nVars, nGlobalAtts, unlimDimID) + if ( status /= nf90_noerr ) call nf90_handle_err(status) + + write (i_char, '(i8)') decimation_factor + + Write (*,*) " Input file : "//trim(filin) + Write (*,*) " Output file : "//trim(filout) + Write (*,*) "decimation factor : "//adjustl(i_char) + + do i=1, nGlobalAtts + status = nf90_inq_attname(ncidin, NF90_GLOBAL, i, attNam) + select case (trim(attNam)) + case ( "WEST-EAST_GRID_DIMENSION", "SOUTH-NORTH_GRID_DIMENSION", & + "WEST-EAST_PATCH_END_UNSTAG", "WEST-EAST_PATCH_END_STAG", & + "SOUTH-NORTH_PATCH_END_UNSTAG", "SOUTH-NORTH_PATCH_END_STAG" ) + status = nf90_get_att(ncidin, NF90_GLOBAL, attNam, fVal) + status = nf90_put_att(ncidout, NF90_GLOBAL, attNam, int(( fVal - 1 ) / decimation_factor + 1) ) + case ("DX","DY", "DT" ) + status = nf90_get_att(ncidin, NF90_GLOBAL, attNam, fVal) + status = nf90_put_att(ncidout, NF90_GLOBAL, attNam, fVal * decimation_factor ) + case default + status = nf90_copy_att(ncidin, NF90_GLOBAL, attNam, ncidout, NF90_GLOBAL) + end select + end do + + allocate (vdimsizes(nDims), stat=status) + + do i=1, nDims + + status = nf90_inquire_dimension(ncidin, i, name=dNam, len = dLen) + + vdimsizes(i) = dLen + select case (trim(dNam)) + case ("south_north_stag", "west_east_stag") + vdimsizes(i) = (dLen - 1 ) / decimation_factor + 1 + case ("west_east", "south_north") + vdimsizes(i) = dLen / decimation_factor + case ("Time") + allocate(times(dLen), stat=status) + vdimsizes(i) = NF90_UNLIMITED + nTimes = dLen + TID = i + end select + + status = nf90_def_dim(ncidout, dNam, vdimsizes(i), dID) + + end do + + vdimsizes(TID) = nTimes + + do varid=1, nVars + status = nf90_inquire_variable(ncidin,varid,name=vNam,xtype=xtype,ndims=nDims,dimids=vDimIDs,natts=numsAtts) + status = nf90_def_var(ncidout, trim(vNam), xtype, vDimIDs(1:nDims), varid_out) + if(status /= nf90_NoErr) call nf90_handle_err(status) + do i=1, numsAtts + status = nf90_inq_attname(ncidin, varid, i, attNam) + status = nf90_copy_att(ncidin, varid, trim(attNam), ncidout, varid_out) + if(status /= nf90_NoErr) call nf90_handle_err(status) + end do + end do + + status = nf90_enddef(ncidout) + + offset = (decimation_factor + 1) / 2 + + do varid=1, nVars + + status = nf90_inquire_variable(ncidin,varid,name=vNam,xtype=xtype,ndims=nDims,dimids=vDimIDs) + + dsizes = 1 + do i = 1 , nDims + dsizes(i) = vdimsizes(vDimIDs(i)) + end do + + status = nf90_inquire_attribute(ncidin,varid,"coordinates") + + if ( status == nf90_noerr ) then + + Write(*,*) "Thinning for "//trim(vNam) + + coordinates=char(0) + status = nf90_get_att(ncidin, varid, "coordinates" , coordinates) + print *, coordinates + + stride=(/decimation_factor,decimation_factor,1,1/) + + n = index(coordinates, char(0)) - 1 + if ( n < 0 ) n = len(coordinates) + + select case (trim(coordinates(1:n))) + case ("XLONG_V XLAT_V") + start=(/offset,1,1,1/) + case ("XLONG_U XLAT_U") + start=(/1,offset,1,1/) + case ("XLONG XLAT") + start=(/offset,offset,1,1/) + case ("XLONG XLAT XTI") + start=(/offset,offset,1,1/) + case default + print *, "Unkown coordinates : "//coordinates + call exit(-1) + end select + + else + + stride = 1 + start = 1 + + if ( trim(vNam) == 'XLONG' .or. trim(vNam) == 'XLAT' ) then + stride = (/decimation_factor,decimation_factor,1,1/) + start = (/offset,offset,1,1/) + endif + + endif + + select case (xtype) + case (nf90_float) + allocate(fVar( dsizes(1), dsizes(2), dsizes(3), dsizes(4) ), stat=status) + status = nf90_get_var(ncidin, varid, fVar, start=start, stride=stride) + if ( status == nf90_noerr ) then + if ( vNam == "RDX" .or. vNam == "RDY" ) then + status = nf90_put_var(ncidout, varid, fVar / decimation_factor) + else + status = nf90_put_var(ncidout, varid, fVar) + endif + if ( status /= nf90_noerr) call nf90_handle_err(status) + else + call nf90_handle_err(status) + endif + deallocate(fVar, stat=status) + case (nf90_int) + allocate(iVar( dsizes(1), dsizes(2), dsizes(3), dsizes(4) ), stat=status) + status = nf90_get_var(ncidin, varid, iVar, start=start, stride=stride) + if ( status == nf90_noerr ) then + status = nf90_put_var(ncidout, varid, iVar) + if ( status /= nf90_noerr) call nf90_handle_err(status) + else + call nf90_handle_err(status) + endif + deallocate(iVar, stat=status) + case (nf90_char) + if ( trim(vNam) == "Times") then + status = nf90_get_var(ncidin, varid, times) + if ( status == nf90_noerr ) then + status = nf90_put_var(ncidout, varid, times) + if ( status /= nf90_noerr) call nf90_handle_err(status) + else + call nf90_handle_err(status) + endif + deallocate(times, stat=status) + else + print *, "Unkown character variable :"//trim(vNam) + call exit(-1) + endif + case default + print *, "Unkown xtype : ", xtype + call exit(-1) + end select + end do + + status = nf90_close(ncidin) + status = nf90_close(ncidout) + + Write(*,*) "Completed thinning successfully" + +contains + + subroutine nf90_handle_err(status) + integer, intent ( in) :: status + + if(status /= nf90_noerr) then + print *, trim(nf90_strerror(status)) + call exit(-1) + end if + end subroutine nf90_handle_err + +end program da_thin diff --git a/var/mri4dvar/da_vp_bilin.f90 b/var/mri4dvar/da_vp_bilin.f90 new file mode 100644 index 0000000000..3855e0f95f --- /dev/null +++ b/var/mri4dvar/da_vp_bilin.f90 @@ -0,0 +1,384 @@ +program da_vp_bilin + +!---------------------------------------------------------------------- +! Purpose: Regridding from low to high resolution in control variable space +! by using bilinear interpolation +! +! where n is the grid number in x or y +! ns is the refinement ratio between two resulotions +! +! Method: follow da_bilin.f90 +! +! Compile: +! +! pgf90 -o da_vp_bilin.exe da_vp_bilin.f90 +! +! liuz@ucar.edu , 2016-08, NCAR/MMM +!---------------------------------------------------------------------- + + !use netcdf + + implicit none + + !These variables' incremental will be regridded by default + character (len=6), dimension(1:19) :: vNam + + integer :: ix, jy, kz, k, status + integer :: ixh, jyh, kzh + integer :: nLat, nLon, oLat, oLon + integer :: sLat, eLat, sLon, eLon + integer :: rLat, rLon + + real, dimension(:,:,:), allocatable :: v1, v2, v3, v4, v5 + real, dimension(:,:,:), allocatable :: v6, v7, v8, v9, v10, v11 + real, dimension(:,:,:), allocatable :: v1h, v2h, v3h, v4h, v5h + real, dimension(:,:,:), allocatable :: v6h, v7h, v8h, v9h, v10h, v11h + real, dimension(:,:), allocatable :: iVar, oVar + + character (len = 255) :: appname = "" + character (len = 255) :: arg = "" + character (len = 19) :: analysis_date + character (len = 255) :: input_file= "vp_output.global" + character (len = 255) :: output_file= "vp_output.global_hires" + + integer, parameter :: vp_unit = 8 + integer, parameter :: vp_hires_unit = 9 + integer :: ratio ! resolution ratio + integer :: cloud_cv_options ! 2 or 3 with cloud cv variables + integer :: use_cv_w ! =1 for w control variable + integer :: io_status + integer iargc + + LOGICAL :: file_exists + + !These variables' incremental will be regridded by default + + !call getarg(0, appname) + !n=index(appname, '/', BACK=.true.) + !appname = trim(appname(n+1:)) + + call getarg(1, arg) + call getarg(2, arg) + read(arg, '(i3)') ratio + + call getarg(3, arg) + call getarg(4, arg) + read(arg, '(i3)') cloud_cv_options + + call getarg(5, arg) + call getarg(6, arg) + read(arg, '(i3)') use_cv_w + + + write (*, *) 'ratio = ', ratio, 'cloud_cv_options = ', cloud_cv_options, & + 'use_cv_w = ', use_cv_w + + +! read vp file +!-------------------- + inquire(FILE=trim(input_file), EXIST=file_exists) + + if ( .not. file_exists ) then + Write(*,*) "\nError: "//trim(input_file)//" not exists\n" + call exit(-1) + else + Write(*,*) "Found: "//trim(input_file) + endif + + open(unit=vp_unit,file=trim(input_file),iostat=io_status,form='UNFORMATTED',status='OLD') + if (io_status /= 0) then + write(*,*) "Error ",io_status," opening vp file "//trim(input_file) + call exit(-1) + end if + write(*,*) 'Reading vp from : '//trim(input_file) + !read(vp_unit) analysis_date + !print *, 'analysis_date = ', analysis_date + read(vp_unit) ix, jy, kz ! domain dimension (unstagered) + print *, "input file: ix, jy, kz = ", ix, jy, kz + + allocate ( v1 (1:ix,1:jy,1:kz)) + allocate ( v2 (1:ix,1:jy,1:kz)) + allocate ( v3 (1:ix,1:jy,1:kz)) + allocate ( v4 (1:ix,1:jy,1:kz)) + allocate ( v5 (1:ix,1:jy,1:kz)) + + read(vp_unit) v1, v2, v3, v4, v5 + + if ( cloud_cv_options >= 2 ) then + allocate ( v6 (1:ix,1:jy,1:kz)) + allocate ( v7 (1:ix,1:jy,1:kz)) + allocate ( v8 (1:ix,1:jy,1:kz)) + allocate ( v9 (1:ix,1:jy,1:kz)) + allocate ( v10 (1:ix,1:jy,1:kz)) + read(vp_unit) v6, v7, v8, v9, v10 + end if + + if ( use_cv_w == 1 ) then + allocate ( v11 (1:ix,1:jy,1:kz)) + read(vp_unit) v11 + end if + + write(*,*) 'End Reading vp from : '//trim(input_file) + close(vp_unit) +!----------------------------- +! end read vp file +!---------------------- + + nLon = ix + 2 ! 52 + nLat = jy + 2 ! 52 + + rLon = ix * ratio ! 150 + rLat = jy * ratio ! 150 + + oLon = ( nLon - 1 ) * ratio + 1 ! 154 + oLat = ( nLat - 1 ) * ratio + 1 + + elat = (oLat - rLat) / 2 ! 2 + slat = oLat - rLat - elat + 1 ! 3 + + elon = (oLon - rLon) / 2 + slon = oLon - rLon - elon + 1 + + allocate(iVar(nLon, nLat), stat=status) + allocate(oVar(oLon, oLat), stat=status) + + + ixh = ix*ratio + jyh = jy*ratio + + allocate ( v1h (1:ixh,1:jyh,1:kz)) + allocate ( v2h (1:ixh,1:jyh,1:kz)) + allocate ( v3h (1:ixh,1:jyh,1:kz)) + allocate ( v4h (1:ixh,1:jyh,1:kz)) + allocate ( v5h (1:ixh,1:jyh,1:kz)) + + if ( cloud_cv_options >= 2 ) then + allocate ( v6h (1:ixh,1:jyh,1:kz)) + allocate ( v7h (1:ixh,1:jyh,1:kz)) + allocate ( v8h (1:ixh,1:jyh,1:kz)) + allocate ( v9h (1:ixh,1:jyh,1:kz)) + allocate ( v10h (1:ixh,1:jyh,1:kz)) + end if + + if ( use_cv_w == 1 ) then + allocate ( v11h (1:ixh,1:jyh,1:kz)) + end if + + do k = 1, kz + iVar(2:nlon-1,2:nlat-1) = v1(:,:,k) + iVar(1,:) = iVar(2,:) + iVar(nlon,:) = iVar(nlon-1,:) + iVar(:,1) = iVar(:,2) + iVar(:,nlat) = iVar(:,nlat-1) + call bilin(iVar,nLon,nLat,ratio,oVar,oLon,oLat) + v1h(:,:,k) = oVar(slon:olon-elon,slat:olat-elat) + + iVar(2:nlon-1,2:nlat-1) = v2(:,:,k) + iVar(1,:) = iVar(2,:) + iVar(nlon,:) = iVar(nlon-1,:) + iVar(:,1) = iVar(:,2) + iVar(:,nlat) = iVar(:,nlat-1) + call bilin(iVar,nLon,nLat,ratio,oVar,oLon,oLat) + v2h(:,:,k) = oVar(slon:olon-elon,slat:olat-elat) + + iVar(2:nlon-1,2:nlat-1) = v3(:,:,k) + iVar(1,:) = iVar(2,:) + iVar(nlon,:) = iVar(nlon-1,:) + iVar(:,1) = iVar(:,2) + iVar(:,nlat) = iVar(:,nlat-1) + call bilin(iVar,nLon,nLat,ratio,oVar,oLon,oLat) + v3h(:,:,k) = oVar(slon:olon-elon,slat:olat-elat) + + iVar(2:nlon-1,2:nlat-1) = v4(:,:,k) + iVar(1,:) = iVar(2,:) + iVar(nlon,:) = iVar(nlon-1,:) + iVar(:,1) = iVar(:,2) + iVar(:,nlat) = iVar(:,nlat-1) + call bilin(iVar,nLon,nLat,ratio,oVar,oLon,oLat) + v4h(:,:,k) = oVar(slon:olon-elon,slat:olat-elat) + + iVar(2:nlon-1,2:nlat-1) = v5(:,:,k) + iVar(1,:) = iVar(2,:) + iVar(nlon,:) = iVar(nlon-1,:) + iVar(:,1) = iVar(:,2) + iVar(:,nlat) = iVar(:,nlat-1) + call bilin(iVar,nLon,nLat,ratio,oVar,oLon,oLat) + v5h(:,:,k) = oVar(slon:olon-elon,slat:olat-elat) + + if ( cloud_cv_options >= 2 ) then + iVar(2:nlon-1,2:nlat-1) = v6(:,:,k) + iVar(1,:) = iVar(2,:) + iVar(nlon,:) = iVar(nlon-1,:) + iVar(:,1) = iVar(:,2) + iVar(:,nlat) = iVar(:,nlat-1) + call bilin(iVar,nLon,nLat,ratio,oVar,oLon,oLat) + v6h(:,:,k) = oVar(slon:olon-elon,slat:olat-elat) + + iVar(2:nlon-1,2:nlat-1) = v7(:,:,k) + iVar(1,:) = iVar(2,:) + iVar(nlon,:) = iVar(nlon-1,:) + iVar(:,1) = iVar(:,2) + iVar(:,nlat) = iVar(:,nlat-1) + call bilin(iVar,nLon,nLat,ratio,oVar,oLon,oLat) + v7h(:,:,k) = oVar(slon:olon-elon,slat:olat-elat) + + iVar(2:nlon-1,2:nlat-1) = v8(:,:,k) + iVar(1,:) = iVar(2,:) + iVar(nlon,:) = iVar(nlon-1,:) + iVar(:,1) = iVar(:,2) + iVar(:,nlat) = iVar(:,nlat-1) + call bilin(iVar,nLon,nLat,ratio,oVar,oLon,oLat) + v8h(:,:,k) = oVar(slon:olon-elon,slat:olat-elat) + + iVar(2:nlon-1,2:nlat-1) = v9(:,:,k) + iVar(1,:) = iVar(2,:) + iVar(nlon,:) = iVar(nlon-1,:) + iVar(:,1) = iVar(:,2) + iVar(:,nlat) = iVar(:,nlat-1) + call bilin(iVar,nLon,nLat,ratio,oVar,oLon,oLat) + v9h(:,:,k) = oVar(slon:olon-elon,slat:olat-elat) + + iVar(2:nlon-1,2:nlat-1) = v10(:,:,k) + iVar(1,:) = iVar(2,:) + iVar(nlon,:) = iVar(nlon-1,:) + iVar(:,1) = iVar(:,2) + iVar(:,nlat) = iVar(:,nlat-1) + call bilin(iVar,nLon,nLat,ratio,oVar,oLon,oLat) + v10h(:,:,k) = oVar(slon:olon-elon,slat:olat-elat) + end if + + if ( use_cv_w == 1 ) then + iVar(2:nlon-1,2:nlat-1) = v11(:,:,k) + iVar(1,:) = iVar(2,:) + iVar(nlon,:) = iVar(nlon-1,:) + iVar(:,1) = iVar(:,2) + iVar(:,nlat) = iVar(:,nlat-1) + call bilin(iVar,nLon,nLat,ratio,oVar,oLon,oLat) + v11h(:,:,k) = oVar(slon:olon-elon,slat:olat-elat) + end if + enddo + + open(unit=vp_hires_unit,file=trim(output_file),iostat=io_status,form='UNFORMATTED',status='UNKNOWN') + if (io_status /= 0) then + write(*,*) "Error ",io_status," opening vp file "//trim(output_file) + call exit(-1) + end if + write(*,*) 'Writting vp on hires. to : '//trim(output_file) + + print *, 'output file: ixh, jyh, kz=', ixh, jyh, kz + write(vp_hires_unit) ixh, jyh, kz + write(vp_hires_unit) v1h,v2h,v3h,v4h,v5h + if ( cloud_cv_options >= 2 ) then + write(vp_hires_unit) v6h,v7h,v8h,v9h,v10h + end if + if ( use_cv_w == 1 ) then + write(vp_hires_unit) v11h + end if + + deallocate(v1, stat=status) + deallocate(v2, stat=status) + deallocate(v3, stat=status) + deallocate(v4, stat=status) + deallocate(v5, stat=status) + + deallocate(v1h, stat=status) + deallocate(v2h, stat=status) + deallocate(v3h, stat=status) + deallocate(v4h, stat=status) + deallocate(v5h, stat=status) + + if ( cloud_cv_options >= 2 ) then + deallocate(v6, stat=status) + deallocate(v7, stat=status) + deallocate(v8, stat=status) + deallocate(v9, stat=status) + deallocate(v10, stat=status) + + deallocate(v6h, stat=status) + deallocate(v7h, stat=status) + deallocate(v8h, stat=status) + deallocate(v9h, stat=status) + deallocate(v10h, stat=status) + end if + + if ( use_cv_w == 1 ) then + deallocate(v11, stat=status) + deallocate(v11h, stat=status) + end if + + Write(*,*) "Regridding increment completed successfully" + +contains + subroutine show_usage() + Write(*,*) 'Usage :'//trim(appname)// & + '[-h] [-fg_lores filename] [-an_lores filename] [-fg_hires filename] [-ns n ] [-o outputfile]' + Write(*,*) " -fg_lores Optional, low resulotion first guess file, default - fg" + Write(*,*) " -an_lores Optional, low resulotion analysis file comes from wrfvar, default - wrfvar_output" + Write(*,*) " -fg_hires Optional, high resultion first guess file, default - wrfinput_hires" + Write(*,*) " -ns Optional, the refinement ratio between two resulotions, default - 3" + Write(*,*) " -o Optional, output high resulotion analysis file, default - wrfvar_output_hires" + Write(*,*) " -h Show this help" + end subroutine show_usage + + !subroutine nf90_handle_err(status, errmsg) + ! integer, intent(in) :: status + ! character(len=*), intent(in) :: errmsg +! +! if(status /= nf90_noerr) then +! print *, trim(nf90_strerror(status))//" : "//trim(errmsg) +! Stop +! end if +! end subroutine nf90_handle_err + + subroutine bilin(old,xi,yi,ns,new,xo,yo) + +! assume: xo = (xi-1)*ns + 1, xi=50, xo=49*3+1=148 +! yo = (yi-1)*ns + 1 + + implicit none + + integer, intent(in) :: xi,yi,xo,yo + real, dimension(xi,yi), intent(in) :: old + integer, intent(in) :: ns + real, dimension(xo,yo), intent(out):: new + + real :: im(1:ns+1,2) +! real :: imm(1:ns+3,2) + integer:: i,j,jm1,im1,ix1,ix2,iy1,iy2 + + forall(i=1:ns+1) im(i,2) = real(i-1)/ns + im(:,1) = 1 - im(:,2) + + do j=2,yi + jm1 = j - 1 + iy2 = jm1 * ns + 1 + iy1 = iy2 - ns + do i=2,xi + im1 = i - 1 + ix2 = im1 * ns + 1 + ix1 = ix2 - ns + new(ix1:ix2,iy1:iy2) = matmul(im,matmul(old(im1:i,jm1:j),transpose(im))) + end do + end do + + + ! ns = ns + 2 + ! forall(i=1:ns+1) imm(i,2) = real(i-1)/ns + ! imm(:,1) = 1 - imm(:,2) +! +! j=yi +! jm1 = j - 1 +! iy2 = jm1 * ns + 1 +! iy1 = iy2 - ns +! +! i=xi +! im1 = i - 1 +! ix2 = im1 * ns + 1 +! ix1 = ix2 - ns +! new(ix1:ix2,iy1:iy2) = matmul(imm,matmul(old(im1:i,jm1:j),transpose(imm))) +! end do +! end do + + end subroutine bilin + +end program da_vp_bilin diff --git a/var/mri4dvar/da_vp_split.f90 b/var/mri4dvar/da_vp_split.f90 new file mode 100644 index 0000000000..0a3ab07a69 --- /dev/null +++ b/var/mri4dvar/da_vp_split.f90 @@ -0,0 +1,368 @@ +program da_vp_split + +!---------------------------------------------------------------------- +! Purpose: Scatter global hires. control variables to different PEs +! +! Input : vp_hires.bin -- high resolution global control variables +! +! Output : vp_XXXX -- high resolution local control variables +! +! In order to keep the domain size, it needs to match ( n - 1 )*ratio + 1 +! +! where n is the grid number in x or y +! ratio is the refinement ratio between two resulotions +! +! liuz@ucar.edu , 2016-05, NCAR/MMM +!---------------------------------------------------------------------- + + implicit none + + include 'mpif.h' + + integer :: i, j, k, n, status + + INTEGER :: ntasks_x, ntasks_y, mytask, mytask_x, mytask_y + INTEGER :: new_local_comm, local_communicator + INTEGER, DIMENSION(2) :: dims, coords + LOGICAL, DIMENSION(2) :: isperiodic + INTEGER :: ids, ide, jds, jde, kds, kde, & + ips, ipe, jps, jpe, kps, kpe + INTEGER :: minx, miny + integer :: ratio = 3 + + integer :: io_status + + character (len = 255) :: vp_hires + character (len = 255) :: arg = "" + integer, parameter :: vp_unit = 8 + + integer :: ix, jy, kz + + real, dimension(:,:,:), allocatable :: v1, v2, v3, v4, v5 + real, dimension(:,:,:), allocatable :: v6, v7, v8, v9, v10, v11 + real, dimension(:,:,:), allocatable :: v1l, v2l, v3l, v4l, v5l + real, dimension(:,:,:), allocatable :: v6l, v7l, v8l, v9l, v10l, v11l + + integer size, ierror + integer :: cloud_cv_options ! 2 or 3 with cloud cv variables + integer :: use_cv_w ! =1 for w control variable + + LOGICAL :: file_exists + + + !------------------------------ + ! read program arguments + !------------------------------ + call getarg(1, arg) + call getarg(2, arg) + read(arg, '(i3)') cloud_cv_options + + call getarg(3, arg) + call getarg(4, arg) + read(arg, '(i3)') use_cv_w + + write (*, *) 'cloud_cv_options = ', cloud_cv_options, & + 'use_cv_w = ', use_cv_w + + !--------------------------------------------------------------------- + ! MPI initialization + !--------------------------------------------------------------------- + call MPI_INIT(ierror) + call MPI_COMM_SIZE(MPI_COMM_WORLD, size, ierror) + call MPI_COMM_RANK(MPI_COMM_WORLD, mytask, ierror) + + call MPASPECT( size, ntasks_x, ntasks_y, 1, 1 ) + if ( mytask == 0 ) WRITE( * , * )'Ntasks in X ',ntasks_x,', ntasks in Y ',ntasks_y + + new_local_comm = MPI_COMM_WORLD + dims(1) = ntasks_y ! rows + dims(2) = ntasks_x ! columns + isperiodic(1) = .false. + isperiodic(2) = .false. + CALL mpi_cart_create( new_local_comm, 2, dims, isperiodic, .false., local_communicator, ierror ) + CALL mpi_comm_rank( local_communicator, mytask, ierror ) + CALL mpi_cart_coords( local_communicator, mytask, 2, coords, ierror ) + mytask_x = coords(2) ! col task (x) + mytask_y = coords(1) ! row task (y) + !write (*,*) "The coords of task ",mytask, " is ",mytask_x,mytask_y + + io_status = 0 + + vp_hires='vp_output.global_hires' + inquire(FILE=trim(vp_hires), EXIST=file_exists) + + if ( .not. file_exists ) then + Write(*,*) "\nError: "//trim(vp_hires)//" not exists\n" + call exit(-1) + endif + + open(unit=vp_unit,file=trim(vp_hires),iostat=io_status,form='UNFORMATTED',status='OLD') + if (io_status /= 0) then + write(*,*) "Error ",io_status," opening vp file "//trim(vp_hires) + call exit(-1) + end if + if ( mytask == 0 ) write(*,*) 'Reading vp from : '//trim(vp_hires) + read(vp_unit) ide, jde, kde ! domain dimension (unstagered) + ide = ide + 1 ! WRF parallel decomposition is based on stagered grid + jde = jde + 1 + kde = kde + 1 + if ( mytask == 0 ) write(*,*) 'ide, jde, kde = ', ide, jde, kde + ids = 1 + jds = 1 + kds = 1 + + !--------------------------------------------------------------------- + ! Calculate the domain decomposition + !--------------------------------------------------------------------- + CALL compute_memory_dims_rsl_lite ( 0 , & + ids, ide, jds, jde, kds, kde, & + ips, ipe, jps, jpe, kps, kpe ) + ! convert to A-grid and middle levels on which control variables sit + if ( ipe == ide ) ipe = ipe - 1 + if ( jpe == jde ) jpe = jpe - 1 + if ( kpe == kde ) kpe = kpe - 1 + !WRITE(*,*)'*************************************' + !WRITE(90,*)'local ',ips,ipe,jps,jpe,kps,kpe + WRITE(*,*)'local ',ips,ipe,jps,jpe,kps,kpe + !WRITE(*,*)'*************************************' + + !--------------------------------------------------------------------- + ! allocate global vp variables (unstagered) + !--------------------------------------------------------------------- + allocate ( v1(ids:ide-1,jds:jde-1,kds:kde-1) ) + allocate ( v2(ids:ide-1,jds:jde-1,kds:kde-1) ) + allocate ( v3(ids:ide-1,jds:jde-1,kds:kde-1) ) + allocate ( v4(ids:ide-1,jds:jde-1,kds:kde-1) ) + allocate ( v5(ids:ide-1,jds:jde-1,kds:kde-1) ) + + if ( cloud_cv_options >= 2 ) then + allocate ( v6(ids:ide-1,jds:jde-1,kds:kde-1) ) + allocate ( v7(ids:ide-1,jds:jde-1,kds:kde-1) ) + allocate ( v8(ids:ide-1,jds:jde-1,kds:kde-1) ) + allocate ( v9(ids:ide-1,jds:jde-1,kds:kde-1) ) + allocate ( v10(ids:ide-1,jds:jde-1,kds:kde-1) ) + end if + + if ( use_cv_w == 1 ) allocate ( v11(ids:ide-1,jds:jde-1,kds:kde-1) ) + + read(vp_unit) v1, v2, v3, v4, v5 + if ( cloud_cv_options >= 2 )read(vp_unit) v6, v7, v8, v9, v10 + if ( use_cv_w == 1 )read(vp_unit) v11 + close(vp_unit) + + call MPI_BARRIER(MPI_COMM_WORLD,ierror) + if ( mytask == 0 ) write(*,*) 'Reading vp from : '//trim(vp_hires)//' is completeed' + + !--------------------------------------------------------------------- + ! allocate local vp variables (unstagered) + !--------------------------------------------------------------------- + ix = ipe-ips+1 + jy = jpe-jps+1 + kz = kpe-kps+1 + + allocate ( v1l(1:ix,1:jy,1:kz) ) + allocate ( v2l(1:ix,1:jy,1:kz) ) + allocate ( v3l(1:ix,1:jy,1:kz) ) + allocate ( v4l(1:ix,1:jy,1:kz) ) + allocate ( v5l(1:ix,1:jy,1:kz) ) + + if ( cloud_cv_options >= 2 ) then + allocate ( v6l(1:ix,1:jy,1:kz) ) + allocate ( v7l(1:ix,1:jy,1:kz) ) + allocate ( v8l(1:ix,1:jy,1:kz) ) + allocate ( v9l(1:ix,1:jy,1:kz) ) + allocate ( v10l(1:ix,1:jy,1:kz) ) + end if + + if ( use_cv_w == 1 ) allocate ( v11l(1:ix,1:jy,1:kz) ) + + !--------------------------------------------------------------------- + ! Scatter vp to PEs + !--------------------------------------------------------------------- + + v1l(1:ix,1:jy,1:kz) = v1(ips:ipe,jps:jpe,kps:kpe) + v2l(1:ix,1:jy,1:kz) = v2(ips:ipe,jps:jpe,kps:kpe) + v3l(1:ix,1:jy,1:kz) = v3(ips:ipe,jps:jpe,kps:kpe) + v4l(1:ix,1:jy,1:kz) = v4(ips:ipe,jps:jpe,kps:kpe) + v5l(1:ix,1:jy,1:kz) = v5(ips:ipe,jps:jpe,kps:kpe) + + if ( cloud_cv_options >= 2 ) then + v6l(1:ix,1:jy,1:kz) = v6(ips:ipe,jps:jpe,kps:kpe) + v7l(1:ix,1:jy,1:kz) = v7(ips:ipe,jps:jpe,kps:kpe) + v8l(1:ix,1:jy,1:kz) = v8(ips:ipe,jps:jpe,kps:kpe) + v9l(1:ix,1:jy,1:kz) = v9(ips:ipe,jps:jpe,kps:kpe) + v10l(1:ix,1:jy,1:kz) = v10(ips:ipe,jps:jpe,kps:kpe) + end if + + if ( use_cv_w == 1 ) v11l(1:ix,1:jy,1:kz) = v11(ips:ipe,jps:jpe,kps:kpe) + + write (vp_hires,'(A,i4.4)') "vp_input.",mytask + + open(unit=vp_unit,file=trim(vp_hires),iostat=io_status,form='UNFORMATTED',status='UNKNOWN') + if (io_status /= 0) then + write(*,*) "Error ",io_status," opening vp file "//trim(vp_hires) + call exit(-1) + end if + write(*,*) 'Writting vp on hires to : '//trim(vp_hires) + write(vp_unit) ips, ipe, jps, jpe, kps, kpe + write(vp_unit) v1l, v2l, v3l, v4l, v5l + if ( cloud_cv_options >= 2 )write(vp_unit) v6l, v7l, v8l, v9l, v10l + if ( use_cv_w == 1 )write(vp_unit) v11l + !write(*,*) 'Sample of cvt :',mytask, maxval(cvt), minval(cvt) + close(vp_unit) + + !--------------------------------------------------------------------- + ! The end + !--------------------------------------------------------------------- + !if ( mytask == 0 ) then + deallocate (v1) + deallocate (v2) + deallocate (v3) + deallocate (v4) + deallocate (v5) + deallocate (v1l) + deallocate (v2l) + deallocate (v3l) + deallocate (v4l) + deallocate (v5l) + + if ( cloud_cv_options >= 2 ) then + deallocate (v6) + deallocate (v7) + deallocate (v8) + deallocate (v9) + deallocate (v10) + deallocate (v6l) + deallocate (v7l) + deallocate (v8l) + deallocate (v9l) + deallocate (v10l) + end if + + if ( use_cv_w == 1 ) then + deallocate (v11) + deallocate (v11l) + end if + !endif + + call MPI_BARRIER(MPI_COMM_WORLD,ierror) + if ( mytask == 0 ) Write(*,*) "Distributting control variables completed successfully" + call MPI_FINALIZE(ierror) + +contains + + SUBROUTINE MPASPECT( P, MINM, MINN, PROCMIN_M, PROCMIN_N ) + IMPLICIT NONE + INTEGER P, M, N, MINI, MINM, MINN, PROCMIN_M, PROCMIN_N, ierror + MINI = 2*P + MINM = 1 + MINN = P + DO M = 1, P + IF ( MOD( P, M ) .EQ. 0 ) THEN + N = P / M + IF ( ABS(M-N) .LT. MINI & + .AND. M .GE. PROCMIN_M & + .AND. N .GE. PROCMIN_N & + ) THEN + MINI = ABS(M-N) + MINM = M + MINN = N + ENDIF + ENDIF + ENDDO + IF ( MINM .LT. PROCMIN_M .OR. MINN .LT. PROCMIN_N ) THEN + WRITE( * , * )'MPASPECT: UNABLE TO GENERATE PROCESSOR MESH. STOPPING.' + WRITE( * , * )' PROCMIN_M ', PROCMIN_M + WRITE( * , * )' PROCMIN_N ', PROCMIN_N + WRITE( * , * )' P ', P + WRITE( * , * )' MINM ', MINM + WRITE( * , * )' MINN ', MINN + call MPI_FINALIZE(ierror) + stop + ENDIF + RETURN + END SUBROUTINE MPASPECT + + SUBROUTINE compute_memory_dims_rsl_lite ( & + shw , & + ids, ide, jds, jde, kds, kde, & + ips, ipe, jps, jpe, kps, kpe ) + + IMPLICIT NONE + INTEGER, INTENT(IN) :: shw + INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde + INTEGER, INTENT(OUT) :: ips, ipe, jps, jpe, kps, kpe + + INTEGER Px, Py, P, i, j, k, ierr + +! xy decomposition + + ips = -1 + j = jds + ierr = 0 + DO i = ids, ide + CALL task_for_point ( i, j, ids, ide, jds, jde, ntasks_x, ntasks_y, Px, Py, & + minx, miny, ierr ) + IF ( ierr .NE. 0 ) stop 'error code returned by task_for_point ' + IF ( Px .EQ. mytask_x ) THEN + ipe = i + IF ( ips .EQ. -1 ) ips = i + ENDIF + ENDDO + ! handle setting the memory dimensions where there are no X elements assigned to this proc + IF (ips .EQ. -1 ) THEN + ipe = -1 + ips = 0 + ENDIF + jps = -1 + i = ids + ierr = 0 + DO j = jds, jde + CALL task_for_point ( i, j, ids, ide, jds, jde, ntasks_x, ntasks_y, Px, Py, & + minx, miny, ierr ) + IF ( ierr .NE. 0 ) stop 'error code returned by task_for_point ' + IF ( Py .EQ. mytask_y ) THEN + jpe = j + IF ( jps .EQ. -1 ) jps = j + ENDIF + ENDDO + ! handle setting the memory dimensions where there are no Y elements assigned to this proc + IF (jps .EQ. -1 ) THEN + jpe = -1 + jps = 0 + ENDIF + +!begin: wig; 12-Mar-2008 +! This appears redundant with the conditionals above, but we get cases with only +! one of the directions being set to "missing" when turning off extra processors. +! This may break the handling of setting only one of nproc_x or nproc_y via the namelist. + IF (ipe .EQ. -1 .or. jpe .EQ. -1) THEN + ipe = -1 + ips = 0 + jpe = -1 + jps = 0 + ENDIF +!end: wig; 12-Mar-2008 + +! extend the patch dimensions out shw along edges of domain + IF ( ips < ipe .and. jps < jpe ) THEN !wig; 11-Mar-2008 + IF ( mytask_x .EQ. 0 ) THEN + ips = ips - shw + ENDIF + IF ( mytask_x .EQ. ntasks_x-1 ) THEN + ipe = ipe + shw + ENDIF + IF ( mytask_y .EQ. 0 ) THEN + jps = jps - shw + ENDIF + IF ( mytask_y .EQ. ntasks_y-1 ) THEN + jpe = jpe + shw + ENDIF + ENDIF !wig; 11-Mar-2008 + + kps = 1 + kpe = kde-kds+1 + + END SUBROUTINE compute_memory_dims_rsl_lite + +end program da_vp_split diff --git a/var/mri4dvar/nc_increment.ncl b/var/mri4dvar/nc_increment.ncl new file mode 100644 index 0000000000..f8eb0468a5 --- /dev/null +++ b/var/mri4dvar/nc_increment.ncl @@ -0,0 +1,56 @@ +load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl" +load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl" +load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl" + +begin + + + filename = "analysis_increments" + + varnames = (/"psi","chi_u","t_u","rh","ps_u"/) + nvar = dimsizes(varnames) + + setfileoption("bin","ReadByteOrder","BigEndian") + dims = fbinrecread(filename,0,6,"integer") + ni=dims(1) ;;+ 1 + nj=dims(3) ;;+ 1 + nk=dims(5) ;;+ 1 + print("ni, nj, nk = "+ni+", "+nj+", "+nk) + + vv = fbinrecread(filename,1,(/4,nk,nj,ni/),"double") + + system("/bin/rm -f "+filename+".nc") ; remove any pre-existing file + ncdf = addfile(filename+".nc" ,"c") ; open output netCDF file + + ;=================================================================== + ; make time an UNLIMITED dimension; recommended for most applications + ;=================================================================== + ; filedimdef(ncdf,"time",-1,True) + + u = new((/nk, nj,ni/),double) + v = new((/nk, nj,ni/),double) + ;w = new((/nk, nj,ni/),double) + ;p = new((/nk, nj,ni/),double) + t = new((/nk, nj,ni/),double) + q = new((/nk, nj,ni/),double) + ;z = new((/nk, nj,ni/),double) + + u(:,:,:) = vv(0,:,:,:) + v(:,:,:) = vv(1,:,:,:) + ;w(:,:,:) = vv(2,:,:,:) + ;p(:,:,:) = vv(3,:,:,:) + t(:,:,:) = vv(2,:,:,:) + q(:,:,:) = vv(3,:,:,:) + ;z(:,:,:) = vv(6,:,:,:) + + + ncdf->u = u + ncdf->v = v + ;ncdf->w = w + ;ncdf->p = p + ncdf->t = t + ncdf->q = q + ;ncdf->z = z + +end + diff --git a/var/mri4dvar/nc_vpglobal.ncl b/var/mri4dvar/nc_vpglobal.ncl new file mode 100644 index 0000000000..981e8dd0d4 --- /dev/null +++ b/var/mri4dvar/nc_vpglobal.ncl @@ -0,0 +1,65 @@ +load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl" +load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl" +load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl" + +begin + + + ;filename = "vv_input.global" + filename = "vv_afterUvTransf" + + varnames = (/"psi","chi_u","t_u","rh","ps_u"/) + nvar = dimsizes(varnames) + + setfileoption("bin","ReadByteOrder","BigEndian") + dims = fbinrecread(filename,0,3,"integer") + ni=dims(0) + nj=dims(1) + nk=dims(2) + print("ni, nj, nk = "+ni+", "+nj+", "+nk) + + vv = fbinrecread(filename,1,(/5,nk,nj,ni/),"double") + + system("/bin/rm -f "+filename+".nc") ; remove any pre-existing file + ncdf = addfile(filename+".nc" ,"c") ; open output netCDF file + + ;=================================================================== + ; make time an UNLIMITED dimension; recommended for most applications + ;=================================================================== + ; filedimdef(ncdf,"time",-1,True) + + u = new((/nk, nj,ni/),double) + v = new((/nk, nj,ni/),double) + t = new((/nk, nj,ni/),double) + rh = new((/nk, nj,ni/),double) + ps = new((/nk, nj,ni/),double) + + ;do k = 0, nk-1 + ;do j = 0, nj-1 + ;do i = 0, ni-1 + ; v1(k,j,i) = v(i,j,k,1) + ; v2(k,j,i) = v(i,j,k,2) + ; v3(k,j,i) = v(i,j,k,3) + ; v4(k,j,i) = v(i,j,k,4) + ; ;v5(k,j,i) = v(i,j,k,5) + ;end do + ;end do + ;end do + + u(:,:,:) = vv(0,:,:,:) + v(:,:,:) = vv(1,:,:,:) + t(:,:,:) = vv(2,:,:,:) + rh(:,:,:) = vv(3,:,:,:) + ps(:,:,:) = vv(4,:,:,:) + + ncdf->u = u + ncdf->v = v + ncdf->t = t + ncdf->rh = rh + ncdf->ps = ps + + ;************************************************ + ; end of reading be.dat data + ;************************************************ + +end diff --git a/var/mri4dvar/nc_vphires.ncl b/var/mri4dvar/nc_vphires.ncl new file mode 100644 index 0000000000..8cee26a0fd --- /dev/null +++ b/var/mri4dvar/nc_vphires.ncl @@ -0,0 +1,64 @@ +load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl" +load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl" +load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl" + +begin + + + filename = "vp_output.global_hires" + + varnames = (/"psi","chi_u","t_u","rh","ps_u"/) + nvar = dimsizes(varnames) + + setfileoption("bin","ReadByteOrder","BigEndian") + dims = fbinrecread(filename,0,3,"integer") + ni=dims(0) + nj=dims(1) + nk=dims(2) + print("ni, nj, nk = "+ni+", "+nj+", "+nk) + + vv = fbinrecread(filename,1,(/5,nk,nj,ni/),"double") + + system("/bin/rm -f "+filename+".nc") ; remove any pre-existing file + ncdf = addfile(filename+".nc" ,"c") ; open output netCDF file + + ;=================================================================== + ; make time an UNLIMITED dimension; recommended for most applications + ;=================================================================== + ; filedimdef(ncdf,"time",-1,True) + + u = new((/nk, nj,ni/),double) + v = new((/nk, nj,ni/),double) + t = new((/nk, nj,ni/),double) + rh = new((/nk, nj,ni/),double) + ps = new((/nk, nj,ni/),double) + + ;do k = 0, nk-1 + ;do j = 0, nj-1 + ;do i = 0, ni-1 + ; v1(k,j,i) = v(i,j,k,1) + ; v2(k,j,i) = v(i,j,k,2) + ; v3(k,j,i) = v(i,j,k,3) + ; v4(k,j,i) = v(i,j,k,4) + ; ;v5(k,j,i) = v(i,j,k,5) + ;end do + ;end do + ;end do + + u(:,:,:) = vv(0,:,:,:) + v(:,:,:) = vv(1,:,:,:) + t(:,:,:) = vv(2,:,:,:) + rh(:,:,:) = vv(3,:,:,:) + ps(:,:,:) = vv(4,:,:,:) + + ncdf->u = u + ncdf->v = v + ncdf->t = t + ncdf->rh = rh + ncdf->ps = ps + + ;************************************************ + ; end of reading be.dat data + ;************************************************ + +end diff --git a/var/mri4dvar/nc_vpinput.ncl b/var/mri4dvar/nc_vpinput.ncl new file mode 100644 index 0000000000..2c743f81c2 --- /dev/null +++ b/var/mri4dvar/nc_vpinput.ncl @@ -0,0 +1,64 @@ +load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl" +load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl" +load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl" + +begin + + + filename = "vp_input.0000" + + varnames = (/"psi","chi_u","t_u","rh","ps_u"/) + nvar = dimsizes(varnames) + + setfileoption("bin","ReadByteOrder","BigEndian") + dims = fbinrecread(filename,0,6,"integer") + ni=dims(1)-dims(0)+1 + nj=dims(3)-dims(2)+1 + nk=dims(5)-dims(4)+1 + print("ni, nj, nk = "+ni+", "+nj+", "+nk) + + vv = fbinrecread(filename,1,(/5,nk,nj,ni/),"double") + + system("/bin/rm -f "+filename+".nc") ; remove any pre-existing file + ncdf = addfile(filename+".nc" ,"c") ; open output netCDF file + + ;=================================================================== + ; make time an UNLIMITED dimension; recommended for most applications + ;=================================================================== + ; filedimdef(ncdf,"time",-1,True) + + u = new((/nk, nj,ni/),double) + v = new((/nk, nj,ni/),double) + t = new((/nk, nj,ni/),double) + rh = new((/nk, nj,ni/),double) + ps = new((/nk, nj,ni/),double) + + ;do k = 0, nk-1 + ;do j = 0, nj-1 + ;do i = 0, ni-1 + ; v1(k,j,i) = v(i,j,k,1) + ; v2(k,j,i) = v(i,j,k,2) + ; v3(k,j,i) = v(i,j,k,3) + ; v4(k,j,i) = v(i,j,k,4) + ; ;v5(k,j,i) = v(i,j,k,5) + ;end do + ;end do + ;end do + + u(:,:,:) = vv(0,:,:,:) + v(:,:,:) = vv(1,:,:,:) + t(:,:,:) = vv(2,:,:,:) + rh(:,:,:) = vv(3,:,:,:) + ps(:,:,:) = vv(4,:,:,:) + + ncdf->u = u + ncdf->v = v + ncdf->t = t + ncdf->rh = rh + ncdf->ps = ps + + ;************************************************ + ; end of reading be.dat data + ;************************************************ + +end diff --git a/var/mri4dvar/nc_vplocal.ncl b/var/mri4dvar/nc_vplocal.ncl new file mode 100644 index 0000000000..ef0bad0e43 --- /dev/null +++ b/var/mri4dvar/nc_vplocal.ncl @@ -0,0 +1,64 @@ +load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl" +load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl" +load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl" + +begin + + + filename = "vp_0020" + + varnames = (/"psi","chi_u","t_u","rh","ps_u"/) + nvar = dimsizes(varnames) + + setfileoption("bin","ReadByteOrder","BigEndian") + dims = fbinrecread(filename,0,15,"integer") + ni=dims(12) + nj=dims(13) + nk=dims(14) + print("ni, nj, nk = "+ni+", "+nj+", "+nk) + + v = fbinrecread(filename,1,(/5,nk,nj,ni/),"double") + + system("/bin/rm -f "+filename+".nc") ; remove any pre-existing file + ncdf = addfile(filename+".nc" ,"c") ; open output netCDF file + + ;=================================================================== + ; make time an UNLIMITED dimension; recommended for most applications + ;=================================================================== + ; filedimdef(ncdf,"time",-1,True) + + ;v1 = new((/nk, nj,ni/),double) + ;v2 = new((/nk, nj,ni/),double) + ;v3 = new((/nk, nj,ni/),double) + v4 = new((/nk, nj,ni/),double) + v5 = new((/nk, nj,ni/),double) + + ;do k = 0, nk-1 + ;do j = 0, nj-1 + ;do i = 0, ni-1 + ; v1(k,j,i) = v(i,j,k,1) + ; v2(k,j,i) = v(i,j,k,2) + ; v3(k,j,i) = v(i,j,k,3) + ; v4(k,j,i) = v(i,j,k,4) + ; ;v5(k,j,i) = v(i,j,k,5) + ;end do + ;end do + ;end do + + ;v1(:,:,:) = v(1,:,:,:) + ;v2(:,:,:) = v(2,:,:,:) + ;v3(:,:,:) = v(3,:,:,:) + v4(:,:,:) = v(4,:,:,:) + ;v5(:,:,:) = v(5,:,:,:) + + ;ncdf->v1 = v1 + ;ncdf->v2 = v2 + ;ncdf->v3 = v3 + ncdf->v4 = v4 + ;ncdf->v5 = v5 + + ;************************************************ + ; end of reading be.dat data + ;************************************************ + +end diff --git a/var/mri4dvar/rsl_lite.h b/var/mri4dvar/rsl_lite.h new file mode 100644 index 0000000000..03a47fca20 --- /dev/null +++ b/var/mri4dvar/rsl_lite.h @@ -0,0 +1,168 @@ +#ifndef CRAY +# ifdef NOUNDERSCORE +# define RSL_LITE_ERROR_DUP1 rsl_error_dup1 +# define BYTE_BCAST byte_bcast +# define RSL_LITE_INIT_EXCH rsl_lite_init_exch +# define RSL_LITE_EXCH_Y rsl_lite_exch_y +# define RSL_LITE_EXCH_X rsl_lite_exch_x +# define RSL_LITE_PACK rsl_lite_pack +# define RSL_LITE_BCAST_MSGS rsl_lite_bcast_msgs +# define RSL_LITE_TO_CHILD_MSG rsl_lite_to_child_msg +# define RSL_LITE_TO_CHILD_INFO rsl_lite_to_child_info +# define RSL_LITE_FROM_PARENT_MSG rsl_lite_from_parent_msg +# define RSL_LITE_FROM_PARENT_INFO rsl_lite_from_parent_info +# define RSL_LITE_MERGE_MSGS rsl_lite_merge_msgs +# define RSL_LITE_TO_PARENT_MSG rsl_lite_to_parent_msg +# define RSL_LITE_TO_PARENT_INFO rsl_lite_to_parent_info +# define RSL_LITE_FROM_CHILD_MSG rsl_lite_from_child_msg +# define RSL_LITE_FROM_CHILD_INFO rsl_lite_from_child_info +# define RSL_INTERNAL_MILLICLOCK rsl_internal_milliclock +# define RSL_INTERNAL_MICROCLOCK rsl_internal_microclock +# define TASK_FOR_POINT task_for_point +# define TASK_FOR_POINT_MESSAGE task_for_point_message +# define RSL_LITE_INIT_PERIOD rsl_lite_init_period +# define RSL_LITE_EXCH_PERIOD_Y rsl_lite_exch_period_y +# define RSL_LITE_EXCH_PERIOD_X rsl_lite_exch_period_x +# define RSL_LITE_PACK_PERIOD rsl_lite_pack_period +# define RSL_LITE_INIT_SWAP rsl_lite_init_swap +# define RSL_LITE_SWAP rsl_lite_swap +# define RSL_LITE_PACK_SWAP rsl_lite_pack_swap +# define RSL_LITE_INIT_CYCLE rsl_lite_init_cycle +# define RSL_LITE_CYCLE rsl_lite_cycle +# define RSL_LITE_PACK_CYCLE rsl_lite_pack_cycle +# define F_PACK_LINT f_pack_lint +# define F_PACK_INT f_pack_int +# define F_UNPACK_LINT f_unpack_lint +# define F_UNPACK_INT f_unpack_int +# define RSL_LITE_GET_HOSTNAME rsl_lite_get_hostname +# else +# ifdef F2CSTYLE +# define RSL_LITE_ERROR_DUP1 rsl_error_dup1__ +# define BYTE_BCAST byte_bcast__ +# define RSL_LITE_INIT_EXCH rsl_lite_init_exch__ +# define RSL_LITE_EXCH_Y rsl_lite_exch_y__ +# define RSL_LITE_EXCH_X rsl_lite_exch_x__ +# define RSL_LITE_PACK rsl_lite_pack__ +# define RSL_LITE_BCAST_MSGS rsl_lite_bcast_msgs__ +# define RSL_LITE_TO_CHILD_MSG rsl_lite_to_child_msg__ +# define RSL_LITE_TO_CHILD_INFO rsl_lite_to_child_info__ +# define RSL_LITE_FROM_PARENT_MSG rsl_lite_from_parent_msg__ +# define RSL_LITE_FROM_PARENT_INFO rsl_lite_from_parent_info__ +# define RSL_LITE_MERGE_MSGS rsl_lite_merge_msgs__ +# define RSL_LITE_TO_PARENT_MSG rsl_lite_to_parent_msg__ +# define RSL_LITE_TO_PARENT_INFO rsl_lite_to_parent_info__ +# define RSL_LITE_FROM_CHILD_MSG rsl_lite_from_child_msg__ +# define RSL_LITE_FROM_CHILD_INFO rsl_lite_from_child_info__ +# define RSL_INTERNAL_MILLICLOCK rsl_internal_milliclock__ +# define RSL_INTERNAL_MICROCLOCK rsl_internal_microclock__ +# define TASK_FOR_POINT task_for_point__ +# define TASK_FOR_POINT_MESSAGE task_for_point_message__ +# define RSL_LITE_INIT_PERIOD rsl_lite_init_period__ +# define RSL_LITE_EXCH_PERIOD_Y rsl_lite_exch_period_y__ +# define RSL_LITE_EXCH_PERIOD_X rsl_lite_exch_period_x__ +# define RSL_LITE_PACK_PERIOD rsl_lite_pack_period__ +# define RSL_LITE_INIT_SWAP rsl_lite_init_swap__ +# define RSL_LITE_SWAP rsl_lite_swap__ +# define RSL_LITE_PACK_SWAP rsl_lite_pack_swap__ +# define RSL_LITE_INIT_CYCLE rsl_lite_init_cycle__ +# define RSL_LITE_CYCLE rsl_lite_cycle__ +# define RSL_LITE_PACK_CYCLE rsl_lite_pack_cycle__ +# define F_PACK_LINT f_pack_lint__ +# define F_PACK_INT f_pack_int__ +# define F_UNPACK_LINT f_unpack_lint__ +# define F_UNPACK_INT f_unpack_int__ +# define RSL_LITE_GET_HOSTNAME rsl_lite_get_hostname__ +# else +# define RSL_LITE_ERROR_DUP1 rsl_error_dup1_ +# define BYTE_BCAST byte_bcast_ +# define RSL_LITE_INIT_EXCH rsl_lite_init_exch_ +# define RSL_LITE_EXCH_Y rsl_lite_exch_y_ +# define RSL_LITE_EXCH_X rsl_lite_exch_x_ +# define RSL_LITE_PACK rsl_lite_pack_ +# define RSL_LITE_BCAST_MSGS rsl_lite_bcast_msgs_ +# define RSL_LITE_TO_CHILD_MSG rsl_lite_to_child_msg_ +# define RSL_LITE_TO_CHILD_INFO rsl_lite_to_child_info_ +# define RSL_LITE_FROM_PARENT_MSG rsl_lite_from_parent_msg_ +# define RSL_LITE_FROM_PARENT_INFO rsl_lite_from_parent_info_ +# define RSL_LITE_MERGE_MSGS rsl_lite_merge_msgs_ +# define RSL_LITE_TO_PARENT_MSG rsl_lite_to_parent_msg_ +# define RSL_LITE_TO_PARENT_INFO rsl_lite_to_parent_info_ +# define RSL_LITE_FROM_CHILD_MSG rsl_lite_from_child_msg_ +# define RSL_LITE_FROM_CHILD_INFO rsl_lite_from_child_info_ +# define RSL_INTERNAL_MILLICLOCK rsl_internal_milliclock_ +# define RSL_INTERNAL_MICROCLOCK rsl_internal_microclock_ +# define TASK_FOR_POINT task_for_point_ +# define TASK_FOR_POINT_MESSAGE task_for_point_message_ +# define RSL_LITE_INIT_PERIOD rsl_lite_init_period_ +# define RSL_LITE_EXCH_PERIOD_Y rsl_lite_exch_period_y_ +# define RSL_LITE_EXCH_PERIOD_X rsl_lite_exch_period_x_ +# define RSL_LITE_PACK_PERIOD rsl_lite_pack_period_ +# define RSL_LITE_INIT_SWAP rsl_lite_init_swap_ +# define RSL_LITE_SWAP rsl_lite_swap_ +# define RSL_LITE_PACK_SWAP rsl_lite_pack_swap_ +# define RSL_LITE_INIT_CYCLE rsl_lite_init_cycle_ +# define RSL_LITE_CYCLE rsl_lite_cycle_ +# define RSL_LITE_PACK_CYCLE rsl_lite_pack_cycle_ +# define F_PACK_LINT f_pack_lint_ +# define F_PACK_INT f_pack_int_ +# define F_UNPACK_LINT f_unpack_lint_ +# define F_UNPACK_INT f_unpack_int_ +# define RSL_LITE_GET_HOSTNAME rsl_lite_get_hostname_ +# endif +# endif +#endif + +#define RSL_SENDBUF 0 +#define RSL_RECVBUF 1 +#define RSL_FREEBUF 3 +#define RSL_MAXPROC 10000 +#define RSL_INVALID -1 + +/* this must be the same as defined in frame/module_driver_constants.F */ +#define DATA_ORDER_XYZ 1 +#define DATA_ORDER_YXZ 2 +#define DATA_ORDER_ZXY 3 +#define DATA_ORDER_ZYX 4 +#define DATA_ORDER_XZY 5 +#define DATA_ORDER_YZX 6 + + +#define RSL_MALLOC(T,N) (T *)rsl_malloc(__FILE__,__LINE__,(sizeof(T))*(N)) +#define RSL_FREE(P) rsl_free(P) + +char * buffer_for_proc ( int P, int size, int code ) ; +void * rsl_malloc( char * f, int l, int s ) ; +typedef int * int_p ; + +#define INDEX_2(A,B,NB) ( (B) + (A)*(NB) ) +#define INDEX_3(A,B,NB,C,NC) INDEX_2( (A), INDEX_2( (B), (C), (NC) ), (NB)*(NC) ) + +#ifndef STUBMPI +# define RSL_FATAL(N) MPI_Abort(MPI_COMM_WORLD, 9) +#else +# define RSL_FATAL(N) exit(9) ; +#endif +#ifndef MS_SUA +# define RSL_TEST_ERR(T,M) {if(T){fprintf(stderr,"rsl_lite error (\"%s\":%d) %s\n",__FILE__,__LINE__,M);RSL_FATAL(5);}} +#else +# define RSL_TEST_ERR(T,M) {if(T){RSL_FATAL(5);}} +#endif + +#ifndef MPI2_SUPPORT +typedef int MPI_Fint; +# define MPI_Comm_c2f(comm) (MPI_Fint)(comm) +# define MPI_Comm_f2c(comm) (MPI_Comm)(comm) +#endif + +typedef struct rsl_list { + struct rsl_list * next ; + void * data ; /* pointer to some node */ +#ifdef crayx1 + int info1 ; /* blank info field */ + int info2 ; /* blank info field */ +#else + short info1 ; /* blank info field */ + short info2 ; /* blank info field */ +#endif +} rsl_list_t ; + diff --git a/var/mri4dvar/run_mri3d4dvar.csh_lsf b/var/mri4dvar/run_mri3d4dvar.csh_lsf new file mode 100755 index 0000000000..67b307fc47 --- /dev/null +++ b/var/mri4dvar/run_mri3d4dvar.csh_lsf @@ -0,0 +1,742 @@ +#!/bin/tcsh -f + +#set echo +set nonomatch +set TOP_DIR=/glade/p/mmm/liuz/cwb2016 +set JOB='LSF' +set PROJID='P64000471' +set QUEUE='regular' +set OS=`uname -s` +set WRFDA_DIR=$TOP_DIR/liuz_newcode/WRFDA_V38 +set MULTI_INC_TOOLS=$TOP_DIR/liuz_newcode/multi_inc_tools_new +set DATA_DIR=$TOP_DIR/20150614case/2015061400_ztd30min + +set RUN_STAGE1=true +set RUN_STAGE2=true +set RUN_STAGE3=true + +#---------------- User Configuration -------------- +set VAR4D=$1 # false if 3DVAR +set VAR4D_LBC=false +set MULTI_INC=$2 +set use_cvt=$3 +set use_vp=$4 +set observerclocktime=00:30 +set minimizeclocktime=03:00 +set WORK_DIR=$TOP_DIR/20150614case/$5 +set THIN_FACTOR=($6 $7) +set BE1=$TOP_DIR/20150614case/be.dat_$8 +set BE2=$TOP_DIR/20150614case/be.dat_$9 +set BE3=$TOP_DIR/20150614case/be.dat_2km +#----------------- User Configuration ------------- + +mkdir -p $WORK_DIR; cd $WORK_DIR + +if ( $VAR4D == true ) then + ln -sf ${WRFDA_DIR}/run/RRTM_DATA_DBL RRTM_DATA + ln -sf ${WRFDA_DIR}/run/RRTMG_LW_DATA_DBL RRTMG_LW_DATA + ln -sf ${WRFDA_DIR}/run/RRTMG_SW_DATA_DBL RRTMG_SW_DATA + ln -sf ${WRFDA_DIR}/run/SOILPARM.TBL . + ln -sf ${WRFDA_DIR}/run/VEGPARM.TBL . + ln -sf ${WRFDA_DIR}/run/GENPARM.TBL . +endif +ln -sf ${WRFDA_DIR}/run/LANDUSE.TBL . +ln -sf ${WRFDA_DIR}/var/da/da_wrfvar.exe . + +cp ${DATA_DIR}/wrfinput_d01 orig_fg +if ( $VAR4D == true ) then + cp ${DATA_DIR}/wrfinput_d01 orig_wrfinput_d01 + cp ${DATA_DIR}/wrfbdy_d01 orig_wrfbdy_d01 + cp ${DATA_DIR}/fg02 orig_fg02 +endif + +if ( $VAR4D == true ) then + cp ${DATA_DIR}/namelist.input_cv7_4dvar orig_namelist.input + ln -sf ${DATA_DIR}/ob*.ascii . +else + cp ${DATA_DIR}/namelist.input_cv7_3dvar orig_namelist.input + ln -sf ${DATA_DIR}/ob01.ascii ./ob.ascii +endif + +#=============================================================================; +# Purpose : Script for running WRF-3D/4DVAR with Multi-resolution +# +# Assuming : 1. All the necessary files required by 4DVAR run are +# already under $RUN_DIR, such as be.dat, namelist.input, *.tbl, +# fg, fg02, wrfbdy_d01, da_wrfvar.exe, da_update_bc, etc. +# +# 2. da_bilin.exe, da_bdy.exe, da_thin.exe, da_vp_bilin.exe +# da_vp_split.exe located under ${MULTI_INC_TOOLS} +# +# How to run : When everything is ready to go, call this script instead of +# da_wrfvar.exe for a Multi-incremental run +# +# run_mri3d4dvar.csh +# +# Limitation : Grids need to match +# ( n - 1 ) mod m = 0 +# where n is the x/y grid number of high resolution, m is the +# x/y grid number of low resolution. Default ratio is 1:3. +# +# Platform : All the commands involved by this script are GNU/Linux +# commands on CentOS box. If involved this script other than +# CentOS, commands may not run as your expect, double check +# it before using. +# +# Not fullly test with all platforms, use it at your own risk +# +# jliu@ucar.edu, MMM/NCAR, 01/13/2012 +# +# Remove RUN_STAGE +# Add the capability of different resolutions for different outer-loops +# xinzhang@ucar.edu, MMM/NCAR, 11/25/2013 +# +# Re-write script and add more comments to ease understanding +# Unify Multi-Resolution Incremental 3DVAR and 4DVAR, i.e., MRI-3D/4DVAR +# Zhiquan (Jake) Liu, liuz@ucar.edu, NCAR/MMM, August 2016 +#=============================================================================; + + +#----------------------------User settings------------------------------------; +# +# Use these environment variables to override the default settings +# +# Variable Names Default Value Description +# +# RUN_CMD mpirun -np 16 Job submit command, "" for serial and OpenMP +# +# TIME_STEP_STAGE2 auto detect Stage2 Time step for integration in integer +# seconds as large as 6*DX (in km) and must be +# exactly divisible by VAR4D_bin exactly. +# +# RADT_STAGE2 auto detect Minutes between radiation physics calls for +# Multi_inc stage2. 1 minute per km of dx. +# +# THIN_FACTOR 3 Thinning ratio +# +# MULTI_INC TRUE TRUE/FALSE - Multi-incremental/full resolution +# +# MAX_OUTERLOOP 1 outerloop number for Multi-incremental run +# +if ( ! $?RUN_CMD ) set RUN_CMD="mpiexec -n " # "" - Serial/OpenMP +if ( ! $?NPROCS_NL ) set NPROCS_NL=1024 # Number of processing cores +if ( ! $?NPROCS ) set NPROCS=(1024 1024) # Number of processing cores +if ( ! $?MAX_OUTERLOOP ) set MAX_OUTERLOOP=2 # Only available for Multi-incremental run +if ( ! $?THIN_FACTOR ) set THIN_FACTOR=(1 1) # default decimation factor + @ n1 = $MAX_OUTERLOOP + @ n2 = $#THIN_FACTOR + @ n3 = $#NPROCS + if ( $n1 > $n2 || $n1 > $n3 ) then + echo "The dimension of THIN_FACTOR ($#THIN_FACTOR) should be equal to MAX_OUTERLOOP ($MAX_OUTERLOOP) " + exit -1 + endif + +#----------------------------End of User settings-----------------------------; + +if ( ! $?MULTI_INC_TOOLS ) then + if ( ${#argv} > 0 ) then + set MULTI_INC_TOOLS=$1 + else + set appname=${0:t} + set MULTI_INC_TOOLS=${0:h} + if ( "$MULTI_INC_TOOLS" == "$appname" ) set MULTI_INC_TOOLS="." + endif +endif + +if ( $MULTI_INC == true ) then + + foreach f (da_thin.exe da_bilin.exe da_bdy.exe \ + da_vp_bilin.exe da_vp_split.exe \ + nc_vpglobal.ncl nc_vphires.ncl nc_increment.ncl ) + if ( -e ${MULTI_INC_TOOLS}/$f ) then + if ( "$MULTI_INC_TOOLS" != "." ) then + ln -sf ${MULTI_INC_TOOLS}/$f . + endif + else + echo "$f NOT exists" > FAIL + exit -1 + endif + end + + set FILES_TO_CLEAN=(ana02 ana02_hires ana02_lores \ + wrfvar_output wrfvar_output_hires wrfvar_output_lores \ + FAIL .current_stage .last_stage .final_stage \ + namelist.input \ + rsl* gts* vp_* outerloop_*) + + #rm -rf $FILES_TO_CLEAN + + touch .current_stage .last_stage .final_stage + + set N=1 + #if ( $VAR4D == true ) then + @ nloop = $MAX_OUTERLOOP + 1 + #else + # @ nloop = $MAX_OUTERLOOP + #endif + + while ( $N <= $nloop ) + + if ( $N == $nloop ) then + set RUN_STAGE1=true # only run omb for the last loop + set RUN_STAGE2=false + set RUN_STAGE3=false + set istage=1 # 1 for observer; 0 for normal 3dvar mode + set nouterloop=1 + set ninnerloop=0 + else + set RUN_STAGE1=true + set RUN_STAGE2=true + set RUN_STAGE3=true + set istage=1 + set nouterloop=1 + set ninnerloop=40 + endif + +#---------------- User Configuration -------------- + if ( $N == 1 ) ln -sf ${BE1} be.dat + if ( $N == 2 ) ln -sf ${BE2} be.dat + if ( $N == 3 ) ln -sf ${BE3} be.dat +#---------------- User Configuration -------------- + + if ( $N == 1 ) then + cp orig_fg o${N}s1_fg # stage1 for observer step + if ( $VAR4D == true ) then + cp orig_fg02 o${N}s1_fg02 + endif + else # from 2nd loop, use previous loop's analysis + @ NM1 = $N - 1 + cp ./o${NM1}s3/wrfvar_output_hires o${N}s1_fg + if ( $VAR4D == true ) then + cp orig_fg02 o${N}s1_fg02 + endif + endif + + if ( $RUN_STAGE1 == "true" ) then + + echo "--------------------------------------" + echo "| Run outerloop-$N : Stage1-Observer |" + echo "--------------------------------------" + + echo "--------------------------------------" + echo "| 1.0 Set up namlist.input for stage1 |" + echo "--------------------------------------" + #----------------------------------- + # &wrfvar1 + # multi_inc=1, # stage1 for omb only + #--------------------------------------- + if ( $OS == "Darwin" ) then + sed -e "/[Mm][Uu][Ll][Tt][Ii]_[Ii][Nn][Cc][ \t]*=/ c\ \ + multi_inc=${istage}," \ + -e "/[m][a][x]_[e][x][t]_[i][t][s][ \t]*=/ c\ \ + max_ext_its=${nouterloop}," \ + -e "/[n][t][m][a][x][ \t]*=/ c\ \ + ntmax=${ninnerloop}," \ + orig_namelist.input > o${N}s1_namelist.input + else + sed -e "/[Mm][Uu][Ll][Tt][Ii]_[Ii][Nn][Cc][ \t]*=/ c\multi_inc=${istage}," \ + -e "/[m][a][x]_[e][x][t]_[i][t][s][ \t]*=/ c\max_ext_its=${nouterloop}," \ + -e "/[n][t][m][a][x][ \t]*=/ c\ntmax=${ninnerloop}," \ + orig_namelist.input > o${N}s1_namelist.input + endif + + + if ( $VAR4D == true ) then + echo "--------------------------------------------" + echo "| 1.1 Generating boundary file for stage1 |" + echo "--------------------------------------------" + + da_bdy.exe -fg o${N}s1_fg \ + -fg02 o${N}s1_fg02 \ + -bdy orig_wrfbdy_d01 \ + -o o${N}s1_wrfbdy_d01 \ + >& o${N}s1_da_bdy.log + if ( ! -e o${N}s1_wrfbdy_d01 ) then + echo "generating bdy file for outloop1 stage1 failed" > FAIL + exit -1 + endif + endif + + echo "--------------------------------------------" + echo "| 1.2 run WRF-VAR in observer mode |" + echo "--------------------------------------------" + + if ( -e namelist.input ) rm namelist.input + ln -sf o${N}s1_namelist.input namelist.input + ln -sf o${N}s1_fg fg + if ( $VAR4D == true ) then + ln -sf o${N}s1_fg02 fg02 + ln -sf o${N}s1_fg wrfinput_d01 + ln -sf o${N}s1_wrfbdy_d01 wrfbdy_d01 + endif + + echo "outerloop${N}_stage1" > .current_stage + echo "outerloop${N}_stage1" > .final_stage + +#-------------------------------------- + if ( $JOB == 'LSF' ) then + if ( -e submit_lsf.csh ) rm -f submit_lsf.csh +cat > submit_lsf.csh < FAIL + exit -1 + endif + + echo "------------------------------" + echo "| 1.3 Save and clean output |" + echo "------------------------------" + + set out_storage=o${N}s1 + if ( ! -d $out_storage ) mkdir $out_storage; #mkdir $out_storage/RSL + mv submit_lsf.csh fort.140 namelist.input namelist.output* $out_storage + mv rsl.* $out_storage + #mv o${N}s1.*.out o${N}s1.*.err $out_storage + rm rej_obs_conv* gts_omb_oma_*.* filtered_obs.* unpert_obs* + rm analysis_increments wrfvar_output + mv gts_omb.* $out_storage # to be used in stage2 + mv gts_omb_oma_* filtered_obs_* qcstat_conv_01 $out_storage + mv buddy_check check_max_iv jo cost_fn grad_fn statistics $out_storage + + echo "outerloop${N}_stage1" > .last_stage + + if ( "`cat .current_stage`" != "outerloop${N}_stage1" && \ + "`cat .last_stage`" != "outerloop${N}_stage1" ) then + echo "outerloop${N}_stage1 was NOT done, aborted Stage2" + exit -1 + endif + endif # end if RUN_STAGE1 + +#--------------------------------- + if ( $RUN_STAGE2 == "true" ) then + + echo "--------------------------------------" + echo "| Run outerloop-$N : Stage2-Minimizer |" + echo "--------------------------------------" + + echo "--------------------------------------------" + echo "| 2.0 Set up namelist.input for stage2 |" + echo "--------------------------------------------" + + #--------------------------------------- + # &wrfvar1 + # multi_inc=2, # stage2 for minimization + # dx= + # dy=${NL_DY}.0, + # e_we=$NL_E_WE, + # e_sn=$NL_E_SN, + # time_step=$TIME_STEP_STAGE2, + # var4d_bin= + #------------------------------------------ + set NL_DX=`grep -i -E "dx[ \t]*=" orig_namelist.input | sed -e 's/\t/ /g' -e 's/ *//g' -e 's/,//' -e 's/\r//g'| cut -c4-` + set NL_DY=`grep -i -E "dy[ \t]*=" orig_namelist.input | sed -e 's/\t/ /g' -e 's/ *//g' -e 's/,//' -e 's/\r//g'| cut -c4-` + set NL_E_WE=`grep -i -E "e_we[ \t]*=" orig_namelist.input | sed -e 's/\t/ /g' -e 's/ *//g' -e 's/,//' -e 's/\r//g'| cut -c6-` + set NL_E_SN=`grep -i -E "e_sn[ \t]*=" orig_namelist.input | sed -e 's/\t/ /g' -e 's/ *//g' -e 's/,//' -e 's/\r//g'| cut -c6-` + + set NL_DX=`echo $NL_DX | sed 's/\.[0-9]*//g'` + set NL_DY=`echo $NL_DY | sed 's/\.[0-9]*//g'` + set NL_E_WE=`echo $NL_E_WE | sed 's/\.[0-9]*//g'` + set NL_E_SN=`echo $NL_E_SN | sed 's/\.[0-9]*//g'` + + @ NL_DX = $NL_DX * $THIN_FACTOR[$N] + @ NL_DY = $NL_DY * $THIN_FACTOR[$N] + @ NL_E_WE = ($NL_E_WE - 1) / $THIN_FACTOR[$N] + 1 + @ NL_E_SN = ($NL_E_SN - 1) / $THIN_FACTOR[$N] + 1 + + @ RADT_STAGE2 = $NL_DX / 1000 + + set NL_VAR4D_BIN=`grep -i -E "var4d_bin[ \t]*=" orig_namelist.input | \ + sed -e 's/\t/ /g' -e 's/ *//g' \ + -e 's/\.[0-9]*//g' -e 's/,//' \ + -e 's/\r//g' | \ + cut -c11-` + @ TIME_STEP_STAGE2 = ( $NL_DX / 1000 ) * 6 + set i=$TIME_STEP_STAGE2 + while ( $i != 0 ) + @ i = $NL_VAR4D_BIN % $TIME_STEP_STAGE2 + @ TIME_STEP_STAGE2-- + end + @ TIME_STEP_STAGE2++ + + if ( $OS == "Darwin" ) then + sed -e '/[Mm][Uu][Ll][Tt][Ii]_[Ii][Nn][Cc]/d' \ + -e '/&[Ww][Rr][Ff][Vv][Aa][Rr]1$/ a\ \ + multi_inc=2,' \ + -e "/[Dd][Xx][ \t]*=/ c\ \ + dx=${NL_DX}.0," \ + -e "/[Dd][Yy][ \t]*=/ c\ \ + dy=${NL_DY}.0," \ + -e "/[Ee]_[Ww][Ee][ \t]*=/ c\ \ + e_we=$NL_E_WE,"\ + -e "/[Ee]_[Ss][Nn][ \t]*=/ c\ \ + e_sn=$NL_E_SN," \ + -e "/[Tt][Ii][Mm][Ee]_[Ss][Tt][Ee][Pp][ \t]*=/ c\ \ + time_step=$TIME_STEP_STAGE2," \ + -e "/[u][s][e]_[i][n][v][e][r][s][e]_[s][q][u][a][r][e][r][o][o][t][b][ \t]*=/ c\ \ + use_inverse_squarerootb=$use_vp," \ + -e "/[u][s][e]_[i][n][t][e][r][p][o][l][a][t][e]_[c][v][t][ \t]*=/ c\ \ + use_interpolate_cvt=$use_cvt," \ + orig_namelist.input > o${N}s2_namelist.input + else + sed -e '/[Mm][Uu][Ll][Tt][Ii]_[Ii][Nn][Cc]/d' \ + -e '/&[Ww][Rr][Ff][Vv][Aa][Rr]1$/ a\multi_inc=2,' \ + -e "/[Dd][Xx][ \t]*=/ c\dx=${NL_DX}.0," \ + -e "/[Dd][Yy][ \t]*=/ c\dy=${NL_DY}.0," \ + -e "/[Ee]_[Ww][Ee][ \t]*=/ c\e_we=$NL_E_WE," \ + -e "/[Ee]_[Ss][Nn][ \t]*=/ c\e_sn=$NL_E_SN," \ + -e "/[Tt][Ii][Mm][Ee]_[Ss][Tt][Ee][Pp][ \t]*=/ c\time_step=$TIME_STEP_STAGE2," \ + -e "/[u][s][e]_[i][n][v][e][r][s][e]_[s][q][u][a][r][e][r][o][o][t][b][ \t]*=/ c\use_inverse_squarerootb=$use_vp," \ + -e "/[u][s][e]_[i][n][t][e][r][p][o][l][a][t][e]_[c][v][t][ \t]*=/ c\use_interpolate_cvt=$use_cvt," \ + orig_namelist.input > o${N}s2_namelist.input + endif + + if ( $N > 1 ) then # only do this step from outer loop 2 + + @ NM1 = $N - 1 + + if ( $use_vp == true || $use_cvt == true ) then + echo "--------------------------------------------" + echo "| 2.1 Scatter the global cvt or vp to PEs |" + echo "--------------------------------------------" + + ln -sf ./o${NM1}s3/vp_output.global_hires . + if ( ! -e vp_output.global_hires ) then + echo "vp_output.global_hires is not found" + exit -1 + endif + +#------------------------------------------- + if ( $JOB == 'LSF' ) then + if ( -e submit_lsf.csh ) rm -f submit_lsf.csh +cat > submit_lsf.csh < FAIL + exit -1 + endif + end + endif + + endif # end if N > 1 + + if ( $THIN_FACTOR[$N] > 1 ) then + echo "--------------------------------------------" + echo "| 2.2 Thin high-res guess to low-res |" + echo "--------------------------------------------" + + ./da_thin.exe -i o${N}s1_fg \ + -o o${N}s2_fg \ + -thin $THIN_FACTOR[$N] \ + >& o${N}s2_thin_fg.log + if ( ! -e o${N}s2_fg ) then + echo "thinning fg failed" > FAIL + exit -1 + endif + + if ( $VAR4D == true ) then # 2nd level fg only for 4DVAR + ./da_thin.exe -i o${N}s1_fg02 \ + -o o${N}s2_fg02 \ + -thin $THIN_FACTOR[$N] \ + >>& o${N}s2_thin_fg02.log + if ( ! -e o${N}s2_fg02 ) then + echo "thinning fg02 failed" > FAIL + exit -1 + endif + endif + else + cp o${N}s1_fg o${N}s2_fg + if ( $VAR4D == true ) cp o${N}s1_fg02 o${N}s2_fg02 + endif + + if ( $VAR4D == true ) then + echo "--------------------------------------------" + echo "| 2.3 Generating boundary file for stage2 |" + echo "--------------------------------------------" + da_bdy.exe -fg o${N}s2_fg \ + -fg02 o${N}s2_fg02 \ + -bdy orig_wrfbdy_d01 \ + -o o${N}s2_wrfbdy_d01 \ + >& o${N}s2_bdy.log + if ( ! -e o${N}s2_wrfbdy_d01 ) then + echo "generating bdy file for outerloop$N stage2 failed" > FAIL + exit -1 + endif + endif + + echo "--------------------------------------------" + echo "| 2.4 Run WRF-VAR minimization at low-res |" + echo "--------------------------------------------" + + if ( -e namelist.input ) rm -f namelist.input + ln -sf o${N}s2_namelist.input namelist.input + ln -sf ./o${N}s1/gts_omb.* . + ln -sf o${N}s2_fg fg + if ( $VAR4D == true ) then + ln -sf o${N}s2_fg02 fg02 + ln -sf o${N}s2_fg wrfinput_d01 + ln -sf o${N}s2_wrfbdy_d01 wrfbdy_d01 + endif + + echo "outerloop${N}_stage2" > .current_stage + echo "outerloop${N}_stage2" > .last_stage + +#--------------------------------- + if ( $JOB == 'LSF' ) then + if ( -e submit_lsf.csh ) rm -f submit_lsf.csh +cat > submit_lsf.csh < FAIL + exit -1 + endif + + echo "------------------------------" + echo "| 2.5 Save and clean output |" + echo "------------------------------" + + if ( $use_vp == true ) ncl nc_vpglobal.ncl + ncl nc_increment.ncl + + set out_storage=o${N}s2 + if ( ! -d $out_storage ) mkdir $out_storage; mkdir $out_storage/RSL + rm unpert* gts_omb.* gts_omb_oma_*.* filtered_obs.* + mv buddy_check check_max_iv $out_storage + mv rsl.* rej_obs* qcstat_conv_01 $out_storage #/RSL + mv cost_fn grad_fn jo fort.* statistics $out_storage + mv wrfvar_output namelist.output* $out_storage + mv gts_omb_oma_* filtered_obs_* submit_lsf.csh $out_storage + mv analysis_increments* $out_storage + if ( $use_vp == true || $use_cvt == true ) then + if ( $N > 1 ) rm vp_output.global_hires + mv vp_input.* vv_input.* vv_after* vp_output.global* $out_storage + endif + + endif # end if RUN_STAGE2 + +#----------------------------------- + if ( $RUN_STAGE3 == "true" ) then + + echo "--------------------------------------" + echo "| Run outerloop${N} : Stage3-Regrid |" + echo "--------------------------------------" + + @ NP1 = $N + 1 + + if ( "$VAR4D_LBC" == "t" || "$VAR4D_LBC" == "T" ) then + # this is not well tested yet. turned it off + echo "------------------------------------------------------------" + echo "| 3.1 regridding in model space for 2nd time level (fg02) |" + echo "------------------------------------------------------------" + # only if var4d_lbc=true. + # NOTE: interpolate to original resolution in model space + + ./da_bilin.exe -fg_lores o${N}s2_fg02 \ + -fg_hires o${N}s1_fg02 \ + -an_lores ana02 \ + -ns $THIN_FACTOR[$N] \ + -o ana02_hires >& o${N}s2_bilin_fg02.log + if ( ! -e ana02_hires ) then + echo "regridding increment failed" > FAIL + exit -1 + endif + mv ana02 ana02_lores + else + echo "# Skipped, VAR4D_LBC=$VAR4D_LBC \n" + endif + + echo "------------------------------------------------------------" + echo "| 3.1 regridding in model space for 1st time level (fg) |" + echo "------------------------------------------------------------" + # wrfvar_output_hires = fg_stage1 + S (wrfvar_output_lores - fg_stage2) + #---------------------------------------------------------------------------- + if ( $THIN_FACTOR[$N] > 1 ) then # regrid to model resolution + ./da_bilin.exe -fg_lores o${N}s2_fg \ + -fg_hires o${N}s1_fg \ + -an_lores ./o${N}s2/wrfvar_output \ + -ns $THIN_FACTOR[$N] \ + -o wrfvar_output_hires >& o${N}s3_da_bilin.log + if ( ! -e wrfvar_output_hires ) then + echo "regridding increment failed" > FAIL + exit -1 + endif + else # if DA res. is same as model res., no need for interpolation + cp ./o${N}s2/wrfvar_output wrfvar_output_hires + endif + + if ( $N < $MAX_OUTERLOOP ) then # no need to do this for the last loop + #------------------------------------------------------ + # interpolate vp to next outer loop's resolution + #------------------------------------------------------------- + if ( $use_vp == true || $use_cvt == true ) then + if ( $THIN_FACTOR[$N] != $THIN_FACTOR[$NP1] ) then # only do this if res diff for two loops + echo "---------------------------------------------" + echo "| 3.2 regridding in control variable space |" + echo "---------------------------------------------" + if ( $N < $MAX_OUTERLOOP ) then + @ ratio = $THIN_FACTOR[$N] / $THIN_FACTOR[$NP1] + else + @ ratio = $THIN_FACTOR[$N] # / 1 + endif + + if ( -e vp_output.global ) rm -f vp_output.global + ln -sf ./o${N}s2/vp_output.global . + ./da_vp_bilin.exe -ratio $ratio >& o${N}s3_vp_bilin.log + if ( ! -e vp_output.global_hires ) then + echo "vp_output.global_hires is not generated" > FAIL + exit -1 + endif + else # if resolution same, no interpolation needed. + cp ./o${N}s2/vp_output.global vp_output.global_hires + endif + ncl nc_vphires.ncl + endif + + echo "---------------------------------" + echo "| 3.3 Save and Clean results |" + echo "---------------------------------" + + set out_storage=o${N}s3 + if ( ! -d $out_storage ) mkdir $out_storage + + mv wrfvar_output_hires $out_storage + rm namelist.input + + if ( $use_vp == true || $use_cvt == true ) then + mv vp_output.global_hires* $out_storage + rm vp_output.global + endif + + endif # $N < $MAX_OUTERLOOP + + endif ## end if RUN_STAGE3=true + + @ N++ + + end # End of outerloop + + rm fg fg02 wrfinput_d01 wrfbdy_d01 + +else ## if NOT multi-resolution incremental 3D/4DVAR, no stop outer loop + + ln -sf ${BE3} be.dat + ln -sf orig_fg fg + if ( $VAR4D == true ) then + ln -sf orig_wrfinput_d01 wrfinput_d01 + ln -sf orig_wrfbdy_d01 wrfbdy_d01 + endif + + if ( $OS == "Darwin" ) then + sed -e "/[u][s][e]_[i][n][v][e][r][s][e]_[s][q][u][a][r][e][r][o][o][t][b][ \t]*=/ c\ \ + use_inverse_squarerootb=$use_vp," \ + -e "/[u][s][e]_[i][n][t][e][r][p][o][l][a][t][e]_[c][v][t][ \t]*=/ c\ \ + use_interpolate_cvt=$use_cvt," \ + orig_namelist.input > namelist.input + else + sed -e "/[u][s][e]_[i][n][v][e][r][s][e]_[s][q][u][a][r][e][r][o][o][t][b][ \t]*=/ c\use_inverse_squarerootb=$use_vp," \ + -e "/[u][s][e]_[i][n][t][e][r][p][o][l][a][t][e]_[c][v][t][ \t]*=/ c\use_interpolate_cvt=$use_cvt," \ + orig_namelist.input > namelist.input + endif + +#--------------------------------- + if ( $JOB == 'LSF' ) then + if ( -e submit_lsf.csh ) rm -f submit_lsf.csh +cat > submit_lsf.csh < $n2 || $n1 > $n3 ) then + echo "The dimension of THIN_FACTOR ($#THIN_FACTOR) should be equal to MAX_OUTERLOOP ($MAX_OUTERLOOP) " + exit -1 + endif + +#----------------------------End of User settings-----------------------------; + +if ( ! $?MULTI_INC_TOOLS ) then + if ( ${#argv} > 0 ) then + set MULTI_INC_TOOLS=$1 + else + set appname=${0:t} + set MULTI_INC_TOOLS=${0:h} + if ( "$MULTI_INC_TOOLS" == "$appname" ) set MULTI_INC_TOOLS="." + endif +endif + +if ( $MULTI_INC == true ) then + + foreach f (da_thin.exe da_bilin.exe da_bdy.exe \ + da_vp_bilin.exe da_vp_split.exe \ + nc_vpglobal.ncl nc_vphires.ncl nc_increment.ncl ) + if ( -e ${MULTI_INC_TOOLS}/$f ) then + if ( "$MULTI_INC_TOOLS" != "." ) then + ln -sf ${MULTI_INC_TOOLS}/$f . + endif + else + echo "$f NOT exists" > FAIL + exit -1 + endif + end + + set FILES_TO_CLEAN=(ana02 ana02_hires ana02_lores \ + wrfvar_output wrfvar_output_hires wrfvar_output_lores \ + FAIL .current_stage .last_stage .final_stage \ + namelist.input \ + rsl* gts* vp_* outerloop_*) + + #rm -rf $FILES_TO_CLEAN + + touch .current_stage .last_stage .final_stage + + set N=1 + #if ( $VAR4D == true ) then + @ nloop = $MAX_OUTERLOOP + 1 + #else + # @ nloop = $MAX_OUTERLOOP + #endif + + while ( $N <= $nloop ) + + if ( $N == $nloop ) then + set RUN_STAGE1=true # only run omb for the last loop + set RUN_STAGE2=false + set RUN_STAGE3=false + set istage=1 # 1 for observer; 0 for normal 3dvar mode + set nouterloop=1 + set ninnerloop=0 + else + set RUN_STAGE1=true + set RUN_STAGE2=true + set RUN_STAGE3=true + set istage=1 + set nouterloop=1 + set ninnerloop=30 + endif + +#---------------- User Configuration -------------- + if ( $N == 1 ) ln -sf ${BE1} be.dat + if ( $N == 2 ) ln -sf ${BE2} be.dat + if ( $N == 3 ) ln -sf ${BE3} be.dat +#---------------- User Configuration -------------- + + if ( $N == 1 ) then + cp orig_fg o${N}s1_fg # stage1 for observer step + if ( $VAR4D == true ) then + cp orig_fg02 o${N}s1_fg02 + endif + else # from 2nd loop, use previous loop's analysis + @ NM1 = $N - 1 + cp ./o${NM1}s3/wrfvar_output_hires o${N}s1_fg + if ( $VAR4D == true ) then + cp orig_fg02 o${N}s1_fg02 + endif + endif + + if ( $RUN_STAGE1 == "true" ) then + + echo "--------------------------------------" + echo "| Run outerloop-$N : Stage1-Observer |" + echo "--------------------------------------" + + echo "--------------------------------------" + echo "| 1.0 Set up namlist.input for stage1 |" + echo "--------------------------------------" + #----------------------------------- + # &wrfvar1 + # multi_inc=1, # stage1 for omb only + #--------------------------------------- + if ( $OS == "Darwin" ) then + sed -e "/[Mm][Uu][Ll][Tt][Ii]_[Ii][Nn][Cc][ \t]*=/ c\ \ + multi_inc=${istage}," \ + -e "/[m][a][x]_[e][x][t]_[i][t][s][ \t]*=/ c\ \ + max_ext_its=${nouterloop}," \ + -e "/[n][t][m][a][x][ \t]*=/ c\ \ + ntmax=${ninnerloop}," \ + orig_namelist.input > o${N}s1_namelist.input + else + sed -e "/[Mm][Uu][Ll][Tt][Ii]_[Ii][Nn][Cc][ \t]*=/ c\multi_inc=${istage}," \ + -e "/[m][a][x]_[e][x][t]_[i][t][s][ \t]*=/ c\max_ext_its=${nouterloop}," \ + -e "/[n][t][m][a][x][ \t]*=/ c\ntmax=${ninnerloop}," \ + orig_namelist.input > o${N}s1_namelist.input + endif + + + if ( $VAR4D == true ) then + echo "--------------------------------------------" + echo "| 1.1 Generating boundary file for stage1 |" + echo "--------------------------------------------" + + da_bdy.exe -fg o${N}s1_fg \ + -fg02 o${N}s1_fg02 \ + -bdy orig_wrfbdy_d01 \ + -o o${N}s1_wrfbdy_d01 \ + >& o${N}s1_da_bdy.log + if ( ! -e o${N}s1_wrfbdy_d01 ) then + echo "generating bdy file for outloop1 stage1 failed" > FAIL + exit -1 + endif + endif + + echo "--------------------------------------------" + echo "| 1.2 run WRF-VAR in observer mode |" + echo "--------------------------------------------" + + if ( -e namelist.input ) rm namelist.input + ln -sf o${N}s1_namelist.input namelist.input + ln -sf o${N}s1_fg fg + if ( $VAR4D == true ) then + ln -sf o${N}s1_fg02 fg02 + ln -sf o${N}s1_fg wrfinput_d01 + ln -sf o${N}s1_wrfbdy_d01 wrfbdy_d01 + endif + + echo "outerloop${N}_stage1" > .current_stage + echo "outerloop${N}_stage1" > .final_stage + +#-------------------------------------- + if ( $JOB == 'LSF' ) then + if ( -e submit_lsf.csh ) rm -f submit_lsf.csh +cat > submit_lsf.csh < submit_pbs.csh <> log + if ( "`qstat | grep -o -m 1 $jobid`" != $jobid ) then + if ( "`tail rsl.out.0000 | grep -o -m 1 successfully`" != "successfully" ) then + echo "da_wrfvar stage1 failed " > FAIL + exit -1 + else + break + endif + else + @ i++ + endif + end + echo "done" >> log + + echo "------------------------------" + echo "| 1.3 Save and clean output |" + echo "------------------------------" + + set out_storage=o${N}s1 + if ( ! -d $out_storage ) mkdir $out_storage + mkdir $out_storage/RSL + mv submit_pbs.csh fort.140 namelist.input namelist.output* $out_storage + mv rsl.* $out_storage/RSL + #mv o${N}s1.*.out o${N}s1.*.err $out_storage + rm rej_obs_conv* + mv gts_omb.* $out_storage # to be used in stage2 + mv buddy_check check_max_iv jo cost_fn grad_fn statistics $out_storage + + echo "outerloop${N}_stage1" > .last_stage + + if ( "`cat .current_stage`" != "outerloop${N}_stage1" && \ + "`cat .last_stage`" != "outerloop${N}_stage1" ) then + echo "outerloop${N}_stage1 was NOT done, aborted Stage2" + exit -1 + endif + endif # end if RUN_STAGE1 + +#--------------------------------- + if ( $RUN_STAGE2 == "true" ) then + + echo "--------------------------------------" + echo "| Run outerloop-$N : Stage2-Minimizer |" + echo "--------------------------------------" + + echo "--------------------------------------------" + echo "| 2.0 Set up namelist.input for stage2 |" + echo "--------------------------------------------" + + #--------------------------------------- + # &wrfvar1 + # multi_inc=2, # stage2 for minimization + # dx= + # dy=${NL_DY}.0, + # e_we=$NL_E_WE, + # e_sn=$NL_E_SN, + # time_step=$TIME_STEP_STAGE2, + # var4d_bin= + #------------------------------------------ + set NL_DX=`grep -i -E "dx[ \t]*=" orig_namelist.input | sed -e 's/\t/ /g' -e 's/ *//g' -e 's/,//' -e 's/\r//g'| cut -c4-` + set NL_DY=`grep -i -E "dy[ \t]*=" orig_namelist.input | sed -e 's/\t/ /g' -e 's/ *//g' -e 's/,//' -e 's/\r//g'| cut -c4-` + set NL_E_WE=`grep -i -E "e_we[ \t]*=" orig_namelist.input | sed -e 's/\t/ /g' -e 's/ *//g' -e 's/,//' -e 's/\r//g'| cut -c6-` + set NL_E_SN=`grep -i -E "e_sn[ \t]*=" orig_namelist.input | sed -e 's/\t/ /g' -e 's/ *//g' -e 's/,//' -e 's/\r//g'| cut -c6-` + + set NL_DX=`echo $NL_DX | sed 's/\.[0-9]*//g'` + set NL_DY=`echo $NL_DY | sed 's/\.[0-9]*//g'` + set NL_E_WE=`echo $NL_E_WE | sed 's/\.[0-9]*//g'` + set NL_E_SN=`echo $NL_E_SN | sed 's/\.[0-9]*//g'` + + @ NL_DX = $NL_DX * $THIN_FACTOR[$N] + @ NL_DY = $NL_DY * $THIN_FACTOR[$N] + @ NL_E_WE = ($NL_E_WE - 1) / $THIN_FACTOR[$N] + 1 + @ NL_E_SN = ($NL_E_SN - 1) / $THIN_FACTOR[$N] + 1 + + @ RADT_STAGE2 = $NL_DX / 1000 + + set NL_VAR4D_BIN=`grep -i -E "var4d_bin[ \t]*=" orig_namelist.input | \ + sed -e 's/\t/ /g' -e 's/ *//g' \ + -e 's/\.[0-9]*//g' -e 's/,//' \ + -e 's/\r//g' | \ + cut -c11-` + @ TIME_STEP_STAGE2 = ( $NL_DX / 1000 ) * 6 + set i=$TIME_STEP_STAGE2 + while ( $i != 0 ) + @ i = $NL_VAR4D_BIN % $TIME_STEP_STAGE2 + @ TIME_STEP_STAGE2-- + end + @ TIME_STEP_STAGE2++ + + if ( $OS == "Darwin" ) then + sed -e '/[Mm][Uu][Ll][Tt][Ii]_[Ii][Nn][Cc]/d' \ + -e '/&[Ww][Rr][Ff][Vv][Aa][Rr]1$/ a\ \ + multi_inc=2,' \ + -e "/[Dd][Xx][ \t]*=/ c\ \ + dx=${NL_DX}.0," \ + -e "/[Dd][Yy][ \t]*=/ c\ \ + dy=${NL_DY}.0," \ + -e "/[Ee]_[Ww][Ee][ \t]*=/ c\ \ + e_we=$NL_E_WE,"\ + -e "/[Ee]_[Ss][Nn][ \t]*=/ c\ \ + e_sn=$NL_E_SN," \ + -e "/[Tt][Ii][Mm][Ee]_[Ss][Tt][Ee][Pp][ \t]*=/ c\ \ + time_step=$TIME_STEP_STAGE2," \ + -e "/[u][s][e]_[i][n][v][e][r][s][e]_[s][q][u][a][r][e][r][o][o][t][b][ \t]*=/ c\ \ + use_inverse_squarerootb=$use_vp," \ + -e "/[u][s][e]_[i][n][t][e][r][p][o][l][a][t][e]_[c][v][t][ \t]*=/ c\ \ + use_interpolate_cvt=$use_cvt," \ + orig_namelist.input > o${N}s2_namelist.input + else + sed -e '/[Mm][Uu][Ll][Tt][Ii]_[Ii][Nn][Cc]/d' \ + -e '/&[Ww][Rr][Ff][Vv][Aa][Rr]1$/ a\multi_inc=2,' \ + -e "/[Dd][Xx][ \t]*=/ c\dx=${NL_DX}.0," \ + -e "/[Dd][Yy][ \t]*=/ c\dy=${NL_DY}.0," \ + -e "/[Ee]_[Ww][Ee][ \t]*=/ c\e_we=$NL_E_WE," \ + -e "/[Ee]_[Ss][Nn][ \t]*=/ c\e_sn=$NL_E_SN," \ + -e "/[Tt][Ii][Mm][Ee]_[Ss][Tt][Ee][Pp][ \t]*=/ c\time_step=$TIME_STEP_STAGE2," \ + -e "/[u][s][e]_[i][n][v][e][r][s][e]_[s][q][u][a][r][e][r][o][o][t][b][ \t]*=/ c\use_inverse_squarerootb=$use_vp," \ + -e "/[u][s][e]_[i][n][t][e][r][p][o][l][a][t][e]_[c][v][t][ \t]*=/ c\use_interpolate_cvt=$use_cvt," \ + orig_namelist.input > o${N}s2_namelist.input + endif + + if ( $N > 1 ) then # only do this step from outer loop 2 + + @ NM1 = $N - 1 + + if ( $use_vp == true || $use_cvt == true ) then + echo "--------------------------------------------" + echo "| 2.1 Scatter the global cvt or vp to PEs |" + echo "--------------------------------------------" + + ln -sf ./o${NM1}s3/vp_output.global_hires . + if ( ! -e vp_output.global_hires ) then + echo "vp_output.global_hires is not found" + exit -1 + endif + +#------------------------------------------- + if ( $JOB == 'LSF' ) then + if ( -e submit_lsf.csh ) rm -f submit_lsf.csh +cat > submit_lsf.csh < submit_pbs.csh <> log + if ( "`qstat | grep -o -m 1 $jobid`" != $jobid ) then # if job finish + if ( $use_vp == true || $use_cvt == true ) then + foreach f ( vp_input.0* ) + if ( ! -e $f ) then + echo "$f NOT exists" > FAIL + exit -1 + endif + end + break + endif + else + @ i++ + endif + end + echo "done" >> log + + endif # end if N > 1 + + if ( $THIN_FACTOR[$N] > 1 ) then + echo "--------------------------------------------" + echo "| 2.2 Thin high-res guess to low-res |" + echo "--------------------------------------------" + + ./da_thin.exe -i o${N}s1_fg \ + -o o${N}s2_fg \ + -thin $THIN_FACTOR[$N] \ + >& o${N}s2_thin_fg.log + if ( ! -e o${N}s2_fg ) then + echo "thinning fg failed" > FAIL + exit -1 + endif + + if ( $VAR4D == true ) then # 2nd level fg only for 4DVAR + ./da_thin.exe -i o${N}s1_fg02 \ + -o o${N}s2_fg02 \ + -thin $THIN_FACTOR[$N] \ + >>& o${N}s2_thin_fg02.log + if ( ! -e o${N}s2_fg02 ) then + echo "thinning fg02 failed" > FAIL + exit -1 + endif + endif + else + cp o${N}s1_fg o${N}s2_fg + if ( $VAR4D == true ) cp o${N}s1_fg02 o${N}s2_fg02 + endif + + if ( $VAR4D == true ) then + echo "--------------------------------------------" + echo "| 2.3 Generating boundary file for stage2 |" + echo "--------------------------------------------" + da_bdy.exe -fg o${N}s2_fg \ + -fg02 o${N}s2_fg02 \ + -bdy orig_wrfbdy_d01 \ + -o o${N}s2_wrfbdy_d01 \ + >& o${N}s2_bdy.log + if ( ! -e o${N}s2_wrfbdy_d01 ) then + echo "generating bdy file for outerloop$N stage2 failed" > FAIL + exit -1 + endif + endif + + echo "--------------------------------------------" + echo "| 2.4 Run WRF-VAR minimization at low-res |" + echo "--------------------------------------------" + + if ( -e namelist.input ) rm -f namelist.input + ln -sf o${N}s2_namelist.input namelist.input + ln -sf ./o${N}s1/gts_omb.* . + ln -sf o${N}s2_fg fg + if ( $VAR4D == true ) then + ln -sf o${N}s2_fg02 fg02 + ln -sf o${N}s2_fg wrfinput_d01 + ln -sf o${N}s2_wrfbdy_d01 wrfbdy_d01 + endif + + echo "outerloop${N}_stage2" > .current_stage + echo "outerloop${N}_stage2" > .last_stage + +#--------------------------------- + if ( $JOB == 'LSF' ) then + if ( -e submit_lsf.csh ) rm -f submit_lsf.csh +cat > submit_lsf.csh < submit_pbs.csh <> log + if ( "`qstat | grep -o -m 1 $jobid`" != $jobid ) then # if job finish + if ( "`tail rsl.out.0000 | grep -o -m 1 successfully`" != "successfully" ) then + echo "da_wrfvar stage2_$N failed " > FAIL + exit -1 + else + break + endif + else + @ i++ + endif + end + echo "done" >> log + + echo "------------------------------" + echo "| 2.5 Save and clean output |" + echo "------------------------------" + + #if ( $use_vp == true ) ncl nc_vpglobal.ncl + #ncl nc_increment.ncl + + set out_storage=o${N}s2 + if ( ! -d $out_storage ) mkdir $out_storage; mkdir $out_storage/RSL + rm unpert* gts_omb.* gts_omb_oma_*.* radar_omb_oma_*.* filtered_obs.* rej_obs* + mv buddy_check check_max_iv qcstat_conv_01 $out_storage + mv rsl.* $out_storage/RSL + mv cost_fn grad_fn jo fort.* statistics $out_storage + mv wrfvar_output namelist.output* $out_storage + mv gts_omb_oma_* radar_omb_oma_* filtered_obs_* submit_pbs.csh $out_storage + mv analysis_increments* $out_storage + if ( $use_vp == true || $use_cvt == true ) then + if ( $N > 1 ) rm vp_output.global_hires + mv vp_input.* vv_input.* vv_after* vp_output.global* $out_storage + endif + + endif # end if RUN_STAGE2 + +#----------------------------------- + if ( $RUN_STAGE3 == "true" ) then + + echo "--------------------------------------" + echo "| Run outerloop${N} : Stage3-Regrid |" + echo "--------------------------------------" + + @ NP1 = $N + 1 + + if ( "$VAR4D_LBC" == "t" || "$VAR4D_LBC" == "T" ) then + # this is not well tested yet. turned it off + echo "------------------------------------------------------------" + echo "| 3.1 regridding in model space for 2nd time level (fg02) |" + echo "------------------------------------------------------------" + # only if var4d_lbc=true. + # NOTE: interpolate to original resolution in model space + + ./da_bilin.exe -fg_lores o${N}s2_fg02 \ + -fg_hires o${N}s1_fg02 \ + -an_lores ana02 \ + -ns $THIN_FACTOR[$N] \ + -o ana02_hires >& o${N}s2_bilin_fg02.log + if ( ! -e ana02_hires ) then + echo "regridding increment failed" > FAIL + exit -1 + endif + mv ana02 ana02_lores + else + echo "# Skipped, VAR4D_LBC=$VAR4D_LBC \n" + endif + + echo "------------------------------------------------------------" + echo "| 3.1 regridding in model space for 1st time level (fg) |" + echo "------------------------------------------------------------" + # wrfvar_output_hires = fg_stage1 + S (wrfvar_output_lores - fg_stage2) + #---------------------------------------------------------------------------- + if ( $THIN_FACTOR[$N] > 1 ) then # regrid to model resolution + ./da_bilin.exe -fg_lores o${N}s2_fg \ + -fg_hires o${N}s1_fg \ + -an_lores ./o${N}s2/wrfvar_output \ + -ns $THIN_FACTOR[$N] \ + -o wrfvar_output_hires >& o${N}s3_da_bilin.log + if ( ! -e wrfvar_output_hires ) then + echo "regridding increment failed" > FAIL + exit -1 + endif + else # if DA res. is same as model res., no need for interpolation + cp ./o${N}s2/wrfvar_output wrfvar_output_hires + endif + + if ( $N < $MAX_OUTERLOOP ) then # no need to do this for the last loop + #------------------------------------------------------ + # interpolate vp to next outer loop's resolution + #------------------------------------------------------------- + if ( $use_vp == true || $use_cvt == true ) then + if ( $THIN_FACTOR[$N] != $THIN_FACTOR[$NP1] ) then # only do this if res diff for two loops + echo "---------------------------------------------" + echo "| 3.2 regridding in control variable space |" + echo "---------------------------------------------" + if ( $N < $MAX_OUTERLOOP ) then + @ ratio = $THIN_FACTOR[$N] / $THIN_FACTOR[$NP1] + else + @ ratio = $THIN_FACTOR[$N] # / 1 + endif + + if ( -e vp_output.global ) rm -f vp_output.global + ln -sf ./o${N}s2/vp_output.global . + ./da_vp_bilin.exe -ratio $ratio \ + -cloud_cv_options 3 \ + -use_cv_w 1 >& o${N}s3_vp_bilin.log + if ( ! -e vp_output.global_hires ) then + echo "vp_output.global_hires is not generated" > FAIL + exit -1 + endif + else # if resolution same, no interpolation needed. + cp ./o${N}s2/vp_output.global vp_output.global_hires + endif + #ncl nc_vphires.ncl + endif + + echo "---------------------------------" + echo "| 3.3 Save and Clean results |" + echo "---------------------------------" + + set out_storage=o${N}s3 + if ( ! -d $out_storage ) mkdir $out_storage + + mv wrfvar_output_hires $out_storage + rm namelist.input + + if ( $use_vp == true || $use_cvt == true ) then + mv vp_output.global_hires* $out_storage + rm vp_output.global + endif + + endif # $N < $MAX_OUTERLOOP + + endif ## end if RUN_STAGE3=true + + @ N++ + + end # End of outerloop + + rm fg fg02 wrfinput_d01 wrfbdy_d01 + +else ## if NOT multi-resolution incremental 3D/4DVAR, no stop outer loop +########################################################################### + + ln -sf ${BE3} be.dat + ln -sf orig_fg fg + if ( $VAR4D == true ) then + ln -sf orig_wrfinput_d01 wrfinput_d01 + ln -sf orig_wrfbdy_d01 wrfbdy_d01 + endif + + if ( $OS == "Darwin" ) then + sed -e "/[u][s][e]_[i][n][v][e][r][s][e]_[s][q][u][a][r][e][r][o][o][t][b][ \t]*=/ c\ \ + use_inverse_squarerootb=$use_vp," \ + -e "/[u][s][e]_[i][n][t][e][r][p][o][l][a][t][e]_[c][v][t][ \t]*=/ c\ \ + use_interpolate_cvt=$use_cvt," \ + orig_namelist.input > namelist.input + else + sed -e "/[u][s][e]_[i][n][v][e][r][s][e]_[s][q][u][a][r][e][r][o][o][t][b][ \t]*=/ c\use_inverse_squarerootb=$use_vp," \ + -e "/[u][s][e]_[i][n][t][e][r][p][o][l][a][t][e]_[c][v][t][ \t]*=/ c\use_interpolate_cvt=$use_cvt," \ + orig_namelist.input > namelist.input + endif + +#--------------------------------- + if ( $JOB == 'LSF' ) then + if ( -e submit_lsf.csh ) rm -f submit_lsf.csh +cat > submit_lsf.csh < submit_pbs.csh < +#include "rsl_lite.h" + +/* updated 20051021, new algorithm distributes the remainder, if any, at either ends of the dimension + rather than the first remainder number of processors in the dimension. Idea is that the processes + on the ends have less work because they're boundary processes. New alg works like this: + a b + + + + + + + o o o o o o o o o o o o o + + + + + + + + + represents a process with an extra point (npoints is n/p+1), o processors that don't (n/p) + a and b are the starting process indices in the dimension of the new section of o or x. + JM +*/ + +/* experimental for running some tasks on host and some on MIC + if minx = -99 then miny is the number of grid points I want in the Y dimension. + Otherwise both are set to 1 and it works normally 20121018 JM */ + +static char tfpmess[1024] ; + +TASK_FOR_POINT ( i_p , j_p , ids_p, ide_p , jds_p, jde_p , npx_p , npy_p , Px_p, Py_p , minx_p, miny_p, ierr_p ) + int_p i_p , j_p , Px_p , Py_p , ids_p, ide_p , jds_p, jde_p , npx_p , npy_p, minx_p, miny_p, ierr_p ; +{ + int i , j , ids, ide, jds, jde, npx, npy, minx, miny ; /* inputs */ + int Px, Py ; /* output */ + int idim, jdim ; + int rem, a, b ; + i = *i_p - 1 ; + j = *j_p - 1 ; + npx = *npx_p ; + npy = *npy_p ; +#if 0 + minx = *minx_p ; + miny = *miny_p ; +#else + if ( *minx_p == -99 ) { + minx = 1 ; + miny = *miny_p ; + npx = ( *npx_p * *npy_p ) / 2 ; /* x dim gets half the tasks , only decompose Y by 2 */ + if ( npx * 2 != *npx_p * *npy_p ) { + *ierr_p = 1 ; + sprintf(tfpmess,"%d by %d decomp will not work for MIC/HOST splitting. Need even number of tasks\n") ; + } + } else { + minx = 1 ; + miny = 1 ; + } +#endif + ids = *ids_p - 1 ; ide = *ide_p - 1 ; + jds = *jds_p - 1 ; jde = *jde_p - 1 ; + idim = ide - ids + 1 ; + jdim = jde - jds + 1 ; + + *ierr_p = 0 ; + + if ( *minx_p != -99 ) { + /* begin: jm for Peter Johnsen -- noticed problem with polar filters in gwrf + if the number of processors exceeds number of vertical levels */ + if ( npx > idim ) { npx = idim ; } + if ( npy > jdim ) { npy = jdim ; } + + /* begin: wig; 10-Mar-2008 + Check that the number of processors is not so high that the halos begin to overlap. + If they do, then reduce the number of processors allowed for that dimension. + */ + tfpmess[0] = '\0' ; + if ( idim / npx < minx ) { + npx = idim/minx ; + if (npx < 1) { npx = 1 ;} + if (npx != *npx_p) { + sprintf(tfpmess,"RSL_LITE: TASK_FOR_POINT LIMITING PROCESSOR COUNT IN X-DIRECTION TO %d %d\n", npx,*npx_p) ; + *ierr_p = 1 ; + } + } + if ( jdim / npy < miny ) { + npy = jdim/miny ; + if (npy < 1) { npy = 1 ;} + if (npy != *npy_p) { + sprintf(tfpmess,"RSL_LITE: TASK_FOR_POINT LIMITING PROCESSOR COUNT IN Y-DIRECTION TO %d %d\n", npy,*npy_p) ; + *ierr_p = 1 ; + } + } + /* end: wig */ + } + + i = i >= ids ? i : ids ; i = i <= ide ? i : ide ; + rem = idim % npx ; + a = ( rem / 2 ) * ( (idim / npx) + 1 ) ; + b = a + ( npx - rem ) * ( idim / npx ) ; + if ( i-ids < a ) { + Px = (i-ids) / ( (idim / npx) + 1 ) ; + } + else if ( i-ids < b ) { + Px = ( a / ( (idim / npx) + 1 ) ) + (i-a-ids) / ( ( b - a ) / ( npx - rem ) ) ; + } + else { + Px = ( a / ( (idim / npx) + 1 ) ) + (b-a-ids) / ( ( b - a ) / ( npx - rem ) ) + + (i-b-ids) / ( ( idim / npx ) + 1 ) ; + } + + j = j >= jds ? j : jds ; j = j <= jde ? j : jde ; + if ( *minx_p != -99 ) { + rem = jdim % npy ; + a = ( rem / 2 ) * ( (jdim / npy) + 1 ) ; + b = a + ( npy - rem ) * ( jdim / npy ) ; + if ( j-jds < a ) { + Py = (j-jds) / ( (jdim / npy) + 1 ) ; + } + else if ( j-jds < b ) { + Py = ( a / ( (jdim / npy) + 1 ) ) + (j-a-jds) / ( ( b - a ) / ( npy - rem ) ) ; + } + else { + Py = ( a / ( (jdim / npy) + 1 ) ) + (b-a-jds) / ( ( b - a ) / ( npy - rem ) ) + + (j-b-jds) / ( ( jdim / npy ) + 1 ) ; + } + } else { + Py = 1 ; + if ( j <= jde-miny ) Py = 0 ; + } + + *Px_p = Px ; + *Py_p = Py ; +} + +TASK_FOR_POINT_MESSAGE() +{ + fprintf(stderr,"%s\n",tfpmess) ; +} + +#if 0 +main() +{ + int minx, miny, ierr ; + int ips[100], ipe[100] ; + int jps[100], jpe[100] ; + int shw, i , j , ids, ide, jds, jde, npx, npy ; /* inputs */ + int Px, Py, P ; /* output */ + printf("i, j, ids, ide, jds, jde, npx, npy\n") ; + scanf("%d %d %d %d %d %d %d %d",&i, &j, &ids,&ide,&jds,&jde,&npx,&npy ) ; + shw =0 ; + minx = -99 ; + miny = 180 ; + for ( i = 0 ; i < 100 ; i++ ) { ips[i] = 9999999 ; ipe[i] = -99999999 ; } + for ( i = 0 ; i < 100 ; i++ ) { jps[i] = 9999999 ; jpe[i] = -99999999 ; } +#if 1 + for ( j = jds-shw ; j <= jde+shw ; j++ ) + { + for ( i = ids-shw ; i <= ide+shw ; i++ ) + { +#endif + TASK_FOR_POINT ( &i , &j , + &ids, &ide, &jds, &jde , &npx , &npy , + &Px, &Py, &minx, &miny, &ierr ) ; +// printf("(%3d %3d) ",Px,Py) ; + printf("%d %3d\n ",i, Px) ; +#if 1 + } + printf("\n") ; + } +/* for ( i = 0 ; i < npx*npy ; i++ ) { */ +/* fprintf(stderr,"%3d. ips %d ipe %d (%d) jps %d jpe %d (%d)\n", i, ips[i], ipe[i], ipe[i]-ips[i]+1, jps[i], jpe[i], jpe[i]-jps[i]+1 ) ; */ +/* } */ +#endif +} +#endif diff --git a/var/mri4dvar/wraper_mri3d4dvar.csh b/var/mri4dvar/wraper_mri3d4dvar.csh new file mode 100755 index 0000000000..67863344b3 --- /dev/null +++ b/var/mri4dvar/wraper_mri3d4dvar.csh @@ -0,0 +1,28 @@ +#!/bin/tcsh -f +# script 1:VAR4D 2:MULTI_INC 3:use_cvt 4:use_vp 5:WORK_DIR 6/7:THIN_FACTOR 8:BE1 9:BE2 +#-------- 3DVAR runs with interpolation of CVT +#./run_mri3d4dvar.csh false true true false mri3dvar_2km2km_cvt 1 1 2km 2km > &! log.22_cvt +#./run_mri3d4dvar.csh false true true false mri3dvar_6km6km_cvt 3 3 6km 6km > &! log.66_cvt +#./run_mri3d4dvar.csh false true true false mri3dvar_18km6km_cvt 9 3 18km 6km > &! log.186_cvt +#-------- 3DVAR runs with Inverse of transform U and interpolation of vp +#./run_mri3d4dvar.csh false true false true mri3dvar_2km2km_vp 1 1 2km 2km > &! log.22_vp +#./run_mri3d4dvar.csh false true false true mri3dvar_6km6km_vp 3 3 6km 6km > &! log.66_vp +#./run_mri3d4dvar.csh false true false true mri3dvar_18km6km_vp 9 3 18km 6km > &! log.186_vp +#-------- 3DVAR runs with cvt=0 for the second outer loop +#./run_mri3d4dvar.csh false true false false mri3dvar_2km2km_cvt0 1 1 2km 2km > &! log.22_cvt0 +#./run_mri3d4dvar.csh false true false false mri3dvar_6km6km_cvt0 3 3 6km 6km > &! log.66_cvt0 +#./run_mri3d4dvar.csh false true false false mri3dvar_18km6km_cvt0 9 3 18km 6km > &! log.186_cvt0 +#------------- +#./run_mri3d4dvar.csh true true true false mri3dvar_6km6km_cvt 3 3 6km 6km > &! log.66_cvt +#./run_mri3d4dvar.csh true true true false mri3dvar_18km6km_cvt 9 3 18km 6km > &! log.186_cvt +#-------- 4DVAR runs with Inverse of transform U and interpolation of vp +#./run_mri3d4dvar.csh true true false true mri3dvar_2km2km_vp 1 1 2km 2km > &! log.22_vp +#./run_mri3d4dvar.csh true true false true mri3dvar_6km6km_vp 3 3 6km 6km > &! log.66_vp +#./run_mri3d4dvar.csh true true false true mri3dvar_18km6km_vp 9 3 18km 6km > &! log.186_vp +#-------- 4DVAR runs with cvt=0 for the second outer loop +#./run_mri3d4dvar.csh true true false false mri3dvar_2km2km_cvt0 1 1 2km 2km > &! log.22_cvt0 +#./run_mri3d4dvar.csh true true false false mri3dvar_6km6km_cvt0 3 3 6km 6km > &! log.66_cvt0 +#./run_mri3d4dvar.csh true true false false mri3dvar_18km6km_cvt0 9 3 18km 6km > &! log.186_cvt0 +#-------- 4DVAR runs with interpolation of CVT +#./run_mri3d4dvar.csh true false false false ztd30min_4dvar_2km2km 1 1 2km 2km > &! log.22 +./run_mri3d4dvar.csh_pbs true true false true ztd30min_mri4dvar_6km6km_512core 3 3 6km 6km > &! log.66 From 6a379542d3a0b4d50f49f772afe0b581e7494498 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Thu, 19 Apr 2018 18:06:48 -0600 Subject: [PATCH 15/91] Fix excessive "outside of domain" prints when assimilating CWB radar mosaic data. For CWB's radar data assimilation, the radar data are pre-processed to be on mass points of the model grid. When WRFDA reads in the radar mosaic data on model mass points, it prints out a lot of "Report is outside of domain" messages when print_detail_radar=.true. Those "outside of domain" obs appear to be along the domain boundaries. When calculating grid x/y from lat/lon (by calling da_llxy), the output x/y are floating numbers and they do not match exactly the grid index. For example, by giving the lat/lon of (450,1), the calculated x is 450.000183 and y is 0.999511719. A few more examples are listed below: (450, 2) : (450.000183, 2.00000000) (450, 3) : (450.000153, 3.00000000) (450, 4) : (450.000153, 3.99951172) (450, 5) : (450.000092, 5.00048828) (450, 6) : (450.000061, 6.00000000) (446, 450) : (446.000580, 450.000000) (447, 450) : (446.999146, 449.999512) (448, 450) : (448.000671, 449.999512) (449, 450) : (448.999268, 450.000000) (450, 450) : (450.000793, 450.000000) By removing the "=" sign in line 52 and line 53 of var/da/da_tools/da_llxy.inc, the "outside of domain" prints can be reduced. Another solution to reducing run-time output is to set print_detail_radar=.false. for operational runs. modified: var/da/da_tools/da_llxy.inc --- var/da/da_tools/da_llxy.inc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/var/da/da_tools/da_llxy.inc b/var/da/da_tools/da_llxy.inc index 2b9f988b31..36a0d810a0 100644 --- a/var/da/da_tools/da_llxy.inc +++ b/var/da/da_tools/da_llxy.inc @@ -49,8 +49,8 @@ subroutine da_llxy (info, loc, outside, outside_all) outside_all = .false. ! Do not check for global options if (.not. global) then - if ((int(loc%x) < ids) .or. (int(loc%x) >= ide) .or. & - (int(loc%y) < jds) .or. (int(loc%y) >= jde)) then + if ((int(loc%x) < ids) .or. (int(loc%x) > ide) .or. & + (int(loc%y) < jds) .or. (int(loc%y) > jde)) then outside_all = .true. outside = .true. return From fd87c7eaa87ac63b03d4454580ae1ed47259612f Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Thu, 19 Apr 2018 18:16:16 -0600 Subject: [PATCH 16/91] Fix unnecessary fatal stop and print when duplicate surface obs are found in obsproc. modified: var/obsproc/src/module_qc.F90 --- var/obsproc/src/module_qc.F90 | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/var/obsproc/src/module_qc.F90 b/var/obsproc/src/module_qc.F90 index efe490857e..2d76aae4ba 100644 --- a/var/obsproc/src/module_qc.F90 +++ b/var/obsproc/src/module_qc.F90 @@ -692,7 +692,6 @@ SUBROUTINE vert_cons_check ( obs , counter , print_vert, iunit, failed ) REAL :: p1 , p2 , h1 , h2 LOGICAL :: found LOGICAL :: failed - LOGICAL :: fatal, listing INTEGER :: iunit ! INCLUDE 'error.inc' @@ -738,16 +737,15 @@ SUBROUTINE vert_cons_check ( obs , counter , print_vert, iunit, failed ) IF (( eps_equal (h1 , h2 , 0.1 )) .AND. & (.NOT. eps_equal (p1 , p2 , 0.1 ))) THEN + if ( print_vert ) then WRITE (message, FMT = '(" Duplicate surface found at ",A8,A8)') & TRIM (obs%location%id), TRIM (obs%location%name) - fatal = .true. - listing = .false. + WRITE (iunit, '(A)') TRIM (message) + end if ! To discard the OBS: obs%info % discard = .TRUE. - CALL error_handler (proc_name, message, "",fatal) - current%meas%pressure%data = missing_r current%meas%height%data = missing_r current%meas%temperature%data = missing_r From 5d61947346ae660be46c8f6f24f7bce9e52aa50c Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Fri, 20 Apr 2018 12:47:31 -0600 Subject: [PATCH 17/91] Add a new namelist ccv_be_inp_opt to allow reading cloud and w BES from different sources. ccv_be_inp_opt=0 (default), original hard-coded values used by cloud_cv_options=3. ccv_be_inp_opt=1, user-specified values in be_ccv.txt and be_w.txt to be used by cloud_cv_options=3. ccv_be_inp_opt=2, the same behavior as used in mri4dvar for cloud_cv_options=2. ccv_be_inp_opt=3, univariate cloud and w BES in independent files for cloud_cv_options=2. Note that the code compiles but has not yet been tested. modified: Registry/registry.var modified: var/da/da_setup_structures/da_setup_be_regional.inc modified: var/da/da_setup_structures/da_setup_structures.f90 --- Registry/registry.var | 1 + .../da_setup_be_regional.inc | 276 ++++++++++++++++-- .../da_setup_structures.f90 | 1 + 3 files changed, 258 insertions(+), 20 deletions(-) diff --git a/Registry/registry.var b/Registry/registry.var index 3122a901aa..d3e5c61795 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -261,6 +261,7 @@ rconfig character lanczos_ep_filename namelist,wrfvar6 1 "../lanczos_eig rconfig logical orthonorm_gradient namelist,wrfvar6 1 .false. - "orthonorm_gradient" "" "" rconfig integer cv_options namelist,wrfvar7 1 5 - "cv_options" "" "" rconfig integer cloud_cv_options namelist,wrfvar7 1 0 - "cloud_cv_options" "0: off, 1: qt, 3: specified qc,qr,qi,qs,qg BE" "" +rconfig integer ccv_be_inp_opt namelist,wrfvar7 1 0 - "ccv_be_inp_opt" "0: original hard-coded, 1: user-specified, 2: BE (cloud/w variables are embedded in be.dat) generated by GEN_BE_2.0, 3: BE (each cloud and w variable in its own file) generated by GEN_BE_V3" "" rconfig logical use_cv_w namelist,wrfvar7 1 .false. - "use_cv_w" "if activate w control variable when cloud_cv_options=3" "" rconfig real as1 namelist,wrfvar7 3*max_outer_iterations -1.0 - "as1" "" "" rconfig real as2 namelist,wrfvar7 3*max_outer_iterations -1.0 - "as2" "" "" diff --git a/var/da/da_setup_structures/da_setup_be_regional.inc b/var/da/da_setup_structures/da_setup_be_regional.inc index 731ca3b1f5..cf65e06748 100644 --- a/var/da/da_setup_structures/da_setup_be_regional.inc +++ b/var/da/da_setup_structures/da_setup_be_regional.inc @@ -124,6 +124,10 @@ subroutine da_setup_be_regional(xb, be, grid) !real :: qrain_th_low, qrain_th_high integer :: be_unit, ier, be_rf_unit, be_print_unit, it, idummy + integer :: ccv_be_unit, n + real :: rval + logical :: fexist + character(len=32) :: fname !-----------for interpolating CV5-------------------------------------------------------------- REAL, ALLOCATABLE :: reg_psi_ps0(:,:), reg_psi_chi0(:,:), reg_psi_t0(:,:,:), & @@ -159,6 +163,12 @@ subroutine da_setup_be_regional(xb, be, grid) call da_error(__FILE__,__LINE__,message(1:1)) end if + if ( cloud_cv_options == 2 .and. & + (ccv_be_inp_opt /= 2 .or. ccv_be_inp_opt /= 3) ) then + write (unit=message(1),fmt='(3x,A)') 'Please set ccv_be_inp_opt = 2 or 3 for cloud_cv_options=2' + call da_error(__FILE__,__LINE__,message(1:1)) + end if + ix = xb % mix jy = xb % mjy kz = xb % mkz @@ -586,31 +596,97 @@ subroutine da_setup_be_regional(xb, be, grid) end if if ( cloud_cv_options == 3 ) then - ! hard-coded the v6-v11 BE values here be % v6 % name = "qcloud" be % v7 % name = "qrain" be % v8 % name = "qice" be % v9 % name = "qsnow" be % v10 % name = "qgraup" - be6_eval_glo = 1.0e-6 - be7_eval_glo = 1.0e-6 - be8_eval_glo = 1.0e-6 - be9_eval_glo = 1.0e-6 - be10_eval_glo = 1.0e-6 - if ( use_cv_w ) then - be % v11 % name = "w" - be11_eval_glo = 1.0 - end if - if ( use_rf ) then - be6_rf_lengthscale = 1.0 - be7_rf_lengthscale = 1.0 - be8_rf_lengthscale = 1.0 - be9_rf_lengthscale = 1.0 - be10_rf_lengthscale = 1.0 + if ( ccv_be_inp_opt == 0 ) then + ! hard-code the v6-v11 BE values here + be6_eval_glo = 1.0e-6 + be7_eval_glo = 1.0e-6 + be8_eval_glo = 1.0e-6 + be9_eval_glo = 1.0e-6 + be10_eval_glo = 1.0e-6 if ( use_cv_w ) then - be11_rf_lengthscale = 1.0 + be % v11 % name = "w" + be11_eval_glo = 1.0 end if - end if + if ( use_rf ) then + be6_rf_lengthscale = 1.0 + be7_rf_lengthscale = 1.0 + be8_rf_lengthscale = 1.0 + be9_rf_lengthscale = 1.0 + be10_rf_lengthscale = 1.0 + if ( use_cv_w ) then + be11_rf_lengthscale = 1.0 + end if + end if + else if ( ccv_be_inp_opt == 1 ) then + fname = 'be_ccv.txt' + inquire(file=trim(fname), exist=fexist) + if ( .not. fexist ) then + write (unit=message(1),fmt='(3x,A,5e10.3)') trim(fname)//' does not exist for ccv_be_inp_opt=1' + call da_error(__FILE__,__LINE__,message(1:1)) + end if + call da_get_unit(ccv_be_unit) + open(unit=ccv_be_unit,file=trim(fname), status="old",form="formatted") + read(ccv_be_unit,*) rval + be6_eval_glo(:) = rval + read(ccv_be_unit,*) rval + be7_eval_glo(:) = rval + read(ccv_be_unit,*) rval + be8_eval_glo(:) = rval + read(ccv_be_unit,*) rval + be9_eval_glo(:) = rval + read(ccv_be_unit,*) rval + be10_eval_glo(:) = rval + if ( use_rf ) then + read(ccv_be_unit,*) rval + be6_rf_lengthscale(:) = rval + read(ccv_be_unit,*) rval + be7_rf_lengthscale(:) = rval + read(ccv_be_unit,*) rval + be8_rf_lengthscale(:) = rval + read(ccv_be_unit,*) rval + be9_rf_lengthscale(:) = rval + read(ccv_be_unit,*) rval + be10_rf_lengthscale(:) = rval + end if + close(ccv_be_unit) + write (unit=message(1),fmt='(3x,A,5e10.3)') 'eval from be_ccv.txt: ', & + be6_eval_glo(1), be7_eval_glo(1), be8_eval_glo(1), be9_eval_glo(1), & + be10_eval_glo(1) + write (unit=message(2),fmt='(3x,A,5f10.3)') 'sl from be_ccv.txt: ', & + be6_rf_lengthscale(1), be7_rf_lengthscale(1), be8_rf_lengthscale(1), & + be9_rf_lengthscale(1), be10_rf_lengthscale(1) + call da_message(message(1:2)) + if ( use_cv_w ) then + fname = 'be_w.txt' + inquire(file=trim(fname), exist=fexist) + if ( .not. fexist ) then + write (unit=message(1),fmt='(3x,A,5e10.3)') trim(fname)//' does not exist for ccv_be_inp_opt=1' + call da_error(__FILE__,__LINE__,message(1:1)) + end if + open(unit=ccv_be_unit,file=trim(fname), status="old",form="formatted") + read(ccv_be_unit,*) rval + be11_eval_glo(:) = rval + if ( use_rf ) then + read(ccv_be_unit,*) rval + be11_rf_lengthscale(:) = rval + end if + close(ccv_be_unit) + write (unit=message(1),fmt='(3x,A,e10.3)') 'eval from be_w.txt: ', & + be11_eval_glo(1) + write (unit=message(2),fmt='(3x,A,f10.3)') 'sl from be_w.txt: ', & + be11_rf_lengthscale(1) + call da_message(message(1:2)) + end if + call da_free_unit(ccv_be_unit) + else + write (unit=message(1),fmt='(3x,A)') 'Please set ccv_be_inp_opt = 0 or 1 for cloud_cv_options=3' + call da_error(__FILE__,__LINE__,message(1:1)) + end if ! ccv_be_inp_opt for cloud_cv_options=3 end if ! 2.2 Read in the eigenvector and eigenvalue @@ -682,7 +758,7 @@ subroutine da_setup_be_regional(xb, be, grid) end do !1-num_cv_3d_basic - if ( cloud_cv_options == 2 ) then + if ( cloud_cv_options == 2 .and. ccv_be_inp_opt == 2 ) then do i = num_cv_3d_basic+1 , num_cv_3d_basic+num_cv_3d_extra read (be_unit) variable @@ -817,6 +893,166 @@ subroutine da_setup_be_regional(xb, be, grid) deallocate (evec_loc) deallocate (eval_loc) + if ( cloud_cv_options == 2 .and. ccv_be_inp_opt == 3 ) then + be % v6 % name = "qcloud" + be % v7 % name = "qrain" + be % v8 % name = "qice" + be % v9 % name = "qsnow" + be % v10 % name = "qgraup" + if ( use_cv_w ) then + be % v11 % name = "w" + end if + call da_get_unit(ccv_be_unit) + allocate (evec_loc(1:nk,1:nk,1:num_bins2d)) + allocate (eval_loc(1:nk, 1:num_bins2d)) + ! qcloud + fname = 'be_QCLOUD.dat' + inquire(file=trim(fname), exist=fexist) + if ( .not. fexist ) then + write (unit=message(1),fmt='(3x,A,5e10.3)') trim(fname)//' does not exist for ccv_be_inp_opt=3' + call da_error(__FILE__,__LINE__,message(1:1)) + end if + open(unit=ccv_be_unit,file=trim(fname), status="old",form="unformatted") + ! hcl-todo: + ! the reading needs to be improved in the future + ! no checks are done on the dimensions yet + do n = 1, 7 + ! skip the first 7 records + read (ccv_be_unit) + end do + read (ccv_be_unit) be6_evec_glo + read (ccv_be_unit) be6_eval_glo + read (ccv_be_unit) evec_loc + read (ccv_be_unit) eval_loc + read (ccv_be_unit) be6_rf_lengthscale + do j=1,nj + b = bin2d(1,j) + be6_evec_loc(j,1:nk,1:nk) = evec_loc(1:nk,1:nk,b) + be6_eval_loc(j,1:nk ) = eval_loc(1:nk,b) + end do + close(ccv_be_unit) + ! qrain + fname = 'be_QRAIN.dat' + inquire(file=trim(fname), exist=fexist) + if ( .not. fexist ) then + write (unit=message(1),fmt='(3x,A,5e10.3)') trim(fname)//' does not exist for ccv_be_inp_opt=3' + call da_error(__FILE__,__LINE__,message(1:1)) + end if + open(unit=ccv_be_unit,file=trim(fname), status="old",form="unformatted") + do n = 1, 7 + ! skip the first 7 records + read (ccv_be_unit) + end do + read (ccv_be_unit) be7_evec_glo + read (ccv_be_unit) be7_eval_glo + read (ccv_be_unit) evec_loc + read (ccv_be_unit) eval_loc + read (ccv_be_unit) be7_rf_lengthscale + do j=1,nj + b = bin2d(1,j) + be7_evec_loc(j,1:nk,1:nk) = evec_loc(1:nk,1:nk,b) + be7_eval_loc(j,1:nk ) = eval_loc(1:nk,b) + end do + close(ccv_be_unit) + ! qice + fname = 'be_QICE.dat' + inquire(file=trim(fname), exist=fexist) + if ( .not. fexist ) then + write (unit=message(1),fmt='(3x,A,5e10.3)') trim(fname)//' does not exist for ccv_be_inp_opt=3' + call da_error(__FILE__,__LINE__,message(1:1)) + end if + open(unit=ccv_be_unit,file=trim(fname), status="old",form="unformatted") + do n = 1, 7 + ! skip the first 7 records + read (ccv_be_unit) + end do + read (ccv_be_unit) be8_evec_glo + read (ccv_be_unit) be8_eval_glo + read (ccv_be_unit) evec_loc + read (ccv_be_unit) eval_loc + read (ccv_be_unit) be8_rf_lengthscale + do j=1,nj + b = bin2d(1,j) + be8_evec_loc(j,1:nk,1:nk) = evec_loc(1:nk,1:nk,b) + be8_eval_loc(j,1:nk ) = eval_loc(1:nk,b) + end do + close(ccv_be_unit) + ! qsnow + fname = 'be_QSNOW.dat' + inquire(file=trim(fname), exist=fexist) + if ( .not. fexist ) then + write (unit=message(1),fmt='(3x,A,5e10.3)') trim(fname)//' does not exist for ccv_be_inp_opt=3' + call da_error(__FILE__,__LINE__,message(1:1)) + end if + open(unit=ccv_be_unit,file=trim(fname), status="old",form="unformatted") + do n = 1, 7 + ! skip the first 7 records + read (ccv_be_unit) + end do + read (ccv_be_unit) be9_evec_glo + read (ccv_be_unit) be9_eval_glo + read (ccv_be_unit) evec_loc + read (ccv_be_unit) eval_loc + read (ccv_be_unit) be9_rf_lengthscale + do j=1,nj + b = bin2d(1,j) + be9_evec_loc(j,1:nk,1:nk) = evec_loc(1:nk,1:nk,b) + be9_eval_loc(j,1:nk ) = eval_loc(1:nk,b) + end do + close(ccv_be_unit) + ! qgraup + fname = 'be_QGRAUP.dat' + inquire(file=trim(fname), exist=fexist) + if ( .not. fexist ) then + write (unit=message(1),fmt='(3x,A,5e10.3)') trim(fname)//' does not exist for ccv_be_inp_opt=3' + call da_error(__FILE__,__LINE__,message(1:1)) + end if + open(unit=ccv_be_unit,file=trim(fname), status="old",form="unformatted") + do n = 1, 7 + ! skip the first 7 records + read (ccv_be_unit) + end do + read (ccv_be_unit) be10_evec_glo + read (ccv_be_unit) be10_eval_glo + read (ccv_be_unit) evec_loc + read (ccv_be_unit) eval_loc + read (ccv_be_unit) be10_rf_lengthscale + do j=1,nj + b = bin2d(1,j) + be10_evec_loc(j,1:nk,1:nk) = evec_loc(1:nk,1:nk,b) + be10_eval_loc(j,1:nk ) = eval_loc(1:nk,b) + end do + close(ccv_be_unit) + if ( use_cv_w ) then + ! w + fname = 'be_W.dat' + inquire(file=trim(fname), exist=fexist) + if ( .not. fexist ) then + write (unit=message(1),fmt='(3x,A,5e10.3)') trim(fname)//' does not exist for ccv_be_inp_opt=3' + call da_error(__FILE__,__LINE__,message(1:1)) + end if + open(unit=ccv_be_unit,file=trim(fname), status="old",form="unformatted") + do n = 1, 7 + ! skip the first 7 records + read (ccv_be_unit) + end do + read (ccv_be_unit) be11_evec_glo + read (ccv_be_unit) be11_eval_glo + read (ccv_be_unit) evec_loc + read (ccv_be_unit) eval_loc + read (ccv_be_unit) be11_rf_lengthscale + do j=1,nj + b = bin2d(1,j) + be11_evec_loc(j,1:nk,1:nk) = evec_loc(1:nk,1:nk,b) + be11_eval_loc(j,1:nk ) = eval_loc(1:nk,b) + end do + close(ccv_be_unit) + end if + deallocate (evec_loc) + deallocate (eval_loc) + call da_free_unit(ccv_be_unit) + end if + if(use_radarobs .and. use_radar_rf .or. use_rad .and. crtm_cloud) then if ( cloud_cv_options == 1 ) be % v4 % name = 'qt ' end if @@ -895,7 +1131,7 @@ subroutine da_setup_be_regional(xb, be, grid) end select end do ! num_cv_3d_basic - if ( cloud_cv_options == 2 ) then + if ( cloud_cv_options == 2 .and. ccv_be_inp_opt == 2 ) then do i = num_cv_3d_basic+1 , num_cv_3d_basic+num_cv_3d_extra read (be_unit) variable print *, trim(adjustl(variable)) diff --git a/var/da/da_setup_structures/da_setup_structures.f90 b/var/da/da_setup_structures/da_setup_structures.f90 index ee74e79b66..d954836ea9 100644 --- a/var/da/da_setup_structures/da_setup_structures.f90 +++ b/var/da/da_setup_structures/da_setup_structures.f90 @@ -69,6 +69,7 @@ module da_setup_structures use da_control, only: rden_bin, use_lsac use da_control, only: use_cv_w use da_control, only: pseudo_tpw, pseudo_ztd, pseudo_ref, pseudo_uvtpq, pseudo_elv, anal_type_qcobs + use da_control, only: ccv_be_inp_opt use da_obs, only : da_fill_obs_structures, da_store_obs_grid_info, da_store_obs_grid_info_rad, & da_fill_obs_structures_rain, da_fill_obs_structures_radar, da_set_obs_missing,da_set_3d_obs_missing From 133dc93fc7ac862579f139440c5216dc2c027515 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Fri, 20 Apr 2018 15:49:26 -0600 Subject: [PATCH 18/91] Dissociate use_cv_w from cloud_cv_options if-test blocks in setting BE. But note that for now use_cv_w also uses the same ccv_be_inp_opt intended for cloud cv. A new namelist, wcv_be_inp_opt, can be added in the future if desired. modified: var/da/da_setup_structures/da_setup_be_regional.inc --- .../da_setup_be_regional.inc | 168 ++++++++++-------- 1 file changed, 96 insertions(+), 72 deletions(-) diff --git a/var/da/da_setup_structures/da_setup_be_regional.inc b/var/da/da_setup_structures/da_setup_be_regional.inc index cf65e06748..dfaff2bfe4 100644 --- a/var/da/da_setup_structures/da_setup_be_regional.inc +++ b/var/da/da_setup_structures/da_setup_be_regional.inc @@ -608,19 +608,12 @@ subroutine da_setup_be_regional(xb, be, grid) be8_eval_glo = 1.0e-6 be9_eval_glo = 1.0e-6 be10_eval_glo = 1.0e-6 - if ( use_cv_w ) then - be % v11 % name = "w" - be11_eval_glo = 1.0 - end if if ( use_rf ) then be6_rf_lengthscale = 1.0 be7_rf_lengthscale = 1.0 be8_rf_lengthscale = 1.0 be9_rf_lengthscale = 1.0 be10_rf_lengthscale = 1.0 - if ( use_cv_w ) then - be11_rf_lengthscale = 1.0 - end if end if else if ( ccv_be_inp_opt == 1 ) then fname = 'be_ccv.txt' @@ -654,6 +647,7 @@ subroutine da_setup_be_regional(xb, be, grid) be10_rf_lengthscale(:) = rval end if close(ccv_be_unit) + call da_free_unit(ccv_be_unit) write (unit=message(1),fmt='(3x,A,5e10.3)') 'eval from be_ccv.txt: ', & be6_eval_glo(1), be7_eval_glo(1), be8_eval_glo(1), be9_eval_glo(1), & be10_eval_glo(1) @@ -661,34 +655,76 @@ subroutine da_setup_be_regional(xb, be, grid) be6_rf_lengthscale(1), be7_rf_lengthscale(1), be8_rf_lengthscale(1), & be9_rf_lengthscale(1), be10_rf_lengthscale(1) call da_message(message(1:2)) - if ( use_cv_w ) then - fname = 'be_w.txt' - inquire(file=trim(fname), exist=fexist) - if ( .not. fexist ) then - write (unit=message(1),fmt='(3x,A,5e10.3)') trim(fname)//' does not exist for ccv_be_inp_opt=1' - call da_error(__FILE__,__LINE__,message(1:1)) - end if - open(unit=ccv_be_unit,file=trim(fname), status="old",form="formatted") - read(ccv_be_unit,*) rval - be11_eval_glo(:) = rval - if ( use_rf ) then - read(ccv_be_unit,*) rval - be11_rf_lengthscale(:) = rval - end if - close(ccv_be_unit) - write (unit=message(1),fmt='(3x,A,e10.3)') 'eval from be_w.txt: ', & - be11_eval_glo(1) - write (unit=message(2),fmt='(3x,A,f10.3)') 'sl from be_w.txt: ', & - be11_rf_lengthscale(1) - call da_message(message(1:2)) - end if - call da_free_unit(ccv_be_unit) else write (unit=message(1),fmt='(3x,A)') 'Please set ccv_be_inp_opt = 0 or 1 for cloud_cv_options=3' call da_error(__FILE__,__LINE__,message(1:1)) end if ! ccv_be_inp_opt for cloud_cv_options=3 end if + if ( use_cv_w ) then + be % v11 % name = "w" + if ( ccv_be_inp_opt == 0 ) then + be11_eval_glo = 1.0 + if ( use_rf ) then + be11_rf_lengthscale = 1.0 + end if + else if ( ccv_be_inp_opt == 1 ) then + fname = 'be_w.txt' + inquire(file=trim(fname), exist=fexist) + if ( .not. fexist ) then + write (unit=message(1),fmt='(3x,A,5e10.3)') trim(fname)//' does not exist for ccv_be_inp_opt=1' + call da_error(__FILE__,__LINE__,message(1:1)) + end if + call da_get_unit(ccv_be_unit) + open(unit=ccv_be_unit,file=trim(fname), status="old",form="formatted") + read(ccv_be_unit,*) rval + be11_eval_glo(:) = rval + if ( use_rf ) then + read(ccv_be_unit,*) rval + be11_rf_lengthscale(:) = rval + end if + close(ccv_be_unit) + call da_free_unit(ccv_be_unit) + write (unit=message(1),fmt='(3x,A,e10.3)') 'eval from be_w.txt: ', & + be11_eval_glo(1) + write (unit=message(2),fmt='(3x,A,f10.3)') 'sl from be_w.txt: ', & + be11_rf_lengthscale(1) + call da_message(message(1:2)) + else if ( ccv_be_inp_opt == 3 ) then + ! w + fname = 'be_W.dat' + inquire(file=trim(fname), exist=fexist) + if ( .not. fexist ) then + write (unit=message(1),fmt='(3x,A,5e10.3)') trim(fname)//' does not exist for ccv_be_inp_opt=3' + call da_error(__FILE__,__LINE__,message(1:1)) + end if + call da_get_unit(ccv_be_unit) + open(unit=ccv_be_unit,file=trim(fname), status="old",form="unformatted") + do n = 1, 7 + ! skip the first 7 records + read (ccv_be_unit) + end do + allocate (evec_loc(1:nk,1:nk,1:num_bins2d)) + allocate (eval_loc(1:nk, 1:num_bins2d)) + read (ccv_be_unit) be11_evec_glo + read (ccv_be_unit) be11_eval_glo + read (ccv_be_unit) evec_loc + read (ccv_be_unit) eval_loc + if ( use_rf ) then + read (ccv_be_unit) be11_rf_lengthscale + end if + do j=1,nj + b = bin2d(1,j) + be11_evec_loc(j,1:nk,1:nk) = evec_loc(1:nk,1:nk,b) + be11_eval_loc(j,1:nk ) = eval_loc(1:nk,b) + end do + close(ccv_be_unit) + call da_free_unit(ccv_be_unit) + deallocate (evec_loc) + deallocate (eval_loc) + end if ! ccv_be_inp_opt for w + end if ! use_cv_w + ! 2.2 Read in the eigenvector and eigenvalue print *, '-------- reading eigen vector/value -------' @@ -899,9 +935,6 @@ subroutine da_setup_be_regional(xb, be, grid) be % v8 % name = "qice" be % v9 % name = "qsnow" be % v10 % name = "qgraup" - if ( use_cv_w ) then - be % v11 % name = "w" - end if call da_get_unit(ccv_be_unit) allocate (evec_loc(1:nk,1:nk,1:num_bins2d)) allocate (eval_loc(1:nk, 1:num_bins2d)) @@ -924,7 +957,9 @@ subroutine da_setup_be_regional(xb, be, grid) read (ccv_be_unit) be6_eval_glo read (ccv_be_unit) evec_loc read (ccv_be_unit) eval_loc - read (ccv_be_unit) be6_rf_lengthscale + if ( use_rf ) then + read (ccv_be_unit) be6_rf_lengthscale + end if do j=1,nj b = bin2d(1,j) be6_evec_loc(j,1:nk,1:nk) = evec_loc(1:nk,1:nk,b) @@ -947,7 +982,9 @@ subroutine da_setup_be_regional(xb, be, grid) read (ccv_be_unit) be7_eval_glo read (ccv_be_unit) evec_loc read (ccv_be_unit) eval_loc - read (ccv_be_unit) be7_rf_lengthscale + if ( use_rf ) then + read (ccv_be_unit) be7_rf_lengthscale + end if do j=1,nj b = bin2d(1,j) be7_evec_loc(j,1:nk,1:nk) = evec_loc(1:nk,1:nk,b) @@ -970,7 +1007,9 @@ subroutine da_setup_be_regional(xb, be, grid) read (ccv_be_unit) be8_eval_glo read (ccv_be_unit) evec_loc read (ccv_be_unit) eval_loc - read (ccv_be_unit) be8_rf_lengthscale + if ( use_rf ) then + read (ccv_be_unit) be8_rf_lengthscale + end if do j=1,nj b = bin2d(1,j) be8_evec_loc(j,1:nk,1:nk) = evec_loc(1:nk,1:nk,b) @@ -993,7 +1032,9 @@ subroutine da_setup_be_regional(xb, be, grid) read (ccv_be_unit) be9_eval_glo read (ccv_be_unit) evec_loc read (ccv_be_unit) eval_loc - read (ccv_be_unit) be9_rf_lengthscale + if ( use_rf ) then + read (ccv_be_unit) be9_rf_lengthscale + end if do j=1,nj b = bin2d(1,j) be9_evec_loc(j,1:nk,1:nk) = evec_loc(1:nk,1:nk,b) @@ -1016,38 +1057,15 @@ subroutine da_setup_be_regional(xb, be, grid) read (ccv_be_unit) be10_eval_glo read (ccv_be_unit) evec_loc read (ccv_be_unit) eval_loc - read (ccv_be_unit) be10_rf_lengthscale + if ( use_rf ) then + read (ccv_be_unit) be10_rf_lengthscale + end if do j=1,nj b = bin2d(1,j) be10_evec_loc(j,1:nk,1:nk) = evec_loc(1:nk,1:nk,b) be10_eval_loc(j,1:nk ) = eval_loc(1:nk,b) end do close(ccv_be_unit) - if ( use_cv_w ) then - ! w - fname = 'be_W.dat' - inquire(file=trim(fname), exist=fexist) - if ( .not. fexist ) then - write (unit=message(1),fmt='(3x,A,5e10.3)') trim(fname)//' does not exist for ccv_be_inp_opt=3' - call da_error(__FILE__,__LINE__,message(1:1)) - end if - open(unit=ccv_be_unit,file=trim(fname), status="old",form="unformatted") - do n = 1, 7 - ! skip the first 7 records - read (ccv_be_unit) - end do - read (ccv_be_unit) be11_evec_glo - read (ccv_be_unit) be11_eval_glo - read (ccv_be_unit) evec_loc - read (ccv_be_unit) eval_loc - read (ccv_be_unit) be11_rf_lengthscale - do j=1,nj - b = bin2d(1,j) - be11_evec_loc(j,1:nk,1:nk) = evec_loc(1:nk,1:nk,b) - be11_eval_loc(j,1:nk ) = eval_loc(1:nk,b) - end do - close(ccv_be_unit) - end if deallocate (evec_loc) deallocate (eval_loc) call da_free_unit(ccv_be_unit) @@ -1466,9 +1484,10 @@ subroutine da_setup_be_regional(xb, be, grid) call da_check_eof_decomposition(be8_eval_glo(:), be8_evec_glo(:,:), be % v8 % name) call da_check_eof_decomposition(be9_eval_glo(:), be9_evec_glo(:,:), be % v9 % name) call da_check_eof_decomposition(be10_eval_glo(:), be10_evec_glo(:,:), be % v10 % name) - if ( use_cv_w ) then - call da_check_eof_decomposition(be11_eval_glo(:), be11_evec_glo(:,:), be % v11 % name) - end if + end if + + if ( use_cv_w .and. (ccv_be_inp_opt == 2 .or. ccv_be_inp_opt == 3) ) then + call da_check_eof_decomposition(be11_eval_glo(:), be11_evec_glo(:,:), be % v11 % name) end if end if @@ -1485,9 +1504,6 @@ subroutine da_setup_be_regional(xb, be, grid) call da_get_vertical_truncation(max_vert_var8, be8_eval_glo(:), be % v8) call da_get_vertical_truncation(max_vert_var9, be9_eval_glo(:), be % v9) call da_get_vertical_truncation(max_vert_var10,be10_eval_glo(:),be % v10) - if ( use_cv_w ) then - call da_get_vertical_truncation(max_vert_var11,be11_eval_glo(:),be % v11) - end if else if ( jb_factor > 0.0 ) then be % v6 % mz = xb % mkz @@ -1495,16 +1511,24 @@ subroutine da_setup_be_regional(xb, be, grid) be % v8 % mz = xb % mkz be % v9 % mz = xb % mkz be % v10 % mz = xb % mkz - if ( use_cv_w ) then - be % v11 % mz = xb % mkz - end if else be % v6 % mz = 0 be % v7 % mz = 0 be % v8 % mz = 0 be % v9 % mz = 0 be % v10 % mz = 0 - be % v11 % mz = 0 + end if + end if + + if ( use_cv_w ) then + if ( ccv_be_inp_opt == 2 .or. ccv_be_inp_opt == 3 ) then + call da_get_vertical_truncation(max_vert_var11,be11_eval_glo(:),be % v11) + else + if ( jb_factor > 0.0 ) then + be % v11 % mz = xb % mkz + else + be % v11 % mz = 0 + end if end if end if From 244b9aed4ef4e98ad3a991366b0932b86ab76cb8 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Mon, 23 Apr 2018 10:28:27 -0600 Subject: [PATCH 19/91] Add radar_non_precip_opt=3 option used by CWB. Set retrieved qr, qs, qg to zero when echo is non-precip. modified: var/da/da_radar/da_get_innov_vector_radar.inc --- var/da/da_radar/da_get_innov_vector_radar.inc | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/var/da/da_radar/da_get_innov_vector_radar.inc b/var/da/da_radar/da_get_innov_vector_radar.inc index 3c61d369e4..64250e8b3c 100644 --- a/var/da/da_radar/da_get_innov_vector_radar.inc +++ b/var/da/da_radar/da_get_innov_vector_radar.inc @@ -381,7 +381,8 @@ if ( iv%info(radar)%nlocal > 0 ) then ob_radar_rf = ob % radar(n) % rf(k) - if ( radar_non_precip_opt > 0 ) then ! assimilate non_precip echo + if ( radar_non_precip_opt > 0 .and. radar_non_precip_opt /= 3 ) then + ! assimilate non_precip echo if ( echo_non_precip ) then ! ob is non-precip if ( bg_rf > -15.0 ) then ! when background/model is precip @@ -441,6 +442,19 @@ if ( iv%info(radar)%nlocal > 0 ) then iv % radar(n) % rgr(k) % qc = 0 end if ! temp +!------ norain modify by yating 20180212 + if ( radar_non_precip_opt == 3 ) then ! assimilate non_precip echo + if ( echo_non_precip ) then ! ob is non-precip + iv % radar(n) % rrno(k) = 0. + iv % radar(n) % rsno(k) = 0. + iv % radar(n) % rgro(k) = 0. + iv % radar(n) % rrn(k) % qc = 0 + iv % radar(n) % rsn(k) % qc = 0 + iv % radar(n) % rgr(k) % qc = 0 + end if + end if +!--------------------------------------------------- + ! rainwater error iv % radar(n) % rrn(k) % error = iv % radar(n) % rf(k) % error * iv % radar(n) % rrno(k) * alog_10/leh2 iv % radar(n) % rrn(k) % error = amax1(0.0005,iv % radar(n) % rrn(k) % error) From 2224289930a343aa8ffadc940a036bfc3ff95bef Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Mon, 23 Apr 2018 12:10:03 -0600 Subject: [PATCH 20/91] Use Max_StHeight_Diff_ztd instead of Max_StHeight_Diff for ZTD. Also set the default Max_StHeight_Diff_ztd a large value for backward compatibility when users do not explicitly set Max_StHeight_Diff_ztd. The same code has been in the master repository as of commit bc60b4c. modified: Registry/registry.var modified: var/da/da_gpspw/da_get_innov_vector_gpsztd.inc modified: var/da/da_gpspw/da_gpspw.f90 --- Registry/registry.var | 1 + var/da/da_gpspw/da_get_innov_vector_gpsztd.inc | 4 ++-- var/da/da_gpspw/da_gpspw.f90 | 2 +- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/Registry/registry.var b/Registry/registry.var index d3e5c61795..edf3393983 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -332,6 +332,7 @@ rconfig logical sfcht_adjust_q namelist,wrfvar11 1 .false. - "sf rconfig integer sfc_hori_intp_options namelist,wrfvar11 1 1 - "sfc_hori_intp_options" "how the background is calculated" "1: 4-point, 2: nearest point" rconfig integer q_error_options namelist,wrfvar11 1 1 - "q_error_options" "how specific humidity errors are calculated from RH errors" "1: orig, 2: new" rconfig real max_stheight_diff namelist,wrfvar11 1 100.0 - "max_stheight_diff" "Stations whose |Zdiff|>max_stHeight_diff will not be assimilated when sfc_assi_options=1" "m" +rconfig real max_stheight_diff_ztd namelist,wrfvar11 1 1000.0 - "max_stheight_diff_ztd" "For ZTD, stations whose |Zdiff|>max_stHeight_diff_ztd will not be assimilated" "m" rconfig real stn_ht_diff_scale namelist,wrfvar11 1 200.0 - "stn_ht_diff_scale" "factor=exp(|Zdiff|/stn_ht_diff_scale)" "m" rconfig logical obs_err_inflate namelist,wrfvar11 1 .false. - "obs_err_inflate" "switch for inflating obs err by exp(|Zdiff|/stn_ht_diff_scale)" "" rconfig logical consider_xap4ztd namelist,wrfvar11 1 .true. - "consider_xap4ztd" "whether or not including xa%p in TL/AD of xtoztd operator" "" diff --git a/var/da/da_gpspw/da_get_innov_vector_gpsztd.inc b/var/da/da_gpspw/da_get_innov_vector_gpsztd.inc index 89914d460f..4513b02494 100644 --- a/var/da/da_gpspw/da_get_innov_vector_gpsztd.inc +++ b/var/da/da_gpspw/da_get_innov_vector_gpsztd.inc @@ -9,7 +9,7 @@ SUBROUTINE da_get_innov_vector_gpsztd ( it, num_qcstat_conv, grid, ob, iv ) ! Y.-R. Guo 05/21/2008 ! History: ! 2017-06: Jamie Bresch -! (1) reject obs-model height difference larger than Max_StHeight_Diff +! (1) reject obs-model height difference larger than Max_StHeight_Diff_ztd ! (2) properly write out ztd innov info ! (3) minor clean-up !---------------------------------------------------------------- @@ -134,7 +134,7 @@ SUBROUTINE da_get_innov_vector_gpsztd ( it, num_qcstat_conv, grid, ob, iv ) end if !pseudo_ztd end if ! valid obs - if ( abs(obs_terr - model_terr) > Max_StHeight_Diff ) then + if ( abs(obs_terr - model_terr) > Max_StHeight_Diff_ztd ) then iv%gpspw(n)%tpw%qc = -66 end if diff --git a/var/da/da_gpspw/da_gpspw.f90 b/var/da/da_gpspw/da_gpspw.f90 index fe4a069f1a..473a1ea9ca 100644 --- a/var/da/da_gpspw/da_gpspw.f90 +++ b/var/da/da_gpspw/da_gpspw.f90 @@ -7,7 +7,7 @@ module da_gpspw v_interp_p, v_interp_h, check_max_iv_print,kts,kte, & missing, max_error_uv, max_error_t, rootproc, gpspw, & max_error_p,max_error_q, check_max_iv_unit,check_max_iv, & - max_stheight_diff,missing_data,max_error_bq,max_error_slp, & + max_stheight_diff_ztd,missing_data,max_error_bq,max_error_slp, & max_error_bt, max_error_buv, gpspw,max_error_thickness, & pseudo_var, num_pseudo, use_gpspwobs, use_gpsztdobs, max_error_pw,fails_error_max, & fails_error_max,pseudo_err,pseudo_x, pseudo_y, stdout, & From 528a5cafb3e68b35d22ee4260a5ba6b68514c66a Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Thu, 26 Apr 2018 18:22:06 -0600 Subject: [PATCH 21/91] Fix improper qc flag in gts_omb_oma when synop q ob is missing for q_error_options=2. Add checks for missing Q obs to set proper Q qc flags. I-Han Chen reported the problem and helped with the test. modified: var/da/da_synop/da_get_innov_vector_synop.inc --- var/da/da_synop/da_get_innov_vector_synop.inc | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/var/da/da_synop/da_get_innov_vector_synop.inc b/var/da/da_synop/da_get_innov_vector_synop.inc index 384c372283..ae171675b4 100644 --- a/var/da/da_synop/da_get_innov_vector_synop.inc +++ b/var/da/da_synop/da_get_innov_vector_synop.inc @@ -188,9 +188,14 @@ subroutine da_get_innov_vector_synop( it,num_qcstat_conv, grid, ob, iv) if ( it == 1 .and. q_error_options == 2 ) then allocate (model_qs(iv%info(synop)%n1:iv%info(synop)%n2)) do n=iv%info(synop)%n1,iv%info(synop)%n2 - call da_tp_to_qs(model_t(1,n), model_p(1,n), es, model_qs(n)) - rh_error = iv%synop(n)%q%error !q error is rh at this stage - iv%synop(n)%q%error = model_qs(n)*rh_error*0.01 + if ( abs(ob%synop(n)%q-missing_r) > 1.0 ) then + call da_tp_to_qs(model_t(1,n), model_p(1,n), es, model_qs(n)) + rh_error = iv%synop(n)%q%error !q error is rh at this stage + iv%synop(n)%q%error = model_qs(n)*rh_error*0.01 + else + iv%synop(n)%q%error = missing_r + iv%synop(n)%q%qc = missing_data + end if end do deallocate (model_qs) end if From 8fbb74794673eaa170c5d4f2fe2d99542f6917d8 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Mon, 30 Apr 2018 10:16:36 -0600 Subject: [PATCH 22/91] Remove redundant include of mpif.h in module_dm.F for Fujitsu compilation. The same code has been in the master repository as of commit bd9a460. modified: external/RSL_LITE/module_dm.F --- external/RSL_LITE/module_dm.F | 1 - 1 file changed, 1 deletion(-) diff --git a/external/RSL_LITE/module_dm.F b/external/RSL_LITE/module_dm.F index cc497dfc63..2704b83af3 100644 --- a/external/RSL_LITE/module_dm.F +++ b/external/RSL_LITE/module_dm.F @@ -1313,7 +1313,6 @@ END FUNCTION getrealmpitype REAL FUNCTION wrf_dm_max_int ( inval ) IMPLICIT NONE #ifndef STUBMPI - INCLUDE 'mpif.h' INTEGER, intent(in) :: inval INTEGER :: ierr, retval CALL mpi_allreduce ( inval, retval , 1, MPI_INT, MPI_MAX, local_communicator, ierr ) From 46fbba5335be8f390a9939a909298efbea206239 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Wed, 2 May 2018 16:09:53 -0600 Subject: [PATCH 23/91] Improve radar DA memory usage by not allocating unused variables. modified: var/da/da_define_structures/da_allocate_y.inc modified: var/da/da_define_structures/da_allocate_y_radar.inc modified: var/da/da_define_structures/da_deallocate_observations.inc modified: var/da/da_define_structures/da_define_structures.f90 modified: var/da/da_obs_io/da_obs_io.f90 modified: var/da/da_obs_io/da_read_obs_radar.inc modified: var/da/da_radar/da_ao_stats_radar.inc modified: var/da/da_radar/da_get_innov_vector_radar.inc modified: var/da/da_radar/da_jo_and_grady_radar.inc modified: var/da/da_radar/da_oi_stats_radar.inc modified: var/da/da_radar/da_radar.f90 modified: var/da/da_radar/da_transform_xtoy_radar.inc modified: var/da/da_radar/da_transform_xtoy_radar_adj.inc modified: var/da/da_setup_structures/da_setup_obs_structures_radar.inc --- var/da/da_define_structures/da_allocate_y.inc | 4 - .../da_allocate_y_radar.inc | 4 - .../da_deallocate_observations.inc | 8 +- .../da_define_structures.f90 | 20 ++--- var/da/da_obs_io/da_obs_io.f90 | 3 +- var/da/da_obs_io/da_read_obs_radar.inc | 82 ++++++++----------- var/da/da_radar/da_ao_stats_radar.inc | 6 +- var/da/da_radar/da_get_innov_vector_radar.inc | 24 ++---- var/da/da_radar/da_jo_and_grady_radar.inc | 2 - var/da/da_radar/da_oi_stats_radar.inc | 6 +- var/da/da_radar/da_radar.f90 | 4 - var/da/da_radar/da_transform_xtoy_radar.inc | 19 +++-- .../da_radar/da_transform_xtoy_radar_adj.inc | 18 ++-- .../da_setup_obs_structures_radar.inc | 4 - 14 files changed, 78 insertions(+), 126 deletions(-) diff --git a/var/da/da_define_structures/da_allocate_y.inc b/var/da/da_define_structures/da_allocate_y.inc index 5b74ad9b52..f1c9364684 100644 --- a/var/da/da_define_structures/da_allocate_y.inc +++ b/var/da/da_define_structures/da_allocate_y.inc @@ -181,8 +181,6 @@ subroutine da_allocate_y (iv, y) allocate (y % radar(n)%rrn(1:nlevels)) allocate (y % radar(n)%rsn(1:nlevels)) allocate (y % radar(n)%rgr(1:nlevels)) - allocate (y % radar(n)%rcl(1:nlevels)) - allocate (y % radar(n)%rci(1:nlevels)) allocate (y % radar(n)%rqv(1:nlevels)) y % radar(n) % rv(1:nlevels) = 0.0 @@ -190,8 +188,6 @@ subroutine da_allocate_y (iv, y) y % radar(n) % rrn(1:nlevels) = 0.0 y % radar(n) % rsn(1:nlevels) = 0.0 y % radar(n) % rgr(1:nlevels) = 0.0 - y % radar(n) % rcl(1:nlevels) = 0.0 - y % radar(n) % rci(1:nlevels) = 0.0 y % radar(n) % rqv(1:nlevels) = 0.0 end do end if diff --git a/var/da/da_define_structures/da_allocate_y_radar.inc b/var/da/da_define_structures/da_allocate_y_radar.inc index ae3f1f39c4..75937954a7 100644 --- a/var/da/da_define_structures/da_allocate_y_radar.inc +++ b/var/da/da_define_structures/da_allocate_y_radar.inc @@ -34,8 +34,6 @@ subroutine da_allocate_y_radar (iv, y) allocate (y % radar(n)%rrn(1:nlevels)) allocate (y % radar(n)%rsn(1:nlevels)) allocate (y % radar(n)%rgr(1:nlevels)) - allocate (y % radar(n)%rcl(1:nlevels)) - allocate (y % radar(n)%rci(1:nlevels)) allocate (y % radar(n)%rqv(1:nlevels)) y % radar(n) % rv(1:nlevels) = 0.0 @@ -43,8 +41,6 @@ subroutine da_allocate_y_radar (iv, y) y % radar(n) % rrn(1:nlevels) = 0.0 y % radar(n) % rsn(1:nlevels) = 0.0 y % radar(n) % rgr(1:nlevels) = 0.0 - y % radar(n) % rcl(1:nlevels) = 0.0 - y % radar(n) % rci(1:nlevels) = 0.0 y % radar(n) % rqv(1:nlevels) = 0.0 end do end if diff --git a/var/da/da_define_structures/da_deallocate_observations.inc b/var/da/da_define_structures/da_deallocate_observations.inc index 971badc16f..0004d0ad68 100644 --- a/var/da/da_define_structures/da_deallocate_observations.inc +++ b/var/da/da_define_structures/da_deallocate_observations.inc @@ -220,9 +220,11 @@ subroutine da_deallocate_observations (iv) deallocate (iv%info(n)%lat) deallocate (iv%info(n)%lon) deallocate (iv%info(n)%elv) - deallocate (iv%info(n)%pstar) - deallocate (iv%info(n)%slp) - deallocate (iv%info(n)%pw) + if ( n /= radar ) then + deallocate (iv%info(n)%pstar) + deallocate (iv%info(n)%slp) + deallocate (iv%info(n)%pw) + end if deallocate (iv%info(n)%x) deallocate (iv%info(n)%y) deallocate (iv%info(n)%i) diff --git a/var/da/da_define_structures/da_define_structures.f90 b/var/da/da_define_structures/da_define_structures.f90 index 3000ff4195..ef54856488 100644 --- a/var/da/da_define_structures/da_define_structures.f90 +++ b/var/da/da_define_structures/da_define_structures.f90 @@ -215,8 +215,6 @@ module da_define_structures real, pointer :: model_t(:) real, pointer :: model_rho(:) real, pointer :: model_qrn(:) - real, pointer :: model_qcl(:) - real, pointer :: model_qci(:) real, pointer :: model_qsn(:) real, pointer :: model_qgr(:) real :: model_ps @@ -226,15 +224,11 @@ module da_define_structures type (field_type) , pointer :: rv (:) ! Radial Velocity type (field_type) , pointer :: rf (:) ! Reflectivity - type (field_type) , pointer :: rrn (:) ! Reflectivity - type (field_type) , pointer :: rcl (:) ! Reflectivity - type (field_type) , pointer :: rci (:) ! Reflectivity - type (field_type) , pointer :: rsn (:) ! Reflectivity - type (field_type) , pointer :: rgr (:) ! Reflectivity - type (field_type) , pointer :: rqv (:) ! + type (field_type) , pointer :: rrn (:) ! qrain + type (field_type) , pointer :: rsn (:) ! qsnow + type (field_type) , pointer :: rgr (:) ! qgraupel + type (field_type) , pointer :: rqv (:) real , pointer :: rrno (:) - real , pointer :: rclo (:) - real , pointer :: rcio (:) real , pointer :: rsno (:) real , pointer :: rgro (:) real , pointer :: rqvo (:) @@ -688,8 +682,6 @@ module da_define_structures type (bad_info_type) :: rrn type (bad_info_type) :: rsn type (bad_info_type) :: rgr - type (bad_info_type) :: rcl - type (bad_info_type) :: rci type (bad_info_type) :: rqv type (bad_info_type) :: slp type (bad_info_type) :: rad @@ -826,8 +818,6 @@ module da_define_structures real, pointer :: rv(:) ! rv real, pointer :: rf(:) ! rf real, pointer :: rrn(:) ! rrain - real, pointer :: rcl(:) ! rcloud - real, pointer :: rci(:) ! rcloudice real, pointer :: rsn(:) ! rsnow real, pointer :: rgr(:) ! rgraupel real, pointer :: rqv(:) @@ -925,7 +915,7 @@ module da_define_structures real :: qscat_u, qscat_v real :: profiler_u, profiler_v real :: buoy_u, buoy_v, buoy_t, buoy_p, buoy_q - real :: radar_rv, radar_rf, radar_rrn,radar_rsn,radar_rgr,radar_rcl,radar_rci,radar_rqv + real :: radar_rv, radar_rf, radar_rrn,radar_rsn,radar_rgr,radar_rqv real :: bogus_u, bogus_v, bogus_t, bogus_q, bogus_slp real :: airsr_t, airsr_q real :: rain_r diff --git a/var/da/da_obs_io/da_obs_io.f90 b/var/da/da_obs_io/da_obs_io.f90 index 8a8d522959..e2c668eb2d 100644 --- a/var/da/da_obs_io/da_obs_io.f90 +++ b/var/da/da_obs_io/da_obs_io.f90 @@ -30,7 +30,8 @@ module da_obs_io wind_sd,wind_sd_synop,wind_sd_tamdar,wind_sd_mtgirs,wind_sd_profiler,wind_sd_geoamv,wind_sd_polaramv, & wind_sd_airep,wind_sd_sound,wind_sd_metar,wind_sd_ships,wind_sd_qscat,wind_sd_buoy,wind_sd_pilot,wind_stats_sd,& thin_conv, thin_conv_ascii, lsac_nh_step, lsac_nv_step, lsac_nv_start, lsac_print_details, & - lsac_use_u, lsac_use_v, lsac_use_t, lsac_use_q, lsac_u_error, lsac_v_error, lsac_t_error, lsac_q_error + lsac_use_u, lsac_use_v, lsac_use_t, lsac_use_q, lsac_u_error, lsac_v_error, lsac_t_error, lsac_q_error, & + use_radar_rhv, use_radar_rqv use da_define_structures, only : iv_type, multi_level_type, multi_level_type_BUFR, & radar_multi_level_type, y_type, field_type, each_level_type, & diff --git a/var/da/da_obs_io/da_read_obs_radar.inc b/var/da/da_obs_io/da_read_obs_radar.inc index 18ca3db03a..01513567d1 100644 --- a/var/da/da_obs_io/da_read_obs_radar.inc +++ b/var/da/da_obs_io/da_read_obs_radar.inc @@ -271,9 +271,6 @@ subroutine da_read_obs_radar (iv, filename, grid) iv%info(radar)%lat(:,ilocal) = platform%info%lat iv%info(radar)%lon(:,ilocal) = platform%info%lon iv%info(radar)%elv(ilocal) = platform%info%elv - iv%info(radar)%pstar(ilocal) = platform%info%pstar - iv%info(radar)%slp(ilocal) = platform%loc%slp - iv%info(radar)%pw(ilocal) = platform%loc%pw iv%info(radar)%x(:,ilocal) = platform%loc%x iv%info(radar)%y(:,ilocal) = platform%loc%y iv%info(radar)%i(:,ilocal) = platform%loc%i @@ -288,27 +285,24 @@ subroutine da_read_obs_radar (iv, filename, grid) allocate (iv % radar (ilocal) % model_p (1:iv%info(radar)%max_lev)) allocate (iv % radar (ilocal) % model_rho(1:iv%info(radar)%max_lev)) allocate (iv % radar (ilocal) % model_qrn(1:iv%info(radar)%max_lev)) - allocate (iv % radar (ilocal) % model_qcl(1:iv%info(radar)%max_lev)) - allocate (iv % radar (ilocal) % model_qci(1:iv%info(radar)%max_lev)) allocate (iv % radar (ilocal) % model_qsn(1:iv%info(radar)%max_lev)) allocate (iv % radar (ilocal) % model_qgr(1:iv%info(radar)%max_lev)) allocate (iv % radar (ilocal) % height (1:iv%info(radar)%max_lev)) allocate (iv % radar (ilocal) % height_qc(1:iv%info(radar)%max_lev)) allocate (iv % radar (ilocal) % rv (1:iv%info(radar)%max_lev)) allocate (iv % radar (ilocal) % rf (1:iv%info(radar)%max_lev)) - allocate (iv % radar (ilocal) % rrn (1:iv%info(radar)%max_lev)) - allocate (iv % radar (ilocal) % rcl (1:iv%info(radar)%max_lev)) - allocate (iv % radar (ilocal) % rci (1:iv%info(radar)%max_lev)) - allocate (iv % radar (ilocal) % rsn (1:iv%info(radar)%max_lev)) - allocate (iv % radar (ilocal) % rgr (1:iv%info(radar)%max_lev)) - allocate (iv % radar (ilocal) % rqv (1:iv%info(radar)%max_lev)) - - allocate (iv % radar (ilocal) % rrno (1:iv%info(radar)%max_lev)) - allocate (iv % radar (ilocal) % rclo (1:iv%info(radar)%max_lev)) - allocate (iv % radar (ilocal) % rcio (1:iv%info(radar)%max_lev)) - allocate (iv % radar (ilocal) % rsno (1:iv%info(radar)%max_lev)) - allocate (iv % radar (ilocal) % rgro (1:iv%info(radar)%max_lev)) - allocate (iv % radar (ilocal) % rqvo (1:iv%info(radar)%max_lev)) + if ( use_radar_rhv ) then + allocate (iv % radar (ilocal) % rrn (1:iv%info(radar)%max_lev)) + allocate (iv % radar (ilocal) % rsn (1:iv%info(radar)%max_lev)) + allocate (iv % radar (ilocal) % rgr (1:iv%info(radar)%max_lev)) + allocate (iv % radar (ilocal) % rrno (1:iv%info(radar)%max_lev)) + allocate (iv % radar (ilocal) % rsno (1:iv%info(radar)%max_lev)) + allocate (iv % radar (ilocal) % rgro (1:iv%info(radar)%max_lev)) + end if + if ( use_radar_rqv ) then + allocate (iv % radar (ilocal) % rqv (1:iv%info(radar)%max_lev)) + allocate (iv % radar (ilocal) % rqvo (1:iv%info(radar)%max_lev)) + end if end if do i = 1, nlevels iv % radar (ilocal) % height(i) = platform % each(i) % height @@ -316,35 +310,29 @@ subroutine da_read_obs_radar (iv, filename, grid) iv % radar (ilocal) % rv(i) = platform % each(i) % rv iv % radar (ilocal) % rf(i) = platform % each(i) % rf - iv % radar (ilocal) % rrn(i) % inv = missing_r - iv % radar (ilocal) % rrn(i) % qc = missing_data - iv % radar (ilocal) % rrn(i) % error = missing_r - iv % radar (ilocal) % rrno(i) = missing_r - - iv % radar (ilocal) % rcl(i) % inv = missing_r - iv % radar (ilocal) % rcl(i) % qc = missing_data - iv % radar (ilocal) % rcl(i) % error = missing_r - iv % radar (ilocal) % rclo(i) = missing_r - - iv % radar (ilocal) % rci(i) % inv = missing_r - iv % radar (ilocal) % rci(i) % qc = missing_data - iv % radar (ilocal) % rci(i) % error = missing_r - iv % radar (ilocal) % rcio(i) = missing_r - - iv % radar (ilocal) % rsn(i) % inv = missing_r - iv % radar (ilocal) % rsn(i) % qc = missing_data - iv % radar (ilocal) % rsn(i) % error = missing_r - iv % radar (ilocal) % rsno(i) = missing_r - - iv % radar (ilocal) % rgr(i) % inv = missing_r - iv % radar (ilocal) % rgr(i) % qc = missing_data - iv % radar (ilocal) % rgr(i) % error = missing_r - iv % radar (ilocal) % rgro(i) = missing_r - - iv % radar (ilocal) % rqv(i) % inv = missing_r - iv % radar (ilocal) % rqv(i) % qc = missing_data - iv % radar (ilocal) % rqv(i) % error = missing_r - iv % radar (ilocal) % rqvo(i) = missing_r + if ( use_radar_rhv ) then + iv % radar (ilocal) % rrn(i) % inv = missing_r + iv % radar (ilocal) % rrn(i) % qc = missing_data + iv % radar (ilocal) % rrn(i) % error = missing_r + iv % radar (ilocal) % rrno(i) = missing_r + + iv % radar (ilocal) % rsn(i) % inv = missing_r + iv % radar (ilocal) % rsn(i) % qc = missing_data + iv % radar (ilocal) % rsn(i) % error = missing_r + iv % radar (ilocal) % rsno(i) = missing_r + + iv % radar (ilocal) % rgr(i) % inv = missing_r + iv % radar (ilocal) % rgr(i) % qc = missing_data + iv % radar (ilocal) % rgr(i) % error = missing_r + iv % radar (ilocal) % rgro(i) = missing_r + end if + + if ( use_radar_rqv ) then + iv % radar (ilocal) % rqv(i) % inv = missing_r + iv % radar (ilocal) % rqv(i) % qc = missing_data + iv % radar (ilocal) % rqv(i) % error = missing_r + iv % radar (ilocal) % rqvo(i) = missing_r + end if end do case default; diff --git a/var/da/da_radar/da_ao_stats_radar.inc b/var/da/da_radar/da_ao_stats_radar.inc index 5cf798e795..8408ddc22a 100644 --- a/var/da/da_radar/da_ao_stats_radar.inc +++ b/var/da/da_radar/da_ao_stats_radar.inc @@ -31,18 +31,14 @@ subroutine da_ao_stats_radar (stats_unit, iv, re) stats%maximum%rrn = maxmin_type (missing_r, 0, 0) stats%maximum%rsn = maxmin_type (missing_r, 0, 0) stats%maximum%rgr = maxmin_type (missing_r, 0, 0) - stats%maximum%rcl = maxmin_type (missing_r, 0, 0) - stats%maximum%rci = maxmin_type (missing_r, 0, 0) stats%maximum%rqv = maxmin_type (missing_r, 0, 0) stats%minimum%rrn = maxmin_type(-missing_r, 0, 0) stats%minimum%rsn = maxmin_type(-missing_r, 0, 0) stats%minimum%rgr = maxmin_type(-missing_r, 0, 0) - stats%minimum%rcl = maxmin_type(-missing_r, 0, 0) - stats%minimum%rci = maxmin_type(-missing_r, 0, 0) stats%minimum%rqv = maxmin_type(-missing_r, 0, 0) - stats%average = residual_radar1_type(0.0, 0.0, 0.0, 0.0, 0.0,0.0,0.0,0.0) + stats%average = residual_radar1_type(0.0, 0.0, 0.0, 0.0, 0.0, 0.0) stats%rms_err = stats%average do n=1, iv%info(radar)%nlocal diff --git a/var/da/da_radar/da_get_innov_vector_radar.inc b/var/da/da_radar/da_get_innov_vector_radar.inc index 64250e8b3c..d5feeed303 100644 --- a/var/da/da_radar/da_get_innov_vector_radar.inc +++ b/var/da/da_radar/da_get_innov_vector_radar.inc @@ -44,8 +44,6 @@ subroutine da_get_innov_vector_radar (it, grid, ob, iv) real, allocatable :: model_rho(:,:) real, allocatable :: model_qrn(:,:) - real, allocatable :: model_qcl(:,:) - real, allocatable :: model_qci(:,:) real, allocatable :: model_qsn(:,:) real, allocatable :: model_qgr(:,:) @@ -110,8 +108,8 @@ if ( iv%info(radar)%nlocal > 0 ) then allocate (model_v(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) allocate (model_w(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) - allocate (model_rv(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) - allocate (model_rf(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) + if ( use_radar_rv ) allocate (model_rv(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) + if ( use_radar_rf ) allocate (model_rf(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) allocate (model_ps(iv%info(radar)%n1:iv%info(radar)%n2)) allocate (model_qv(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) @@ -120,8 +118,6 @@ if ( iv%info(radar)%nlocal > 0 ) then allocate (model_rho(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) allocate (model_qrn(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) - allocate (model_qcl(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) - allocate (model_qci(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) allocate (model_qsn(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) allocate (model_qgr(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) @@ -136,8 +132,8 @@ if ( iv%info(radar)%nlocal > 0 ) then model_v(:,:) = 0. model_w(:,:) = 0. - model_rv(:,:) = 0. - model_rf(:,:) = 0. + if ( use_radar_rv ) model_rv(:,:) = 0. + if ( use_radar_rf ) model_rf(:,:) = 0. model_ps(:) = 0. model_qv(:,:) = 0. @@ -146,8 +142,6 @@ if ( iv%info(radar)%nlocal > 0 ) then model_rho(:,:) = 0. model_qrn(:,:) = 0. - model_qcl(:,:) = 0. - model_qci(:,:) = 0. model_qsn(:,:) = 0. model_qgr(:,:) = 0. @@ -202,8 +196,6 @@ if ( iv%info(radar)%nlocal > 0 ) then call da_interp_lin_3d (grid%xb % wh, iv%info(radar), model_w) call da_interp_lin_3d (grid%xb % rho, iv%info(radar), model_rho) call da_interp_lin_3d (grid%xb % qrn, iv%info(radar), model_qrn) - call da_interp_lin_3d (grid%xb % qcw, iv%info(radar), model_qcl) - call da_interp_lin_3d (grid%xb % qci, iv%info(radar), model_qci) call da_interp_lin_3d (grid%xb % qsn, iv%info(radar), model_qsn) IF ( ASSOCIATED( grid%xb%qgr ) ) THEN call da_interp_lin_3d (grid%xb % qgr, iv%info(radar), model_qgr) @@ -296,8 +288,6 @@ if ( iv%info(radar)%nlocal > 0 ) then iv%radar(n)%model_p(1:iv%info(radar)%levels(n)) = model_p(1:iv%info(radar)%levels(n),n) iv%radar(n)%model_rho(1:iv%info(radar)%levels(n)) = model_rho(1:iv%info(radar)%levels(n),n) iv%radar(n)%model_qrn(1:iv%info(radar)%levels(n)) = model_qrn(1:iv%info(radar)%levels(n),n) - iv%radar(n)%model_qcl(1:iv%info(radar)%levels(n)) = model_qcl(1:iv%info(radar)%levels(n),n) - iv%radar(n)%model_qci(1:iv%info(radar)%levels(n)) = model_qci(1:iv%info(radar)%levels(n),n) iv%radar(n)%model_qsn(1:iv%info(radar)%levels(n)) = model_qsn(1:iv%info(radar)%levels(n),n) iv%radar(n)%model_qgr(1:iv%info(radar)%levels(n)) = model_qgr(1:iv%info(radar)%levels(n),n) @@ -792,8 +782,8 @@ if ( iv%info(radar)%nlocal > 0 ) then deallocate (model_v) deallocate (model_w) - deallocate (model_rv) - deallocate (model_rf) + if ( allocated(model_rv) ) deallocate (model_rv) + if ( allocated(model_rf) ) deallocate (model_rf) deallocate (model_ps) deallocate (model_qv) @@ -802,8 +792,6 @@ if ( iv%info(radar)%nlocal > 0 ) then deallocate (model_qrn) deallocate (model_rho) - deallocate (model_qcl) - deallocate (model_qci) deallocate (model_qsn) deallocate (model_qgr) diff --git a/var/da/da_radar/da_jo_and_grady_radar.inc b/var/da/da_radar/da_jo_and_grady_radar.inc index 3b8f203a14..3720666290 100644 --- a/var/da/da_radar/da_jo_and_grady_radar.inc +++ b/var/da/da_radar/da_jo_and_grady_radar.inc @@ -20,8 +20,6 @@ subroutine da_jo_and_grady_radar(iv, re, jo, jo_grad_y) jo % radar_rrn = 0.0 jo % radar_rsn = 0.0 jo % radar_rgr = 0.0 - jo % radar_rci = 0.0 - jo % radar_rcl = 0.0 jo % radar_rqv = 0.0 do n=1, iv%info(radar)%nlocal diff --git a/var/da/da_radar/da_oi_stats_radar.inc b/var/da/da_radar/da_oi_stats_radar.inc index 2bb17e78a7..6bfa5c8cfd 100644 --- a/var/da/da_radar/da_oi_stats_radar.inc +++ b/var/da/da_radar/da_oi_stats_radar.inc @@ -30,18 +30,14 @@ subroutine da_oi_stats_radar (stats_unit, iv) stats%maximum%rrn = maxmin_type (missing_r, 0, 0) stats%maximum%rsn = maxmin_type (missing_r, 0, 0) stats%maximum%rgr = maxmin_type (missing_r, 0, 0) - stats%maximum%rcl = maxmin_type (missing_r, 0, 0) - stats%maximum%rci = maxmin_type (missing_r, 0, 0) stats%maximum%rqv = maxmin_type (missing_r, 0, 0) stats%minimum%rrn = maxmin_type(-missing_r, 0, 0) stats%minimum%rsn = maxmin_type(-missing_r, 0, 0) stats%minimum%rgr = maxmin_type(-missing_r, 0, 0) - stats%minimum%rcl = maxmin_type(-missing_r, 0, 0) - stats%minimum%rci = maxmin_type(-missing_r, 0, 0) stats%minimum%rqv = maxmin_type(-missing_r, 0, 0) - stats%average = residual_radar1_type(0.0, 0.0, 0.0, 0.0, 0.0,0.0,0.0,0.0) + stats%average = residual_radar1_type(0.0, 0.0, 0.0, 0.0, 0.0, 0.0) stats%rms_err = stats%average diff --git a/var/da/da_radar/da_radar.f90 b/var/da/da_radar/da_radar.f90 index fe8316d0a1..f656159922 100644 --- a/var/da/da_radar/da_radar.f90 +++ b/var/da/da_radar/da_radar.f90 @@ -43,8 +43,6 @@ module da_radar real :: rrn real :: rsn real :: rgr - real :: rcl - real :: rci real :: rqv end type residual_radar1_type @@ -54,8 +52,6 @@ module da_radar type (maxmin_type) :: rrn type (maxmin_type) :: rsn type (maxmin_type) :: rgr - type (maxmin_type) :: rcl - type (maxmin_type) :: rci type (maxmin_type) :: rqv end type maxmin_radar_stats_type diff --git a/var/da/da_radar/da_transform_xtoy_radar.inc b/var/da/da_radar/da_transform_xtoy_radar.inc index 1d918c09ca..f582683bfa 100644 --- a/var/da/da_radar/da_transform_xtoy_radar.inc +++ b/var/da/da_radar/da_transform_xtoy_radar.inc @@ -52,9 +52,7 @@ subroutine da_transform_xtoy_radar (grid, iv, y) allocate (model_qsn(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) allocate (model_qgr(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) allocate (model_qv(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) - allocate (model_qvb(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) allocate (model_t(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) - allocate (model_tb(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) do n=iv%info(radar)%n1,iv%info(radar)%n2 do k = 1, iv%info(radar)%levels(n) @@ -87,9 +85,14 @@ subroutine da_transform_xtoy_radar (grid, iv, y) end if call da_interp_lin_3d (grid%xa%q, iv%info(radar), model_qv) call da_interp_lin_3d (grid%xa%t, iv%info(radar), model_t) - !basic states - call da_interp_lin_3d (grid%xb%t, iv%info(radar), model_tb) - call da_interp_lin_3d (grid%xb%q, iv%info(radar), model_qvb) + + if ( use_radar_rqv ) then + !basic states + allocate (model_tb(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) + allocate (model_qvb(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) + call da_interp_lin_3d (grid%xb%t, iv%info(radar), model_tb) + call da_interp_lin_3d (grid%xb%q, iv%info(radar), model_qvb) + end if do n=iv%info(radar)%n1,iv%info(radar)%n2 @@ -157,10 +160,12 @@ subroutine da_transform_xtoy_radar (grid, iv, y) deallocate (model_qsn) deallocate (model_qgr) deallocate (model_qv) - deallocate (model_qvb) deallocate (model_t) - deallocate (model_tb) deallocate (model_rho) + if ( use_radar_rqv ) then + deallocate (model_tb) + deallocate (model_qvb) + end if if (trace_use) call da_trace_exit("da_transform_xtoy_radar") diff --git a/var/da/da_radar/da_transform_xtoy_radar_adj.inc b/var/da/da_radar/da_transform_xtoy_radar_adj.inc index 83d184ce9e..d9434e1500 100644 --- a/var/da/da_radar/da_transform_xtoy_radar_adj.inc +++ b/var/da/da_radar/da_transform_xtoy_radar_adj.inc @@ -59,13 +59,15 @@ subroutine da_transform_xtoy_radar_adj(grid, iv, jo_grad_y, jo_grad_x) allocate (model_qsn(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) allocate (model_qgr(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) allocate (model_qv(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) - allocate (model_qvb(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) allocate (model_t(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) - allocate (model_tb(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) - !basic states - call da_interp_lin_3d (grid%xb%t, iv%info(radar), model_tb) - call da_interp_lin_3d (grid%xb%q, iv%info(radar), model_qvb) + if ( use_radar_rqv ) then + !basic states + allocate (model_qvb(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) + allocate (model_tb(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) + call da_interp_lin_3d (grid%xb%t, iv%info(radar), model_tb) + call da_interp_lin_3d (grid%xb%q, iv%info(radar), model_qvb) + end if ! Needed model_u = 0.0 @@ -173,12 +175,14 @@ subroutine da_transform_xtoy_radar_adj(grid, iv, jo_grad_y, jo_grad_x) deallocate (model_qrnb) deallocate (model_ps) deallocate (model_qv) - deallocate (model_qvb) deallocate (model_t) - deallocate (model_tb) deallocate (model_qsn) deallocate (model_qgr) deallocate (model_rho) + if ( use_radar_rqv ) then + deallocate (model_qvb) + deallocate (model_tb) + end if if (trace_use) call da_trace_exit("da_transform_xtoy_radar_adj") diff --git a/var/da/da_setup_structures/da_setup_obs_structures_radar.inc b/var/da/da_setup_structures/da_setup_obs_structures_radar.inc index 721248f872..efc981a3df 100644 --- a/var/da/da_setup_structures/da_setup_obs_structures_radar.inc +++ b/var/da/da_setup_structures/da_setup_obs_structures_radar.inc @@ -57,10 +57,6 @@ subroutine da_setup_obs_structures_radar( grid, ob, iv ) allocate (iv%info(radar)%lat(iv%info(radar)%max_lev,iv%info(radar)%nlocal)) allocate (iv%info(radar)%lon(iv%info(radar)%max_lev,iv%info(radar)%nlocal)) allocate (iv%info(radar)%elv(iv%info(radar)%nlocal)) - allocate (iv%info(radar)%pstar(iv%info(radar)%nlocal)) - - allocate (iv%info(radar)%slp(iv%info(radar)%nlocal)) - allocate (iv%info(radar)%pw(iv%info(radar)%nlocal)) allocate (iv%info(radar)%x (kms:kme,iv%info(radar)%nlocal)) allocate (iv%info(radar)%y (kms:kme,iv%info(radar)%nlocal)) From 3fc063b6103e3d3c8d3e82db7bf8a1605abf8ff2 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Thu, 17 May 2018 13:34:16 -0600 Subject: [PATCH 24/91] 4DVAR fix for cloud variables. This fixes the unreasonable 4DVAR QICE and QGRAUP increments when only surface observations are assimilated with cloud_cv_options=3 and mp_physics=99, a case reported by Ihan. This should also fix other subtle 4DVAR moist problems. However, there are probably more fixes needed for rainfall DA. modified: Registry/registry.var modified: var/da/da_main/da_update_firstguess.inc modified: var/da/da_main/da_wrfvar_init2.inc modified: var/da/da_transfer_model/da_transfer_model.f90 modified: var/da/da_transfer_model/da_transfer_wrftltoxa.inc modified: var/da/da_transfer_model/da_transfer_wrftltoxa_adj.inc modified: var/da/da_transfer_model/da_transfer_xatowrftl.inc modified: var/da/da_transfer_model/da_transfer_xatowrftl_adj.inc --- Registry/registry.var | 71 ++++++++++++++++--- var/da/da_main/da_update_firstguess.inc | 20 ++++-- var/da/da_main/da_wrfvar_init2.inc | 31 ++------ .../da_transfer_model/da_transfer_model.f90 | 4 +- .../da_transfer_wrftltoxa.inc | 33 +++++---- .../da_transfer_wrftltoxa_adj.inc | 33 +++++---- .../da_transfer_xatowrftl.inc | 33 +++++---- .../da_transfer_xatowrftl_adj.inc | 33 +++++---- 8 files changed, 156 insertions(+), 102 deletions(-) diff --git a/Registry/registry.var b/Registry/registry.var index edf3393983..2e2be0070a 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -61,8 +61,8 @@ state real a_qs ijkft a_moist 1 - rh "A_QSNOW state real g_qs ijkft g_moist 1 - rh "G_QSNOW" "Snow mixing ratio" "kg kg-1" state real a_qg ijkft a_moist 1 - rh "A_QGRAUP" "Graupel mixing ratio" "kg kg-1" state real g_qg ijkft g_moist 1 - rh "G_QGRAUP" "Graupel mixing ratio" "kg kg-1" -#state real a_qh ijkft a_moist 1 - rh "A_QHAIL" "Hail mixing ratio" "kg kg-1" -#state real g_qh ijkft g_moist 1 - rh "G_QHAIL" "Hail mixing ratio" "kg kg-1" +state real a_qh ijkft a_moist 1 - rh "A_QHAIL" "Hail mixing ratio" "kg kg-1" +state real g_qh ijkft g_moist 1 - rh "G_QHAIL" "Hail mixing ratio" "kg kg-1" # Other Misc State Variables state real g_h_diabatic ijk misc 1 - rdu "g_h_diabatic" "MICROPHYSICS LATENT HEATING" "K s-1" state real a_h_diabatic ijk misc 1 - rdu "a_h_diabatic" "MICROPHYSICS LATENT HEATING" "K s-1" @@ -493,8 +493,6 @@ rconfig logical var4d_run namelist,perturbation 1 .true. - rconfig integer mp_physics_ad namelist,physics max_domains 98 - "mp_physics_ad" "" "" # NAMELIST DERIVED rconfig integer mp_physics_4dvar derived max_domains -1 - "mp_physics_4dvar" "" "-1 = no 4dvar and so no need to allocate a_ and g_ moist and scalar variables, >0 = running 4dvar, so allocate a_ and g_ moist and scalar variables appropriate for selected microphysics package" -rconfig integer mp_physics_da derived max_domains 1 - "mp_physics_da" "" "1 when mp_physics>0 for allocating moist variables" -rconfig integer mp_physics_da_4dvar derived max_domains -1 - "mp_physics_da_4dvar" "" "1 when mp_physics>0 for allocating g_/a_moist variables" # #--------------------------------------------------------------------------------------------------------------------------------------- # Package Declarations @@ -509,12 +507,65 @@ package dyn_em_ad dyn_opt==302 - - package dyn_em_tst dyn_opt==402 - - package dyn_em_var dyn_opt==502 - - -package mp_phys_zero mp_physics_da==0 - moist:qv -package mp_phys_set mp_physics_da==1 - moist:qv,qc,qr,qi,qs,qg +package nomoist_ad mp_physics_ad==98 - - +package warmrain_ad mp_physics_ad==99 - - -package nomoist_4dvar mp_physics_da_4dvar==-1 - - -package passiveqv_4dvar mp_physics_da_4dvar==0 - g_moist:g_qv;a_moist:a_qv -package warmrain_4dvar mp_physics_da_4dvar==1 - g_moist:g_qv,g_qc,g_qr;a_moist:a_qv,a_qc,a_qr +#do "grep package Registry/Registry.EM_COMMON | grep mp_physics==", then remove non-moist lists +package passiveqv mp_physics==0 - moist:qv +package kesslerscheme mp_physics==1 - moist:qv,qc,qr +package linscheme mp_physics==2 - moist:qv,qc,qr,qi,qs,qg +package wsm3scheme mp_physics==3 - moist:qv,qc,qr +package wsm5scheme mp_physics==4 - moist:qv,qc,qr,qi,qs +package fer_mp_hires mp_physics==5 - moist:qv,qc,qr,qi +package fer_mp_hires_advect mp_physics==15 - moist:qv,qc,qr,qi +package wsm6scheme mp_physics==6 - moist:qv,qc,qr,qi,qs,qg +package gsfcgcescheme mp_physics==7 - moist:qv,qc,qr,qi,qs,qg +package thompson mp_physics==8 - moist:qv,qc,qr,qi,qs,qg +package milbrandt2mom mp_physics==9 - moist:qv,qc,qr,qi,qs,qg,qh +package morr_two_moment mp_physics==10 - moist:qv,qc,qr,qi,qs,qg +package cammgmpscheme mp_physics==11 - moist:qv,qc,qi,qr,qs +package sbu_ylinscheme mp_physics==13 - moist:qv,qc,qr,qi,qs +package wdm5scheme mp_physics==14 - moist:qv,qc,qr,qi,qs +package wdm6scheme mp_physics==16 - moist:qv,qc,qr,qi,qs,qg +package nssl_2mom mp_physics==17 - moist:qv,qc,qr,qi,qs,qg,qh +package nssl_2momccn mp_physics==18 - moist:qv,qc,qr,qi,qs,qg,qh +package nssl_1mom mp_physics==19 - moist:qv,qc,qr,qi,qs,qg,qh +package nssl_1momlfo mp_physics==21 - moist:qv,qc,qr,qi,qs,qg +package nssl_2momg mp_physics==22 - moist:qv,qc,qr,qi,qs,qg +package thompsonaero mp_physics==28 - moist:qv,qc,qr,qi,qs,qg +package p3_1category mp_physics==50 - moist:qv,qc,qr,qi +package p3_1category_nc mp_physics==51 - moist:qv,qc,qr,qi +package etampnew mp_physics==95 - moist:qv,qc,qr,qs +package lscondscheme mp_physics==98 - moist:qv +package mkesslerscheme mp_physics==99 - moist:qv,qc,qr +# +package passiveqv_4dvar mp_physics_4dvar==0 - g_moist:g_qv;a_moist:a_qv +package kessler_4dvar mp_physics_4dvar==1 - g_moist:g_qv,g_qc,g_qr;a_moist:a_qv,a_qc,a_qr +package lins_4dvar mp_physics_4dvar==2 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg;a_moist:a_qv,a_qc,a_qr +package wsm3_4dvar mp_physics_4dvar==3 - g_moist:g_qv,g_qc,g_qr;a_moist:a_qv,a_qc,a_qr +package wsm5_4dvar mp_physics_4dvar==4 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs +package fer_mp_hi_4dvar mp_physics_4dvar==5 - g_moist:g_qv,g_qc,g_qr,g_qi;a_moist:a_qv,a_qc,a_qr,a_qi +package fer_mp_hi_advect_4dvar mp_physics_4dvar==15 - g_moist:g_qv,g_qc,g_qr,g_qi;a_moist:a_qv,a_qc,a_qr,a_qi +package wsm6_4dvar mp_physics_4dvar==6 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg +package gsfcgce_4dvar mp_physics_4dvar==7 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg +package thompson_4dvar mp_physics_4dvar==8 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg +package milbrandt2mom_4dvar mp_physics_4dvar==9 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg,g_qh;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg,a_qh +package morr_two_mom_4dvar mp_physics_4dvar==10 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg +package cammgmp_4dvar mp_physics_4dvar==11 - g_moist:g_qv,g_qc,g_qi,g_qr,g_qs;a_moist:a_qv,a_qc,a_qi,a_qr,a_qs +package sbu_ylin_4dvar mp_physics_4dvar==13 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs;g_moist:a_qv,a_qc,a_qr,a_qi,a_qs +package wdm5_4dvar mp_physics_4dvar==14 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs;g_moist:a_qv,a_qc,a_qr,a_qi,a_qs +package wdm6_4dvar mp_physics_4dvar==16 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg +package nssl_2mom_4dvar mp_physics_4dvar==17 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg,g_qh;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg,a_qh +package nssl_2momccn_4dvar mp_physics_4dvar==18 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg,g_qh;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg,a_qh +package nssl_1mom_4dvar mp_physics_4dvar==19 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg,g_qh;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg,a_qh +package nssl_1momlfo_4dvar mp_physics_4dvar==21 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg +package nssl_2momg_4dvar mp_physics_4dvar==22 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg +package thompsonaero_4dvar mp_physics_4dvar==28 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg +package p3_1category_4dvar mp_physics_4dvar==50 - g_moist:g_qv,g_qc,g_qr,g_qi;a_moist:a_qv,a_qc,a_qr,a_qi +package p3_1category_nc_4dvar mp_physics_4dvar==51 - g_moist:g_qv,g_qc,g_qr,g_qi;a_moist:a_qv,a_qc,a_qr,a_qi +package etampnew_4dvar mp_physics_4dvar==95 - g_moist:g_qv,g_qc,g_qr,g_qs;a_moist:a_qv,a_qc,a_qr,a_qs +package lscond_4dvar mp_physics_4dvar==98 - g_moist:g_qv;a_moist:a_qv +package mkessler_4dvar mp_physics_4dvar==99 - g_moist:g_qv,g_qc,g_qr;a_moist:a_qv,a_qc,a_qr package surfdragscheme bl_pbl_physics==98 - - package ducuscheme cu_physics==98 - - @@ -876,7 +927,7 @@ package cloud_cv_1 cloud_cv_options==1 - state:xa%qt, package cloud_cv_2 cloud_cv_options==2 - state:xa%qrn,xa%qcw,xa%qci,xa%qsn,xa%qgr,vp%v6,vp%v7,vp%v8,vp%v9,vp%v10,vv%v6,vv%v7,vv%v8,vv%v9,vv%v10 package cloud_cv_3 cloud_cv_options==3 - state:xa%qrn,xa%qcw,xa%qci,xa%qsn,xa%qgr,vp%v6,vp%v7,vp%v8,vp%v9,vp%v10,vv%v6,vv%v7,vv%v8,vv%v9,vv%v10 package not_var4d var4d_cloudcv==-1 - - -package no_var4d_ccv var4d_cloudcv==0 - state:vp6%v1,vp6%v2,vp6%v3,vp6%v4,vp6%v5,vv6%v1,vv6%v2,vv6%v3,vv6%v4,vv6%v5,xa%qrn,xa%qcw +package no_var4d_ccv var4d_cloudcv==0 - state:vp6%v1,vp6%v2,vp6%v3,vp6%v4,vp6%v5,vv6%v1,vv6%v2,vv6%v3,vv6%v4,vv6%v5 package var4d_ccv_1 var4d_cloudcv==1 - state:vp6%v1,vp6%v2,vp6%v3,vp6%v4,vp6%v5,vv6%v1,vv6%v2,vv6%v3,vv6%v4,vv6%v5,x6a%qt,x6a%qrn,x6a%qcw package var4d_ccv_2 var4d_cloudcv==2 - state:vp6%v1,vp6%v2,vp6%v3,vp6%v4,vp6%v5,vv6%v1,vv6%v2,vv6%v3,vv6%v4,vv6%v5,vp6%v6,vp6%v7,vp6%v8,vp6%v9,vp6%v10,vv6%v6,vv6%v7,vv6%v8,vv6%v9,vv6%v10,x6a%qrn,x6a%qcw,x6a%qci,x6a%qsn,x6a%qgr package var4d_ccv_3 var4d_cloudcv==3 - state:vp6%v1,vp6%v2,vp6%v3,vp6%v4,vp6%v5,vv6%v1,vv6%v2,vv6%v3,vv6%v4,vv6%v5,vp6%v6,vp6%v7,vp6%v8,vp6%v9,vp6%v10,vv6%v6,vv6%v7,vv6%v8,vv6%v9,vv6%v10,x6a%qrn,x6a%qcw,x6a%qci,x6a%qsn,x6a%qgr diff --git a/var/da/da_main/da_update_firstguess.inc b/var/da/da_main/da_update_firstguess.inc index eae85e6959..0dcb0af256 100755 --- a/var/da/da_main/da_update_firstguess.inc +++ b/var/da/da_main/da_update_firstguess.inc @@ -28,7 +28,8 @@ subroutine da_update_firstguess(grid, out_filename) use da_control, only : use_radarobs, use_rad, crtm_cloud, & use_radar_rhv, use_radar_rqv use module_state_description, only : p_qv, p_qc, p_qr, p_qi, & - p_qs, p_qg + p_qs, p_qg, & + f_qc, f_qr, f_qi, f_qs, f_qg implicit none @@ -841,7 +842,7 @@ subroutine da_update_firstguess(grid, out_filename) !-------------Update QCLOUD, QRAIN, QICE, QSNOW & QGROUP if ( cloud_cv_options >= 1 ) then ! update qcw and qrn - if (size(grid%moist,dim=4) >= 4) then ! update QCLOUD & QRAIN + if ( f_qc ) then ! ! update QCLOUD ! @@ -891,7 +892,9 @@ if ( cloud_cv_options >= 1 ) then ! update qcw and qrn #ifdef DM_PARALLEL deallocate(globbuf) #endif + end if ! f_qc + if ( f_qr ) then ! ! update QRAIN ! @@ -942,11 +945,11 @@ if ( cloud_cv_options >= 1 ) then ! update qcw and qrn deallocate(globbuf) #endif - end if ! end of update QCLOUD & QRAIN + end if ! f_qr end if ! cloud_cv_options >= 1 if ( cloud_cv_options >= 2 ) then ! update qci, qsn, qgr - if (size(grid%moist,dim=4) >= 6) then ! update QICE & QSNOW + if ( f_qi ) then ! ! update QICE ! @@ -997,6 +1000,9 @@ if ( cloud_cv_options >= 2 ) then ! update qci, qsn, qgr deallocate(globbuf) #endif + end if ! f_qi + + if ( f_qs ) then ! ! update QSNOW ! @@ -1047,9 +1053,9 @@ if ( cloud_cv_options >= 2 ) then ! update qci, qsn, qgr deallocate(globbuf) #endif - end if ! end of update QICE & QSNOW + end if ! f_qs - if (size(grid%moist,dim=4) >= 7) then ! update QGRAUP + if ( f_qg ) then ! ! update QGRAUP ! @@ -1100,7 +1106,7 @@ if ( cloud_cv_options >= 2 ) then ! update qci, qsn, qgr deallocate(globbuf) #endif - end if ! end of update QGRAUP + end if ! f_qg end if ! cloud_cv_options >= 2 !-------------End of update QCLOUD, QRAIN, QICE, QSNOW & QGROUP diff --git a/var/da/da_main/da_wrfvar_init2.inc b/var/da/da_main/da_wrfvar_init2.inc index 417086a26f..bb4f390a60 100644 --- a/var/da/da_main/da_wrfvar_init2.inc +++ b/var/da/da_main/da_wrfvar_init2.inc @@ -76,30 +76,13 @@ subroutine da_wrfvar_init2 call da_message(message(1:1)) endif - !mp_physics_da can be 0/1, used for allocating moist variables - !allocate all moist variables (excluding qh) used in DA when mp_physics is on - do i = 1, model_config_rec%max_dom - if ( mp_physics(i) > 0 ) then - model_config_rec%mp_physics_da(i) = 1 - else if ( mp_physics(i) == 0 ) then - model_config_rec%mp_physics_da(i) = 0 - else if ( mp_physics(i) == -1 ) then - !for DA, if physics_suite is set and mp_physics is not set, mp_physics will be -1 - !in this case, also allocate all moist variables - model_config_rec%mp_physics_da(i) = 1 - end if - end do + if (max_dom > 1 .and. ( .not. anal_type_hybrid_dual_res) ) then + call da_error(__FILE__,__LINE__, (/'WRFDA does not handle nests (max_domain > 1)'/)) + end if if ( var4d ) then model_config_rec%var4d_used = 1 - !mp_physics_da_4dvar can be 0/1, used for allocating a_moist and g_moist variables - do i = 1, model_config_rec%max_dom - if ( mp_physics(i) > 0 ) then - model_config_rec%mp_physics_da_4dvar(i) = 1 - else - model_config_rec%mp_physics_da_4dvar(i) = 0 - end if - end do + model_config_rec%mp_physics_4dvar = model_config_rec%mp_physics end if if ( adj_sens ) then @@ -143,12 +126,6 @@ subroutine da_wrfvar_init2 nullify(null_domain) - -! if (max_dom > 1 ) then - if (max_dom > 1 .and. ( .not. anal_type_hybrid_dual_res) ) then - call da_error(__FILE__,__LINE__, (/'WRFDA does not handle nests (max_domain > 1)'/)) - end if - ! ! The top-most domain in the simulation is then allocated and configured ! by calling alloc_and_configure_domain. diff --git a/var/da/da_transfer_model/da_transfer_model.f90 b/var/da/da_transfer_model/da_transfer_model.f90 index 6f813f991b..6eb76d23c9 100644 --- a/var/da/da_transfer_model/da_transfer_model.f90 +++ b/var/da/da_transfer_model/da_transfer_model.f90 @@ -14,7 +14,7 @@ module da_transfer_model p_g_qv, p_g_qr, p_g_qi, p_g_qs, p_g_qg, p_g_qc, & p_a_qv, p_a_qr, p_a_qi, p_a_qs, p_a_qg, p_a_qc, num_g_moist, num_a_moist, & f_qc, f_qr, f_qi, f_qs, f_qg, f_g_qc, f_g_qr, f_g_qi, f_g_qs, f_g_qg, & - f_a_qc, f_a_qr, f_a_qi, f_a_qs, f_a_qg + f_a_qc, f_a_qr, f_a_qi, f_a_qs, f_a_qg, warmrain_ad use module_dm, only : wrf_dm_sum_real, wrf_dm_sum_reals #ifdef DM_PARALLEL use module_dm, only : local_communicator, & @@ -42,7 +42,7 @@ module da_transfer_model t_kelvin, num_fgat_time, num_pseudo, iso_temp, interval_seconds, trajectory_io, & ids,ide,jds,jde,kds,kde, ims,ime,jms,jme,kms,kme, num_fft_factors, & its,ite,jts,jte,kts,kte, ips,ipe,jps,jpe,kps,kpe, qlimit, & - update_sfcdiags, use_wrf_sfcinfo, use_radar_rqv, cloudbase_calc_opt + update_sfcdiags, use_wrf_sfcinfo, use_radar_rqv, cloudbase_calc_opt, cloud_cv_options use da_control, only: base_pres_strat, base_lapse_strat use da_control, only: c1f, c2f, c1h, c2h, c3f, c3h, c4f, c4h use da_define_structures, only : xbx_type, be_type diff --git a/var/da/da_transfer_model/da_transfer_wrftltoxa.inc b/var/da/da_transfer_model/da_transfer_wrftltoxa.inc index 0e036ef85e..50aad239a5 100644 --- a/var/da/da_transfer_model/da_transfer_wrftltoxa.inc +++ b/var/da/da_transfer_model/da_transfer_wrftltoxa.inc @@ -169,21 +169,26 @@ subroutine da_transfer_wrftltoxa(grid, config_flags, filnam, timestr) end do if ( var4d ) then - if ( f_g_qc ) then - grid%xa%qcw(is:ie,js:je,ks:ke)=grid%g_moist(is:ie,js:je,ks:ke,p_g_qc) - end if - if ( f_g_qr ) then - grid%xa%qrn(is:ie,js:je,ks:ke)=grid%g_moist(is:ie,js:je,ks:ke,p_g_qr) - end if - if ( f_g_qi ) then - grid%xa%qci(is:ie,js:je,ks:ke)=grid%g_moist(is:ie,js:je,ks:ke,p_g_qi) - end if - if ( f_g_qs ) then - grid%xa%qsn(is:ie,js:je,ks:ke)=grid%g_moist(is:ie,js:je,ks:ke,p_g_qs) - end if - if ( f_g_qg ) then - grid%xa%qgr(is:ie,js:je,ks:ke)=grid%g_moist(is:ie,js:je,ks:ke,p_g_qg) + if ( config_flags%mp_physics_ad == warmrain_ad ) then + if ( f_g_qc .and. cloud_cv_options >= 1 ) then + grid%xa%qcw(is:ie,js:je,ks:ke)=grid%g_moist(is:ie,js:je,ks:ke,p_g_qc) + end if + if ( f_g_qr .and. cloud_cv_options >= 1 ) then + grid%xa%qrn(is:ie,js:je,ks:ke)=grid%g_moist(is:ie,js:je,ks:ke,p_g_qr) + end if end if + !placeholder + !if ( config_flags%mp_physics_ad == icecld_ad ) then + ! if ( f_g_qi .and. cloud_cv_options >= 2 ) then + ! grid%xa%qci(is:ie,js:je,ks:ke)=grid%g_moist(is:ie,js:je,ks:ke,p_g_qi) + ! end if + ! if ( f_g_qs .and. cloud_cv_options >= 2 ) then + ! grid%xa%qsn(is:ie,js:je,ks:ke)=grid%g_moist(is:ie,js:je,ks:ke,p_g_qs) + ! end if + ! if ( f_g_qg .and. cloud_cv_options >= 2 ) then + ! grid%xa%qgr(is:ie,js:je,ks:ke)=grid%g_moist(is:ie,js:je,ks:ke,p_g_qg) + ! end if + !end if end if #ifdef DM_PARALLEL diff --git a/var/da/da_transfer_model/da_transfer_wrftltoxa_adj.inc b/var/da/da_transfer_model/da_transfer_wrftltoxa_adj.inc index fe70ee6f31..d944b3b13f 100644 --- a/var/da/da_transfer_model/da_transfer_wrftltoxa_adj.inc +++ b/var/da/da_transfer_model/da_transfer_wrftltoxa_adj.inc @@ -64,21 +64,26 @@ subroutine da_transfer_wrftltoxa_adj(grid, config_flags, filnam, timestr) grid%xa%w(is:ie,js:je,ks:ke+1) = 0.0 if ( var4d ) then - if ( f_g_qc ) then - grid%g_moist(is:ie,js:je,ks:ke,p_g_qc)=grid%xa%qcw(is:ie,js:je,ks:ke) - end if - if ( f_g_qr ) then - grid%g_moist(is:ie,js:je,ks:ke,p_g_qr)=grid%xa%qrn(is:ie,js:je,ks:ke) - end if - if ( f_g_qi ) then - grid%g_moist(is:ie,js:je,ks:ke,p_g_qi)=grid%xa%qci(is:ie,js:je,ks:ke) - end if - if ( f_g_qs ) then - grid%g_moist(is:ie,js:je,ks:ke,p_g_qs)=grid%xa%qsn(is:ie,js:je,ks:ke) - end if - if ( f_g_qg ) then - grid%g_moist(is:ie,js:je,ks:ke,p_g_qg)=grid%xa%qgr(is:ie,js:je,ks:ke) + if ( config_flags%mp_physics_ad == warmrain_ad ) then + if ( f_g_qc .and. cloud_cv_options >= 1 ) then + grid%g_moist(is:ie,js:je,ks:ke,p_g_qc)=grid%xa%qcw(is:ie,js:je,ks:ke) + end if + if ( f_g_qr .and. cloud_cv_options >= 1 ) then + grid%g_moist(is:ie,js:je,ks:ke,p_g_qr)=grid%xa%qrn(is:ie,js:je,ks:ke) + end if end if + !placeholder + !if ( config_flags%mp_physics_ad == icecld_ad ) then + ! if ( f_g_qi .and. cloud_cv_options >= 2 ) then + ! grid%g_moist(is:ie,js:je,ks:ke,p_g_qi)=grid%xa%qci(is:ie,js:je,ks:ke) + ! end if + ! if ( f_g_qs .and. cloud_cv_options >= 2 ) then + ! grid%g_moist(is:ie,js:je,ks:ke,p_g_qs)=grid%xa%qsn(is:ie,js:je,ks:ke) + ! end if + ! if ( f_g_qg .and. cloud_cv_options >= 2 ) then + ! grid%g_moist(is:ie,js:je,ks:ke,p_g_qg)=grid%xa%qgr(is:ie,js:je,ks:ke) + ! end if + !end if end if !---------------------------------------------------------------------------- diff --git a/var/da/da_transfer_model/da_transfer_xatowrftl.inc b/var/da/da_transfer_model/da_transfer_xatowrftl.inc index 1a403b5ad8..8dc8f56c14 100644 --- a/var/da/da_transfer_model/da_transfer_xatowrftl.inc +++ b/var/da/da_transfer_model/da_transfer_xatowrftl.inc @@ -258,20 +258,25 @@ subroutine da_transfer_xatowrftl(grid, config_flags, filnam, timestr) end do end do - if ( f_g_qc ) then - grid%g_moist(is:ie,js:je,ks:ke,p_g_qc) = grid%xa%qcw(is:ie,js:je,ks:ke) - end if - if ( f_g_qr ) then - grid%g_moist(is:ie,js:je,ks:ke,p_g_qr) = grid%xa%qrn(is:ie,js:je,ks:ke) - end if - if ( f_g_qi ) then - grid%g_moist(is:ie,js:je,ks:ke,p_g_qi) = grid%xa%qci(is:ie,js:je,ks:ke) - end if - if ( f_g_qs ) then - grid%g_moist(is:ie,js:je,ks:ke,p_g_qs) = grid%xa%qsn(is:ie,js:je,ks:ke) - end if - if ( f_g_qg ) then - grid%g_moist(is:ie,js:je,ks:ke,p_g_qg) = grid%xa%qgr(is:ie,js:je,ks:ke) + if ( config_flags%mp_physics_ad == warmrain_ad ) then + if ( f_g_qc .and. cloud_cv_options >= 1 ) then + grid%g_moist(is:ie,js:je,ks:ke,p_g_qc) = grid%xa%qcw(is:ie,js:je,ks:ke) + end if + if ( f_g_qr .and. cloud_cv_options >= 1 ) then + grid%g_moist(is:ie,js:je,ks:ke,p_g_qr) = grid%xa%qrn(is:ie,js:je,ks:ke) + end if + !placeholder + !if ( config_flags%mp_physics_ad == icecld_ad ) then + ! if ( f_g_qi .and. cloud_cv_options >= 2 ) then + ! grid%g_moist(is:ie,js:je,ks:ke,p_g_qi) = grid%xa%qci(is:ie,js:je,ks:ke) + ! end if + ! if ( f_g_qs .and. cloud_cv_options >= 2 ) then + ! grid%g_moist(is:ie,js:je,ks:ke,p_g_qs) = grid%xa%qsn(is:ie,js:je,ks:ke) + ! end if + ! if ( f_g_qg .and. cloud_cv_options >= 2 ) then + ! grid%g_moist(is:ie,js:je,ks:ke,p_g_qg) = grid%xa%qgr(is:ie,js:je,ks:ke) + ! end if + !end if end if call da_transfer_wrftl_lbc_t0 ( grid ) diff --git a/var/da/da_transfer_model/da_transfer_xatowrftl_adj.inc b/var/da/da_transfer_model/da_transfer_xatowrftl_adj.inc index ce3dbc9fb4..a1dd72d9be 100644 --- a/var/da/da_transfer_model/da_transfer_xatowrftl_adj.inc +++ b/var/da/da_transfer_model/da_transfer_xatowrftl_adj.inc @@ -296,20 +296,25 @@ subroutine da_transfer_xatowrftl_adj(grid, config_flags, filnam) end do end do - if ( f_a_qc ) then - grid%xa%qcw(its:ite,jts:jte,kts:kte)=grid%a_moist(its:ite,jts:jte,kts:kte,p_a_qc) - end if - if ( f_a_qr ) then - grid%xa%qrn(its:ite,jts:jte,kts:kte)=grid%a_moist(its:ite,jts:jte,kts:kte,p_a_qr) - end if - if ( f_a_qi ) then - grid%xa%qci(its:ite,jts:jte,kts:kte)=grid%a_moist(its:ite,jts:jte,kts:kte,p_a_qi) - end if - if ( f_a_qs ) then - grid%xa%qsn(its:ite,jts:jte,kts:kte)=grid%a_moist(its:ite,jts:jte,kts:kte,p_a_qs) - end if - if ( f_a_qg ) then - grid%xa%qgr(its:ite,jts:jte,kts:kte)=grid%a_moist(its:ite,jts:jte,kts:kte,p_a_qg) + if ( config_flags%mp_physics_ad == warmrain_ad ) then + if ( f_a_qc .and. cloud_cv_options >= 1 ) then + grid%xa%qcw(its:ite,jts:jte,kts:kte)=grid%a_moist(its:ite,jts:jte,kts:kte,p_a_qc) + end if + if ( f_a_qr .and. cloud_cv_options >= 1 ) then + grid%xa%qrn(its:ite,jts:jte,kts:kte)=grid%a_moist(its:ite,jts:jte,kts:kte,p_a_qr) + end if + !placeholder + !if ( config_flags%mp_physics_ad == icecld_ad ) then + ! if ( f_a_qi .and. cloud_cv_options >= 2 ) then + ! grid%xa%qci(its:ite,jts:jte,kts:kte)=grid%a_moist(its:ite,jts:jte,kts:kte,p_a_qi) + ! end if + ! if ( f_a_qs .and. cloud_cv_options >= 2 ) then + ! grid%xa%qsn(its:ite,jts:jte,kts:kte)=grid%a_moist(its:ite,jts:jte,kts:kte,p_a_qs) + ! end if + ! if ( f_a_qg .and. cloud_cv_options >= 2 ) then + ! grid%xa%qgr(its:ite,jts:jte,kts:kte)=grid%a_moist(its:ite,jts:jte,kts:kte,p_a_qg) + ! end if + !end if end if grid%a_moist = 0.0 From abd1d9d26ed409cd465f6ade3b903900bf8574b4 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Fri, 25 May 2018 13:28:15 -0600 Subject: [PATCH 25/91] Minor clean-up in registry.var. To be consistent with what had been committed to the master repository. 1. Change default of mp_physics_ad to 99 2. Remove some unused variables 3. Fix a couple typos (g_->a_) modified: Registry/registry.var --- Registry/registry.var | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/Registry/registry.var b/Registry/registry.var index 2e2be0070a..e117c52962 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -64,8 +64,6 @@ state real g_qg ijkft g_moist 1 - rh "G_QGRAU state real a_qh ijkft a_moist 1 - rh "A_QHAIL" "Hail mixing ratio" "kg kg-1" state real g_qh ijkft g_moist 1 - rh "G_QHAIL" "Hail mixing ratio" "kg kg-1" # Other Misc State Variables -state real g_h_diabatic ijk misc 1 - rdu "g_h_diabatic" "MICROPHYSICS LATENT HEATING" "K s-1" -state real a_h_diabatic ijk misc 1 - rdu "a_h_diabatic" "MICROPHYSICS LATENT HEATING" "K s-1" state real G_RAINC ij misc 1 - rhdu "G_RAINC" "ACCUMULATED TOTAL CUMULUS PRECIPITATION" "mm" state real A_RAINC ij misc 1 - rhdu "A_RAINC" "ACCUMULATED TOTAL CUMULUS PRECIPITATION" "mm" state real G_RAINNC ij misc 1 - rhdu "G_RAINNC" "ACCUMULATED TOTAL GRID SCALE PRECIPITATION" "mm" @@ -490,7 +488,7 @@ rconfig logical enable_identity namelist,perturbation 1 .false. - rconfig logical trajectory_io namelist,perturbation 1 .true. - "0:disk IO;1:memory IO" "" "" rconfig logical var4d_detail_out namelist,perturbation 1 .false. - "true:output perturbation, gradient to disk" "" "" rconfig logical var4d_run namelist,perturbation 1 .true. - "true: exlcude the P calculation in start_em" "" "" -rconfig integer mp_physics_ad namelist,physics max_domains 98 - "mp_physics_ad" "" "" +rconfig integer mp_physics_ad namelist,physics max_domains 99 - "mp_physics_ad" "" "" # NAMELIST DERIVED rconfig integer mp_physics_4dvar derived max_domains -1 - "mp_physics_4dvar" "" "-1 = no 4dvar and so no need to allocate a_ and g_ moist and scalar variables, >0 = running 4dvar, so allocate a_ and g_ moist and scalar variables appropriate for selected microphysics package" # @@ -552,8 +550,8 @@ package thompson_4dvar mp_physics_4dvar==8 - g_moist:g_q package milbrandt2mom_4dvar mp_physics_4dvar==9 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg,g_qh;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg,a_qh package morr_two_mom_4dvar mp_physics_4dvar==10 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg package cammgmp_4dvar mp_physics_4dvar==11 - g_moist:g_qv,g_qc,g_qi,g_qr,g_qs;a_moist:a_qv,a_qc,a_qi,a_qr,a_qs -package sbu_ylin_4dvar mp_physics_4dvar==13 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs;g_moist:a_qv,a_qc,a_qr,a_qi,a_qs -package wdm5_4dvar mp_physics_4dvar==14 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs;g_moist:a_qv,a_qc,a_qr,a_qi,a_qs +package sbu_ylin_4dvar mp_physics_4dvar==13 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs +package wdm5_4dvar mp_physics_4dvar==14 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs package wdm6_4dvar mp_physics_4dvar==16 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg package nssl_2mom_4dvar mp_physics_4dvar==17 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg,g_qh;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg,a_qh package nssl_2momccn_4dvar mp_physics_4dvar==18 - g_moist:g_qv,g_qc,g_qr,g_qi,g_qs,g_qg,g_qh;a_moist:a_qv,a_qc,a_qr,a_qi,a_qs,a_qg,a_qh @@ -911,7 +909,7 @@ rconfig integer var4d_used derived 1 0 package no_adj_sens adj_sens_used==0 - - package do_adj_sens adj_sens_used==1 - state:a_u,a_v,a_t,a_mu,a_ph,g_u,g_v,g_t,g_mu,g_ph;a_moist:a_qv;g_moist:g_qv package no_var4d var4d_used==0 - - -package do_var4d var4d_used==1 - state:a_u,a_v,a_w,a_ph,a_t,a_mu,a_p,a_z,g_u,g_v,g_w,g_ph,g_t,g_mu,g_p,g_z,a_h_diabatic,g_h_diabatic,a_rainc,g_rainc,a_rainnc,g_rainnc,a_raincv,g_raincv,a_rainncv,g_rainncv +package do_var4d var4d_used==1 - state:a_u,a_v,a_w,a_ph,a_t,a_mu,a_p,g_u,g_v,g_w,g_ph,g_t,g_mu,g_p,a_rainc,g_rainc,a_rainnc,g_rainnc,a_raincv,g_raincv,a_rainncv,g_rainncv rconfig integer cv_w_used derived 1 0 - "cv_w_used" "turn on if use_cv_w=true" rconfig integer ens_used derived 1 0 - "ens_used" "turn on if ensdim_alpha>0" From 99046c07678be9541949347db584c8bbae2c7233 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Fri, 25 May 2018 13:33:40 -0600 Subject: [PATCH 26/91] Fix a logic error in ccv_be_inp_opt namelist consistency check. modified: var/da/da_setup_structures/da_setup_be_regional.inc --- var/da/da_setup_structures/da_setup_be_regional.inc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/var/da/da_setup_structures/da_setup_be_regional.inc b/var/da/da_setup_structures/da_setup_be_regional.inc index dfaff2bfe4..05e873e1b5 100644 --- a/var/da/da_setup_structures/da_setup_be_regional.inc +++ b/var/da/da_setup_structures/da_setup_be_regional.inc @@ -164,7 +164,7 @@ subroutine da_setup_be_regional(xb, be, grid) end if if ( cloud_cv_options == 2 .and. & - (ccv_be_inp_opt /= 2 .or. ccv_be_inp_opt /= 3) ) then + (ccv_be_inp_opt /= 2 .and. ccv_be_inp_opt /= 3) ) then write (unit=message(1),fmt='(3x,A)') 'Please set ccv_be_inp_opt = 2 or 3 for cloud_cv_options=2' call da_error(__FILE__,__LINE__,message(1:1)) end if From 35ad3eddc793af3e207f39f1e427bbffe6c604d0 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Tue, 19 Jun 2018 14:06:09 -0600 Subject: [PATCH 27/91] Bug fix to make the code consistent with the intended formulation for sfc wind correction. As in figure 2 of Stauffer et al. 1991, MWR, 0=0.2 : u40/u10=1.169+0.315*z0 modified: var/da/da_tools/da_mo_correction.inc --- var/da/da_tools/da_mo_correction.inc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/var/da/da_tools/da_mo_correction.inc b/var/da/da_tools/da_mo_correction.inc index ce51e6fe1b..641d1b27fa 100644 --- a/var/da/da_tools/da_mo_correction.inc +++ b/var/da/da_tools/da_mo_correction.inc @@ -176,7 +176,7 @@ function da_mo_correction (ho, po, to, qo, & if (hll > 1.5) then if (zint < 0.2) then correc = 1.000 + 0.320 * zint ** 0.200 - else if (zint < 0.0) then + else if (zint >= 0.2) then correc = 1.169 + 0.315 * zint end if From b53c3fb1e168835125d489ab23e5f3ad1b986e9d Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Wed, 11 Jul 2018 14:38:19 -0600 Subject: [PATCH 28/91] Initial implementation of improved radar inv I/O for MRI-4dvar. modified: Registry/registry.var modified: var/build/depend.txt modified: var/da/da_minimisation/da_get_innov_vector.inc modified: var/da/da_minimisation/da_minimisation.f90 modified: var/da/da_obs_io/da_obs_io.f90 new file: var/da/da_obs_io/da_read_iv_for_multi_inc_opt2.inc new file: var/da/da_obs_io/da_write_iv_for_multi_inc_opt2.inc --- Registry/registry.var | 1 + var/build/depend.txt | 2 +- .../da_minimisation/da_get_innov_vector.inc | 14 +- var/da/da_minimisation/da_minimisation.f90 | 6 +- var/da/da_obs_io/da_obs_io.f90 | 4 +- .../da_read_iv_for_multi_inc_opt2.inc | 843 ++++++++++++++++ .../da_write_iv_for_multi_inc_opt2.inc | 902 ++++++++++++++++++ 7 files changed, 1765 insertions(+), 7 deletions(-) create mode 100644 var/da/da_obs_io/da_read_iv_for_multi_inc_opt2.inc create mode 100644 var/da/da_obs_io/da_write_iv_for_multi_inc_opt2.inc diff --git a/Registry/registry.var b/Registry/registry.var index e117c52962..407a5188db 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -87,6 +87,7 @@ rconfig integer var4d_bin namelist,wrfvar1 1 3600 - "va rconfig integer var4d_bin_rain namelist,wrfvar1 1 3600 - "var4d_bin_rain" "" "" rconfig logical var4d_lbc namelist,wrfvar1 1 .false. - "var4d_lbc" "" "" rconfig integer multi_inc namelist,wrfvar1 1 0 - "multi_incremental_flag" "" "" +rconfig integer multi_inc_io_opt namelist,wrfvar1 1 1 - "multi_incremental_io_opt" "1: original 2:new" "" rconfig logical print_detail_radar namelist,wrfvar1 1 .false. - "print_detail_radar" "" "" rconfig logical print_detail_rain namelist,wrfvar1 1 .false. - "print_detail_rain" "" "" rconfig logical print_detail_rad namelist,wrfvar1 1 .false. - "print_detail_rad" "" "" diff --git a/var/build/depend.txt b/var/build/depend.txt index 5e73dd12f8..c1f3cff656 100644 --- a/var/build/depend.txt +++ b/var/build/depend.txt @@ -131,7 +131,7 @@ da_module_couple_uv_ad.o : da_module_couple_uv_ad.f90 da_couple_ad.inc da_calc_m da_mtgirs.o : da_mtgirs.f90 da_calculate_grady_mtgirs.inc da_get_innov_vector_mtgirs.inc da_check_max_iv_mtgirs.inc da_transform_xtoy_mtgirs_adj.inc da_transform_xtoy_mtgirs.inc da_print_stats_mtgirs.inc da_oi_stats_mtgirs.inc da_residual_mtgirs.inc da_jo_mtgirs_uvtq.inc da_jo_and_grady_mtgirs.inc da_ao_stats_mtgirs.inc da_tracing.o da_physics.o da_grid_definitions.o da_par_util1.o da_par_util.o da_tools.o da_statistics.o da_interpolation.o module_domain.o da_define_structures.o da_control.o da_netcdf_interface.o : da_netcdf_interface.f90 da_atotime.inc da_get_bdytimestr_cdf.inc da_get_bdyfrq.inc da_put_att_cdf.inc da_get_att_cdf.inc da_put_var_2d_int_cdf.inc da_get_var_2d_int_cdf.inc da_put_var_2d_real_cdf.inc da_put_var_3d_real_cdf.inc da_get_var_2d_real_cdf.inc da_get_var_3d_real_cdf.inc da_get_gl_att_real_cdf.inc da_get_gl_att_int_cdf.inc da_get_dims_cdf.inc da_get_times_cdf.inc da_get_var_1d_real_cdf.inc da_obs.o : da_obs.f90 da_grid_definitions.o da_set_obs_missing.inc da_obs_sensitivity.inc da_count_filtered_obs.inc da_store_obs_grid_info_rad.inc da_store_obs_grid_info.inc da_random_omb_all.inc da_fill_obs_structures.inc da_fill_obs_structures_rain.inc da_fill_obs_structures_radar.inc da_check_missing.inc da_add_noise_to_ob.inc da_transform_xtoy_adj.inc da_transform_xtoy.inc da_obs_proc_station.inc module_dm.o da_tracing.o da_tools.o da_tools_serial.o da_synop.o da_ssmi.o da_tamdar.o da_mtgirs.o da_sound.o da_ships.o da_satem.o da_rttov.o da_reporting.o da_rain.o da_radar.o da_qscat.o da_pseudo.o da_profiler.o da_polaramv.o da_pilot.o da_physics.o da_metar.o da_gpsref.o da_gpspw.o da_geoamv.o da_crtm.o da_control.o da_buoy.o da_bogus.o da_airsr.o da_airep.o module_domain.o da_define_structures.o -da_obs_io.o : da_obs_io.f90 da_grid_definitions.o da_final_write_modified_filtered_obs.inc da_final_write_filtered_obs.inc da_write_noise_to_ob.inc da_read_omb_tmp.inc da_read_rand_unit.inc da_read_y_unit.inc da_final_write_y.inc da_final_write_obs.inc da_read_obs_bufrgpsro.inc da_read_obs_bufr.inc da_write_y.inc da_write_modified_filtered_obs.inc da_write_filtered_obs.inc da_write_obs_etkf.inc da_search_obs.inc da_read_iv_for_multi_inc.inc da_write_iv_for_multi_inc.inc da_write_obs.inc da_use_obs_errfac.inc da_read_errfac.inc da_read_obs_rain.inc da_scan_obs_rain.inc da_scan_obs_radar.inc da_read_obs_radar.inc da_scan_obs_ascii.inc da_read_obs_ascii.inc da_par_util.o gsi_thinning.o module_radiance.o da_tracing.o da_tools_serial.o da_tools.o da_reporting.o da_physics.o da_par_util1.o da_obs.o da_grid_definitions.o da_define_structures.o da_control.o module_domain.o da_read_lsac_util.inc da_read_obs_lsac.inc da_scan_obs_lsac.inc da_netcdf_interface.o +da_obs_io.o : da_obs_io.f90 da_grid_definitions.o da_final_write_modified_filtered_obs.inc da_final_write_filtered_obs.inc da_write_noise_to_ob.inc da_read_omb_tmp.inc da_read_rand_unit.inc da_read_y_unit.inc da_final_write_y.inc da_final_write_obs.inc da_read_obs_bufrgpsro.inc da_read_obs_bufr.inc da_write_y.inc da_write_modified_filtered_obs.inc da_write_filtered_obs.inc da_write_obs_etkf.inc da_search_obs.inc da_read_iv_for_multi_inc.inc da_write_iv_for_multi_inc.inc da_write_obs.inc da_use_obs_errfac.inc da_read_errfac.inc da_read_obs_rain.inc da_scan_obs_rain.inc da_scan_obs_radar.inc da_read_obs_radar.inc da_scan_obs_ascii.inc da_read_obs_ascii.inc da_par_util.o gsi_thinning.o module_radiance.o da_tracing.o da_tools_serial.o da_tools.o da_reporting.o da_physics.o da_par_util1.o da_obs.o da_grid_definitions.o da_define_structures.o da_control.o module_domain.o da_read_lsac_util.inc da_read_obs_lsac.inc da_scan_obs_lsac.inc da_netcdf_interface.o da_write_iv_for_multi_inc_opt2.inc da_read_iv_for_multi_inc_opt2.inc da_par_util.o : da_par_util.f90 da_proc_maxmin_combine.inc da_proc_stats_combine.inc da_system.inc da_y_facade_to_global.inc da_generic_boilerplate.inc da_deallocate_global_synop.inc da_deallocate_global_sound.inc da_deallocate_global_sonde_sfc.inc da_generic_methods.inc da_patch_to_global_3d.inc da_patch_to_global_dual_res.inc da_patch_to_global_2d.inc da_cv_to_global.inc da_transpose_y2x_v2.inc da_transpose_x2y_v2.inc da_transpose_z2y.inc da_transpose_y2z.inc da_transpose_x2z.inc da_transpose_z2x.inc da_transpose_y2x.inc da_transpose_x2y.inc da_unpack_count_obs.inc da_pack_count_obs.inc da_copy_tile_dims.inc da_copy_dims.inc da_alloc_and_copy_be_arrays.inc da_vv_to_cv.inc da_cv_to_vv.inc da_generic_typedefs.inc da_wrf_interfaces.o da_tracing.o da_reporting.o da_define_structures.o da_par_util1.o module_dm.o module_domain.o da_control.o da_par_util1.o : da_par_util1.f90 da_proc_sum_real.inc da_proc_sum_ints.inc da_proc_sum_int.inc da_control.o da_physics.o : da_physics.f90 da_uv_to_sd_lin.inc da_uv_to_sd_adj.inc da_integrat_dz.inc da_wdt.inc da_filter_adj.inc da_filter.inc da_evapo_lin.inc da_condens_lin.inc da_condens_adj.inc da_moist_phys_lin.inc da_moist_phys_adj.inc da_sfc_pre_adj.inc da_sfc_pre_lin.inc da_sfc_pre.inc da_transform_xtowtq_adj.inc da_transform_xtowtq.inc da_transform_xtopsfc_adj.inc da_transform_xtopsfc.inc da_sfc_wtq_adj.inc da_sfc_wtq_lin.inc da_sfc_wtq.inc da_julian_day.inc da_roughness_from_lanu.inc da_get_q_error.inc da_check_rh_simple.inc da_check_rh.inc da_transform_xtogpsref_lin.inc da_transform_xtogpsref_adj.inc da_transform_xtogpsref.inc da_transform_xtotpw_adj.inc da_transform_xtotpw.inc da_transform_xtoztd_adj.inc da_transform_xtoztd_lin.inc da_transform_xtoztd.inc da_tv_profile_tl.inc da_thickness_tl.inc da_find_layer_adj.inc da_thickness.inc da_tv_profile_adj.inc da_find_layer.inc da_thickness_adj.inc da_find_layer_tl.inc da_tv_profile.inc da_tpq_to_slp_adj.inc da_tpq_to_slp_lin.inc da_wrf_tpq_2_slp.inc da_tpq_to_slp.inc da_trh_to_td.inc da_tp_to_qs_lin1.inc da_tp_to_qs_lin.inc da_tp_to_qs_adj1.inc da_tp_to_qs_adj.inc da_tp_to_qs1.inc da_tp_to_qs.inc da_tprh_to_q_lin1.inc da_tprh_to_q_lin.inc da_tprh_to_q_adj1.inc da_tprh_to_q_adj.inc da_tpq_to_rh_lin1.inc da_tpq_to_rh_lin.inc da_tpq_to_rh.inc da_pt_to_rho_lin.inc da_pt_to_rho_adj.inc da_uvprho_to_w_adj.inc da_uvprho_to_w_lin.inc da_prho_to_t_lin.inc da_prho_to_t_adj.inc da_wrf_interfaces.o da_reporting.o da_dynamics.o da_interpolation.o da_tracing.o da_par_util.o da_define_structures.o da_control.o module_comm_dm.o module_dm.o module_domain.o da_grid_definitions.o diff --git a/var/da/da_minimisation/da_get_innov_vector.inc b/var/da/da_minimisation/da_get_innov_vector.inc index 4e90e6d894..a9ea915900 100644 --- a/var/da/da_minimisation/da_get_innov_vector.inc +++ b/var/da/da_minimisation/da_get_innov_vector.inc @@ -173,11 +173,19 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) if ( multi_inc == 1 ) then - call da_write_iv_for_multi_inc(n, iv) + if ( multi_inc_io_opt == 1 ) then + call da_write_iv_for_multi_inc(n, iv) + else if ( multi_inc_io_opt == 2 ) then + call da_write_iv_for_multi_inc_opt2(n, iv) + end if elseif ( multi_inc == 2 ) then - call da_read_iv_for_multi_inc(n, iv) + if ( multi_inc_io_opt == 1 ) then + call da_read_iv_for_multi_inc(n, iv) + else if ( multi_inc_io_opt == 2 ) then + call da_read_iv_for_multi_inc_opt2(n, iv) + end if endif @@ -219,7 +227,7 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) call domain_clockprint(150, grid, 'get CurrTime from clock,') end if - if ( multi_inc == 1 ) then + if ( multi_inc == 1 .and. multi_inc_io_opt == 1 ) then #ifdef DM_PARALLEL call mpi_barrier(MPI_COMM_WORLD,ierr) if ( myproc == 0 ) call da_join_iv_for_multi_inc() diff --git a/var/da/da_minimisation/da_minimisation.f90 b/var/da/da_minimisation/da_minimisation.f90 index 9b4dc3c843..efd7eb9bdc 100644 --- a/var/da/da_minimisation/da_minimisation.f90 +++ b/var/da/da_minimisation/da_minimisation.f90 @@ -54,7 +54,8 @@ module da_minimisation use_satcv, sensitivity_option, print_detail_outerloop, adj_sens, filename_len, & ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe, fgat_rain_flags, var4d_bin_rain, freeze_varbc, & use_wpec, wpec_factor, use_4denvar, anal_type_hybrid_dual_res, alphacv_method, alphacv_method_xa, & - write_detail_grad_fn, pseudo_uvtpq, lanczos_ep_filename, use_divc, divc_factor, use_radarobs + write_detail_grad_fn, pseudo_uvtpq, lanczos_ep_filename, use_divc, divc_factor, use_radarobs, & + multi_inc_io_opt use da_define_structures, only : iv_type, y_type, j_type, be_type, & xbx_type, jo_type, da_allocate_y,da_zero_x,da_zero_y,da_deallocate_y, & da_zero_vp_type, qhat_type @@ -73,7 +74,8 @@ module da_minimisation da_jo_and_grady_gpsref use da_obs_io, only : da_final_write_y, da_write_y, da_final_write_obs, & da_write_obs,da_write_obs_etkf,da_write_noise_to_ob, da_use_obs_errfac, & - da_write_iv_for_multi_inc, da_read_iv_for_multi_inc + da_write_iv_for_multi_inc, da_read_iv_for_multi_inc, & + da_write_iv_for_multi_inc_opt2, da_read_iv_for_multi_inc_opt2 use da_metar, only : da_calculate_grady_metar, da_ao_stats_metar, & da_oi_stats_metar, da_get_innov_vector_metar, da_residual_metar, & da_jo_and_grady_metar diff --git a/var/da/da_obs_io/da_obs_io.f90 b/var/da/da_obs_io/da_obs_io.f90 index e2c668eb2d..842151af95 100644 --- a/var/da/da_obs_io/da_obs_io.f90 +++ b/var/da/da_obs_io/da_obs_io.f90 @@ -31,7 +31,7 @@ module da_obs_io wind_sd_airep,wind_sd_sound,wind_sd_metar,wind_sd_ships,wind_sd_qscat,wind_sd_buoy,wind_sd_pilot,wind_stats_sd,& thin_conv, thin_conv_ascii, lsac_nh_step, lsac_nv_step, lsac_nv_start, lsac_print_details, & lsac_use_u, lsac_use_v, lsac_use_t, lsac_use_q, lsac_u_error, lsac_v_error, lsac_t_error, lsac_q_error, & - use_radar_rhv, use_radar_rqv + use_radar_rhv, use_radar_rqv, use_radar_rf, use_radar_rv use da_define_structures, only : iv_type, multi_level_type, multi_level_type_BUFR, & radar_multi_level_type, y_type, field_type, each_level_type, & @@ -79,7 +79,9 @@ module da_obs_io #include "da_use_obs_errfac.inc" #include "da_write_obs.inc" #include "da_write_iv_for_multi_inc.inc" +#include "da_write_iv_for_multi_inc_opt2.inc" #include "da_read_iv_for_multi_inc.inc" +#include "da_read_iv_for_multi_inc_opt2.inc" #include "da_search_obs.inc" #include "da_write_obs_etkf.inc" #include "da_write_filtered_obs.inc" diff --git a/var/da/da_obs_io/da_read_iv_for_multi_inc_opt2.inc b/var/da/da_obs_io/da_read_iv_for_multi_inc_opt2.inc new file mode 100644 index 0000000000..508088fe0f --- /dev/null +++ b/var/da/da_obs_io/da_read_iv_for_multi_inc_opt2.inc @@ -0,0 +1,843 @@ +subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) + + !----------------------------------------------------------------------- + ! Purpose: Read for Multi-incremental + !----------------------------------------------------------------------- + + !------------------------------------------------------------------------- + ! read iv=O-B structure written by WRFVAR + !------------------------------------------------------------------------- + + implicit none + + type (iv_type), intent(inout) :: iv ! O-B structure. + integer, intent(in) :: file_index + integer :: unit_in + character(len=filename_len) :: filename + + integer :: num_obs, ios + character*20 :: ob_type_string + + integer :: n, gn + logical :: found_flag + + integer :: nobs_tot, nlev_max, k , iobs + integer :: nobs_in, nlev_in + logical :: has_rv, has_rf, has_rhv, has_rqv + real, allocatable :: data2d(:,:) + real, allocatable :: data3d(:,:,:) + + if (trace_use) call da_trace_entry("da_read_iv_for_multi_inc_opt2") + + !------------------------------------------------------------------------- + ! Fix input unit + !------------------------------------------------------------------------- + + call da_get_unit(unit_in) + + write(unit=filename, fmt='(a,i3.3)') 'gts_omb.', file_index + + ! [1] surface obs: + + if (iv%info(synop)%plocal(iv%time)-iv%info(synop)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.synop',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'synop' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find synop marker. "/)) + gn = 0 + do n = iv%info(synop)%plocal(iv%time-1) + 1, & + iv%info(synop)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find synop obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(synop)%plocal(iv%time)-iv%info(synop)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [2] metar obs: + + if (iv%info(metar)%plocal(iv%time)-iv%info(metar)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.metar',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'metar' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find metar marker. "/)) + gn = 0 + do n = iv%info(metar)%plocal(iv%time-1) + 1, & + iv%info(metar)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find metar obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(metar)%plocal(iv%time)-iv%info(metar)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [3] ships obs: + + if (iv%info(ships)%plocal(iv%time)-iv%info(ships)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.ships',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'ships' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find ships marker. "/)) + gn = 0 + do n = iv%info(ships)%plocal(iv%time-1) + 1, & + iv%info(ships)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find ships obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(ships)%plocal(iv%time)-iv%info(ships)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [4] sonde_sfc obs: + + if (iv%info(sonde_sfc)%plocal(iv%time)-iv%info(sonde_sfc)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.sonde_sfc',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'sonde_sfc' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find sonde_sfc marker. "/)) + gn = 0 + do n = iv%info(sonde_sfc)%plocal(iv%time-1) + 1, & + iv%info(sonde_sfc)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find sonde_sfc obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(sonde_sfc)%plocal(iv%time)-iv%info(sonde_sfc)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [5] sound obs: + + if (iv%info(sound)%plocal(iv%time)-iv%info(sound)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.sound',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'sound' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find sound marker. "/)) + gn = 0 + do n = iv%info(sound)%plocal(iv%time-1) + 1, & + iv%info(sound)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find sound obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(sound)%plocal(iv%time)-iv%info(sound)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [6] mtgirs obs: + + if (iv%info(mtgirs)%plocal(iv%time)-iv%info(mtgirs)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.mtgirs',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'mtgirs' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find mtgirs marker. "/)) + gn = 0 + do n = iv%info(mtgirs)%plocal(iv%time-1) + 1, & + iv%info(mtgirs)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find mtgirs obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(mtgirs)%plocal(iv%time)-iv%info(mtgirs)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [7] tamdar obs: + + if (iv%info(tamdar)%plocal(iv%time)-iv%info(tamdar)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.tamdar',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'tamdar' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find tamdar marker. "/)) + gn = 0 + do n = iv%info(tamdar)%plocal(iv%time-1) + 1, & + iv%info(tamdar)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find tamdar obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(tamdar)%plocal(iv%time)-iv%info(tamdar)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [8] tamdar_sfc obs: + + if (iv%info(tamdar_sfc)%plocal(iv%time)-iv%info(tamdar_sfc)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.tamdar_sfc',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'tamdar_sfc' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find tamdar_sfc marker. "/)) + gn = 0 + do n = iv%info(tamdar_sfc)%plocal(iv%time-1) + 1, & + iv%info(tamdar_sfc)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find tamdar_sfc obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(tamdar_sfc)%plocal(iv%time)-iv%info(tamdar_sfc)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [9] buoy obs: + + if (iv%info(buoy)%plocal(iv%time)-iv%info(buoy)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.buoy',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'buoy' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find buoy marker. "/)) + gn = 0 + do n = iv%info(buoy)%plocal(iv%time-1) + 1, & + iv%info(buoy)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find buoy obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(buoy)%plocal(iv%time)-iv%info(buoy)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [10] Geo AMV obs: + + if (iv%info(geoamv)%plocal(iv%time)-iv%info(geoamv)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.geoamv',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'geoamv' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find geoamv marker. "/)) + gn = 0 + do n = iv%info(geoamv)%plocal(iv%time-1) + 1, & + iv%info(geoamv)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find geoamv obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(geoamv)%plocal(iv%time)-iv%info(geoamv)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [11] gpspw obs: + + if (iv%info(gpspw)%plocal(iv%time)-iv%info(gpspw)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.gpspw',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'gpspw' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find gpspw marker. "/)) + gn = 0 + do n = iv%info(gpspw)%plocal(iv%time-1) + 1, & + iv%info(gpspw)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find gpspw obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(gpspw)%plocal(iv%time)-iv%info(gpspw)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [12] SSM/I obs: + + if (iv%info(ssmi_rv)%plocal(iv%time)-iv%info(ssmi_rv)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.ssmir',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'ssmir' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find ssmir marker. "/)) + gn = 0 + do n = iv%info(ssmi_rv)%plocal(iv%time-1) + 1, & + iv%info(ssmi_rv)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find ssmir obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(ssmi_rv)%plocal(iv%time)-iv%info(ssmi_rv)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [13] airep obs: + + if (iv%info(airep)%plocal(iv%time)-iv%info(airep)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.airep',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'airep' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find airep marker. "/)) + gn = 0 + do n = iv%info(airep)%plocal(iv%time-1) + 1, & + iv%info(airep)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find airep obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(airep)%plocal(iv%time)-iv%info(airep)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [14] polaramv obs: + + if (iv%info(polaramv)%plocal(iv%time)-iv%info(polaramv)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.polaramv',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'polaramv' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find polaramv marker. "/)) + gn = 0 + do n = iv%info(polaramv)%plocal(iv%time-1) + 1, & + iv%info(polaramv)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find polaramv obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(polaramv)%plocal(iv%time)-iv%info(polaramv)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [15] pilot obs: + + if (iv%info(pilot)%plocal(iv%time)-iv%info(pilot)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.pilot',form='formatted',status='old',iostat=ios) + + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'pilot' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find pilot marker. "/)) + gn = 0 + do n = iv%info(pilot)%plocal(iv%time-1) + 1, & + iv%info(pilot)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find pilot obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(pilot)%plocal(iv%time)-iv%info(pilot)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [16] ssmi_tb obs: + + if (iv%info(ssmi_tb)%plocal(iv%time)-iv%info(ssmi_tb)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.ssmi_tb',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'ssmi_tb' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find ssmi_tb marker. "/)) + gn = 0 + do n = iv%info(ssmi_tb)%plocal(iv%time-1) + 1, & + iv%info(ssmi_tb)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find ssmi_tb obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(ssmi_tb)%plocal(iv%time)-iv%info(ssmi_tb)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [17] satem obs: + + if (iv%info(satem)%plocal(iv%time)-iv%info(satem)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.satem',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'satem' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find satem marker. "/)) + gn = 0 + do n = iv%info(satem)%plocal(iv%time-1) + 1, & + iv%info(satem)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find satem obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(satem)%plocal(iv%time)-iv%info(satem)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [18] ssmt1 obs: + + if (iv%info(ssmt1)%plocal(iv%time)-iv%info(ssmt1)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.ssmt1',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'ssmt1' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find ssmt1 marker. "/)) + gn = 0 + do n = iv%info(ssmt1)%plocal(iv%time-1) + 1, & + iv%info(ssmt1)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find ssmt1 obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(ssmt1)%plocal(iv%time)-iv%info(ssmt1)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [19] ssmt2 obs: + + if (iv%info(ssmt2)%plocal(iv%time)-iv%info(ssmt2)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.ssmt2',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'ssmt2' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find ssmt2 marker. "/)) + gn = 0 + do n = iv%info(ssmt2)%plocal(iv%time-1) + 1, & + iv%info(ssmt2)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find ssmt2 obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(ssmt2)%plocal(iv%time)-iv%info(ssmt2)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [20] scatterometer obs: + + if (iv%info(qscat)%plocal(iv%time)-iv%info(qscat)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.qscat',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'qscat' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find qscat marker. "/)) + gn = 0 + do n = iv%info(qscat)%plocal(iv%time-1) + 1, & + iv%info(qscat)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find qscat obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(qscat)%plocal(iv%time)-iv%info(qscat)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [21] profiler obs: + + if (iv%info(profiler)%plocal(iv%time)-iv%info(profiler)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.profiler',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'profiler' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find profiler marker. "/)) + gn = 0 + do n = iv%info(profiler)%plocal(iv%time-1) + 1, & + iv%info(profiler)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find profiler obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(profiler)%plocal(iv%time)-iv%info(profiler)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [22] TC bogus obs: + + if (iv%info(bogus)%plocal(iv%time)-iv%info(bogus)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.bogus',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'bogus' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find bogus marker. "/)) + gn = 0 + do n = iv%info(bogus)%plocal(iv%time-1) + 1, & + iv%info(bogus)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find bogus obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(bogus)%plocal(iv%time)-iv%info(bogus)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [23] AIRS retrievals: + + if (iv%info(airsr)%plocal(iv%time)-iv%info(airsr)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.airsr',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'airsr' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find airsr marker. "/)) + gn = 0 + do n = iv%info(airsr)%plocal(iv%time-1) + 1, & + iv%info(airsr)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find airsr obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(airsr)%plocal(iv%time)-iv%info(airsr)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [24] gpsref obs: + + if (iv%info(gpsref)%plocal(iv%time)-iv%info(gpsref)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.gpsref',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'gpsref' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find gpsref marker. "/)) + gn = 0 + do n = iv%info(gpsref)%plocal(iv%time-1) + 1, & + iv%info(gpsref)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find gpsref obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(gpsref)%plocal(iv%time)-iv%info(gpsref)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + + ! [25] radar obs: + + nobs_tot = iv%info(radar)%ptotal(num_fgat_time) - iv%info(radar)%ptotal(0) + nlev_max = iv%info(radar)%max_lev + + if ( nobs_tot > 0 ) then + + write(unit=filename, fmt='(a,i3.3)') 'radar_innov_t', file_index + open(unit=unit_in,file=trim(filename),form='unformatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file "//trim(filename)/)) + end if + + read(unit_in) nobs_in, nlev_in, has_rv, has_rf, has_rhv, has_rqv + if ( nobs_in /= nobs_tot .or. nlev_in /= nlev_max ) then + call da_error(__FILE__,__LINE__, & + (/"Dimensions (nobs_tot or nlev_max) mismatch "/)) + end if + allocate ( data2d(nobs_tot, 2) ) + read(unit_in) data2d + do n = iv%info(radar)%n1, iv%info(radar)%n2 + iobs = iv%info(radar)%obs_global_index(n) +! iv%info(radar)%lat(1,n) = data2d(iobs, 1) +! iv%info(radar)%lon(1,n) = data2d(iobs, 2) + end do + deallocate ( data2d ) + + if ( use_radar_rv .and. has_rv ) then + allocate( data3d(nobs_tot, nlev_max, 3) ) + read(unit_in) data3d + do n = iv%info(radar)%n1, iv%info(radar)%n2 + iobs = iv%info(radar)%obs_global_index(n) + do k = 1 , iv%info(radar)%levels(n) + iv%radar(n)%rv(k)%inv = data3d(iobs, k, 1) + iv%radar(n)%rv(k)%qc = int(data3d(iobs, k, 2)) + iv%radar(n)%rv(k)%error = data3d(iobs, k, 3) + end do + end do + deallocate( data3d ) + end if + + if ( use_radar_rf .and. has_rf ) then + allocate( data3d(nobs_tot, nlev_max, 3) ) + read(unit_in) data3d + do n = iv%info(radar)%n1, iv%info(radar)%n2 + iobs = iv%info(radar)%obs_global_index(n) + do k = 1 , iv%info(radar)%levels(n) + iv%radar(n)%rf(k)%inv = data3d(iobs, k, 1) + iv%radar(n)%rf(k)%qc = int(data3d(iobs, k, 2)) + iv%radar(n)%rf(k)%error = data3d(iobs, k, 3) + end do + end do + deallocate( data3d ) + end if + + if ( use_radar_rhv .and. has_rhv ) then + allocate( data3d(nobs_tot, nlev_max, 9) ) + read(unit_in) data3d + do n = iv%info(radar)%n1, iv%info(radar)%n2 + iobs = iv%info(radar)%obs_global_index(n) + do k = 1 , iv%info(radar)%levels(n) + iv%radar(n)%rrn(k)%inv = data3d(iobs, k, 1) + iv%radar(n)%rrn(k)%qc = int(data3d(iobs, k, 2)) + iv%radar(n)%rrn(k)%error = data3d(iobs, k, 3) + iv%radar(n)%rsn(k)%inv = data3d(iobs, k, 4) + iv%radar(n)%rsn(k)%qc = int(data3d(iobs, k, 5)) + iv%radar(n)%rsn(k)%error = data3d(iobs, k, 6) + iv%radar(n)%rgr(k)%inv = data3d(iobs, k, 7) + iv%radar(n)%rgr(k)%qc = int(data3d(iobs, k, 8)) + iv%radar(n)%rgr(k)%error = data3d(iobs, k, 9) + end do + end do + deallocate( data3d ) + end if + + if ( use_radar_rqv .and. has_rqv ) then + allocate( data3d(nobs_tot, nlev_max, 3) ) + read(unit_in) data3d + do n = iv%info(radar)%n1, iv%info(radar)%n2 + iobs = iv%info(radar)%obs_global_index(n) + do k = 1 , iv%info(radar)%levels(n) + iv%radar(n)%rqv(k)%inv = data3d(iobs, k, 1) + iv%radar(n)%rqv(k)%qc = int(data3d(iobs, k, 2)) + iv%radar(n)%rqv(k)%error = data3d(iobs, k, 3) + end do + end do + deallocate( data3d ) + end if + + close (unit_in) + end if ! nobs_tot > 0 + +999 continue + close (unit_in) + call da_free_unit(unit_in) + + if (trace_use) call da_trace_exit("da_read_iv_for_multi_inc_opt2") + return + +1000 continue + write(unit=message(1), fmt='(a,i3)') & + 'read error on unit: ',unit_in + call da_warning(__FILE__,__LINE__,message(1:1)) + +end subroutine da_read_iv_for_multi_inc_opt2 diff --git a/var/da/da_obs_io/da_write_iv_for_multi_inc_opt2.inc b/var/da/da_obs_io/da_write_iv_for_multi_inc_opt2.inc new file mode 100644 index 0000000000..76afc8411e --- /dev/null +++ b/var/da/da_obs_io/da_write_iv_for_multi_inc_opt2.inc @@ -0,0 +1,902 @@ +subroutine da_write_iv_for_multi_inc_opt2(file_index, iv) + + !------------------------------------------------------------------------- + ! Purpose: Writes out components of iv=O-B structure. + !------------------------------------------------------------------------- + + implicit none + + type (iv_type), intent(in) :: iv ! O-B structure. + integer, intent (in) :: file_index + + integer :: n, k, ios + integer :: ounit ! Output unit + character(len=filename_len) :: filename + + integer :: nobs_tot, nlev_max, iobs + real, allocatable :: data2d(:,:) + real, allocatable :: data3d(:,:,:) + real, allocatable :: data2d_g(:,:) + real, allocatable :: data3d_g(:,:,:) + + if (trace_use) call da_trace_entry("da_write_iv_for_multi_inc_opt2") + + !------------------------------------------------------------------------- + ! Fix output unit + !------------------------------------------------------------------------- + + call da_get_unit(ounit) +#ifdef DM_PARALLEL + write(unit=filename, fmt='(a,i3.3,a,i4.4)') 'stub.', file_index, '.', myproc +#else + write(unit=filename, fmt='(a,i3.3)') 'gts_omb.', file_index +#endif + ! [1] surface obs: + + if (iv%info(synop)%plocal(iv%time) - iv%info(synop)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.synop',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'synop',iv%info(synop)%plocal(iv%time) - & + iv%info(synop)%plocal(iv%time-1) + do n = iv%info(synop)%plocal(iv%time-1) + 1, & + iv%info(synop)%plocal(iv%time) + write(ounit,'(i8,a5,2E22.13)')& + n , iv%info(synop)%id(n), & ! Station + iv%info(synop)%lat(1,n), & ! Latitude + iv%info(synop)%lon(1,n) ! Longitude + write(ounit,'(E22.13,5(E22.13,i8,3E22.13))')& + iv%synop(n)%h, & + iv%synop(n)%u, &! O-B u + iv%synop(n)%v, &! O-B v + iv%synop(n)%t, &! O-B t + iv%synop(n)%p, &! O-B p + iv%synop(n)%q ! O-B q + end do + close (ounit) + end if + + ! [2] metar obs: + + if (iv%info(metar)%plocal(iv%time) - iv%info(metar)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.metar',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'metar', iv%info(metar)%plocal(iv%time) - & + iv%info(metar)%plocal(iv%time-1) + do n = iv%info(metar)%plocal(iv%time-1) + 1, & + iv%info(metar)%plocal(iv%time) + write(ounit,'(i8,a5,2E22.13)')& + n, iv%info(metar)%id(n), & ! Station + iv%info(metar)%lat(1,n), & ! Latitude + iv%info(metar)%lon(1,n) ! Longitude + write(ounit,'(E22.13,5(E22.13,i8,3E22.13))')& + iv%metar(n)%h, & + iv%metar(n)%u, &! O-B u + iv%metar(n)%v, &! O-B v + iv%metar(n)%t, &! O-B t + iv%metar(n)%p, &! O-B p + iv%metar(n)%q ! O-B q + end do + close (ounit) + end if + + ! [3] ships obs: + + if (iv%info(ships)%plocal(iv%time) - iv%info(ships)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.ships',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'ships', iv%info(ships)%plocal(iv%time) - & + iv%info(ships)%plocal(iv%time-1) + do n = iv%info(ships)%plocal(iv%time-1) + 1, & + iv%info(ships)%plocal(iv%time) + write(ounit,'(i8,a5,2E22.13)')& + n, iv%info(ships)%id(n), & ! Station + iv%info(ships)%lat(1,n), & ! Latitude + iv%info(ships)%lon(1,n) ! Longitude + write(ounit,'(E22.13,5(E22.13,i8,3E22.13))')& + iv%ships(n)%h, & + iv%ships(n)%u, &! O-B u + iv%ships(n)%v, &! O-B v + iv%ships(n)%t, &! O-B t + iv%ships(n)%p, &! O-B p + iv%ships(n)%q ! O-B q + end do + close (ounit) + end if + + ! [4] sonde_sfc obs: + + if (iv%info(sonde_sfc)%plocal(iv%time) - iv%info(sonde_sfc)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.sonde_sfc',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'sonde_sfc', iv%info(sonde_sfc)%plocal(iv%time) - & + iv%info(sonde_sfc)%plocal(iv%time-1) + do n = iv%info(sonde_sfc)%plocal(iv%time-1) + 1, & + iv%info(sonde_sfc)%plocal(iv%time) + write(ounit,'(i8,a5,2E22.13)')& + n, iv%info(sonde_sfc)%id(n), & ! Station + iv%info(sonde_sfc)%lat(1,n), & ! Latitude + iv%info(sonde_sfc)%lon(1,n) ! Longitude + write(ounit,'(E22.13,5(E22.13,i8,3E22.13))')& + iv%sonde_sfc(n)%h, & + iv%sonde_sfc(n)%u, &! O-B u + iv%sonde_sfc(n)%v, &! O-B v + iv%sonde_sfc(n)%t, &! O-B t + iv%sonde_sfc(n)%p, &! O-B p + iv%sonde_sfc(n)%q ! O-B q + end do + close (ounit) + end if + + ! [5] sound obs: + + if (iv%info(sound)%plocal(iv%time) - iv%info(sound)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.sound',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'sound', iv%info(sound)%plocal(iv%time) - & + iv%info(sound)%plocal(iv%time-1) + do n = iv%info(sound)%plocal(iv%time-1) + 1, & + iv%info(sound)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(sound)%levels(n), iv%info(sound)%id(n), & ! Station + iv%info(sound)%lat(1,n), & ! Latitude + iv%info(sound)%lon(1,n) ! Longitude + do k = 1 , iv%info(sound)%levels(n) + write(ounit,'(2E22.13,4(E22.13,i8,3E22.13))')& + iv%sound(n)%h(k), & + iv%sound(n)%p(k), & ! Obs Pressure + iv%sound(n)%u(k), &! O-B u + iv%sound(n)%v(k), &! O-B v + iv%sound(n)%t(k), &! O-B t + iv%sound(n)%q(k) ! O-B q + enddo + end do + close (ounit) + end if + + ! [6] mtgirs obs: + + if (iv%info(mtgirs)%plocal(iv%time) - iv%info(mtgirs)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.mtgirs',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'mtgirs', iv%info(mtgirs)%plocal(iv%time) - & + iv%info(mtgirs)%plocal(iv%time-1) + do n = iv%info(mtgirs)%plocal(iv%time-1) + 1, & + iv%info(mtgirs)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(mtgirs)%levels(n), iv%info(mtgirs)%id(n), & ! Station + iv%info(mtgirs)%lat(1,n), & ! Latitude + iv%info(mtgirs)%lon(1,n) ! Longitude + do k = 1 , iv%info(mtgirs)%levels(n) + write(ounit,'(2E22.13,4(E22.13,i8,3E22.13))')& + iv % mtgirs(n) % h(k), & + iv % mtgirs(n) % p(k), & ! Obs Pressure + iv%mtgirs(n)%u(k), &! O-B u + iv%mtgirs(n)%v(k), &! O-B v + iv%mtgirs(n)%t(k), &! O-B t + iv%mtgirs(n)%q(k) ! O-B q + + enddo + end do + close (ounit) + end if + + ! [7] tamdar + + if (iv%info(tamdar)%plocal(iv%time) - iv%info(tamdar)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.tamdar',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'tamdar', iv%info(tamdar)%plocal(iv%time) - & + iv%info(tamdar)%plocal(iv%time-1) + do n = iv%info(tamdar)%plocal(iv%time-1) + 1, & + iv%info(tamdar)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(tamdar)%levels(n), iv%info(tamdar)%id(n), & ! Station + iv%info(tamdar)%lat(1,n), & ! Latitude + iv%info(tamdar)%lon(1,n) ! Longitude + do k = 1 , iv%info(tamdar)%levels(n) + write(ounit,'(2E22.13,4(E22.13,i8,3E22.13))')& + iv%tamdar(n)%h(k), & + iv%tamdar(n)%p(k), & ! Obs Pressure + iv%tamdar(n)%u(k), &! O-B u + iv%tamdar(n)%v(k), &! O-B v + iv%tamdar(n)%t(k), &! O-B t + iv%tamdar(n)%q(k) ! O-B q + enddo + end do + close (ounit) + end if + + ! [8] tamdar_sfc + + if (iv%info(tamdar_sfc)%plocal(iv%time) - iv%info(tamdar_sfc)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.tamdar_sfc',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'tamdar_sfc', iv%info(tamdar_sfc)%plocal(iv%time) - & + iv%info(tamdar_sfc)%plocal(iv%time-1) + do n = iv%info(tamdar_sfc)%plocal(iv%time-1) + 1, & + iv%info(tamdar_sfc)%plocal(iv%time) + write(ounit,'(i8,a5,2E22.13)')& + n, iv%info(tamdar_sfc)%id(n), & ! Station + iv%info(tamdar_sfc)%lat(1,n), & ! Latitude + iv%info(tamdar_sfc)%lon(1,n) ! Longitude + write(ounit,'(E22.13,5(E22.13,i8,3E22.13))')& + iv%tamdar_sfc(n)%h, & + iv%tamdar_sfc(n)%u, &! O-B u + iv%tamdar_sfc(n)%v, &! O-B v + iv%tamdar_sfc(n)%t, &! O-B t + iv%tamdar_sfc(n)%p, &! O-B p + iv%tamdar_sfc(n)%q ! O-B q + end do + close (ounit) + end if + + ! [9] buoy obs: + + if (iv%info(buoy)%plocal(iv%time) - iv%info(buoy)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.buoy',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'buoy', iv%info(buoy)%plocal(iv%time) - & + iv%info(buoy)%plocal(iv%time-1) + do n = iv%info(buoy)%plocal(iv%time-1) + 1, & + iv%info(buoy)%plocal(iv%time) + write(ounit,'(i8,a5,2E22.13)')& + n, iv%info(buoy)%id(n), & ! Station + iv%info(buoy)%lat(1,n), & ! Latitude + iv%info(buoy)%lon(1,n) ! Longitude + write(ounit,'(E22.13,5(E22.13,i8,3E22.13))')& + iv%buoy(n)%h, & + iv%buoy(n)%u, &! O-B u + iv%buoy(n)%v, &! O-B v + iv%buoy(n)%t, &! O-B t + iv%buoy(n)%p, &! O-B p + iv%buoy(n)%q ! O-B q + end do + close (ounit) + end if + + ! [10] Geo AMVs obs: + + if (iv%info(geoamv)%plocal(iv%time) - iv%info(geoamv)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.geoamv',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'geoamv', iv%info(geoamv)%plocal(iv%time) - & + iv%info(geoamv)%plocal(iv%time-1) + do n = iv%info(geoamv)%plocal(iv%time-1) + 1, & + iv%info(geoamv)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(geoamv)%levels(n), iv%info(geoamv)%id(n), & ! Station + iv%info(geoamv)%lat(1,n), & ! Latitude + iv%info(geoamv)%lon(1,n) ! Longitude + do k = 1 , iv%info(geoamv)%levels(n) + write(ounit,'(E22.13,2(E22.13,i8,3E22.13))')& + iv%geoamv(n)%p(k), & ! Obs Pressure + iv%geoamv(n)%u(k), &! O-B u + iv%geoamv(n)%v(k) + enddo + end do + close (ounit) + end if + + ! [11] gpspw obs: + + if (iv%info(gpspw)%plocal(iv%time) - iv%info(gpspw)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.gpspw',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'gpspw', iv%info(gpspw)%plocal(iv%time) - & + iv%info(gpspw)%plocal(iv%time-1) + do n = iv%info(gpspw)%plocal(iv%time-1) + 1, & + iv%info(gpspw)%plocal(iv%time) + write(ounit,'(i8,a5,2E22.13)')& + n, iv%info(gpspw)%id(n), & ! Station + iv%info(gpspw)%lat(1,n), & ! Latitude + iv%info(gpspw)%lon(1,n) ! Longitude + write(ounit,'(E22.13,i8,3E22.13)')& + iv%gpspw(n)%tpw + end do + close (ounit) + end if + + ! [12] SSM/I obs: + + if (iv%info(ssmi_rv)%plocal(iv%time) - iv%info(ssmi_rv)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.ssmir',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'ssmir', iv%info(ssmi_rv)%plocal(iv%time) - & + iv%info(ssmi_rv)%plocal(iv%time-1) + do n = iv%info(ssmi_rv)%plocal(iv%time-1) + 1, & + iv%info(ssmi_rv)%plocal(iv%time) + write(ounit,'(i8,2E22.13)')& + n, & ! Station + iv%info(ssmi_rv)%lat(1,n), & ! Latitude + iv%info(ssmi_rv)%lon(1,n) ! Longitude + write(ounit,'(2(E22.13,i8,3E22.13))')& + iv%ssmi_rv(n)%speed, & ! O-B speed + iv%ssmi_rv(n)%tpw ! O-BA tpw + end do + close (ounit) + end if + + ! [13] airep obs: + + if (iv%info(airep)%plocal(iv%time) - iv%info(airep)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.airep',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'airep', iv%info(airep)%plocal(iv%time) - & + iv%info(airep)%plocal(iv%time-1) + do n = iv%info(airep)%plocal(iv%time-1) + 1, & + iv%info(airep)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(airep)%levels(n), iv%info(airep)%id(n), & ! Station + iv%info(airep)%lat(1,n), & ! Latitude + iv%info(airep)%lon(1,n) ! Longitude + do k = 1 , iv%info(airep)%levels(n) + write(ounit,'(2E22.13,4(E22.13,i8,3E22.13))')& + iv%airep(n)%h(k), & + iv%airep(n)%p(k), & ! Obs pressure + iv%airep(n)%u(k), &! O-B u + iv%airep(n)%v(k), &! O-B v + iv%airep(n)%t(k), & + iv%airep(n)%q(k) + enddo + end do + close (ounit) + end if + + ! [14] Polar AMVs obs: + + if (iv%info(polaramv)%plocal(iv%time) - iv%info(polaramv)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.polaramv',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'polaramv', iv%info(polaramv)%plocal(iv%time) - & + iv%info(polaramv)%plocal(iv%time-1) + do n = iv%info(polaramv)%plocal(iv%time-1) + 1, & + iv%info(polaramv)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(polaramv)%levels(n), iv%info(polaramv)%id(n), & ! Station + iv%info(polaramv)%lat(1,n), & ! Latitude + iv%info(polaramv)%lon(1,n) ! Longitude + do k = 1 , iv%info(polaramv)%levels(n) + write(ounit,'(E22.13,2(E22.13,i8,3E22.13))')& + iv%polaramv(n)%p(k), & ! Obs Pressure + iv%polaramv(n)%u(k), &! O-B u + iv%polaramv(n)%v(k) + enddo + end do + close (ounit) + end if + + ! [15] pilot obs: + + if (iv%info(pilot)%plocal(iv%time) - iv%info(pilot)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.pilot',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'pilot', iv%info(pilot)%plocal(iv%time) - & + iv%info(pilot)%plocal(iv%time-1) + do n = iv%info(pilot)%plocal(iv%time-1) + 1, & + iv%info(pilot)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(pilot)%levels(n), iv%info(pilot)%id(n), & ! Station + iv%info(pilot)%lat(1,n), & ! Latitude + iv%info(pilot)%lon(1,n) ! Longitude + do k = 1 , iv%info(pilot)%levels(n) + write(ounit,'(E22.13,2(E22.13,i8,3E22.13))')& + iv%pilot(n)%p(k), & ! Obs Pressure + iv%pilot(n)%u(k), &! O-B u + iv%pilot(n)%v(k) + enddo + end do + close (ounit) + end if + + ! [16] ssmi_tb obs: + + if (iv%info(ssmi_tb)%plocal(iv%time) - iv%info(ssmi_tb)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.ssmi_tb',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'ssmi_tb', iv%info(ssmi_tb)%plocal(iv%time) - & + iv%info(ssmi_tb)%plocal(iv%time-1) + do n = iv%info(ssmi_tb)%plocal(iv%time-1) + 1, & + iv%info(ssmi_tb)%plocal(iv%time) + write(ounit,'(i8,2E22.13)')& + n, & ! Station + iv%info(ssmi_tb)%lat(1,n), & ! Latitude + iv%info(ssmi_tb)%lon(1,n) ! Longitude + write(ounit,'(7(E22.13,i8,3E22.13))')& + iv%ssmi_tb(n)%tb19h, & ! O-B Tb19h + iv%ssmi_tb(n)%tb19v, & ! O-B Tb19v + iv%ssmi_tb(n)%tb22v, & ! O-B Tb22v + iv%ssmi_tb(n)%tb37h, & ! O-B Tb37h + iv%ssmi_tb(n)%tb37v, & ! O-B Tb37v + iv%ssmi_tb(n)%tb85h, & ! O-B Tb85h + iv%ssmi_tb(n)%tb85v ! O-B Tb85v + end do + close (ounit) + end if + + ! [17] satem obs: + + if (iv%info(satem)%plocal(iv%time) - iv%info(satem)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.satem',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'satem', iv%info(satem)%plocal(iv%time) - & + iv%info(satem)%plocal(iv%time-1) + do n = iv%info(satem)%plocal(iv%time-1) + 1, & + iv%info(satem)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(satem)%levels(n), iv%info(satem)%id(n), & ! Station + iv%info(satem)%lat(1,n), & ! Latitude + iv%info(satem)%lon(1,n) ! Longitude + do k = 1 , iv%info(satem)%levels(n) + write(ounit,'(E22.13,(E22.13,i8,3E22.13))')& + iv%satem(n)%p(k), & ! Obs Pressure + iv%satem(n)%thickness(k) + enddo + end do + close (ounit) + end if + + ! [18] ssmt1 obs: + + if (iv%info(ssmt1)%plocal(iv%time) - iv%info(ssmt1)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.ssmt1',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'ssmt1', iv%info(ssmt1)%plocal(iv%time) - & + iv%info(ssmt1)%plocal(iv%time-1) + do n = iv%info(ssmt1)%plocal(iv%time-1) + 1, & + iv%info(ssmt1)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(ssmt1)%levels(n), iv%info(ssmt1)%id(n), & ! Station + iv%info(ssmt1)%lat(1,n), & ! Latitude + iv%info(ssmt1)%lon(1,n) ! Longitude + do k = 1 , iv%info(ssmt1)%levels(n) + write(ounit,'(E22.13,(E22.13,i8,3E22.13))')& + iv%ssmt1(n)%h(k), & ! Obs height + iv%ssmt1(n)%t(k) + enddo + end do + close (ounit) + end if + + ! [19] ssmt2 obs: + + if (iv%info(ssmt2)%plocal(iv%time) - iv%info(ssmt2)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.ssmt2',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'ssmt2', iv%info(ssmt2)%plocal(iv%time) - & + iv%info(ssmt2)%plocal(iv%time-1) + do n = iv%info(ssmt2)%plocal(iv%time-1) + 1, & + iv%info(ssmt2)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(ssmt2)%levels(n), iv%info(ssmt2)%id(n), & ! Station + iv%info(ssmt2)%lat(1,n), & ! Latitude + iv%info(ssmt2)%lon(1,n) ! Longitude + do k = 1 , iv%info(ssmt2)%levels(n) + write(ounit,'(E22.13,(E22.13,i8,3E22.13))')& + iv%ssmt2(n)%h(k), & ! Obs height + iv%ssmt2(n)%rh(k) + enddo + end do + close (ounit) + end if + + ! [20] scatterometer obs: + + if (iv%info(qscat)%plocal(iv%time) - iv%info(qscat)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.qscat',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'qscat', iv%info(qscat)%plocal(iv%time) - & + iv%info(qscat)%plocal(iv%time-1) + do n = iv%info(qscat)%plocal(iv%time-1) + 1, & + iv%info(qscat)%plocal(iv%time) + write(ounit,'(i8,a5,2E22.13)')& + n, iv%info(qscat)%id(n), & ! Station + iv%info(qscat)%lat(1,n), & ! Latitude + iv%info(qscat)%lon(1,n) ! Longitude + write(ounit,'(E22.13,2(E22.13,i8,3E22.13))')& + iv%qscat(n)%h, & ! Obs height + iv%qscat(n)%u, &! O-B u + iv%qscat(n)%v ! O-B v + end do + close (ounit) + end if + + ! [21] profiler obs: + + if (iv%info(profiler)%plocal(iv%time) - iv%info(profiler)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.profiler',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'profiler', iv%info(profiler)%plocal(iv%time) - & + iv%info(profiler)%plocal(iv%time-1) + do n = iv%info(profiler)%plocal(iv%time-1) + 1, & + iv%info(profiler)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(profiler)%levels(n), iv%info(profiler)%id(n), & ! Station + iv%info(profiler)%lat(1,n), & ! Latitude + iv%info(profiler)%lon(1,n) ! Longitude + do k = 1 , iv%info(profiler)%levels(n) + write(ounit,'(E22.13,2(E22.13,i8,3E22.13))')& + iv%profiler(n)%p(k), & ! Obs Pressure + iv%profiler(n)%u(k), &! O-B u + iv%profiler(n)%v(k) ! O-B v + enddo + end do + close (ounit) + end if + + ! [22] TC bogus obs: + + if (iv%info(bogus)%plocal(iv%time) - iv%info(bogus)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.bogus',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'bogus', iv%info(bogus)%plocal(iv%time) - & + iv%info(bogus)%plocal(iv%time-1) + do n = iv%info(bogus)%plocal(iv%time-1) + 1, & + iv%info(bogus)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(bogus)%levels(n), iv%info(bogus)%id(n), & ! Station + iv%info(bogus)%lat(1,n), & ! Latitude + iv%info(bogus)%lon(1,n) ! Longitude + write(ounit,'(E22.13,i8,3E22.13)')& + iv%bogus(n)%slp ! O-B p + do k = 1 , iv%info(bogus)%levels(n) + write(ounit,'(2E22.13,4(E22.13,i8,3E22.13))')& + iv%bogus(n)%h(k), & + iv%bogus(n)%p(k), & ! Obs Pressure + iv%bogus(n)%u(k), &! O-B u + iv%bogus(n)%v(k), &! O-B v + iv%bogus(n)%t(k), &! O-B t + iv%bogus(n)%q(k) ! O-B q + enddo + end do + close (ounit) + end if + + ! [23] AIRS retrievals: + + if (iv%info(airsr)%plocal(iv%time) - iv%info(airsr)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.airsr',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'airsr', iv%info(airsr)%plocal(iv%time) - & + iv%info(airsr)%plocal(iv%time-1) + do n = iv%info(airsr)%plocal(iv%time-1) + 1, & + iv%info(airsr)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(airsr)%levels(n), iv%info(airsr)%id(n), & ! Station + iv%info(airsr)%lat(1,n), & ! Latitude + iv%info(airsr)%lon(1,n) ! Longitude + do k = 1 , iv%info(airsr)%levels(n) + write(ounit,'(E22.13,2(E22.13,i8,3E22.13))')& + iv%airsr(n)%p(k), & ! Obs Pressure + iv%airsr(n)%t(k), &! O-B t + iv%airsr(n)%q(k) ! O-B q + enddo + end do + close (ounit) + end if + + ! [24] gpsref obs: + + if (iv%info(gpsref)%plocal(iv%time) - iv%info(gpsref)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.gpsref',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'gpsref', iv%info(gpsref)%plocal(iv%time) - & + iv%info(gpsref)%plocal(iv%time-1) + do n = iv%info(gpsref)%plocal(iv%time-1) + 1, & + iv%info(gpsref)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(gpsref)%levels(n), iv%info(gpsref)%id(n), & ! Station + iv%info(gpsref)%lat(1,n), & ! Latitude + iv%info(gpsref)%lon(1,n) ! Longitude + do k = 1 , iv%info(gpsref)%levels(n) + write(ounit,'(E22.13,(E22.13,i8,3E22.13))')& + iv%gpsref(n)%h(k), & ! Obs Height + iv%gpsref(n)%ref(k) ! O-B ref + enddo + end do + close (ounit) + end if + + ! [25] radar obs: + + nobs_tot = iv%info(radar)%ptotal(num_fgat_time) - iv%info(radar)%ptotal(0) + nlev_max = iv%info(radar)%max_lev + + if ( nobs_tot > 0 ) then + if ( rootproc ) then + write(unit=filename, fmt='(a,i3.3,a)') 'radar_innov_t', file_index + open (unit=ounit,file=trim(filename),form='unformatted', & + status='replace', iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file "//trim(filename)/)) + end if + write(ounit) nobs_tot, nlev_max, use_radar_rv, use_radar_rf, use_radar_rhv, use_radar_rqv + end if ! root open ounit + + allocate( data2d(nobs_tot, 2) ) + data2d = 0.0 + do n = iv%info(radar)%n1, iv%info(radar)%n2 + if ( .not. iv%info(radar)%proc_domain(1,n) ) cycle + iobs = iv%info(radar)%obs_global_index(n) + data2d(iobs, 1) = iv%info(radar)%lat(1,n) + data2d(iobs, 2) = iv%info(radar)%lon(1,n) + end do + + allocate( data2d_g(nobs_tot, 2) ) +#ifdef DM_PARALLEL + call mpi_reduce(data2d, data2d_g, nobs_tot*2, true_mpi_real, mpi_sum, root, comm, ierr) +#else + data2d_g = data2d +#endif + deallocate( data2d ) + if ( rootproc ) then + write(ounit) data2d_g + end if + deallocate( data2d_g ) + + if ( use_radar_rv ) then + allocate( data3d(nobs_tot, nlev_max, 3) ) + data3d = 0.0 + do n = iv%info(radar)%n1, iv%info(radar)%n2 + if ( .not. iv%info(radar)%proc_domain(1,n) ) cycle + iobs = iv%info(radar)%obs_global_index(n) + do k = 1 , iv%info(radar)%levels(n) + data3d(iobs, k, 1) = iv%radar(n)%rv(k)%inv + data3d(iobs, k, 2) = iv%radar(n)%rv(k)%qc * 1.0 !int to real + data3d(iobs, k, 3) = iv%radar(n)%rv(k)%error + end do + end do + allocate( data3d_g(nobs_tot, nlev_max, 3) ) +#ifdef DM_PARALLEL + call mpi_reduce(data3d, data3d_g, nobs_tot*nlev_max*3, true_mpi_real, mpi_sum, root, comm, ierr) +#else + data3d_g = data3d +#endif + deallocate( data3d ) + if ( rootproc ) then + write(ounit) data3d_g + end if + deallocate( data3d_g ) + end if ! use_radar_rv + + if ( use_radar_rf ) then + allocate( data3d(nobs_tot, nlev_max, 3) ) + data3d = 0.0 + do n = iv%info(radar)%n1, iv%info(radar)%n2 + if ( .not. iv%info(radar)%proc_domain(1,n) ) cycle + iobs = iv%info(radar)%obs_global_index(n) + do k = 1 , iv%info(radar)%levels(n) + data3d(iobs, k, 1) = iv%radar(n)%rf(k)%inv + data3d(iobs, k, 2) = iv%radar(n)%rf(k)%qc * 1.0 !int to real + data3d(iobs, k, 3) = iv%radar(n)%rf(k)%error + end do + end do + allocate( data3d_g(nobs_tot, nlev_max, 3) ) +#ifdef DM_PARALLEL + call mpi_reduce(data3d, data3d_g, nobs_tot*nlev_max*3, true_mpi_real, mpi_sum, root, comm, ierr) +#else + data3d_g = data3d +#endif + deallocate( data3d ) + if ( rootproc ) then + write(ounit) data3d_g + end if + deallocate( data3d_g ) + end if ! use_radar_rf + + if ( use_radar_rhv ) then + allocate( data3d(nobs_tot, nlev_max, 9) ) + data3d = 0.0 + do n = iv%info(radar)%n1, iv%info(radar)%n2 + if ( .not. iv%info(radar)%proc_domain(1,n) ) cycle + iobs = iv%info(radar)%obs_global_index(n) + do k = 1 , iv%info(radar)%levels(n) + data3d(iobs, k, 1) = iv%radar(n)%rrn(k)%inv + data3d(iobs, k, 2) = iv%radar(n)%rrn(k)%qc * 1.0 !int to real + data3d(iobs, k, 3) = iv%radar(n)%rrn(k)%error + data3d(iobs, k, 4) = iv%radar(n)%rsn(k)%inv + data3d(iobs, k, 5) = iv%radar(n)%rsn(k)%qc * 1.0 !int to real + data3d(iobs, k, 6) = iv%radar(n)%rsn(k)%error + data3d(iobs, k, 7) = iv%radar(n)%rgr(k)%inv + data3d(iobs, k, 8) = iv%radar(n)%rgr(k)%qc * 1.0 !int to real + data3d(iobs, k, 9) = iv%radar(n)%rgr(k)%error + end do + end do + allocate( data3d_g(nobs_tot, nlev_max, 9) ) +#ifdef DM_PARALLEL + call mpi_reduce(data3d, data3d_g, nobs_tot*nlev_max*9, true_mpi_real, mpi_sum, root, comm, ierr) +#else + data3d_g = data3d +#endif + deallocate( data3d ) + if ( rootproc ) then + write(ounit) data3d_g + end if + deallocate( data3d_g ) + end if + + if ( use_radar_rqv ) then + allocate( data3d(nobs_tot, nlev_max, 3) ) + data3d = 0.0 + do n = iv%info(radar)%n1, iv%info(radar)%n2 + if ( .not. iv%info(radar)%proc_domain(1,n) ) cycle + iobs = iv%info(radar)%obs_global_index(n) + do k = 1 , iv%info(radar)%levels(n) + data3d(iobs, k, 1) = iv%radar(n)%rqv(k)%inv + data3d(iobs, k, 2) = iv%radar(n)%rqv(k)%qc * 1.0 !int to real + data3d(iobs, k, 3) = iv%radar(n)%rqv(k)%error + end do + end do + allocate( data3d_g(nobs_tot, nlev_max, 3) ) +#ifdef DM_PARALLEL + call mpi_reduce(data3d, data3d_g, nobs_tot*nlev_max*3, true_mpi_real, mpi_sum, root, comm, ierr) +#else + data3d_g = data3d +#endif + deallocate( data3d ) + if ( rootproc ) then + write(ounit) data3d_g + end if + deallocate( data3d_g ) + end if ! use_radar_rqv + + if ( rootproc ) then + close(ounit) + end if + + end if ! nobs_tot > 0 + + !------------------------------------------------------------------------------- + + + call da_free_unit(ounit) + + if (trace_use) call da_trace_exit("da_write_iv_for_multi_inc_opt2") + +end subroutine da_write_iv_for_multi_inc_opt2 + + From 1d39c22f4db94127a43d73caf49ebff3d3d651d1 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Mon, 16 Jul 2018 08:58:45 -0600 Subject: [PATCH 29/91] Fix to assign proper radar rv/rf error values to avoid excessive check_max_iv prints. modified: var/da/da_obs_io/da_read_obs_radar.inc modified: var/da/da_radar/da_get_innov_vector_radar.inc Missing rv are set incorrectly as no-rain rf in NCAR-processed radar data. The fix is to set qc to missing_data for -999.99 rv in var/da/da_radar/da_get_innov_vector_radar.inc NCAR-processed radar data sample FM-128 RADAR 2017-06-02_03:06:00 22.961 117.830 38.0 1 5158.0 -999.990 0 0.500 -999.990 0 0.000 -8888.880 Missing rv/rf has error of missing_r in CWB-processed radar data. The fix is to set a default error value in var/da/da_obs_io/da_read_obs_radar.inc. CWB-processed radar data sample 1 FM-128 RADAR 2017-07-06_06:00:00 19.570 117.335 0.0 1 12000.0 -888888.000 -88 -888888.000 -999.990 0 0.000 CWB-processed radar data sample 2 FM-128 RADAR 2017-07-06_06:02:00 24.134 122.223 63.0 1 946.0 1.300 0 2.000 -888888.000 -88 -888888.000 --- var/da/da_obs_io/da_read_obs_radar.inc | 6 ++++-- var/da/da_radar/da_get_innov_vector_radar.inc | 4 ++++ 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/var/da/da_obs_io/da_read_obs_radar.inc b/var/da/da_obs_io/da_read_obs_radar.inc index 01513567d1..43cfa1c6f8 100644 --- a/var/da/da_obs_io/da_read_obs_radar.inc +++ b/var/da/da_obs_io/da_read_obs_radar.inc @@ -179,11 +179,13 @@ subroutine da_read_obs_radar (iv, filename, grid) platform % each (i) % rf % qc, & platform % each (i) % rf % error - if (platform % each (i) % rv % error == 0.0) then + if (platform % each (i) % rv % error == 0.0 .or. & + abs(platform % each (i) % rv % error - missing_r) > 1.0) then platform % each (i) % rv % error = 1.0 end if - if (platform % each (i) % rf % error == 0.0) then + if (platform % each (i) % rf % error == 0.0 .or. & + abs(platform % each (i) % rf % error - missing_r) > 1.0) then platform % each (i) % rf % error = 1.0 end if diff --git a/var/da/da_radar/da_get_innov_vector_radar.inc b/var/da/da_radar/da_get_innov_vector_radar.inc index d5feeed303..ef4ec6c998 100644 --- a/var/da/da_radar/da_get_innov_vector_radar.inc +++ b/var/da/da_radar/da_get_innov_vector_radar.inc @@ -331,6 +331,10 @@ if ( iv%info(radar)%nlocal > 0 ) then .and. (iv % radar(n) % rf(k) % qc >= obs_qc_pointer) if (use_radar_rv) then + !set qc to missing_data for rv of -999.99 (radar_non_precip_rf) + if ( abs(ob%radar(n)%rv(k) - radar_non_precip_rf) < 0.1 ) then + iv % radar(n) % rv(k) % qc = missing_data + end if if (abs(iv % radar(n) % rv(k) % qc - missing_data) > 1) then if (abs(ob % radar(n) % rv(k) - missing_r) > 1.0 .AND. & iv % radar(n) % rv(k) % qc >= obs_qc_pointer) then From 32a859613ba161fcc630aa11623f9848ec24bc39 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Mon, 16 Jul 2018 09:35:25 -0600 Subject: [PATCH 30/91] Add namelist options for specifying errors for radar rhv(rrn/rsn/rgr). radar_rhv_err_opt: 1 (original; errors calculated in da_get_innov_vector_radar) 2 (new; use error settings from new namelists radar_rhv_rrn_err, radar_rhv_rsn_err, radar_rhv_rgr_err) modified: Registry/registry.var modified: var/da/da_radar/da_get_innov_vector_radar.inc modified: var/da/da_radar/da_radar.f90 --- Registry/registry.var | 4 ++ var/da/da_radar/da_get_innov_vector_radar.inc | 37 +++++++++++++------ var/da/da_radar/da_radar.f90 | 3 +- 3 files changed, 31 insertions(+), 13 deletions(-) diff --git a/Registry/registry.var b/Registry/registry.var index e117c52962..199ca6b3fc 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -481,6 +481,10 @@ rconfig real radar_rqv_rh1 namelist,radar_da 1 85.0 - "ra rconfig real radar_rqv_rh2 namelist,radar_da 1 95.0 - "radar_rqv_rh2" "RH for (radar_rqv_thresh1 < rf < radar_rqv_thresh2)" "%" rconfig real radar_rqv_h_lbound namelist,radar_da 1 -999.0 - "radar_rqv_h_lbound" "height lower bound for rqv" "m" rconfig real radar_rqv_h_ubound namelist,radar_da 1 -999.0 - "radar_rqv_h_ubound" "height upper bound for rqv" "m" +rconfig integer radar_rhv_err_opt namelist,radar_da 1 1 - "radar_rhv_err_opt" "" "1: calculated (original), 2: from namelist" +rconfig real radar_rhv_rrn_err namelist,radar_da 1 0.15 - "radar_rhv_rrn_err" "obs error of retrieved qrain" "g/kg" +rconfig real radar_rhv_rsn_err namelist,radar_da 1 0.15 - "radar_rhv_rsn_err" "obs error of retrieved qsnow" "g/kg" +rconfig real radar_rhv_rgr_err namelist,radar_da 1 0.15 - "radar_rhv_rgr_err" "obs error of retrieved qgraup" "g/kg" rconfig logical jcdfi_use namelist,perturbation 1 .false. - "jcdfi_use" "JcDFI on/off" "" rconfig integer jcdfi_diag namelist,perturbation 1 1 - "jcdfi_diag" "JcDFI diag. on/off" "" rconfig real jcdfi_penalty namelist,perturbation 1 10. - "jcdfi_penalty" "Penalty parameter for JcDF" "" diff --git a/var/da/da_radar/da_get_innov_vector_radar.inc b/var/da/da_radar/da_get_innov_vector_radar.inc index ef4ec6c998..54847100db 100644 --- a/var/da/da_radar/da_get_innov_vector_radar.inc +++ b/var/da/da_radar/da_get_innov_vector_radar.inc @@ -449,18 +449,31 @@ if ( iv%info(radar)%nlocal > 0 ) then end if !--------------------------------------------------- - ! rainwater error - iv % radar(n) % rrn(k) % error = iv % radar(n) % rf(k) % error * iv % radar(n) % rrno(k) * alog_10/leh2 - iv % radar(n) % rrn(k) % error = amax1(0.0005,iv % radar(n) % rrn(k) % error) - iv % radar(n) % rrn(k) % error = amin1( 0.001,iv % radar(n) % rrn(k) % error) - ! snow error - iv % radar(n) % rsn(k) % error = iv % radar(n) % rf(k) % error * iv % radar(n) % rsno(k) * alog_10/leh2 - iv % radar(n) % rsn(k) % error = amax1(0.0005,iv % radar(n) % rsn(k) % error) - iv % radar(n) % rsn(k) % error = amin1( 0.001,iv % radar(n) % rsn(k) % error) - ! graupel error - iv % radar(n) % rgr(k) % error = iv % radar(n) % rf(k) % error * iv % radar(n) % rgro(k) * alog_10/leh2 - iv % radar(n) % rgr(k) % error = amax1(0.0005,iv % radar(n) % rgr(k) % error) - iv % radar(n) % rgr(k) % error = amin1( 0.001,iv % radar(n) % rgr(k) % error) + if ( radar_rhv_err_opt == 1 ) then + ! rainwater error + iv % radar(n) % rrn(k) % error = iv % radar(n) % rf(k) % error * iv % radar(n) % rrno(k) * alog_10/leh2 + iv % radar(n) % rrn(k) % error = amax1(0.0005,iv % radar(n) % rrn(k) % error) + iv % radar(n) % rrn(k) % error = amin1( 0.001,iv % radar(n) % rrn(k) % error) + ! snow error + iv % radar(n) % rsn(k) % error = iv % radar(n) % rf(k) % error * iv % radar(n) % rsno(k) * alog_10/leh2 + iv % radar(n) % rsn(k) % error = amax1(0.0005,iv % radar(n) % rsn(k) % error) + iv % radar(n) % rsn(k) % error = amin1( 0.001,iv % radar(n) % rsn(k) % error) + ! graupel error + iv % radar(n) % rgr(k) % error = iv % radar(n) % rf(k) % error * iv % radar(n) % rgro(k) * alog_10/leh2 + iv % radar(n) % rgr(k) % error = amax1(0.0005,iv % radar(n) % rgr(k) % error) + iv % radar(n) % rgr(k) % error = amin1( 0.001,iv % radar(n) % rgr(k) % error) + else if ( radar_rhv_err_opt == 2 ) then + ! use settings in the namelist + ! rainwater error + iv % radar(n) % rrn(k) % error = radar_rhv_rrn_err * 0.001 ! g/kg to kg/kg + ! snow error + iv % radar(n) % rsn(k) % error = radar_rhv_rsn_err * 0.001 ! g/kg to kg/kg + ! graupel error + iv % radar(n) % rgr(k) % error = radar_rhv_rgr_err * 0.001 ! g/kg to kg/kg + else + write(unit=message(1),fmt='(A)') "radar_rhv_err_opt should be 1 or 2" + call da_error(__FILE__,__LINE__,message(1:1)) + end if end if ! it=1 diff --git a/var/da/da_radar/da_radar.f90 b/var/da/da_radar/da_radar.f90 index f656159922..d90fca1c12 100644 --- a/var/da/da_radar/da_radar.f90 +++ b/var/da/da_radar/da_radar.f90 @@ -18,7 +18,8 @@ module da_radar use da_control, only : cloudbase_calc_opt, & radar_non_precip_rf, radar_non_precip_opt, radar_rqv_thresh1, radar_rqv_thresh2, & radar_rqv_rh1, radar_rqv_rh2, radar_non_precip_rh_w, radar_non_precip_rh_i, & - radar_rqv_h_lbound, radar_rqv_h_ubound, radar_saturated_rf, cloud_cv_options + radar_rqv_h_lbound, radar_rqv_h_ubound, radar_saturated_rf, cloud_cv_options, & + radar_rhv_err_opt, radar_rhv_rrn_err, radar_rhv_rsn_err, radar_rhv_rgr_err use da_define_structures, only : maxmin_type, iv_type, y_type, jo_type, & bad_data_type, x_type, number_type, bad_data_type, & infa_type, field_type From 6e9d30b5f97f24243115caa41e3120d46e7346b0 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Mon, 16 Jul 2018 10:45:56 -0600 Subject: [PATCH 31/91] Add a namelist option to trun on/off the output of radar_omb_oma. modified: Registry/registry.var modified: var/da/da_main/da_solve.inc --- Registry/registry.var | 1 + var/da/da_main/da_solve.inc | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/Registry/registry.var b/Registry/registry.var index 557a1e26ed..92c979b580 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -486,6 +486,7 @@ rconfig integer radar_rhv_err_opt namelist,radar_da 1 1 - "ra rconfig real radar_rhv_rrn_err namelist,radar_da 1 0.15 - "radar_rhv_rrn_err" "obs error of retrieved qrain" "g/kg" rconfig real radar_rhv_rsn_err namelist,radar_da 1 0.15 - "radar_rhv_rsn_err" "obs error of retrieved qsnow" "g/kg" rconfig real radar_rhv_rgr_err namelist,radar_da 1 0.15 - "radar_rhv_rgr_err" "obs error of retrieved qgraup" "g/kg" +rconfig logical write_oa_radar_ascii namelist,radar_da 1 .true. - "write_oa_radar_ascii" "switch for writing out radar_omb_oma" "" rconfig logical jcdfi_use namelist,perturbation 1 .false. - "jcdfi_use" "JcDFI on/off" "" rconfig integer jcdfi_diag namelist,perturbation 1 1 - "jcdfi_diag" "JcDFI diag. on/off" "" rconfig real jcdfi_penalty namelist,perturbation 1 10. - "jcdfi_penalty" "Penalty parameter for JcDF" "" diff --git a/var/da/da_main/da_solve.inc b/var/da/da_main/da_solve.inc index 50e1194865..038a801463 100644 --- a/var/da/da_main/da_solve.inc +++ b/var/da/da_main/da_solve.inc @@ -985,7 +985,7 @@ ! [8.7.1] Write Ascii radar OMB and OMA file - if (use_radarobs) then + if ( use_radarobs .and. write_oa_radar_ascii ) then call da_write_oa_radar_ascii (ob,iv,re,it) end if From b7b8105b6f78713deaf12d0ee0c506f83b490b71 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Mon, 16 Jul 2018 14:44:01 -0600 Subject: [PATCH 32/91] Add namelist options for turning on/off some diagnostic output. &wrfvar1 write_gts_omb_oma = .true. !(default) write_rej_obs_conv = .false. !(default), the information is not too helpful write_unpert_obs = .false. !(default), the information is not usually used modified: Registry/registry.var modified: var/da/da_airep/da_airep.f90 modified: var/da/da_airep/da_check_max_iv_airep.inc modified: var/da/da_airsr/da_airsr.f90 modified: var/da/da_airsr/da_check_max_iv_airsr.inc modified: var/da/da_bogus/da_bogus.f90 modified: var/da/da_bogus/da_check_max_iv_bogus.inc modified: var/da/da_buoy/da_buoy.f90 modified: var/da/da_buoy/da_check_max_iv_buoy.inc modified: var/da/da_geoamv/da_check_max_iv_geoamv.inc modified: var/da/da_geoamv/da_geoamv.f90 modified: var/da/da_gpspw/da_check_max_iv_gpspw.inc modified: var/da/da_gpspw/da_gpspw.f90 modified: var/da/da_gpsref/da_check_max_iv_gpsref.inc modified: var/da/da_gpsref/da_gpsref.f90 modified: var/da/da_metar/da_check_max_iv_metar.inc modified: var/da/da_metar/da_metar.f90 modified: var/da/da_minimisation/da_get_innov_vector.inc modified: var/da/da_minimisation/da_minimisation.f90 modified: var/da/da_minimisation/da_write_diagnostics.inc modified: var/da/da_mtgirs/da_check_max_iv_mtgirs.inc modified: var/da/da_mtgirs/da_mtgirs.f90 modified: var/da/da_pilot/da_check_max_iv_pilot.inc modified: var/da/da_pilot/da_pilot.f90 modified: var/da/da_polaramv/da_check_max_iv_polaramv.inc modified: var/da/da_polaramv/da_polaramv.f90 modified: var/da/da_profiler/da_check_max_iv_profiler.inc modified: var/da/da_profiler/da_profiler.f90 modified: var/da/da_qscat/da_check_max_iv_qscat.inc modified: var/da/da_qscat/da_qscat.f90 modified: var/da/da_rain/da_check_max_iv_rain.inc modified: var/da/da_rain/da_rain.f90 modified: var/da/da_satem/da_check_max_iv_satem.inc modified: var/da/da_satem/da_satem.f90 modified: var/da/da_ships/da_check_max_iv_ships.inc modified: var/da/da_ships/da_ships.f90 modified: var/da/da_sound/da_check_max_iv_sonde_sfc.inc modified: var/da/da_sound/da_check_max_iv_sound.inc modified: var/da/da_sound/da_sound.f90 modified: var/da/da_ssmi/da_check_max_iv_ssmi_rv.inc modified: var/da/da_ssmi/da_check_max_iv_ssmt1.inc modified: var/da/da_ssmi/da_check_max_iv_ssmt2.inc modified: var/da/da_ssmi/da_ssmi.f90 modified: var/da/da_synop/da_check_max_iv_synop.inc modified: var/da/da_synop/da_synop.f90 modified: var/da/da_tamdar/da_check_max_iv_tamdar.inc modified: var/da/da_tamdar/da_check_max_iv_tamdar_sfc.inc modified: var/da/da_tamdar/da_tamdar.f90 --- Registry/registry.var | 3 ++ var/da/da_airep/da_airep.f90 | 2 +- var/da/da_airep/da_check_max_iv_airep.inc | 16 ++++++++++ var/da/da_airsr/da_airsr.f90 | 2 +- var/da/da_airsr/da_check_max_iv_airsr.inc | 4 +++ var/da/da_bogus/da_bogus.f90 | 2 +- var/da/da_bogus/da_check_max_iv_bogus.inc | 10 ++++++ var/da/da_buoy/da_buoy.f90 | 2 +- var/da/da_buoy/da_check_max_iv_buoy.inc | 18 +++++++++++ var/da/da_geoamv/da_check_max_iv_geoamv.inc | 12 +++++++ var/da/da_geoamv/da_geoamv.f90 | 2 +- var/da/da_gpspw/da_check_max_iv_gpspw.inc | 2 ++ var/da/da_gpspw/da_gpspw.f90 | 2 +- var/da/da_gpsref/da_check_max_iv_gpsref.inc | 2 ++ var/da/da_gpsref/da_gpsref.f90 | 2 +- var/da/da_metar/da_check_max_iv_metar.inc | 18 +++++++++++ var/da/da_metar/da_metar.f90 | 2 +- .../da_minimisation/da_get_innov_vector.inc | 31 +++++++++++-------- var/da/da_minimisation/da_minimisation.f90 | 2 +- .../da_minimisation/da_write_diagnostics.inc | 17 +++++++--- var/da/da_mtgirs/da_check_max_iv_mtgirs.inc | 16 ++++++++++ var/da/da_mtgirs/da_mtgirs.f90 | 2 +- var/da/da_pilot/da_check_max_iv_pilot.inc | 12 +++++++ var/da/da_pilot/da_pilot.f90 | 2 +- .../da_polaramv/da_check_max_iv_polaramv.inc | 12 +++++++ var/da/da_polaramv/da_polaramv.f90 | 2 +- .../da_profiler/da_check_max_iv_profiler.inc | 12 +++++++ var/da/da_profiler/da_profiler.f90 | 2 +- var/da/da_qscat/da_check_max_iv_qscat.inc | 12 +++++++ var/da/da_qscat/da_qscat.f90 | 2 +- var/da/da_rain/da_check_max_iv_rain.inc | 2 ++ var/da/da_rain/da_rain.f90 | 2 +- var/da/da_satem/da_check_max_iv_satem.inc | 2 ++ var/da/da_satem/da_satem.f90 | 2 +- var/da/da_ships/da_check_max_iv_ships.inc | 18 +++++++++++ var/da/da_ships/da_ships.f90 | 2 +- var/da/da_sound/da_check_max_iv_sonde_sfc.inc | 18 +++++++++++ var/da/da_sound/da_check_max_iv_sound.inc | 16 ++++++++++ var/da/da_sound/da_sound.f90 | 2 +- var/da/da_ssmi/da_check_max_iv_ssmi_rv.inc | 4 +++ var/da/da_ssmi/da_check_max_iv_ssmt1.inc | 2 ++ var/da/da_ssmi/da_check_max_iv_ssmt2.inc | 2 ++ var/da/da_ssmi/da_ssmi.f90 | 3 +- var/da/da_synop/da_check_max_iv_synop.inc | 18 +++++++++++ var/da/da_synop/da_synop.f90 | 2 +- var/da/da_tamdar/da_check_max_iv_tamdar.inc | 16 ++++++++++ .../da_tamdar/da_check_max_iv_tamdar_sfc.inc | 18 +++++++++++ var/da/da_tamdar/da_tamdar.f90 | 2 +- 48 files changed, 318 insertions(+), 38 deletions(-) diff --git a/Registry/registry.var b/Registry/registry.var index 92c979b580..b1bba57b7a 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -82,6 +82,9 @@ rconfig logical use_wrf_sfcinfo namelist,wrfvar1 1 .true. - "us rconfig logical use_background_errors namelist,wrfvar1 1 .true. - "use_background_errors" "" "" rconfig logical write_increments namelist,wrfvar1 1 .false. - "write_increments" "" "" rconfig logical write_iv_gpsztd namelist,wrfvar1 1 .false. - "write_iv_gpsztd" "switch for writing out ztd innov information" "" +rconfig logical write_gts_omb_oma namelist,wrfvar1 1 .true. - "write_gts_omb_oma" "switch for writing out gts_omb_oma information" "" +rconfig logical write_rej_obs_conv namelist,wrfvar1 1 .false. - "write_rej_obs_conv" "switch for writing out rej_obs_conv information" "" +rconfig logical write_unpert_obs namelist,wrfvar1 1 .false. - "write_unpert_obs" "switch for writing out unpert_obs (y=Hx') information" "" rconfig logical var4d namelist,wrfvar1 1 .false. - "var4d" "" "" rconfig integer var4d_bin namelist,wrfvar1 1 3600 - "var4d_bin" "" "" rconfig integer var4d_bin_rain namelist,wrfvar1 1 3600 - "var4d_bin_rain" "" "" diff --git a/var/da/da_airep/da_airep.f90 b/var/da/da_airep/da_airep.f90 index 23db6aa1e3..13c537beae 100644 --- a/var/da/da_airep/da_airep.f90 +++ b/var/da/da_airep/da_airep.f90 @@ -8,7 +8,7 @@ module da_airep airep, anal_type_verify, kms,kme,kts,kte, trace_use_dull, & position_lev_dependant,qcstat_conv_unit,ob_vars, fails_error_max, & convert_fd2uv, convert_uv2fd, max_error_spd, max_error_dir, max_omb_spd, max_omb_dir, pi, qc_rej_both, & - wind_sd_airep, wind_stats_sd + wind_sd_airep, wind_stats_sd, write_rej_obs_conv use da_grid_definitions, only : da_ffdduv, da_ffdduv_model,da_ffdduv_diagnose use da_physics, only : da_uv_to_sd_lin, da_uv_to_sd_adj use da_define_structures, only : maxmin_type, iv_type, y_type, jo_type, & diff --git a/var/da/da_airep/da_check_max_iv_airep.inc b/var/da/da_airep/da_check_max_iv_airep.inc index 7d1468d55f..121a1ac4d7 100644 --- a/var/da/da_airep/da_check_max_iv_airep.inc +++ b/var/da/da_airep/da_check_max_iv_airep.inc @@ -34,8 +34,10 @@ subroutine da_check_max_iv_airep(iv, it, num_qcstat_conv) num_qcstat_conv(1,airep,1,ipr) = num_qcstat_conv(1,airep,1,ipr) + 1 if(failed) then num_qcstat_conv(2,airep,1,ipr) = num_qcstat_conv(2,airep,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'airep',ob_vars(1),iv%info(airep)%lat(k,n),iv%info(airep)%lon(k,n),0.01*iv%airep(n)%p(k) + end if end if end if end if @@ -47,8 +49,10 @@ subroutine da_check_max_iv_airep(iv, it, num_qcstat_conv) num_qcstat_conv(1,airep,2,ipr) = num_qcstat_conv(1,airep,2,ipr) + 1 if(failed)then num_qcstat_conv(2,airep,2,ipr) = num_qcstat_conv(2,airep,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'airep',ob_vars(2),iv%info(airep)%lat(k,n),iv%info(airep)%lon(k,n),0.01*iv%airep(n)%p(k) + end if end if end if end if @@ -62,8 +66,10 @@ subroutine da_check_max_iv_airep(iv, it, num_qcstat_conv) num_qcstat_conv(1,airep,1,ipr) = num_qcstat_conv(1,airep,1,ipr) + 1 if(failed) then num_qcstat_conv(2,airep,1,ipr) = num_qcstat_conv(2,airep,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'airep',ob_vars(1),iv%info(airep)%lat(k,n),iv%info(airep)%lon(k,n),0.01*iv%airep(n)%p(k) + end if end if end if end if @@ -75,8 +81,10 @@ subroutine da_check_max_iv_airep(iv, it, num_qcstat_conv) num_qcstat_conv(1,airep,2,ipr) = num_qcstat_conv(1,airep,2,ipr) + 1 if(failed)then num_qcstat_conv(2,airep,2,ipr) = num_qcstat_conv(2,airep,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'airep',ob_vars(2),iv%info(airep)%lat(k,n),iv%info(airep)%lon(k,n),0.01*iv%airep(n)%p(k) + end if end if end if end if @@ -114,11 +122,15 @@ subroutine da_check_max_iv_airep(iv, it, num_qcstat_conv) if(failed1 .or. failed2) then num_qcstat_conv(2,airep,1,ipr) = num_qcstat_conv(2,airep,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'airep',ob_vars(1),iv%info(airep)%lat(k,n),iv%info(airep)%lon(k,n),0.01*iv%airep(n)%p(k) + end if num_qcstat_conv(2,airep,2,ipr) = num_qcstat_conv(2,airep,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'airep',ob_vars(2),iv%info(airep)%lat(k,n),iv%info(airep)%lon(k,n),0.01*iv%airep(n)%p(k) + end if endif endif @@ -147,8 +159,10 @@ subroutine da_check_max_iv_airep(iv, it, num_qcstat_conv) num_qcstat_conv(1,airep,3,ipr) = num_qcstat_conv(1,airep,3,ipr) + 1 if(failed) then num_qcstat_conv(2,airep,3,ipr) = num_qcstat_conv(2,airep,3,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'airep',ob_vars(3),iv%info(airep)%lat(k,n),iv%info(airep)%lon(k,n),0.01*iv%airep(n)%p(k) + end if end if end if end if @@ -166,9 +180,11 @@ subroutine da_check_max_iv_airep(iv, it, num_qcstat_conv) num_qcstat_conv(1,airep,4,ipr) = num_qcstat_conv(1,airep,4,ipr) + 1 if(failed) then num_qcstat_conv(2,airep,4,ipr) = num_qcstat_conv(2,airep,4,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'airep',ob_vars(4),iv%info(airep)%lat(k,n),iv%info(airep)%lon(k,n),0.01*iv%airep(n)%p(k) end if + end if end if end if end do diff --git a/var/da/da_airsr/da_airsr.f90 b/var/da/da_airsr/da_airsr.f90 index 7dee650860..58c88f8d6a 100644 --- a/var/da/da_airsr/da_airsr.f90 +++ b/var/da/da_airsr/da_airsr.f90 @@ -8,7 +8,7 @@ module da_airsr airsr, max_error_p,max_error_q, trace_use_dull,fails_error_max, & max_stheight_diff,missing_data,max_error_bq,max_error_slp, & max_error_bt, max_error_buv, anal_type_verify, kms,kme,kts,kte, & - ob_vars, qcstat_conv_unit, fails_error_max + ob_vars, qcstat_conv_unit, fails_error_max, write_rej_obs_conv use da_define_structures, only : maxmin_type, iv_type, y_type, jo_type, & bad_data_type, x_type, number_type, bad_data_type use da_interpolation, only : da_interp_lin_3d, da_to_zk, & diff --git a/var/da/da_airsr/da_check_max_iv_airsr.inc b/var/da/da_airsr/da_check_max_iv_airsr.inc index af0cd128cf..925b8d1d92 100644 --- a/var/da/da_airsr/da_check_max_iv_airsr.inc +++ b/var/da/da_airsr/da_check_max_iv_airsr.inc @@ -32,8 +32,10 @@ subroutine da_check_max_iv_airsr(iv, it,num_qcstat_conv) num_qcstat_conv(1,airsr,3,ipr) = num_qcstat_conv(1,airsr,3,ipr) + 1 if(failed)then num_qcstat_conv(2,airsr,3,ipr) = num_qcstat_conv(2,airsr,3,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'airsr',ob_vars(3),iv%info(airsr)%lat(k,n),iv%info(airsr)%lon(k,n),0.01*iv%airsr(n)%p(k) + end if endif endif endif @@ -45,8 +47,10 @@ subroutine da_check_max_iv_airsr(iv, it,num_qcstat_conv) num_qcstat_conv(1,airsr,4,ipr) = num_qcstat_conv(1,airsr,4,ipr) + 1 if(failed)then num_qcstat_conv(2,airsr,4,ipr) = num_qcstat_conv(2,airsr,4,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'airsr',ob_vars(4),iv%info(airsr)%lat(k,n),iv%info(airsr)%lon(k,n),0.01*iv%airsr(n)%p(k) + end if endif endif endif diff --git a/var/da/da_bogus/da_bogus.f90 b/var/da/da_bogus/da_bogus.f90 index 13d3850442..ef52ec61b7 100644 --- a/var/da/da_bogus/da_bogus.f90 +++ b/var/da/da_bogus/da_bogus.f90 @@ -8,7 +8,7 @@ module da_bogus bogus, max_error_p,max_error_q, trace_use_dull,fails_error_max, & max_stheight_diff,missing_data,max_error_bq,max_error_slp, & max_error_bt, max_error_buv, anal_type_verify, kms,kme,kts,kte, & - ob_vars,qcstat_conv_unit + ob_vars,qcstat_conv_unit, write_rej_obs_conv use da_define_structures, only : maxmin_type, iv_type, y_type, jo_type, & bad_data_type, x_type, number_type, bad_data_type use da_interpolation, only : da_interp_lin_3d, da_to_zk, & diff --git a/var/da/da_bogus/da_check_max_iv_bogus.inc b/var/da/da_bogus/da_check_max_iv_bogus.inc index 673f8556a1..1a1cafa716 100644 --- a/var/da/da_bogus/da_check_max_iv_bogus.inc +++ b/var/da/da_bogus/da_check_max_iv_bogus.inc @@ -35,8 +35,10 @@ subroutine da_check_max_iv_bogus(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,bogus,1,ipr) = num_qcstat_conv(1,bogus,1,ipr) + 1 if(failed)then num_qcstat_conv(2,bogus,1,ipr) = num_qcstat_conv(2,bogus,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'bogus',ob_vars(1),iv%info(bogus)%lat(k,n),iv%info(bogus)%lon(k,n),0.01*iv%bogus(n)%p(k) + end if end if end if end if @@ -48,8 +50,10 @@ subroutine da_check_max_iv_bogus(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,bogus,2,ipr) = num_qcstat_conv(1,bogus,2,ipr) + 1 if(failed)then num_qcstat_conv(2,bogus,2,ipr) = num_qcstat_conv(2,bogus,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'bogus',ob_vars(2),iv%info(bogus)%lat(k,n),iv%info(bogus)%lon(k,n),0.01*iv%bogus(n)%p(k) + end if end if end if end if @@ -61,8 +65,10 @@ subroutine da_check_max_iv_bogus(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,bogus,3,ipr) = num_qcstat_conv(1,bogus,3,ipr) + 1 if(failed)then num_qcstat_conv(2,bogus,3,ipr) = num_qcstat_conv(2,bogus,3,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'bogus',ob_vars(3),iv%info(bogus)%lat(k,n),iv%info(bogus)%lon(k,n),0.01*iv%bogus(n)%p(k) + end if end if end if end if @@ -74,8 +80,10 @@ subroutine da_check_max_iv_bogus(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,bogus,4,ipr) = num_qcstat_conv(1,bogus,4,ipr) + 1 if(failed)then num_qcstat_conv(2,bogus,4,ipr) = num_qcstat_conv(2,bogus,4,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'bogus',ob_vars(4),iv%info(bogus)%lat(k,n),iv%info(bogus)%lon(k,n),0.01*iv%bogus(n)%p(k) + end if end if end if end if @@ -90,8 +98,10 @@ subroutine da_check_max_iv_bogus(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,bogus,5,1) = num_qcstat_conv(1,bogus,5,1) + 1 if(failed) then num_qcstat_conv(2,bogus,5,1) = num_qcstat_conv(2,bogus,5,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'bogus',ob_vars(5),iv%info(bogus)%lat(1,n),iv%info(bogus)%lon(1,n),ob%bogus(n)%slp + end if endif endif endif diff --git a/var/da/da_buoy/da_buoy.f90 b/var/da/da_buoy/da_buoy.f90 index f43e2e2682..b08cc61ff7 100644 --- a/var/da/da_buoy/da_buoy.f90 +++ b/var/da/da_buoy/da_buoy.f90 @@ -12,7 +12,7 @@ module da_buoy qcstat_conv_unit,ob_vars, & convert_fd2uv, convert_uv2fd, max_error_spd, max_error_dir, & max_omb_spd, max_omb_dir, pi, qc_rej_both, & - wind_sd_buoy, wind_stats_sd + wind_sd_buoy, wind_stats_sd, write_rej_obs_conv use da_grid_definitions, only : da_ffdduv, da_ffdduv_model, da_ffdduv_diagnose use da_define_structures, only : maxmin_type, iv_type, y_type, jo_type, & bad_data_type, x_type, number_type, bad_data_type diff --git a/var/da/da_buoy/da_check_max_iv_buoy.inc b/var/da/da_buoy/da_check_max_iv_buoy.inc index e4f21d1ccc..c40513ff86 100644 --- a/var/da/da_buoy/da_check_max_iv_buoy.inc +++ b/var/da/da_buoy/da_check_max_iv_buoy.inc @@ -34,8 +34,10 @@ subroutine da_check_max_iv_buoy(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,buoy,1,1) = num_qcstat_conv(1,buoy,1,1) + 1 if(failed) then num_qcstat_conv(2,buoy,1,1) = num_qcstat_conv(2,buoy,1,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'buoy',ob_vars(1),iv%info(buoy)%lat(1,n),iv%info(buoy)%lon(1,n),0.01*ob%buoy(n)%p + end if end if end if end if @@ -47,8 +49,10 @@ subroutine da_check_max_iv_buoy(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,buoy,2,1) = num_qcstat_conv(1,buoy,2,1) + 1 if(failed)then num_qcstat_conv(2,buoy,2,1) = num_qcstat_conv(2,buoy,2,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'buoy',ob_vars(2),iv%info(buoy)%lat(1,n),iv%info(buoy)%lon(1,n),0.01*ob%buoy(n)%p + end if end if end if end if @@ -62,8 +66,10 @@ subroutine da_check_max_iv_buoy(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,buoy,1,1) = num_qcstat_conv(1,buoy,1,1) + 1 if(failed) then num_qcstat_conv(2,buoy,1,1) = num_qcstat_conv(2,buoy,1,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'buoy',ob_vars(1),iv%info(buoy)%lat(1,n),iv%info(buoy)%lon(1,n),0.01*ob%buoy(n)%p + end if end if end if end if @@ -75,8 +81,10 @@ subroutine da_check_max_iv_buoy(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,buoy,2,1) = num_qcstat_conv(1,buoy,2,1) + 1 if(failed)then num_qcstat_conv(2,buoy,2,1) = num_qcstat_conv(2,buoy,2,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'buoy',ob_vars(2),iv%info(buoy)%lat(1,n),iv%info(buoy)%lon(1,n),0.01*ob%buoy(n)%p + end if end if end if end if @@ -112,11 +120,15 @@ subroutine da_check_max_iv_buoy(iv,ob, it, num_qcstat_conv) if(failed1 .or. failed2) then num_qcstat_conv(2,buoy,1,1) = num_qcstat_conv(2,buoy,1,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'buoy',ob_vars(1),iv%info(buoy)%lat(1,n),iv%info(buoy)%lon(1,n),0.01*ob%buoy(n)%p + end if num_qcstat_conv(2,buoy,2,1) = num_qcstat_conv(2,buoy,2,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'buoy',ob_vars(2),iv%info(buoy)%lat(1,n),iv%info(buoy)%lon(1,n),0.01*ob%buoy(n)%p + end if endif endif @@ -145,11 +157,13 @@ subroutine da_check_max_iv_buoy(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,buoy,3,1)= num_qcstat_conv(1,buoy,3,1) + 1 if(failed) then num_qcstat_conv(2,buoy,3,1)= num_qcstat_conv(2,buoy,3,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'buoy',ob_vars(3),iv%info(buoy)%lat(1,n),iv%info(buoy)%lon(1,n),0.01*ob%buoy(n)%p end if end if end if + end if failed=.false. if( iv%buoy(n)%p%qc >= obs_qc_pointer ) then @@ -158,11 +172,13 @@ subroutine da_check_max_iv_buoy(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,buoy,5,1)= num_qcstat_conv(1,buoy,5,1) + 1 if(failed) then num_qcstat_conv(2,buoy,5,1)= num_qcstat_conv(2,buoy,5,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'buoy',ob_vars(5),iv%info(buoy)%lat(1,n),iv%info(buoy)%lon(1,n),0.01*ob%buoy(n)%p end if end if end if + end if failed=.false. @@ -178,11 +194,13 @@ subroutine da_check_max_iv_buoy(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,buoy,4,1)= num_qcstat_conv(1,buoy,4,1) + 1 if(failed) then num_qcstat_conv(2,buoy,4,1)= num_qcstat_conv(2,buoy,4,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'buoy',ob_vars(4),iv%info(buoy)%lat(1,n),iv%info(buoy)%lon(1,n),0.01*ob%buoy(n)%p end if end if end if + end if end do diff --git a/var/da/da_geoamv/da_check_max_iv_geoamv.inc b/var/da/da_geoamv/da_check_max_iv_geoamv.inc index 7482495513..53b9579c8d 100644 --- a/var/da/da_geoamv/da_check_max_iv_geoamv.inc +++ b/var/da/da_geoamv/da_check_max_iv_geoamv.inc @@ -35,8 +35,10 @@ subroutine da_check_max_iv_geoamv(iv, it, num_qcstat_conv) num_qcstat_conv(1,geoamv,1,ipr) = num_qcstat_conv(1,geoamv,1,ipr) + 1 if(failed) then num_qcstat_conv(2,geoamv,1,ipr) = num_qcstat_conv(2,geoamv,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'geoamv',ob_vars(1),iv%info(geoamv)%lat(k,n),iv%info(geoamv)%lon(k,n),0.01*iv%geoamv(n)%p(k) + end if end if end if end if @@ -48,8 +50,10 @@ subroutine da_check_max_iv_geoamv(iv, it, num_qcstat_conv) num_qcstat_conv(1,geoamv,2,ipr) = num_qcstat_conv(1,geoamv,2,ipr) + 1 if(failed)then num_qcstat_conv(2,geoamv,2,ipr) = num_qcstat_conv(2,geoamv,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'geoamv',ob_vars(2),iv%info(geoamv)%lat(k,n),iv%info(geoamv)%lon(k,n),0.01*iv%geoamv(n)%p(k) + end if end if end if end if @@ -63,8 +67,10 @@ subroutine da_check_max_iv_geoamv(iv, it, num_qcstat_conv) num_qcstat_conv(1,geoamv,1,ipr) = num_qcstat_conv(1,geoamv,1,ipr) + 1 if(failed) then num_qcstat_conv(2,geoamv,1,ipr) = num_qcstat_conv(2,geoamv,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'geoamv',ob_vars(1),iv%info(geoamv)%lat(k,n),iv%info(geoamv)%lon(k,n),0.01*iv%geoamv(n)%p(k) + end if end if end if end if @@ -76,8 +82,10 @@ subroutine da_check_max_iv_geoamv(iv, it, num_qcstat_conv) num_qcstat_conv(1,geoamv,2,ipr) = num_qcstat_conv(1,geoamv,2,ipr) + 1 if(failed)then num_qcstat_conv(2,geoamv,2,ipr) = num_qcstat_conv(2,geoamv,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'geoamv',ob_vars(2),iv%info(geoamv)%lat(k,n),iv%info(geoamv)%lon(k,n),0.01*iv%geoamv(n)%p(k) + end if end if end if end if @@ -113,11 +121,15 @@ subroutine da_check_max_iv_geoamv(iv, it, num_qcstat_conv) if(failed1 .or. failed2) then num_qcstat_conv(2,geoamv,1,ipr) = num_qcstat_conv(2,geoamv,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'geoamv',ob_vars(1),iv%info(geoamv)%lat(k,n),iv%info(geoamv)%lon(k,n),0.01*iv%geoamv(n)%p(k) + end if num_qcstat_conv(2,geoamv,2,ipr) = num_qcstat_conv(2,geoamv,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'geoamv',ob_vars(2),iv%info(geoamv)%lat(k,n),iv%info(geoamv)%lon(k,n),0.01*iv%geoamv(n)%p(k) + end if endif endif diff --git a/var/da/da_geoamv/da_geoamv.f90 b/var/da/da_geoamv/da_geoamv.f90 index 2f5ce31a7e..d4bbbc486b 100644 --- a/var/da/da_geoamv/da_geoamv.f90 +++ b/var/da/da_geoamv/da_geoamv.f90 @@ -9,7 +9,7 @@ module da_geoamv max_stheight_diff,missing_data,max_error_bq,max_error_slp,fails_error_max, & max_error_bt, max_error_buv, geoamv, anal_type_verify,qcstat_conv_unit,ob_vars, & convert_fd2uv, convert_uv2fd, max_error_spd, max_error_dir, max_omb_spd, max_omb_dir, pi, qc_rej_both,& - wind_sd_geoamv, wind_stats_sd + wind_sd_geoamv, wind_stats_sd, write_rej_obs_conv use da_grid_definitions, only : da_ffdduv, da_ffdduv_model,da_ffdduv_diagnose use da_physics, only : da_uv_to_sd_lin, da_uv_to_sd_adj use da_define_structures, only : maxmin_type, iv_type, y_type, jo_type, & diff --git a/var/da/da_gpspw/da_check_max_iv_gpspw.inc b/var/da/da_gpspw/da_check_max_iv_gpspw.inc index 599d8f320c..6be539a3ef 100644 --- a/var/da/da_gpspw/da_check_max_iv_gpspw.inc +++ b/var/da/da_gpspw/da_check_max_iv_gpspw.inc @@ -30,8 +30,10 @@ subroutine da_check_max_iv_gpspw(iv, it, num_qcstat_conv) num_qcstat_conv(1,gpspw,7,1) = num_qcstat_conv(1,gpspw,7,1) + 1 if(failed) then num_qcstat_conv(2,gpspw,7,1) = num_qcstat_conv(2,gpspw,7,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,2f12.2,a12)')& 'gpspw',ob_vars(7),iv%info(gpspw)%lat(1,n),iv%info(gpspw)%lon(1,n),'1013.25' + end if end if end if end if diff --git a/var/da/da_gpspw/da_gpspw.f90 b/var/da/da_gpspw/da_gpspw.f90 index 473a1ea9ca..808d6649ba 100644 --- a/var/da/da_gpspw/da_gpspw.f90 +++ b/var/da/da_gpspw/da_gpspw.f90 @@ -12,7 +12,7 @@ module da_gpspw pseudo_var, num_pseudo, use_gpspwobs, use_gpsztdobs, max_error_pw,fails_error_max, & fails_error_max,pseudo_err,pseudo_x, pseudo_y, stdout, & pseudo_z,pseudo_val,max_error_ref, trace_use_dull, pseudo, its,ite,jts,jte,& - ob_vars,qcstat_conv_unit + ob_vars,qcstat_conv_unit, write_rej_obs_conv use da_control, only : pseudo_tpw, pseudo_ztd, myproc, num_fgat_time, write_iv_gpsztd use da_define_structures, only : maxmin_type, iv_type, y_type, jo_type, & bad_data_type, x_type, number_type, bad_data_type, & diff --git a/var/da/da_gpsref/da_check_max_iv_gpsref.inc b/var/da/da_gpsref/da_check_max_iv_gpsref.inc index 0c84222dc1..32e8cf966b 100644 --- a/var/da/da_gpsref/da_check_max_iv_gpsref.inc +++ b/var/da/da_gpsref/da_check_max_iv_gpsref.inc @@ -61,11 +61,13 @@ subroutine da_check_max_iv_gpsref(iv,it, num_qcstat_conv, opt) endif if(failed) then num_qcstat_conv(2,gpsref,8,ipr) = num_qcstat_conv(2,gpsref,8,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2,I5)')& 'gpsref',ob_vars(8),iv%info(gpsref)%lat(k,n), & iv%info(gpsref)%lon(k,n),0.01*iv%gpsref(n)%p(k)%inv, & iv%gpsref(n)%ref(k)%qc end if + end if end do end do ENDIF diff --git a/var/da/da_gpsref/da_gpsref.f90 b/var/da/da_gpsref/da_gpsref.f90 index 4ab2e79d76..9400e9708d 100644 --- a/var/da/da_gpsref/da_gpsref.f90 +++ b/var/da/da_gpsref/da_gpsref.f90 @@ -15,7 +15,7 @@ module da_gpsref ! t_iwabuchi END anal_type_verify,fails_error_max,pseudo_err,pseudo_x, pseudo_y, stdout, & use_gpsrefobs, gpsref_thinning, pseudo_z,pseudo_val,max_error_ref, pseudo, & - jts, jte,its,ite, npres_print, pptop + jts, jte,its,ite, npres_print, pptop, write_rej_obs_conv use da_control, only : pseudo_ref use da_define_structures, only : maxmin_type, iv_type, y_type, jo_type, & bad_data_type, x_type, number_type, bad_data_type, & diff --git a/var/da/da_metar/da_check_max_iv_metar.inc b/var/da/da_metar/da_check_max_iv_metar.inc index 29e6449606..082f58ebba 100644 --- a/var/da/da_metar/da_check_max_iv_metar.inc +++ b/var/da/da_metar/da_check_max_iv_metar.inc @@ -34,8 +34,10 @@ subroutine da_check_max_iv_metar(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,metar,1,1) = num_qcstat_conv(1,metar,1,1) + 1 if(failed) then num_qcstat_conv(2,metar,1,1) = num_qcstat_conv(2,metar,1,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'metar',ob_vars(1),iv%info(metar)%lat(1,n),iv%info(metar)%lon(1,n),0.01*ob%metar(n)%p + end if end if end if end if @@ -47,8 +49,10 @@ subroutine da_check_max_iv_metar(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,metar,2,1) = num_qcstat_conv(1,metar,2,1) + 1 if(failed)then num_qcstat_conv(2,metar,2,1) = num_qcstat_conv(2,metar,2,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'metar',ob_vars(2),iv%info(metar)%lat(1,n),iv%info(metar)%lon(1,n),0.01*ob%metar(n)%p + end if end if end if end if @@ -60,8 +64,10 @@ subroutine da_check_max_iv_metar(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,metar,1,1) = num_qcstat_conv(1,metar,1,1) + 1 if(failed) then num_qcstat_conv(2,metar,1,1) = num_qcstat_conv(2,metar,1,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'metar',ob_vars(1),iv%info(metar)%lat(1,n),iv%info(metar)%lon(1,n),0.01*ob%metar(n)%p + end if end if end if end if @@ -72,8 +78,10 @@ subroutine da_check_max_iv_metar(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,metar,2,1) = num_qcstat_conv(1,metar,2,1) + 1 if(failed)then num_qcstat_conv(2,metar,2,1) = num_qcstat_conv(2,metar,2,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'metar',ob_vars(2),iv%info(metar)%lat(1,n),iv%info(metar)%lon(1,n),0.01*ob%metar(n)%p + end if end if end if end if @@ -108,11 +116,15 @@ subroutine da_check_max_iv_metar(iv,ob, it, num_qcstat_conv) if(failed1 .or. failed2) then num_qcstat_conv(2,metar,1,1) = num_qcstat_conv(2,metar,1,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'metar',ob_vars(1),iv%info(metar)%lat(1,n),iv%info(metar)%lon(1,n),0.01*ob%metar(n)%p + end if num_qcstat_conv(2,metar,2,1) = num_qcstat_conv(2,metar,2,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'metar',ob_vars(2),iv%info(metar)%lat(1,n),iv%info(metar)%lon(1,n),0.01*ob%metar(n)%p + end if endif endif @@ -141,11 +153,13 @@ subroutine da_check_max_iv_metar(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,metar,3,1)= num_qcstat_conv(1,metar,3,1) + 1 if(failed) then num_qcstat_conv(2,metar,3,1)= num_qcstat_conv(2,metar,3,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'metar',ob_vars(3),iv%info(metar)%lat(1,n),iv%info(metar)%lon(1,n),0.01*ob%metar(n)%p end if end if end if + end if failed=.false. if( iv%metar(n)%p%qc >= obs_qc_pointer ) then @@ -154,11 +168,13 @@ subroutine da_check_max_iv_metar(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,metar,5,1)= num_qcstat_conv(1,metar,5,1) + 1 if(failed) then num_qcstat_conv(2,metar,5,1)= num_qcstat_conv(2,metar,5,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'metar',ob_vars(5),iv%info(metar)%lat(1,n),iv%info(metar)%lon(1,n),0.01*ob%metar(n)%p end if end if end if + end if failed=.false. if( iv%metar(n)%q%qc >= obs_qc_pointer ) then @@ -173,11 +189,13 @@ subroutine da_check_max_iv_metar(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,metar,4,1)= num_qcstat_conv(1,metar,4,1) + 1 if(failed) then num_qcstat_conv(2,metar,4,1)= num_qcstat_conv(2,metar,4,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'metar',ob_vars(4),iv%info(metar)%lat(1,n),iv%info(metar)%lon(1,n),0.01*ob%metar(n)%p end if end if end if + end if end do if (trace_use_dull) call da_trace_exit("da_check_max_iv_metar") diff --git a/var/da/da_metar/da_metar.f90 b/var/da/da_metar/da_metar.f90 index 03cfab0a7e..07b17c4271 100644 --- a/var/da/da_metar/da_metar.f90 +++ b/var/da/da_metar/da_metar.f90 @@ -13,7 +13,7 @@ module da_metar qcstat_conv_unit,ob_vars, & convert_fd2uv, convert_uv2fd, max_error_spd, max_error_dir, & max_omb_spd, max_omb_dir, pi, qc_rej_both, & - wind_sd_metar, wind_stats_sd + wind_sd_metar, wind_stats_sd, write_rej_obs_conv use da_grid_definitions, only : da_ffdduv, da_ffdduv_model, da_ffdduv_diagnose use da_define_structures, only : maxmin_type, iv_type, y_type, jo_type, & bad_data_type, x_type, number_type, bad_data_type, & diff --git a/var/da/da_minimisation/da_get_innov_vector.inc b/var/da/da_minimisation/da_get_innov_vector.inc index a9ea915900..f50b2be5b6 100644 --- a/var/da/da_minimisation/da_get_innov_vector.inc +++ b/var/da/da_minimisation/da_get_innov_vector.inc @@ -32,22 +32,23 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) if (trace_use) call da_trace_entry("da_get_innov_vector") call da_message((/"Calculate innovation vector(iv)"/)) - call da_get_unit(qcstat_conv_unit) + if ( write_rej_obs_conv ) then + call da_get_unit(qcstat_conv_unit) #ifdef DM_PARALLEL - write(unit=filename, fmt='(a,i2.2,a,i4.4)') 'rej_obs_conv_',it,'.', myproc + write(unit=filename, fmt='(a,i2.2,a,i4.4)') 'rej_obs_conv_',it,'.', myproc #else - write(unit=filename, fmt='(a,i2.2,a)') 'rej_obs_conv_',it,'.000' + write(unit=filename, fmt='(a,i2.2,a)') 'rej_obs_conv_',it,'.000' #endif - open (unit=qcstat_conv_unit,file=trim(filename),form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open qc observation file"//filename/)) + open (unit=qcstat_conv_unit,file=trim(filename),form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open qc observation file"//filename/)) + end if end if - iv%ptop = grid%xb%ptop filename = ' ' @@ -237,8 +238,10 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) !call wrfu_finalize !call wrf_shutdown !stop - close(qcstat_conv_unit) - call da_free_unit(qcstat_conv_unit) + if ( write_rej_obs_conv ) then + close(qcstat_conv_unit) + call da_free_unit(qcstat_conv_unit) + end if if (trace_use) call da_trace_exit("da_get_innov_vector") return endif @@ -289,8 +292,10 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) end if #endif - close(qcstat_conv_unit) - call da_free_unit(qcstat_conv_unit) + if ( write_rej_obs_conv ) then + close(qcstat_conv_unit) + call da_free_unit(qcstat_conv_unit) + end if if (trace_use) call da_trace_exit("da_get_innov_vector") diff --git a/var/da/da_minimisation/da_minimisation.f90 b/var/da/da_minimisation/da_minimisation.f90 index efd7eb9bdc..fefb0a7824 100644 --- a/var/da/da_minimisation/da_minimisation.f90 +++ b/var/da/da_minimisation/da_minimisation.f90 @@ -55,7 +55,7 @@ module da_minimisation ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe, fgat_rain_flags, var4d_bin_rain, freeze_varbc, & use_wpec, wpec_factor, use_4denvar, anal_type_hybrid_dual_res, alphacv_method, alphacv_method_xa, & write_detail_grad_fn, pseudo_uvtpq, lanczos_ep_filename, use_divc, divc_factor, use_radarobs, & - multi_inc_io_opt + multi_inc_io_opt, write_gts_omb_oma, write_unpert_obs, write_rej_obs_conv use da_define_structures, only : iv_type, y_type, j_type, be_type, & xbx_type, jo_type, da_allocate_y,da_zero_x,da_zero_y,da_deallocate_y, & da_zero_vp_type, qhat_type diff --git a/var/da/da_minimisation/da_write_diagnostics.inc b/var/da/da_minimisation/da_write_diagnostics.inc index 30cca100bb..bba90fee4d 100644 --- a/var/da/da_minimisation/da_write_diagnostics.inc +++ b/var/da/da_minimisation/da_write_diagnostics.inc @@ -129,19 +129,28 @@ end if ! [5.0] Write observation data (O, O-B, O-A, y=hx'): !------------------------------------------------------------------------------ - call da_write_obs(it, ob, iv, re) + if ( write_gts_omb_oma ) then + call da_write_obs(it, ob, iv, re) + end if ! Write ETKF observation files if required (note - 1PE only at present): if (anal_type_verify) then call da_write_obs_etkf(ob, iv, re) end if - call da_final_write_obs(it, iv) + if ( write_gts_omb_oma ) then + call da_final_write_obs(it, iv) + end if if (.not. anal_type_verify) then - call da_write_y(iv, y) + if ( write_unpert_obs ) then + call da_write_y(iv, y) + end if + + if ( write_unpert_obs ) then + call da_final_write_y(iv) + end if - call da_final_write_y(iv) call da_print_qcstat(it, iv, num_qcstat_conv) end if diff --git a/var/da/da_mtgirs/da_check_max_iv_mtgirs.inc b/var/da/da_mtgirs/da_check_max_iv_mtgirs.inc index 99305b7b18..825af5739f 100644 --- a/var/da/da_mtgirs/da_check_max_iv_mtgirs.inc +++ b/var/da/da_mtgirs/da_check_max_iv_mtgirs.inc @@ -34,8 +34,10 @@ subroutine da_check_max_iv_mtgirs(iv, it, num_qcstat_conv) num_qcstat_conv(1,mtgirs,1,ipr) = num_qcstat_conv(1,mtgirs,1,ipr) + 1 if(failed) then num_qcstat_conv(2,mtgirs,1,ipr) = num_qcstat_conv(2,mtgirs,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'mtgirs',ob_vars(1),iv%info(mtgirs)%lat(k,n),iv%info(mtgirs)%lon(k,n),0.01*iv%mtgirs(n)%p(k) + end if end if end if end if @@ -47,8 +49,10 @@ subroutine da_check_max_iv_mtgirs(iv, it, num_qcstat_conv) num_qcstat_conv(1,mtgirs,2,ipr) = num_qcstat_conv(1,mtgirs,2,ipr) + 1 if(failed)then num_qcstat_conv(2,mtgirs,2,ipr) = num_qcstat_conv(2,mtgirs,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'mtgirs',ob_vars(2),iv%info(mtgirs)%lat(k,n),iv%info(mtgirs)%lon(k,n),0.01*iv%mtgirs(n)%p(k) + end if end if end if end if @@ -60,8 +64,10 @@ subroutine da_check_max_iv_mtgirs(iv, it, num_qcstat_conv) num_qcstat_conv(1,mtgirs,1,ipr) = num_qcstat_conv(1,mtgirs,1,ipr) + 1 if(failed) then num_qcstat_conv(2,mtgirs,1,ipr) = num_qcstat_conv(2,mtgirs,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'mtgirs',ob_vars(1),iv%info(mtgirs)%lat(k,n),iv%info(mtgirs)%lon(k,n),0.01*iv%mtgirs(n)%p(k) + end if end if end if end if @@ -73,8 +79,10 @@ subroutine da_check_max_iv_mtgirs(iv, it, num_qcstat_conv) num_qcstat_conv(1,mtgirs,2,ipr) = num_qcstat_conv(1,mtgirs,2,ipr) + 1 if(failed)then num_qcstat_conv(2,mtgirs,2,ipr) = num_qcstat_conv(2,mtgirs,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'mtgirs',ob_vars(2),iv%info(mtgirs)%lat(k,n),iv%info(mtgirs)%lon(k,n),0.01*iv%mtgirs(n)%p(k) + end if end if end if end if @@ -110,11 +118,15 @@ subroutine da_check_max_iv_mtgirs(iv, it, num_qcstat_conv) if(failed1 .or. failed2) then num_qcstat_conv(2,mtgirs,1,ipr) = num_qcstat_conv(2,mtgirs,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'mtgirs',ob_vars(1),iv%info(mtgirs)%lat(k,n),iv%info(mtgirs)%lon(k,n),0.01*iv%mtgirs(n)%p(k) + end if num_qcstat_conv(2,mtgirs,2,ipr) = num_qcstat_conv(2,mtgirs,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'mtgirs',ob_vars(2),iv%info(mtgirs)%lat(k,n),iv%info(mtgirs)%lon(k,n),0.01*iv%mtgirs(n)%p(k) + end if end if end if @@ -144,8 +156,10 @@ subroutine da_check_max_iv_mtgirs(iv, it, num_qcstat_conv) num_qcstat_conv(1,mtgirs,3,ipr) = num_qcstat_conv(1,mtgirs,3,ipr) + 1 if(failed) then num_qcstat_conv(2,mtgirs,3,ipr) = num_qcstat_conv(2,mtgirs,3,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'mtgirs',ob_vars(3),iv%info(mtgirs)%lat(k,n),iv%info(mtgirs)%lon(k,n),0.01*iv%mtgirs(n)%p(k) + end if end if end if end if @@ -163,8 +177,10 @@ subroutine da_check_max_iv_mtgirs(iv, it, num_qcstat_conv) num_qcstat_conv(1,mtgirs,4,ipr) = num_qcstat_conv(1,mtgirs,4,ipr) + 1 if(failed) then num_qcstat_conv(2,mtgirs,4,ipr) = num_qcstat_conv(2,mtgirs,4,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'mtgirs',ob_vars(4),iv%info(mtgirs)%lat(k,n),iv%info(mtgirs)%lon(k,n),0.01*iv%mtgirs(n)%p(k) + end if end if end if end if diff --git a/var/da/da_mtgirs/da_mtgirs.f90 b/var/da/da_mtgirs/da_mtgirs.f90 index d809044e11..33b085a508 100644 --- a/var/da/da_mtgirs/da_mtgirs.f90 +++ b/var/da/da_mtgirs/da_mtgirs.f90 @@ -8,7 +8,7 @@ module da_mtgirs kms,kme,kts,kte, & trace_use_dull, mtgirs, position_lev_dependant, max_ext_its, qcstat_conv_unit, ob_vars, & convert_fd2uv, convert_uv2fd, max_error_spd, max_error_dir, max_omb_spd, max_omb_dir, pi, qc_rej_both,& - wind_sd_mtgirs, wind_stats_sd + wind_sd_mtgirs, wind_stats_sd, write_rej_obs_conv use da_grid_definitions, only : da_ffdduv,da_ffdduv_model, da_ffdduv_diagnose use da_physics, only : da_uv_to_sd_lin, da_uv_to_sd_adj use da_define_structures, only : maxmin_type, iv_type, y_type, jo_type, & diff --git a/var/da/da_pilot/da_check_max_iv_pilot.inc b/var/da/da_pilot/da_check_max_iv_pilot.inc index 63aa020d21..3a63ab3b5c 100644 --- a/var/da/da_pilot/da_check_max_iv_pilot.inc +++ b/var/da/da_pilot/da_check_max_iv_pilot.inc @@ -35,8 +35,10 @@ subroutine da_check_max_iv_pilot(iv, it, num_qcstat_conv) num_qcstat_conv(1,pilot,1,ipr) = num_qcstat_conv(1,pilot,1,ipr) + 1 if(failed) then num_qcstat_conv(2,pilot,1,ipr) = num_qcstat_conv(2,pilot,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'pilot',ob_vars(1),iv%info(pilot)%lat(k,n),iv%info(pilot)%lon(k,n),0.01*iv%pilot(n)%p(k) + end if end if end if end if @@ -48,8 +50,10 @@ subroutine da_check_max_iv_pilot(iv, it, num_qcstat_conv) num_qcstat_conv(1,pilot,2,ipr) = num_qcstat_conv(1,pilot,2,ipr) + 1 if(failed)then num_qcstat_conv(2,pilot,2,ipr) = num_qcstat_conv(2,pilot,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'pilot',ob_vars(2),iv%info(pilot)%lat(k,n),iv%info(pilot)%lon(k,n),0.01*iv%pilot(n)%p(k) + end if end if end if end if @@ -61,8 +65,10 @@ subroutine da_check_max_iv_pilot(iv, it, num_qcstat_conv) num_qcstat_conv(1,pilot,1,ipr) = num_qcstat_conv(1,pilot,1,ipr) + 1 if(failed) then num_qcstat_conv(2,pilot,1,ipr) = num_qcstat_conv(2,pilot,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'pilot',ob_vars(1),iv%info(pilot)%lat(k,n),iv%info(pilot)%lon(k,n),0.01*iv%pilot(n)%p(k) + end if end if end if end if @@ -74,8 +80,10 @@ subroutine da_check_max_iv_pilot(iv, it, num_qcstat_conv) num_qcstat_conv(1,pilot,2,ipr) = num_qcstat_conv(1,pilot,2,ipr) + 1 if(failed)then num_qcstat_conv(2,pilot,2,ipr) = num_qcstat_conv(2,pilot,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'pilot',ob_vars(2),iv%info(pilot)%lat(k,n),iv%info(pilot)%lon(k,n),0.01*iv%pilot(n)%p(k) + end if end if end if end if @@ -112,11 +120,15 @@ subroutine da_check_max_iv_pilot(iv, it, num_qcstat_conv) if(failed1 .or. failed2) then num_qcstat_conv(2,pilot,1,ipr) = num_qcstat_conv(2,pilot,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'pilot',ob_vars(1),iv%info(pilot)%lat(k,n),iv%info(pilot)%lon(k,n),0.01*iv%pilot(n)%p(k) + end if num_qcstat_conv(2,pilot,2,ipr) = num_qcstat_conv(2,pilot,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'pilot',ob_vars(2),iv%info(pilot)%lat(k,n),iv%info(pilot)%lon(k,n),0.01*iv%pilot(n)%p(k) + end if endif endif diff --git a/var/da/da_pilot/da_pilot.f90 b/var/da/da_pilot/da_pilot.f90 index 0e81d187d8..5517239c36 100644 --- a/var/da/da_pilot/da_pilot.f90 +++ b/var/da/da_pilot/da_pilot.f90 @@ -9,7 +9,7 @@ module da_pilot max_stheight_diff, anal_type_verify, kms,kme,kts,kte,ob_vars,qcstat_conv_unit, & convert_fd2uv, convert_uv2fd, max_error_spd, max_error_dir, & max_omb_spd, max_omb_dir, pi, qc_rej_both, & - wind_sd_pilot, wind_stats_sd + wind_sd_pilot, wind_stats_sd, write_rej_obs_conv use da_grid_definitions, only : da_ffdduv, da_ffdduv_model, da_ffdduv_diagnose use da_physics, only : da_uv_to_sd_lin, da_uv_to_sd_adj use da_define_structures, only : maxmin_type, iv_type, y_type, jo_type, & diff --git a/var/da/da_polaramv/da_check_max_iv_polaramv.inc b/var/da/da_polaramv/da_check_max_iv_polaramv.inc index 34f8cbc9d3..cf848540f9 100644 --- a/var/da/da_polaramv/da_check_max_iv_polaramv.inc +++ b/var/da/da_polaramv/da_check_max_iv_polaramv.inc @@ -34,8 +34,10 @@ subroutine da_check_max_iv_polaramv(iv,it,num_qcstat_conv) num_qcstat_conv(1,polaramv,1,ipr) = num_qcstat_conv(1,polaramv,1,ipr) + 1 if(failed) then num_qcstat_conv(2,polaramv,1,ipr) = num_qcstat_conv(2,polaramv,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'polaramv',ob_vars(1),iv%info(polaramv)%lat(k,n),iv%info(polaramv)%lon(k,n),0.01*iv%polaramv(n)%p(k) + end if end if end if end if @@ -47,8 +49,10 @@ subroutine da_check_max_iv_polaramv(iv,it,num_qcstat_conv) num_qcstat_conv(1,polaramv,2,ipr) = num_qcstat_conv(1,polaramv,2,ipr) + 1 if(failed)then num_qcstat_conv(2,polaramv,2,ipr) = num_qcstat_conv(2,polaramv,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'polaramv',ob_vars(2),iv%info(polaramv)%lat(k,n),iv%info(polaramv)%lon(k,n),0.01*iv%polaramv(n)%p(k) + end if end if end if end if @@ -62,8 +66,10 @@ subroutine da_check_max_iv_polaramv(iv,it,num_qcstat_conv) num_qcstat_conv(1,polaramv,1,ipr) = num_qcstat_conv(1,polaramv,1,ipr) + 1 if(failed) then num_qcstat_conv(2,polaramv,1,ipr) = num_qcstat_conv(2,polaramv,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'polaramv',ob_vars(1),iv%info(polaramv)%lat(k,n),iv%info(polaramv)%lon(k,n),0.01*iv%polaramv(n)%p(k) + end if end if end if end if @@ -75,8 +81,10 @@ subroutine da_check_max_iv_polaramv(iv,it,num_qcstat_conv) num_qcstat_conv(1,polaramv,2,ipr) = num_qcstat_conv(1,polaramv,2,ipr) + 1 if(failed)then num_qcstat_conv(2,polaramv,2,ipr) = num_qcstat_conv(2,polaramv,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'polaramv',ob_vars(2),iv%info(polaramv)%lat(k,n),iv%info(polaramv)%lon(k,n),0.01*iv%polaramv(n)%p(k) + end if end if end if end if @@ -114,11 +122,15 @@ subroutine da_check_max_iv_polaramv(iv,it,num_qcstat_conv) if(failed1 .or. failed2) then num_qcstat_conv(2,polaramv,1,ipr) = num_qcstat_conv(2,polaramv,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'polaramv',ob_vars(1),iv%info(polaramv)%lat(k,n),iv%info(polaramv)%lon(k,n),0.01*iv%polaramv(n)%p(k) + end if num_qcstat_conv(2,polaramv,2,ipr) = num_qcstat_conv(2,polaramv,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'polaramv',ob_vars(2),iv%info(polaramv)%lat(k,n),iv%info(polaramv)%lon(k,n),0.01*iv%polaramv(n)%p(k) + end if end if end if end if diff --git a/var/da/da_polaramv/da_polaramv.f90 b/var/da/da_polaramv/da_polaramv.f90 index 052fb272e4..4f73b5881c 100644 --- a/var/da/da_polaramv/da_polaramv.f90 +++ b/var/da/da_polaramv/da_polaramv.f90 @@ -10,7 +10,7 @@ module da_polaramv max_error_bt, max_error_buv, polaramv, anal_type_verify, & position_lev_dependant, qcstat_conv_unit,ob_vars, & convert_fd2uv,convert_uv2fd,max_error_spd,max_error_dir,max_omb_spd,max_omb_dir,pi,qc_rej_both, & - wind_sd_polaramv, wind_stats_sd + wind_sd_polaramv, wind_stats_sd, write_rej_obs_conv use da_grid_definitions, only : da_ffdduv,da_ffdduv_model, da_ffdduv_diagnose use da_physics, only : da_uv_to_sd_lin, da_uv_to_sd_adj use da_define_structures, only : maxmin_type, iv_type, y_type, jo_type, & diff --git a/var/da/da_profiler/da_check_max_iv_profiler.inc b/var/da/da_profiler/da_check_max_iv_profiler.inc index 54178cf1af..a6a4cd63a1 100644 --- a/var/da/da_profiler/da_check_max_iv_profiler.inc +++ b/var/da/da_profiler/da_check_max_iv_profiler.inc @@ -36,8 +36,10 @@ subroutine da_check_max_iv_profiler(iv, it, num_qcstat_conv) num_qcstat_conv(1,profiler,1,ipr) = num_qcstat_conv(1,profiler,1,ipr) + 1 if(failed) then num_qcstat_conv(2,profiler,1,ipr) = num_qcstat_conv(2,profiler,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'profiler',ob_vars(1),iv%info(profiler)%lat(k,n),iv%info(profiler)%lon(k,n),0.01*iv%profiler(n)%p(k) + end if end if end if end if @@ -49,8 +51,10 @@ subroutine da_check_max_iv_profiler(iv, it, num_qcstat_conv) num_qcstat_conv(1,profiler,2,ipr) = num_qcstat_conv(1,profiler,2,ipr) + 1 if(failed)then num_qcstat_conv(2,profiler,2,ipr) = num_qcstat_conv(2,profiler,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'profiler',ob_vars(2),iv%info(profiler)%lat(k,n),iv%info(profiler)%lon(k,n),0.01*iv%profiler(n)%p(k) + end if end if end if end if @@ -64,8 +68,10 @@ subroutine da_check_max_iv_profiler(iv, it, num_qcstat_conv) num_qcstat_conv(1,profiler,1,ipr) = num_qcstat_conv(1,profiler,1,ipr) + 1 if(failed) then num_qcstat_conv(2,profiler,1,ipr) = num_qcstat_conv(2,profiler,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'profiler',ob_vars(1),iv%info(profiler)%lat(k,n),iv%info(profiler)%lon(k,n),0.01*iv%profiler(n)%p(k) + end if end if end if end if @@ -77,8 +83,10 @@ subroutine da_check_max_iv_profiler(iv, it, num_qcstat_conv) num_qcstat_conv(1,profiler,2,ipr) = num_qcstat_conv(1,profiler,2,ipr) + 1 if(failed)then num_qcstat_conv(2,profiler,2,ipr) = num_qcstat_conv(2,profiler,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'profiler',ob_vars(2),iv%info(profiler)%lat(k,n),iv%info(profiler)%lon(k,n),0.01*iv%profiler(n)%p(k) + end if end if end if end if @@ -115,11 +123,15 @@ subroutine da_check_max_iv_profiler(iv, it, num_qcstat_conv) if(failed1 .or. failed2) then num_qcstat_conv(2,profiler,1,ipr) = num_qcstat_conv(2,profiler,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'profiler',ob_vars(1),iv%info(profiler)%lat(k,n),iv%info(profiler)%lon(k,n),0.01*iv%profiler(n)%p(k) + end if num_qcstat_conv(2,profiler,2,ipr) = num_qcstat_conv(2,profiler,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'profiler',ob_vars(2),iv%info(profiler)%lat(k,n),iv%info(profiler)%lon(k,n),0.01*iv%profiler(n)%p(k) + end if endif endif diff --git a/var/da/da_profiler/da_profiler.f90 b/var/da/da_profiler/da_profiler.f90 index 3747301da3..0d8268a12b 100644 --- a/var/da/da_profiler/da_profiler.f90 +++ b/var/da/da_profiler/da_profiler.f90 @@ -9,7 +9,7 @@ module da_profiler max_stheight_diff, anal_type_verify, kms,kme,kts,kte, trace_use_dull,& ob_vars, qcstat_conv_unit, & convert_fd2uv,convert_uv2fd,max_error_spd,max_error_dir,max_omb_spd,max_omb_dir,pi,qc_rej_both,& - wind_sd_profiler, wind_stats_sd + wind_sd_profiler, wind_stats_sd, write_rej_obs_conv use da_grid_definitions, only : da_ffdduv,da_ffdduv_model, da_ffdduv_diagnose use da_physics, only : da_uv_to_sd_lin, da_uv_to_sd_adj use da_define_structures, only : maxmin_type, iv_type, y_type, jo_type, & diff --git a/var/da/da_qscat/da_check_max_iv_qscat.inc b/var/da/da_qscat/da_check_max_iv_qscat.inc index 2588e57f0c..44b1337fb2 100644 --- a/var/da/da_qscat/da_check_max_iv_qscat.inc +++ b/var/da/da_qscat/da_check_max_iv_qscat.inc @@ -32,8 +32,10 @@ subroutine da_check_max_iv_qscat(iv, it, num_qcstat_conv) num_qcstat_conv(1,qscat,1,1) = num_qcstat_conv(1,qscat,1,1) + 1 if(failed) then num_qcstat_conv(2,qscat,1,1) = num_qcstat_conv(2,qscat,1,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,2f12.2,a12)')& 'qscat',ob_vars(1),iv%info(qscat)%lat(1,n),iv%info(qscat)%lon(1,n),'1013.25' + end if end if end if end if @@ -45,8 +47,10 @@ subroutine da_check_max_iv_qscat(iv, it, num_qcstat_conv) num_qcstat_conv(1,qscat,2,1) = num_qcstat_conv(1,qscat,2,1) + 1 if(failed)then num_qcstat_conv(2,qscat,2,1) = num_qcstat_conv(2,qscat,2,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,2f12.2,a12)')& 'qscat',ob_vars(2),iv%info(qscat)%lat(1,n),iv%info(qscat)%lon(1,n),'1013.25' + end if end if end if end if @@ -59,8 +63,10 @@ subroutine da_check_max_iv_qscat(iv, it, num_qcstat_conv) num_qcstat_conv(1,qscat,1,1) = num_qcstat_conv(1,qscat,1,1) + 1 if(failed) then num_qcstat_conv(2,qscat,1,1) = num_qcstat_conv(2,qscat,1,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,2f12.2,a12)')& 'qscat',ob_vars(1),iv%info(qscat)%lat(1,n),iv%info(qscat)%lon(1,n),'1013.25' + end if end if end if end if @@ -71,8 +77,10 @@ subroutine da_check_max_iv_qscat(iv, it, num_qcstat_conv) num_qcstat_conv(1,qscat,2,1) = num_qcstat_conv(1,qscat,2,1) + 1 if(failed)then num_qcstat_conv(2,qscat,2,1) = num_qcstat_conv(2,qscat,2,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,2f12.2,a12)')& 'qscat',ob_vars(2),iv%info(qscat)%lat(1,n),iv%info(qscat)%lon(1,n),'1013.25' + end if end if end if end if @@ -109,11 +117,15 @@ subroutine da_check_max_iv_qscat(iv, it, num_qcstat_conv) if(failed1 .or. failed2) then num_qcstat_conv(2,qscat,1,1) = num_qcstat_conv(2,qscat,1,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,2f12.2,a12)')& 'qscat',ob_vars(1),iv%info(qscat)%lat(1,n),iv%info(qscat)%lon(1,n),'1013.25' + end if num_qcstat_conv(2,qscat,2,1) = num_qcstat_conv(2,qscat,2,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,2f12.2,a12)')& 'qscat',ob_vars(2),iv%info(qscat)%lat(1,n),iv%info(qscat)%lon(1,n),'1013.25' + end if end if end if end if diff --git a/var/da/da_qscat/da_qscat.f90 b/var/da/da_qscat/da_qscat.f90 index 6fea3764ab..619b422d9e 100644 --- a/var/da/da_qscat/da_qscat.f90 +++ b/var/da/da_qscat/da_qscat.f90 @@ -10,7 +10,7 @@ module da_qscat max_error_bt, max_error_buv, anal_type_verify, kms,kme,kts,kte,& ob_vars,qcstat_conv_unit, fails_error_max, & convert_fd2uv,convert_uv2fd,max_error_spd,max_error_dir,max_omb_spd,max_omb_dir,pi,qc_rej_both,& - wind_sd_qscat, wind_stats_sd + wind_sd_qscat, wind_stats_sd, write_rej_obs_conv use da_grid_definitions, only : da_ffdduv, da_ffdduv_model, da_ffdduv_diagnose use da_physics, only : da_uv_to_sd_lin, da_uv_to_sd_adj use da_define_structures, only : maxmin_type, iv_type, y_type, jo_type, & diff --git a/var/da/da_rain/da_check_max_iv_rain.inc b/var/da/da_rain/da_check_max_iv_rain.inc index c3128e4a2c..0a6d84c0ca 100644 --- a/var/da/da_rain/da_check_max_iv_rain.inc +++ b/var/da/da_rain/da_check_max_iv_rain.inc @@ -31,8 +31,10 @@ subroutine da_check_max_iv_rain(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,rain,10,1)= num_qcstat_conv(1,rain,10,1) + 1 if (failed) then num_qcstat_conv(2,rain,10,1)= num_qcstat_conv(2,rain,10,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,2f12.2,a12)')& 'Rainfall','Rain',iv%info(rain)%lat(1,n),iv%info(rain)%lon(1,n),'-8888.88' + end if end if end if end if diff --git a/var/da/da_rain/da_rain.f90 b/var/da/da_rain/da_rain.f90 index 77fc73ec66..3be85e1bc3 100644 --- a/var/da/da_rain/da_rain.f90 +++ b/var/da/da_rain/da_rain.f90 @@ -15,7 +15,7 @@ module da_rain max_stheight_diff,missing_data,anal_type_verify, & anal_type_verify,max_ext_its,qcstat_conv_unit,ob_vars, & ids,ide,jds,jde,kds,kde, ims,ime,jms,jme,kms,kme, & - ips,ipe,jps,jpe,kps,kpe,num_fgat_time + ips,ipe,jps,jpe,kps,kpe,num_fgat_time, write_rej_obs_conv use da_define_structures, only : maxmin_type, iv_type, y_type, jo_type, & bad_data_type, x_type, number_type, bad_data_type diff --git a/var/da/da_satem/da_check_max_iv_satem.inc b/var/da/da_satem/da_check_max_iv_satem.inc index 3db0f61c20..35dfdb7315 100644 --- a/var/da/da_satem/da_check_max_iv_satem.inc +++ b/var/da/da_satem/da_check_max_iv_satem.inc @@ -34,8 +34,10 @@ subroutine da_check_max_iv_satem(iv, it, num_qcstat_conv) num_qcstat_conv(1,satem,9,ipr-1) = num_qcstat_conv(1,satem,9,ipr-1) + 1 if (failed) then num_qcstat_conv(2,satem,9,ipr-1) = num_qcstat_conv(2,satem,9,ipr-1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'satem',ob_vars(9),iv%info(satem)%lat(k,n),iv%info(satem)%lon(k,n),0.01*iv%satem(n)%p(k) + end if end if end if end if diff --git a/var/da/da_satem/da_satem.f90 b/var/da/da_satem/da_satem.f90 index f0c00cb8fd..7f25456a17 100644 --- a/var/da/da_satem/da_satem.f90 +++ b/var/da/da_satem/da_satem.f90 @@ -9,7 +9,7 @@ module da_satem max_error_p,max_error_q, check_max_iv_unit,check_max_iv, & max_stheight_diff,missing_data,max_error_bq,max_error_slp, & max_error_bt, max_error_buv, satem,max_error_thickness, above_model_lid,& - ob_vars,qcstat_conv_unit + ob_vars,qcstat_conv_unit, write_rej_obs_conv use da_define_structures, only : maxmin_type, iv_type, y_type, jo_type, & bad_data_type, x_type, number_type, bad_data_type, & diff --git a/var/da/da_ships/da_check_max_iv_ships.inc b/var/da/da_ships/da_check_max_iv_ships.inc index 0d43db7579..fac99a966a 100644 --- a/var/da/da_ships/da_check_max_iv_ships.inc +++ b/var/da/da_ships/da_check_max_iv_ships.inc @@ -34,8 +34,10 @@ subroutine da_check_max_iv_ships(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,ships,1,1) = num_qcstat_conv(1,ships,1,1) + 1 if(failed) then num_qcstat_conv(2,ships,1,1) = num_qcstat_conv(2,ships,1,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'ships',ob_vars(1),iv%info(ships)%lat(1,n),iv%info(ships)%lon(1,n),0.01*ob%ships(n)%p + end if end if end if end if @@ -47,8 +49,10 @@ subroutine da_check_max_iv_ships(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,ships,2,1) = num_qcstat_conv(1,ships,2,1) + 1 if(failed)then num_qcstat_conv(2,ships,2,1) = num_qcstat_conv(2,ships,2,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'ships',ob_vars(2),iv%info(ships)%lat(1,n),iv%info(ships)%lon(1,n),0.01*ob%ships(n)%p + end if end if end if end if @@ -62,8 +66,10 @@ subroutine da_check_max_iv_ships(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,ships,1,1) = num_qcstat_conv(1,ships,1,1) + 1 if(failed) then num_qcstat_conv(2,ships,1,1) = num_qcstat_conv(2,ships,1,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'ships',ob_vars(1),iv%info(ships)%lat(1,n),iv%info(ships)%lon(1,n),0.01*ob%ships(n)%p + end if end if end if end if @@ -74,8 +80,10 @@ subroutine da_check_max_iv_ships(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,ships,2,1) = num_qcstat_conv(1,ships,2,1) + 1 if(failed)then num_qcstat_conv(2,ships,2,1) = num_qcstat_conv(2,ships,2,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'ships',ob_vars(2),iv%info(ships)%lat(1,n),iv%info(ships)%lon(1,n),0.01*ob%ships(n)%p + end if end if end if end if @@ -110,11 +118,15 @@ subroutine da_check_max_iv_ships(iv,ob, it, num_qcstat_conv) if(failed1 .or. failed2) then num_qcstat_conv(2,ships,1,1) = num_qcstat_conv(2,ships,1,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'ships',ob_vars(1),iv%info(ships)%lat(1,n),iv%info(ships)%lon(1,n),0.01*ob%ships(n)%p + end if num_qcstat_conv(2,ships,2,1) = num_qcstat_conv(2,ships,2,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'ships',ob_vars(2),iv%info(ships)%lat(1,n),iv%info(ships)%lon(1,n),0.01*ob%ships(n)%p + end if endif endif @@ -143,11 +155,13 @@ subroutine da_check_max_iv_ships(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,ships,3,1)= num_qcstat_conv(1,ships,3,1) + 1 if(failed) then num_qcstat_conv(2,ships,3,1)= num_qcstat_conv(2,ships,3,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'ships',ob_vars(3),iv%info(ships)%lat(1,n),iv%info(ships)%lon(1,n),0.01*ob%ships(n)%p end if end if end if + end if failed=.false. if( iv%ships(n)%p%qc >= obs_qc_pointer ) then @@ -156,11 +170,13 @@ subroutine da_check_max_iv_ships(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,ships,5,1)= num_qcstat_conv(1,ships,5,1) + 1 if(failed) then num_qcstat_conv(2,ships,5,1)= num_qcstat_conv(2,ships,5,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'ships',ob_vars(5),iv%info(ships)%lat(1,n),iv%info(ships)%lon(1,n),0.01*ob%ships(n)%p end if end if end if + end if failed=.false. if( iv%ships(n)%q%qc >= obs_qc_pointer ) then @@ -175,10 +191,12 @@ subroutine da_check_max_iv_ships(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,ships,4,1)= num_qcstat_conv(1,ships,4,1) + 1 if(failed) then num_qcstat_conv(2,ships,4,1)= num_qcstat_conv(2,ships,4,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'ships',ob_vars(4),iv%info(ships)%lat(1,n),iv%info(ships)%lon(1,n),0.01*ob%ships(n)%p end if end if + end if end if end do diff --git a/var/da/da_ships/da_ships.f90 b/var/da/da_ships/da_ships.f90 index 4e1d6dd5bd..86c9e9db4e 100644 --- a/var/da/da_ships/da_ships.f90 +++ b/var/da/da_ships/da_ships.f90 @@ -12,7 +12,7 @@ module da_ships qcstat_conv_unit,ob_vars, & convert_fd2uv, convert_uv2fd, max_error_spd, max_error_dir, & max_omb_spd, max_omb_dir, pi, qc_rej_both, & - wind_sd_ships, wind_stats_sd + wind_sd_ships, wind_stats_sd, write_rej_obs_conv use da_grid_definitions, only : da_ffdduv, da_ffdduv_model, da_ffdduv_diagnose use da_define_structures, only : maxmin_type, iv_type, y_type, jo_type, & bad_data_type, x_type, number_type, bad_data_type diff --git a/var/da/da_sound/da_check_max_iv_sonde_sfc.inc b/var/da/da_sound/da_check_max_iv_sonde_sfc.inc index 99a728fbd2..bf6e9d0801 100644 --- a/var/da/da_sound/da_check_max_iv_sonde_sfc.inc +++ b/var/da/da_sound/da_check_max_iv_sonde_sfc.inc @@ -35,8 +35,10 @@ subroutine da_check_max_iv_sonde_sfc(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,sonde_sfc,1,1) = num_qcstat_conv(1,sonde_sfc,1,1) + 1 if(failed) then num_qcstat_conv(2,sonde_sfc,1,1) = num_qcstat_conv(2,sonde_sfc,1,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'sonde_sfc',ob_vars(1),iv%info(sonde_sfc)%lat(1,n),iv%info(sonde_sfc)%lon(1,n),0.01*ob%sonde_sfc(n)%p + end if end if end if end if @@ -48,8 +50,10 @@ subroutine da_check_max_iv_sonde_sfc(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,sonde_sfc,2,1) = num_qcstat_conv(1,sonde_sfc,2,1) + 1 if(failed)then num_qcstat_conv(2,sonde_sfc,2,1) = num_qcstat_conv(2,sonde_sfc,2,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'sonde_sfc',ob_vars(2),iv%info(sonde_sfc)%lat(1,n),iv%info(sonde_sfc)%lon(1,n),0.01*ob%sonde_sfc(n)%p + end if end if end if end if @@ -61,8 +65,10 @@ subroutine da_check_max_iv_sonde_sfc(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,sonde_sfc,1,1) = num_qcstat_conv(1,sonde_sfc,1,1) + 1 if(failed) then num_qcstat_conv(2,sonde_sfc,1,1) = num_qcstat_conv(2,sonde_sfc,1,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'sonde_sfc',ob_vars(1),iv%info(sonde_sfc)%lat(1,n),iv%info(sonde_sfc)%lon(1,n),0.01*ob%sonde_sfc(n)%p + end if end if end if end if @@ -74,8 +80,10 @@ subroutine da_check_max_iv_sonde_sfc(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,sonde_sfc,2,1) = num_qcstat_conv(1,sonde_sfc,2,1) + 1 if(failed)then num_qcstat_conv(2,sonde_sfc,2,1) = num_qcstat_conv(2,sonde_sfc,2,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'sonde_sfc',ob_vars(2),iv%info(sonde_sfc)%lat(1,n),iv%info(sonde_sfc)%lon(1,n),0.01*ob%sonde_sfc(n)%p + end if end if end if end if @@ -110,11 +118,15 @@ subroutine da_check_max_iv_sonde_sfc(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,sonde_sfc,2,1) = num_qcstat_conv(1,sonde_sfc,2,1) + 1 if(failed1 .or. failed2) then num_qcstat_conv(2,sonde_sfc,1,1) = num_qcstat_conv(2,sonde_sfc,1,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'sonde_sfc',ob_vars(1),iv%info(sonde_sfc)%lat(1,n),iv%info(sonde_sfc)%lon(1,n),0.01*ob%sonde_sfc(n)%p + end if num_qcstat_conv(2,sonde_sfc,2,1) = num_qcstat_conv(2,sonde_sfc,2,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'sonde_sfc',ob_vars(2),iv%info(sonde_sfc)%lat(1,n),iv%info(sonde_sfc)%lon(1,n),0.01*ob%sonde_sfc(n)%p + end if endif endif @@ -143,11 +155,13 @@ subroutine da_check_max_iv_sonde_sfc(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,sonde_sfc,3,1)= num_qcstat_conv(1,sonde_sfc,3,1) + 1 if(failed) then num_qcstat_conv(2,sonde_sfc,3,1)= num_qcstat_conv(2,sonde_sfc,3,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'sonde_sfc',ob_vars(3),iv%info(sonde_sfc)%lat(1,n),iv%info(sonde_sfc)%lon(1,n),0.01*ob%sonde_sfc(n)%p end if end if end if + end if failed=.false. if( iv%sonde_sfc(n)%p%qc >= obs_qc_pointer ) then @@ -156,11 +170,13 @@ subroutine da_check_max_iv_sonde_sfc(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,sonde_sfc,5,1)= num_qcstat_conv(1,sonde_sfc,5,1) + 1 if(failed) then num_qcstat_conv(2,sonde_sfc,5,1)= num_qcstat_conv(2,sonde_sfc,5,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'sonde_sfc',ob_vars(5),iv%info(sonde_sfc)%lat(1,n),iv%info(sonde_sfc)%lon(1,n),0.01*ob%sonde_sfc(n)%p end if end if end if + end if failed=.false. if( iv%sonde_sfc(n)%q%qc >= obs_qc_pointer ) then @@ -175,10 +191,12 @@ subroutine da_check_max_iv_sonde_sfc(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,sonde_sfc,4,1)= num_qcstat_conv(1,sonde_sfc,4,1) + 1 if(failed) then num_qcstat_conv(2,sonde_sfc,4,1)= num_qcstat_conv(2,sonde_sfc,4,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'sonde_sfc',ob_vars(4),iv%info(sonde_sfc)%lat(1,n),iv%info(sonde_sfc)%lon(1,n),0.01*ob%sonde_sfc(n)%p end if end if + end if end if end do diff --git a/var/da/da_sound/da_check_max_iv_sound.inc b/var/da/da_sound/da_check_max_iv_sound.inc index aa90dcc97a..8e8a2ce9f3 100644 --- a/var/da/da_sound/da_check_max_iv_sound.inc +++ b/var/da/da_sound/da_check_max_iv_sound.inc @@ -35,8 +35,10 @@ subroutine da_check_max_iv_sound(iv, it,num_qcstat_conv) num_qcstat_conv(1,sound,1,ipr) = num_qcstat_conv(1,sound,1,ipr) + 1 if(failed) then num_qcstat_conv(2,sound,1,ipr) = num_qcstat_conv(2,sound,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'sound',ob_vars(1),iv%info(sound)%lat(k,n),iv%info(sound)%lon(k,n),0.01*iv%sound(n)%p(k) + end if end if end if end if @@ -48,8 +50,10 @@ subroutine da_check_max_iv_sound(iv, it,num_qcstat_conv) num_qcstat_conv(1,sound,2,ipr) = num_qcstat_conv(1,sound,2,ipr) + 1 if(failed)then num_qcstat_conv(2,sound,2,ipr) = num_qcstat_conv(2,sound,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'sound',ob_vars(2),iv%info(sound)%lat(k,n),iv%info(sound)%lon(k,n),0.01*iv%sound(n)%p(k) + end if end if end if end if @@ -61,8 +65,10 @@ subroutine da_check_max_iv_sound(iv, it,num_qcstat_conv) num_qcstat_conv(1,sound,1,ipr) = num_qcstat_conv(1,sound,1,ipr) + 1 if(failed) then num_qcstat_conv(2,sound,1,ipr) = num_qcstat_conv(2,sound,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'sound',ob_vars(1),iv%info(sound)%lat(k,n),iv%info(sound)%lon(k,n),0.01*iv%sound(n)%p(k) + end if end if end if end if @@ -74,8 +80,10 @@ subroutine da_check_max_iv_sound(iv, it,num_qcstat_conv) num_qcstat_conv(1,sound,2,ipr) = num_qcstat_conv(1,sound,2,ipr) + 1 if(failed)then num_qcstat_conv(2,sound,2,ipr) = num_qcstat_conv(2,sound,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'sound',ob_vars(2),iv%info(sound)%lat(k,n),iv%info(sound)%lon(k,n),0.01*iv%sound(n)%p(k) + end if end if end if end if @@ -111,11 +119,15 @@ subroutine da_check_max_iv_sound(iv, it,num_qcstat_conv) if(failed1 .or. failed2) then num_qcstat_conv(2,sound,1,ipr) = num_qcstat_conv(2,sound,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'sound',ob_vars(1),iv%info(sound)%lat(k,n),iv%info(sound)%lon(k,n),0.01*iv%sound(n)%p(k) + end if num_qcstat_conv(2,sound,2,ipr) = num_qcstat_conv(2,sound,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'sound',ob_vars(2),iv%info(sound)%lat(k,n),iv%info(sound)%lon(k,n),0.01*iv%sound(n)%p(k) + end if endif endif @@ -145,8 +157,10 @@ subroutine da_check_max_iv_sound(iv, it,num_qcstat_conv) num_qcstat_conv(1,sound,3,ipr) = num_qcstat_conv(1,sound,3,ipr) + 1 if(failed) then num_qcstat_conv(2,sound,3,ipr) = num_qcstat_conv(2,sound,3,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'sound',ob_vars(3),iv%info(sound)%lat(k,n),iv%info(sound)%lon(k,n),0.01*iv%sound(n)%p(k) + end if end if end if end if @@ -164,8 +178,10 @@ subroutine da_check_max_iv_sound(iv, it,num_qcstat_conv) num_qcstat_conv(1,sound,4,ipr) = num_qcstat_conv(1,sound,4,ipr) + 1 if(failed) then num_qcstat_conv(2,sound,4,ipr) = num_qcstat_conv(2,sound,4,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'sound',ob_vars(4),iv%info(sound)%lat(k,n),iv%info(sound)%lon(k,n),0.01*iv%sound(n)%p(k) + end if end if end if end if diff --git a/var/da/da_sound/da_sound.f90 b/var/da/da_sound/da_sound.f90 index f64edcb43d..fd6963bba2 100644 --- a/var/da/da_sound/da_sound.f90 +++ b/var/da/da_sound/da_sound.f90 @@ -10,7 +10,7 @@ module da_sound kms,kme,kts,kte,sfc_assi_options_1,sfc_assi_options_2, num_procs, comm, & trace_use_dull, sound, sonde_sfc, position_lev_dependant, max_ext_its,qcstat_conv_unit,ob_vars, & convert_fd2uv,convert_uv2fd,max_error_spd,max_error_dir,max_omb_spd,max_omb_dir,pi,qc_rej_both, & - wind_sd_sound, wind_stats_sd + wind_sd_sound, wind_stats_sd, write_rej_obs_conv use da_grid_definitions, only : da_ffdduv,da_ffdduv_model, da_ffdduv_diagnose #ifdef DM_PARALLEL diff --git a/var/da/da_ssmi/da_check_max_iv_ssmi_rv.inc b/var/da/da_ssmi/da_check_max_iv_ssmi_rv.inc index e09077eeaa..2f3ab549b9 100644 --- a/var/da/da_ssmi/da_check_max_iv_ssmi_rv.inc +++ b/var/da/da_ssmi/da_check_max_iv_ssmi_rv.inc @@ -31,8 +31,10 @@ subroutine da_check_max_iv_ssmi_rv(iv, it, num_qcstat_conv) num_qcstat_conv(1,ssmi_rv,7,1) = num_qcstat_conv(1,ssmi_rv,7,1) + 1 if(failed) then num_qcstat_conv(2,ssmi_rv,7,1) = num_qcstat_conv(2,ssmi_rv,7,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,2f12.2,a12)')& 'ssmi_rv',ob_vars(7),iv%info(ssmi_rv)%lat(1,n),iv%info(ssmi_rv)%lon(1,n),'1013.25' + end if end if end if end if @@ -44,8 +46,10 @@ subroutine da_check_max_iv_ssmi_rv(iv, it, num_qcstat_conv) num_qcstat_conv(1,ssmi_rv,6,1) = num_qcstat_conv(1,ssmi_rv,6,1) + 1 if(failed)then num_qcstat_conv(2,ssmi_rv,6,1) = num_qcstat_conv(2,ssmi_rv,6,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,2f12.2,a12)')& 'ssmi_rv',ob_vars(6),iv%info(ssmi_rv)%lat(1,n),iv%info(ssmi_rv)%lon(1,n),'1013.25' + endif endif end if end if diff --git a/var/da/da_ssmi/da_check_max_iv_ssmt1.inc b/var/da/da_ssmi/da_check_max_iv_ssmt1.inc index e3806f6cbd..d5ebfaa2d5 100644 --- a/var/da/da_ssmi/da_check_max_iv_ssmt1.inc +++ b/var/da/da_ssmi/da_check_max_iv_ssmt1.inc @@ -35,11 +35,13 @@ subroutine da_check_max_iv_ssmt1(iv, it, num_qcstat_conv) num_qcstat_conv(1,ssmt1,3,ipr) = num_qcstat_conv(1,ssmt1,3,ipr) + 1 if(failed) then num_qcstat_conv(2,ssmt1,3,ipr) = num_qcstat_conv(2,ssmt1,3,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'ssmt1',ob_vars(3),iv%info(ssmt1)%lat(k,n),iv%info(ssmt1)%lon(k,n),0.01*iv%ssmt1(n)%p(k) endif endif endif + endif end do end do diff --git a/var/da/da_ssmi/da_check_max_iv_ssmt2.inc b/var/da/da_ssmi/da_check_max_iv_ssmt2.inc index 1bfbc556af..c7ddf7aa3e 100644 --- a/var/da/da_ssmi/da_check_max_iv_ssmt2.inc +++ b/var/da/da_ssmi/da_check_max_iv_ssmt2.inc @@ -35,11 +35,13 @@ subroutine da_check_max_iv_ssmt2(iv, it, num_qcstat_conv) num_qcstat_conv(1,ssmt2,4,ipr) = num_qcstat_conv(1,ssmt2,4,ipr) + 1 if(failed)then num_qcstat_conv(2,ssmt2,4,ipr) = num_qcstat_conv(2,ssmt2,4,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'ssmt2',ob_vars(4),iv%info(ssmt2)%lat(k,n),iv%info(ssmt2)%lon(k,n),0.01*iv%ssmt2(n)%p(k) endif endif endif + endif end do end do diff --git a/var/da/da_ssmi/da_ssmi.f90 b/var/da/da_ssmi/da_ssmi.f90 index 7d209ae6ea..a41bb54a92 100644 --- a/var/da/da_ssmi/da_ssmi.f90 +++ b/var/da/da_ssmi/da_ssmi.f90 @@ -15,7 +15,8 @@ module da_ssmi test_transforms,stdout, use_ssmiretrievalobs, use_ssmitbobs, & global, print_detail_obs, max_ssmi_rv_input, max_ssmi_tb_input, & its,ite,jts,jte,kts,kte,kms,kme,ids,ide,jds,jde,fails_error_max, & - ssmi_tb, ssmi_rv, num_ob_indexes, ssmt1, ssmt2, ob_vars,qcstat_conv_unit + ssmi_tb, ssmi_rv, num_ob_indexes, ssmt1, ssmt2, ob_vars,qcstat_conv_unit, & + write_rej_obs_conv use da_define_structures, only : maxmin_type, iv_type, y_type, jo_type, & bad_data_type, x_type, number_type, bad_data_type, & maxmin_type,residual_ssmi_rv_type, & diff --git a/var/da/da_synop/da_check_max_iv_synop.inc b/var/da/da_synop/da_check_max_iv_synop.inc index 83a29148ae..0dab74af81 100644 --- a/var/da/da_synop/da_check_max_iv_synop.inc +++ b/var/da/da_synop/da_check_max_iv_synop.inc @@ -34,8 +34,10 @@ subroutine da_check_max_iv_synop(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,synop,1,1) = num_qcstat_conv(1,synop,1,1) + 1 if(failed) then num_qcstat_conv(2,synop,1,1) = num_qcstat_conv(2,synop,1,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'synop',ob_vars(1),iv%info(synop)%lat(1,n),iv%info(synop)%lon(1,n),0.01*ob%synop(n)%p + end if end if end if end if @@ -47,8 +49,10 @@ subroutine da_check_max_iv_synop(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,synop,2,1) = num_qcstat_conv(1,synop,2,1) + 1 if(failed)then num_qcstat_conv(2,synop,2,1) = num_qcstat_conv(2,synop,2,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'synop',ob_vars(2),iv%info(synop)%lat(1,n),iv%info(synop)%lon(1,n),0.01*ob%synop(n)%p + end if end if end if end if @@ -60,8 +64,10 @@ subroutine da_check_max_iv_synop(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,synop,1,1) = num_qcstat_conv(1,synop,1,1) + 1 if(failed) then num_qcstat_conv(2,synop,1,1) = num_qcstat_conv(2,synop,1,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'synop',ob_vars(1),iv%info(synop)%lat(1,n),iv%info(synop)%lon(1,n),0.01*ob%synop(n)%p + end if end if end if end if @@ -73,8 +79,10 @@ subroutine da_check_max_iv_synop(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,synop,2,1) = num_qcstat_conv(1,synop,2,1) + 1 if(failed)then num_qcstat_conv(2,synop,2,1) = num_qcstat_conv(2,synop,2,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'synop',ob_vars(2),iv%info(synop)%lat(1,n),iv%info(synop)%lon(1,n),0.01*ob%synop(n)%p + end if end if end if end if @@ -110,11 +118,15 @@ subroutine da_check_max_iv_synop(iv,ob, it, num_qcstat_conv) if(failed1 .or. failed2) then num_qcstat_conv(2,synop,1,1) = num_qcstat_conv(2,synop,1,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'synop',ob_vars(1),iv%info(synop)%lat(1,n),iv%info(synop)%lon(1,n),0.01*ob%synop(n)%p + end if num_qcstat_conv(2,synop,2,1) = num_qcstat_conv(2,synop,2,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'synop',ob_vars(2),iv%info(synop)%lat(1,n),iv%info(synop)%lon(1,n),0.01*ob%synop(n)%p + end if endif endif @@ -144,11 +156,13 @@ subroutine da_check_max_iv_synop(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,synop,3,1)= num_qcstat_conv(1,synop,3,1) + 1 if(failed) then num_qcstat_conv(2,synop,3,1)= num_qcstat_conv(2,synop,3,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'synop',ob_vars(3),iv%info(synop)%lat(1,n),iv%info(synop)%lon(1,n),0.01*ob%synop(n)%p end if end if end if + end if failed=.false. if( iv%synop(n)%p%qc >= obs_qc_pointer ) then @@ -157,11 +171,13 @@ subroutine da_check_max_iv_synop(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,synop,5,1)= num_qcstat_conv(1,synop,5,1) + 1 if(failed) then num_qcstat_conv(2,synop,5,1)= num_qcstat_conv(2,synop,5,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'synop',ob_vars(5),iv%info(synop)%lat(1,n),iv%info(synop)%lon(1,n),0.01*ob%synop(n)%p end if end if end if + end if failed=.false. if( iv%synop(n)%q%qc >= obs_qc_pointer ) then @@ -176,10 +192,12 @@ subroutine da_check_max_iv_synop(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,synop,4,1)= num_qcstat_conv(1,synop,4,1) + 1 if(failed) then num_qcstat_conv(2,synop,4,1)= num_qcstat_conv(2,synop,4,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'synop',ob_vars(4),iv%info(synop)%lat(1,n),iv%info(synop)%lon(1,n),0.01*ob%synop(n)%p end if end if + end if end if end do diff --git a/var/da/da_synop/da_synop.f90 b/var/da/da_synop/da_synop.f90 index 0d18ec149a..e401773b22 100644 --- a/var/da/da_synop/da_synop.f90 +++ b/var/da/da_synop/da_synop.f90 @@ -13,7 +13,7 @@ module da_synop trace_use_dull, synop, max_ext_its,qcstat_conv_unit,ob_vars, & convert_fd2uv, convert_uv2fd, max_error_spd, max_error_dir, & max_omb_spd, max_omb_dir, pi, qc_rej_both, & - wind_sd_synop, wind_stats_sd + wind_sd_synop, wind_stats_sd, write_rej_obs_conv use da_control, only : surface_correction, sfc_hori_intp_options, & q_error_options, sfcht_adjust_q, obs_err_inflate, stn_ht_diff_scale use da_grid_definitions, only : da_ffdduv, da_ffdduv_model, da_ffdduv_diagnose diff --git a/var/da/da_tamdar/da_check_max_iv_tamdar.inc b/var/da/da_tamdar/da_check_max_iv_tamdar.inc index b0b1b4759b..301b69e62e 100644 --- a/var/da/da_tamdar/da_check_max_iv_tamdar.inc +++ b/var/da/da_tamdar/da_check_max_iv_tamdar.inc @@ -35,8 +35,10 @@ subroutine da_check_max_iv_tamdar(iv, it,num_qcstat_conv) num_qcstat_conv(1,tamdar,1,ipr) = num_qcstat_conv(1,tamdar,1,ipr) + 1 if(failed) then num_qcstat_conv(2,tamdar,1,ipr) = num_qcstat_conv(2,tamdar,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'tamdar',ob_vars(1),iv%info(tamdar)%lat(k,n),iv%info(tamdar)%lon(k,n),0.01*iv%tamdar(n)%p(k) + end if end if end if end if @@ -48,8 +50,10 @@ subroutine da_check_max_iv_tamdar(iv, it,num_qcstat_conv) num_qcstat_conv(1,tamdar,2,ipr) = num_qcstat_conv(1,tamdar,2,ipr) + 1 if(failed)then num_qcstat_conv(2,tamdar,2,ipr) = num_qcstat_conv(2,tamdar,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'tamdar',ob_vars(2),iv%info(tamdar)%lat(k,n),iv%info(tamdar)%lon(k,n),0.01*iv%tamdar(n)%p(k) + end if end if end if end if @@ -61,8 +65,10 @@ subroutine da_check_max_iv_tamdar(iv, it,num_qcstat_conv) num_qcstat_conv(1,tamdar,1,ipr) = num_qcstat_conv(1,tamdar,1,ipr) + 1 if(failed) then num_qcstat_conv(2,tamdar,1,ipr) = num_qcstat_conv(2,tamdar,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'tamdar',ob_vars(1),iv%info(tamdar)%lat(k,n),iv%info(tamdar)%lon(k,n),0.01*iv%tamdar(n)%p(k) + end if end if end if end if @@ -74,8 +80,10 @@ subroutine da_check_max_iv_tamdar(iv, it,num_qcstat_conv) num_qcstat_conv(1,tamdar,2,ipr) = num_qcstat_conv(1,tamdar,2,ipr) + 1 if(failed)then num_qcstat_conv(2,tamdar,2,ipr) = num_qcstat_conv(2,tamdar,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'tamdar',ob_vars(2),iv%info(tamdar)%lat(k,n),iv%info(tamdar)%lon(k,n),0.01*iv%tamdar(n)%p(k) + end if end if end if end if @@ -111,11 +119,15 @@ subroutine da_check_max_iv_tamdar(iv, it,num_qcstat_conv) if(failed1 .or. failed2) then num_qcstat_conv(2,tamdar,1,ipr) = num_qcstat_conv(2,tamdar,1,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'tamdar',ob_vars(1),iv%info(tamdar)%lat(k,n),iv%info(tamdar)%lon(k,n),0.01*iv%tamdar(n)%p(k) + end if num_qcstat_conv(2,tamdar,2,ipr) = num_qcstat_conv(2,tamdar,2,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'tamdar',ob_vars(2),iv%info(tamdar)%lat(k,n),iv%info(tamdar)%lon(k,n),0.01*iv%tamdar(n)%p(k) + end if endif endif @@ -144,8 +156,10 @@ subroutine da_check_max_iv_tamdar(iv, it,num_qcstat_conv) num_qcstat_conv(1,tamdar,3,ipr) = num_qcstat_conv(1,tamdar,3,ipr) + 1 if(failed) then num_qcstat_conv(2,tamdar,3,ipr) = num_qcstat_conv(2,tamdar,3,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'tamdar',ob_vars(3),iv%info(tamdar)%lat(k,n),iv%info(tamdar)%lon(k,n),0.01*iv%tamdar(n)%p(k) + end if end if end if end if @@ -163,8 +177,10 @@ subroutine da_check_max_iv_tamdar(iv, it,num_qcstat_conv) num_qcstat_conv(1,tamdar,4,ipr) = num_qcstat_conv(1,tamdar,4,ipr) + 1 if(failed) then num_qcstat_conv(2,tamdar,4,ipr) = num_qcstat_conv(2,tamdar,4,ipr) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'tamdar',ob_vars(4),iv%info(tamdar)%lat(k,n),iv%info(tamdar)%lon(k,n),0.01*iv%tamdar(n)%p(k) + end if end if end if end if diff --git a/var/da/da_tamdar/da_check_max_iv_tamdar_sfc.inc b/var/da/da_tamdar/da_check_max_iv_tamdar_sfc.inc index c8682470a0..d8d5ad624f 100644 --- a/var/da/da_tamdar/da_check_max_iv_tamdar_sfc.inc +++ b/var/da/da_tamdar/da_check_max_iv_tamdar_sfc.inc @@ -35,8 +35,10 @@ subroutine da_check_max_iv_tamdar_sfc(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,tamdar_sfc,1,1) = num_qcstat_conv(1,tamdar_sfc,1,1) + 1 if(failed) then num_qcstat_conv(2,tamdar_sfc,1,1) = num_qcstat_conv(2,tamdar_sfc,1,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'tamdar_sfc',ob_vars(1),iv%info(tamdar_sfc)%lat(1,n),iv%info(tamdar_sfc)%lon(1,n),0.01*ob%tamdar_sfc(n)%p + end if end if end if end if @@ -48,8 +50,10 @@ subroutine da_check_max_iv_tamdar_sfc(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,tamdar_sfc,2,1) = num_qcstat_conv(1,tamdar_sfc,2,1) + 1 if(failed)then num_qcstat_conv(2,tamdar_sfc,2,1) = num_qcstat_conv(2,tamdar_sfc,2,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'tamdar_sfc',ob_vars(2),iv%info(tamdar_sfc)%lat(1,n),iv%info(tamdar_sfc)%lon(1,n),0.01*ob%tamdar_sfc(n)%p + end if end if end if end if @@ -61,8 +65,10 @@ subroutine da_check_max_iv_tamdar_sfc(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,tamdar_sfc,1,1) = num_qcstat_conv(1,tamdar_sfc,1,1) + 1 if(failed) then num_qcstat_conv(2,tamdar_sfc,1,1) = num_qcstat_conv(2,tamdar_sfc,1,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'tamdar_sfc',ob_vars(1),iv%info(tamdar_sfc)%lat(1,n),iv%info(tamdar_sfc)%lon(1,n),0.01*ob%tamdar_sfc(n)%p + end if end if end if end if @@ -74,8 +80,10 @@ subroutine da_check_max_iv_tamdar_sfc(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,tamdar_sfc,2,1) = num_qcstat_conv(1,tamdar_sfc,2,1) + 1 if(failed)then num_qcstat_conv(2,tamdar_sfc,2,1) = num_qcstat_conv(2,tamdar_sfc,2,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'tamdar_sfc',ob_vars(2),iv%info(tamdar_sfc)%lat(1,n),iv%info(tamdar_sfc)%lon(1,n),0.01*ob%tamdar_sfc(n)%p + end if end if end if end if @@ -111,11 +119,15 @@ subroutine da_check_max_iv_tamdar_sfc(iv,ob, it, num_qcstat_conv) if(failed1 .or. failed2) then num_qcstat_conv(2,tamdar_sfc,1,1) = num_qcstat_conv(2,tamdar_sfc,1,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'tamdar_sfc',ob_vars(1),iv%info(tamdar_sfc)%lat(1,n),iv%info(tamdar_sfc)%lon(1,n),0.01*ob%tamdar_sfc(n)%p + end if num_qcstat_conv(2,tamdar_sfc,2,1) = num_qcstat_conv(2,tamdar_sfc,2,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'tamdar_sfc',ob_vars(2),iv%info(tamdar_sfc)%lat(1,n),iv%info(tamdar_sfc)%lon(1,n),0.01*ob%tamdar_sfc(n)%p + end if endif endif @@ -144,11 +156,13 @@ subroutine da_check_max_iv_tamdar_sfc(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,tamdar_sfc,3,1)= num_qcstat_conv(1,tamdar_sfc,3,1) + 1 if(failed) then num_qcstat_conv(2,tamdar_sfc,3,1)= num_qcstat_conv(2,tamdar_sfc,3,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'tamdar_sfc',ob_vars(3),iv%info(tamdar_sfc)%lat(1,n),iv%info(tamdar_sfc)%lon(1,n),0.01*ob%tamdar_sfc(n)%p end if end if end if + end if failed=.false. if( iv%tamdar_sfc(n)%p%qc >= obs_qc_pointer ) then @@ -157,11 +171,13 @@ subroutine da_check_max_iv_tamdar_sfc(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,tamdar_sfc,5,1)= num_qcstat_conv(1,tamdar_sfc,5,1) + 1 if(failed) then num_qcstat_conv(2,tamdar_sfc,5,1)= num_qcstat_conv(2,tamdar_sfc,5,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'tamdar_sfc',ob_vars(5),iv%info(tamdar_sfc)%lat(1,n),iv%info(tamdar_sfc)%lon(1,n),0.01*ob%tamdar_sfc(n)%p end if end if end if + end if failed=.false. if( iv%tamdar_sfc(n)%q%qc >= obs_qc_pointer ) then @@ -176,11 +192,13 @@ subroutine da_check_max_iv_tamdar_sfc(iv,ob, it, num_qcstat_conv) num_qcstat_conv(1,tamdar_sfc,4,1)= num_qcstat_conv(1,tamdar_sfc,4,1) + 1 if(failed) then num_qcstat_conv(2,tamdar_sfc,4,1)= num_qcstat_conv(2,tamdar_sfc,4,1) + 1 + if ( write_rej_obs_conv ) then write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')& 'tamdar_sfc',ob_vars(4),iv%info(tamdar_sfc)%lat(1,n),iv%info(tamdar_sfc)%lon(1,n),0.01*ob%tamdar_sfc(n)%p end if end if end if + end if end do diff --git a/var/da/da_tamdar/da_tamdar.f90 b/var/da/da_tamdar/da_tamdar.f90 index befe479d41..34e238c1c3 100644 --- a/var/da/da_tamdar/da_tamdar.f90 +++ b/var/da/da_tamdar/da_tamdar.f90 @@ -12,7 +12,7 @@ module da_tamdar trace_use_dull, tamdar, tamdar_sfc, position_lev_dependant, max_ext_its, & qcstat_conv_unit,ob_vars, fails_error_max, & convert_fd2uv,convert_uv2fd,max_error_spd,max_error_dir,max_omb_spd,max_omb_dir,pi,qc_rej_both, & - wind_sd_tamdar, wind_stats_sd + wind_sd_tamdar, wind_stats_sd, write_rej_obs_conv use da_grid_definitions, only : da_ffdduv,da_ffdduv_model, da_ffdduv_diagnose use da_define_structures, only : maxmin_type, iv_type, y_type, jo_type, & bad_data_type, x_type, number_type, bad_data_type From 98b568f46cb09ccc4c20858555f51e9245c72ce6 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Fri, 20 Jul 2018 15:54:55 -0600 Subject: [PATCH 33/91] Fix for mri-4dvar radar io bug introduced in commit b53c3fb (5a0dc81). Remove mistakenly added check condition to make non-radar data types work for both multi_inc_io_opt = 1 and 2. modified: var/da/da_minimisation/da_get_innov_vector.inc --- var/da/da_minimisation/da_get_innov_vector.inc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/var/da/da_minimisation/da_get_innov_vector.inc b/var/da/da_minimisation/da_get_innov_vector.inc index f50b2be5b6..dc9ac19fdb 100644 --- a/var/da/da_minimisation/da_get_innov_vector.inc +++ b/var/da/da_minimisation/da_get_innov_vector.inc @@ -228,7 +228,7 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) call domain_clockprint(150, grid, 'get CurrTime from clock,') end if - if ( multi_inc == 1 .and. multi_inc_io_opt == 1 ) then + if ( multi_inc == 1 ) then #ifdef DM_PARALLEL call mpi_barrier(MPI_COMM_WORLD,ierr) if ( myproc == 0 ) call da_join_iv_for_multi_inc() From 3d0926f4b427ca24ee8bc5cb3edab6c7dd514c37 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Fri, 20 Jul 2018 15:59:32 -0600 Subject: [PATCH 34/91] Fix (again) to assign proper radar rv/rf errors to avoid excessive check_max_iv prints. The previous fix in commit 1d39c22 did not have correct checking logic for missing_r values. modified: var/da/da_obs_io/da_read_obs_radar.inc --- var/da/da_obs_io/da_read_obs_radar.inc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/var/da/da_obs_io/da_read_obs_radar.inc b/var/da/da_obs_io/da_read_obs_radar.inc index 43cfa1c6f8..a4ca5233a5 100644 --- a/var/da/da_obs_io/da_read_obs_radar.inc +++ b/var/da/da_obs_io/da_read_obs_radar.inc @@ -180,12 +180,12 @@ subroutine da_read_obs_radar (iv, filename, grid) platform % each (i) % rf % error if (platform % each (i) % rv % error == 0.0 .or. & - abs(platform % each (i) % rv % error - missing_r) > 1.0) then + abs(platform % each (i) % rv % error - missing_r) < 1.0) then platform % each (i) % rv % error = 1.0 end if if (platform % each (i) % rf % error == 0.0 .or. & - abs(platform % each (i) % rf % error - missing_r) > 1.0) then + abs(platform % each (i) % rf % error - missing_r) < 1.0) then platform % each (i) % rf % error = 1.0 end if From cab83af2822252b79d99e6b2679f30fdd96a5518 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Fri, 20 Jul 2018 16:09:05 -0600 Subject: [PATCH 35/91] Remove a couple unnecessary prints. modified: var/da/da_radar/da_write_oa_radar_ascii.inc modified: var/mri4dvar/da_thin.f90 --- var/da/da_radar/da_write_oa_radar_ascii.inc | 4 ++-- var/mri4dvar/da_thin.f90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/var/da/da_radar/da_write_oa_radar_ascii.inc b/var/da/da_radar/da_write_oa_radar_ascii.inc index d8d91b7213..db8bfd1142 100644 --- a/var/da/da_radar/da_write_oa_radar_ascii.inc +++ b/var/da/da_radar/da_write_oa_radar_ascii.inc @@ -154,8 +154,8 @@ subroutine da_write_oa_radar_ascii ( ob, iv, re, it ) (/"Cannot open file "//trim(filename1(k))/)) read(omb_radar_unit, '(20x,i8)', iostat=ios)num_obs IF(ios /= 0)THEN - write(unit=message(1),fmt='(A,A)') 'Nothing to read from ',filename1(k) - call da_message(message(1:1)) + !write(unit=message(1),fmt='(A,A)') 'Nothing to read from ',filename1(k) + !call da_message(message(1:1)) cycle ENDIF if (num_obs > 0) then diff --git a/var/mri4dvar/da_thin.f90 b/var/mri4dvar/da_thin.f90 index 2127c77a9f..559eced218 100644 --- a/var/mri4dvar/da_thin.f90 +++ b/var/mri4dvar/da_thin.f90 @@ -180,7 +180,7 @@ program da_thin coordinates=char(0) status = nf90_get_att(ncidin, varid, "coordinates" , coordinates) - print *, coordinates + !print *, coordinates stride=(/decimation_factor,decimation_factor,1,1/) From 495d9285047cb1b67d709c9c3743617c661e91f1 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Fri, 20 Jul 2018 16:15:14 -0600 Subject: [PATCH 36/91] Fix for cloud/w BE rescaling for non-first outerloops. In addition to adding cloud and w control variables that were not included in the original rescaling code, a couple other changes are also made in the commit. 1. Only root processor writes out the intermediate file. 2. Change the log message from Jb factor used() to var_scaling used(). modified: var/da/da_minimisation/da_get_var_diagnostics.inc modified: var/da/da_minimisation/da_minimisation.f90 modified: var/da/da_setup_structures/da_scale_background_errors.inc modified: var/da/da_setup_structures/da_setup_be_regional.inc --- .../da_get_var_diagnostics.inc | 20 ++++++--- var/da/da_minimisation/da_minimisation.f90 | 4 +- .../da_scale_background_errors.inc | 41 ++++++++++++++++++- .../da_setup_be_regional.inc | 13 +++++- 4 files changed, 69 insertions(+), 9 deletions(-) diff --git a/var/da/da_minimisation/da_get_var_diagnostics.inc b/var/da/da_minimisation/da_get_var_diagnostics.inc index 9812abb19b..4e1e97d607 100644 --- a/var/da/da_minimisation/da_get_var_diagnostics.inc +++ b/var/da/da_minimisation/da_get_var_diagnostics.inc @@ -219,11 +219,21 @@ subroutine da_get_var_diagnostics(it, iv, j) write(unit=stdout,fmt='(a,f15.5)') ' Final J / total num_obs = ', j % total / & real(num_stats_tot) if (cv_options /= 3) then - write(unit=stdout,fmt='(a,(5f15.5))') ' Jb factor used(1) = ', var_scaling1(it) - write(unit=stdout,fmt='(a,(5f15.5))') ' Jb factor used(2) = ', var_scaling2(it) - write(unit=stdout,fmt='(a,(5f15.5))') ' Jb factor used(3) = ', var_scaling3(it) - write(unit=stdout,fmt='(a,(5f15.5))') ' Jb factor used(4) = ', var_scaling4(it) - write(unit=stdout,fmt='(a,(5f15.5))') ' Jb factor used(5) = ', var_scaling5(it) + write(unit=stdout,fmt='(a,(5f15.5))') ' var_scaling used(1) = ', var_scaling1(it) + write(unit=stdout,fmt='(a,(5f15.5))') ' var_scaling used(2) = ', var_scaling2(it) + write(unit=stdout,fmt='(a,(5f15.5))') ' var_scaling used(3) = ', var_scaling3(it) + write(unit=stdout,fmt='(a,(5f15.5))') ' var_scaling used(4) = ', var_scaling4(it) + write(unit=stdout,fmt='(a,(5f15.5))') ' var_scaling used(5) = ', var_scaling5(it) + if ( cloud_cv_options >= 2 ) then + write(unit=stdout,fmt='(a,(5f15.5))') ' var_scaling used(6) = ', var_scaling6(it) + write(unit=stdout,fmt='(a,(5f15.5))') ' var_scaling used(7) = ', var_scaling7(it) + write(unit=stdout,fmt='(a,(5f15.5))') ' var_scaling used(8) = ', var_scaling8(it) + write(unit=stdout,fmt='(a,(5f15.5))') ' var_scaling used(9) = ', var_scaling9(it) + write(unit=stdout,fmt='(a,(5f15.5))') ' var_scaling used(10) = ', var_scaling10(it) + end if + if ( use_cv_w ) then + write(unit=stdout,fmt='(a,(5f15.5))') ' var_scaling used(11) = ', var_scaling11(it) + end if endif write(unit=stdout,fmt='(a, f15.5)') ' Jb factor used = ', jb_factor diff --git a/var/da/da_minimisation/da_minimisation.f90 b/var/da/da_minimisation/da_minimisation.f90 index fefb0a7824..b3b896a3ed 100644 --- a/var/da/da_minimisation/da_minimisation.f90 +++ b/var/da/da_minimisation/da_minimisation.f90 @@ -55,7 +55,9 @@ module da_minimisation ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe, fgat_rain_flags, var4d_bin_rain, freeze_varbc, & use_wpec, wpec_factor, use_4denvar, anal_type_hybrid_dual_res, alphacv_method, alphacv_method_xa, & write_detail_grad_fn, pseudo_uvtpq, lanczos_ep_filename, use_divc, divc_factor, use_radarobs, & - multi_inc_io_opt, write_gts_omb_oma, write_unpert_obs, write_rej_obs_conv + multi_inc_io_opt, write_gts_omb_oma, write_unpert_obs, write_rej_obs_conv, & + cloud_cv_options, use_cv_w, var_scaling6, var_scaling7, var_scaling8, var_scaling9, & + var_scaling10, var_scaling11 use da_define_structures, only : iv_type, y_type, j_type, be_type, & xbx_type, jo_type, da_allocate_y,da_zero_x,da_zero_y,da_deallocate_y, & da_zero_vp_type, qhat_type diff --git a/var/da/da_setup_structures/da_scale_background_errors.inc b/var/da/da_setup_structures/da_scale_background_errors.inc index cd2801c507..7d9c893fcf 100644 --- a/var/da/da_setup_structures/da_scale_background_errors.inc +++ b/var/da/da_setup_structures/da_scale_background_errors.inc @@ -12,12 +12,15 @@ subroutine da_scale_background_errors ( be, it ) integer :: i, ix, jy, kz, v1_mz, v2_mz, v3_mz, v4_mz, v5_mz real :: ds + real*8, allocatable, dimension(:) :: rf_len6, rf_len7, rf_len8, & + rf_len9, rf_len10, rf_len11 + if ( jb_factor <= 0.0 ) return ! ! Rewind the unit: be_rf_unit = unit_end + 1 be_print_unit = unit_end + 2 - rewind (be_rf_unit) + if ( rootproc ) rewind (be_rf_unit) ! ! Read the dimensions and allocate the arrays: read(be_rf_unit) kz, jy, ix, v1_mz, v2_mz, v3_mz, v4_mz, v5_mz, ds @@ -105,6 +108,40 @@ subroutine da_scale_background_errors ( be, it ) deallocate ( rf_len4 ) deallocate ( v5_val ) deallocate ( rf_len5 ) -! + + if ( cloud_cv_options >= 2 ) then + allocate ( rf_len6(1:kz) ) + allocate ( rf_len7(1:kz) ) + allocate ( rf_len8(1:kz) ) + allocate ( rf_len9(1:kz) ) + allocate ( rf_len10(1:kz) ) + read (be_rf_unit) be%v6%val, be%v7%val, be%v8%val, & + be%v9%val, be%v10%val + read (be_rf_unit) rf_len6, rf_len7, rf_len8, rf_len9, rf_len10 + call da_rescale_background_errors( var_scaling6(it), len_scaling6(it), & + ds, rf_len6, be % v6 ) + call da_rescale_background_errors( var_scaling6(it), len_scaling7(it), & + ds, rf_len7, be % v7 ) + call da_rescale_background_errors( var_scaling8(it), len_scaling8(it), & + ds, rf_len8, be % v8 ) + call da_rescale_background_errors( var_scaling9(it), len_scaling9(it), & + ds, rf_len9, be % v9 ) + call da_rescale_background_errors( var_scaling10(it), len_scaling10(it), & + ds, rf_len10, be % v10) + deallocate ( rf_len6 ) + deallocate ( rf_len7 ) + deallocate ( rf_len8 ) + deallocate ( rf_len9 ) + deallocate ( rf_len10 ) + end if + if ( use_cv_w ) then + allocate ( rf_len11(1:kz) ) + read (be_rf_unit) be%v11%val + read (be_rf_unit) rf_len11 + call da_rescale_background_errors( var_scaling11(it), len_scaling11(it), & + ds, rf_len11, be % v11) + deallocate ( rf_len11 ) + end if + end subroutine da_scale_background_errors diff --git a/var/da/da_setup_structures/da_setup_be_regional.inc b/var/da/da_setup_structures/da_setup_be_regional.inc index 05e873e1b5..c6a61e540d 100644 --- a/var/da/da_setup_structures/da_setup_be_regional.inc +++ b/var/da/da_setup_structures/da_setup_be_regional.inc @@ -1729,6 +1729,7 @@ subroutine da_setup_be_regional(xb, be, grid) if (max_ext_its > 1 .and. jb_factor > 0.0) then + if ( rootproc ) then write(unit=message(1),fmt='(A,I4)') '>>> Save the variances and scale-lengths in outer-loop', it call da_message(message(1:1)) write(be_rf_unit) kz, jy, ix, be % v1 % mz, be % v2 % mz, be% v3 % mz, & @@ -1737,7 +1738,17 @@ subroutine da_setup_be_regional(xb, be, grid) be % v4 % val, be % v5 % val, & be1_rf_lengthscale, be2_rf_lengthscale, be3_rf_lengthscale, & be4_rf_lengthscale, be5_rf_lengthscale - + if ( cloud_cv_options >= 2 ) then + write(be_rf_unit) be%v6%val, be%v7%val, be%v8%val, be%v9%val, be%v10%val + write(be_rf_unit) be6_rf_lengthscale, be7_rf_lengthscale, be8_rf_lengthscale, & + be9_rf_lengthscale, be10_rf_lengthscale + end if + if ( use_cv_w ) then + write(be_rf_unit) be%v11%val + write(be_rf_unit) be11_rf_lengthscale + end if + end if ! rootproc + if (print_detail_be ) then write(be_print_unit,'("it=",i2,2x,"kz=",i3,2x,"jy=",i4,2x,"ix=",i4,2x,"ds=",e12.5)') & it, kz, jy, ix, xb % ds From 1ec712236d162ea7bb3f061e8ceb578aeffc2031 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Fri, 20 Jul 2018 18:01:49 -0600 Subject: [PATCH 37/91] Workaround to make multi_inc_io_opt=2 work for mosaic radar data. modified: var/da/da_obs_io/da_obs_io.f90 modified: var/da/da_obs_io/da_read_obs_radar.inc modified: var/da/da_obs_io/da_scan_obs_radar.inc --- var/da/da_obs_io/da_obs_io.f90 | 2 +- var/da/da_obs_io/da_read_obs_radar.inc | 2 +- var/da/da_obs_io/da_scan_obs_radar.inc | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/var/da/da_obs_io/da_obs_io.f90 b/var/da/da_obs_io/da_obs_io.f90 index 842151af95..be09cd9310 100644 --- a/var/da/da_obs_io/da_obs_io.f90 +++ b/var/da/da_obs_io/da_obs_io.f90 @@ -31,7 +31,7 @@ module da_obs_io wind_sd_airep,wind_sd_sound,wind_sd_metar,wind_sd_ships,wind_sd_qscat,wind_sd_buoy,wind_sd_pilot,wind_stats_sd,& thin_conv, thin_conv_ascii, lsac_nh_step, lsac_nv_step, lsac_nv_start, lsac_print_details, & lsac_use_u, lsac_use_v, lsac_use_t, lsac_use_q, lsac_u_error, lsac_v_error, lsac_t_error, lsac_q_error, & - use_radar_rhv, use_radar_rqv, use_radar_rf, use_radar_rv + use_radar_rhv, use_radar_rqv, use_radar_rf, use_radar_rv, multi_inc use da_define_structures, only : iv_type, multi_level_type, multi_level_type_BUFR, & radar_multi_level_type, y_type, field_type, each_level_type, & diff --git a/var/da/da_obs_io/da_read_obs_radar.inc b/var/da/da_obs_io/da_read_obs_radar.inc index a4ca5233a5..51acd5d99d 100644 --- a/var/da/da_obs_io/da_read_obs_radar.inc +++ b/var/da/da_obs_io/da_read_obs_radar.inc @@ -219,7 +219,7 @@ subroutine da_read_obs_radar (iv, filename, grid) endif call da_llxy (platform%info, platform%loc, outside, outside_all) - if( outside_all ) then + if( outside_all .and. multi_inc == 0 ) then if (print_detail_radar) then write(unit=stdout, fmt='(a)') '*** Report is outside of domain:' write(unit=stdout, fmt='(2x,a,2(2x,f7.3),2x,a)') & diff --git a/var/da/da_obs_io/da_scan_obs_radar.inc b/var/da/da_obs_io/da_scan_obs_radar.inc index 5d30072dc8..f665c801ca 100644 --- a/var/da/da_obs_io/da_scan_obs_radar.inc +++ b/var/da/da_obs_io/da_scan_obs_radar.inc @@ -194,7 +194,7 @@ subroutine da_scan_obs_radar (iv, filename, grid) endif call da_llxy (platform%info, platform%loc, outside, outside_all) - if( outside_all ) cycle reports + if( outside_all .and. multi_inc == 0 ) cycle reports nlevels = platform%info%levels From 6b4582506a7524fd4bf13a665f4326631e6651f3 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Mon, 17 Dec 2018 11:39:48 -0700 Subject: [PATCH 38/91] Multi-Resolution-Incremental 4DVAR code as it is from Jake Liu. git cherry-pick -n 070d870 96fb5f3 5e94060 606ac0e 4cc9707 85e4d11 baa3fe6 excluding offline programs and scripts in var/mri4dvar directory. On branch mri4dvar Changes to be committed: modified: Registry/registry.var modified: var/build/depend.txt modified: var/da/da_main/da_solve.inc modified: var/da/da_main/da_wrfvar_top.f90 modified: var/da/da_obs_io/da_search_obs.inc modified: var/da/da_recursive_filter/da_recursive_filter.f90 new file: var/da/da_recursive_filter/da_recursive_filter_1d_inv.inc modified: var/da/da_recursive_filter/da_transform_through_rf.inc new file: var/da/da_recursive_filter/da_transform_through_rf_inv.inc modified: var/da/da_setup_structures/da_setup_be_regional.inc modified: var/da/da_setup_structures/da_setup_structures.f90 new file: var/da/da_setup_structures/da_write_vp.inc modified: var/da/da_vtox_transforms/da_transform_vptox.inc new file: var/da/da_vtox_transforms/da_transform_vptox_inv.inc new file: var/da/da_vtox_transforms/da_transform_vtovv_inv.inc new file: var/da/da_vtox_transforms/da_transform_vtox_inv.inc modified: var/da/da_vtox_transforms/da_transform_vvtovp.inc modified: var/da/da_vtox_transforms/da_transform_vvtovp_adj.inc new file: var/da/da_vtox_transforms/da_transform_vvtovp_inv.inc modified: var/da/da_vtox_transforms/da_vertical_transform.inc modified: var/da/da_vtox_transforms/da_vtox_transforms.f90 --- Registry/registry.var | 2 + var/build/depend.txt | 6 +- var/da/da_main/da_solve.inc | 189 ++++++++++++--- var/da/da_main/da_wrfvar_top.f90 | 8 +- var/da/da_obs_io/da_search_obs.inc | 5 +- .../da_recursive_filter.f90 | 2 + .../da_recursive_filter_1d_inv.inc | 88 +++++++ .../da_transform_through_rf.inc | 9 +- .../da_transform_through_rf_inv.inc | 189 +++++++++++++++ .../da_setup_be_regional.inc | 85 ++++--- .../da_setup_structures.f90 | 3 +- var/da/da_setup_structures/da_write_vp.inc | 195 +++++++++++++++ .../da_vtox_transforms/da_transform_vptox.inc | 85 ++++--- .../da_transform_vptox_inv.inc | 174 +++++++++++++ .../da_transform_vtovv_inv.inc | 229 ++++++++++++++++++ .../da_transform_vtox_inv.inc | 87 +++++++ .../da_transform_vvtovp.inc | 10 +- .../da_transform_vvtovp_adj.inc | 2 +- .../da_transform_vvtovp_inv.inc | 62 +++++ .../da_vertical_transform.inc | 101 ++++---- .../da_vtox_transforms/da_vtox_transforms.f90 | 6 +- 21 files changed, 1366 insertions(+), 171 deletions(-) create mode 100644 var/da/da_recursive_filter/da_recursive_filter_1d_inv.inc create mode 100644 var/da/da_recursive_filter/da_transform_through_rf_inv.inc create mode 100644 var/da/da_setup_structures/da_write_vp.inc create mode 100644 var/da/da_vtox_transforms/da_transform_vptox_inv.inc create mode 100644 var/da/da_vtox_transforms/da_transform_vtovv_inv.inc create mode 100644 var/da/da_vtox_transforms/da_transform_vtox_inv.inc create mode 100644 var/da/da_vtox_transforms/da_transform_vvtovp_inv.inc diff --git a/Registry/registry.var b/Registry/registry.var index ef7e05ceea..bca4843688 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -254,6 +254,8 @@ rconfig logical gpsref_thinning namelist,wrfvar5 1 .false. - "gps rconfig logical outer_loop_restart namelist,wrfvar6 1 .false. - "outer_loop_restart" "" "" rconfig integer max_ext_its namelist,wrfvar6 1 1 - "max_ext_its" "" "" rconfig integer ntmax namelist,wrfvar6 max_outer_iterations 75 - "ntmax" "" "" +rconfig logical use_inverse_squarerootb namelist,wrfvar6 1 .false. - "use_inverse_squarerootb" "" "" +rconfig logical use_interpolate_cvt namelist,wrfvar6 1 .false. - "use_interpolate_cvt" "" "" rconfig integer nsave namelist,wrfvar6 1 4 - "nsave" "" "" rconfig integer write_interval namelist,wrfvar6 1 5 - "write_interval" "" "" rconfig real eps namelist,wrfvar6 max_outer_iterations 0.01 - "eps" "" "" diff --git a/var/build/depend.txt b/var/build/depend.txt index e17c71e122..e11aeb5eba 100644 --- a/var/build/depend.txt +++ b/var/build/depend.txt @@ -146,14 +146,14 @@ da_radar.o : da_radar.f90 da_write_oa_radar_ascii.inc da_max_error_qc_radar.inc da_radiance.o : da_radiance.f90 da_blacklist_rad.inc da_read_pseudo_rad.inc da_get_innov_vector_radiance.inc da_radiance_init.inc da_setup_radiance_structures.inc da_sort_rad.inc da_read_kma1dvar.inc da_initialize_rad_iv.inc da_allocate_rad_iv.inc da_read_obs_bufrssmis.inc da_read_obs_bufrairs.inc da_read_obs_bufriasi.inc da_read_obs_bufrseviri.inc da_read_obs_bufrtovs.inc da_write_filtered_rad.inc da_read_simulated_rad.inc da_read_filtered_rad.inc da_calculate_grady_rad.inc gsi_thinning.o da_wrf_interfaces.o da_varbc.o da_tracing.o da_tools.o da_statistics.o da_rttov.o da_reporting.o da_radiance1.o da_physics.o da_par_util.o da_par_util1.o da_tools_serial.o da_interpolation.o da_define_structures.o da_crtm.o da_control.o module_radiance.o module_domain.o amsr2time_.c da_read_obs_hdf5amsr2.inc da_deallocate_radiance.inc da_read_obs_ncgoesimg.inc da_get_satzen.inc da_radiance1.o : da_radiance1.f90 da_mspps_ts.inc da_mspps_emis.inc da_setup_satcv.inc da_qc_rad.inc da_print_stats_rad.inc da_oi_stats_rad.inc da_ao_stats_rad.inc da_cld_eff_radius.inc da_detsurtyp.inc da_write_oa_rad_ascii.inc da_write_iv_rad_ascii.inc da_qc_mhs.inc da_qc_ssmis.inc da_qc_hirs.inc da_qc_amsub.inc da_qc_amsua.inc da_qc_airs.inc da_cloud_detect_airs.inc da_cloud_sim.inc da_qc_seviri.inc da_qc_iasi.inc da_cloud_detect_iasi.inc da_qc_crtm.inc da_predictor_crtm.inc da_predictor_rttov.inc da_write_biasprep.inc da_biasprep.inc da_read_biascoef.inc da_biascorr.inc da_residual_rad.inc da_jo_and_grady_rad.inc gsi_constants.o da_tracing.o da_tools_serial.o da_tools.o da_statistics.o da_reporting.o da_par_util1.o da_par_util.o module_dm.o da_define_structures.o da_control.o module_radiance.o da_qc_amsr2.inc da_qc_goesimg.inc da_rain.o : da_rain.f90 da_calculate_grady_rain.inc da_get_innov_vector_rain.inc da_get_hr_rain.inc da_check_max_iv_rain.inc da_transform_xtoy_rain_adj.inc da_transform_xtoy_rain.inc da_print_stats_rain.inc da_oi_stats_rain.inc da_residual_rain.inc da_jo_and_grady_rain.inc da_ao_stats_rain.inc da_tracing.o da_tools.o da_statistics.o da_par_util.o da_par_util1.o da_interpolation.o da_define_structures.o da_control.o module_comm_dm.o module_dm.o module_domain.o -da_recursive_filter.o : da_recursive_filter.f90 da_apply_rf_adj.inc da_apply_rf.inc da_apply_rf_1v_adj.inc da_apply_rf_1v.inc da_transform_through_rf_adj.inc da_transform_through_rf.inc da_recursive_filter_1d_adj.inc da_recursive_filter_1d.inc da_calculate_rf_factors.inc da_transform_through_rf_dual_res.inc da_transform_through_rf_adj_dual_res.inc da_perform_2drf.inc da_rf_cv3.o da_rfz_cv3.o da_tracing.o da_par_util.o da_define_structures.o da_control.o module_domain.o +da_recursive_filter.o : da_recursive_filter.f90 da_apply_rf_adj.inc da_apply_rf.inc da_apply_rf_1v_adj.inc da_apply_rf_1v.inc da_transform_through_rf_adj.inc da_transform_through_rf.inc da_transform_through_rf_inv.inc da_recursive_filter_1d_adj.inc da_recursive_filter_1d.inc da_recursive_filter_1d_inv.inc da_calculate_rf_factors.inc da_transform_through_rf_dual_res.inc da_transform_through_rf_adj_dual_res.inc da_perform_2drf.inc da_rf_cv3.o da_rfz_cv3.o da_tracing.o da_par_util.o da_define_structures.o da_control.o module_domain.o da_reporting.o : da_reporting.f90 da_message2.inc da_message.inc da_warning.inc da_error.inc da_control.o da_rf_cv3.o : da_rf_cv3.f90 da_mat_cv3.o da_rfz_cv3.o : da_rfz_cv3.f90 da_rsl_interfaces.o : da_rsl_interfaces.f90 da_rttov.o : da_rttov.f90 da_rttov_ad.inc da_rttov_tl.inc da_rttov_direct.inc da_rttov_init.inc da_transform_xtoy_rttov_adj.inc da_transform_xtoy_rttov.inc da_get_innov_vector_rttov.inc da_rttov_k.inc da_wrf_interfaces.o da_tracing.o da_tools.o da_radiance1.o da_par_util.o da_tools_serial.o da_interpolation.o da_control.o module_radiance.o da_reporting.o module_domain.o da_define_structures.o da_satem.o : da_satem.f90 da_calculate_grady_satem.inc da_get_innov_vector_satem.inc da_check_max_iv_satem.inc da_transform_xtoy_satem_adj.inc da_transform_xtoy_satem.inc da_print_stats_satem.inc da_oi_stats_satem.inc da_residual_satem.inc da_jo_and_grady_satem.inc da_ao_stats_satem.inc da_tracing.o da_tools.o da_statistics.o da_physics.o da_par_util1.o da_par_util.o da_define_structures.o da_control.o module_domain.o -da_setup_structures.o : da_setup_structures.f90 da_truncate_spectra.inc da_get_bins_info.inc da_write_kma_increments.inc da_write_increments_for_wrf_nmm_regional.inc da_write_increments.inc da_qfrmrh.inc da_cumulus.inc da_lcl.inc da_cloud_model.inc da_setup_runconstants.inc da_setup_obs_interp_wts.inc da_setup_obs_structures_madis.inc da_setup_obs_structures_bufr.inc da_setup_obs_structures_ascii.inc da_setup_obs_structures_rain.inc da_setup_obs_structures_radar.inc da_setup_obs_structures.inc da_setup_flow_predictors.inc da_setup_flow_predictors_para_read_opt1.inc da_chgvres.inc da_setup_cv.inc da_setup_be_nmm_regional.inc da_setup_be_regional.inc da_setup_be_ncep_gfs.inc da_setup_be_global.inc da_setup_background_errors.inc da_scale_background_errors.inc da_scale_background_errors_cv3.inc da_rescale_background_errors.inc da_interpolate_regcoeff.inc da_get_vertical_truncation.inc gsi_thinning.o module_radiance.o da_rf_cv3.o da_rfz_cv3.o da_vtox_transforms.o da_tracing.o da_tools.o da_tools_serial.o da_ssmi.o da_spectral.o da_recursive_filter.o da_reporting.o da_radiance.o da_par_util.o da_par_util1.o da_obs_io.o da_obs.o da_control.o da_wrf_interfaces.o da_define_structures.o module_domain.o da_wavelet.o da_chg_be_Vres.inc da_gen_eigen.inc da_eigen_to_covmatrix.inc da_setup_pseudo_obs.inc +da_setup_structures.o : da_setup_structures.f90 da_write_vp.inc da_truncate_spectra.inc da_get_bins_info.inc da_write_kma_increments.inc da_write_increments_for_wrf_nmm_regional.inc da_write_increments.inc da_qfrmrh.inc da_cumulus.inc da_lcl.inc da_cloud_model.inc da_setup_runconstants.inc da_setup_obs_interp_wts.inc da_setup_obs_structures_madis.inc da_setup_obs_structures_bufr.inc da_setup_obs_structures_ascii.inc da_setup_obs_structures_rain.inc da_setup_obs_structures_radar.inc da_setup_obs_structures.inc da_setup_flow_predictors.inc da_setup_flow_predictors_para_read_opt1.inc da_chgvres.inc da_setup_cv.inc da_setup_be_nmm_regional.inc da_setup_be_regional.inc da_setup_be_ncep_gfs.inc da_setup_be_global.inc da_setup_background_errors.inc da_scale_background_errors.inc da_scale_background_errors_cv3.inc da_rescale_background_errors.inc da_interpolate_regcoeff.inc da_get_vertical_truncation.inc gsi_thinning.o module_radiance.o da_rf_cv3.o da_rfz_cv3.o da_vtox_transforms.o da_tracing.o da_tools.o da_tools_serial.o da_ssmi.o da_spectral.o da_recursive_filter.o da_reporting.o da_radiance.o da_par_util.o da_par_util1.o da_obs_io.o da_obs.o da_control.o da_wrf_interfaces.o da_define_structures.o module_domain.o da_wavelet.o da_chg_be_Vres.inc da_gen_eigen.inc da_eigen_to_covmatrix.inc da_setup_pseudo_obs.inc da_ships.o : da_ships.f90 da_calculate_grady_ships.inc da_get_innov_vector_ships.inc da_check_max_iv_ships.inc da_transform_xtoy_ships_adj.inc da_transform_xtoy_ships.inc da_print_stats_ships.inc da_oi_stats_ships.inc da_residual_ships.inc da_jo_and_grady_ships.inc da_ao_stats_ships.inc da_tracing.o da_tools.o da_statistics.o da_physics.o da_grid_definitions.o da_par_util1.o da_par_util.o da_interpolation.o da_define_structures.o da_control.o module_domain.o da_sound.o : da_sound.f90 da_calculate_grady_sonde_sfc.inc da_check_max_iv_sonde_sfc.inc da_get_innov_vector_sonde_sfc.inc da_transform_xtoy_sonde_sfc_adj.inc da_transform_xtoy_sonde_sfc.inc da_print_stats_sonde_sfc.inc da_oi_stats_sonde_sfc.inc da_residual_sonde_sfc.inc da_jo_sonde_sfc_uvtq.inc da_jo_and_grady_sonde_sfc.inc da_ao_stats_sonde_sfc.inc da_check_buddy_sound.inc da_calculate_grady_sound.inc da_get_innov_vector_sound.inc da_check_max_iv_sound.inc da_transform_xtoy_sound_adj.inc da_transform_xtoy_sound.inc da_print_stats_sound.inc da_oi_stats_sound.inc da_residual_sound.inc da_jo_sound_uvtq.inc da_jo_and_grady_sound.inc da_ao_stats_sound.inc da_tracing.o da_physics.o da_grid_definitions.o da_par_util1.o da_par_util.o da_tools.o da_statistics.o da_interpolation.o module_domain.o da_define_structures.o da_control.o da_spectral.o : da_spectral.f90 da_apply_power.inc da_legtra_inv_adj.inc da_vtovv_spectral_adj.inc da_vv_to_v_spectral.inc da_vtovv_spectral.inc da_test_spectral.inc da_setlegpol.inc da_setlegpol_test.inc da_legtra.inc da_legtra_inv.inc da_initialize_h.inc da_get_reglats.inc da_get_gausslats.inc da_calc_power_spectrum.inc da_asslegpol.inc da_tracing.o da_tools_serial.o da_reporting.o da_par_util1.o da_define_structures.o da_control.o @@ -181,7 +181,7 @@ da_verif_tools.o : da_verif_tools.f90 da_verif_obs_control.o : da_verif_obs_control.f90 da_verif_obs_init.o : da_verif_obs_init.f90 da_verif_obs_control.o -da_vtox_transforms.o : da_vtox_transforms.f90 da_apply_be_adj.inc da_apply_be.inc da_transform_bal_adj.inc da_transform_bal.inc da_transform_vtovv_global_adj.inc da_transform_vtovv_global.inc da_get_aspoles.inc da_get_avpoles.inc da_get_spoles.inc da_get_vpoles.inc da_vertical_transform.inc da_transform_vptovv.inc da_transform_vvtovp_adj.inc da_transform_vvtovp.inc da_transform_vptox_adj.inc da_transform_vptox.inc da_transform_xtoxa_adj.inc da_transform_vtox_adj.inc da_transform_xtoxa.inc da_transform_vtox.inc da_transform_rescale.inc da_transform_vtovv_adj.inc da_transform_vtovv.inc da_check_eof_decomposition.inc da_add_flow_dependence_xa_adj.inc da_add_flow_dependence_xa.inc da_add_flow_dependence_vp_adj.inc da_add_flow_dependence_vp.inc da_transform_vvtovp_dual_res.inc da_transform_vvtovp_adj_dual_res.inc da_wavelet.o da_wrf_interfaces.o da_tracing.o da_tools.o da_ssmi.o da_spectral.o da_reporting.o da_recursive_filter.o da_par_util.o da_physics.o da_dynamics.o da_define_structures.o da_control.o module_domain.o module_comm_dm.o module_dm.o interp_fcn.o da_copy_xa.inc da_add_xa.inc da_calc_flow_dependence_xa_adj.inc da_calc_flow_dependence_xa.inc da_calc_flow_dependence_xa_dual_res.inc da_calc_flow_dependence_xa_adj_dual_res.inc da_transform_vpatox.inc da_transform_vpatox_adj.inc +da_vtox_transforms.o : da_vtox_transforms.f90 da_apply_be_adj.inc da_apply_be.inc da_transform_bal_adj.inc da_transform_bal.inc da_transform_vtovv_global_adj.inc da_transform_vtovv_global.inc da_get_aspoles.inc da_get_avpoles.inc da_get_spoles.inc da_get_vpoles.inc da_vertical_transform.inc da_transform_vptovv.inc da_transform_vvtovp_adj.inc da_transform_vvtovp.inc da_transform_vvtovp_inv.inc da_transform_vptox_adj.inc da_transform_vptox.inc da_transform_vptox_inv.inc da_transform_xtoxa_adj.inc da_transform_vtox_adj.inc da_transform_xtoxa.inc da_transform_vtox.inc da_transform_vtox_inv.inc da_transform_rescale.inc da_transform_vtovv_adj.inc da_transform_vtovv.inc da_transform_vtovv_inv.inc da_check_eof_decomposition.inc da_add_flow_dependence_xa_adj.inc da_add_flow_dependence_xa.inc da_add_flow_dependence_vp_adj.inc da_add_flow_dependence_vp.inc da_transform_vvtovp_dual_res.inc da_transform_vvtovp_adj_dual_res.inc da_wavelet.o da_wrf_interfaces.o da_tracing.o da_tools.o da_ssmi.o da_spectral.o da_reporting.o da_recursive_filter.o da_par_util.o da_physics.o da_dynamics.o da_define_structures.o da_control.o module_domain.o module_comm_dm.o module_dm.o interp_fcn.o da_copy_xa.inc da_add_xa.inc da_calc_flow_dependence_xa_adj.inc da_calc_flow_dependence_xa.inc da_calc_flow_dependence_xa_dual_res.inc da_calc_flow_dependence_xa_adj_dual_res.inc da_transform_vpatox.inc da_transform_vpatox_adj.inc diff --git a/var/da/da_main/da_solve.inc b/var/da/da_main/da_solve.inc index 6fd9576de3..d649271b55 100644 --- a/var/da/da_main/da_solve.inc +++ b/var/da/da_main/da_solve.inc @@ -45,6 +45,8 @@ type(x_type) :: shuffle real, allocatable :: grid_box_area(:,:), mapfac(:,:) + real, allocatable :: v1(:,:,:),v2(:,:,:),v3(:,:,:),v4(:,:,:),v5(:,:,:) + real, allocatable :: v6(:,:,:),v7(:,:,:),v8(:,:,:),v9(:,:,:),v10(:,:,:),v11(:,:,:) character (len=10) :: variable_name integer :: iwin, num_subtwindow @@ -53,8 +55,12 @@ real, external :: nest_loc_of_cg ! from share/interp_fcn.F integer, external :: compute_CGLL ! from share/interp_fcn.F - integer :: cvt_unit, iost - character(len=8) :: cvtfile + integer :: vp_unit, iost + character(len=13) :: vpfile ! vp_input.0001 + integer :: i1,i2,i3,i4,i5,i6 + !integer :: i11,i22,i33,i44,i55,i66 + !integer :: dim1, dim2, dim3 + !integer :: mz1, mz2, mz3, mz4, mz5 logical :: ex if (trace_use) call da_trace_entry("da_solve") @@ -499,6 +505,19 @@ cv_size_domain_je = (ide_int - ids_int + 1) * (jde_int - jds_int + 1) * be % alpha % mz * be % ne endif + !write (*,*) "--------- Debug ---------------" + !write (*,*) "ids,ide,jds,jde,kds,kde= ", ids,ide,jds,jde,kds,kde + !write (*,*) "ips,ipe,jps,jpe,kps,kpe= ", ips,ipe,jps,jpe,kps,kpe + !write (*,*) "its,ite,jts,jte,kts,kte= ", its,ite,jts,jte,kts,kte + !write (*,*) "ims,ime,jms,jme,kms,kme= ", ims,ime,jms,jme,kms,kme + !write (*,*) "mz 1-5= ",be%v1%mz, be%v2%mz, be%v3%mz, be%v4%mz, be%v5%mz + !write (*,*) "be % cv % size_jb = ", be % cv % size_jb + !write (*,*) "be % cv % size_jp = ", be % cv % size_jp + !write (*,*) "be % cv % size_js = ", be % cv % size_js + !write (*,*) "be % cv % size_jl = ", be % cv % size_jl + !write (*,*) "be % cv % size_je = ", be % cv % size_je + !write (*,*) "--------- Debug ---------------" + !--------------------------------------------------------------------------- ! [5.2] Set up observation bias correction (VarBC): !--------------------------------------------------------------------------- @@ -549,35 +568,133 @@ ! allocate (full_eignvec(cv_size)) ! end if - if ( outer_loop_restart ) then - !call da_get_unit(cvt_unit) - cvt_unit=600 +! liuz: if multi_inc == 0: run normal 3D/4D-Var +!------------------------------------------------------------------------ + call da_initialize_cv (cv_size, cvt) + call da_zero_vp_type (grid%vp) + call da_zero_vp_type (grid%vv) + + if ( multi_inc == 2 ) then if ( max_ext_its > 1 ) then max_ext_its=1 - write(unit=message(1),fmt='(a)') "Re-set max_ext_its = 1 for outer_loop_restart" + write(unit=message(1),fmt='(a)') "Re-set max_ext_its = 1 for multi_inc==2" call da_message(message(1:1)) end if - write(unit=cvtfile,fmt='(a,i4.4)') 'cvt_',myproc - inquire(file=trim(cvtfile), exist=ex) + + ! read vp files for different PEs + !---------------------------------- + write(unit=vpfile,fmt='(a,i4.4)') 'vp_input.',myproc + inquire(file=trim(vpfile), exist=ex) if ( ex ) then - open(unit=cvt_unit,file=trim(cvtfile),iostat=iost,form='UNFORMATTED',status='OLD') + call da_get_unit(vp_unit) + open(unit=vp_unit,file=trim(vpfile),iostat=iost,form='UNFORMATTED',status='OLD') if (iost /= 0) then write(unit=message(1),fmt='(A,I5,A)') & - "Error ",iost," opening cvt file "//trim(cvtfile) + "Error ",iost," opening vp file "//trim(vpfile) call da_error(__FILE__,__LINE__,message(1:1)) end if - write(unit=message(1),fmt='(a)') 'Reading cvt from : '//trim(cvtfile) + if ( use_interpolate_cvt ) then ! works for CV3?, 3D RF + write(unit=message(1),fmt='(a)') 'Reading vv from : '//trim(vpfile) + elseif ( use_inverse_squarerootb ) then ! works for CV5,6,7, vertical EOF + write(unit=message(1),fmt='(a)') 'Reading vp from : '//trim(vpfile) + end if call da_message(message(1:1)) - read(cvt_unit) cvt - close(cvt_unit) + !read(vp_unit) mz1, mz2, mz3, mz4, mz5 + !print *, 'mz1-5=',mz1, mz2, mz3, mz4, mz5 + read(vp_unit) i1, i2, i3, i4, i5, i6 ! read dimension of patch for current processor + ! i11, i22, i33, i44, i55, i66, & + ! dim1, dim2, dim3 + !if ( i1 /= ips ) print *, "task=", myproc, "i1=",i1, "ips=",ips + !if ( i2 /= ipe ) print *, "task=", myproc, "i2=",i2, "ipe=",ipe + !if ( i3 /= jps ) print *, "task=", myproc, "i3=",i3, "jps=",jps + !if ( i4 /= jpe ) print *, "task=", myproc, "i4=",i4, "jpe=",jpe + !if ( i5 /= kps ) print *, "task=", myproc, "i5=",i5, "kps=",kps + !if ( i6 /= kpe ) print *, "task=", myproc, "i6=",i6, "kpe=",kpe + allocate( v1(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) + allocate( v2(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) + allocate( v3(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) + allocate( v4(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) + allocate( v5(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) + if ( cloud_cv_options >= 2 ) then + allocate( v6(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) + allocate( v7(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) + allocate( v8(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) + allocate( v9(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) + allocate( v10(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) + end if + if ( use_cv_w ) allocate( v11(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) + + read(vp_unit) v1, v2, v3, v4, v5 + if ( cloud_cv_options >= 2 ) read(vp_unit) v6, v7, v8, v9, v10 + if ( use_cv_w ) read(vp_unit) v11 + + if ( use_interpolate_cvt ) then + grid%vv%v1(ips:ipe,jps:jpe,kps:kpe) = v1(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vv%v2(ips:ipe,jps:jpe,kps:kpe) = v2(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vv%v3(ips:ipe,jps:jpe,kps:kpe) = v3(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vv%v4(ips:ipe,jps:jpe,kps:kpe) = v4(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vv%v5(ips:ipe,jps:jpe,kps:kpe) = v5(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + if ( cloud_cv_options >= 2 ) then + grid%vv%v6(ips:ipe,jps:jpe,kps:kpe) = v6(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vv%v7(ips:ipe,jps:jpe,kps:kpe) = v7(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vv%v8(ips:ipe,jps:jpe,kps:kpe) = v8(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vv%v9(ips:ipe,jps:jpe,kps:kpe) = v9(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vv%v10(ips:ipe,jps:jpe,kps:kpe) = v10(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + end if + if ( use_cv_w ) then + grid%vv%v11(ips:ipe,jps:jpe,kps:kpe) = v11(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + end if + call da_vv_to_cv( grid%vv, grid%xp, be%cv_mz, be%ncv_mz, cv_size, cvt ) + elseif ( use_inverse_squarerootb ) then + grid%vp%v1(ips:ipe,jps:jpe,kps:kpe) = v1(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vp%v2(ips:ipe,jps:jpe,kps:kpe) = v2(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vp%v3(ips:ipe,jps:jpe,kps:kpe) = v3(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vp%v4(ips:ipe,jps:jpe,kps:kpe) = v4(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vp%v5(ips:ipe,jps:jpe,kps:kpe) = v5(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + if ( cloud_cv_options >= 2 ) then + grid%vp%v6(ips:ipe,jps:jpe,kps:kpe) = v6(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vp%v7(ips:ipe,jps:jpe,kps:kpe) = v7(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vp%v8(ips:ipe,jps:jpe,kps:kpe) = v8(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vp%v9(ips:ipe,jps:jpe,kps:kpe) = v9(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + grid%vp%v10(ips:ipe,jps:jpe,kps:kpe) = v10(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + end if + if ( use_cv_w ) then ! vertical stagging +1? + grid%vp%v11(ips:ipe,jps:jpe,kps:kpe) = v11(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) + end if + !call da_write_vp(grid,grid%vp,'vp_input.global ') ! to verify correctness + print '(/10X,"===> Use inverse transform of square-root B for outer-loop=",i2)', it + if ( cv_options == 3 ) then + write(unit=message(1),fmt='(A,I5,A)') & + "Error: inverse U transform not for cv_options = 3" + call da_error(__FILE__,__LINE__,message(1:1)) + end if + call da_transform_vtox_inv (grid,be%cv%size_jb,xbx,be,grid%ep,cvt(1:be%cv%size_jb),grid%vv,grid%vp) + end if + + deallocate( v1 ) + deallocate( v2 ) + deallocate( v3 ) + deallocate( v4 ) + deallocate( v5 ) + if ( cloud_cv_options >= 2 ) then + deallocate( v6 ) + deallocate( v7 ) + deallocate( v8 ) + deallocate( v9 ) + deallocate( v10 ) + end if + if ( use_cv_w ) deallocate( v11 ) + + close(vp_unit) + call da_free_unit(vp_unit) + else - write(unit=message(1),fmt='(a)') "cvt file '"//trim(cvtfile)//"' does not exists, initializing cvt." + write(unit=message(1),fmt='(a)') "vp files '"//trim(vpfile)//"' does not exists, initiallizing cvt." call da_message(message(1:1)) call da_initialize_cv (cv_size, cvt) end if - else - call da_initialize_cv (cv_size, cvt) end if +! liuz: ------------------------------------------- call da_zero_vp_type (grid%vv) call da_zero_vp_type (grid%vp) @@ -614,6 +731,24 @@ call da_initialize_cv (cv_size, xhat) +! liuz:---------------------- +! Apply inverse transform of squareroot(B) for full-resolution non-stop Var +! from 2nd outer loop, this is to check correctness of inverse U transform +! does not apply this setting for real world application +!----------------------------- + if (multi_inc == 0 .and. it > 1 .and. use_inverse_squarerootb .and. cv_options /= 3) then + print '(/10X,"===> Use inverse transform of square-root B for outer-loop=",i2)', it + call da_transform_vtox_inv (grid,be%cv%size_jb,xbx,be,grid%ep,cvt(1:be%cv%size_jb),grid%vv,grid%vp) + endif + +! Reinitialize cvt=0 for full-resolution non-stop Var for each loop +!------------------------------ + if (multi_inc == 0 .and. it > 1 .and. use_interpolate_cvt) then + print '(/10X,"===> Reinitialize cvt as zeros for outer loop ",i2)', it + call da_initialize_cv (cv_size, cvt) + endif +! liuz:------------------------ + ! [8.1] Calculate nonlinear model trajectory ! if (var4d .and. multi_inc /= 2 ) then @@ -785,18 +920,9 @@ ! Update outer-loop control variable cvt = cvt + xhat - if ( outer_loop_restart ) then - open(unit=cvt_unit,status='unknown',file=trim(cvtfile),iostat=iost,form='UNFORMATTED') - if (iost /= 0) then - write(unit=message(1),fmt='(A,I5,A)') & - "Error ",iost," opening cvt file "//trim(cvtfile) - call da_error(__FILE__,__LINE__,message(1:1)) - end if - write(unit=message(1),fmt='(a)') 'Writing cvt to : '//trim(cvtfile) - call da_message(message(1:1)) - write(cvt_unit) cvt - close(cvt_unit) - !call da_free_unit(cvt_unit) + if ( multi_inc == 2 .and. use_interpolate_cvt ) then + call da_cv_to_vv( cv_size, cvt, be%cv_mz, be%ncv_mz, grid%vv ) + call da_write_vp(grid,grid%vv,'vp_output.global') ! wrtie vv to vp file end if !------------------------------------------------------------------------ @@ -826,6 +952,13 @@ call da_transform_vtox (grid,be%cv%size_jb,xbx,be,grid%ep,xhat(1:be%cv%size_jb),grid%vv,grid%vp) call da_transform_vpatox (grid,be,grid%ep,grid%vp) endif + +! liuz:------------------------ + if (multi_inc == 2 .and. use_inverse_squarerootb) then + call da_write_vp(grid,grid%vp,'vp_output.global') ! write vp to vp file + end if +! liuz:-------------------------- + call da_transform_xtoxa (grid) ! [8.6] Only when use_radarobs = .false. and calc_w_increment =.true., diff --git a/var/da/da_main/da_wrfvar_top.f90 b/var/da/da_main/da_wrfvar_top.f90 index 25bc9618a9..227d97544d 100644 --- a/var/da/da_main/da_wrfvar_top.f90 +++ b/var/da/da_main/da_wrfvar_top.f90 @@ -55,7 +55,8 @@ module da_wrfvar_top use da_obs, only : da_transform_xtoy_adj use da_obs_io, only : da_write_filtered_obs, da_write_obs, da_final_write_obs , & da_write_obs_etkf, da_write_modified_filtered_obs - use da_par_util, only : da_system,da_copy_tile_dims,da_copy_dims + use da_par_util, only : da_system,da_copy_tile_dims,da_copy_dims, & + da_vv_to_cv, da_cv_to_vv use da_physics, only : da_uvprho_to_w_lin #if defined (CRTM) || defined (RTTOV) use da_radiance, only : da_deallocate_radiance @@ -65,7 +66,7 @@ module da_wrfvar_top use da_varbc, only : da_varbc_init,da_varbc_update #endif use da_reporting, only : message, da_warning, da_error, da_message - use da_setup_structures, only : da_setup_obs_structures, & + use da_setup_structures, only : da_setup_obs_structures, da_write_vp, & da_setup_background_errors,da_setup_flow_predictors, & da_setup_cv, da_scale_background_errors, da_scale_background_errors_cv3 use da_setup_structures, only : da_setup_flow_predictors_para_read_opt1 @@ -75,7 +76,8 @@ module da_wrfvar_top use da_transfer_model, only : da_transfer_xatoanalysis,da_setup_firstguess, & da_transfer_wrftltoxa_adj use da_vtox_transforms, only : da_transform_vtox, da_transform_xtoxa, & - da_transform_xtoxa_adj, da_copy_xa, da_add_xa, da_transform_vpatox + da_transform_xtoxa_adj, da_copy_xa, da_add_xa, da_transform_vpatox, & + da_transform_vtox_inv use da_wrfvar_io, only : da_med_initialdata_input, da_update_firstguess use da_tools, only : da_set_randomcv, da_get_julian_time diff --git a/var/da/da_obs_io/da_search_obs.inc b/var/da/da_obs_io/da_search_obs.inc index 89d47b08f0..1576a82b27 100644 --- a/var/da/da_obs_io/da_search_obs.inc +++ b/var/da/da_obs_io/da_search_obs.inc @@ -344,7 +344,6 @@ subroutine da_search_obs (ob_type_string, unit_in, num_obs, nth, iv, found_flag) do n = 1, num_obs read(unit_in,'(2i8,2E22.13)') n_dummy, levels, lat, lon - if ( abs(iv%info(radar)%lat(1,nth) - lat ) < MIN_ERR .and. & abs(iv%info(radar)%lon(1,nth) - lon ) < MIN_ERR ) then @@ -359,7 +358,9 @@ subroutine da_search_obs (ob_type_string, unit_in, num_obs, nth, iv, found_flag) if (trace_use) call da_trace_exit("da_search_obs") return else - read(unit_in,*) + do k = 1, levels + read(unit_in,*) + enddo endif enddo !found_flag = .false. diff --git a/var/da/da_recursive_filter/da_recursive_filter.f90 b/var/da/da_recursive_filter/da_recursive_filter.f90 index 12798251c6..54eae7ce6f 100644 --- a/var/da/da_recursive_filter/da_recursive_filter.f90 +++ b/var/da/da_recursive_filter/da_recursive_filter.f90 @@ -31,8 +31,10 @@ module da_recursive_filter #include "da_calculate_rf_factors.inc" #include "da_recursive_filter_1d.inc" #include "da_recursive_filter_1d_adj.inc" +#include "da_recursive_filter_1d_inv.inc" #include "da_transform_through_rf.inc" #include "da_transform_through_rf_adj.inc" +#include "da_transform_through_rf_inv.inc" #include "da_apply_rf_1v.inc" #include "da_apply_rf_1v_adj.inc" diff --git a/var/da/da_recursive_filter/da_recursive_filter_1d_inv.inc b/var/da/da_recursive_filter/da_recursive_filter_1d_inv.inc new file mode 100644 index 0000000000..cbc175bb5b --- /dev/null +++ b/var/da/da_recursive_filter/da_recursive_filter_1d_inv.inc @@ -0,0 +1,88 @@ +subroutine da_recursive_filter_1d_inv(pass, alpha, field, n) + + !--------------------------------------------------------------------------- + ! Purpose: Perform one pass of inverse of recursive filter on 1D array. + ! + ! Method: Inverse filter is non-recursive. References: + ! + ! Lorenc, A. (1992), Iterative Analysis Using Covariance Functions and Filters. + ! Q.J.R. Meteorol. Soc., 118: 569-591. Equation (A2) + ! + ! Christopher M. Hayden and R. James Purser, 1995: Recursive Filter Objective Analysis of + ! Meteorological Fields: Applications to NESDIS Operational Processing. + ! J. Appl. Meteor., 34, 3-15. + ! + ! Dale Barker etal., 2004, A 3DVAR data assimilation system for use with MM5, + ! NCAR Tech Note 393. + ! + ! Author: Zhiquan (Jake) Liu, NCAR/MMM, 2015-09 + !--------------------------------------------------------------------------- + + implicit none + + integer, intent(in) :: pass ! Current pass of filter. + real*8, intent(in) :: alpha ! Alpha coefficient for RF. + real*8, intent(inout) :: field(:) ! Array to be filtered. + integer, intent(in) :: n ! Size of field array. + + integer :: j ! Loop counter. + real :: one_alpha ! 1 - alpha. + real :: a(1:n) ! Input field. + real :: b(1:n) ! Field after left-right pass. + real :: c(1:n) ! Field after right-left pass. + + if (trace_use_dull) call da_trace_entry("da_recursive_filter_1d_inv") + + !------------------------------------------------------------------------- + ! [1.0] Initialise: + !------------------------------------------------------------------------- + + one_alpha = 1.0 - alpha + + c(1:n) = field(1:n) + + !------------------------------------------------------------------------- + ! [2.0] Perform non-recursive inverse filter: + !------------------------------------------------------------------------- + + ! Follow the appendix Eq. (A2) of Lorenc (1992): + + do j = 2, n-1 + a(j) = c(j) - (alpha/one_alpha**2) * (c(j-1)-2.0*c(j)+c(j+1)) + end do + + !------------------------------------------------------------------------- + ! [3.0] Perform inverse filter at boundary points 1 & n: + !------------------------------------------------------------------------- + + ! use turning conditions as in the appendix of Hayden & Purser (1995): + ! also see Barker etal., 2004, chapter 5a. + + if (pass == 1) then + b(1) = (c(1)-alpha*c(2))/one_alpha + a(1) = b(1)/one_alpha + + b(n-1) = (c(n-1)-alpha*c(n))/one_alpha + b(n) = c(n)*(1.0+alpha) + a(n) = (b(n) - alpha*b(n-1))/one_alpha + else if ( pass == 2) then + b(1) = (c(1)-alpha*c(2))/one_alpha + a(1) = b(1)*(1.0+alpha) + + b(n-1) = (c(n-1)-alpha*c(n))/one_alpha + b(n) = c(n)*(1.0-alpha**2)**2/one_alpha+alpha**3*b(n-1) + a(n) = (b(n) - alpha*b(n-1))/one_alpha + else + b(1) = (c(1)-alpha*c(2))/one_alpha + a(1) = b(1)*(1.0-alpha**2)**2/one_alpha+alpha**3*a(2) + + b(n-1) = (c(n-1)-alpha*c(n))/one_alpha + b(n) = c(n)*(1.0-alpha**2)**2/one_alpha+alpha**3*b(n-1) + a(n) = (b(n) - alpha*b(n-1))/one_alpha + end if + + field(1:n) = a(1:n) + + if (trace_use_dull) call da_trace_exit("da_recursive_filter_1d_inv") + +end subroutine da_recursive_filter_1d_inv diff --git a/var/da/da_recursive_filter/da_transform_through_rf.inc b/var/da/da_recursive_filter/da_transform_through_rf.inc index 71af24539a..fa2cd76d99 100644 --- a/var/da/da_recursive_filter/da_transform_through_rf.inc +++ b/var/da/da_recursive_filter/da_transform_through_rf.inc @@ -79,7 +79,8 @@ subroutine da_transform_through_rf(grid,mz, rf_alpha, val,field, scaling) !------------------------------------------------------------------------- ! [2.1] Apply (i',j',k -> i,j',k') (grid%xp%v1z -> grid%xp%v1x) - ! convert from vertical column to x-stripe + ! convert from z-strip to x-stripe (i.e., no decomposition in x-dir) + ! Liuz NOTE: in order to do global recursive filter in x-direction call da_transpose_z2x (grid) @@ -108,7 +109,7 @@ subroutine da_transform_through_rf(grid,mz, rf_alpha, val,field, scaling) !------------------------------------------------------------------------- ! [3.1] Apply (i, j' ,k' -> i', j ,k') (grid%xp%v1x -> grid%xp%v1y) - ! convert from vertical column to y-stripe + ! convert from x-strip to y-stripe call da_transpose_x2y (grid) @@ -133,11 +134,11 @@ subroutine da_transform_through_rf(grid,mz, rf_alpha, val,field, scaling) !$OMP END PARALLEL DO !------------------------------------------------------------------------- - ! [4.0]: Perform 1D recursive filter in y-direction: + ! [4.0]: convert back from y-trip to normal z-strip: !------------------------------------------------------------------------- ! [4.1] Apply (i',j,k' -> i',j',k) (grid%xp%v1y -> grid%xp%v1z) - ! convert from y-stripe to vertical column. + ! convert from y-stripe to z-strip. call da_transpose_y2z (grid) diff --git a/var/da/da_recursive_filter/da_transform_through_rf_inv.inc b/var/da/da_recursive_filter/da_transform_through_rf_inv.inc new file mode 100644 index 0000000000..5576f66203 --- /dev/null +++ b/var/da/da_recursive_filter/da_transform_through_rf_inv.inc @@ -0,0 +1,189 @@ +subroutine da_transform_through_rf_inv(grid, mz,rf_alpha, val, field, scaling) + + !--------------------------------------------------------------------------- + ! Purpose: Inverse transform of the recursive filter. + ! Based on da_transform_through_rf_adj + ! + ! Author: Zhiquan (Jake) Liu, NCAR/MMM, 2015-09 + ! + ! Method: 1) Apply inverse filter first in y-direction. + ! 2) then apply inverse filter in x-direction + !--------------------------------------------------------------------------- + + implicit none + + type(domain), intent(inout) :: grid + integer, intent(in) :: mz ! Vertical truncation. + real*8, intent(in) :: rf_alpha(mz) ! RF scale parameter. + real*8, intent(in) :: val(jds:jde,mz) ! Error standard deviation. + real, intent(inout) :: field(ims:ime,jms:jme,kms:kme) ! Field to be transformed. + + integer :: rf_passes_over_two ! rf_passes / 2 + integer :: i, j, m, n, pass, ij ! Loop counters. + real :: p_x(ims:ime,jms:jme) ! sqrt(Grid box area). + real*8 :: val_j(grid%xp%jtsy:grid%xp%jtey) + real*8 :: val_i(grid%xp%itsx:grid%xp%itex) + + logical, optional, intent(in) :: scaling + + !------------------------------------------------------------------------- + ! [1.0]: Initialise: + !------------------------------------------------------------------------- + + if (trace_use_dull) call da_trace_entry("da_transform_through_rf_inv") + + write (*,*) 'mz= ', mz + !write (*,*) 'rf_alpha= ', rf_alpha + !write (*,*) 'eigval= ', val + !write (*,*) 'vert_corr=', vert_corr, ' vert_corr_1=', vert_corr_1 + + + rf_passes_over_two = rf_passes / 2 + + ! [1.1] Define inner product (square root of grid box area): + !$OMP PARALLEL DO & + !$OMP PRIVATE (ij, i, j) + do ij = 1 , grid%num_tiles + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + p_x(i,j) = sqrt(grid%xb%grid_box_area(i,j)) + end do + end do + end do + !$OMP END PARALLEL DO + + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij, m, i, j ) + do ij = 1 , grid%num_tiles + do m = 1, mz + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + grid%xp%v1z(i,j,m) = 0.0 + end do + end do + end do + end do + !$OMP END PARALLEL DO + + !------------------------------------------------------------------------- + ! [4.0]: Perform 1D recursive filter in y-direction: + !------------------------------------------------------------------------- + + ! [4.3] Optionally scale by background error: + ! be_s % val = Gridpoint standard deviation - only required for + ! vert_corr = vert_corr_1 as scaling is performed in vertical transform + ! for vert_corr = vert_corr_2: + + if (vert_corr == vert_corr_1 .or. (present(scaling))) then + if (scaling .or. vert_corr == vert_corr_1) then + do m = 1, mz + do i = its, ite + field(i,jts:jte,m) = field(i,jts:jte,m) / val(jts:jte,m) + end do + end do + end if + end if + + ! [4.2] Transform filtered field to dimensional space: + + !$OMP PARALLEL DO & + !$OMP PRIVATE (ij ,m, j, i) + do ij = 1 , grid%num_tiles + do m = 1, mz + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + grid%xp%v1z(i,j,m) = field(i,j,m) / p_x(i,j) + end do + end do + end do + end do + !$OMP END PARALLEL DO + + ! [4.1] Apply (i',j',k -> i',j,k') (grid%xp%v1z -> grid%xp%v1y) + ! convert z-strip to y-stripe + + call da_transpose_z2y (grid) + + !------------------------------------------------------------------------- + ! [3.0]: Perform 1D recursive filter in y-direction: + !------------------------------------------------------------------------- + + ! [3.2] Apply 1D filter in y direction: + + n=grid%xp%jtey-grid%xp%jtsy+1 + !$OMP PARALLEL DO & + !$OMP PRIVATE (m, i, val_j, pass, j) + do m = grid%xp%ktsy, min(grid%xp%ktey, mz) + do i = grid%xp%itsy, grid%xp%itey + do j = grid%xp%jtsy, grid%xp%jtey + val_j(j) = grid%xp%v1y(i,j,m) + end do + do pass = rf_passes_over_two, 1, -1 + call da_recursive_filter_1d_inv(pass, rf_alpha(m), val_j, n) + end do + do j = grid%xp%jtsy, grid%xp%jtey + grid%xp%v1y(i,j,m) = val_j(j) + end do + end do + end do + !$OMP END PARALLEL DO + + ! [3.1] Apply (i',j,k' -> i,j',k') (grid%xp%v1y -> grid%xp%v1x) + ! convert from y-stripe to x-stripe + + call da_transpose_y2x (grid) + + !------------------------------------------------------------------------- + ! [2.0]: Perform 1D recursive filter in x-direction: + !------------------------------------------------------------------------- + + ! [2.2] Apply 1D filter in x direction: + + n = grid%xp%itex-grid%xp%itsx+1 + + !$OMP PARALLEL DO & + !$OMP PRIVATE ( m, j, pass, i, val_i) + do m = grid%xp%ktsx, min(grid%xp%ktex,mz) + do j = grid%xp%jtsx, grid%xp%jtex + do i = grid%xp%itsx, grid%xp%itex + val_i(i) = grid%xp%v1x(i,j,m) + end do + do pass = rf_passes_over_two, 1, -1 + call da_recursive_filter_1d_inv(pass, rf_alpha(m), val_i, n) + end do + do i = grid%xp%itsx, grid%xp%itex + grid%xp%v1x(i,j,m) = val_i(i) + end do + end do + end do + !$OMP END PARALLEL DO + + ! [2.1] Apply (i,j',k' -> i',j',k) (grid%xp%v1x -> grid%xp%v1z) + ! convert from x-stripe to normal z-strip + + call da_transpose_x2z (grid) + + !------------------------------------------------------------------------- + ! [1.0]: Initialise: + !------------------------------------------------------------------------- + + ! [1.2] Transform to nondimensional v_hat space: + + !$OMP PARALLEL DO & + !$OMP PRIVATE (ij ,m, i, j) + do ij = 1 , grid%num_tiles + do m = 1, mz + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + field(i,j,m) = grid%xp%v1z(i,j,m) * p_x(i,j) + end do + end do + end do + end do + !$OMP END PARALLEL DO + + if (trace_use_dull) call da_trace_exit("da_transform_through_rf_inv") + +end subroutine da_transform_through_rf_inv + + diff --git a/var/da/da_setup_structures/da_setup_be_regional.inc b/var/da/da_setup_structures/da_setup_be_regional.inc index 7869f120ca..f87b94d14e 100644 --- a/var/da/da_setup_structures/da_setup_be_regional.inc +++ b/var/da/da_setup_structures/da_setup_be_regional.inc @@ -121,7 +121,7 @@ subroutine da_setup_be_regional(xb, be, grid) real, allocatable :: regcoeff_chi_u_rh(:,:,:) ! chi_u/rh regression coefficient real, allocatable :: regcoeff_t_u_rh(:,:,:) ! t_u/rh regression coefficient real, allocatable :: regcoeff_ps_u_rh(:,:) ! ps_u/rh regression coefficient - real :: qrain_th_low, qrain_th_high + !real :: qrain_th_low, qrain_th_high integer :: be_unit, ier, be_rf_unit, be_print_unit, it, idummy @@ -171,11 +171,13 @@ subroutine da_setup_be_regional(xb, be, grid) rewind (be_unit) read (be_unit, iostat=ier) ni, nj, nk + print *, 'ni, nj, nk = ', ni, nj, nk if (ier /= 0) then write (unit=message(1),fmt='(a,i3)') 'Error in reading be.dat, unit= ',be_unit call da_error(__FILE__,__LINE__,message(1:1)) end if read (be_unit) bin_type + print *, 'bin_type = ', bin_type !-----------for interpolating CV5-------------------------------------------------------------- if ( .not. interpolate_stats ) then @@ -222,20 +224,26 @@ subroutine da_setup_be_regional(xb, be, grid) allocate (bin(1:ni,1:nj,1:nk)) allocate (bin2d(1:ni,1:nj)) - if(cloud_cv_options.eq.2)then - read (be_unit)num_bins, num_bins2d - read (be_unit)lat_min, lat_max, binwidth_lat - read (be_unit)hgt_min, hgt_max, binwidth_hgt - read (be_unit)qrain_th_low, qrain_th_high - read (be_unit)bin(1:ni,1:nj,1:nk) - read (be_unit)bin2d(1:ni,1:nj) - else + !if(cloud_cv_options.eq.2)then + ! read (be_unit)num_bins, num_bins2d + ! read (be_unit)lat_min, lat_max, binwidth_lat + ! read (be_unit)hgt_min, hgt_max, binwidth_hgt + ! read (be_unit)qrain_th_low, qrain_th_high + ! read (be_unit)bin(1:ni,1:nj,1:nk) + ! read (be_unit)bin2d(1:ni,1:nj) + !else read (be_unit)lat_min, lat_max, binwidth_lat read (be_unit)hgt_min, hgt_max, binwidth_hgt read (be_unit)num_bins, num_bins2d read (be_unit)bin(1:ni,1:nj,1:nk) read (be_unit)bin2d(1:ni,1:nj) - end if + !end if + + print *, lat_min, lat_max, binwidth_lat + print *, hgt_min, hgt_max, binwidth_hgt + print *, 'num_bins, num_bins2d = ', num_bins, num_bins2d + print *, 'bin = ', bin(1:1,1:1,1:1) + print *, 'bin2d = ', bin2d(1:1,1:1) num_cv_3d_basic = 4 num_cv_3d_extra = 0 @@ -583,14 +591,14 @@ subroutine da_setup_be_regional(xb, be, grid) be % v7 % name = "qrain" be % v8 % name = "qice" be % v9 % name = "qsnow" - be % v10 % name = "qgraupel" + be % v10 % name = "qgraup" be6_eval_glo = 1.0e-6 be7_eval_glo = 1.0e-6 be8_eval_glo = 1.0e-6 be9_eval_glo = 1.0e-6 be10_eval_glo = 1.0e-6 if ( use_cv_w ) then - be % v11 % name = "z-wind" + be % v11 % name = "w" be11_eval_glo = 1.0 end if if ( use_rf ) then @@ -607,9 +615,11 @@ subroutine da_setup_be_regional(xb, be, grid) ! 2.2 Read in the eigenvector and eigenvalue + print *, '-------- reading eigen vector/value -------' do i = 1 , num_cv_3d_basic read (be_unit) variable read (be_unit) nk, num_bins2d + print *, trim(adjustl(variable)), nk, num_bins2d if ( i == 1 ) then allocate (evec_loc(1:nk,1:nk,1:num_bins2d)) allocate (eval_loc(1:nk, 1:num_bins2d)) @@ -677,6 +687,7 @@ subroutine da_setup_be_regional(xb, be, grid) read (be_unit) variable read (be_unit) nk, num_bins2d + print *, trim(adjustl(variable)), nk, num_bins2d select case( trim(adjustl(variable)) ) @@ -728,9 +739,9 @@ subroutine da_setup_be_regional(xb, be, grid) be9_eval_loc(j,1:nk ) = eval_loc(1:nk,b) end do - case ('qgraupel' ) + case ('qgraup' ) be % v10 % name = trim(adjustl(variable)) - read (be_unit) nk, num_bins2d + !read (be_unit) nk, num_bins2d read (be_unit) be10_evec_glo read (be_unit) be10_eval_glo read (be_unit) evec_loc @@ -741,15 +752,9 @@ subroutine da_setup_be_regional(xb, be, grid) be10_eval_loc(j,1:nk ) = eval_loc(1:nk,b) end do - case default; - message(1)=' Read problem in eigen vectors/values in BE file ' - write (unit=message(2),fmt='(A,A)') ' Trying to read Eigenvectors for variable: ',trim(adjustl(variable)) - write (unit=message(3),fmt='(A)') ' Make sure you are using the correct be.dat file for your cv_options setting!' - call da_error(__FILE__,__LINE__,message(1:3)) - end select - - if ( use_cv_w ) then - if ( trim(adjustl(variable)) == 'z-wind' ) then + case ('w' ) + !if ( use_cv_w ) then + ! if ( trim(adjustl(variable)) == 'w' ) then be % v11 % name = trim(adjustl(variable)) read (be_unit) be11_evec_glo read (be_unit) be11_eval_glo @@ -760,10 +765,17 @@ subroutine da_setup_be_regional(xb, be, grid) be11_evec_loc(j,1:nk,1:nk) = evec_loc(1:nk,1:nk,b) be11_eval_loc(j,1:nk ) = eval_loc(1:nk,b) end do - end if - end if + ! end if + !end if - end do ! num_cv_3d_basic+1 - num_cv_3d_basic+num_cv_3d_extra + case default; + message(1)=' Read problem in eigen vectors/values in BE file ' + write (unit=message(2),fmt='(A,A)') ' Trying to read Eigenvectors for variable: ',trim(adjustl(variable)) + write (unit=message(3),fmt='(A)') ' Make sure you are using the correct be.dat file for your cv_options setting!' + call da_error(__FILE__,__LINE__,message(1:3)) + end select + + end do ! num_cv_3d_basic+1 - num_cv_3d_basic+num_cv_3d_extra-1 end if ! cloud_cv_options=2 @@ -774,6 +786,8 @@ subroutine da_setup_be_regional(xb, be, grid) read (be_unit) variable read (be_unit) nk_2d, num_bins2d + print *, trim(adjustl(variable)), nk_2d, num_bins2d + !hcl-why !#ifdef CLOUD_CV ! nk_2d=1 @@ -822,7 +836,7 @@ subroutine da_setup_be_regional(xb, be, grid) end if if ( use_cv_w ) then write (unit=message(5),fmt='(3x,A)') & - 'z-wind control variable is activated' + 'w control variable is activated' end if call da_message(message(1:5)) @@ -857,8 +871,10 @@ subroutine da_setup_be_regional(xb, be, grid) ! 3.2 read in the scale lengths + print *, '----- read lengthscale --------' do i = 1 , num_cv_3d_basic read (be_unit) variable + print *, trim(adjustl(variable)) select case( trim(adjustl(variable)) ) case ('psi', 'u') read(be_unit) rfls1_be @@ -882,6 +898,7 @@ subroutine da_setup_be_regional(xb, be, grid) if ( cloud_cv_options == 2 ) then do i = num_cv_3d_basic+1 , num_cv_3d_basic+num_cv_3d_extra read (be_unit) variable + print *, trim(adjustl(variable)) select case( trim(adjustl(variable)) ) case ('qcloud') read(be_unit) be6_rf_lengthscale @@ -891,24 +908,26 @@ subroutine da_setup_be_regional(xb, be, grid) read(be_unit) be8_rf_lengthscale case ('qsnow') read(be_unit) be9_rf_lengthscale - case ('qgraupel') + case ('qgraup') read(be_unit) be10_rf_lengthscale + case ('w') + !if ( use_cv_w ) then + ! if ( trim(adjustl(variable)) == 'w' ) then + read(be_unit) be11_rf_lengthscale + ! end if + !end if case default; message(1)='Read problem in lengthscales in be.dat' write(message(2),'("Trying to read lengthscales for variable ",I0,": ",A)')i,trim(adjustl(variable)) call da_error(__FILE__,__LINE__,message(1:2)) end select - if ( use_cv_w ) then - if ( trim(adjustl(variable)) == 'z-wind' ) then - read(be_unit) be11_rf_lengthscale - end if - end if end do ! num_cv_3d_basic+1 - num_cv_3d_basic+num_cv_3d_extra end if ! Read in lengthscale of 2D Control variable ps_u read (be_unit) variable + print *, trim(adjustl(variable)) if ( trim(adjustl(variable)) /= 'ps_u' .and. & trim(adjustl(variable)) /= 'ps' ) then message(1)='Read problem in lengthscales in be.dat' diff --git a/var/da/da_setup_structures/da_setup_structures.f90 b/var/da/da_setup_structures/da_setup_structures.f90 index aa85997e6c..14bf3fe1f3 100644 --- a/var/da/da_setup_structures/da_setup_structures.f90 +++ b/var/da/da_setup_structures/da_setup_structures.f90 @@ -5,7 +5,7 @@ module da_setup_structures !--------------------------------------------------------------------------- use da_wavelet, only: lf,namw,nb,nij,ws - use module_domain, only : xb_type, ep_type, domain + use module_domain, only : xb_type, ep_type, domain, vp_type use da_define_structures, only : xbx_type,be_subtype, be_type, y_type, j_type, & iv_type,da_allocate_background_errors,da_allocate_observations, & @@ -139,6 +139,7 @@ module da_setup_structures #include "da_lcl.inc" #include "da_cumulus.inc" #include "da_qfrmrh.inc" +#include "da_write_vp.inc" #include "da_write_increments.inc" #include "da_write_increments_for_wrf_nmm_regional.inc" #include "da_write_kma_increments.inc" diff --git a/var/da/da_setup_structures/da_write_vp.inc b/var/da/da_setup_structures/da_write_vp.inc new file mode 100644 index 0000000000..75bcf4d42f --- /dev/null +++ b/var/da/da_setup_structures/da_write_vp.inc @@ -0,0 +1,195 @@ +subroutine da_write_vp (grid,vp,filename) + + !---------------------------------------------------------------------- + ! Purpose: Write vp, full varibles after balance transform Up + ! will be interpolated into higher resolution by offline program + ! Method: based on da_write_increments.inc + ! Author: Zhiquan (Jake) Liu, NCAR/MMM, 2015-09 + ! add cloud and w variables, 2017-07 + !---------------------------------------------------------------------- + + implicit none + + type (domain), intent(in) :: grid + type(vp_type), intent(in) :: vp + character(len=16), intent(in) :: filename + + ! Arrays for write out increments: + integer :: ix, jy, kz +#ifdef DM_PARALLEL + !real, dimension(1:grid%xb%mix,1:grid%xb%mjy) :: gbuf_2d + !real, dimension(1:grid%xb%mix+1,1:grid%xb%mjy+1) :: gbuf_2dd + real, dimension(1:grid%xb%mix,1:grid%xb%mjy,1:grid%xb%mkz) :: gbuf + + !real, dimension(1:grid%xb%mix,1:grid%xb%mjy,1:grid%xb%mkz+1) :: wgbuf + real, dimension(:,:,:), allocatable :: v1_global, v2_global, & + v3_global, v4_global, v5_global + real, dimension(:,:,:), allocatable :: v6_global, v7_global, & + v8_global, v9_global, v10_global, v11_global +#endif + + integer :: vp_unit, vp_local_unit + character(len=7) :: vpfile + + if (trace_use) call da_trace_entry("da_write_vp") + + + ! Dimension of the domain (unstagered): + ix = grid%xb%mix + jy = grid%xb%mjy + kz = grid%xb%mkz + +#ifdef DM_PARALLEL + + ! 3-d and 2-d increments: + + allocate ( v1_global (1:ix,1:jy,1:kz)) + allocate ( v2_global (1:ix,1:jy,1:kz)) + allocate ( v3_global (1:ix,1:jy,1:kz)) + allocate ( v4_global (1:ix,1:jy,1:kz)) + allocate ( v5_global (1:ix,1:jy,1:kz)) + if ( cloud_cv_options >= 2 ) then + allocate ( v6_global (1:ix,1:jy,1:kz)) + allocate ( v7_global (1:ix,1:jy,1:kz)) + allocate ( v8_global (1:ix,1:jy,1:kz)) + allocate ( v9_global (1:ix,1:jy,1:kz)) + allocate ( v10_global (1:ix,1:jy,1:kz)) + end if + if ( use_cv_w ) then + allocate ( v11_global (1:ix,1:jy,1:kz)) + end if + + call da_patch_to_global(grid, vp % v1, gbuf) ! psi or u + if (rootproc) then + v1_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) + end if + + call da_patch_to_global(grid, vp % v2, gbuf) ! chi_u or v + if (rootproc) then + v2_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) + end if + + call da_patch_to_global(grid, vp % v3, gbuf) ! t_u or t + if (rootproc) then + v3_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) + end if + + call da_patch_to_global(grid, vp % v4, gbuf) ! q/qs + if (rootproc) then + v4_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) + end if + + !print *, "local size v5: ", size(vp % v5,1),size(vp % v5,2),size(vp % v5,3) + call da_patch_to_global(grid, vp % v5, gbuf) ! Ps (:,:,1) + if (rootproc) then + v5_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) + end if + + if ( cloud_cv_options >= 2 ) then + call da_patch_to_global(grid, vp % v6, gbuf) ! qcloud + if (rootproc) then + v6_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) + end if + + call da_patch_to_global(grid, vp % v7, gbuf) ! qrain + if (rootproc) then + v7_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) + end if + + call da_patch_to_global(grid, vp % v8, gbuf) ! qice + if (rootproc) then + v8_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) + end if + + call da_patch_to_global(grid, vp % v9, gbuf) ! qsnow + if (rootproc) then + v9_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) + end if + + call da_patch_to_global(grid, vp % v10, gbuf) ! qgraupel + if (rootproc) then + v10_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) + end if + end if ! cloud_cv_options + + if ( use_cv_w ) then + call da_patch_to_global(grid, vp % v11, gbuf) ! w + if (rootproc) then + v11_global(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) + end if + end if + + !write(unit=vpfile,fmt='(a,i4.4)') 'vp_',myproc + !call da_get_unit(vp_local_unit) + !open(unit=vp_local_unit, file=trim(vpfile), form='unformatted') + + !print *, "local: ips,ipe,jps,jpe,kps,kpe=", ips,ipe,jps,jpe,kps,kpe + !print *, "local: ims,ime,jms,jme,kms,kme=", ims,ime,jms,jme,kms,kme + !print *, "local: dimx, dimy, dimz=", size(vp%v5,1),size(vp%v5,2),size(vp%v5,3) + + !write (unit=vp_local_unit) ips,ipe,jps,jpe,kps,kpe, & + ! ims,ime,jms,jme,kms,kme, & + ! size(vp%v5,1),size(vp%v5,2),size(vp%v5,3) + + !write (unit=vp_local_unit) vp%v1, vp%v2, & + ! vp%v3, vp%v4, vp%v5 + + !close(vp_local_unit) + !call da_free_unit(vp_local_unit) + + +#endif + + if (rootproc) then + call da_get_unit(vp_unit) + open(unit=vp_unit, file=trim(filename), form='unformatted') + + !print *, "ANALYSIS_DATE= ", ANALYSIS_DATE + !write (unit=vp_unit) ANALYSIS_DATE + + print *, "write_vp: Global ix, jy, kz=", ix, jy, kz + write (unit=vp_unit) ix, jy, kz + +#ifdef DM_PARALLEL + + ! 3d- and 2d-increments in vp space: + write (unit=vp_unit) v1_global, v2_global, & + v3_global, v4_global, v5_global + + if ( cloud_cv_options >= 2 ) then + write (unit=vp_unit) v6_global, v7_global, & + v8_global, v9_global, v10_global + end if + if ( use_cv_w ) write (unit=vp_unit) v11_global + + close(vp_unit) + call da_free_unit(vp_unit) + +#else + + ! 3d- and 2d-increments: + write (unit=vp_unit) vp%v1(1:ix,1:jy,1:kz), & + vp%v2(1:ix,1:jy,1:kz), & + vp%v3(1:ix,1:jy,1:kz), & + vp%v4(1:ix,1:jy,1:kz), & + vp%v5(1:ix,1:jy,1) + if ( cloud_cv_options >= 2 ) then + write (unit=vp_unit) vp%v6(1:ix,1:jy,1:kz), & + vp%v7(1:ix,1:jy,1:kz), & + vp%v8(1:ix,1:jy,1:kz), & + vp%v9(1:ix,1:jy,1:kz), & + vp%v10(1:ix,1:jy,1:kz) + end if + if ( use_cv_w ) write (unit=vp_unit) vp%v11(1:ix,1:jy,1:kz) + + close(vp_unit) + call da_free_unit(vp_unit) +#endif + + end if + + if (trace_use) call da_trace_exit("da_write_vp") + +end subroutine da_write_vp + + diff --git a/var/da/da_vtox_transforms/da_transform_vptox.inc b/var/da/da_vtox_transforms/da_transform_vptox.inc index 35b75ceffd..a72d6faae5 100644 --- a/var/da/da_vtox_transforms/da_transform_vptox.inc +++ b/var/da/da_vtox_transforms/da_transform_vptox.inc @@ -9,6 +9,12 @@ subroutine da_transform_vptox(grid, vp, be, ep) ! ! Implementation of multi-variate BE for cv_options=6 ! Syed RH Rizvi, MMM/NESL/NCAR, Date: 02/01/2010 + !------------------------ + ! Zhiquan (Jake) Liu, NCAR/MMM, 2015-09 + ! re-order transforms to avoid local chi_u and store full variables in vp + ! full vp will be written out and used as input of inverse U transform + ! for multi-resolution incremental 4DVAR + ! order: v4 (rh), v3 (T), v5 (Ps), v2 (Chi_u -> Chi) !----------------------------------------------------------------------- implicit none @@ -21,7 +27,7 @@ subroutine da_transform_vptox(grid, vp, be, ep) ! integer, intent(in), optional :: nobwin integer :: i, k, j, k1, ij ! Loop counters. - real, allocatable :: chi_u(:,:,:) ! Unbalanced chi + !real, allocatable :: chi_u(:,:,:) ! Unbalanced chi if (trace_use) call da_trace_entry("da_transform_vptox") @@ -41,43 +47,38 @@ subroutine da_transform_vptox(grid, vp, be, ep) !$OMP PRIVATE ( ij, k1, k, j, i) do ij = 1 , grid%num_tiles + ! 2.1 Pseudo rh_u to Pseudo rh (only for cv6) + ! do moisture first to avoid local (chi_u,t_t,Ps_u) variables + !-------------------------------------------------------------- if ( cv_options == 6 ) then - allocate (chi_u(its:ite,grid%j_start(ij):grid%j_end(ij),kts:kte) ) - do k = kts, kte - do j = grid%j_start(ij), grid%j_end(ij) - do i = its, ite - chi_u(i,j,k) = vp%v2(i,j,k) + do k1 = kts, kte + do k = kts, kte + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + vp%v4(i,j,k1) = vp%v4(i,j,k1) + be%reg_psi_rh(j,k1,k)*vp%v1(i,j,k) + & + be%reg_chi_u_rh(j,k1,k)*vp%v2(i,j,k) + be%reg_t_u_rh(j,k1,k)*vp%v3(i,j,k) + end do end do end do end do - end if - - ! Chi: - if (cv_options /= 7) then +! do k = kts, kte do j = grid%j_start(ij), grid%j_end(ij) do i = its, ite - vp%v2(i,j,k) = vp%v2(i,j,k) + be%reg_psi_chi(j,k)* vp%v1(i,j,k) + vp%v4(i,j,k) = vp%v4(i,j,k) + be%reg_ps_u_rh(j,k)*vp%v5(i,j,1) end do end do end do end if - - ! Temperature: - do k = kts, kte - do j = grid%j_start(ij), grid%j_end(ij) - do i = its, ite - grid%xa%t(i,j,k) = vp%v3(i,j,k) - end do - end do - end do + ! 2.2 t_u --> t, do this before chi_u --> chi + !---------------------------------------------- if (cv_options /= 7) then do k1 = kts, kte do k = kts, kte do j = grid%j_start(ij), grid%j_end(ij) do i = its, ite - grid%xa%t(i,j,k) = grid%xa%t(i,j,k) + be%reg_psi_t(j,k,k1)*vp%v1(i,j,k1) + vp%v3(i,j,k) = vp%v3(i,j,k) + be%reg_psi_t(j,k,k1)*vp%v1(i,j,k1) end do end do end do @@ -89,25 +90,28 @@ subroutine da_transform_vptox(grid, vp, be, ep) do k = kts, kte do j = grid%j_start(ij), grid%j_end(ij) do i = its, ite - grid%xa%t(i,j,k) = grid%xa%t(i,j,k) + be%reg_chi_u_t(j,k,k1)*chi_u(i,j,k1) + vp%v3(i,j,k) = vp%v3(i,j,k) + be%reg_chi_u_t(j,k,k1)*vp%v2(i,j,k1) end do end do end do end do end if - ! Surface Pressure - do j = grid%j_start(ij), grid%j_end(ij) - do i = its, ite - grid%xa%psfc(i,j) = vp%v5(i,j,1) + do k = kts, kte + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + grid%xa%t(i,j,k) = vp%v3(i,j,k) + end do end do end do + ! 2.3 Ps_u --> Ps, do this before chi_u --> chi + !------------------------------------------------- if (cv_options /= 7) then do k = kts,kte do j = grid%j_start(ij), grid%j_end(ij) do i = its, ite - grid%xa%psfc(i,j) = grid%xa%psfc(i,j) + be%reg_psi_ps(j,k)*vp%v1(i,j,k) + vp%v5(i,j,1) = vp%v5(i,j,1) + be%reg_psi_ps(j,k)*vp%v1(i,j,k) end do end do end do @@ -117,36 +121,31 @@ subroutine da_transform_vptox(grid, vp, be, ep) do k = kts,kte do j = grid%j_start(ij), grid%j_end(ij) do i = its, ite - grid%xa%psfc(i,j) = grid%xa%psfc(i,j) + be%reg_chi_u_ps(j,k)*chi_u(i,j,k) + vp%v5(i,j,1) = vp%v5(i,j,1) + be%reg_chi_u_ps(j,k)*vp%v2(i,j,k) end do end do end do end if - ! Moisture - if ( cv_options == 6 ) then - do k1 = kts, kte - do k = kts, kte - do j = grid%j_start(ij), grid%j_end(ij) - do i = its, ite - vp%v4(i,j,k1) = vp%v4(i,j,k1) + be%reg_psi_rh(j,k1,k)*vp%v1(i,j,k) + & - be%reg_chi_u_rh(j,k1,k)*chi_u(i,j,k) + be%reg_t_u_rh(j,k1,k)*vp%v3(i,j,k) - end do - end do - end do + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + grid%xa%psfc(i,j) = vp%v5(i,j,1) end do -! + end do + + ! 2.4 Chi_u --> Chi, do this last + !----------------------------------- + if (cv_options /= 7) then do k = kts, kte do j = grid%j_start(ij), grid%j_end(ij) do i = its, ite - vp%v4(i,j,k) = vp%v4(i,j,k) + be%reg_ps_u_rh(j,k)*vp%v5(i,j,1) + vp%v2(i,j,k) = vp%v2(i,j,k) + be%reg_psi_chi(j,k)* vp%v1(i,j,k) end do end do end do end if - ! - if ( cv_options == 6 ) deallocate (chi_u ) +! if ( cv_options == 6 ) deallocate (chi_u ) end do !$OMP END PARALLEL DO diff --git a/var/da/da_vtox_transforms/da_transform_vptox_inv.inc b/var/da/da_vtox_transforms/da_transform_vptox_inv.inc new file mode 100644 index 0000000000..93649b675e --- /dev/null +++ b/var/da/da_vtox_transforms/da_transform_vptox_inv.inc @@ -0,0 +1,174 @@ +subroutine da_transform_vptox_inv(grid, vp, be, ep) + + !----------------------------------------------------------------------- + ! Purpose: Inverse of balance (physical) transform of increment + ! + ! Author: Zhiquan (Jake) Liu, NCAR/MMM, 2015-9 + !----------------------------------------------------------------------- + + implicit none + + type (domain), intent(inout) :: grid + + type (vp_type), intent(inout) :: vp ! input: full variables + ! output: unbalanced variables on model grid + type (be_type), intent(in), optional :: be ! Background errors. + type (ep_type), intent(in), optional :: ep ! Ensemble perturbations. + + integer :: i, k, j, k1, ij ! Loop counters. + real, allocatable :: chi_u(:,:,:) ! Unbalanced chi + + if (trace_use) call da_trace_entry("da_transform_vptox_inv") + + !--------------------------------------------------------------------------- + ! [1] Add flow-dependent increments in control variable space (vp): + !--------------------------------------------------------------------------- + + !if (be % ne > 0 .and. alphacv_method == alphacv_method_vp) then + ! call da_add_flow_dependence_vp(be % ne, ep, vp, its,ite, jts,jte, kts,kte) + ! call da_add_flow_dependence_vp_inv !!! ?? + !end if + + !-------------------------------------------------------------------------- + ! [2] Impose statistical balance constraints: + ! Assume input vp%* is full variable, out vp% is unbalanced variables + ! to avoid (Psi,Chi) -> (U,V) transform, which has no exact inverse, + ! we need to store full variables at vp%* after each outloop. + ! da_transform_vptox.inc is also modified for this purpose. + ! + ! for cv7, control variables are all full variables w/o multi-variate correlation. + ! so there is no need for balance transform and its inverse. + !-------------------------------------------------------------------------- + + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij, k1, k, j, i) + do ij = 1 , grid%num_tiles + + ! 2.1 Psi, Chi --> Psi, Chi_u + !------------------------- + ! there is no need for Psi --> Psi transform + + ! Chi --> Chi_u + !-------------------- + if (cv_options /= 7) then + do k = kts, kte + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + vp%v2(i,j,k) = vp%v2(i,j,k) - be%reg_psi_chi(j,k)* vp%v1(i,j,k) + end do + end do + end do + end if + + ! 2.2 T --> T_u + !------------------- + if (cv_options /= 7) then ! - balance contri. from psi + do k1 = kts, kte + do k = kts, kte + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + !vp%v3(i,j,k) = grid%xa%t(i,j,k) - be%reg_psi_t(j,k,k1)*vp%v1(i,j,k1) + vp%v3(i,j,k) = vp%v3(i,j,k) - be%reg_psi_t(j,k,k1)*vp%v1(i,j,k1) + end do + end do + end do + end do + end if + + if ( cv_options == 6 ) then ! - balance contri. from Chi_u + do k1 = kts, kte + do k = kts, kte + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + vp%v3(i,j,k) = vp%v3(i,j,k) - be%reg_chi_u_t(j,k,k1)*vp%v2(i,j,k1) + end do + end do + end do + end do + end if + + ! 2.3 Ps --> Ps_u + !------------------------ + !do j = grid%j_start(ij), grid%j_end(ij) + ! do i = its, ite + ! grid%xa%psfc(i,j) = vp%v5(i,j,1) + ! end do + !end do + + if (cv_options /= 7) then ! - balance contri. from psi + do k = kts,kte + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + !vp%v5(i,j,1) = grid%xa%psfc(i,j) - be%reg_psi_ps(j,k)*vp%v1(i,j,k) + vp%v5(i,j,1) = vp%v5(i,j,1) - be%reg_psi_ps(j,k)*vp%v1(i,j,k) + end do + end do + end do + end if + + if ( cv_options == 6 ) then ! - balance contri. from Chi_u + do k = kts,kte + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + vp%v5(i,j,1) = vp%v5(i,j,1) - be%reg_chi_u_ps(j,k)*vp%v2(i,j,k) + end do + end do + end do + end if + + ! 2.4 q --> pseudo rh=q/qs(background) + !---------------------------- + ! if cv5 or cv7, no need for pseudo rh transform + + !do k = kts, kte + ! do j = grid%j_start(ij), grid%j_end(ij) + ! do i = its, ite + ! vp%v4(i,j,k) = grid%xa % q(i,j,k) / grid%xb%qs(i,j,k) + ! enddo + ! enddo + !enddo + + if ( cv_options == 6 ) then + do k1 = kts, kte + do k = kts, kte + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + vp%v4(i,j,k1) = vp%v4(i,j,k1) - & + be%reg_psi_rh(j,k1,k)*vp%v1(i,j,k) - & + be%reg_chi_u_rh(j,k1,k)*vp%v2(i,j,k) - & + be%reg_t_u_rh(j,k1,k)*vp%v3(i,j,k) + end do + end do + end do + end do +! + do k = kts, kte + do j = grid%j_start(ij), grid%j_end(ij) + do i = its, ite + vp%v4(i,j,k) = vp%v4(i,j,k) - be%reg_ps_u_rh(j,k)*vp%v5(i,j,1) + end do + end do + end do + end if + + end do + + !--------------------------------------------------------------------------- + ! [4] Add flow-dependent increments in model space (grid%xa): + !--------------------------------------------------------------------------- + +! if (be % ne > 0 .and. alphacv_method == alphacv_method_xa) then +! call da_add_flow_dependence_xa(grid, be % ne, ep, vp) +! end if +! if (be % ne > 0 .and. alphacv_method == alphacv_method_xa) then +! if ( anal_type_hybrid_dual_res ) then +! call da_add_flow_dependence_xa_dual_res(grid, be % ne, ep, vp) +! else +! call da_add_flow_dependence_xa(grid, be % ne, ep, vp) +! endif +! end if + + if (trace_use) call da_trace_exit("da_transform_vptox_inv") + +end subroutine da_transform_vptox_inv + diff --git a/var/da/da_vtox_transforms/da_transform_vtovv_inv.inc b/var/da/da_vtox_transforms/da_transform_vtovv_inv.inc new file mode 100644 index 0000000000..cf047eb450 --- /dev/null +++ b/var/da/da_vtox_transforms/da_transform_vtovv_inv.inc @@ -0,0 +1,229 @@ +subroutine da_transform_vtovv_inv(grid, cv_size, be, cv, vv) + + !----------------------------------------------------------------------- + ! Purpose: perform inverse transform of horizontal recursive filter + ! + ! Author: Zhiquan (Jake) Liu, NCAR/MMM, 2015-09 + !----------------------------------------------------------------------- + + implicit none + + type(domain), intent(inout) :: grid + integer, intent(in) :: cv_size ! Size of cv array. + type(be_type), intent(in) :: be ! Background error structure. + real, intent(inout) :: cv(cv_size) ! control variables. + type(vp_type), intent(inout) :: vv ! Grid point/EOF control var. + + integer :: s(4) ! Index bounds into arrays. + integer :: n ! Loop counter. + integer :: mz ! Vertical truncation. + integer :: ne ! Ensemble size. + + logical :: scaling + + if (trace_use) call da_trace_entry("da_transform_vtovv_inv") + + if( .not. use_rf .or. do_normalize ) s(1:2)=1 + + + !------------------------------------------------------------------------- + ! [2.0] Perform inverse of VToVV Transform: + !------------------------------------------------------------------------- + + ! [2.1] Transform 1st control variable: + mz = be % v1 % mz + !s(3)=s(1)+mz-1 + !if( do_normalize )call da_transform_rescale(mz,be%sd(:,:,s(1):s(3)),vv%v1) + if( use_rf .and. mz > 0 .and. len_scaling1(1) /= 0.0) then + call da_transform_through_rf_inv(grid, mz, be % v1 % rf_alpha, be % v1 % val, vv % v1) + !elseif( mz > 0 ) then + ! s(4)=s(2)+nij(0,0,2)*nij(0,1,2)*mz-1 + ! call da_transform_through_wavelet_inv(grid,mz,be%wsd(:,:,s(1):s(3)),cv(s(2):s(4)),vv%v1) + ! s(2)=s(4)+1 + !else + ! !print'(a,": be%v1%mz=",I0)',__FILE__,mz + endif + !s(1)=s(3)+1 + + ! [2.2] Transform 2nd control variable: + + mz = be % v2 % mz + !s(3)=s(1)+mz-1 + !if( do_normalize )call da_transform_rescale(mz,be%sd(:,:,s(1):s(3)),vv%v2) + if( use_rf .and. mz > 0 .and. len_scaling2(1) /= 0.0) then + call da_transform_through_rf_inv(grid, mz, be % v2 % rf_alpha, be % v2 % val, vv % v2) + !elseif( mz > 0 ) then + ! s(4)=s(2)+nij(0,0,2)*nij(0,1,2)*mz-1 + ! call da_transform_through_wavelet_inv(grid,mz,be%wsd(:,:,s(1):s(3)),cv(s(2):s(4)),vv%v2) + ! s(2)=s(4)+1 + !else + ! !print'(a,": be%v2%mz=",I0)',__FILE__,mz + endif + !s(1)=s(3)+1 + + ! [2.3] Transform 3rd control variable + + mz = be % v3 % mz + !s(3)=s(1)+mz-1 + !if( do_normalize )call da_transform_rescale(mz,be%sd(:,:,s(1):s(3)),vv%v3) + if( use_rf .and. mz > 0 .and. len_scaling3(1) /= 0.0) then + call da_transform_through_rf_inv(grid, mz, be % v3 % rf_alpha, be % v3 % val, vv % v3) + !elseif( mz > 0 ) then + ! s(4)=s(2)+nij(0,0,2)*nij(0,1,2)*mz-1 + ! call da_transform_through_wavelet_inv(grid,mz,be%wsd(:,:,s(1):s(3)),cv(s(2):s(4)),vv%v3) + ! s(2)=s(4)+1 + !else + ! !print'(a,": be%v3%mz=",I0)',__FILE__,mz + endif + !s(1)=s(3)+1 + + ! [2.4] Transform 4th control variable + + mz = be % v4 % mz + !s(3)=s(1)+mz-1 + !if( do_normalize )call da_transform_rescale(mz,be%sd(:,:,s(1):s(3)),vv%v4) + if( use_rf .and. mz > 0 .and. len_scaling4(1) /= 0.0) then + call da_transform_through_rf_inv(grid, mz, be % v4 % rf_alpha, be % v4 % val, vv % v4) + !elseif( mz > 0 ) then + ! s(4)=s(2)+nij(0,0,2)*nij(0,1,2)*mz-1 + ! call da_transform_through_wavelet_inv(grid,mz,be%wsd(:,:,s(1):s(3)),cv(s(2):s(4)),vv%v4) + ! s(2)=s(4)+1 + !else + ! !print'(a,": be%v4%mz=",I0)',__FILE__,mz + endif + !s(1)=s(3)+1 + + ! [2.5] Transform 5th control variable + + mz = be % v5 % mz + !s(3)=s(1)+mz-1 + !if( do_normalize )call da_transform_rescale(mz,be%sd(:,:,s(1):s(3)),vv%v5) + if( use_rf .and. mz > 0 .and. len_scaling5(1) /= 0.0) then + call da_transform_through_rf_inv(grid, mz, be % v5 % rf_alpha, be % v5 % val, vv % v5) + !elseif( mz > 0 ) then + ! s(4)=s(2)+nij(0,0,2)*nij(0,1,2)*mz-1 + ! call da_transform_through_wavelet_inv(grid,mz,be%wsd(:,:,s(1):s(3)),cv(s(2):s(4)),vv%v5) + ! s(2)=s(4)+1 + !else + ! !print'(a,": be%v5%mz=",I0)',__FILE__,mz + endif + !s(1)=s(3)+1 + + if ( use_rf .and. cloud_cv_options <= 1 ) then + vv % v6 = 0.0 + vv % v7 = 0.0 + vv % v8 = 0.0 + vv % v9 = 0.0 + vv % v10 = 0.0 + vv % v11 = 0.0 + end if + + + ! [2.6] Transform 6th-10th cloud control variables + + if ( use_rf .and. cloud_cv_options >= 2 ) then + select case ( cloud_cv_options ) + case ( 2 ) +!hcl-check array index of len_scaling + mz = be % v6 % mz + if ( mz > 0 .and. len_scaling6(1) > 0.0 ) then + call da_transform_through_rf_inv(grid, mz, be % v6 % rf_alpha, be % v6 % val, vv % v6) + end if + mz = be % v7 % mz + if ( mz > 0 .and. len_scaling7(1) > 0.0 ) then + call da_transform_through_rf_inv(grid, mz, be % v7 % rf_alpha, be % v7 % val, vv % v7) + end if + mz = be % v8 % mz + if ( mz > 0 .and. len_scaling8(1) > 0.0 ) then + call da_transform_through_rf_inv(grid, mz, be % v8 % rf_alpha, be % v8 % val, vv % v8) + end if + mz = be % v9 % mz + if ( mz > 0 .and. len_scaling9(1) > 0.0 ) then + call da_transform_through_rf_inv(grid, mz, be % v9 % rf_alpha, be % v9 % val, vv % v9) + end if + mz = be % v10 % mz + if ( mz > 0 .and. len_scaling10(1) > 0.0 ) then + call da_transform_through_rf_inv(grid, mz, be % v10 % rf_alpha, be % v10 % val, vv % v10) + end if + case ( 3 ) + scaling = .true. + mz = be % v6 % mz + if ( mz > 0 .and. len_scaling6(1) > 0.0 ) then + call da_transform_through_rf_inv(grid, mz, be % v6 % rf_alpha, be % v6 % val, vv % v6, scaling) + end if + mz = be % v7 % mz + if ( mz > 0 .and. len_scaling7(1) > 0.0 ) then + call da_transform_through_rf_inv(grid, mz, be % v7 % rf_alpha, be % v7 % val, vv % v7, scaling) + end if + mz = be % v8 % mz + if ( mz > 0 .and. len_scaling8(1) > 0.0 ) then + call da_transform_through_rf_inv(grid, mz, be % v8 % rf_alpha, be % v8 % val, vv % v8, scaling) + end if + mz = be % v9 % mz + if ( mz > 0 .and. len_scaling9(1) > 0.0 ) then + call da_transform_through_rf_inv(grid, mz, be % v9 % rf_alpha, be % v9 % val, vv % v9, scaling) + end if + mz = be % v10 % mz + if ( mz > 0 .and. len_scaling10(1) > 0.0 ) then + call da_transform_through_rf_inv(grid, mz, be % v10 % rf_alpha, be % v10 % val, vv % v10, scaling) + end if + end select + end if + + ! [2.7] Transform w control variable + + if ( use_rf ) then + if ( .not. use_cv_w ) then + vv % v11 = 0.0 + else + mz = be % v11 % mz + if ( mz > 0 .and. len_scaling11(1) > 0.0 ) then + if ( cloud_cv_options == 2 ) then + call da_transform_through_rf_inv(grid, mz, be % v11 % rf_alpha, be % v11 % val, vv % v11) + else if ( cloud_cv_options == 3 ) then + scaling = .true. + call da_transform_through_rf_inv(grid, mz, be % v11 % rf_alpha, be % v11 % val, vv % v11, scaling) + end if + end if + end if + end if + + + ! [2.8] Transform alpha control variable + + ne = be % ne + if (ne > 0) then + mz = be % alpha % mz + !if( do_normalize )then + ! do n = 1, ne + ! call da_transform_rescale(mz,be%alpha%sd,vv%alpha(:,:,:,n)) + ! end do + !endif + if( use_rf )then + do n = 1, ne + !if ( anal_type_hybrid_dual_res ) then + ! call da_transform_through_rf_inv_dual_res(grid % intermediate_grid, mz, be % alpha % rf_alpha, & + ! be % alpha % val, vv % alpha(:,:,:,n)) + !else + call da_transform_through_rf_inv(grid, mz, be % alpha % rf_alpha, be % alpha % val, vv % alpha(:,:,:,n)) + !endif + end do + !else + !do n = 1, ne + ! s(4)=s(2)+nij(0,0,2)*nij(0,1,2)*mz-1 + ! call da_transform_through_wavelet_inv(grid,mz,be%alpha%wsd,cv(s(2):s(4)),vv%alpha(:,:,:,n)) + ! s(2)=s(4)+1 + !end do + endif + endif + + if( use_rf )then + !------------------------------------------------------------------------- + ! [1.0] Fill 1D cv array from 3-dimensional vv arrays. + !------------------------------------------------------------------------- + call da_vv_to_cv( vv, grid%xp, be%cv_mz, be%ncv_mz, cv_size, cv) + endif + + if (trace_use) call da_trace_exit("da_transform_vtovv_inv") + +endsubroutine da_transform_vtovv_inv diff --git a/var/da/da_vtox_transforms/da_transform_vtox_inv.inc b/var/da/da_vtox_transforms/da_transform_vtox_inv.inc new file mode 100644 index 0000000000..56c56c2433 --- /dev/null +++ b/var/da/da_vtox_transforms/da_transform_vtox_inv.inc @@ -0,0 +1,87 @@ +subroutine da_transform_vtox_inv(grid, cv_size, xbx, be, ep, cv, vv, vp) + + !-------------------------------------------------------------------------- + ! Purpose: Inverse control variable transform v = U^{-1} x'. + !-------------------------------------------------------------------------- + + implicit none + + type(domain), intent(inout) :: grid + integer, intent(in) :: cv_size ! Size of cv array. + type(xbx_type), intent(in) :: xbx ! For header & non-grid arrays. + type(be_type), intent(in) :: be ! background errors. + type(ep_type), intent(in) :: ep ! Ensemble perturbations. + real, intent(out) :: cv(1:cv_size) ! control variables. + type(vp_type), intent(out) :: vv ! grdipt/eof cv (local). + type(vp_type), intent(inout) :: vp ! grdipt/level cv (local). + + if (trace_use) call da_trace_entry("da_transform_vtox_inv") + + call da_zero_x (grid%xa) + + if (.not. use_background_errors) then + if (trace_use) call da_trace_exit("da_transform_vtox_inv") + return + end if + + !---------------------------------------------------------------------- + ! [1.0]: Perform inverse of balance tranform: vp = u_p^{-1} dx + !---------------------------------------------------------------------- + + if ( cv_options /= 7 ) call da_transform_vptox_inv(grid, vp, be, ep) + + !---------------------------------------------------------------------- + ! [2.0]: Perform inverse of vertical transform: vv = L^{-1/2} E^T vp + !---------------------------------------------------------------------- + + !if ( cv_options == 3 ) then + ! + ! call da_apply_be( be, cv, vp, grid) + ! call da_transform_bal( vp, be, grid) + ! + !else + + if (vert_corr == vert_corr_2) then + call da_vertical_transform(grid, 'u_inv', be, grid%xb % vertical_inner_product, vv, vp) + !call da_write_vp(grid,vv,'vv_afterUvTransf') + else + vv % v1(its:ite,jts:jte,kts:kte) = vp % v1(its:ite,jts:jte,kts:kte) + vv % v2(its:ite,jts:jte,kts:kte) = vp % v2(its:ite,jts:jte,kts:kte) + vv % v3(its:ite,jts:jte,kts:kte) = vp % v3(its:ite,jts:jte,kts:kte) + vv % v4(its:ite,jts:jte,kts:kte) = vp % v4(its:ite,jts:jte,kts:kte) + vv % v5(its:ite,jts:jte,kts:kte) = vp % v5(its:ite,jts:jte,kts:kte) + if ( cloud_cv_options >= 2 ) then + vv % v6(its:ite,jts:jte,kts:kte) = vp % v6(its:ite,jts:jte,kts:kte) + vv % v7(its:ite,jts:jte,kts:kte) = vp % v7(its:ite,jts:jte,kts:kte) + vv % v8(its:ite,jts:jte,kts:kte) = vp % v8(its:ite,jts:jte,kts:kte) + vv % v9(its:ite,jts:jte,kts:kte) = vp % v9(its:ite,jts:jte,kts:kte) + vv % v10(its:ite,jts:jte,kts:kte) = vp % v10(its:ite,jts:jte,kts:kte) + end if + if ( use_cv_w ) vv % v11(its:ite,jts:jte,kts:kte) = vp % v11(its:ite,jts:jte,kts:kte) + if (be % ne > 0) then +! vv % alpha(its:ite,jts:jte,kts:kte,1:be%ne) = vp%alpha(its:ite,jts:jte,kts:kte,1:be%ne) + vv % alpha(its_int:ite_int,jts_int:jte_int,kts_int:kte_int,1:be%ne) = & + vp%alpha(its_int:ite_int,jts_int:jte_int,kts_int:kte_int,1:be%ne) + end if + end if + + !---------------------------------------------------------------------- + ! [3.0]: Perform inverse of recursive filter: cv = u_h^{-1} vv + !---------------------------------------------------------------------- + + !if (global) then + ! call da_transform_vtovv_global(cv_size, xbx, be, cv, vv) + !else if ( (fg_format == fg_format_wrf_arw_regional .or. & + ! fg_format == fg_format_wrf_nmm_regional) .and. & + ! (.not. cv_options == 3) )then + + call da_transform_vtovv_inv(grid, cv_size, be, cv, vv) + + !end if + + !end if + + if (trace_use) call da_trace_exit("da_transform_vtox_inv") + +end subroutine da_transform_vtox_inv + diff --git a/var/da/da_vtox_transforms/da_transform_vvtovp.inc b/var/da/da_vtox_transforms/da_transform_vvtovp.inc index e4fa05d871..dfce751467 100644 --- a/var/da/da_vtox_transforms/da_transform_vvtovp.inc +++ b/var/da/da_vtox_transforms/da_transform_vvtovp.inc @@ -4,7 +4,15 @@ subroutine da_transform_vvtovp(grid, evec, eval, vertical_wgt, vv, vp, mz, level ! Purpose: Transform from fields on vertical EOFS to fields on vertical ! levels. ! - ! Method: Perform vp(i,j,k) = P E L^{1/2} vv(i,j,m) transform. + ! Method: Perform vp(i,j,k) = E L^{1/2} vv(i,j,m) transform. + ! + ! Zhiquan (Jake) liu's note: 2015-09 + !------------------------------------------------------------------------- + ! 1. evec/eval assumed to vary in y direction (jds:jde) though it may not + ! be true in BE file (e.g., likely domain-averaged BE with bin_type=5). + ! 2. evec/eval truncated to number of EOF mode mz<=levels + ! 3. eval here is in fact square root of eigen values (see da_allocate_background_errors) + ! 4. by default, vertical weight not calculated/used !--------------------------------------------------------------------------- implicit none diff --git a/var/da/da_vtox_transforms/da_transform_vvtovp_adj.inc b/var/da/da_vtox_transforms/da_transform_vvtovp_adj.inc index ad820375da..c615c01c15 100644 --- a/var/da/da_vtox_transforms/da_transform_vvtovp_adj.inc +++ b/var/da/da_vtox_transforms/da_transform_vvtovp_adj.inc @@ -31,7 +31,7 @@ subroutine da_transform_vvtovp_adj(grid, evec, eval, vertical_wgt, vp, vv, mz, l end if !------------------------------------------------------------------- - ! [2.0] Perform vp(i,j,k) = E L^{1/2} vv(i,j,m) transform: + ! [2.0] Perform vv(i,j,m) = L^{1/2} E^T vp(i,j,k) transform: !------------------------------------------------------------------- !$OMP PARALLEL DO & diff --git a/var/da/da_vtox_transforms/da_transform_vvtovp_inv.inc b/var/da/da_vtox_transforms/da_transform_vvtovp_inv.inc new file mode 100644 index 0000000000..fa620d7f61 --- /dev/null +++ b/var/da/da_vtox_transforms/da_transform_vvtovp_inv.inc @@ -0,0 +1,62 @@ +subroutine da_transform_vvtovp_inv(grid, evec, eval, vertical_wgt, vp, vv, mz, levels) + + !--------------------------------------------------------------------------- + ! Purpose: Inverse of da_transform_vvtovp. + ! based on da_transform_vvtovp_adj + ! + ! Author: Zhiquan (Jake) Liu, NCAR/MMM, 2015-09 + !--------------------------------------------------------------------------- + + implicit none + + type (domain), intent(in) :: grid + integer, intent(in) :: mz ! # vertical modes. + integer, intent(in) :: levels ! no. of vertical levels + + real*8, intent(in) :: evec(jds:jde,kds:kde,1:mz) ! Eigenvectors. + real*8, intent(in) :: eval(jds:jde,1:mz) ! Eigenvalues. + real, intent(in) :: vertical_wgt(ims:ime,jms:jme,kms:kme) ! Weighting. + real, intent(inout) :: vp(ims:ime,jms:jme,kms:kme)! CV in level space. + real, intent(out) :: vv(ims:ime,jms:jme,kms:kme)! CV in EOF space. + + integer :: i, j, m, k, ij ! Loop counters. + real :: temp + + if (trace_use_dull) call da_trace_entry("da_transform_vvtovp_inv") + + !------------------------------------------------------------------- + ! [1.0] Apply inner-product weighting if vertical_ip /= vertical_ip_0: + !------------------------------------------------------------------- + + if (vertical_ip /= vertical_ip_0) then + vp(its:ite,jts:jte,kts:levels) = vp(its:ite,jts:jte,kts:levels) * & + vertical_wgt(its:ite,jts:jte,kts:levels) + end if + + !------------------------------------------------------------------- + ! [2.0] Perform vv(i,j,m) = L^{-1/2} E^T vp(i,j,k) transform: + !------------------------------------------------------------------- + + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij, m, k, j, i, temp ) + do ij = 1 , grid%num_tiles + vv(:,grid%j_start(ij):grid%j_end(ij),:) = 0.0 + do m = 1, mz + do k = kts, levels + do j = grid%j_start(ij), grid%j_end(ij) + temp = evec(j,k,m) / eval(j,m) + + do i = its, ite + vv(i,j,m) = vv(i,j,m) + temp * vp(i,j,k) + end do + end do + end do + end do + end do + !$OMP END PARALLEL DO + + if (trace_use_dull) call da_trace_exit("da_transform_vvtovp_inv") + +end subroutine da_transform_vvtovp_inv + + diff --git a/var/da/da_vtox_transforms/da_vertical_transform.inc b/var/da/da_vtox_transforms/da_vertical_transform.inc index e709bd423a..2fa70c1d00 100644 --- a/var/da/da_vtox_transforms/da_vertical_transform.inc +++ b/var/da/da_vtox_transforms/da_vertical_transform.inc @@ -1,7 +1,13 @@ subroutine da_vertical_transform(grid, string, be, vertical_wgt, vv, vp) !--------------------------------------------------------------------- - ! Purpose: TBD + ! Purpose: perform vertical transform Uv using eigenvector/eigenvalue + ! of vertical covariance + ! + ! Zhiquan (Jake) Liu, NCAR/MMM, 2015-09 + ! 1. add appropriate comments on transform and variables + ! 2. replace inverse transform da_transform_vptovv + ! by da_transform_vvtovp_inv !--------------------------------------------------------------------- implicit none @@ -30,28 +36,28 @@ subroutine da_vertical_transform(grid, string, be, vertical_wgt, vv, vp) if (be % v1 % mz > 0) then call da_transform_vvtovp (grid, be % v1 % evec, be % v1 % val, vertical_wgt, & - vv % v1, vp % v1, be % v1 % mz, kte) + vv % v1, vp % v1, be % v1 % mz, kte) ! psi (stream function) or u (if cv7) else vp % v1(its:ite,jts:jte,kts:kte) = 0.0 end if if (be % v2 % mz > 0) then call da_transform_vvtovp (grid, be % v2 % evec, be % v2 % val, vertical_wgt, & - vv % v2, vp % v2, be % v2 % mz, kte) + vv % v2, vp % v2, be % v2 % mz, kte) ! chi_u (unbalanced chi) or v (if cv7) else vp % v2(its:ite,jts:jte,kts:kte) = 0.0 end if if (be % v3 % mz > 0) then call da_transform_vvtovp (grid, be % v3 % evec, be % v3 % val, vertical_wgt, & - vv % v3, vp % v3, be % v3 % mz, kte) + vv % v3, vp % v3, be % v3 % mz, kte) ! T_u (unbalanced T) or T (if cv7) else vp % v3(its:ite,jts:jte,kts:kte) = 0.0 end if if (be % v4 % mz > 0) then call da_transform_vvtovp (grid, be % v4 % evec, be % v4 % val, vertical_wgt, & - vv % v4, vp % v4, be % v4 % mz, kte) + vv % v4, vp % v4, be % v4 % mz, kte) ! pseudo rh=q/qs(background) else vp % v4(its:ite,jts:jte,kts:kte) = 0.0 end if @@ -61,19 +67,19 @@ subroutine da_vertical_transform(grid, string, be, vertical_wgt, vv, vp) vp % v5(its:ite,jts:jte,1) = vv % v5(its:ite,jts:jte,1) else call da_transform_vvtovp (grid, be % v5 % evec, be % v5 % val, vertical_wgt, & - vv % v5, vp % v5, be % v5 % mz, kts) + vv % v5, vp % v5, be % v5 % mz, kts) ! Ps_u (unbalanced Ps) or Ps (if cv7) end if else vp % v5(its:ite,jts:jte,kts:kts) = 0.0 end if ! for cloud_cv_options<=1 and not use_cv_w - vp % v6 = 0.0 - vp % v7 = 0.0 - vp % v8 = 0.0 - vp % v9 = 0.0 - vp % v10 = 0.0 - vp % v11 = 0.0 + vp % v6 = 0.0 ! cloud water qcw + vp % v7 = 0.0 ! rain water qrain + vp % v8 = 0.0 ! cloud ice qice + vp % v9 = 0.0 ! snow qsnow + vp % v10 = 0.0 ! qgraupel + vp % v11 = 0.0 ! vertical velocity w if ( cloud_cv_options == 2 ) then if (be % v6 % mz > 0) then @@ -142,72 +148,62 @@ subroutine da_vertical_transform(grid, string, be, vertical_wgt, vv, vp) case ('u_inv'); !------------------------------------------------------------------- - ! [2.0] Perform vv(i,j,m) = L^{-1/2} E^T vp(i,j,k) transform: + ! [2.0] Perform inverse transform: vv(i,j,m) = L^{-1/2} E^T vp(i,j,k) !------------------------------------------------------------------- if (be % v1 % mz > 0) then - call da_transform_vptovv (be % v1 % evec, be % v1 % val, vertical_wgt, & - vp % v1, vv % v1, be % v1 % mz, kds,kde, ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) + call da_transform_vvtovp_inv (grid, be % v1 % evec, be % v1 % val, vertical_wgt, & + vp % v1, vv % v1, be % v1 % mz, kte) end if if (be % v2 % mz > 0) then - call da_transform_vptovv (be % v2 % evec, be % v2 % val, vertical_wgt, & - vp % v2, vv % v2, be % v2 % mz, kds,kde, ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) + call da_transform_vvtovp_inv (grid, be % v2 % evec, be % v2 % val, vertical_wgt, & + vp % v2, vv % v2, be % v2 % mz, kte) end if if (be % v3 % mz > 0) then - call da_transform_vptovv (be % v3 % evec, be % v3 % val, vertical_wgt, & - vp % v3, vv % v3, be % v3 % mz, kds,kde, ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) + call da_transform_vvtovp_inv (grid, be % v3 % evec, be % v3 % val, vertical_wgt, & + vp % v3, vv % v3, be % v3 % mz, kte) end if if (be % v4 % mz > 0) then - call da_transform_vptovv (be % v4 % evec, be % v4 % val, vertical_wgt, & - vp % v4, vv % v4, be % v4 % mz, kds,kde, ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) + call da_transform_vvtovp_inv (grid, be % v4 % evec, be % v4 % val, vertical_wgt, & + vp % v4, vv % v4, be % v4 % mz, kte) end if if (be % v5 % mz > 0) then if (global) then vv % v5(its:ite,jts:jte,1) = vp % v5(its:ite,jts:jte,1) else - call da_transform_vptovv (be % v5 % evec, be % v5 % val, vertical_wgt, & - vp % v5, vv % v5, be % v5 % mz, kds,kde, ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) + call da_transform_vvtovp_inv (grid, be % v5 % evec, be % v5 % val, vertical_wgt, & + vp % v5, vv % v5, be % v5 % mz, kts) end if end if if ( cloud_cv_options == 2 ) then if (be % v6 % mz > 0) then - call da_transform_vptovv (be % v6 % evec, be % v6 % val, vertical_wgt, & - vp % v6, vv % v6, be % v6 % mz, kds,kde, ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) + call da_transform_vvtovp_inv (grid, be % v6 % evec, be % v6 % val, vertical_wgt, & + vp % v6, vv % v6, be % v6 % mz, kte) end if if (be % v7 % mz > 0) then - call da_transform_vptovv (be % v7 % evec, be % v7 % val, vertical_wgt, & - vp % v7, vv % v7, be % v7 % mz, kds,kde, ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) + call da_transform_vvtovp_inv (grid, be % v7 % evec, be % v7 % val, vertical_wgt, & + vp % v7, vv % v7, be % v7 % mz, kte) end if if (be % v8 % mz > 0) then - call da_transform_vptovv (be % v8 % evec, be % v8 % val, vertical_wgt, & - vp % v8, vv % v8, be % v8 % mz, kds,kde, ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) + call da_transform_vvtovp_inv (grid, be % v8 % evec, be % v8 % val, vertical_wgt, & + vp % v8, vv % v8, be % v8 % mz, kte) end if if (be % v9 % mz > 0) then - call da_transform_vptovv (be % v9 % evec, be % v9 % val, vertical_wgt, & - vp % v9, vv % v9, be % v9 % mz, kds,kde, ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) + call da_transform_vvtovp_inv (grid, be % v9 % evec, be % v9 % val, vertical_wgt, & + vp % v9, vv % v9, be % v9 % mz, kte) end if if (be % v10 % mz > 0) then - call da_transform_vptovv (be % v10 % evec, be % v10 % val, vertical_wgt, & - vp % v10, vv % v10, be % v10 % mz, kds,kde, ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) + call da_transform_vvtovp_inv (grid, be % v10 % evec, be % v10 % val, vertical_wgt, & + vp % v10, vv % v10, be % v10 % mz, kte) end if else if ( cloud_cv_options == 3 ) then @@ -236,9 +232,8 @@ subroutine da_vertical_transform(grid, string, be, vertical_wgt, vv, vp) if ( use_cv_w ) then if (be % v11 % mz > 0) then if ( cloud_cv_options == 2 ) then - call da_transform_vptovv (be % v11 % evec, be % v11 % val, vertical_wgt, & - vp % v11, vv % v11, be % v11 % mz, kds,kde, ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) + call da_transform_vvtovp_inv (grid, be % v11 % evec, be % v11 % val, vertical_wgt, & + vp % v11, vv % v11, be % v11 % mz, kte) else if ( cloud_cv_options == 3 ) then vv % v11 = vp % v11 end if @@ -250,17 +245,21 @@ subroutine da_vertical_transform(grid, string, be, vertical_wgt, vv, vp) ! call da_transform_vptovv (be % alpha % evec, be % alpha % val, vertical_wgt, & ! vp % alpha(:,:,:,n), vv % alpha(:,:,:,n), be % alpha % mz, kds,kde, & ! ims,ime, jms,jme, kms,kme, its,ite, jts,jte, kts,kte) - call da_transform_vptovv (be % alpha % evec, be % alpha % val, vertical_wgt, & - vp % alpha(:,:,:,n), vv % alpha(:,:,:,n), be % alpha % mz, kds_int,kde_int, & - ims_int,ime_int, jms_int,jme_int, kms_int,kme_int, its_int,ite_int, & - jts_int,jte_int, kts_int,kte_int) +! call da_transform_vptovv (be % alpha % evec, be % alpha % val, vertical_wgt, & +! vp % alpha(:,:,:,n), vv % alpha(:,:,:,n), be % alpha % mz, kds_int,kde_int, & +! ims_int,ime_int, jms_int,jme_int, kms_int,kme_int, its_int,ite_int, & +! jts_int,jte_int, kts_int,kte_int) + + call da_transform_vvtovp_inv (grid, be % alpha % evec, be % alpha % val, vertical_wgt, & + vp % alpha(:,:,:,n), vv % alpha(:,:,:,n), be % alpha % mz, kte) + end do end if case ('u_adj'); !------------------------------------------------------------------- - ! [3.0] Perform vv_adj = U_{v}^{T} vp_adj transform: + ! [3.0] Perform adjoint transform: vv_adj = L^{1/2} E^T vp_adj !------------------------------------------------------------------- if (be % v1 % mz > 0) then diff --git a/var/da/da_vtox_transforms/da_vtox_transforms.f90 b/var/da/da_vtox_transforms/da_vtox_transforms.f90 index f93a7ae5fe..74ee7de37a 100644 --- a/var/da/da_vtox_transforms/da_vtox_transforms.f90 +++ b/var/da/da_vtox_transforms/da_vtox_transforms.f90 @@ -64,6 +64,7 @@ module da_vtox_transforms use da_par_util, only : da_vv_to_cv, da_cv_to_vv use da_recursive_filter, only : da_transform_through_rf, & + da_transform_through_rf_inv, & da_transform_through_rf_adj, da_apply_rf, da_apply_rf_adj, & da_transform_through_rf_dual_res, da_transform_through_rf_adj_dual_res use da_reporting, only : da_error, message, da_warning, da_message @@ -85,16 +86,19 @@ module da_vtox_transforms #include "da_check_eof_decomposition.inc" #include "da_transform_vtovv.inc" #include "da_transform_vtovv_adj.inc" +#include "da_transform_vtovv_inv.inc" #include "da_transform_rescale.inc" #include "da_transform_vtox.inc" +#include "da_transform_vtox_inv.inc" #include "da_transform_xtoxa.inc" #include "da_transform_vtox_adj.inc" #include "da_transform_xtoxa_adj.inc" #include "da_transform_vptox.inc" #include "da_transform_vptox_adj.inc" +#include "da_transform_vptox_inv.inc" #include "da_transform_vvtovp.inc" #include "da_transform_vvtovp_adj.inc" -#include "da_transform_vptovv.inc" +#include "da_transform_vvtovp_inv.inc" #include "da_transform_vpatox.inc" #include "da_transform_vpatox_adj.inc" #include "da_vertical_transform.inc" From 7e733298428dce53e667bb87cd7f0281c296a4e7 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Mon, 17 Dec 2018 13:06:50 -0700 Subject: [PATCH 39/91] Implement improved radar inv I/O (multi_inc_io_opt=2) for MRI-4dvar Note that the code for non-radar observation types are not changed. On branch mri4dvar Changes to be committed: modified: Registry/registry.var modified: var/build/depend.txt modified: var/da/da_minimisation/da_get_innov_vector.inc modified: var/da/da_minimisation/da_minimisation.f90 modified: var/da/da_obs_io/da_obs_io.f90 new file: var/da/da_obs_io/da_read_iv_for_multi_inc_opt2.inc modified: var/da/da_obs_io/da_read_obs_radar.inc modified: var/da/da_obs_io/da_scan_obs_radar.inc new file: var/da/da_obs_io/da_write_iv_for_multi_inc_opt2.inc --- Registry/registry.var | 1 + var/build/depend.txt | 2 +- .../da_minimisation/da_get_innov_vector.inc | 12 +- var/da/da_minimisation/da_minimisation.f90 | 6 +- var/da/da_obs_io/da_obs_io.f90 | 4 +- .../da_read_iv_for_multi_inc_opt2.inc | 843 ++++++++++++++++ var/da/da_obs_io/da_read_obs_radar.inc | 2 +- var/da/da_obs_io/da_scan_obs_radar.inc | 2 +- .../da_write_iv_for_multi_inc_opt2.inc | 902 ++++++++++++++++++ 9 files changed, 1766 insertions(+), 8 deletions(-) create mode 100644 var/da/da_obs_io/da_read_iv_for_multi_inc_opt2.inc create mode 100644 var/da/da_obs_io/da_write_iv_for_multi_inc_opt2.inc diff --git a/Registry/registry.var b/Registry/registry.var index bca4843688..1931dd7988 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -92,6 +92,7 @@ rconfig integer var4d_bin namelist,wrfvar1 1 3600 - "va rconfig integer var4d_bin_rain namelist,wrfvar1 1 3600 - "var4d_bin_rain" "" "" rconfig logical var4d_lbc namelist,wrfvar1 1 .false. - "var4d_lbc" "" "" rconfig integer multi_inc namelist,wrfvar1 1 0 - "multi_incremental_flag" "" "" +rconfig integer multi_inc_io_opt namelist,wrfvar1 1 1 - "multi_incremental_io_opt" "1: original 2:new" "" rconfig logical print_detail_radar namelist,wrfvar1 1 .false. - "print_detail_radar" "" "" rconfig logical print_detail_rain namelist,wrfvar1 1 .false. - "print_detail_rain" "" "" rconfig logical print_detail_rad namelist,wrfvar1 1 .false. - "print_detail_rad" "" "" diff --git a/var/build/depend.txt b/var/build/depend.txt index e11aeb5eba..bc007a90b2 100644 --- a/var/build/depend.txt +++ b/var/build/depend.txt @@ -132,7 +132,7 @@ da_module_couple_uv_ad.o : da_module_couple_uv_ad.f90 da_couple_ad.inc da_calc_m da_mtgirs.o : da_mtgirs.f90 da_calculate_grady_mtgirs.inc da_get_innov_vector_mtgirs.inc da_check_max_iv_mtgirs.inc da_transform_xtoy_mtgirs_adj.inc da_transform_xtoy_mtgirs.inc da_print_stats_mtgirs.inc da_oi_stats_mtgirs.inc da_residual_mtgirs.inc da_jo_mtgirs_uvtq.inc da_jo_and_grady_mtgirs.inc da_ao_stats_mtgirs.inc da_tracing.o da_physics.o da_grid_definitions.o da_par_util1.o da_par_util.o da_tools.o da_statistics.o da_interpolation.o module_domain.o da_define_structures.o da_control.o da_netcdf_interface.o : da_netcdf_interface.f90 da_atotime.inc da_get_bdytimestr_cdf.inc da_get_bdyfrq.inc da_put_att_cdf.inc da_get_att_cdf.inc da_put_var_2d_int_cdf.inc da_get_var_2d_int_cdf.inc da_put_var_2d_real_cdf.inc da_put_var_3d_real_cdf.inc da_get_var_2d_real_cdf.inc da_get_var_3d_real_cdf.inc da_get_gl_att_real_cdf.inc da_get_gl_att_int_cdf.inc da_get_dims_cdf.inc da_get_times_cdf.inc da_get_var_1d_real_cdf.inc da_obs.o : da_obs.f90 da_grid_definitions.o da_set_obs_missing.inc da_obs_sensitivity.inc da_count_filtered_obs.inc da_store_obs_grid_info_rad.inc da_store_obs_grid_info.inc da_random_omb_all.inc da_fill_obs_structures.inc da_fill_obs_structures_rain.inc da_fill_obs_structures_radar.inc da_check_missing.inc da_add_noise_to_ob.inc da_transform_xtoy_adj.inc da_transform_xtoy.inc da_obs_proc_station.inc module_dm.o da_tracing.o da_tools.o da_tools_serial.o da_synop.o da_ssmi.o da_tamdar.o da_mtgirs.o da_sound.o da_ships.o da_satem.o da_rttov.o da_reporting.o da_rain.o da_radar.o da_qscat.o da_pseudo.o da_profiler.o da_polaramv.o da_pilot.o da_physics.o da_metar.o da_gpsref.o da_gpspw.o da_geoamv.o da_crtm.o da_control.o da_buoy.o da_bogus.o da_airsr.o da_airep.o module_domain.o da_define_structures.o da_gpseph.o -da_obs_io.o : da_obs_io.f90 da_grid_definitions.o da_final_write_modified_filtered_obs.inc da_final_write_filtered_obs.inc da_write_noise_to_ob.inc da_read_omb_tmp.inc da_read_rand_unit.inc da_read_y_unit.inc da_final_write_y.inc da_final_write_obs.inc da_read_obs_bufrgpsro.inc da_read_obs_bufr.inc da_write_y.inc da_write_modified_filtered_obs.inc da_write_filtered_obs.inc da_write_obs_etkf.inc da_search_obs.inc da_read_iv_for_multi_inc.inc da_write_iv_for_multi_inc.inc da_write_obs.inc da_use_obs_errfac.inc da_read_errfac.inc da_read_obs_rain.inc da_scan_obs_rain.inc da_scan_obs_radar.inc da_read_obs_radar.inc da_scan_obs_ascii.inc da_read_obs_ascii.inc da_par_util.o gsi_thinning.o module_radiance.o da_tracing.o da_tools_serial.o da_tools.o da_reporting.o da_physics.o da_par_util1.o da_obs.o da_grid_definitions.o da_define_structures.o da_control.o module_domain.o da_read_lsac_util.inc da_read_obs_lsac.inc da_scan_obs_lsac.inc da_netcdf_interface.o da_gpseph.o da_read_obs_bufrgpsro_eph.inc +da_obs_io.o : da_obs_io.f90 da_grid_definitions.o da_final_write_modified_filtered_obs.inc da_final_write_filtered_obs.inc da_write_noise_to_ob.inc da_read_omb_tmp.inc da_read_rand_unit.inc da_read_y_unit.inc da_final_write_y.inc da_final_write_obs.inc da_read_obs_bufrgpsro.inc da_read_obs_bufr.inc da_write_y.inc da_write_modified_filtered_obs.inc da_write_filtered_obs.inc da_write_obs_etkf.inc da_search_obs.inc da_read_iv_for_multi_inc.inc da_write_iv_for_multi_inc.inc da_write_obs.inc da_use_obs_errfac.inc da_read_errfac.inc da_read_obs_rain.inc da_scan_obs_rain.inc da_scan_obs_radar.inc da_read_obs_radar.inc da_scan_obs_ascii.inc da_read_obs_ascii.inc da_par_util.o gsi_thinning.o module_radiance.o da_tracing.o da_tools_serial.o da_tools.o da_reporting.o da_physics.o da_par_util1.o da_obs.o da_grid_definitions.o da_define_structures.o da_control.o module_domain.o da_read_lsac_util.inc da_read_obs_lsac.inc da_scan_obs_lsac.inc da_netcdf_interface.o da_gpseph.o da_read_obs_bufrgpsro_eph.inc da_write_iv_for_multi_inc_opt2.inc da_read_iv_for_multi_inc_opt2.inc da_par_util.o : da_par_util.f90 da_proc_maxmin_combine.inc da_proc_stats_combine.inc da_system.inc da_y_facade_to_global.inc da_generic_boilerplate.inc da_deallocate_global_synop.inc da_deallocate_global_sound.inc da_deallocate_global_sonde_sfc.inc da_generic_methods.inc da_patch_to_global_3d.inc da_patch_to_global_dual_res.inc da_patch_to_global_2d.inc da_cv_to_global.inc da_transpose_y2x_v2.inc da_transpose_x2y_v2.inc da_transpose_z2y.inc da_transpose_y2z.inc da_transpose_x2z.inc da_transpose_z2x.inc da_transpose_y2x.inc da_transpose_x2y.inc da_unpack_count_obs.inc da_pack_count_obs.inc da_copy_tile_dims.inc da_copy_dims.inc da_alloc_and_copy_be_arrays.inc da_vv_to_cv.inc da_cv_to_vv.inc da_generic_typedefs.inc da_wrf_interfaces.o da_tracing.o da_reporting.o da_define_structures.o da_par_util1.o module_dm.o module_domain.o da_control.o da_par_util1.o : da_par_util1.f90 da_proc_sum_real.inc da_proc_sum_ints.inc da_proc_sum_int.inc da_control.o da_physics.o : da_physics.f90 da_uv_to_sd_lin.inc da_uv_to_sd_adj.inc da_integrat_dz.inc da_wdt.inc da_filter_adj.inc da_filter.inc da_evapo_lin.inc da_condens_lin.inc da_condens_adj.inc da_moist_phys_lin.inc da_moist_phys_adj.inc da_sfc_pre_adj.inc da_sfc_pre_lin.inc da_sfc_pre.inc da_transform_xtowtq_adj.inc da_transform_xtowtq.inc da_transform_xtopsfc_adj.inc da_transform_xtopsfc.inc da_sfc_wtq_adj.inc da_sfc_wtq_lin.inc da_sfc_wtq.inc da_julian_day.inc da_roughness_from_lanu.inc da_get_q_error.inc da_check_rh_simple.inc da_check_rh.inc da_transform_xtogpsref_lin.inc da_transform_xtogpsref_adj.inc da_transform_xtogpsref.inc da_transform_xtotpw_adj.inc da_transform_xtotpw.inc da_transform_xtoztd_adj.inc da_transform_xtoztd_lin.inc da_transform_xtoztd.inc da_tv_profile_tl.inc da_thickness_tl.inc da_find_layer_adj.inc da_thickness.inc da_tv_profile_adj.inc da_find_layer.inc da_thickness_adj.inc da_find_layer_tl.inc da_tv_profile.inc da_tpq_to_slp_adj.inc da_tpq_to_slp_lin.inc da_wrf_tpq_2_slp.inc da_tpq_to_slp.inc da_trh_to_td.inc da_tp_to_qs_lin1.inc da_tp_to_qs_lin.inc da_tp_to_qs_adj1.inc da_tp_to_qs_adj.inc da_tp_to_qs1.inc da_tp_to_qs.inc da_tprh_to_q_lin1.inc da_tprh_to_q_lin.inc da_tprh_to_q_adj1.inc da_tprh_to_q_adj.inc da_tpq_to_rh_lin1.inc da_tpq_to_rh_lin.inc da_tpq_to_rh.inc da_pt_to_rho_lin.inc da_pt_to_rho_adj.inc da_uvprho_to_w_adj.inc da_uvprho_to_w_lin.inc da_prho_to_t_lin.inc da_prho_to_t_adj.inc da_wrf_interfaces.o da_reporting.o da_dynamics.o da_interpolation.o da_tracing.o da_par_util.o da_define_structures.o da_control.o module_comm_dm.o module_dm.o module_domain.o da_grid_definitions.o da_gpseph.o diff --git a/var/da/da_minimisation/da_get_innov_vector.inc b/var/da/da_minimisation/da_get_innov_vector.inc index 7c10528551..b9f04a699a 100644 --- a/var/da/da_minimisation/da_get_innov_vector.inc +++ b/var/da/da_minimisation/da_get_innov_vector.inc @@ -174,11 +174,19 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) if ( multi_inc == 1 ) then - call da_write_iv_for_multi_inc(n, iv) + if ( multi_inc_io_opt == 1 ) then + call da_write_iv_for_multi_inc(n, iv) + else if ( multi_inc_io_opt == 2 ) then + call da_write_iv_for_multi_inc_opt2(n, iv) + end if elseif ( multi_inc == 2 ) then - call da_read_iv_for_multi_inc(n, iv) + if ( multi_inc_io_opt == 1 ) then + call da_read_iv_for_multi_inc(n, iv) + else if ( multi_inc_io_opt == 2 ) then + call da_read_iv_for_multi_inc_opt2(n, iv) + end if endif diff --git a/var/da/da_minimisation/da_minimisation.f90 b/var/da/da_minimisation/da_minimisation.f90 index 9364ece06e..bd920e2914 100644 --- a/var/da/da_minimisation/da_minimisation.f90 +++ b/var/da/da_minimisation/da_minimisation.f90 @@ -57,7 +57,8 @@ module da_minimisation write_detail_grad_fn, pseudo_uvtpq, lanczos_ep_filename, use_divc, divc_factor, & cloud_cv_options, use_cv_w, var_scaling6, var_scaling7, var_scaling8, var_scaling9, & var_scaling10, var_scaling11, & - write_gts_omb_oma, write_unpert_obs, write_rej_obs_conv, pseudo_time + write_gts_omb_oma, write_unpert_obs, write_rej_obs_conv, pseudo_time, & + multi_inc_io_opt use da_define_structures, only : iv_type, y_type, j_type, be_type, & xbx_type, jo_type, da_allocate_y,da_zero_x,da_zero_y,da_deallocate_y, & da_zero_vp_type, qhat_type @@ -79,7 +80,8 @@ module da_minimisation da_jo_and_grady_gpseph use da_obs_io, only : da_final_write_y, da_write_y, da_final_write_obs, & da_write_obs,da_write_obs_etkf,da_write_noise_to_ob, da_use_obs_errfac, & - da_write_iv_for_multi_inc, da_read_iv_for_multi_inc + da_write_iv_for_multi_inc, da_read_iv_for_multi_inc, & + da_write_iv_for_multi_inc_opt2, da_read_iv_for_multi_inc_opt2 use da_metar, only : da_calculate_grady_metar, da_ao_stats_metar, & da_oi_stats_metar, da_get_innov_vector_metar, da_residual_metar, & da_jo_and_grady_metar diff --git a/var/da/da_obs_io/da_obs_io.f90 b/var/da/da_obs_io/da_obs_io.f90 index b12f5aed36..d6294cc537 100644 --- a/var/da/da_obs_io/da_obs_io.f90 +++ b/var/da/da_obs_io/da_obs_io.f90 @@ -32,7 +32,7 @@ module da_obs_io thin_conv, thin_conv_ascii, lsac_nh_step, lsac_nv_step, lsac_nv_start, lsac_print_details, & lsac_use_u, lsac_use_v, lsac_use_t, lsac_use_q, lsac_u_error, lsac_v_error, lsac_t_error, lsac_q_error, & gpsro_drift, max_gpseph_input, use_gpsephobs, gpseph, gpseph_loadbalance, kds, kde, kts, kte, & - use_radar_rhv, use_radar_rqv + use_radar_rhv, use_radar_rqv, use_radar_rf, use_radar_rv, multi_inc use da_define_structures, only : iv_type, multi_level_type, multi_level_type_BUFR, & radar_multi_level_type, y_type, field_type, each_level_type, & @@ -82,7 +82,9 @@ module da_obs_io #include "da_use_obs_errfac.inc" #include "da_write_obs.inc" #include "da_write_iv_for_multi_inc.inc" +#include "da_write_iv_for_multi_inc_opt2.inc" #include "da_read_iv_for_multi_inc.inc" +#include "da_read_iv_for_multi_inc_opt2.inc" #include "da_search_obs.inc" #include "da_write_obs_etkf.inc" #include "da_write_filtered_obs.inc" diff --git a/var/da/da_obs_io/da_read_iv_for_multi_inc_opt2.inc b/var/da/da_obs_io/da_read_iv_for_multi_inc_opt2.inc new file mode 100644 index 0000000000..508088fe0f --- /dev/null +++ b/var/da/da_obs_io/da_read_iv_for_multi_inc_opt2.inc @@ -0,0 +1,843 @@ +subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) + + !----------------------------------------------------------------------- + ! Purpose: Read for Multi-incremental + !----------------------------------------------------------------------- + + !------------------------------------------------------------------------- + ! read iv=O-B structure written by WRFVAR + !------------------------------------------------------------------------- + + implicit none + + type (iv_type), intent(inout) :: iv ! O-B structure. + integer, intent(in) :: file_index + integer :: unit_in + character(len=filename_len) :: filename + + integer :: num_obs, ios + character*20 :: ob_type_string + + integer :: n, gn + logical :: found_flag + + integer :: nobs_tot, nlev_max, k , iobs + integer :: nobs_in, nlev_in + logical :: has_rv, has_rf, has_rhv, has_rqv + real, allocatable :: data2d(:,:) + real, allocatable :: data3d(:,:,:) + + if (trace_use) call da_trace_entry("da_read_iv_for_multi_inc_opt2") + + !------------------------------------------------------------------------- + ! Fix input unit + !------------------------------------------------------------------------- + + call da_get_unit(unit_in) + + write(unit=filename, fmt='(a,i3.3)') 'gts_omb.', file_index + + ! [1] surface obs: + + if (iv%info(synop)%plocal(iv%time)-iv%info(synop)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.synop',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'synop' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find synop marker. "/)) + gn = 0 + do n = iv%info(synop)%plocal(iv%time-1) + 1, & + iv%info(synop)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find synop obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(synop)%plocal(iv%time)-iv%info(synop)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [2] metar obs: + + if (iv%info(metar)%plocal(iv%time)-iv%info(metar)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.metar',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'metar' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find metar marker. "/)) + gn = 0 + do n = iv%info(metar)%plocal(iv%time-1) + 1, & + iv%info(metar)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find metar obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(metar)%plocal(iv%time)-iv%info(metar)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [3] ships obs: + + if (iv%info(ships)%plocal(iv%time)-iv%info(ships)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.ships',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'ships' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find ships marker. "/)) + gn = 0 + do n = iv%info(ships)%plocal(iv%time-1) + 1, & + iv%info(ships)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find ships obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(ships)%plocal(iv%time)-iv%info(ships)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [4] sonde_sfc obs: + + if (iv%info(sonde_sfc)%plocal(iv%time)-iv%info(sonde_sfc)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.sonde_sfc',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'sonde_sfc' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find sonde_sfc marker. "/)) + gn = 0 + do n = iv%info(sonde_sfc)%plocal(iv%time-1) + 1, & + iv%info(sonde_sfc)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find sonde_sfc obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(sonde_sfc)%plocal(iv%time)-iv%info(sonde_sfc)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [5] sound obs: + + if (iv%info(sound)%plocal(iv%time)-iv%info(sound)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.sound',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'sound' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find sound marker. "/)) + gn = 0 + do n = iv%info(sound)%plocal(iv%time-1) + 1, & + iv%info(sound)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find sound obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(sound)%plocal(iv%time)-iv%info(sound)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [6] mtgirs obs: + + if (iv%info(mtgirs)%plocal(iv%time)-iv%info(mtgirs)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.mtgirs',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'mtgirs' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find mtgirs marker. "/)) + gn = 0 + do n = iv%info(mtgirs)%plocal(iv%time-1) + 1, & + iv%info(mtgirs)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find mtgirs obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(mtgirs)%plocal(iv%time)-iv%info(mtgirs)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [7] tamdar obs: + + if (iv%info(tamdar)%plocal(iv%time)-iv%info(tamdar)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.tamdar',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'tamdar' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find tamdar marker. "/)) + gn = 0 + do n = iv%info(tamdar)%plocal(iv%time-1) + 1, & + iv%info(tamdar)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find tamdar obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(tamdar)%plocal(iv%time)-iv%info(tamdar)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [8] tamdar_sfc obs: + + if (iv%info(tamdar_sfc)%plocal(iv%time)-iv%info(tamdar_sfc)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.tamdar_sfc',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'tamdar_sfc' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find tamdar_sfc marker. "/)) + gn = 0 + do n = iv%info(tamdar_sfc)%plocal(iv%time-1) + 1, & + iv%info(tamdar_sfc)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find tamdar_sfc obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(tamdar_sfc)%plocal(iv%time)-iv%info(tamdar_sfc)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [9] buoy obs: + + if (iv%info(buoy)%plocal(iv%time)-iv%info(buoy)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.buoy',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'buoy' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find buoy marker. "/)) + gn = 0 + do n = iv%info(buoy)%plocal(iv%time-1) + 1, & + iv%info(buoy)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find buoy obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(buoy)%plocal(iv%time)-iv%info(buoy)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [10] Geo AMV obs: + + if (iv%info(geoamv)%plocal(iv%time)-iv%info(geoamv)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.geoamv',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'geoamv' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find geoamv marker. "/)) + gn = 0 + do n = iv%info(geoamv)%plocal(iv%time-1) + 1, & + iv%info(geoamv)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find geoamv obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(geoamv)%plocal(iv%time)-iv%info(geoamv)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [11] gpspw obs: + + if (iv%info(gpspw)%plocal(iv%time)-iv%info(gpspw)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.gpspw',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'gpspw' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find gpspw marker. "/)) + gn = 0 + do n = iv%info(gpspw)%plocal(iv%time-1) + 1, & + iv%info(gpspw)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find gpspw obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(gpspw)%plocal(iv%time)-iv%info(gpspw)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [12] SSM/I obs: + + if (iv%info(ssmi_rv)%plocal(iv%time)-iv%info(ssmi_rv)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.ssmir',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'ssmir' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find ssmir marker. "/)) + gn = 0 + do n = iv%info(ssmi_rv)%plocal(iv%time-1) + 1, & + iv%info(ssmi_rv)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find ssmir obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(ssmi_rv)%plocal(iv%time)-iv%info(ssmi_rv)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [13] airep obs: + + if (iv%info(airep)%plocal(iv%time)-iv%info(airep)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.airep',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'airep' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find airep marker. "/)) + gn = 0 + do n = iv%info(airep)%plocal(iv%time-1) + 1, & + iv%info(airep)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find airep obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(airep)%plocal(iv%time)-iv%info(airep)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [14] polaramv obs: + + if (iv%info(polaramv)%plocal(iv%time)-iv%info(polaramv)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.polaramv',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'polaramv' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find polaramv marker. "/)) + gn = 0 + do n = iv%info(polaramv)%plocal(iv%time-1) + 1, & + iv%info(polaramv)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find polaramv obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(polaramv)%plocal(iv%time)-iv%info(polaramv)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [15] pilot obs: + + if (iv%info(pilot)%plocal(iv%time)-iv%info(pilot)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.pilot',form='formatted',status='old',iostat=ios) + + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'pilot' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find pilot marker. "/)) + gn = 0 + do n = iv%info(pilot)%plocal(iv%time-1) + 1, & + iv%info(pilot)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find pilot obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(pilot)%plocal(iv%time)-iv%info(pilot)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [16] ssmi_tb obs: + + if (iv%info(ssmi_tb)%plocal(iv%time)-iv%info(ssmi_tb)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.ssmi_tb',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'ssmi_tb' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find ssmi_tb marker. "/)) + gn = 0 + do n = iv%info(ssmi_tb)%plocal(iv%time-1) + 1, & + iv%info(ssmi_tb)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find ssmi_tb obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(ssmi_tb)%plocal(iv%time)-iv%info(ssmi_tb)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [17] satem obs: + + if (iv%info(satem)%plocal(iv%time)-iv%info(satem)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.satem',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'satem' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find satem marker. "/)) + gn = 0 + do n = iv%info(satem)%plocal(iv%time-1) + 1, & + iv%info(satem)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find satem obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(satem)%plocal(iv%time)-iv%info(satem)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [18] ssmt1 obs: + + if (iv%info(ssmt1)%plocal(iv%time)-iv%info(ssmt1)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.ssmt1',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'ssmt1' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find ssmt1 marker. "/)) + gn = 0 + do n = iv%info(ssmt1)%plocal(iv%time-1) + 1, & + iv%info(ssmt1)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find ssmt1 obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(ssmt1)%plocal(iv%time)-iv%info(ssmt1)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [19] ssmt2 obs: + + if (iv%info(ssmt2)%plocal(iv%time)-iv%info(ssmt2)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.ssmt2',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'ssmt2' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find ssmt2 marker. "/)) + gn = 0 + do n = iv%info(ssmt2)%plocal(iv%time-1) + 1, & + iv%info(ssmt2)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find ssmt2 obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(ssmt2)%plocal(iv%time)-iv%info(ssmt2)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [20] scatterometer obs: + + if (iv%info(qscat)%plocal(iv%time)-iv%info(qscat)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.qscat',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'qscat' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find qscat marker. "/)) + gn = 0 + do n = iv%info(qscat)%plocal(iv%time-1) + 1, & + iv%info(qscat)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find qscat obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(qscat)%plocal(iv%time)-iv%info(qscat)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [21] profiler obs: + + if (iv%info(profiler)%plocal(iv%time)-iv%info(profiler)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.profiler',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'profiler' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find profiler marker. "/)) + gn = 0 + do n = iv%info(profiler)%plocal(iv%time-1) + 1, & + iv%info(profiler)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find profiler obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(profiler)%plocal(iv%time)-iv%info(profiler)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [22] TC bogus obs: + + if (iv%info(bogus)%plocal(iv%time)-iv%info(bogus)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.bogus',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'bogus' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find bogus marker. "/)) + gn = 0 + do n = iv%info(bogus)%plocal(iv%time-1) + 1, & + iv%info(bogus)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find bogus obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(bogus)%plocal(iv%time)-iv%info(bogus)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [23] AIRS retrievals: + + if (iv%info(airsr)%plocal(iv%time)-iv%info(airsr)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.airsr',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'airsr' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find airsr marker. "/)) + gn = 0 + do n = iv%info(airsr)%plocal(iv%time-1) + 1, & + iv%info(airsr)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find airsr obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(airsr)%plocal(iv%time)-iv%info(airsr)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + ! [24] gpsref obs: + + if (iv%info(gpsref)%plocal(iv%time)-iv%info(gpsref)%plocal(iv%time-1) > 0) then + + open(unit=unit_in,file=trim(filename)//'.gpsref',form='formatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file"//filename/)) + end if + + read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs + if ( trim(adjustl(ob_type_string)) .ne. 'gpsref' ) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find gpsref marker. "/)) + gn = 0 + do n = iv%info(gpsref)%plocal(iv%time-1) + 1, & + iv%info(gpsref)%plocal(iv%time) + call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) + if (found_flag .eqv. .false.) & + call da_error(__FILE__,__LINE__, & + (/"Cannot find gpsref obs. "/)) + gn = gn + 1 + end do + if (gn /= iv%info(gpsref)%plocal(iv%time)-iv%info(gpsref)%plocal(iv%time-1)) & + call da_error(__FILE__,__LINE__, & + (/"Unequal obs. found "/)) + close (unit_in) + end if + + + ! [25] radar obs: + + nobs_tot = iv%info(radar)%ptotal(num_fgat_time) - iv%info(radar)%ptotal(0) + nlev_max = iv%info(radar)%max_lev + + if ( nobs_tot > 0 ) then + + write(unit=filename, fmt='(a,i3.3)') 'radar_innov_t', file_index + open(unit=unit_in,file=trim(filename),form='unformatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file "//trim(filename)/)) + end if + + read(unit_in) nobs_in, nlev_in, has_rv, has_rf, has_rhv, has_rqv + if ( nobs_in /= nobs_tot .or. nlev_in /= nlev_max ) then + call da_error(__FILE__,__LINE__, & + (/"Dimensions (nobs_tot or nlev_max) mismatch "/)) + end if + allocate ( data2d(nobs_tot, 2) ) + read(unit_in) data2d + do n = iv%info(radar)%n1, iv%info(radar)%n2 + iobs = iv%info(radar)%obs_global_index(n) +! iv%info(radar)%lat(1,n) = data2d(iobs, 1) +! iv%info(radar)%lon(1,n) = data2d(iobs, 2) + end do + deallocate ( data2d ) + + if ( use_radar_rv .and. has_rv ) then + allocate( data3d(nobs_tot, nlev_max, 3) ) + read(unit_in) data3d + do n = iv%info(radar)%n1, iv%info(radar)%n2 + iobs = iv%info(radar)%obs_global_index(n) + do k = 1 , iv%info(radar)%levels(n) + iv%radar(n)%rv(k)%inv = data3d(iobs, k, 1) + iv%radar(n)%rv(k)%qc = int(data3d(iobs, k, 2)) + iv%radar(n)%rv(k)%error = data3d(iobs, k, 3) + end do + end do + deallocate( data3d ) + end if + + if ( use_radar_rf .and. has_rf ) then + allocate( data3d(nobs_tot, nlev_max, 3) ) + read(unit_in) data3d + do n = iv%info(radar)%n1, iv%info(radar)%n2 + iobs = iv%info(radar)%obs_global_index(n) + do k = 1 , iv%info(radar)%levels(n) + iv%radar(n)%rf(k)%inv = data3d(iobs, k, 1) + iv%radar(n)%rf(k)%qc = int(data3d(iobs, k, 2)) + iv%radar(n)%rf(k)%error = data3d(iobs, k, 3) + end do + end do + deallocate( data3d ) + end if + + if ( use_radar_rhv .and. has_rhv ) then + allocate( data3d(nobs_tot, nlev_max, 9) ) + read(unit_in) data3d + do n = iv%info(radar)%n1, iv%info(radar)%n2 + iobs = iv%info(radar)%obs_global_index(n) + do k = 1 , iv%info(radar)%levels(n) + iv%radar(n)%rrn(k)%inv = data3d(iobs, k, 1) + iv%radar(n)%rrn(k)%qc = int(data3d(iobs, k, 2)) + iv%radar(n)%rrn(k)%error = data3d(iobs, k, 3) + iv%radar(n)%rsn(k)%inv = data3d(iobs, k, 4) + iv%radar(n)%rsn(k)%qc = int(data3d(iobs, k, 5)) + iv%radar(n)%rsn(k)%error = data3d(iobs, k, 6) + iv%radar(n)%rgr(k)%inv = data3d(iobs, k, 7) + iv%radar(n)%rgr(k)%qc = int(data3d(iobs, k, 8)) + iv%radar(n)%rgr(k)%error = data3d(iobs, k, 9) + end do + end do + deallocate( data3d ) + end if + + if ( use_radar_rqv .and. has_rqv ) then + allocate( data3d(nobs_tot, nlev_max, 3) ) + read(unit_in) data3d + do n = iv%info(radar)%n1, iv%info(radar)%n2 + iobs = iv%info(radar)%obs_global_index(n) + do k = 1 , iv%info(radar)%levels(n) + iv%radar(n)%rqv(k)%inv = data3d(iobs, k, 1) + iv%radar(n)%rqv(k)%qc = int(data3d(iobs, k, 2)) + iv%radar(n)%rqv(k)%error = data3d(iobs, k, 3) + end do + end do + deallocate( data3d ) + end if + + close (unit_in) + end if ! nobs_tot > 0 + +999 continue + close (unit_in) + call da_free_unit(unit_in) + + if (trace_use) call da_trace_exit("da_read_iv_for_multi_inc_opt2") + return + +1000 continue + write(unit=message(1), fmt='(a,i3)') & + 'read error on unit: ',unit_in + call da_warning(__FILE__,__LINE__,message(1:1)) + +end subroutine da_read_iv_for_multi_inc_opt2 diff --git a/var/da/da_obs_io/da_read_obs_radar.inc b/var/da/da_obs_io/da_read_obs_radar.inc index 8a3bf12277..fb487c6fa9 100644 --- a/var/da/da_obs_io/da_read_obs_radar.inc +++ b/var/da/da_obs_io/da_read_obs_radar.inc @@ -219,7 +219,7 @@ subroutine da_read_obs_radar (iv, filename, grid) endif call da_llxy (platform%info, platform%loc, outside, outside_all) - if( outside_all ) then + if( outside_all .and. multi_inc == 0 ) then if (print_detail_radar) then write(unit=stdout, fmt='(a)') '*** Report is outside of domain:' write(unit=stdout, fmt='(2x,a,2(2x,f8.3),2x,a)') & diff --git a/var/da/da_obs_io/da_scan_obs_radar.inc b/var/da/da_obs_io/da_scan_obs_radar.inc index 5d30072dc8..f665c801ca 100644 --- a/var/da/da_obs_io/da_scan_obs_radar.inc +++ b/var/da/da_obs_io/da_scan_obs_radar.inc @@ -194,7 +194,7 @@ subroutine da_scan_obs_radar (iv, filename, grid) endif call da_llxy (platform%info, platform%loc, outside, outside_all) - if( outside_all ) cycle reports + if( outside_all .and. multi_inc == 0 ) cycle reports nlevels = platform%info%levels diff --git a/var/da/da_obs_io/da_write_iv_for_multi_inc_opt2.inc b/var/da/da_obs_io/da_write_iv_for_multi_inc_opt2.inc new file mode 100644 index 0000000000..76afc8411e --- /dev/null +++ b/var/da/da_obs_io/da_write_iv_for_multi_inc_opt2.inc @@ -0,0 +1,902 @@ +subroutine da_write_iv_for_multi_inc_opt2(file_index, iv) + + !------------------------------------------------------------------------- + ! Purpose: Writes out components of iv=O-B structure. + !------------------------------------------------------------------------- + + implicit none + + type (iv_type), intent(in) :: iv ! O-B structure. + integer, intent (in) :: file_index + + integer :: n, k, ios + integer :: ounit ! Output unit + character(len=filename_len) :: filename + + integer :: nobs_tot, nlev_max, iobs + real, allocatable :: data2d(:,:) + real, allocatable :: data3d(:,:,:) + real, allocatable :: data2d_g(:,:) + real, allocatable :: data3d_g(:,:,:) + + if (trace_use) call da_trace_entry("da_write_iv_for_multi_inc_opt2") + + !------------------------------------------------------------------------- + ! Fix output unit + !------------------------------------------------------------------------- + + call da_get_unit(ounit) +#ifdef DM_PARALLEL + write(unit=filename, fmt='(a,i3.3,a,i4.4)') 'stub.', file_index, '.', myproc +#else + write(unit=filename, fmt='(a,i3.3)') 'gts_omb.', file_index +#endif + ! [1] surface obs: + + if (iv%info(synop)%plocal(iv%time) - iv%info(synop)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.synop',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'synop',iv%info(synop)%plocal(iv%time) - & + iv%info(synop)%plocal(iv%time-1) + do n = iv%info(synop)%plocal(iv%time-1) + 1, & + iv%info(synop)%plocal(iv%time) + write(ounit,'(i8,a5,2E22.13)')& + n , iv%info(synop)%id(n), & ! Station + iv%info(synop)%lat(1,n), & ! Latitude + iv%info(synop)%lon(1,n) ! Longitude + write(ounit,'(E22.13,5(E22.13,i8,3E22.13))')& + iv%synop(n)%h, & + iv%synop(n)%u, &! O-B u + iv%synop(n)%v, &! O-B v + iv%synop(n)%t, &! O-B t + iv%synop(n)%p, &! O-B p + iv%synop(n)%q ! O-B q + end do + close (ounit) + end if + + ! [2] metar obs: + + if (iv%info(metar)%plocal(iv%time) - iv%info(metar)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.metar',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'metar', iv%info(metar)%plocal(iv%time) - & + iv%info(metar)%plocal(iv%time-1) + do n = iv%info(metar)%plocal(iv%time-1) + 1, & + iv%info(metar)%plocal(iv%time) + write(ounit,'(i8,a5,2E22.13)')& + n, iv%info(metar)%id(n), & ! Station + iv%info(metar)%lat(1,n), & ! Latitude + iv%info(metar)%lon(1,n) ! Longitude + write(ounit,'(E22.13,5(E22.13,i8,3E22.13))')& + iv%metar(n)%h, & + iv%metar(n)%u, &! O-B u + iv%metar(n)%v, &! O-B v + iv%metar(n)%t, &! O-B t + iv%metar(n)%p, &! O-B p + iv%metar(n)%q ! O-B q + end do + close (ounit) + end if + + ! [3] ships obs: + + if (iv%info(ships)%plocal(iv%time) - iv%info(ships)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.ships',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'ships', iv%info(ships)%plocal(iv%time) - & + iv%info(ships)%plocal(iv%time-1) + do n = iv%info(ships)%plocal(iv%time-1) + 1, & + iv%info(ships)%plocal(iv%time) + write(ounit,'(i8,a5,2E22.13)')& + n, iv%info(ships)%id(n), & ! Station + iv%info(ships)%lat(1,n), & ! Latitude + iv%info(ships)%lon(1,n) ! Longitude + write(ounit,'(E22.13,5(E22.13,i8,3E22.13))')& + iv%ships(n)%h, & + iv%ships(n)%u, &! O-B u + iv%ships(n)%v, &! O-B v + iv%ships(n)%t, &! O-B t + iv%ships(n)%p, &! O-B p + iv%ships(n)%q ! O-B q + end do + close (ounit) + end if + + ! [4] sonde_sfc obs: + + if (iv%info(sonde_sfc)%plocal(iv%time) - iv%info(sonde_sfc)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.sonde_sfc',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'sonde_sfc', iv%info(sonde_sfc)%plocal(iv%time) - & + iv%info(sonde_sfc)%plocal(iv%time-1) + do n = iv%info(sonde_sfc)%plocal(iv%time-1) + 1, & + iv%info(sonde_sfc)%plocal(iv%time) + write(ounit,'(i8,a5,2E22.13)')& + n, iv%info(sonde_sfc)%id(n), & ! Station + iv%info(sonde_sfc)%lat(1,n), & ! Latitude + iv%info(sonde_sfc)%lon(1,n) ! Longitude + write(ounit,'(E22.13,5(E22.13,i8,3E22.13))')& + iv%sonde_sfc(n)%h, & + iv%sonde_sfc(n)%u, &! O-B u + iv%sonde_sfc(n)%v, &! O-B v + iv%sonde_sfc(n)%t, &! O-B t + iv%sonde_sfc(n)%p, &! O-B p + iv%sonde_sfc(n)%q ! O-B q + end do + close (ounit) + end if + + ! [5] sound obs: + + if (iv%info(sound)%plocal(iv%time) - iv%info(sound)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.sound',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'sound', iv%info(sound)%plocal(iv%time) - & + iv%info(sound)%plocal(iv%time-1) + do n = iv%info(sound)%plocal(iv%time-1) + 1, & + iv%info(sound)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(sound)%levels(n), iv%info(sound)%id(n), & ! Station + iv%info(sound)%lat(1,n), & ! Latitude + iv%info(sound)%lon(1,n) ! Longitude + do k = 1 , iv%info(sound)%levels(n) + write(ounit,'(2E22.13,4(E22.13,i8,3E22.13))')& + iv%sound(n)%h(k), & + iv%sound(n)%p(k), & ! Obs Pressure + iv%sound(n)%u(k), &! O-B u + iv%sound(n)%v(k), &! O-B v + iv%sound(n)%t(k), &! O-B t + iv%sound(n)%q(k) ! O-B q + enddo + end do + close (ounit) + end if + + ! [6] mtgirs obs: + + if (iv%info(mtgirs)%plocal(iv%time) - iv%info(mtgirs)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.mtgirs',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'mtgirs', iv%info(mtgirs)%plocal(iv%time) - & + iv%info(mtgirs)%plocal(iv%time-1) + do n = iv%info(mtgirs)%plocal(iv%time-1) + 1, & + iv%info(mtgirs)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(mtgirs)%levels(n), iv%info(mtgirs)%id(n), & ! Station + iv%info(mtgirs)%lat(1,n), & ! Latitude + iv%info(mtgirs)%lon(1,n) ! Longitude + do k = 1 , iv%info(mtgirs)%levels(n) + write(ounit,'(2E22.13,4(E22.13,i8,3E22.13))')& + iv % mtgirs(n) % h(k), & + iv % mtgirs(n) % p(k), & ! Obs Pressure + iv%mtgirs(n)%u(k), &! O-B u + iv%mtgirs(n)%v(k), &! O-B v + iv%mtgirs(n)%t(k), &! O-B t + iv%mtgirs(n)%q(k) ! O-B q + + enddo + end do + close (ounit) + end if + + ! [7] tamdar + + if (iv%info(tamdar)%plocal(iv%time) - iv%info(tamdar)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.tamdar',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'tamdar', iv%info(tamdar)%plocal(iv%time) - & + iv%info(tamdar)%plocal(iv%time-1) + do n = iv%info(tamdar)%plocal(iv%time-1) + 1, & + iv%info(tamdar)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(tamdar)%levels(n), iv%info(tamdar)%id(n), & ! Station + iv%info(tamdar)%lat(1,n), & ! Latitude + iv%info(tamdar)%lon(1,n) ! Longitude + do k = 1 , iv%info(tamdar)%levels(n) + write(ounit,'(2E22.13,4(E22.13,i8,3E22.13))')& + iv%tamdar(n)%h(k), & + iv%tamdar(n)%p(k), & ! Obs Pressure + iv%tamdar(n)%u(k), &! O-B u + iv%tamdar(n)%v(k), &! O-B v + iv%tamdar(n)%t(k), &! O-B t + iv%tamdar(n)%q(k) ! O-B q + enddo + end do + close (ounit) + end if + + ! [8] tamdar_sfc + + if (iv%info(tamdar_sfc)%plocal(iv%time) - iv%info(tamdar_sfc)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.tamdar_sfc',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'tamdar_sfc', iv%info(tamdar_sfc)%plocal(iv%time) - & + iv%info(tamdar_sfc)%plocal(iv%time-1) + do n = iv%info(tamdar_sfc)%plocal(iv%time-1) + 1, & + iv%info(tamdar_sfc)%plocal(iv%time) + write(ounit,'(i8,a5,2E22.13)')& + n, iv%info(tamdar_sfc)%id(n), & ! Station + iv%info(tamdar_sfc)%lat(1,n), & ! Latitude + iv%info(tamdar_sfc)%lon(1,n) ! Longitude + write(ounit,'(E22.13,5(E22.13,i8,3E22.13))')& + iv%tamdar_sfc(n)%h, & + iv%tamdar_sfc(n)%u, &! O-B u + iv%tamdar_sfc(n)%v, &! O-B v + iv%tamdar_sfc(n)%t, &! O-B t + iv%tamdar_sfc(n)%p, &! O-B p + iv%tamdar_sfc(n)%q ! O-B q + end do + close (ounit) + end if + + ! [9] buoy obs: + + if (iv%info(buoy)%plocal(iv%time) - iv%info(buoy)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.buoy',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'buoy', iv%info(buoy)%plocal(iv%time) - & + iv%info(buoy)%plocal(iv%time-1) + do n = iv%info(buoy)%plocal(iv%time-1) + 1, & + iv%info(buoy)%plocal(iv%time) + write(ounit,'(i8,a5,2E22.13)')& + n, iv%info(buoy)%id(n), & ! Station + iv%info(buoy)%lat(1,n), & ! Latitude + iv%info(buoy)%lon(1,n) ! Longitude + write(ounit,'(E22.13,5(E22.13,i8,3E22.13))')& + iv%buoy(n)%h, & + iv%buoy(n)%u, &! O-B u + iv%buoy(n)%v, &! O-B v + iv%buoy(n)%t, &! O-B t + iv%buoy(n)%p, &! O-B p + iv%buoy(n)%q ! O-B q + end do + close (ounit) + end if + + ! [10] Geo AMVs obs: + + if (iv%info(geoamv)%plocal(iv%time) - iv%info(geoamv)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.geoamv',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'geoamv', iv%info(geoamv)%plocal(iv%time) - & + iv%info(geoamv)%plocal(iv%time-1) + do n = iv%info(geoamv)%plocal(iv%time-1) + 1, & + iv%info(geoamv)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(geoamv)%levels(n), iv%info(geoamv)%id(n), & ! Station + iv%info(geoamv)%lat(1,n), & ! Latitude + iv%info(geoamv)%lon(1,n) ! Longitude + do k = 1 , iv%info(geoamv)%levels(n) + write(ounit,'(E22.13,2(E22.13,i8,3E22.13))')& + iv%geoamv(n)%p(k), & ! Obs Pressure + iv%geoamv(n)%u(k), &! O-B u + iv%geoamv(n)%v(k) + enddo + end do + close (ounit) + end if + + ! [11] gpspw obs: + + if (iv%info(gpspw)%plocal(iv%time) - iv%info(gpspw)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.gpspw',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'gpspw', iv%info(gpspw)%plocal(iv%time) - & + iv%info(gpspw)%plocal(iv%time-1) + do n = iv%info(gpspw)%plocal(iv%time-1) + 1, & + iv%info(gpspw)%plocal(iv%time) + write(ounit,'(i8,a5,2E22.13)')& + n, iv%info(gpspw)%id(n), & ! Station + iv%info(gpspw)%lat(1,n), & ! Latitude + iv%info(gpspw)%lon(1,n) ! Longitude + write(ounit,'(E22.13,i8,3E22.13)')& + iv%gpspw(n)%tpw + end do + close (ounit) + end if + + ! [12] SSM/I obs: + + if (iv%info(ssmi_rv)%plocal(iv%time) - iv%info(ssmi_rv)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.ssmir',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'ssmir', iv%info(ssmi_rv)%plocal(iv%time) - & + iv%info(ssmi_rv)%plocal(iv%time-1) + do n = iv%info(ssmi_rv)%plocal(iv%time-1) + 1, & + iv%info(ssmi_rv)%plocal(iv%time) + write(ounit,'(i8,2E22.13)')& + n, & ! Station + iv%info(ssmi_rv)%lat(1,n), & ! Latitude + iv%info(ssmi_rv)%lon(1,n) ! Longitude + write(ounit,'(2(E22.13,i8,3E22.13))')& + iv%ssmi_rv(n)%speed, & ! O-B speed + iv%ssmi_rv(n)%tpw ! O-BA tpw + end do + close (ounit) + end if + + ! [13] airep obs: + + if (iv%info(airep)%plocal(iv%time) - iv%info(airep)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.airep',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'airep', iv%info(airep)%plocal(iv%time) - & + iv%info(airep)%plocal(iv%time-1) + do n = iv%info(airep)%plocal(iv%time-1) + 1, & + iv%info(airep)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(airep)%levels(n), iv%info(airep)%id(n), & ! Station + iv%info(airep)%lat(1,n), & ! Latitude + iv%info(airep)%lon(1,n) ! Longitude + do k = 1 , iv%info(airep)%levels(n) + write(ounit,'(2E22.13,4(E22.13,i8,3E22.13))')& + iv%airep(n)%h(k), & + iv%airep(n)%p(k), & ! Obs pressure + iv%airep(n)%u(k), &! O-B u + iv%airep(n)%v(k), &! O-B v + iv%airep(n)%t(k), & + iv%airep(n)%q(k) + enddo + end do + close (ounit) + end if + + ! [14] Polar AMVs obs: + + if (iv%info(polaramv)%plocal(iv%time) - iv%info(polaramv)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.polaramv',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'polaramv', iv%info(polaramv)%plocal(iv%time) - & + iv%info(polaramv)%plocal(iv%time-1) + do n = iv%info(polaramv)%plocal(iv%time-1) + 1, & + iv%info(polaramv)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(polaramv)%levels(n), iv%info(polaramv)%id(n), & ! Station + iv%info(polaramv)%lat(1,n), & ! Latitude + iv%info(polaramv)%lon(1,n) ! Longitude + do k = 1 , iv%info(polaramv)%levels(n) + write(ounit,'(E22.13,2(E22.13,i8,3E22.13))')& + iv%polaramv(n)%p(k), & ! Obs Pressure + iv%polaramv(n)%u(k), &! O-B u + iv%polaramv(n)%v(k) + enddo + end do + close (ounit) + end if + + ! [15] pilot obs: + + if (iv%info(pilot)%plocal(iv%time) - iv%info(pilot)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.pilot',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'pilot', iv%info(pilot)%plocal(iv%time) - & + iv%info(pilot)%plocal(iv%time-1) + do n = iv%info(pilot)%plocal(iv%time-1) + 1, & + iv%info(pilot)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(pilot)%levels(n), iv%info(pilot)%id(n), & ! Station + iv%info(pilot)%lat(1,n), & ! Latitude + iv%info(pilot)%lon(1,n) ! Longitude + do k = 1 , iv%info(pilot)%levels(n) + write(ounit,'(E22.13,2(E22.13,i8,3E22.13))')& + iv%pilot(n)%p(k), & ! Obs Pressure + iv%pilot(n)%u(k), &! O-B u + iv%pilot(n)%v(k) + enddo + end do + close (ounit) + end if + + ! [16] ssmi_tb obs: + + if (iv%info(ssmi_tb)%plocal(iv%time) - iv%info(ssmi_tb)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.ssmi_tb',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'ssmi_tb', iv%info(ssmi_tb)%plocal(iv%time) - & + iv%info(ssmi_tb)%plocal(iv%time-1) + do n = iv%info(ssmi_tb)%plocal(iv%time-1) + 1, & + iv%info(ssmi_tb)%plocal(iv%time) + write(ounit,'(i8,2E22.13)')& + n, & ! Station + iv%info(ssmi_tb)%lat(1,n), & ! Latitude + iv%info(ssmi_tb)%lon(1,n) ! Longitude + write(ounit,'(7(E22.13,i8,3E22.13))')& + iv%ssmi_tb(n)%tb19h, & ! O-B Tb19h + iv%ssmi_tb(n)%tb19v, & ! O-B Tb19v + iv%ssmi_tb(n)%tb22v, & ! O-B Tb22v + iv%ssmi_tb(n)%tb37h, & ! O-B Tb37h + iv%ssmi_tb(n)%tb37v, & ! O-B Tb37v + iv%ssmi_tb(n)%tb85h, & ! O-B Tb85h + iv%ssmi_tb(n)%tb85v ! O-B Tb85v + end do + close (ounit) + end if + + ! [17] satem obs: + + if (iv%info(satem)%plocal(iv%time) - iv%info(satem)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.satem',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'satem', iv%info(satem)%plocal(iv%time) - & + iv%info(satem)%plocal(iv%time-1) + do n = iv%info(satem)%plocal(iv%time-1) + 1, & + iv%info(satem)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(satem)%levels(n), iv%info(satem)%id(n), & ! Station + iv%info(satem)%lat(1,n), & ! Latitude + iv%info(satem)%lon(1,n) ! Longitude + do k = 1 , iv%info(satem)%levels(n) + write(ounit,'(E22.13,(E22.13,i8,3E22.13))')& + iv%satem(n)%p(k), & ! Obs Pressure + iv%satem(n)%thickness(k) + enddo + end do + close (ounit) + end if + + ! [18] ssmt1 obs: + + if (iv%info(ssmt1)%plocal(iv%time) - iv%info(ssmt1)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.ssmt1',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'ssmt1', iv%info(ssmt1)%plocal(iv%time) - & + iv%info(ssmt1)%plocal(iv%time-1) + do n = iv%info(ssmt1)%plocal(iv%time-1) + 1, & + iv%info(ssmt1)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(ssmt1)%levels(n), iv%info(ssmt1)%id(n), & ! Station + iv%info(ssmt1)%lat(1,n), & ! Latitude + iv%info(ssmt1)%lon(1,n) ! Longitude + do k = 1 , iv%info(ssmt1)%levels(n) + write(ounit,'(E22.13,(E22.13,i8,3E22.13))')& + iv%ssmt1(n)%h(k), & ! Obs height + iv%ssmt1(n)%t(k) + enddo + end do + close (ounit) + end if + + ! [19] ssmt2 obs: + + if (iv%info(ssmt2)%plocal(iv%time) - iv%info(ssmt2)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.ssmt2',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'ssmt2', iv%info(ssmt2)%plocal(iv%time) - & + iv%info(ssmt2)%plocal(iv%time-1) + do n = iv%info(ssmt2)%plocal(iv%time-1) + 1, & + iv%info(ssmt2)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(ssmt2)%levels(n), iv%info(ssmt2)%id(n), & ! Station + iv%info(ssmt2)%lat(1,n), & ! Latitude + iv%info(ssmt2)%lon(1,n) ! Longitude + do k = 1 , iv%info(ssmt2)%levels(n) + write(ounit,'(E22.13,(E22.13,i8,3E22.13))')& + iv%ssmt2(n)%h(k), & ! Obs height + iv%ssmt2(n)%rh(k) + enddo + end do + close (ounit) + end if + + ! [20] scatterometer obs: + + if (iv%info(qscat)%plocal(iv%time) - iv%info(qscat)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.qscat',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'qscat', iv%info(qscat)%plocal(iv%time) - & + iv%info(qscat)%plocal(iv%time-1) + do n = iv%info(qscat)%plocal(iv%time-1) + 1, & + iv%info(qscat)%plocal(iv%time) + write(ounit,'(i8,a5,2E22.13)')& + n, iv%info(qscat)%id(n), & ! Station + iv%info(qscat)%lat(1,n), & ! Latitude + iv%info(qscat)%lon(1,n) ! Longitude + write(ounit,'(E22.13,2(E22.13,i8,3E22.13))')& + iv%qscat(n)%h, & ! Obs height + iv%qscat(n)%u, &! O-B u + iv%qscat(n)%v ! O-B v + end do + close (ounit) + end if + + ! [21] profiler obs: + + if (iv%info(profiler)%plocal(iv%time) - iv%info(profiler)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.profiler',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'profiler', iv%info(profiler)%plocal(iv%time) - & + iv%info(profiler)%plocal(iv%time-1) + do n = iv%info(profiler)%plocal(iv%time-1) + 1, & + iv%info(profiler)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(profiler)%levels(n), iv%info(profiler)%id(n), & ! Station + iv%info(profiler)%lat(1,n), & ! Latitude + iv%info(profiler)%lon(1,n) ! Longitude + do k = 1 , iv%info(profiler)%levels(n) + write(ounit,'(E22.13,2(E22.13,i8,3E22.13))')& + iv%profiler(n)%p(k), & ! Obs Pressure + iv%profiler(n)%u(k), &! O-B u + iv%profiler(n)%v(k) ! O-B v + enddo + end do + close (ounit) + end if + + ! [22] TC bogus obs: + + if (iv%info(bogus)%plocal(iv%time) - iv%info(bogus)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.bogus',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'bogus', iv%info(bogus)%plocal(iv%time) - & + iv%info(bogus)%plocal(iv%time-1) + do n = iv%info(bogus)%plocal(iv%time-1) + 1, & + iv%info(bogus)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(bogus)%levels(n), iv%info(bogus)%id(n), & ! Station + iv%info(bogus)%lat(1,n), & ! Latitude + iv%info(bogus)%lon(1,n) ! Longitude + write(ounit,'(E22.13,i8,3E22.13)')& + iv%bogus(n)%slp ! O-B p + do k = 1 , iv%info(bogus)%levels(n) + write(ounit,'(2E22.13,4(E22.13,i8,3E22.13))')& + iv%bogus(n)%h(k), & + iv%bogus(n)%p(k), & ! Obs Pressure + iv%bogus(n)%u(k), &! O-B u + iv%bogus(n)%v(k), &! O-B v + iv%bogus(n)%t(k), &! O-B t + iv%bogus(n)%q(k) ! O-B q + enddo + end do + close (ounit) + end if + + ! [23] AIRS retrievals: + + if (iv%info(airsr)%plocal(iv%time) - iv%info(airsr)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.airsr',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'airsr', iv%info(airsr)%plocal(iv%time) - & + iv%info(airsr)%plocal(iv%time-1) + do n = iv%info(airsr)%plocal(iv%time-1) + 1, & + iv%info(airsr)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(airsr)%levels(n), iv%info(airsr)%id(n), & ! Station + iv%info(airsr)%lat(1,n), & ! Latitude + iv%info(airsr)%lon(1,n) ! Longitude + do k = 1 , iv%info(airsr)%levels(n) + write(ounit,'(E22.13,2(E22.13,i8,3E22.13))')& + iv%airsr(n)%p(k), & ! Obs Pressure + iv%airsr(n)%t(k), &! O-B t + iv%airsr(n)%q(k) ! O-B q + enddo + end do + close (ounit) + end if + + ! [24] gpsref obs: + + if (iv%info(gpsref)%plocal(iv%time) - iv%info(gpsref)%plocal(iv%time-1) > 0) then + + open (unit=ounit,file=trim(filename)//'.gpsref',form='formatted',status='replace', & + iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open conventional observation omb file"//filename/)) + end if + + write(ounit,'(a20,i8)')'gpsref', iv%info(gpsref)%plocal(iv%time) - & + iv%info(gpsref)%plocal(iv%time-1) + do n = iv%info(gpsref)%plocal(iv%time-1) + 1, & + iv%info(gpsref)%plocal(iv%time) + write(ounit,'(2i8,a5,2E22.13)')& + n, iv%info(gpsref)%levels(n), iv%info(gpsref)%id(n), & ! Station + iv%info(gpsref)%lat(1,n), & ! Latitude + iv%info(gpsref)%lon(1,n) ! Longitude + do k = 1 , iv%info(gpsref)%levels(n) + write(ounit,'(E22.13,(E22.13,i8,3E22.13))')& + iv%gpsref(n)%h(k), & ! Obs Height + iv%gpsref(n)%ref(k) ! O-B ref + enddo + end do + close (ounit) + end if + + ! [25] radar obs: + + nobs_tot = iv%info(radar)%ptotal(num_fgat_time) - iv%info(radar)%ptotal(0) + nlev_max = iv%info(radar)%max_lev + + if ( nobs_tot > 0 ) then + if ( rootproc ) then + write(unit=filename, fmt='(a,i3.3,a)') 'radar_innov_t', file_index + open (unit=ounit,file=trim(filename),form='unformatted', & + status='replace', iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file "//trim(filename)/)) + end if + write(ounit) nobs_tot, nlev_max, use_radar_rv, use_radar_rf, use_radar_rhv, use_radar_rqv + end if ! root open ounit + + allocate( data2d(nobs_tot, 2) ) + data2d = 0.0 + do n = iv%info(radar)%n1, iv%info(radar)%n2 + if ( .not. iv%info(radar)%proc_domain(1,n) ) cycle + iobs = iv%info(radar)%obs_global_index(n) + data2d(iobs, 1) = iv%info(radar)%lat(1,n) + data2d(iobs, 2) = iv%info(radar)%lon(1,n) + end do + + allocate( data2d_g(nobs_tot, 2) ) +#ifdef DM_PARALLEL + call mpi_reduce(data2d, data2d_g, nobs_tot*2, true_mpi_real, mpi_sum, root, comm, ierr) +#else + data2d_g = data2d +#endif + deallocate( data2d ) + if ( rootproc ) then + write(ounit) data2d_g + end if + deallocate( data2d_g ) + + if ( use_radar_rv ) then + allocate( data3d(nobs_tot, nlev_max, 3) ) + data3d = 0.0 + do n = iv%info(radar)%n1, iv%info(radar)%n2 + if ( .not. iv%info(radar)%proc_domain(1,n) ) cycle + iobs = iv%info(radar)%obs_global_index(n) + do k = 1 , iv%info(radar)%levels(n) + data3d(iobs, k, 1) = iv%radar(n)%rv(k)%inv + data3d(iobs, k, 2) = iv%radar(n)%rv(k)%qc * 1.0 !int to real + data3d(iobs, k, 3) = iv%radar(n)%rv(k)%error + end do + end do + allocate( data3d_g(nobs_tot, nlev_max, 3) ) +#ifdef DM_PARALLEL + call mpi_reduce(data3d, data3d_g, nobs_tot*nlev_max*3, true_mpi_real, mpi_sum, root, comm, ierr) +#else + data3d_g = data3d +#endif + deallocate( data3d ) + if ( rootproc ) then + write(ounit) data3d_g + end if + deallocate( data3d_g ) + end if ! use_radar_rv + + if ( use_radar_rf ) then + allocate( data3d(nobs_tot, nlev_max, 3) ) + data3d = 0.0 + do n = iv%info(radar)%n1, iv%info(radar)%n2 + if ( .not. iv%info(radar)%proc_domain(1,n) ) cycle + iobs = iv%info(radar)%obs_global_index(n) + do k = 1 , iv%info(radar)%levels(n) + data3d(iobs, k, 1) = iv%radar(n)%rf(k)%inv + data3d(iobs, k, 2) = iv%radar(n)%rf(k)%qc * 1.0 !int to real + data3d(iobs, k, 3) = iv%radar(n)%rf(k)%error + end do + end do + allocate( data3d_g(nobs_tot, nlev_max, 3) ) +#ifdef DM_PARALLEL + call mpi_reduce(data3d, data3d_g, nobs_tot*nlev_max*3, true_mpi_real, mpi_sum, root, comm, ierr) +#else + data3d_g = data3d +#endif + deallocate( data3d ) + if ( rootproc ) then + write(ounit) data3d_g + end if + deallocate( data3d_g ) + end if ! use_radar_rf + + if ( use_radar_rhv ) then + allocate( data3d(nobs_tot, nlev_max, 9) ) + data3d = 0.0 + do n = iv%info(radar)%n1, iv%info(radar)%n2 + if ( .not. iv%info(radar)%proc_domain(1,n) ) cycle + iobs = iv%info(radar)%obs_global_index(n) + do k = 1 , iv%info(radar)%levels(n) + data3d(iobs, k, 1) = iv%radar(n)%rrn(k)%inv + data3d(iobs, k, 2) = iv%radar(n)%rrn(k)%qc * 1.0 !int to real + data3d(iobs, k, 3) = iv%radar(n)%rrn(k)%error + data3d(iobs, k, 4) = iv%radar(n)%rsn(k)%inv + data3d(iobs, k, 5) = iv%radar(n)%rsn(k)%qc * 1.0 !int to real + data3d(iobs, k, 6) = iv%radar(n)%rsn(k)%error + data3d(iobs, k, 7) = iv%radar(n)%rgr(k)%inv + data3d(iobs, k, 8) = iv%radar(n)%rgr(k)%qc * 1.0 !int to real + data3d(iobs, k, 9) = iv%radar(n)%rgr(k)%error + end do + end do + allocate( data3d_g(nobs_tot, nlev_max, 9) ) +#ifdef DM_PARALLEL + call mpi_reduce(data3d, data3d_g, nobs_tot*nlev_max*9, true_mpi_real, mpi_sum, root, comm, ierr) +#else + data3d_g = data3d +#endif + deallocate( data3d ) + if ( rootproc ) then + write(ounit) data3d_g + end if + deallocate( data3d_g ) + end if + + if ( use_radar_rqv ) then + allocate( data3d(nobs_tot, nlev_max, 3) ) + data3d = 0.0 + do n = iv%info(radar)%n1, iv%info(radar)%n2 + if ( .not. iv%info(radar)%proc_domain(1,n) ) cycle + iobs = iv%info(radar)%obs_global_index(n) + do k = 1 , iv%info(radar)%levels(n) + data3d(iobs, k, 1) = iv%radar(n)%rqv(k)%inv + data3d(iobs, k, 2) = iv%radar(n)%rqv(k)%qc * 1.0 !int to real + data3d(iobs, k, 3) = iv%radar(n)%rqv(k)%error + end do + end do + allocate( data3d_g(nobs_tot, nlev_max, 3) ) +#ifdef DM_PARALLEL + call mpi_reduce(data3d, data3d_g, nobs_tot*nlev_max*3, true_mpi_real, mpi_sum, root, comm, ierr) +#else + data3d_g = data3d +#endif + deallocate( data3d ) + if ( rootproc ) then + write(ounit) data3d_g + end if + deallocate( data3d_g ) + end if ! use_radar_rqv + + if ( rootproc ) then + close(ounit) + end if + + end if ! nobs_tot > 0 + + !------------------------------------------------------------------------------- + + + call da_free_unit(ounit) + + if (trace_use) call da_trace_exit("da_write_iv_for_multi_inc_opt2") + +end subroutine da_write_iv_for_multi_inc_opt2 + + From e6268abacd79969d9e7ce85eba016cd00f326c96 Mon Sep 17 00:00:00 2001 From: Dave Gill Date: Fri, 15 Feb 2019 13:08:35 -0700 Subject: [PATCH 40/91] Update version to 4.1-alpha (friendly #1) (#791) TYPE: text only KEYWORDS: version_decl, v4.1-alpha SOURCE: internal DESCRIPTION OF CHANGES: Update the character string inside the WRF system from 4.0.3 to 4.1-alpha. LIST OF MODIFIED FILES: M inc/version_decl TESTS CONDUCTED: - [x] Code runs and v4.1-alpha is the version printed from the WRF system programs. ``` > ncdump -h wrfinput_d01 | grep TITLE :TITLE = " OUTPUT FROM REAL_EM V4.1-alpha PREPROCESSOR" ; > ncdump -h wrfinput_initialized_d01 | grep TITLE :TITLE = " OUTPUT FROM WRF V4.1-alpha MODEL" ; > ncdump -h met_em.d01.2019-02-15_12:00:00.nc | grep TITLE :TITLE = "OUTPUT FROM METGRID V4.1" ; > ncdump -h wrfout_d01_2019-02-16_12:00:00 | grep TITLE :TITLE = " OUTPUT FROM WRF V4.1-alpha MODEL" ; ``` --- inc/version_decl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/inc/version_decl b/inc/version_decl index 7d767c57ee..3384552f76 100644 --- a/inc/version_decl +++ b/inc/version_decl @@ -1 +1 @@ - CHARACTER (LEN=10) :: release_version = 'V4.0.3 ' + CHARACTER (LEN=10) :: release_version = 'V4.1-alpha' From 0bd331efeba0ea3ad40b11fdde3150e46923903a Mon Sep 17 00:00:00 2001 From: wishingprincess Date: Fri, 22 Feb 2019 15:20:23 -0700 Subject: [PATCH 41/91] On branch CWB_v391a_mri4dvar deleted: .gitignore modified: Registry/registry.var modified: var/da/da_define_structures/da_define_structures.f90 modified: var/da/da_minimisation/da_get_innov_vector.inc modified: var/da/da_minimisation/da_minimisation.f90 modified: var/da/da_obs_io/da_final_write_obs.inc modified: var/da/da_obs_io/da_obs_io.f90 modified: var/da/da_obs_io/da_read_iv_for_multi_inc_opt2.inc modified: var/da/da_obs_io/da_read_obs_radar.inc modified: var/da/da_obs_io/da_scan_obs_radar.inc new file: var/da/da_obs_io/log modified: var/da/da_radiance/da_allocate_rad_iv.inc modified: var/da/da_radiance/da_crtm.f90 modified: var/da/da_radiance/da_deallocate_radiance.inc modified: var/da/da_radiance/da_get_innov_vector_radiance.inc modified: var/da/da_radiance/da_initialize_rad_iv.inc new file: var/da/da_radiance/da_qc_ahi.inc new file: var/da/da_radiance/da_qc_ahi.inc.bak new file: var/da/da_radiance/da_qc_ahi_zou.inc modified: var/da/da_radiance/da_qc_rad.inc modified: var/da/da_radiance/da_radiance.f90 modified: var/da/da_radiance/da_radiance1.f90 modified: var/da/da_radiance/da_radiance_init.inc new file: var/da/da_radiance/da_read_iv_rad_ascii.inc new file: var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc new file: var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc.ok new file: var/da/da_radiance/da_read_obs_AHI.inc new file: var/da/da_radiance/da_read_obs_AHI.inc.1 modified: var/da/da_radiance/da_read_obs_fy3.inc new file: var/da/da_radiance/da_read_obs_hdf5ahi.inc new file: var/da/da_radiance/da_read_obs_netcdf4ahi_geocat.inc new file: var/da/da_radiance/da_read_obs_netcdf4ahi_jaxa.inc new file: var/da/da_radiance/da_read_obs_netcdf4ahi_zou.inc modified: var/da/da_radiance/da_setup_radiance_structures.inc modified: var/da/da_radiance/da_transform_xtoy_crtm.inc modified: var/da/da_radiance/da_transform_xtoy_crtm_adj.inc modified: var/da/da_radiance/da_write_filtered_rad.inc modified: var/da/da_radiance/da_write_iv_rad_ascii.inc new file: var/da/da_radiance/da_write_iv_rad_for_multi_inc.inc modified: var/da/da_radiance/da_write_oa_rad_ascii.inc new file: var/da/da_radiance/log modified: var/da/da_radiance/module_radiance.f90 modified: var/da/da_setup_structures/da_setup_obs_structures.inc modified: var/da/da_setup_structures/da_setup_structures.f90 modified: var/da/da_tools/da_get_time_slots.inc modified: var/da/da_transfer_model/da_transfer_xatowrf.inc typechange: var/run/VARBC.in new file: var/run/ahi_info new file: var/run/radiance_info/himawari-8-ahi.info modified: var/test/4dvar/namelist.input --- .gitignore | 18 - Registry/registry.var | 4 + .../da_define_structures.f90 | 4 + .../da_minimisation/da_get_innov_vector.inc | 43 +- var/da/da_minimisation/da_minimisation.f90 | 10 +- var/da/da_obs_io/da_final_write_obs.inc | 156 +- var/da/da_obs_io/da_obs_io.f90 | 2 +- .../da_read_iv_for_multi_inc_opt2.inc | 90 +- var/da/da_obs_io/da_read_obs_radar.inc | 2 +- var/da/da_obs_io/da_scan_obs_radar.inc | 2 +- var/da/da_obs_io/log | 24 + var/da/da_radiance/da_allocate_rad_iv.inc | 19 + var/da/da_radiance/da_crtm.f90 | 3 +- var/da/da_radiance/da_deallocate_radiance.inc | 19 + .../da_get_innov_vector_radiance.inc | 27 +- var/da/da_radiance/da_initialize_rad_iv.inc | 4 + var/da/da_radiance/da_qc_ahi.inc | 233 ++ var/da/da_radiance/da_qc_ahi.inc.bak | 233 ++ var/da/da_radiance/da_qc_ahi_zou.inc | 617 +++++ var/da/da_radiance/da_qc_rad.inc | 6 +- var/da/da_radiance/da_radiance.f90 | 4 +- var/da/da_radiance/da_radiance1.f90 | 28 +- var/da/da_radiance/da_radiance_init.inc | 26 +- var/da/da_radiance/da_read_iv_rad_ascii.inc | 334 +++ .../da_read_iv_rad_for_multi_inc.inc | 96 + .../da_read_iv_rad_for_multi_inc.inc.ok | 334 +++ var/da/da_radiance/da_read_obs_AHI.inc | 570 +++++ var/da/da_radiance/da_read_obs_AHI.inc.1 | 566 +++++ var/da/da_radiance/da_read_obs_fy3.inc | 2 +- var/da/da_radiance/da_read_obs_hdf5ahi.inc | 643 +++++ .../da_read_obs_netcdf4ahi_geocat.inc | 590 +++++ .../da_read_obs_netcdf4ahi_jaxa.inc | 521 ++++ .../da_read_obs_netcdf4ahi_zou.inc | 556 +++++ .../da_setup_radiance_structures.inc | 59 + var/da/da_radiance/da_transform_xtoy_crtm.inc | 26 +- .../da_transform_xtoy_crtm_adj.inc | 10 +- var/da/da_radiance/da_write_filtered_rad.inc | 22 +- var/da/da_radiance/da_write_iv_rad_ascii.inc | 36 +- .../da_write_iv_rad_for_multi_inc.inc | 140 ++ var/da/da_radiance/da_write_oa_rad_ascii.inc | 16 +- var/da/da_radiance/log | 76 + var/da/da_radiance/module_radiance.f90 | 4 +- .../da_setup_obs_structures.inc | 2 +- .../da_setup_structures.f90 | 2 +- var/da/da_tools/da_get_time_slots.inc | 3 +- .../da_transfer_model/da_transfer_xatowrf.inc | 17 +- var/run/VARBC.in | 2148 +---------------- var/run/ahi_info | 8 + var/run/radiance_info/himawari-8-ahi.info | 11 + var/test/4dvar/namelist.input | 23 +- 50 files changed, 6088 insertions(+), 2301 deletions(-) delete mode 100644 .gitignore create mode 100644 var/da/da_obs_io/log create mode 100644 var/da/da_radiance/da_qc_ahi.inc create mode 100644 var/da/da_radiance/da_qc_ahi.inc.bak create mode 100644 var/da/da_radiance/da_qc_ahi_zou.inc create mode 100644 var/da/da_radiance/da_read_iv_rad_ascii.inc create mode 100644 var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc create mode 100644 var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc.ok create mode 100644 var/da/da_radiance/da_read_obs_AHI.inc create mode 100644 var/da/da_radiance/da_read_obs_AHI.inc.1 create mode 100644 var/da/da_radiance/da_read_obs_hdf5ahi.inc create mode 100644 var/da/da_radiance/da_read_obs_netcdf4ahi_geocat.inc create mode 100644 var/da/da_radiance/da_read_obs_netcdf4ahi_jaxa.inc create mode 100644 var/da/da_radiance/da_read_obs_netcdf4ahi_zou.inc create mode 100644 var/da/da_radiance/da_write_iv_rad_for_multi_inc.inc create mode 100644 var/da/da_radiance/log mode change 100644 => 120000 var/run/VARBC.in create mode 100644 var/run/ahi_info create mode 100644 var/run/radiance_info/himawari-8-ahi.info diff --git a/.gitignore b/.gitignore deleted file mode 100644 index da7855287a..0000000000 --- a/.gitignore +++ /dev/null @@ -1,18 +0,0 @@ -# This is the top-level .gitignore file for the WRF model # -# # -# Filenames and wildcards added below will not be tracked by git in any # -# directory in the repository # -# # -# Ignored file types should include executables, build-time temporary files, # -# and other files which should not ever be added to the code repository. # -# # -# USE CAUTION WHEN ADDING WILDCARDS, as some builds use different filename # -# conventions than others # -############################################################################## -*.exe -*.o -*.mod -*.a -configure.wrf* -*.backup -*.f90 diff --git a/Registry/registry.var b/Registry/registry.var index b1bba57b7a..23cb69d0d6 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -179,6 +179,8 @@ rconfig logical use_eos_amsuaobs namelist,wrfvar4 1 .false. - "use rconfig logical use_hsbobs namelist,wrfvar4 1 .false. - "use_hsbobs" "" "" rconfig logical use_ssmisobs namelist,wrfvar4 1 .false. - "use_ssmisobs" "" "" rconfig logical use_iasiobs namelist,wrfvar4 1 .false. - "use_iasiobs" "" "" +rconfig logical use_ahiobs namelist,wrfvar4 1 .false. - "use_ahiobs" "" "" +#wuyl rconfig logical use_seviriobs namelist,wrfvar4 1 .false. - "use_seviriobs" "" "" rconfig logical use_amsr2obs namelist,wrfvar4 1 .false. - "use_amsr2obs" "" "" rconfig logical use_kma1dvar namelist,wrfvar4 1 .false. - "use_kma1dvar" "" "" @@ -413,6 +415,8 @@ rconfig integer mw_emis_sea namelist,wrfvar14 1 1 - "mw rconfig integer tovs_min_transfer namelist,wrfvar14 1 10 - "tovs_min_transfer" "" "" rconfig logical tovs_batch namelist,wrfvar14 1 .false. - "tovs_batch" "" "" rconfig integer rtm_option namelist,wrfvar14 1 1 - "rtm_option" "" "" +rconfig integer varbc_scan namelist,wrfvar14 1 1 - "varbc_scan" "" "" +#wuyl rconfig logical use_crtm_kmatrix namelist,wrfvar14 1 .true. - "use_crtm_kmatrix" "" "" rconfig logical use_rttov_kmatrix namelist,wrfvar14 1 .false. - "use_rttov_kmatrix" "" "" rconfig logical crtm_cloud namelist,wrfvar14 1 .false. - "crtm_cloud" "" "" diff --git a/var/da/da_define_structures/da_define_structures.f90 b/var/da/da_define_structures/da_define_structures.f90 index ef54856488..1eee4e249c 100644 --- a/var/da/da_define_structures/da_define_structures.f90 +++ b/var/da/da_define_structures/da_define_structures.f90 @@ -489,6 +489,7 @@ module da_define_structures integer :: num_rad, nchan, nlevels integer :: num_rad_glo integer, pointer :: ichan(:) + real, pointer :: ca_mean(:,:) ! IR allsky control variable real, pointer :: tb_inv(:,:) integer, pointer :: tb_qc(:,:) real, pointer :: tb_error(:,:) @@ -502,6 +503,7 @@ module da_define_structures integer, pointer :: scanpos(:) integer, pointer :: scanline(:) integer, pointer :: cloud_flag(:,:) + integer, pointer :: cloudflag(:) !rewritted by wuyl integer, pointer :: rain_flag(:) real, pointer :: satzen(:) real, pointer :: satazi(:) @@ -556,6 +558,8 @@ module da_define_structures real, pointer :: vegfra(:) real, pointer :: clwp(:) ! model/guess clwp real, pointer :: clw(:) ! currently AMSR2 only + real, pointer :: tropt(:) !(Zhuge and Zou, 2016, JAMC, cloud check),rewritted by wuyl + real, pointer :: SDob(:) !(Okamoto, 2017, AHI allsky QC) ,rewritted by wuyl real, pointer :: ps_jacobian(:,:) ! only RTTOV real, pointer :: ts_jacobian(:,:) ! only over water CRTM real, pointer :: windspeed_jacobian(:,:) ! only MV and over water CRTM diff --git a/var/da/da_minimisation/da_get_innov_vector.inc b/var/da/da_minimisation/da_get_innov_vector.inc index dc9ac19fdb..f2d8192cfd 100644 --- a/var/da/da_minimisation/da_get_innov_vector.inc +++ b/var/da/da_minimisation/da_get_innov_vector.inc @@ -104,6 +104,8 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) endif end if +! if ( multi_inc == 0 .or. multi_inc == 1) then +! eof_decomposition error if uesed ! Radiosonde: if (iv%info(sound)%nlocal > 0) then call da_get_innov_vector_sound (it, num_qcstat_conv, grid, ob, iv) @@ -167,7 +169,8 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) if (iv%info(pseudo)%nlocal ==1) call da_get_innov_vector_pseudo (it, grid, ob, iv) if (iv%info(airsr)%nlocal > 0) & call da_get_innov_vector_airsr (it,num_qcstat_conv, grid, ob, iv) - + +! end if !---------------------------------------------- ! [5] write out iv in ascii format !----------------------------------------------- @@ -197,10 +200,26 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) #if defined(RTTOV) || defined(CRTM) if (use_rad) then - if ( use_varbc .or. freeze_varbc ) then - if ( num_fgat_time > 1 ) call da_varbc_coldstart(iv) - end if - if ( use_varbc .and. it == 1 ) call da_varbc_precond(iv) + if ( use_varbc .or. freeze_varbc ) then +! if ( num_fgat_time > 1 ) call da_varbc_coldstart(iv) +! end if +! if ( use_varbc .and. it == 1 ) call da_varbc_precond(iv) + if ( num_fgat_time > 1 ) then + iv%instid(:)%info%n1 = 1 + iv%instid(:)%info%n2 = iv%instid(:)%info%plocal(num_fgat_time) + call da_varbc_coldstart(iv) + do n= num_fgat_time , 1, -1 + iv%time = n + iv%instid(:)%info%n1 = iv%instid(:)%info%plocal(iv%time-1) + 1 + iv%instid(:)%info%n2 = iv%instid(:)%info%plocal(iv%time) + call da_varbc_direct(iv) + if (qc_rad) then + call da_qc_rad(it, ob, iv) + end if ! qc is conducted inside n1-n2 + end do + end if + end if + if ( use_varbc .and. it == 1 ) call da_varbc_precond(iv) !fixed by wuyl end if #endif @@ -228,6 +247,19 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) call domain_clockprint(150, grid, 'get CurrTime from clock,') end if +#if defined(CRTM) || defined(RTTOV) + !---------------------------------------------- + ! write out or read in radiance iv for multi in binary format + !----------------------------------------------- + if (use_rad) then + if ( multi_inc == 1 ) then + call da_write_iv_rad_for_multi_inc(it,ob,iv) + elseif ( multi_inc == 2 ) then + call da_read_iv_rad_for_multi_inc(it,ob,iv) + end if + end if +#endif + if ( multi_inc == 1 ) then #ifdef DM_PARALLEL call mpi_barrier(MPI_COMM_WORLD,ierr) @@ -281,6 +313,7 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) end if #endif + !---------------------------------------------------------- ! [6] write out filtered radiance obs in binary format !---------------------------------------------------------- diff --git a/var/da/da_minimisation/da_minimisation.f90 b/var/da/da_minimisation/da_minimisation.f90 index b3b896a3ed..7c68d51b58 100644 --- a/var/da/da_minimisation/da_minimisation.f90 +++ b/var/da/da_minimisation/da_minimisation.f90 @@ -33,7 +33,7 @@ module da_minimisation use da_buoy , only : da_calculate_grady_buoy, da_ao_stats_buoy, & da_oi_stats_buoy,da_get_innov_vector_buoy, da_residual_buoy, & da_jo_and_grady_buoy - use da_control, only : trace_use, var4d_bin, trajectory_io, analysis_date, & + use da_control, only : trace_use, var4d_bin, trajectory_io, analysis_date, qc_rad, & var4d, rootproc,jcdfi_use,jcdfi_diag,ierr,comm,num_fgat_time, & var4d_lbc, stdout, eps, stats_unit, test_dm_exact, global, multi_inc, & calculate_cg_cost_fn,anal_type_randomcv,cv_size_domain,je_factor, & @@ -77,7 +77,8 @@ module da_minimisation use da_obs_io, only : da_final_write_y, da_write_y, da_final_write_obs, & da_write_obs,da_write_obs_etkf,da_write_noise_to_ob, da_use_obs_errfac, & da_write_iv_for_multi_inc, da_read_iv_for_multi_inc, & - da_write_iv_for_multi_inc_opt2, da_read_iv_for_multi_inc_opt2 + da_write_iv_for_multi_inc_opt2, da_read_iv_for_multi_inc_opt2 + use da_metar, only : da_calculate_grady_metar, da_ao_stats_metar, & da_oi_stats_metar, da_get_innov_vector_metar, da_residual_metar, & da_jo_and_grady_metar @@ -115,7 +116,8 @@ module da_minimisation use da_radiance, only : da_calculate_grady_rad, da_write_filtered_rad, & da_get_innov_vector_radiance, satinfo use da_radiance1, only : da_ao_stats_rad,da_oi_stats_rad, & - da_write_iv_rad_ascii,da_residual_rad,da_jo_and_grady_rad + da_write_iv_rad_ascii,da_residual_rad,da_jo_and_grady_rad, & + da_write_iv_rad_for_multi_inc,da_read_iv_rad_for_multi_inc,da_qc_rad #endif use da_radar, only : da_calculate_grady_radar, da_ao_stats_radar, & da_oi_stats_radar, da_get_innov_vector_radar, da_residual_radar, & @@ -156,7 +158,7 @@ module da_minimisation use da_transfer_model, only : da_transfer_wrftltoxa,da_transfer_xatowrftl, & da_transfer_xatowrftl_adj,da_transfer_wrftltoxa_adj #if defined(RTTOV) || defined(CRTM) - use da_varbc, only : da_varbc_tl,da_varbc_adj,da_varbc_precond,da_varbc_coldstart + use da_varbc, only : da_varbc_tl,da_varbc_adj,da_varbc_precond,da_varbc_coldstart,da_varbc_direct #endif use da_vtox_transforms, only : da_transform_vtox,da_transform_vtox_adj,da_transform_xtoxa,da_transform_xtoxa_adj use da_vtox_transforms, only : da_copy_xa, da_add_xa, da_transform_vpatox, da_transform_vpatox_adj diff --git a/var/da/da_obs_io/da_final_write_obs.inc b/var/da/da_obs_io/da_final_write_obs.inc index 9bdf0c2891..c020779bb5 100644 --- a/var/da/da_obs_io/da_final_write_obs.inc +++ b/var/da/da_obs_io/da_final_write_obs.inc @@ -8,7 +8,7 @@ subroutine da_final_write_obs(it,iv) integer, intent(in) :: it type (iv_type), intent(in) :: iv ! O-B structure. - integer :: n, k, iunit + integer :: n, k, iunit,m, m1,m2 integer :: ios ! Error code from MPI routines. integer :: num_obs logical :: if_wind_sd @@ -23,22 +23,34 @@ subroutine da_final_write_obs(it,iv) call mpi_barrier(comm, ierr) #endif - if (rootproc) then - call da_get_unit(iunit) - allocate (filename(0:num_procs-1)) - do k = 0,num_procs-1 - write(unit=filename(k),fmt ='(a,i2.2,a,i4.4)')'gts_omb_oma_',it,'.',k - end do - call da_get_unit(omb_unit) - write(unit=file,fmt ='(a,i2.2)')'gts_omb_oma_',it - open(unit=omb_unit,file=trim(file),form='formatted', status='replace', iostat=ios) - if (ios /= 0) call da_error(__FILE__,__LINE__, & - (/"Cannot open file "//file/)) - end if +!wuyl +do m= num_fgat_time , 1, -1 + + if (rootproc) then + call da_get_unit(iunit) + allocate (filename(0:num_procs-1)) + do k = 0,num_procs-1 + write(unit=filename(k),fmt ='(a,i2.2,a,i4.4)')'gts_omb_oma_',it,'.',k + end do + + + call da_get_unit(omb_unit) + if (num_fgat_time>1) then + write(unit=file,fmt ='(a,i2.2,a,i2.2)')'gts_omb_oma_',m,'_',it + else + write(unit=file,fmt ='(a,i2.2)')'gts_omb_oma_',it + end if + open(unit=omb_unit,file=trim(file),form='formatted', status='replace', iostat=ios) + if (ios /= 0) call da_error(__FILE__,__LINE__, & + (/"Cannot open file "//file/)) + end if num_obs = 0 if (iv%info(synop)%nlocal > 0) then - do n = 1, iv%info(synop)%nlocal +!wuyl do n = 1, iv%info(synop)%nlocal + m1 = iv%info(synop)%plocal(m-1) + 1 + m2 = iv%info(synop)%plocal(m) + do n = m1,m2 if(iv%info(synop)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -59,7 +71,10 @@ subroutine da_final_write_obs(it,iv) num_obs = 0 if (iv%info(metar)%nlocal > 0) then - do n = 1, iv%info(metar)%nlocal +!wuyl do n = 1, iv%info(metar)%nlocal + m1 = iv%info(metar)%plocal(m-1) + 1 + m2 = iv%info(metar)%plocal(m) + do n = m1,m2 if (iv%info(metar)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -80,7 +95,10 @@ subroutine da_final_write_obs(it,iv) num_obs = 0 if (iv%info(ships)%nlocal > 0) then - do n = 1, iv%info(ships)%nlocal +!wuyl do n = 1, iv%info(ships)%nlocal + m1 = iv%info(ships)%plocal(m-1) + 1 + m2 = iv%info(ships)%plocal(m) + do n = m1,m2 if(iv%info(ships)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -101,7 +119,10 @@ subroutine da_final_write_obs(it,iv) num_obs = 0 if (iv%info(geoamv)%nlocal > 0) then - do n = 1, iv%info(geoamv)%nlocal +!wuyl do n = 1, iv%info(geoamv)%nlocal + m1 = iv%info(geoamv)%plocal(m-1) + 1 + m2 = iv%info(geoamv)%plocal(m) + do n = m1,m2 if (iv%info(geoamv)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -122,7 +143,10 @@ subroutine da_final_write_obs(it,iv) num_obs = 0 if (iv%info(polaramv)%nlocal > 0) then - do n = 1, iv%info(polaramv)%nlocal +!wuyl do n = 1, iv%info(polaramv)%nlocal + m1 = iv%info(polaramv)%plocal(m-1) + 1 + m2 = iv%info(polaramv)%plocal(m) + do n = m1,m2 if (iv%info(polaramv)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -143,7 +167,10 @@ subroutine da_final_write_obs(it,iv) num_obs = 0 if (iv%info(gpspw)%nlocal > 0) then - do n = 1, iv%info(gpspw)%nlocal +!wuyl do n = 1, iv%info(gpspw)%nlocal + m1 = iv%info(gpspw)%plocal(m-1) + 1 + m2 = iv%info(gpspw)%plocal(m) + do n = m1,m2 if(iv%info(gpspw)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -163,7 +190,10 @@ subroutine da_final_write_obs(it,iv) num_obs = 0 if (iv%info(sound)%nlocal > 0) then - do n = 1, iv%info(sound)%nlocal +!wuyl do n = 1, iv%info(sound)%nlocal + m1 = iv%info(sound)%plocal(m-1) + 1 + m2 = iv%info(sound)%plocal(m) + do n = m1,m2 if (iv%info(sound)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -181,7 +211,10 @@ subroutine da_final_write_obs(it,iv) ! Now sonde_sfc num_obs = 0 if (iv%info(sonde_sfc)%nlocal > 0) then - do n = 1, iv%info(sonde_sfc)%nlocal +!wuyl do n = 1, iv%info(sonde_sfc)%nlocal + m1 = iv%info(sonde_sfc)%plocal(m-1) + 1 + m2 = iv%info(sonde_sfc)%plocal(m) + do n = m1,m2 if(iv%info(sonde_sfc)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -200,7 +233,10 @@ subroutine da_final_write_obs(it,iv) num_obs = 0 if (iv%info(airep)%nlocal > 0) then - do n = 1, iv%info(airep)%nlocal +!wuyl do n = 1, iv%info(airep)%nlocal + m1 = iv%info(airep)%plocal(m-1) + 1 + m2 = iv%info(airep)%plocal(m) + do n = m1,m2 if(iv%info(airep)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -221,7 +257,10 @@ subroutine da_final_write_obs(it,iv) num_obs = 0 if (iv%info(pilot)%nlocal > 0) then - do n = 1, iv%info(pilot)%nlocal +! do n = 1, iv%info(pilot)%nlocal + m1 = iv%info(pilot)%plocal(m-1) + 1 + m2 = iv%info(pilot)%plocal(m) + do n = m1,m2 if(iv%info(pilot)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -242,7 +281,10 @@ subroutine da_final_write_obs(it,iv) num_obs = 0 if (iv%info(ssmi_rv)%nlocal > 0) then - do n = 1, iv%info(ssmi_rv)%nlocal +! do n = 1, iv%info(ssmi_rv)%nlocal + m1 = iv%info(ssmi_rv)%plocal(m-1) + 1 + m2 = iv%info(ssmi_rv)%plocal(m) + do n = m1,m2 if(iv%info(ssmi_rv)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -262,7 +304,10 @@ subroutine da_final_write_obs(it,iv) num_obs = 0 if (iv%info(ssmi_tb)%nlocal > 0) then - do n = 1, iv%info(ssmi_tb)%nlocal +! do n = 1, iv%info(ssmi_tb)%nlocal + m1 = iv%info(ssmi_tb)%plocal(m-1) + 1 + m2 = iv%info(ssmi_tb)%plocal(m) + do n = m1,m2 if (iv%info(ssmi_tb)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -282,7 +327,10 @@ subroutine da_final_write_obs(it,iv) num_obs = 0 if (iv%info(satem)%nlocal > 0) then - do n = 1, iv%info(satem)%nlocal +! do n = 1, iv%info(satem)%nlocal + m1 = iv%info(satem)%plocal(m-1) + 1 + m2 = iv%info(satem)%plocal(m) + do n = m1,m2 if(iv%info(satem)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -302,7 +350,10 @@ subroutine da_final_write_obs(it,iv) num_obs = 0 if (iv%info(ssmt1)%nlocal > 0) then - do n = 1, iv%info(ssmt1)%nlocal +! do n = 1, iv%info(ssmt1)%nlocal + m1 = iv%info(ssmt1)%plocal(m-1) + 1 + m2 = iv%info(ssmt1)%plocal(m) + do n = m1,m2 if(iv%info(ssmt1)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -322,7 +373,10 @@ subroutine da_final_write_obs(it,iv) num_obs = 0 if (iv%info(ssmt2)%nlocal > 0) then - do n = 1, iv%info(ssmt2)%nlocal +! do n = 1, iv%info(ssmt2)%nlocal + m1 = iv%info(ssmt2)%plocal(m-1) + 1 + m2 = iv%info(ssmt2)%plocal(m) + do n = m1,m2 if(iv%info(ssmt2)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -342,7 +396,10 @@ subroutine da_final_write_obs(it,iv) num_obs = 0 if (iv%info(qscat)%nlocal > 0) then - do n = 1, iv%info(qscat)%nlocal +! do n = 1, iv%info(qscat)%nlocal + m1 = iv%info(qscat)%plocal(m-1) + 1 + m2 = iv%info(qscat)%plocal(m) + do n = m1,m2 if(iv%info(qscat)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -363,7 +420,10 @@ subroutine da_final_write_obs(it,iv) num_obs = 0 if (iv%info(profiler)%nlocal > 0) then - do n = 1, iv%info(profiler)%nlocal +! do n = 1, iv%info(profiler)%nlocal + m1 = iv%info(profiler)%plocal(m-1) + 1 + m2 = iv%info(profiler)%plocal(m) + do n = m1,m2 if(iv%info(profiler)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -384,7 +444,10 @@ subroutine da_final_write_obs(it,iv) num_obs = 0 if (iv%info(buoy)%nlocal > 0) then - do n = 1, iv%info(buoy)%nlocal +! do n = 1, iv%info(buoy)%nlocal + m1 = iv%info(buoy)%plocal(m-1) + 1 + m2 = iv%info(buoy)%plocal(m) + do n = m1,m2 if(iv%info(buoy)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -405,7 +468,10 @@ subroutine da_final_write_obs(it,iv) num_obs = 0 if (iv%info(bogus)%nlocal > 0) then - do n = 1, iv%info(bogus)%nlocal +! do n = 1, iv%info(bogus)%nlocal + m1 = iv%info(bogus)%plocal(m-1) + 1 + m2 = iv%info(bogus)%plocal(m) + do n = m1,m2 if(iv%info(bogus)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -425,7 +491,10 @@ subroutine da_final_write_obs(it,iv) num_obs = 0 if (iv%info(tamdar)%nlocal > 0) then - do n = 1, iv%info(tamdar)%nlocal +! do n = 1, iv%info(tamdar)%nlocal + m1 = iv%info(tamdar)%plocal(m-1) + 1 + m2 = iv%info(tamdar)%plocal(m) + do n = m1,m2 if (iv%info(tamdar)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -444,7 +513,10 @@ subroutine da_final_write_obs(it,iv) ! Now tamdar_sfc num_obs = 0 if (iv%info(tamdar_sfc)%nlocal > 0) then - do n = 1, iv%info(tamdar_sfc)%nlocal +! do n = 1, iv%info(tamdar_sfc)%nlocal + m1 = iv%info(tamdar_sfc)%plocal(m-1) + 1 + m2 = iv%info(tamdar_sfc)%plocal(m) + do n = m1,m2 if(iv%info(tamdar_sfc)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -463,7 +535,10 @@ subroutine da_final_write_obs(it,iv) num_obs = 0 if (iv%info(airsr)%nlocal > 0) then - do n = 1, iv%info(airsr)%nlocal +! do n = 1, iv%info(airsr)%nlocal + m1 = iv%info(airsr)%plocal(m-1) + 1 + m2 = iv%info(airsr)%plocal(m) + do n = m1,m2 if(iv%info(airsr)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -483,7 +558,10 @@ subroutine da_final_write_obs(it,iv) num_obs = 0 if (iv%info(gpsref)%nlocal > 0) then - do n = 1, iv%info(gpsref)%nlocal +! do n = 1, iv%info(gpsref)%nlocal + m1 = iv%info(gpsref)%plocal(m-1) + 1 + m2 = iv%info(gpsref)%plocal(m) + do n = m1,m2 if(iv%info(gpsref)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -503,7 +581,10 @@ subroutine da_final_write_obs(it,iv) num_obs = 0 if (iv%info(rain)%nlocal > 0) then - do n = 1, iv%info(rain)%nlocal +! do n = 1, iv%info(rain)%nlocal + m1 = iv%info(rain)%plocal(m-1) + 1 + m2 = iv%info(rain)%plocal(m) + do n = m1,m2 if(iv%info(rain)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -526,6 +607,7 @@ subroutine da_final_write_obs(it,iv) deallocate (filename) end if +end do !wuyl n1,n2 if (trace_use) call da_trace_exit("da_final_write_obs") end subroutine da_final_write_obs diff --git a/var/da/da_obs_io/da_obs_io.f90 b/var/da/da_obs_io/da_obs_io.f90 index be09cd9310..842151af95 100644 --- a/var/da/da_obs_io/da_obs_io.f90 +++ b/var/da/da_obs_io/da_obs_io.f90 @@ -31,7 +31,7 @@ module da_obs_io wind_sd_airep,wind_sd_sound,wind_sd_metar,wind_sd_ships,wind_sd_qscat,wind_sd_buoy,wind_sd_pilot,wind_stats_sd,& thin_conv, thin_conv_ascii, lsac_nh_step, lsac_nv_step, lsac_nv_start, lsac_print_details, & lsac_use_u, lsac_use_v, lsac_use_t, lsac_use_q, lsac_u_error, lsac_v_error, lsac_t_error, lsac_q_error, & - use_radar_rhv, use_radar_rqv, use_radar_rf, use_radar_rv, multi_inc + use_radar_rhv, use_radar_rqv, use_radar_rf, use_radar_rv use da_define_structures, only : iv_type, multi_level_type, multi_level_type_BUFR, & radar_multi_level_type, y_type, field_type, each_level_type, & diff --git a/var/da/da_obs_io/da_read_iv_for_multi_inc_opt2.inc b/var/da/da_obs_io/da_read_iv_for_multi_inc_opt2.inc index 508088fe0f..7088e05c28 100644 --- a/var/da/da_obs_io/da_read_iv_for_multi_inc_opt2.inc +++ b/var/da/da_obs_io/da_read_iv_for_multi_inc_opt2.inc @@ -23,7 +23,7 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) integer :: nobs_tot, nlev_max, k , iobs integer :: nobs_in, nlev_in - logical :: has_rv, has_rf, has_rhv, has_rqv + logical :: has_rv, has_rf, has_rhv, has_rqv,fexist real, allocatable :: data2d(:,:) real, allocatable :: data3d(:,:,:) @@ -41,6 +41,8 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) if (iv%info(synop)%plocal(iv%time)-iv%info(synop)%plocal(iv%time-1) > 0) then + inquire (file=filename//'.synop', exist=fexist) + if (fexist) then open(unit=unit_in,file=trim(filename)//'.synop',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -64,12 +66,15 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) call da_error(__FILE__,__LINE__, & (/"Unequal obs. found "/)) close (unit_in) + end if !fexist end if ! [2] metar obs: if (iv%info(metar)%plocal(iv%time)-iv%info(metar)%plocal(iv%time-1) > 0) then - + + inquire (file=filename//'.metar', exist=fexist) + if (fexist) then open(unit=unit_in,file=trim(filename)//'.metar',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -93,12 +98,15 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) call da_error(__FILE__,__LINE__, & (/"Unequal obs. found "/)) close (unit_in) + end if end if ! [3] ships obs: if (iv%info(ships)%plocal(iv%time)-iv%info(ships)%plocal(iv%time-1) > 0) then + inquire (file=filename//'.ships', exist=fexist) + if (fexist) then open(unit=unit_in,file=trim(filename)//'.ships',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -122,12 +130,15 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) call da_error(__FILE__,__LINE__, & (/"Unequal obs. found "/)) close (unit_in) + end if end if ! [4] sonde_sfc obs: if (iv%info(sonde_sfc)%plocal(iv%time)-iv%info(sonde_sfc)%plocal(iv%time-1) > 0) then + inquire (file=filename//'.sonde_sfc', exist=fexist) + if (fexist) then open(unit=unit_in,file=trim(filename)//'.sonde_sfc',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -151,12 +162,15 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) call da_error(__FILE__,__LINE__, & (/"Unequal obs. found "/)) close (unit_in) + end if end if ! [5] sound obs: if (iv%info(sound)%plocal(iv%time)-iv%info(sound)%plocal(iv%time-1) > 0) then + inquire (file=filename//'.sound', exist=fexist) + if (fexist) then open(unit=unit_in,file=trim(filename)//'.sound',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -180,12 +194,16 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) call da_error(__FILE__,__LINE__, & (/"Unequal obs. found "/)) close (unit_in) + end if end if ! [6] mtgirs obs: if (iv%info(mtgirs)%plocal(iv%time)-iv%info(mtgirs)%plocal(iv%time-1) > 0) then + inquire (file=filename//'.mtgirs', exist=fexist) + if (fexist) then + open(unit=unit_in,file=trim(filename)//'.mtgirs',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -209,12 +227,16 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) call da_error(__FILE__,__LINE__, & (/"Unequal obs. found "/)) close (unit_in) + end if end if ! [7] tamdar obs: if (iv%info(tamdar)%plocal(iv%time)-iv%info(tamdar)%plocal(iv%time-1) > 0) then + inquire (file=filename//'.tamdar', exist=fexist) + if (fexist) then + open(unit=unit_in,file=trim(filename)//'.tamdar',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -238,12 +260,16 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) call da_error(__FILE__,__LINE__, & (/"Unequal obs. found "/)) close (unit_in) + end if end if ! [8] tamdar_sfc obs: if (iv%info(tamdar_sfc)%plocal(iv%time)-iv%info(tamdar_sfc)%plocal(iv%time-1) > 0) then + inquire (file=filename//'.tamdar_sfc', exist=fexist) + if (fexist) then + open(unit=unit_in,file=trim(filename)//'.tamdar_sfc',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -267,12 +293,15 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) call da_error(__FILE__,__LINE__, & (/"Unequal obs. found "/)) close (unit_in) + end if end if ! [9] buoy obs: if (iv%info(buoy)%plocal(iv%time)-iv%info(buoy)%plocal(iv%time-1) > 0) then - + + inquire (file=filename//'.buoy', exist=fexist) + if (fexist) then open(unit=unit_in,file=trim(filename)//'.buoy',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -296,12 +325,16 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) call da_error(__FILE__,__LINE__, & (/"Unequal obs. found "/)) close (unit_in) + end if end if ! [10] Geo AMV obs: if (iv%info(geoamv)%plocal(iv%time)-iv%info(geoamv)%plocal(iv%time-1) > 0) then + inquire (file=filename//'.geoamv', exist=fexist) + if (fexist) then + open(unit=unit_in,file=trim(filename)//'.geoamv',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -325,12 +358,16 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) call da_error(__FILE__,__LINE__, & (/"Unequal obs. found "/)) close (unit_in) + end if end if ! [11] gpspw obs: if (iv%info(gpspw)%plocal(iv%time)-iv%info(gpspw)%plocal(iv%time-1) > 0) then + inquire (file=filename//'.gpspw', exist=fexist) + if (fexist) then + open(unit=unit_in,file=trim(filename)//'.gpspw',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -354,12 +391,16 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) call da_error(__FILE__,__LINE__, & (/"Unequal obs. found "/)) close (unit_in) + end if end if ! [12] SSM/I obs: if (iv%info(ssmi_rv)%plocal(iv%time)-iv%info(ssmi_rv)%plocal(iv%time-1) > 0) then + inquire (file=filename//'.ssmir', exist=fexist) + if (fexist) then + open(unit=unit_in,file=trim(filename)//'.ssmir',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -383,12 +424,15 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) call da_error(__FILE__,__LINE__, & (/"Unequal obs. found "/)) close (unit_in) + end if end if ! [13] airep obs: if (iv%info(airep)%plocal(iv%time)-iv%info(airep)%plocal(iv%time-1) > 0) then + inquire (file=filename//'.airep', exist=fexist) + if (fexist) then open(unit=unit_in,file=trim(filename)//'.airep',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -412,12 +456,15 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) call da_error(__FILE__,__LINE__, & (/"Unequal obs. found "/)) close (unit_in) + end if end if ! [14] polaramv obs: if (iv%info(polaramv)%plocal(iv%time)-iv%info(polaramv)%plocal(iv%time-1) > 0) then + inquire (file=filename//'.polaramv', exist=fexist) + if (fexist) then open(unit=unit_in,file=trim(filename)//'.polaramv',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -441,12 +488,15 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) call da_error(__FILE__,__LINE__, & (/"Unequal obs. found "/)) close (unit_in) + end if end if ! [15] pilot obs: if (iv%info(pilot)%plocal(iv%time)-iv%info(pilot)%plocal(iv%time-1) > 0) then + inquire (file=filename//'.pilot', exist=fexist) + if (fexist) then open(unit=unit_in,file=trim(filename)//'.pilot',form='formatted',status='old',iostat=ios) if (ios /= 0) Then @@ -471,12 +521,15 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) call da_error(__FILE__,__LINE__, & (/"Unequal obs. found "/)) close (unit_in) + end if end if ! [16] ssmi_tb obs: if (iv%info(ssmi_tb)%plocal(iv%time)-iv%info(ssmi_tb)%plocal(iv%time-1) > 0) then + inquire (file=filename//'.ssmi_tb', exist=fexist) + if (fexist) then open(unit=unit_in,file=trim(filename)//'.ssmi_tb',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -500,12 +553,14 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) call da_error(__FILE__,__LINE__, & (/"Unequal obs. found "/)) close (unit_in) + end if end if ! [17] satem obs: if (iv%info(satem)%plocal(iv%time)-iv%info(satem)%plocal(iv%time-1) > 0) then - + inquire (file=filename//'.satem', exist=fexist) + if (fexist) then open(unit=unit_in,file=trim(filename)//'.satem',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -529,12 +584,15 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) call da_error(__FILE__,__LINE__, & (/"Unequal obs. found "/)) close (unit_in) + end if end if ! [18] ssmt1 obs: if (iv%info(ssmt1)%plocal(iv%time)-iv%info(ssmt1)%plocal(iv%time-1) > 0) then + inquire (file=filename//'.ssmt1', exist=fexist) + if (fexist) then open(unit=unit_in,file=trim(filename)//'.ssmt1',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -558,12 +616,15 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) call da_error(__FILE__,__LINE__, & (/"Unequal obs. found "/)) close (unit_in) + end if end if ! [19] ssmt2 obs: if (iv%info(ssmt2)%plocal(iv%time)-iv%info(ssmt2)%plocal(iv%time-1) > 0) then + inquire (file=filename//'.ssmt2', exist=fexist) + if (fexist) then open(unit=unit_in,file=trim(filename)//'.ssmt2',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -587,12 +648,15 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) call da_error(__FILE__,__LINE__, & (/"Unequal obs. found "/)) close (unit_in) + end if end if ! [20] scatterometer obs: if (iv%info(qscat)%plocal(iv%time)-iv%info(qscat)%plocal(iv%time-1) > 0) then - + + inquire (file=filename//'.qscat', exist=fexist) + if (fexist) then open(unit=unit_in,file=trim(filename)//'.qscat',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -616,12 +680,15 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) call da_error(__FILE__,__LINE__, & (/"Unequal obs. found "/)) close (unit_in) + end if end if ! [21] profiler obs: if (iv%info(profiler)%plocal(iv%time)-iv%info(profiler)%plocal(iv%time-1) > 0) then + inquire (file=filename//'.profiler', exist=fexist) + if (fexist) then open(unit=unit_in,file=trim(filename)//'.profiler',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -645,12 +712,15 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) call da_error(__FILE__,__LINE__, & (/"Unequal obs. found "/)) close (unit_in) + end if end if ! [22] TC bogus obs: if (iv%info(bogus)%plocal(iv%time)-iv%info(bogus)%plocal(iv%time-1) > 0) then + inquire (file=filename//'.bogus', exist=fexist) + if (fexist) then open(unit=unit_in,file=trim(filename)//'.bogus',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -674,12 +744,15 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) call da_error(__FILE__,__LINE__, & (/"Unequal obs. found "/)) close (unit_in) + end if end if ! [23] AIRS retrievals: if (iv%info(airsr)%plocal(iv%time)-iv%info(airsr)%plocal(iv%time-1) > 0) then + inquire (file=filename//'.airsr', exist=fexist) + if (fexist) then open(unit=unit_in,file=trim(filename)//'.airsr',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -703,12 +776,15 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) call da_error(__FILE__,__LINE__, & (/"Unequal obs. found "/)) close (unit_in) + end if end if ! [24] gpsref obs: if (iv%info(gpsref)%plocal(iv%time)-iv%info(gpsref)%plocal(iv%time-1) > 0) then + inquire (file=filename//'.gpsref', exist=fexist) + if (fexist) then open(unit=unit_in,file=trim(filename)//'.gpsref',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -732,6 +808,7 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) call da_error(__FILE__,__LINE__, & (/"Unequal obs. found "/)) close (unit_in) + end if end if @@ -743,6 +820,8 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) if ( nobs_tot > 0 ) then write(unit=filename, fmt='(a,i3.3)') 'radar_innov_t', file_index + inquire (file=filename, exist=fexist) + if (fexist) then open(unit=unit_in,file=trim(filename),form='unformatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -826,6 +905,7 @@ subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) end if close (unit_in) + end if end if ! nobs_tot > 0 999 continue diff --git a/var/da/da_obs_io/da_read_obs_radar.inc b/var/da/da_obs_io/da_read_obs_radar.inc index 51acd5d99d..a4ca5233a5 100644 --- a/var/da/da_obs_io/da_read_obs_radar.inc +++ b/var/da/da_obs_io/da_read_obs_radar.inc @@ -219,7 +219,7 @@ subroutine da_read_obs_radar (iv, filename, grid) endif call da_llxy (platform%info, platform%loc, outside, outside_all) - if( outside_all .and. multi_inc == 0 ) then + if( outside_all ) then if (print_detail_radar) then write(unit=stdout, fmt='(a)') '*** Report is outside of domain:' write(unit=stdout, fmt='(2x,a,2(2x,f7.3),2x,a)') & diff --git a/var/da/da_obs_io/da_scan_obs_radar.inc b/var/da/da_obs_io/da_scan_obs_radar.inc index f665c801ca..5d30072dc8 100644 --- a/var/da/da_obs_io/da_scan_obs_radar.inc +++ b/var/da/da_obs_io/da_scan_obs_radar.inc @@ -194,7 +194,7 @@ subroutine da_scan_obs_radar (iv, filename, grid) endif call da_llxy (platform%info, platform%loc, outside, outside_all) - if( outside_all .and. multi_inc == 0 ) cycle reports + if( outside_all ) cycle reports nlevels = platform%info%levels diff --git a/var/da/da_obs_io/log b/var/da/da_obs_io/log new file mode 100644 index 0000000000..111c030661 --- /dev/null +++ b/var/da/da_obs_io/log @@ -0,0 +1,24 @@ +da_read_iv_for_multi_inc_opt2.inc:760: iobs = iv%info(radar)%obs_global_index(n) +da_read_iv_for_multi_inc_opt2.inc:770: iobs = iv%info(radar)%obs_global_index(n) +da_read_iv_for_multi_inc_opt2.inc:784: iobs = iv%info(radar)%obs_global_index(n) +da_read_iv_for_multi_inc_opt2.inc:798: iobs = iv%info(radar)%obs_global_index(n) +da_read_iv_for_multi_inc_opt2.inc:818: iobs = iv%info(radar)%obs_global_index(n) +da_read_lsac_util.inc:346: iv%info(bogus)%obs_global_index(nlocal) = nlocal +da_read_obs_ascii.inc:788: iv%info(tamdar)%obs_global_index(ilocal(tamdar)) = ntotal(tamdar) +da_read_obs_ascii.inc:1099: iv%info(airep)%obs_global_index(ilocal(airep)) = ntotal(airep) +da_read_obs_ascii.inc:1447: iv%info(obs_index)%obs_global_index(nlocal(obs_index)) = ntotal(obs_index) +da_read_obs_ascii.inc:1472: iv%info(sonde_sfc)%obs_global_index(ilocal(sonde_sfc)) = ntotal(obs_index) +da_read_obs_ascii.inc:1498: iv%info(tamdar_sfc)%obs_global_index(ilocal(tamdar_sfc)) = ntotal(tamdar_sfc) +da_read_obs_bufrgpsro.inc:56: integer :: obs_global_index +da_read_obs_bufrgpsro.inc:331: plink%obs_global_index = ntotal +da_read_obs_bufrgpsro.inc:399: allocate (iv%info(gpsref)%obs_global_index(iv%info(gpsref)%nlocal)) +da_read_obs_bufrgpsro.inc:443: iv%info(gpsref)%obs_global_index(nlocal) = plink%obs_global_index +da_read_obs_bufr.inc:2160: iv%info(obs_index)%obs_global_index(ilocal(obs_index)) = iv%info(obs_index)%ntotal +da_read_obs_bufr.inc:2186: iv%info(sonde_sfc)%obs_global_index(ilocal(sonde_sfc)) =iv%info(sonde_sfc)%ntotal +da_read_obs_radar.inc:285: iv%info(radar)%obs_global_index(ilocal) = ntotal +da_read_obs_rain.inc:247: iv%info(rain)%obs_global_index(ilocal) = ntotal +da_write_iv_for_multi_inc_opt2.inc:764: iobs = iv%info(radar)%obs_global_index(n) +da_write_iv_for_multi_inc_opt2.inc:786: iobs = iv%info(radar)%obs_global_index(n) +da_write_iv_for_multi_inc_opt2.inc:811: iobs = iv%info(radar)%obs_global_index(n) +da_write_iv_for_multi_inc_opt2.inc:836: iobs = iv%info(radar)%obs_global_index(n) +da_write_iv_for_multi_inc_opt2.inc:867: iobs = iv%info(radar)%obs_global_index(n) diff --git a/var/da/da_radiance/da_allocate_rad_iv.inc b/var/da/da_radiance/da_allocate_rad_iv.inc index c4f5b61b81..fc0ab56d05 100644 --- a/var/da/da_radiance/da_allocate_rad_iv.inc +++ b/var/da/da_radiance/da_allocate_rad_iv.inc @@ -78,6 +78,22 @@ subroutine da_allocate_rad_iv (i, nchan, iv) if ( index(iv%instid(i)%rttovid_string, 'amsr2') > 0 ) then allocate (iv%instid(i)%clw(iv%instid(i)%num_rad)) end if + if ( index(iv%instid(i)%rttovid_string, 'gmi') > 0 ) then + allocate (iv%instid(i)%clw(iv%instid(i)%num_rad)) + end if + if ( index(iv%instid(i)%rttovid_string, 'ahi') > 0 ) then + allocate (iv%instid(i)%clw(iv%instid(i)%num_rad)) + end if + if ( index(iv%instid(i)%rttovid_string, 'agri') > 0 ) then + allocate (iv%instid(i)%clw(iv%instid(i)%num_rad)) + end if + + if ( index(iv%instid(i)%rttovid_string, 'ahi') > 0 ) then + allocate (iv%instid(i)%cloudflag(iv%instid(i)%num_rad)) + end if + if ( index(iv%instid(i)%rttovid_string, 'agri') > 0 ) then + allocate (iv%instid(i)%cloudflag(iv%instid(i)%num_rad)) + end if allocate (iv%instid(i)%ps(iv%instid(i)%num_rad)) allocate (iv%instid(i)%tb_xb(nchan,iv%instid(i)%num_rad)) if ( crtm_cloud ) then @@ -86,6 +102,8 @@ subroutine da_allocate_rad_iv (i, nchan, iv) allocate (iv%instid(i)%tb_qc(nchan,iv%instid(i)%num_rad)) allocate (iv%instid(i)%tb_inv(nchan,iv%instid(i)%num_rad)) allocate (iv%instid(i)%tb_error(nchan,iv%instid(i)%num_rad)) + allocate (iv%instid(i)%ca_mean(nchan,iv%instid(i)%num_rad)) + allocate (iv%instid(i)%SDob(iv%instid(i)%num_rad)) !(Okamoto,2017,ahi allsky) allocate (iv%instid(i)%tb_sens(nchan,iv%instid(i)%num_rad)) allocate (iv%instid(i)%tb_imp(nchan,iv%instid(i)%num_rad)) allocate (iv%instid(i)%rad_xb(nchan,iv%instid(i)%num_rad)) @@ -96,6 +114,7 @@ subroutine da_allocate_rad_iv (i, nchan, iv) allocate (iv%instid(i)%scanline(iv%instid(i)%num_rad)) allocate (iv%instid(i)%ifgat(iv%instid(i)%num_rad)) allocate (iv%instid(i)%cloud_flag(nchan,iv%instid(i)%num_rad)) + allocate (iv%instid(i)%tropt(iv%instid(i)%num_rad)) !(Zhuge Zou,2016,cloud check) allocate (iv%instid(i)%rain_flag(iv%instid(i)%num_rad)) allocate (iv%instid(i)%satzen(iv%instid(i)%num_rad)) allocate (iv%instid(i)%satazi(iv%instid(i)%num_rad)) diff --git a/var/da/da_radiance/da_crtm.f90 b/var/da/da_radiance/da_crtm.f90 index e73a1d548d..13d935c11a 100644 --- a/var/da/da_radiance/da_crtm.f90 +++ b/var/da/da_radiance/da_crtm.f90 @@ -37,8 +37,7 @@ module da_crtm use_antcorr, time_slots, use_satcv, use_simulated_rad, simulated_rad_io, & simulated_rad_ngrid, interp_option, use_mspps_emis, use_mspps_ts, calc_weightfunc, & use_clddet_ecmwf,its,ite,jts,jte, & - crtm_coef_path, crtm_irwater_coef, crtm_mwwater_coef, crtm_irland_coef, crtm_visland_coef, & - cloud_cv_options + crtm_coef_path, crtm_irwater_coef, crtm_mwwater_coef, crtm_irland_coef, crtm_visland_coef use da_interpolation, only : da_interp_lin_2d_partial,da_interp_lin_2d_adj_partial, & da_interp_2d_partial use module_dm, only : wrf_dm_sum_real, wrf_dm_sum_reals diff --git a/var/da/da_radiance/da_deallocate_radiance.inc b/var/da/da_radiance/da_deallocate_radiance.inc index 38a7d3c0a7..9bf1c03262 100644 --- a/var/da/da_radiance/da_deallocate_radiance.inc +++ b/var/da/da_radiance/da_deallocate_radiance.inc @@ -101,12 +101,30 @@ if ( index(iv%instid(i)%rttovid_string,'amsr2') > 0 ) then deallocate (iv%instid(i)%clw) end if + if ( index(iv%instid(i)%rttovid_string,'gmi') > 0 ) then + deallocate (iv%instid(i)%clw) + end if + if ( index(iv%instid(i)%rttovid_string,'ahi') > 0 ) then + deallocate (iv%instid(i)%clw) + end if + if ( index(iv%instid(i)%rttovid_string,'agri') > 0 ) then + deallocate (iv%instid(i)%clw) + end if + + if ( index(iv%instid(i)%rttovid_string, 'ahi') > 0 ) then + deallocate (iv%instid(i)%cloudflag) + end if + if ( index(iv%instid(i)%rttovid_string, 'agri') > 0 ) then + deallocate (iv%instid(i)%cloudflag) + end if deallocate (iv%instid(i)%ps) deallocate (iv%instid(i)%tb_xb) if ( crtm_cloud ) then deallocate (iv%instid(i)%tb_xb_clr) end if deallocate (iv%instid(i)%tb_qc) + deallocate (iv%instid(i)%ca_mean) + deallocate (iv%instid(i)%SDob) deallocate (iv%instid(i)%tb_inv) deallocate (iv%instid(i)%tb_error) deallocate (iv%instid(i)%tb_sens) @@ -119,6 +137,7 @@ deallocate (iv%instid(i)%scanline) deallocate (iv%instid(i)%ifgat) deallocate (iv%instid(i)%cloud_flag) + deallocate (iv%instid(i)%tropt) deallocate (iv%instid(i)%rain_flag) deallocate (iv%instid(i)%satzen) deallocate (iv%instid(i)%satazi) diff --git a/var/da/da_radiance/da_get_innov_vector_radiance.inc b/var/da/da_radiance/da_get_innov_vector_radiance.inc index a3ab4688d2..1fca458d04 100644 --- a/var/da/da_radiance/da_get_innov_vector_radiance.inc +++ b/var/da/da_radiance/da_get_innov_vector_radiance.inc @@ -1,4 +1,4 @@ -subroutine da_get_innov_vector_radiance (it, grid, ob, iv) +subroutine da_get_innov_vector_radiance (it,grid, ob, iv) !--------------------------------------------------------------------------- ! PURPOSE: Calculate innovation vector for radiance data. @@ -24,7 +24,6 @@ subroutine da_get_innov_vector_radiance (it, grid, ob, iv) iv%instid(:)%info%n1 = iv%instid(:)%info%plocal(iv%time-1) + 1 iv%instid(:)%info%n2 = iv%instid(:)%info%plocal(iv%time) - !------------------------------------------------------------------------ ! [1.0] calculate components of innovation vector !------------------------------------------------------------------------ @@ -46,17 +45,22 @@ subroutine da_get_innov_vector_radiance (it, grid, ob, iv) else call da_warning(__FILE__,__LINE__,(/"Unknown Radiative Transfer Model"/)) endif - !------------------------------------------------------------------------ ! [2.0] Perform (Variational) bias correction !------------------------------------------------------------------------ if (use_varbc .or. freeze_varbc) then call da_varbc_pred(iv) + !varbc coldstart can not be done here when num_fgat_time>1 if ( num_fgat_time == 1 ) then call da_varbc_coldstart(iv) + call da_varbc_direct(iv) + if (qc_rad) then + call da_qc_rad(it, ob, iv) + end if end if - call da_varbc_direct(iv) + + else if (biascorr) then do inst = 1, iv%num_inst ! loop for sensor write(unit=stdout,fmt='(A,A)') 'Performing bias correction for ', & @@ -64,14 +68,12 @@ subroutine da_get_innov_vector_radiance (it, grid, ob, iv) call da_biascorr(inst,ob,iv) end do ! end loop for sensor end if - - !------------------------------------------------------------------------ - ! [3.0] Perform QC check - !------------------------------------------------------------------------ - if (qc_rad) then - call da_qc_rad(it, ob, iv) - end if - +!wuyl !------------------------------------------------------------------------ +! ! [3.0] Perform QC check +! !------------------------------------------------------------------------ +! if (qc_rad) then +! call da_qc_rad(it, ob, iv) +! end if !------------------------------------------------------------------------ ! [4.0] Compute preconditioning for Variational bias correction !------------------------------------------------------------------------ @@ -88,7 +90,6 @@ subroutine da_get_innov_vector_radiance (it, grid, ob, iv) call da_biasprep(inst,ob,iv) end do end if - if(trace_use) call da_trace_exit("da_get_innov_vector_radiance") end subroutine da_get_innov_vector_radiance diff --git a/var/da/da_radiance/da_initialize_rad_iv.inc b/var/da/da_radiance/da_initialize_rad_iv.inc index c2414a0dc6..3aa1d4f543 100644 --- a/var/da/da_radiance/da_initialize_rad_iv.inc +++ b/var/da/da_radiance/da_initialize_rad_iv.inc @@ -72,6 +72,10 @@ subroutine da_initialize_rad_iv (i, n, iv, p) if ( index(iv%instid(i)%rttovid_string, 'amsr2') > 0 ) then iv%instid(i)%clw(n) = p%clw end if + if ( index(iv%instid(i)%rttovid_string, 'ahi') > 0 ) then + iv%instid(i)%cloudflag(n) = p%cloudflag + end if + iv%instid(i)%cloud_flag(:,n) = qc_good ! no cloud iv%instid(i)%ps(n) = 0.0 iv%instid(i)%tb_xb(:,n) = 0.0 if ( crtm_cloud ) then diff --git a/var/da/da_radiance/da_qc_ahi.inc b/var/da/da_radiance/da_qc_ahi.inc new file mode 100644 index 0000000000..9dbcedcb73 --- /dev/null +++ b/var/da/da_radiance/da_qc_ahi.inc @@ -0,0 +1,233 @@ +subroutine da_qc_ahi (it, i, nchan, ob, iv) + + !--------------------------------------------------------------------------- + ! Purpose: perform quality control for ahi data. + ! To be developed: built in cloud_detection method + !--------------------------------------------------------------------------- + + implicit none + + integer, intent(in) :: it ! outer loop count + integer, intent(in) :: i ! sensor index. + integer, intent(in) :: nchan ! number of channel + type (y_type), intent(in) :: ob ! Observation structure. + type (iv_type), intent(inout) :: iv ! O-B structure. + + ! local variables + logical :: lmix, cloud_detection + integer :: n,k,isflg,ios,fgat_rad_unit + integer :: ngood(nchan),nrej(nchan),nrej_omb_abs(nchan), & + nrej_omb_std(nchan),nrej_eccloud(nchan), & + nrej_clw(nchan),num_proc_domain, & + nrej_mixsurface,nrej_land + + real :: inv_grosscheck + + character(len=30) :: filename + real :: c37_mean + + if (trace_use) call da_trace_entry("da_qc_ahi") + + ngood(:) = 0 + nrej(:) = 0 + nrej_omb_abs(:) = 0 + nrej_omb_std(:) = 0 + nrej_eccloud(:) = 0 + nrej_clw(:) = 0 + nrej_mixsurface = 0 + nrej_land = 0 + num_proc_domain = 0 + + + do n= iv%instid(i)%info%n1,iv%instid(i)%info%n2 + if (iv%instid(i)%info%proc_domain(1,n)) & + num_proc_domain = num_proc_domain + 1 + + if ( crtm_cloud ) then + ! calculate c37_mean + c37_mean = 1.0-(ob%instid(i)%tb(11,n)-ob%instid(i)%tb(12,n)+ & + iv%instid(i)%tb_xb(11,n)-iv%instid(i)%tb_xb(12,n))/ & + (2.0*(iv%instid(i)%tb_xb_clr(11,n)-iv%instid(i)%tb_xb_clr(12,n))) + end if + + ! 0.0 initialise QC by flags assuming good obs + !----------------------------------------------------------------- + iv%instid(i)%tb_qc(:,n) = qc_good + + ! 1.0 reject all channels over mixture surface type + !------------------------------------------------------ + isflg = iv%instid(i)%isflg(n) + lmix = (isflg==4) .or. (isflg==5) .or. (isflg==6) .or. (isflg==7) + if (lmix) then + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_mixsurface = nrej_mixsurface + 1 + end if + + if ( isflg > 0 ) then + do k = 1, nchan + if ( k /= 2 .and. k /= 3 .and. k /= 4 ) then + if (only_sea_rad) then + iv%instid(i)%tb_qc(k,n) = qc_bad + nrej_land = nrej_land + 1 + end if + end if + end do + end if + + ! 3.0 check iuse + !----------------------------------------------------------------- + do k = 1, nchan + if (satinfo(i)%iuse(k) .eq. -1) & + iv%instid(i)%tb_qc(k,n) = qc_bad + end do + + ! 4.0 check cloud + !----------------------------------------------------------------- + if (.not. crtm_cloud ) then + + do k = 1, nchan + + if (iv%instid(i)%clwp(n) >= 0.2) then + iv%instid(i)%tb_qc(k,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_clw(k) = nrej_clw(k) + 1 + end if + + cloud_detection=.false. + if (cloud_detection) then + if (iv%instid(i)%landsea_mask(n) == 0 ) then + if (iv%instid(i)%tb_xb(3,n)-ob%instid(i)%tb(3,n)>3.5) then + iv%instid(i)%tb_qc(k,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_eccloud(k) = nrej_eccloud(k) + 1 + end if + else + if (iv%instid(i)%tb_xb(3,n)-ob%instid(i)%tb(3,n)>2.5) then + iv%instid(i)%tb_qc(k,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_eccloud(k) = nrej_eccloud(k) + 1 + end if + end if + else + if (iv%instid(i)%cloudflag(n) < 3) then ! only use abs clear pixel + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_eccloud(k) = nrej_eccloud(k) + 1 + end if + end if + + end do + end if + + ! assigning obs errors + if (.not. crtm_cloud ) then + do k = 1, nchan + if (use_error_factor_rad) then + iv%instid(i)%tb_error(k,n) = & + satinfo(i)%error_std(k)*satinfo(i)%error_factor(k) + else + iv%instid(i)%tb_error(k,n) = satinfo(i)%error_std(k) + end if + end do ! nchan + + else !crtm_cloud + ! symmetric error model, Geer and Bauer (2011) + do k = 1, nchan + if (c37_mean.lt.0.05) then + iv%instid(i)%tb_error(k,n)= satinfo(i)%error_std(k) + else if (c37_mean.ge.0.05.and.c37_mean.lt.0.5) then + iv%instid(i)%tb_error(k,n)= satinfo(i)%error_std(k)+ & + (c37_mean-0.05)*(satinfo(i)%error_cld(k)-satinfo(i)%error_std(k))/(0.5-0.05) + else + iv%instid(i)%tb_error(k,n)= satinfo(i)%error_cld(k) + end if + end do ! nchan + + end if + + ! 5.0 check innovation + !----------------------------------------------------------------- + if (.not. crtm_cloud ) then + ! absolute departure check + do k = 1, nchan + inv_grosscheck = 15.0 + if (use_satcv(2)) inv_grosscheck = 100.0 + if (abs(iv%instid(i)%tb_inv(k,n)) > inv_grosscheck) then + iv%instid(i)%tb_qc(k,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_omb_abs(k) = nrej_omb_abs(k) + 1 + end if + end do ! nchan + end if + + do k = 1, nchan + ! relative departure check + if (abs(iv%instid(i)%tb_inv(k,n)) > 3.0*iv%instid(i)%tb_error(k,n)) then + iv%instid(i)%tb_qc(k,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_omb_std(k) = nrej_omb_std(k) + 1 + end if + + + ! final QC decsion + if (iv%instid(i)%tb_qc(k,n) == qc_bad) then + iv%instid(i)%tb_error(k,n) = 500.0 + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej(k) = nrej(k) + 1 + else + if (iv%instid(i)%info%proc_domain(1,n)) & + ngood(k) = ngood(k) + 1 + end if + end do ! nchan + + end do ! end loop pixel + + ! Do inter-processor communication to gather statistics. + call da_proc_sum_int (num_proc_domain) + call da_proc_sum_int (nrej_mixsurface) + call da_proc_sum_int (nrej_land) + call da_proc_sum_ints (nrej_eccloud) + call da_proc_sum_ints (nrej_omb_abs) + call da_proc_sum_ints (nrej_omb_std) + call da_proc_sum_ints (nrej_clw) + call da_proc_sum_ints (nrej) + call da_proc_sum_ints (ngood) + + if (rootproc) then + if (num_fgat_time > 1) then + write(filename,'(i2.2,a,i2.2)') it,'_qcstat_'//trim(iv%instid(i)%rttovid_string)//'_',iv%time + else + write(filename,'(i2.2,a)') it,'_qcstat_'//trim(iv%instid(i)%rttovid_string) + end if + + call da_get_unit(fgat_rad_unit) + open(fgat_rad_unit,file=trim(filename),form='formatted',iostat=ios) + if (ios /= 0) then + write(unit=message(1),fmt='(A,A)') 'error opening the output file ', filename + call da_error(__FILE__,__LINE__,message(1:1)) + end if + + write(fgat_rad_unit, fmt='(/a/)') ' Quality Control Statistics for '//iv%instid(i)%rttovid_string + if(num_proc_domain > 0) write(fgat_rad_unit,'(a20,i7)') ' num_proc_domain = ', num_proc_domain + write(fgat_rad_unit,'(a20,i7)') ' nrej_mixsurface = ', nrej_mixsurface + write(fgat_rad_unit,'(a20,i7)') ' nrej_land = ', nrej_land + write(fgat_rad_unit,'(a20)') ' nrej_eccloud(:) = ' + write(fgat_rad_unit,'(10i7)') nrej_eccloud(:) + write(fgat_rad_unit,'(a20)') ' nrej_clw(:) = ' + write(fgat_rad_unit,'(10i7)') nrej_clw(:) + write(fgat_rad_unit,'(a20)') ' nrej_omb_abs(:) = ' + write(fgat_rad_unit,'(10i7)') nrej_omb_abs(:) + write(fgat_rad_unit,'(a20)') ' nrej_omb_std(:) = ' + write(fgat_rad_unit,'(10i7)') nrej_omb_std(:) + write(fgat_rad_unit,'(a20)') ' nrej(:) = ' + write(fgat_rad_unit,'(10i7)') nrej(:) + write(fgat_rad_unit,'(a20)') ' ngood(:) = ' + write(fgat_rad_unit,'(10i7)') ngood(:) + + close(fgat_rad_unit) + call da_free_unit(fgat_rad_unit) + end if + if (trace_use) call da_trace_exit("da_qc_ahi") + +end subroutine da_qc_ahi diff --git a/var/da/da_radiance/da_qc_ahi.inc.bak b/var/da/da_radiance/da_qc_ahi.inc.bak new file mode 100644 index 0000000000..9dbcedcb73 --- /dev/null +++ b/var/da/da_radiance/da_qc_ahi.inc.bak @@ -0,0 +1,233 @@ +subroutine da_qc_ahi (it, i, nchan, ob, iv) + + !--------------------------------------------------------------------------- + ! Purpose: perform quality control for ahi data. + ! To be developed: built in cloud_detection method + !--------------------------------------------------------------------------- + + implicit none + + integer, intent(in) :: it ! outer loop count + integer, intent(in) :: i ! sensor index. + integer, intent(in) :: nchan ! number of channel + type (y_type), intent(in) :: ob ! Observation structure. + type (iv_type), intent(inout) :: iv ! O-B structure. + + ! local variables + logical :: lmix, cloud_detection + integer :: n,k,isflg,ios,fgat_rad_unit + integer :: ngood(nchan),nrej(nchan),nrej_omb_abs(nchan), & + nrej_omb_std(nchan),nrej_eccloud(nchan), & + nrej_clw(nchan),num_proc_domain, & + nrej_mixsurface,nrej_land + + real :: inv_grosscheck + + character(len=30) :: filename + real :: c37_mean + + if (trace_use) call da_trace_entry("da_qc_ahi") + + ngood(:) = 0 + nrej(:) = 0 + nrej_omb_abs(:) = 0 + nrej_omb_std(:) = 0 + nrej_eccloud(:) = 0 + nrej_clw(:) = 0 + nrej_mixsurface = 0 + nrej_land = 0 + num_proc_domain = 0 + + + do n= iv%instid(i)%info%n1,iv%instid(i)%info%n2 + if (iv%instid(i)%info%proc_domain(1,n)) & + num_proc_domain = num_proc_domain + 1 + + if ( crtm_cloud ) then + ! calculate c37_mean + c37_mean = 1.0-(ob%instid(i)%tb(11,n)-ob%instid(i)%tb(12,n)+ & + iv%instid(i)%tb_xb(11,n)-iv%instid(i)%tb_xb(12,n))/ & + (2.0*(iv%instid(i)%tb_xb_clr(11,n)-iv%instid(i)%tb_xb_clr(12,n))) + end if + + ! 0.0 initialise QC by flags assuming good obs + !----------------------------------------------------------------- + iv%instid(i)%tb_qc(:,n) = qc_good + + ! 1.0 reject all channels over mixture surface type + !------------------------------------------------------ + isflg = iv%instid(i)%isflg(n) + lmix = (isflg==4) .or. (isflg==5) .or. (isflg==6) .or. (isflg==7) + if (lmix) then + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_mixsurface = nrej_mixsurface + 1 + end if + + if ( isflg > 0 ) then + do k = 1, nchan + if ( k /= 2 .and. k /= 3 .and. k /= 4 ) then + if (only_sea_rad) then + iv%instid(i)%tb_qc(k,n) = qc_bad + nrej_land = nrej_land + 1 + end if + end if + end do + end if + + ! 3.0 check iuse + !----------------------------------------------------------------- + do k = 1, nchan + if (satinfo(i)%iuse(k) .eq. -1) & + iv%instid(i)%tb_qc(k,n) = qc_bad + end do + + ! 4.0 check cloud + !----------------------------------------------------------------- + if (.not. crtm_cloud ) then + + do k = 1, nchan + + if (iv%instid(i)%clwp(n) >= 0.2) then + iv%instid(i)%tb_qc(k,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_clw(k) = nrej_clw(k) + 1 + end if + + cloud_detection=.false. + if (cloud_detection) then + if (iv%instid(i)%landsea_mask(n) == 0 ) then + if (iv%instid(i)%tb_xb(3,n)-ob%instid(i)%tb(3,n)>3.5) then + iv%instid(i)%tb_qc(k,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_eccloud(k) = nrej_eccloud(k) + 1 + end if + else + if (iv%instid(i)%tb_xb(3,n)-ob%instid(i)%tb(3,n)>2.5) then + iv%instid(i)%tb_qc(k,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_eccloud(k) = nrej_eccloud(k) + 1 + end if + end if + else + if (iv%instid(i)%cloudflag(n) < 3) then ! only use abs clear pixel + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_eccloud(k) = nrej_eccloud(k) + 1 + end if + end if + + end do + end if + + ! assigning obs errors + if (.not. crtm_cloud ) then + do k = 1, nchan + if (use_error_factor_rad) then + iv%instid(i)%tb_error(k,n) = & + satinfo(i)%error_std(k)*satinfo(i)%error_factor(k) + else + iv%instid(i)%tb_error(k,n) = satinfo(i)%error_std(k) + end if + end do ! nchan + + else !crtm_cloud + ! symmetric error model, Geer and Bauer (2011) + do k = 1, nchan + if (c37_mean.lt.0.05) then + iv%instid(i)%tb_error(k,n)= satinfo(i)%error_std(k) + else if (c37_mean.ge.0.05.and.c37_mean.lt.0.5) then + iv%instid(i)%tb_error(k,n)= satinfo(i)%error_std(k)+ & + (c37_mean-0.05)*(satinfo(i)%error_cld(k)-satinfo(i)%error_std(k))/(0.5-0.05) + else + iv%instid(i)%tb_error(k,n)= satinfo(i)%error_cld(k) + end if + end do ! nchan + + end if + + ! 5.0 check innovation + !----------------------------------------------------------------- + if (.not. crtm_cloud ) then + ! absolute departure check + do k = 1, nchan + inv_grosscheck = 15.0 + if (use_satcv(2)) inv_grosscheck = 100.0 + if (abs(iv%instid(i)%tb_inv(k,n)) > inv_grosscheck) then + iv%instid(i)%tb_qc(k,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_omb_abs(k) = nrej_omb_abs(k) + 1 + end if + end do ! nchan + end if + + do k = 1, nchan + ! relative departure check + if (abs(iv%instid(i)%tb_inv(k,n)) > 3.0*iv%instid(i)%tb_error(k,n)) then + iv%instid(i)%tb_qc(k,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_omb_std(k) = nrej_omb_std(k) + 1 + end if + + + ! final QC decsion + if (iv%instid(i)%tb_qc(k,n) == qc_bad) then + iv%instid(i)%tb_error(k,n) = 500.0 + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej(k) = nrej(k) + 1 + else + if (iv%instid(i)%info%proc_domain(1,n)) & + ngood(k) = ngood(k) + 1 + end if + end do ! nchan + + end do ! end loop pixel + + ! Do inter-processor communication to gather statistics. + call da_proc_sum_int (num_proc_domain) + call da_proc_sum_int (nrej_mixsurface) + call da_proc_sum_int (nrej_land) + call da_proc_sum_ints (nrej_eccloud) + call da_proc_sum_ints (nrej_omb_abs) + call da_proc_sum_ints (nrej_omb_std) + call da_proc_sum_ints (nrej_clw) + call da_proc_sum_ints (nrej) + call da_proc_sum_ints (ngood) + + if (rootproc) then + if (num_fgat_time > 1) then + write(filename,'(i2.2,a,i2.2)') it,'_qcstat_'//trim(iv%instid(i)%rttovid_string)//'_',iv%time + else + write(filename,'(i2.2,a)') it,'_qcstat_'//trim(iv%instid(i)%rttovid_string) + end if + + call da_get_unit(fgat_rad_unit) + open(fgat_rad_unit,file=trim(filename),form='formatted',iostat=ios) + if (ios /= 0) then + write(unit=message(1),fmt='(A,A)') 'error opening the output file ', filename + call da_error(__FILE__,__LINE__,message(1:1)) + end if + + write(fgat_rad_unit, fmt='(/a/)') ' Quality Control Statistics for '//iv%instid(i)%rttovid_string + if(num_proc_domain > 0) write(fgat_rad_unit,'(a20,i7)') ' num_proc_domain = ', num_proc_domain + write(fgat_rad_unit,'(a20,i7)') ' nrej_mixsurface = ', nrej_mixsurface + write(fgat_rad_unit,'(a20,i7)') ' nrej_land = ', nrej_land + write(fgat_rad_unit,'(a20)') ' nrej_eccloud(:) = ' + write(fgat_rad_unit,'(10i7)') nrej_eccloud(:) + write(fgat_rad_unit,'(a20)') ' nrej_clw(:) = ' + write(fgat_rad_unit,'(10i7)') nrej_clw(:) + write(fgat_rad_unit,'(a20)') ' nrej_omb_abs(:) = ' + write(fgat_rad_unit,'(10i7)') nrej_omb_abs(:) + write(fgat_rad_unit,'(a20)') ' nrej_omb_std(:) = ' + write(fgat_rad_unit,'(10i7)') nrej_omb_std(:) + write(fgat_rad_unit,'(a20)') ' nrej(:) = ' + write(fgat_rad_unit,'(10i7)') nrej(:) + write(fgat_rad_unit,'(a20)') ' ngood(:) = ' + write(fgat_rad_unit,'(10i7)') ngood(:) + + close(fgat_rad_unit) + call da_free_unit(fgat_rad_unit) + end if + if (trace_use) call da_trace_exit("da_qc_ahi") + +end subroutine da_qc_ahi diff --git a/var/da/da_radiance/da_qc_ahi_zou.inc b/var/da/da_radiance/da_qc_ahi_zou.inc new file mode 100644 index 0000000000..45fe7f5634 --- /dev/null +++ b/var/da/da_radiance/da_qc_ahi_zou.inc @@ -0,0 +1,617 @@ +subroutine da_qc_ahi (it, i, nchan, ob, iv) + + !--------------------------------------------------------------------------- + ! Purpose: perform quality control for ahi data. + ! To be developed: built in cloud_detection method + !--------------------------------------------------------------------------- + + implicit none + + integer, intent(in) :: it ! outer loop count + integer, intent(in) :: i ! sensor index. + integer, intent(in) :: nchan ! number of channel + type (y_type), intent(in) :: ob ! Observation structure. + type (iv_type), intent(inout) :: iv ! O-B structure. + + ! local variables + logical :: lmix, cloud_detection + integer :: n,k,isflg,ios,fgat_rad_unit + integer :: ngood(nchan),nrej(nchan),nrej_omb_abs(nchan), & + nrej_omb_std(nchan),nrej_eccloud(nchan), & + nrej_clw(nchan),num_proc_domain, & + nrej_mixsurface,nrej_land + +! additional variables using by Zhuge and Zou(2017) + integer :: nrej_etrop(nchan), nrej_pfmft(nchan),nrej_nfmft(nchan) + integer :: nrej_emiss4(nchan),nrej_ulst(nchan), nrej_emiss(nchan) + integer :: nrej_notc(nchan) +! ------- + real :: inv_grosscheck + + character(len=30) :: filename + real :: c37_mean +! additional variables using by Zhuge and Zou(2017) + real :: etrop, pfmft, nfmft, emiss4, ulst, e_emiss, notc + real :: rad_O14, rad_M14, rad_tropt + real :: rad_o_ch7, rad_b_ch7, rad_o_ch14, rad_b_ch14 + real :: Relaz, Glintzen, tb_temp1 + real :: wave_num(10) + real :: a1(10), a2(10) + real, parameter :: PI = 3.1415926535897 + real, parameter :: DTOR = PI/180. + real(8), parameter :: C1=1.19104276e-5 ! mWm-2sr-1(cm-1)-4 + real(8), parameter :: C2=1.43877516 ! 1.43877 K(cm-1)-1 + wave_num(1:10) = (/2575.767,1609.241,1442.079,1361.387,1164.443, & + 1038.108, 961.333, 890.741, 809.242, 753.369/) + a1(1:10) = (/0.4646738, 1.646845, 0.3081354,0.05736947,0.1351275, & + 0.09363042, 0.08965492, 0.1800931, 0.2439072, 0.06235635/) + a2(1:10) = (/0.9993416, 0.9964012, 0.9992591, 0.9998543, 0.9996156, & + 0.9997033, 0.9997001, 0.9993562, 0.9990461, 0.9997371/) + + if (trace_use) call da_trace_entry("da_qc_ahi") + + ngood(:) = 0 + nrej(:) = 0 + nrej_omb_abs(:) = 0 + nrej_omb_std(:) = 0 + nrej_eccloud(:) = 0 + nrej_clw(:) = 0 + nrej_mixsurface = 0 + nrej_land = 0 + num_proc_domain = 0 + + + do n= iv%instid(i)%info%n1,iv%instid(i)%info%n2 + if (iv%instid(i)%info%proc_domain(1,n)) & + num_proc_domain = num_proc_domain + 1 + + if ( crtm_cloud ) then + ! calculate c37_mean + c37_mean = 1.0-(ob%instid(i)%tb(11,n)-ob%instid(i)%tb(12,n)+ & + iv%instid(i)%tb_xb(11,n)-iv%instid(i)%tb_xb(12,n))/ & + (2.0*(iv%instid(i)%tb_xb_clr(11,n)-iv%instid(i)%tb_xb_clr(12,n))) + end if + + ! 0.0 initialise QC by flags assuming good obs + !----------------------------------------------------------------- + iv%instid(i)%tb_qc(:,n) = qc_good + + ! 1.0 reject all channels over mixture surface type + !------------------------------------------------------ + isflg = iv%instid(i)%isflg(n) + lmix = (isflg==4) .or. (isflg==5) .or. (isflg==6) .or. (isflg==7) + if (lmix) then + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_mixsurface = nrej_mixsurface + 1 + end if + + if ( isflg > 0 ) then + do k = 1, nchan +!wuyl if ( k /= 2 .and. k /= 3 .and. k /= 4 ) then + if (only_sea_rad) then + iv%instid(i)%tb_qc(k,n) = qc_bad + nrej_land = nrej_land + 1 + end if +!wuyl end if + end do + end if + + ! 2.0 check iuse + !----------------------------------------------------------------- + do k = 1, nchan + if (satinfo(i)%iuse(k) .eq. -1) & + iv%instid(i)%tb_qc(k,n) = qc_bad + end do + + ! 3.0 check cloud + !----------------------------------------------------------------- + if (.not. crtm_cloud ) then + + do k = 1, nchan + + if (iv%instid(i)%clwp(n) >= 0.2) then + iv%instid(i)%tb_qc(k,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_clw(k) = nrej_clw(k) + 1 + end if + + cloud_detection=.false. + if (cloud_detection) then + if (iv%instid(i)%landsea_mask(n) == 0 ) then + if (iv%instid(i)%tb_xb(3,n)-ob%instid(i)%tb(3,n)>3.5) then + iv%instid(i)%tb_qc(k,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_eccloud(k) = nrej_eccloud(k) + 1 + end if + else + if (iv%instid(i)%tb_xb(3,n)-ob%instid(i)%tb(3,n)>2.5) then + iv%instid(i)%tb_qc(k,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_eccloud(k) = nrej_eccloud(k) + 1 + end if + end if + else + if (iv%instid(i)%cloudflag(n) <= 0) then ! only use abs clear pixel, read clm by Zhuge and Zou(2017) + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_eccloud(k) = nrej_eccloud(k) + 1 + end if + end if + + end do + end if + + ! 4.0 check Zhuge X. and Zou X. JAMC, 2016. [ABI CM test] + !----------------------------------------------------------------- + ! 4.1 Cloud check: step 1 + ! Emissivity at Tropopause Test (ETROP) + ! (Zhuge and Zou, 2016, JAMC) for AGRI Chan12(10.8um) + ! Q: need tropopause temprature + ! select iv%instid(i)%isflg(n) + ! SEA(0),ICE(1),LAND(2),SNOW(3),MSEA(4),MICE(5),MLND(6),MSNO(7) + if ( iv%instid(i)%tb_xb(8,n) /=-999. .and. & + iv%instid(i)%tropt(n) /= -999. ) then + tb_temp1 = ob%instid(i)%tb(5,n) + rad_O14 = C1*wave_num(8)**3/( exp( C2*wave_num(8)/(a1(8)+a2(8)*tb_temp1 ) ) -1 ) + tb_temp1 = iv%instid(i)%tb_xb(5,n) + rad_M14 = C1*wave_num(8)**3/( exp( C2*wave_num(8)/(a1(8)+a2(8)*tb_temp1) ) -1 ) + tb_temp1 = iv%instid(i)%tropt(n) + rad_tropt = C1*wave_num(8)**3/( exp( C2*wave_num(8)/(a1(8)+a2(8)*tb_temp1) ) -1 ) + etrop = (rad_O14-rad_M14)/(rad_tropt-rad_M14) + else + etrop = -999. + end if +! write(*,"(a8,f12.8,a8,i4,2f8.2)") "etrop", etrop, "isflg", & +! isflg, iv%instid(i)%info%lat(1,n),iv%instid(i)%info%lon(1,n) + ! isflag: SEA(0),ICE(1),LAND(2),SNOW(3),MSEA(4),MICE(5),MLND(6),MSNO(7) + if ( isflg==0 .and. etrop > 0.1 ) then ! Ocean + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_etrop(:) = nrej_etrop(:) + 1 + end if + if ( isflg==2 .and. etrop > 0.3 ) then ! land + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_etrop(:) = nrej_etrop(:) + 1 + end if + if ( isflg==3 .and. etrop > 0.4 ) then ! snow + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_etrop(:) = nrej_etrop(:) + 1 + end if + if ( isflg==1 .and. etrop > 0.4 ) then ! ice equa snow + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_etrop(:) = nrej_etrop(:) + 1 + end if + ! 4.2 Cloud check: step 2 + ! Positive Fourteen Minus Fifteen Test + ! (Zhuge and Zou, 2016, JAMC) for AGRI Chan12(10.8um) and Chan13(12.0um) + ! e_pfmft = 0.8(Ocean), 2.5(land), 1.0(snow) + ! isflag: sea(1), ice(2), land(3), snow(4), msea(5), mice(6), mland(7), msnow(8) + if ( (iv%instid(i)%tb_inv(8,n)+iv%instid(i)%tb_xb(8,n)) >270. .and. & + iv%instid(i)%tb_xb(8,n) >270.) then + if (ob%instid(i)%tb(8,n) /= -999. .and. ob%instid(i)%tb(9,n) /= -999.) then +! using ob with VarBC +! pfmft = (iv%instid(i)%tb_inv(5,n)+iv%instid(i)%tb_xb(5,n) - & +! iv%instid(i)%tb_inv(6,n)+iv%instid(i)%tb_xb(6,n)) - & +! (iv%instid(i)%tb_xb(5,n)-iv%instid(i)%tb_xb(6,n))* & +! (iv%instid(i)%tb_inv(5,n)+iv%instid(i)%tb_xb(5,n)-260.)/ & +! (iv%instid(i)%tb_xb(5,n)-260.) +! using ob without VarBC + pfmft = (ob%instid(i)%tb(8,n)-ob%instid(i)%tb(9,n)) - & + (iv%instid(i)%tb_xb(8,n)-iv%instid(i)%tb_xb(9,n))* & + (ob%instid(i)%tb(8,n)-260.)/ & + (iv%instid(i)%tb_xb(8,n)-260.) + else + pfmft = -999.0 + end if +! write(*,"(a8,f12.8,a8,i4,3f8.2)") "pfmft", pfmft, "isflg", & +! isflg, iv%instid(i)%info%lat(1,n),iv%instid(i)%info%lon(1,n),iv%instid(i)%tb_xb(5,n) + ! SEA(0),ICE(1),LAND(2),SNOW(3),MSEA(4),MICE(5),MLND(6),MSNO(7) + if ( isflg==0 .and. pfmft > 0.8 ) then ! Ocean + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_pfmft(:) = nrej_pfmft(:) + 1 + end if + if ( isflg==2 .and. pfmft > 2.5 ) then ! land + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_pfmft(:) = nrej_pfmft(:) + 1 + end if + if ( isflg==3 .and. pfmft > 1.0 ) then ! snow + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_pfmft(:) = nrej_pfmft(:) + 1 + end if + if ( isflg==1 .and. pfmft > 1.0 ) then ! ice equa snow + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_pfmft(:) = nrej_pfmft(:) + 1 + end if + end if + + if ( (iv%instid(i)%tb_inv(8,n)+iv%instid(i)%tb_xb(8,n)) < 270. .and. & + iv%instid(i)%tb_xb(8,n) < 270.) then + if (ob%instid(i)%tb(8,n) /= 0. .and. ob%instid(i)%tb(9,n) /= 0.) then +! ------------------------------- +! using ob with VarBC +! pfmft = (iv%instid(i)%tb_inv(5,n)+iv%instid(i)%tb_xb(5,n) - & +! (iv%instid(i)%tb_inv(6,n)+iv%instid(i)%tb_xb(6,n)) ) +! using ob without VarBC + pfmft = ( ob%instid(i)%tb(8,n) - & + ob%instid(i)%tb(9,n) ) +! ------------------------------- + else + pfmft = -999. + end if +! write(*,"(a8,f12.8,a8,i4,2f8.2)") "pfmft", pfmft, "isflg", & +! isflg, iv%instid(i)%info%lat(1,n),iv%instid(i)%info%lon(1,n),iv%instid(i)%tb_xb(5,n) + ! SEA(0),ICE(1),LAND(2),SNOW(3),MSEA(4),MICE(5),MLND(6),MSNO(7) + if ( isflg==0 .and. pfmft > 0.8 ) then ! Ocean + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_pfmft(:) = nrej_pfmft(:) + 1 + end if + if ( isflg==2 .and. pfmft > 2.5 ) then ! land + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_pfmft(:) = nrej_pfmft(:) + 1 + end if + if ( isflg==3 .and. pfmft > 1.0 ) then ! snow + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_pfmft(:) = nrej_pfmft(:) + 1 + end if + if ( isflg==1 .and. pfmft > 1.0 ) then ! ice equa snow + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_pfmft(:) = nrej_pfmft(:) + 1 + end if + end if + + ! 4.3 Negative Fourteen Minus Fifteen Test + ! (Zhuge and Zou, 2016, JAMC) for AGRI Chan12(10.8um) and Chan13(12.0um) + ! e_nfmft = 1.0(Ocean), 2.0(land), 5.0(snow) + ! isflag: SEA(0),ICE(1),LAND(2),SNOW(3),MSEA(4),MICE(5),MLND(6),MSNO(7) + if (ob%instid(i)%tb(8,n) /= -999. .and. ob%instid(i)%tb(9,n) /= -999.) then + nfmft=iv%instid(i)%tb_inv(9,n)-iv%instid(i)%tb_inv(8,n) + else + nfmft=-999.0 + end if + ! write(*,"(a8,f12.8,a8,i4,2f8.2)") "nfmft", nfmft, "isflg", & + ! isflg, iv%instid(i)%info%lat(1,n),iv%instid(i)%info%lon(1,n) + + if ( isflg==0 .and. nfmft > 1.0 ) then ! Ocean + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_nfmft(:) = nrej_nfmft(:) + 1 + end if + if ( isflg==2 .and. nfmft > 2.0 ) then ! land + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_nfmft(:) = nrej_nfmft(:) + 1 + end if + if ( isflg==3 .and. nfmft > 5.0 ) then ! snow + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_nfmft(:) = nrej_nfmft(:) + 1 + end if + if ( isflg==1 .and. nfmft > 5.0 ) then ! ice equa snow + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_nfmft(:) = nrej_nfmft(:) + 1 + end if + + ! 4.4 4um Emissivity Test + ! (Zhuge and Zou, 2016, JAMC) for AGRI Chan8(3.725um) and Chan12(10.8um) + ! e_emiss4 = 0.1(Ocean), 0.2(land), 0.3(snow) for daytime, 2.86(Ocean) for dark + ! isflag: SEA(0),ICE(1),LAND(2),SNOW(3),MSEA(4),MICE(5),MLND(6),MSNO(7) + ! glinting + if (ob%instid(i)%tb(1,n) /= -999. .and. ob%instid(i)%tb(8,n) /= -999.) then +! using ob with VarBC +! rad_o_ch8 = TB2R(waveNum(1),iv%instid(i)%tb_inv(1,n)+iv%instid(i)%tb_xb(1,n)) +! rad_b_ch8 = TB2R(waveNum(1),iv%instid(i)%tb_xb(1,n)) +! rad_o_ch12 = TB2R(waveNum(1),iv%instid(i)%tb_inv(5,n)+iv%instid(i)%tb_xb(5,n)) +! rad_b_ch12 = TB2R(waveNum(1),iv%instid(i)%tb_xb(5,n)) +! using ob without VarBC +! rad_o_ch8 = C1*WaveNum(1)**3/( exp(C2*WaveNum(1)/ob%instid(i)%tb(1,n) ) -1 ) +! rad_b_ch8 = C1*WaveNum(1)**3/( exp(C2*WaveNum(1)/iv%instid(i)%tb_xb(1,n) ) -1 ) +! rad_o_ch12 = C1*WaveNum(1)**3/( exp(C2*WaveNum(1)/ob%instid(i)%tb(5,n) ) -1 ) +! rad_b_ch12 = C1*WaveNum(1)**3/( exp(C2*WaveNum(1)/iv%instid(i)%tb_xb(5,n) ) -1 ) +! search by lookup table + + tb_temp1 = ob%instid(i)%tb(1,n) + rad_o_ch7 = C1*wave_num(1)**3/( exp( C2*wave_num(1)/(a1(1)+a2(1)*tb_temp1 ) ) -1 ) + tb_temp1 = iv%instid(i)%tb_xb(1,n) + rad_b_ch7 = C1*wave_num(1)**3/( exp( C2*wave_num(1)/(a1(1)+a2(1)*tb_temp1 ) ) -1 ) + tb_temp1 = ob%instid(i)%tb(8,n) + rad_o_ch14 = C1*wave_num(1)**3/( exp( C2*wave_num(1)/(a1(1)+a2(1)*tb_temp1 ) ) -1 ) + tb_temp1 = iv%instid(i)%tb_xb(8,n) + rad_b_ch14 = C1*wave_num(1)**3/( exp( C2*wave_num(1)/(a1(1)+a2(1)*tb_temp1 ) ) -1 ) +! --------------------------------------- + emiss4 = (rad_o_ch7/rad_o_ch14 - rad_b_ch7/rad_b_ch14)/ & + rad_b_ch7/rad_b_ch14 + else + emiss4 = -999.0 + end if +! write(*,"(a8,f12.8,a8,i4,2f8.2)") "emiss4", emiss4, "isflg", & +! isflg, iv%instid(i)%info%lat(1,n),iv%instid(i)%info%lon(1,n) + if ( isflg==0 .and. emiss4 > 0.1 ) then ! Ocean + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_emiss4(:) = nrej_emiss4(:) + 1 + end if + if ( isflg==2 .and. emiss4 > 0.2 ) then ! land + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_emiss4(:) = nrej_emiss4(:) + 1 + end if + if ( isflg==3 .and. emiss4 > 0.3 ) then ! snow + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_emiss4(:) = nrej_emiss4(:) + 1 + end if + if ( isflg==1 .and. emiss4 > 0.3 ) then ! ice equa snow + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_emiss4(:) = nrej_emiss4(:) + 1 + end if + + ! Modify EMISS for sun glint area may be not work, because we are at north land + ! - compute relative azimuth + Relaz = RELATIVE_AZIMUTH(iv%instid(i)%solazi(n),iv%instid(i)%satazi(n)) + ! - compute glint angle + Glintzen = GLINT_ANGLE(iv%instid(i)%solzen(n),iv%instid(i)%satzen(n),Relaz ) + if ( Glintzen < 40.0 .and. isflg==0 .and. iv%instid(i)%tb_inv(1,n) < -2.86 ) then + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_emiss4(:) = nrej_emiss4(:) + 1 + end if + + ! 4.5 Uniform low staratus Test + ! (Zhuge and Zou, 2016, JAMC) for AGRI Chan8(3.725um) and Chan12(10.8um) + ! e_ulst = 0.05(Ocean), 0.1(land), 0.12(snow) for dark, no day time test + ! isflag: SEA(0),ICE(1),LAND(2),SNOW(3),MSEA(4),MICE(5),MLND(6),MSNO(7) + if (ob%instid(i)%tb(1,n) /= -999. .and. ob%instid(i)%tb(5,n) /= -999.) then + ulst = rad_b_ch7/rad_b_ch14 - rad_o_ch7/rad_o_ch14 + else + ulst = -999. + end if +! write(*,"(a8,f12.8,a8,i4,2f8.2)") "ulst", ulst, "isflg", & +! isflg, iv%instid(i)%info%lat(1,n),iv%instid(i)%info%lon(1,n) + if ( iv%instid(i)%solazi(n) >= 85.0 ) then ! night Time + if ( isflg==0 .and. ulst > 0.05 ) then ! Ocean + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_ulst(:) = nrej_ulst(:) + 1 + end if + if ( isflg==2 .and. ulst > 0.1 ) then ! land + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_ulst(:) = nrej_ulst(:) + 1 + end if + if ( isflg==3 .and. ulst > 0.12 ) then ! snow + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_ulst(:) = nrej_ulst(:) + 1 + end if + if ( isflg==1 .and. ulst > 0.12 ) then ! ice equa snow + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_ulst(:) = nrej_ulst(:) + 1 + end if + end if + + ! 4.6 N-OTC Test + ! (Zhuge and Zou, 2016, JAMC) for AGRI Chan8(3.725um) + ! e_ulst = 0.26-3*1.04(Ocean), 0.1(land), 0.12(snow) for dark, no day time test + ! isflag: SEA(0),ICE(1),LAND(2),SNOW(3),MSEA(4),MICE(5),MLND(6),MSNO(7) + if (ob%instid(i)%tb(1,n) /= -999. .and. ob%instid(i)%tb(9,n) /= -999.) then +! using ob with VarBC +! notc = iv%instid(i)%tb_inv(1,n)+iv%instid(i)%tb_xb(1,n) - & +! (iv%instid(i)%tb_inv(6,n)+iv%instid(i)%tb_xb(6,n)) +! using ob without VarBC + notc = ob%instid(i)%tb(1,n) - ob%instid(i)%tb(9,n) + else + notc = -999.0 + end if + ! write(*,"(a8,f12.8,a8,i4,2f8.2)") "notc", notc, "isflg", & + ! isflg, iv%instid(i)%info%lat(1,n),iv%instid(i)%info%lon(1,n) + if ( iv%instid(i)%solazi(n) < 85.0 ) then ! day Time + if ( isflg==0 .and. notc > 15. ) then ! Ocean + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_notc(:) = nrej_notc(:) + 1 + end if + if ( isflg==2 .and. notc > 21. ) then ! land + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_notc(:) = nrej_notc(:) + 1 + end if + if ( isflg==3 .and. notc > 10. ) then ! snow + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_notc(:) = nrej_notc(:) + 1 + end if + if ( isflg==1 .and. notc > 10. ) then ! ice equa snow + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_notc(:) = nrej_notc(:) + 1 + end if + else + if ( isflg==0 .and. notc > 11. ) then ! Ocean + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_notc(:) = nrej_notc(:) + 1 + end if + if ( isflg==2 .and. notc > 15. ) then ! land + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_notc(:) = nrej_notc(:) + 1 + end if + if ( isflg==3 .and. notc > 4.5 ) then ! snow + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_notc(:) = nrej_notc(:) + 1 + end if + if ( isflg==1 .and. notc > 4.5 ) then ! ice equa snow + iv%instid(i)%tb_qc(:,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_notc(:) = nrej_notc(:) + 1 + end if + end if + + ! --------------------------- + ! 5.0 assigning obs errors + if (.not. crtm_cloud ) then + do k = 1, nchan + if (use_error_factor_rad) then + iv%instid(i)%tb_error(k,n) = & + satinfo(i)%error_std(k)*satinfo(i)%error_factor(k) + else + iv%instid(i)%tb_error(k,n) = satinfo(i)%error_std(k) + end if + end do ! nchan + + else !crtm_cloud + ! symmetric error model, Geer and Bauer (2011) + do k = 1, nchan + if (c37_mean.lt.0.05) then + iv%instid(i)%tb_error(k,n)= satinfo(i)%error_std(k) + else if (c37_mean.ge.0.05.and.c37_mean.lt.0.5) then + iv%instid(i)%tb_error(k,n)= satinfo(i)%error_std(k)+ & + (c37_mean-0.05)*(satinfo(i)%error_cld(k)-satinfo(i)%error_std(k))/(0.5-0.05) + else + iv%instid(i)%tb_error(k,n)= satinfo(i)%error_cld(k) + end if + end do ! nchan + + end if + + ! 5.1 check innovation + !----------------------------------------------------------------- + if (.not. crtm_cloud ) then + ! absolute departure check + do k = 1, nchan + inv_grosscheck = 15.0 + if (use_satcv(2)) inv_grosscheck = 100.0 + if (abs(iv%instid(i)%tb_inv(k,n)) > inv_grosscheck) then + iv%instid(i)%tb_qc(k,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_omb_abs(k) = nrej_omb_abs(k) + 1 + end if + end do ! nchan + end if + + do k = 1, nchan + ! relative departure check + if (abs(iv%instid(i)%tb_inv(k,n)) > 3.0*iv%instid(i)%tb_error(k,n)) then + iv%instid(i)%tb_qc(k,n) = qc_bad + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej_omb_std(k) = nrej_omb_std(k) + 1 + end if + + + ! final QC decsion + if (iv%instid(i)%tb_qc(k,n) == qc_bad) then + iv%instid(i)%tb_error(k,n) = 500.0 + if (iv%instid(i)%info%proc_domain(1,n)) & + nrej(k) = nrej(k) + 1 + else + if (iv%instid(i)%info%proc_domain(1,n)) & + ngood(k) = ngood(k) + 1 + end if + end do ! nchan + + end do ! end loop pixel + + ! Do inter-processor communication to gather statistics. + call da_proc_sum_int (num_proc_domain) + call da_proc_sum_int (nrej_mixsurface) + call da_proc_sum_int (nrej_land) + call da_proc_sum_ints (nrej_eccloud) + call da_proc_sum_ints (nrej_omb_abs) + call da_proc_sum_ints (nrej_omb_std) + call da_proc_sum_ints (nrej_clw) + call da_proc_sum_ints (nrej) + call da_proc_sum_ints (ngood) + + if (rootproc) then + if (num_fgat_time > 1) then + write(filename,'(i2.2,a,i2.2)') it,'_qcstat_'//trim(iv%instid(i)%rttovid_string)//'_',iv%time + else + write(filename,'(i2.2,a)') it,'_qcstat_'//trim(iv%instid(i)%rttovid_string) + end if + + call da_get_unit(fgat_rad_unit) + open(fgat_rad_unit,file=trim(filename),form='formatted',iostat=ios) + if (ios /= 0) then + write(unit=message(1),fmt='(A,A)') 'error opening the output file ', filename + call da_error(__FILE__,__LINE__,message(1:1)) + end if + + write(fgat_rad_unit, fmt='(/a/)') ' Quality Control Statistics for '//iv%instid(i)%rttovid_string + if(num_proc_domain > 0) write(fgat_rad_unit,'(a20,i7)') ' num_proc_domain = ', num_proc_domain + write(fgat_rad_unit,'(a20,i7)') ' nrej_mixsurface = ', nrej_mixsurface + write(fgat_rad_unit,'(a20,i7)') ' nrej_land = ', nrej_land + write(fgat_rad_unit,'(a20)') ' nrej_eccloud(:) = ' + write(fgat_rad_unit,'(10i7)') nrej_eccloud(:) + write(fgat_rad_unit,'(a20)') ' nrej_clw(:) = ' + write(fgat_rad_unit,'(10i7)') nrej_clw(:) + write(fgat_rad_unit,'(a20)') ' nrej_omb_abs(:) = ' + write(fgat_rad_unit,'(10i7)') nrej_omb_abs(:) + write(fgat_rad_unit,'(a20)') ' nrej_omb_std(:) = ' + write(fgat_rad_unit,'(10i7)') nrej_omb_std(:) + write(fgat_rad_unit,'(a20)') ' nrej(:) = ' + write(fgat_rad_unit,'(10i7)') nrej(:) + write(fgat_rad_unit,'(a20)') ' ngood(:) = ' + write(fgat_rad_unit,'(10i7)') ngood(:) + + close(fgat_rad_unit) + call da_free_unit(fgat_rad_unit) + end if + if (trace_use) call da_trace_exit("da_qc_ahi") + +end subroutine da_qc_ahi + +function relative_azimuth ( sol_az ,sen_az ) + implicit none + real :: sol_az + real :: sen_az + real :: relative_azimuth + relative_azimuth = abs(sol_az - sen_az) + if (relative_azimuth > 180.0) then + relative_azimuth = 360.0 - relative_azimuth + endif + relative_azimuth = 180.0 - relative_azimuth +end function relative_azimuth + !------------------------------------------------------------------------------------ + ! Glint angle (the angle difference between direct "specular" reflection off + ! the surface and actual reflection toward the satellite.) + !------------------------------------------------------------------------------------ +function glint_angle ( sol_zen , sen_zen , rel_az ) + implicit none + real :: sol_zen + real :: sen_zen + real :: rel_az + real :: glint_angle + real, parameter :: PI = 3.1415926535897 + real, parameter :: DTOR = PI/180. + + glint_angle = cos(sol_zen*DTOR) * cos(sen_zen*DTOR) + & + sin(sol_zen*DTOR) * sin(sen_zen*DTOR) * cos(rel_az*DTOR) + glint_angle = max(-1.0 , min( glint_angle ,1.0 )) + glint_angle = acos(glint_angle) / DTOR +end function glint_angle + + + + + + + + + + diff --git a/var/da/da_radiance/da_qc_rad.inc b/var/da/da_radiance/da_qc_rad.inc index 9de2cd3da8..4be8f5d20a 100644 --- a/var/da/da_radiance/da_qc_rad.inc +++ b/var/da/da_radiance/da_qc_rad.inc @@ -14,7 +14,7 @@ subroutine da_qc_rad (it, ob, iv) integer :: i, nchan,p,j logical :: amsua, amsub, hirs, msu,airs, hsb, ssmis, mhs, iasi, seviri - logical :: mwts, mwhs, atms, amsr2 + logical :: mwts, mwhs, atms, amsr2,ahi integer, allocatable :: index(:) integer :: num_tovs_avg @@ -63,6 +63,8 @@ subroutine da_qc_rad (it, ob, iv) atms = trim(rttov_inst_name(rtminit_sensor(i))) == 'atms' seviri = trim(rttov_inst_name(rtminit_sensor(i))) == 'seviri' amsr2 = trim(rttov_inst_name(rtminit_sensor(i))) == 'amsr2' + ahi = trim(rttov_inst_name(rtminit_sensor(i))) == 'ahi' + if (hirs) then ! 1.0 QC for HIRS call da_qc_hirs(it, i,nchan,ob,iv) @@ -94,6 +96,8 @@ subroutine da_qc_rad (it, ob, iv) call da_qc_seviri(it,i,nchan,ob,iv) else if (amsr2) then call da_qc_amsr2(it,i,nchan,ob,iv) + else if (ahi) then + call da_qc_ahi(it,i,nchan,ob,iv) else write(unit=message(1),fmt='(A,A)') & "Unrecognized instrument",trim(rttov_inst_name(rtminit_sensor(i))) diff --git a/var/da/da_radiance/da_radiance.f90 b/var/da/da_radiance/da_radiance.f90 index 64eb78c2d4..0f2b7cb534 100644 --- a/var/da/da_radiance/da_radiance.f90 +++ b/var/da/da_radiance/da_radiance.f90 @@ -46,7 +46,7 @@ module da_radiance tovs_min_transfer,use_error_factor_rad,num_fgat_time,stdout,trace_use, & qc_good, qc_bad,myproc,biascorr,thinning,thinning_mesh, & rad_monitoring, monitor_on, kts, kte, kms, kme, calc_weightfunc, & - use_mwtsobs, use_mwhsobs, use_atmsobs, use_amsr2obs, & + use_mwtsobs, use_mwhsobs, use_atmsobs, use_amsr2obs, use_ahiobs, & use_hirs4obs, use_mhsobs,bufr_year, bufr_month,bufr_day,bufr_hour, & bufr_minute, bufr_second,bufr_solzen, bufr_station_height, & bufr_landsea_mask,bufr_solazi,tovs_end, max_tovs_input, bufr_satzen, nchan_mhs, & @@ -119,6 +119,8 @@ module da_radiance #include "da_read_obs_bufriasi.inc" #include "da_read_obs_bufrseviri.inc" #include "da_read_obs_hdf5amsr2.inc" +#include "da_read_obs_hdf5ahi.inc" +#include "da_read_obs_AHI.inc" #include "da_allocate_rad_iv.inc" #include "da_initialize_rad_iv.inc" #include "da_read_kma1dvar.inc" diff --git a/var/da/da_radiance/da_radiance1.f90 b/var/da/da_radiance/da_radiance1.f90 index 48d21934da..83f09808fe 100644 --- a/var/da/da_radiance/da_radiance1.f90 +++ b/var/da/da_radiance/da_radiance1.f90 @@ -10,10 +10,10 @@ module da_radiance1 use module_radiance, only : CRTM_Planck_Radiance, CRTM_Planck_Temperature #endif #ifdef RTTOV - use module_radiance, only : coefs + use module_radiance, only : coefs, coef_scatt #endif - use da_control, only : trace_use,missing_r, rootproc, & + use da_control, only : trace_use,missing_r, rootproc, ierr,comm,root,& stdout,myproc,qc_good,num_fgat_time,qc_bad, & use_error_factor_rad,biasprep_unit,obs_qc_pointer, filename_len, & print_detail_rad, rtm_option, trace_use_dull, & @@ -27,7 +27,7 @@ module da_radiance1 be_type use module_dm, only : wrf_dm_sum_real, wrf_dm_sum_integer use da_par_util, only : da_proc_stats_combine - use da_par_util1, only : da_proc_sum_int,da_proc_sum_ints + use da_par_util1, only : da_proc_sum_int,da_proc_sum_ints,true_mpi_real use da_reporting, only : da_error, message use da_statistics, only : da_stats_calculate use da_tools, only : da_residual_new, da_eof_decomposition @@ -58,12 +58,17 @@ module da_radiance1 real, pointer :: pm(:), tm(:), qm(:), qrn(:), qcw(:),qci(:),qsn(:),qgr(:) real :: ps,ts,t2m,mr2m,u10,v10, clwp real :: smois, tslb, snowh, elevation,soiltyp,vegtyp,vegfra - real :: clw + real :: clw + real :: tropt integer :: isflg + integer :: cloudflag + real :: SDob + ! real, pointer :: tb_xb(:) real, pointer :: tb_ob(:) real, pointer :: tb_inv(:) real, pointer :: tb_qc(:) + real, pointer :: ca_mean(:) real, pointer :: tb_error(:) integer :: sensor_index type (datalink_type), pointer :: next ! pointer to next data @@ -77,6 +82,14 @@ module da_radiance1 real , pointer :: t_jac(:,:) => null() real , pointer :: q_jac(:,:) => null() real , pointer :: ps_jac(:) => null() + + real , pointer :: ph(:) + real , pointer :: cc(:) + real , pointer :: clw(:) ! kg/kg + real , pointer :: ciw(:) ! kg/kg + real , pointer :: rain(:) ! kg/kg + real , pointer :: sp(:) ! kg/kg + end type con_vars_type type con_cld_vars_type @@ -89,6 +102,7 @@ module da_radiance1 real , pointer :: ciw(:) ! kg/kg real , pointer :: rain(:) ! kg/m2/s real , pointer :: sp(:) ! kg/m2/s + integer, pointer :: cloudflag(:) end type con_cld_vars_type type aux_vars_type @@ -176,7 +190,7 @@ module da_radiance1 real, pointer :: solidp(:) ! solid precipitation rate in kg/m2/s real, pointer :: clw(:) ! cloud liquid water (kg/kg) real, pointer :: ciw(:) ! cloud ice water (kg/kg) - + integer, pointer :: cloudflag(:) ! cloud ice water (kg/kg) end type rad_data_type type bias_type @@ -203,6 +217,7 @@ module da_radiance1 integer, allocatable :: tovs_recv_start(:,:) integer, allocatable :: tovs_copy_count(:) +include 'mpif.h' contains #include "da_jo_and_grady_rad.inc" @@ -233,7 +248,10 @@ module da_radiance1 #include "da_qc_atms.inc" #include "da_qc_seviri.inc" #include "da_qc_amsr2.inc" +#include "da_qc_ahi_zou.inc" #include "da_write_iv_rad_ascii.inc" +#include "da_write_iv_rad_for_multi_inc.inc" +#include "da_read_iv_rad_for_multi_inc.inc" #include "da_write_oa_rad_ascii.inc" #include "da_detsurtyp.inc" #include "da_cld_eff_radius.inc" diff --git a/var/da/da_radiance/da_radiance_init.inc b/var/da/da_radiance/da_radiance_init.inc index 67e563542c..863d6c4341 100644 --- a/var/da/da_radiance/da_radiance_init.inc +++ b/var/da/da_radiance/da_radiance_init.inc @@ -23,7 +23,7 @@ subroutine da_radiance_init(iv,ob) ! ! local arguments !------------------- - integer :: n, j, ichan + integer :: n, j, ichan, iret integer :: nsensor, unit_factor_rad integer :: error integer, allocatable :: nscan(:), nchanl(:) @@ -131,13 +131,25 @@ subroutine da_radiance_init(iv,ob) else if ( trim( crtm_sensor_name(rtminit_sensor(n))) == 'amsr2' ) then nchanl(n) = 14 nscan(n) = 486 + else if ( trim( crtm_sensor_name(rtminit_sensor(n))) == 'ahi' ) then + + !open the ahi info file + open(unit=1990,file='ahi_info',status='old',iostat=iret) + if(iret /= 0)then + call da_error(__FILE__,__LINE__,(/"Read ahi_info error: no such file"/)) + end if + !read ahi information + read(1990,*) + read(1990,*) + read(1990,*) + read(1990,*) nscan(n) + close(1990) + write(*,*) nscan(n) + nchanl(n) = 10 + else - write(unit=message(1),fmt='(A)') "Unrecognized instrument: " - write(unit=message(2),fmt='(A,I4)') "rtminit_platform = ",rtminit_platform(n) - write(unit=message(3),fmt='(A,I4)') "rtminit_satid = ",rtminit_satid(n) - write(unit=message(4),fmt='(A,I4)') "rtminit_sensor = ",rtminit_sensor(n) - write(unit=message(5),fmt='(A)') "Check your namelist settings" - call da_error(__FILE__,__LINE__,message(1:5)) + call da_error(__FILE__,__LINE__, & + (/"Unrecognized instrument"/)) end if iv%instid(n)%nchan = nchanl(n) diff --git a/var/da/da_radiance/da_read_iv_rad_ascii.inc b/var/da/da_radiance/da_read_iv_rad_ascii.inc new file mode 100644 index 0000000000..cd59c73026 --- /dev/null +++ b/var/da/da_radiance/da_read_iv_rad_ascii.inc @@ -0,0 +1,334 @@ +subroutine da_read_iv_rad_ascii (it,ob, iv ) + + !--------------------------------------------------------------------------- + ! Purpose: read out innovation vector structure for radiance data. + !--------------------------------------------------------------------------- + + implicit none + + integer , intent(in) :: it ! outer loop count + type (y_type), intent(in) :: ob ! Observation structure. + type (iv_type), intent(inout) :: iv ! O-B structure. + + integer :: n ! Loop counter. + integer :: i, k, l, m, m1, m2,nobs_tot,nobs_in ! Index dimension. + integer :: nlevelss ! Number of obs levels. + + integer :: ios, innov_rad_unit_in + character(len=filename_len) :: filename + character(len=7) :: surftype + integer :: ndomain + logical :: amsr2 + + real, allocatable :: dtransmt(:,:), transmt_jac(:,:), transmt(:,:), lod(:,:), lod_jac(:,:) + + if (trace_use) call da_trace_entry("da_read_iv_rad_ascii") + + read(unit=message(1),fmt='(A)') 'Reading radiance OMB ascii file' + call da_message(message(1:1)) + + do i = 1, iv%num_inst + if (iv%instid(i)%num_rad < 1) cycle + + ! count number of obs within the loc%proc_domain + ! --------------------------------------------- + nobs_tot = iv%instid(i)%info%ptotal(num_fgat_time) - iv%instid(i)%info%ptotal(0) + do m=num_fgat_time,1,-1 + if ( nobs_tot > 0 ) then + if ( rootproc ) then + write(unit=filename, fmt='(a,i3.3)') 'inv_'//trim(iv%instid(i)%rttovid_string)//'_',m + call da_get_unit(innov_rad_unit_in) + open(unit=innov_rad_unit_in,file=trim(filename),form='formatted',status='replace',iostat=ios) + if (ios /= 0 ) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open innovation radiance file"//filename/)) + Endif + read(innov_rad_unit_in) nobs_in + if ( nobs_in /= nobs_tot ) then + call da_error(__FILE__,__LINE__, & + (/"Dimensions (nobs_tot of radiance) mismatch "/)) + end if + end if ! root open ounit + iv%instid(i)%info%n1 = iv%instid(i)%info%plocal(m-1) + 1 + iv%instid(i)%info%n2=iv%instid(i)%info%plocal(m) + ndomain = 0 +! do n =1,iv%instid(i)%num_rad + do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 + + if (iv%instid(i)%info%proc_domain(1,n)) then + ndomain = ndomain + 1 + end if + end do + if (ndomain < 1) cycle + + if (rtm_option==rtm_option_crtm .and. write_jacobian ) then + allocate ( dtransmt(iv%instid(i)%nchan,iv%instid(i)%nlevels) ) + allocate ( transmt_jac(iv%instid(i)%nchan,iv%instid(i)%nlevels) ) + allocate ( transmt(iv%instid(i)%nchan,iv%instid(i)%nlevels) ) + allocate ( lod(iv%instid(i)%nchan,iv%instid(i)%nlevels) ) + allocate ( lod_jac(iv%instid(i)%nchan,iv%instid(i)%nlevels) ) + end if + + amsr2 = index(iv%instid(i)%rttovid_string,'amsr2') > 0 + + read(unit=innov_rad_unit_in,fmt='(a,a,i7,a,i5,a)') trim(iv%instid(i)%rttovid_string), & + ' number-of-pixels : ', ndomain, & + ' channel-number-of-each-pixel : ', iv%instid(i)%nchan, & + ' index-of-channels : ' + read(unit=innov_rad_unit_in,fmt='(10i5)') iv%instid(i)%ichan + if ( amsr2 ) then + read(unit=innov_rad_unit_in,fmt='(a)') ' pixel-info : i date scanpos landsea_mask elv lat lon satzen satazi clw' + else + read(unit=innov_rad_unit_in,fmt='(a)') ' pixel-info : i date scanpos landsea_mask elv lat lon satzen satazi' + end if + read(unit=innov_rad_unit_in,fmt='(a)') ' grid%xb-surf-info : i t2m mr2m(ppmv) u10 v10 ps ts smois tslb snowh isflg & + & soiltyp vegtyp vegfra elev clwp' + ndomain = 0 +!wuyl do n =1,iv%instid(i)%num_rad + do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 + if (iv%instid(i)%info%proc_domain(1,n)) then + ndomain=ndomain+1 + if ( amsr2 ) then ! read out clw + read(unit=innov_rad_unit_in,fmt='(a,i7,2x,a,i6,i3,f6.0,4f8.2,f8.3)') 'INFO : ', ndomain, & + iv%instid(i)%info%date_char(n), & + iv%instid(i)%scanpos(n), & + iv%instid(i)%landsea_mask(n), & + iv%instid(i)%info%elv(n), & + iv%instid(i)%info%lat(1,n), & + iv%instid(i)%info%lon(1,n), & + iv%instid(i)%satzen(n), & + iv%instid(i)%satazi(n), & + iv%instid(i)%clw(n) + else ! no clw info + read(unit=innov_rad_unit_in,fmt='(a,i7,2x,a,i6,i3,f6.0,4f8.2)') 'INFO : ', ndomain, & + iv%instid(i)%info%date_char(n), & + iv%instid(i)%scanpos(n), & + iv%instid(i)%landsea_mask(n), & + iv%instid(i)%info%elv(n), & + iv%instid(i)%info%lat(1,n), & + iv%instid(i)%info%lon(1,n), & + iv%instid(i)%satzen(n), & + iv%instid(i)%satazi(n) + end if + select case (iv%instid(i)%isflg(n)) + case (0) ; + surftype = ' SEA : ' + case (1) ; + surftype = ' ICE : ' + case (2) ; + surftype = 'LAND : ' + case (3) ; + surftype = 'SNOW : ' + case (4) ; + surftype = 'MSEA : ' + case (5) ; + surftype = 'MICE : ' + case (6) ; + surftype = 'MLND : ' + case (7) ; + surftype = 'MSNO : ' + end select + read(unit=innov_rad_unit_in,fmt='(a,i7,9f10.2,3i3,f8.3,f10.2,f8.3)') surftype, n, & + iv%instid(i)%t2m(n), & + iv%instid(i)%mr2m(n), & + iv%instid(i)%u10(n), & + iv%instid(i)%v10(n), & + iv%instid(i)%ps(n), & + iv%instid(i)%ts(n), & + iv%instid(i)%smois(n), & + iv%instid(i)%tslb(n), & + iv%instid(i)%snowh(n), & + iv%instid(i)%isflg(n), & + nint(iv%instid(i)%soiltyp(n)), & + nint(iv%instid(i)%vegtyp(n)), & + iv%instid(i)%vegfra(n), & + iv%instid(i)%elevation(n), & + iv%instid(i)%clwp(n) + + read(unit=innov_rad_unit_in,fmt='(a)') 'OBS : ' + read(unit=innov_rad_unit_in,fmt='(10f11.2)') ob%instid(i)%tb(:,n) + read(unit=innov_rad_unit_in,fmt='(a)') 'BAK : ' + read(unit=innov_rad_unit_in,fmt='(10f11.2)') iv%instid(i)%tb_xb(:,n) + read(unit=innov_rad_unit_in,fmt='(a)') 'IVBC : ' + read(unit=innov_rad_unit_in,fmt='(10f11.2)') iv%instid(i)%tb_inv(:,n) + read(unit=innov_rad_unit_in,fmt='(a)') 'EMS : ' + read(unit=innov_rad_unit_in,fmt='(10f11.2)') iv%instid(i)%emiss(1:iv%instid(i)%nchan,n) + if (rtm_option==rtm_option_crtm .and. write_jacobian) then + read(unit=innov_rad_unit_in,fmt='(a)') 'EMS_JACOBIAN : ' + read(unit=innov_rad_unit_in,fmt='(10f10.3)') iv%instid(i)%emiss_jacobian(1:iv%instid(i)%nchan,n) + end if + read(unit=innov_rad_unit_in,fmt='(a)') 'ERR : ' + read(unit=innov_rad_unit_in,fmt='(10f11.2)') iv%instid(i)%tb_error(:,n) + read(unit=innov_rad_unit_in,fmt='(a)') 'QC : ' + read(unit=innov_rad_unit_in,fmt='(10i11)') iv%instid(i)%tb_qc(:,n) + + if (write_profile) then + nlevelss = iv%instid(i)%nlevels + if ( rtm_option == rtm_option_rttov ) then +#ifdef RTTOV + ! first, read RTTOV levels + read(unit=innov_rad_unit_in,fmt='(a)') 'RTM_level pres(mb) T(k) Q(ppmv)' + do k = 1, nlevelss + read(unit=innov_rad_unit_in,fmt='(i3,f10.2,f8.2,e11.4)') & + k, & ! RTTOV levels + coefs(i) % coef % ref_prfl_p(k) , & + iv%instid(i)%t(k,n) , & + iv%instid(i)%mr(k,n) + end do ! end loop RTTOV level + ! second, read WRF model levels + read(unit=innov_rad_unit_in,fmt='(a)') & + 'WRF_level pres(mb) T(k) q(g/kg) clw(g/kg) rain(g/kg)' + do k=kts,kte + read(unit=innov_rad_unit_in,fmt='(i3,f10.2,f8.2,3e11.4)') & + k, & ! WRF model levels + iv%instid(i)%pm(k,n) , & + iv%instid(i)%tm(k,n) , & + iv%instid(i)%qm(k,n)*1000 , & + iv%instid(i)%qcw(k,n)*1000.0, & + iv%instid(i)%qrn(k,n)*1000.0 + end do ! end loop model level +#endif + end if ! end if rtm_option_rttov + + if ( rtm_option == rtm_option_crtm ) then +#ifdef CRTM + read(unit=innov_rad_unit_in,fmt='(a)') & + 'level fullp(mb) halfp(mb) t(k) q(g/kg) water(mm) ice(mm) rain(mm) snow(mm) graupel(mm) hail(mm)' + if (crtm_cloud) then + do k=1,iv%instid(i)%nlevels-1 + read(unit=innov_rad_unit_in,fmt='(i3,2f10.2,f8.2,13f8.3)') & + k, & + iv%instid(i)%pf(k,n), & + iv%instid(i)%pm(k,n), & + iv%instid(i)%tm(k,n), & + iv%instid(i)%qm(k,n), & + iv%instid(i)%qcw(k,n), & + iv%instid(i)%qci(k,n), & + iv%instid(i)%qrn(k,n), & + iv%instid(i)%qsn(k,n), & + iv%instid(i)%qgr(k,n), & + iv%instid(i)%qhl(k,n), & + iv%instid(i)%rcw(k,n), & + iv%instid(i)%rci(k,n), & + iv%instid(i)%rrn(k,n), & + iv%instid(i)%rsn(k,n), & + iv%instid(i)%rgr(k,n), & + iv%instid(i)%rhl(k,n) + end do ! end loop profile + else ! no cloud + do k=1,iv%instid(i)%nlevels-1 + read(unit=innov_rad_unit_in,fmt='(i3,2f10.2,f8.2,7f8.3)') & + k, & + iv%instid(i)%pf(k,n), & + iv%instid(i)%pm(k,n), & + iv%instid(i)%tm(k,n), & + iv%instid(i)%qm(k,n), & + 0.0, & + 0.0, & + 0.0, & + 0.0, & + 0.0, & + 0.0 + end do ! end loop profile + end if ! end if crtm_cloud +#endif + end if ! end if rtm_option_crtm + + end if ! end if read_profile + + if ( rtm_option == rtm_option_crtm .and. write_jacobian) then +#ifdef CRTM + + if ( calc_weightfunc ) then + dtransmt(:,:) = iv%instid(i)%der_trans(:,:,n) + transmt(:,:) = iv%instid(i)%trans(:,:,n) + transmt_jac(:,:) = iv%instid(i)%trans_jacobian(:,:,n) + lod(:,:) = iv%instid(i)%lod(:,:,n) + lod_jac(:,:) = iv%instid(i)%lod_jacobian(:,:,n) + else + dtransmt(:,:) = 0.0 + transmt(:,:) = 0.0 + transmt_jac(:,:) = 0.0 + lod(:,:) = 0.0 + lod_jac(:,:) = 0.0 + end if + + read(unit=innov_rad_unit_in,fmt='(a)') & + 'channel level halfp(mb) t(k) q(g/kg) der_trans trans_jac trans lod_jac lod water(mm) ice(mm) rain(mm) snow(mm) graupel(mm) hail(mm)' + if (crtm_cloud) then + do l=1,iv%instid(i)%nchan + do k=1,iv%instid(i)%nlevels-1 + read(unit=innov_rad_unit_in,fmt='(i5,i3,f10.2,13f14.7,6f14.7)') & + l, k, & + iv%instid(i)%pm(k,n), & + iv%instid(i)%t_jacobian(l,k,n), & + iv%instid(i)%q_jacobian(l,k,n), & + dtransmt(l,k),& + transmt_jac(l,k),& + transmt(l,k),& + lod_jac(l,k),& + lod(l,k),& + iv%instid(i)%water_jacobian(l,k,n), & + iv%instid(i)%ice_jacobian(l,k,n), & + iv%instid(i)%rain_jacobian(l,k,n), & + iv%instid(i)%snow_jacobian(l,k,n), & + iv%instid(i)%graupel_jacobian(l,k,n), & + iv%instid(i)%hail_jacobian(l,k,n), & + iv%instid(i)%water_r_jacobian(l,k,n), & + iv%instid(i)%ice_r_jacobian(l,k,n), & + iv%instid(i)%rain_r_jacobian(l,k,n), & + iv%instid(i)%snow_r_jacobian(l,k,n), & + iv%instid(i)%graupel_r_jacobian(l,k,n), & + iv%instid(i)%hail_r_jacobian(l,k,n) + end do ! end loop profile + end do ! end loop channels + else ! no cloud + do l=1,iv%instid(i)%nchan + do k=1,iv%instid(i)%nlevels-1 + read(unit=innov_rad_unit_in,fmt='(i5,i3,f10.2,13f14.7,6f14.7)') & + l, k, & + iv%instid(i)%pm(k,n), & + iv%instid(i)%t_jacobian(l,k,n), & + iv%instid(i)%q_jacobian(l,k,n), & + dtransmt(l,k),& + transmt_jac(l,k),& + transmt(l,k),& + lod_jac(l,k),& + lod(l,k),& + 0., & + 0., & + 0., & + 0., & + 0., & + 0., & + 0., & + 0., & + 0., & + 0., & + 0., & + 0. + end do ! end loop profile + end do ! end loop channels + end if ! end if crtm_cloud +#endif + end if ! end if read_jacobian + + end if ! end if proc_domain + end do ! end do pixels + if (rtm_option==rtm_option_crtm .and. write_jacobian ) then + deallocate ( dtransmt ) + deallocate ( transmt_jac ) + deallocate ( transmt ) + deallocate ( lod ) + deallocate ( lod_jac ) + end if + close(unit=innov_rad_unit_in) + call da_free_unit(innov_rad_unit_in) + end if ! nobs_tot + end do ! n1,n2 wuyl +end do ! end do instruments + + if (trace_use) call da_trace_exit("da_read_iv_rad_ascii") + +end subroutine da_read_iv_rad_ascii + diff --git a/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc b/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc new file mode 100644 index 0000000000..a5f11b1347 --- /dev/null +++ b/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc @@ -0,0 +1,96 @@ +subroutine da_read_iv_rad_for_multi_inc (it,ob, iv ) + + !--------------------------------------------------------------------------- + ! Purpose: read out innovation vector structure for radiance data. + !--------------------------------------------------------------------------- + + implicit none + + integer , intent(in) :: it ! outer loop count + type (y_type), intent(in) :: ob ! Observation structure. + type (iv_type), intent(inout) :: iv ! O-B structure. + + integer :: n ! Loop counter. + integer :: i, k, l, m, m1, m2,my,nobs_tot,nobs_in,iobs ! Index dimension. + integer :: nlevelss ! Number of obs levels. + + integer :: ios, innov_rad_unit_in + character(len=filename_len) :: filename + character(len=7) :: surftype + integer :: ndomain + logical :: amsr2,fexist + real, allocatable :: data2d(:,:) + real, allocatable :: data3d(:,:,:) + real, allocatable :: data2d_g(:,:) + real, allocatable :: data3d_g(:,:,:) + + if (trace_use) call da_trace_entry("da_read_iv_rad_ascii") + + write(unit=message(1),fmt='(A)') 'Reading radiance OMB for multi_inc' + call da_message(message(1:1)) + + do i = 1, iv%num_inst + + nobs_tot = iv%instid(i)%info%ptotal(num_fgat_time) - iv%instid(i)%info%ptotal(0) + do m=num_fgat_time,1,-1 + if ( nobs_tot > 0 ) then + write(unit=filename, fmt='(a,i3.3)') 'inv_'//trim(iv%instid(i)%rttovid_string)//'_',m + call da_get_unit(innov_rad_unit_in) + inquire (file=filename, exist=fexist) + if (.not. fexist) then + exit + else + open(unit=innov_rad_unit_in,file=trim(filename),form='unformatted',status='old',iostat=ios) + if (ios /= 0 ) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open innovation radiance file"//filename/)) + Endif + write(unit=message(1),fmt='(A)') filename + call da_message(message(1:1)) + read(innov_rad_unit_in) nobs_in + if ( nobs_in /= nobs_tot ) then + call da_error(__FILE__,__LINE__, & + (/"Dimensions (nobs_tot) mismatch "/)) + end if + iv%instid(i)%info%n1 = iv%instid(i)%info%plocal(m-1) + 1 + iv%instid(i)%info%n2=iv%instid(i)%info%plocal(m) + ndomain = 0 + + if ( amsr2 ) then + my=3 + else + my=2 + end if + allocate( data2d(nobs_tot, my) ) + read(innov_rad_unit_in) data2d + do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 +! iobs = iv%instid(i)%info%obs_global_index(n) + iobs = n + end do + deallocate ( data2d ) + +! read(unit=innov_rad_unit_in,fmt='(10i5)') iv%instid(i)%ichan + + allocate( data3d(nobs_tot, iv%instid(i)%nchan, 3) ) + read(innov_rad_unit_in) data3d + + do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 +! iobs = iv%instid(i)%info%obs_global_index(n) + iobs = n + iv%instid(i)%tb_inv(:,n) = data3d (iobs,:,1) + iv%instid(i)%tb_error(:,n) = data3d (iobs,:,2) + iv%instid(i)%tb_qc(:,n) = int(data3d (iobs,:,3)) + end do + deallocate( data3d ) + + close(unit=innov_rad_unit_in) + call da_free_unit(innov_rad_unit_in) + end if !fexist + end if ! nobs_tot + end do !num_fgat +end do ! end do instruments + +if (trace_use) call da_trace_exit("da_read_iv_rad_ascii") + +end subroutine da_read_iv_rad_for_multi_inc + diff --git a/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc.ok b/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc.ok new file mode 100644 index 0000000000..faa2f45882 --- /dev/null +++ b/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc.ok @@ -0,0 +1,334 @@ +subroutine da_read_iv_rad_for_multi_inc (it,ob, iv ) + + !--------------------------------------------------------------------------- + ! Purpose: read out innovation vector structure for radiance data. + !--------------------------------------------------------------------------- + + implicit none + + integer , intent(in) :: it ! outer loop count + type (y_type), intent(in) :: ob ! Observation structure. + type (iv_type), intent(inout) :: iv ! O-B structure. + + integer :: n ! Loop counter. + integer :: i, k, l, m, m1, m2,nobs_tot,nobs_in ! Index dimension. + integer :: nlevelss ! Number of obs levels. + + integer :: ios, innov_rad_unit_in + character(len=filename_len) :: filename + character(len=7) :: surftype + integer :: ndomain + logical :: amsr2 + + real, allocatable :: dtransmt(:,:), transmt_jac(:,:), transmt(:,:), lod(:,:), lod_jac(:,:) + + if (trace_use) call da_trace_entry("da_read_iv_rad_ascii") + + write(unit=message(1),fmt='(A)') 'Reading radiance OMB ascii file' + call da_message(message(1:1)) + + do i = 1, iv%num_inst + if (iv%instid(i)%num_rad < 1) cycle + + ! count number of obs within the loc%proc_domain + ! --------------------------------------------- + nobs_tot = iv%instid(i)%info%ptotal(num_fgat_time) - iv%instid(i)%info%ptotal(0) + do m=num_fgat_time,1,-1 + if ( nobs_tot > 0 ) then + if ( rootproc ) then + write(unit=filename, fmt='(a,i3.3)') 'inv_'//trim(iv%instid(i)%rttovid_string)//'_',m + call da_get_unit(innov_rad_unit_in) + open(unit=innov_rad_unit_in,file=trim(filename),form='formatted',status='replace',iostat=ios) + if (ios /= 0 ) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open innovation radiance file"//filename/)) + Endif + read(innov_rad_unit_in) nobs_in + if ( nobs_in /= nobs_tot ) then + call da_error(__FILE__,__LINE__, & + (/"Dimensions (nobs_tot of radiance) mismatch "/)) + end if + end if ! root open ounit + iv%instid(i)%info%n1 = iv%instid(i)%info%plocal(m-1) + 1 + iv%instid(i)%info%n2=iv%instid(i)%info%plocal(m) + ndomain = 0 +! do n =1,iv%instid(i)%num_rad + do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 + + if (iv%instid(i)%info%proc_domain(1,n)) then + ndomain = ndomain + 1 + end if + end do + if (ndomain < 1) cycle + + if (rtm_option==rtm_option_crtm .and. write_jacobian ) then + allocate ( dtransmt(iv%instid(i)%nchan,iv%instid(i)%nlevels) ) + allocate ( transmt_jac(iv%instid(i)%nchan,iv%instid(i)%nlevels) ) + allocate ( transmt(iv%instid(i)%nchan,iv%instid(i)%nlevels) ) + allocate ( lod(iv%instid(i)%nchan,iv%instid(i)%nlevels) ) + allocate ( lod_jac(iv%instid(i)%nchan,iv%instid(i)%nlevels) ) + end if + + amsr2 = index(iv%instid(i)%rttovid_string,'amsr2') > 0 + + read(unit=innov_rad_unit_in,fmt='(a,a,i7,a,i5,a)') iv%instid(i)%rttovid_string, & + ' number-of-pixels : ', ndomain, & + ' channel-number-of-each-pixel : ', iv%instid(i)%nchan, & + ' index-of-channels : ' + read(unit=innov_rad_unit_in,fmt='(10i5)') iv%instid(i)%ichan + if ( amsr2 ) then + read(unit=innov_rad_unit_in,fmt='(a)') ' pixel-info : i date scanpos landsea_mask elv lat lon satzen satazi clw' + else + read(unit=innov_rad_unit_in,fmt='(a)') ' pixel-info : i date scanpos landsea_mask elv lat lon satzen satazi' + end if + read(unit=innov_rad_unit_in,fmt='(a)') ' grid%xb-surf-info : i t2m mr2m(ppmv) u10 v10 ps ts smois tslb snowh isflg & + & soiltyp vegtyp vegfra elev clwp' + ndomain = 0 +!wuyl do n =1,iv%instid(i)%num_rad + do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 + if (iv%instid(i)%info%proc_domain(1,n)) then + ndomain=ndomain+1 + if ( amsr2 ) then ! read out clw + read(unit=innov_rad_unit_in,fmt='(a,i7,2x,a,i6,i3,f6.0,4f8.2,f8.3)') 'INFO : ', ndomain, & + iv%instid(i)%info%date_char(n), & + iv%instid(i)%scanpos(n), & + iv%instid(i)%landsea_mask(n), & + iv%instid(i)%info%elv(n), & + iv%instid(i)%info%lat(1,n), & + iv%instid(i)%info%lon(1,n), & + iv%instid(i)%satzen(n), & + iv%instid(i)%satazi(n), & + iv%instid(i)%clw(n) + else ! no clw info + read(unit=innov_rad_unit_in,fmt='(a,i7,2x,a,i6,i3,f6.0,4f8.2)') 'INFO : ', ndomain, & + iv%instid(i)%info%date_char(n), & + iv%instid(i)%scanpos(n), & + iv%instid(i)%landsea_mask(n), & + iv%instid(i)%info%elv(n), & + iv%instid(i)%info%lat(1,n), & + iv%instid(i)%info%lon(1,n), & + iv%instid(i)%satzen(n), & + iv%instid(i)%satazi(n) + end if + select case (iv%instid(i)%isflg(n)) + case (0) ; + surftype = ' SEA : ' + case (1) ; + surftype = ' ICE : ' + case (2) ; + surftype = 'LAND : ' + case (3) ; + surftype = 'SNOW : ' + case (4) ; + surftype = 'MSEA : ' + case (5) ; + surftype = 'MICE : ' + case (6) ; + surftype = 'MLND : ' + case (7) ; + surftype = 'MSNO : ' + end select + read(unit=innov_rad_unit_in,fmt='(a,i7,9f10.2,3i3,f8.3,f10.2,f8.3)') surftype, n, & + iv%instid(i)%t2m(n), & + iv%instid(i)%mr2m(n), & + iv%instid(i)%u10(n), & + iv%instid(i)%v10(n), & + iv%instid(i)%ps(n), & + iv%instid(i)%ts(n), & + iv%instid(i)%smois(n), & + iv%instid(i)%tslb(n), & + iv%instid(i)%snowh(n), & + iv%instid(i)%isflg(n), & + nint(iv%instid(i)%soiltyp(n)), & + nint(iv%instid(i)%vegtyp(n)), & + iv%instid(i)%vegfra(n), & + iv%instid(i)%elevation(n), & + iv%instid(i)%clwp(n) + + read(unit=innov_rad_unit_in,fmt='(a)') 'OBS : ' + read(unit=innov_rad_unit_in,fmt='(10f11.2)') ob%instid(i)%tb(:,n) + read(unit=innov_rad_unit_in,fmt='(a)') 'BAK : ' + read(unit=innov_rad_unit_in,fmt='(10f11.2)') iv%instid(i)%tb_xb(:,n) + read(unit=innov_rad_unit_in,fmt='(a)') 'IVBC : ' + read(unit=innov_rad_unit_in,fmt='(10f11.2)') iv%instid(i)%tb_inv(:,n) + read(unit=innov_rad_unit_in,fmt='(a)') 'EMS : ' + read(unit=innov_rad_unit_in,fmt='(10f11.2)') iv%instid(i)%emiss(1:iv%instid(i)%nchan,n) + if (rtm_option==rtm_option_crtm .and. write_jacobian) then + read(unit=innov_rad_unit_in,fmt='(a)') 'EMS_JACOBIAN : ' + read(unit=innov_rad_unit_in,fmt='(10f10.3)') iv%instid(i)%emiss_jacobian(1:iv%instid(i)%nchan,n) + end if + read(unit=innov_rad_unit_in,fmt='(a)') 'ERR : ' + read(unit=innov_rad_unit_in,fmt='(10f11.2)') iv%instid(i)%tb_error(:,n) + read(unit=innov_rad_unit_in,fmt='(a)') 'QC : ' + read(unit=innov_rad_unit_in,fmt='(10i11)') iv%instid(i)%tb_qc(:,n) + + if (write_profile) then + nlevelss = iv%instid(i)%nlevels + if ( rtm_option == rtm_option_rttov ) then +#ifdef RTTOV + ! first, read RTTOV levels + read(unit=innov_rad_unit_in,fmt='(a)') 'RTM_level pres(mb) T(k) Q(ppmv)' + do k = 1, nlevelss + read(unit=innov_rad_unit_in,fmt='(i3,f10.2,f8.2,e11.4)') & + k, & ! RTTOV levels + coefs(i) % coef % ref_prfl_p(k) , & + iv%instid(i)%t(k,n) , & + iv%instid(i)%mr(k,n) + end do ! end loop RTTOV level + ! second, read WRF model levels + read(unit=innov_rad_unit_in,fmt='(a)') & + 'WRF_level pres(mb) T(k) q(g/kg) clw(g/kg) rain(g/kg)' + do k=kts,kte + read(unit=innov_rad_unit_in,fmt='(i3,f10.2,f8.2,3e11.4)') & + k, & ! WRF model levels + iv%instid(i)%pm(k,n) , & + iv%instid(i)%tm(k,n) , & + iv%instid(i)%qm(k,n)*1000 , & + iv%instid(i)%qcw(k,n)*1000.0, & + iv%instid(i)%qrn(k,n)*1000.0 + end do ! end loop model level +#endif + end if ! end if rtm_option_rttov + + if ( rtm_option == rtm_option_crtm ) then +#ifdef CRTM + read(unit=innov_rad_unit_in,fmt='(a)') & + 'level fullp(mb) halfp(mb) t(k) q(g/kg) water(mm) ice(mm) rain(mm) snow(mm) graupel(mm) hail(mm)' + if (crtm_cloud) then + do k=1,iv%instid(i)%nlevels-1 + read(unit=innov_rad_unit_in,fmt='(i3,2f10.2,f8.2,13f8.3)') & + k, & + iv%instid(i)%pf(k,n), & + iv%instid(i)%pm(k,n), & + iv%instid(i)%tm(k,n), & + iv%instid(i)%qm(k,n), & + iv%instid(i)%qcw(k,n), & + iv%instid(i)%qci(k,n), & + iv%instid(i)%qrn(k,n), & + iv%instid(i)%qsn(k,n), & + iv%instid(i)%qgr(k,n), & + iv%instid(i)%qhl(k,n), & + iv%instid(i)%rcw(k,n), & + iv%instid(i)%rci(k,n), & + iv%instid(i)%rrn(k,n), & + iv%instid(i)%rsn(k,n), & + iv%instid(i)%rgr(k,n), & + iv%instid(i)%rhl(k,n) + end do ! end loop profile + else ! no cloud + do k=1,iv%instid(i)%nlevels-1 + read(unit=innov_rad_unit_in,fmt='(i3,2f10.2,f8.2,7f8.3)') & + k, & + iv%instid(i)%pf(k,n), & + iv%instid(i)%pm(k,n), & + iv%instid(i)%tm(k,n), & + iv%instid(i)%qm(k,n), & + 0.0, & + 0.0, & + 0.0, & + 0.0, & + 0.0, & + 0.0 + end do ! end loop profile + end if ! end if crtm_cloud +#endif + end if ! end if rtm_option_crtm + + end if ! end if read_profile + + if ( rtm_option == rtm_option_crtm .and. write_jacobian) then +#ifdef CRTM + + if ( calc_weightfunc ) then + dtransmt(:,:) = iv%instid(i)%der_trans(:,:,n) + transmt(:,:) = iv%instid(i)%trans(:,:,n) + transmt_jac(:,:) = iv%instid(i)%trans_jacobian(:,:,n) + lod(:,:) = iv%instid(i)%lod(:,:,n) + lod_jac(:,:) = iv%instid(i)%lod_jacobian(:,:,n) + else + dtransmt(:,:) = 0.0 + transmt(:,:) = 0.0 + transmt_jac(:,:) = 0.0 + lod(:,:) = 0.0 + lod_jac(:,:) = 0.0 + end if + + read(unit=innov_rad_unit_in,fmt='(a)') & + 'channel level halfp(mb) t(k) q(g/kg) der_trans trans_jac trans lod_jac lod water(mm) ice(mm) rain(mm) snow(mm) graupel(mm) hail(mm)' + if (crtm_cloud) then + do l=1,iv%instid(i)%nchan + do k=1,iv%instid(i)%nlevels-1 + read(unit=innov_rad_unit_in,fmt='(i5,i3,f10.2,13f14.7,6f14.7)') & + l, k, & + iv%instid(i)%pm(k,n), & + iv%instid(i)%t_jacobian(l,k,n), & + iv%instid(i)%q_jacobian(l,k,n), & + dtransmt(l,k),& + transmt_jac(l,k),& + transmt(l,k),& + lod_jac(l,k),& + lod(l,k),& + iv%instid(i)%water_jacobian(l,k,n), & + iv%instid(i)%ice_jacobian(l,k,n), & + iv%instid(i)%rain_jacobian(l,k,n), & + iv%instid(i)%snow_jacobian(l,k,n), & + iv%instid(i)%graupel_jacobian(l,k,n), & + iv%instid(i)%hail_jacobian(l,k,n), & + iv%instid(i)%water_r_jacobian(l,k,n), & + iv%instid(i)%ice_r_jacobian(l,k,n), & + iv%instid(i)%rain_r_jacobian(l,k,n), & + iv%instid(i)%snow_r_jacobian(l,k,n), & + iv%instid(i)%graupel_r_jacobian(l,k,n), & + iv%instid(i)%hail_r_jacobian(l,k,n) + end do ! end loop profile + end do ! end loop channels + else ! no cloud + do l=1,iv%instid(i)%nchan + do k=1,iv%instid(i)%nlevels-1 + read(unit=innov_rad_unit_in,fmt='(i5,i3,f10.2,13f14.7,6f14.7)') & + l, k, & + iv%instid(i)%pm(k,n), & + iv%instid(i)%t_jacobian(l,k,n), & + iv%instid(i)%q_jacobian(l,k,n), & + dtransmt(l,k),& + transmt_jac(l,k),& + transmt(l,k),& + lod_jac(l,k),& + lod(l,k),& + 0., & + 0., & + 0., & + 0., & + 0., & + 0., & + 0., & + 0., & + 0., & + 0., & + 0., & + 0. + end do ! end loop profile + end do ! end loop channels + end if ! end if crtm_cloud +#endif + end if ! end if read_jacobian + + end if ! end if proc_domain + end do ! end do pixels + if (rtm_option==rtm_option_crtm .and. write_jacobian ) then + deallocate ( dtransmt ) + deallocate ( transmt_jac ) + deallocate ( transmt ) + deallocate ( lod ) + deallocate ( lod_jac ) + end if + close(unit=innov_rad_unit_in) + call da_free_unit(innov_rad_unit_in) + end if ! nobs_tot + end do ! n1,n2 wuyl +end do ! end do instruments + + if (trace_use) call da_trace_exit("da_read_iv_rad_ascii") + +end subroutine da_read_iv_rad_for_multi_inc + diff --git a/var/da/da_radiance/da_read_obs_AHI.inc b/var/da/da_radiance/da_read_obs_AHI.inc new file mode 100644 index 0000000000..02a7473450 --- /dev/null +++ b/var/da/da_radiance/da_read_obs_AHI.inc @@ -0,0 +1,570 @@ +subroutine da_read_obs_AHI (iv, infile) + !-------------------------------------------------------- + ! Purpose: read in GEOCAT AHI Level-1 and Level-2 data in NETCDF4 format + ! and form innovation structure + ! + ! METHOD: use F90 sequantial data structure to avoid read the file twice + ! 1. read file radiance data in sequential data structure + ! 2. do gross QC check + ! 3. assign sequential data structure to innovation structure + ! and deallocate sequential data structure + ! + ! HISTORY: 2016/10/22 - Creation Yuanbing Wang, NUIST/CAS, NCAR/NESL/MMM/DAS + ! To be devoloped: 1.time information; 2.dimension sequence + !------------------------------------------------------------------------------ + + use netcdf + implicit none + + character(len=*), intent(in) :: infile + type(iv_type), intent(inout) :: iv + +! fixed parameter values + integer,parameter::time_dims=6 ! Time dimension + integer,parameter::nfile_max = 8 ! each netcdf file contains + +! interface variable + integer iret, rcode, ncid ! return status + +! array data + real(4), allocatable :: vlatitude(:,:) ! value for latitude + real(4), allocatable :: vlongitude(:,:) ! value for longitude + + real(4), allocatable :: tbb(:,:,:) ! tb for band 7-16 + real(4), allocatable :: sat_zenith(:,:) + real(4), allocatable :: sun_zenith(:,:) + real(4), allocatable :: tropo_temp(:,:) + + byte, allocatable :: cloud_mask(:,:) + byte, allocatable :: cloud_zou(:,:) + + real(r_kind),parameter :: tbmin = 50._r_kind + real(r_kind),parameter :: tbmax = 550._r_kind + + real(kind=8) :: obs_time + type (datalink_type),pointer :: head, p, current, prev + type(info_type) :: info + type(model_loc_type) :: loc + + integer(i_kind) :: idate5(6) + character(len=80) :: filename,str_tmp + + integer(i_kind) :: inst,platform_id,satellite_id,sensor_id + real(r_kind) :: tb, crit + integer(i_kind) :: ifgat, iout, iobs + logical :: outside, outside_all, iuse + + integer :: i,j,k,l,m,n, ifile, landsea_mask + logical :: found, head_found, head_allocated + +! Other work variables + real(r_kind) :: dlon_earth,dlat_earth + integer(i_kind) :: num_ahi_local, num_ahi_global, num_ahi_used, num_ahi_thinned + integer(i_kind) :: num_ahi_used_tmp, num_ahi_file + integer(i_kind) :: num_ahi_local_local, num_ahi_global_local, num_ahi_file_local + integer(i_kind) :: itx, itt + character(80) :: filename1,filename2 + integer :: nchan,nlongitude,nlatitude,ilongitude,ilatitude,ichannels + integer :: lonstart,latstart + integer :: LatDimID,LonDimID + integer :: latid,lonid,tbb_id,sazid,cltyid,sozid,ttp_id + integer :: nfile + character(80) :: fname_tb(nfile_max),fname_clp(nfile_max) + integer :: vtype + character(80) :: vname + logical :: fexist,got_clp_file + +! Allocatable arrays + integer(i_kind),allocatable :: ptotal(:) + real,allocatable :: in(:), out(:) + real(r_kind),allocatable :: data_all(:) + + character(len=2) tbb_name + + + if (trace_use) call da_trace_entry("da_read_obs_netcdf4ahi_geocat") + +! 0.0 Initialize variables +!----------------------------------- + head_allocated = .false. + platform_id = 31 ! Table-2 Col 1 corresponding to 'himawari' + satellite_id = 8 ! Table-2 Col 3 + sensor_id = 56 ! Table-3 Col 2 corresponding to 'ahi' + + allocate(ptotal(0:num_fgat_time)) + ptotal(0:num_fgat_time) = 0 + iobs = 0 ! for thinning, argument is inout + num_ahi_file = 0 + num_ahi_local = 0 + num_ahi_global = 0 + num_ahi_used = 0 + num_ahi_thinned = 0 + + do i = 1, rtminit_nsensor + if (platform_id == rtminit_platform(i) & + .and. satellite_id == rtminit_satid(i) & + .and. sensor_id == rtminit_sensor(i)) then + inst = i + exit + end if + end do + if (inst == 0) then + call da_warning(__FILE__,__LINE__, & + (/"The combination of Satellite_Id and Sensor_Id for AHI is not found"/)) + if (trace_use) call da_trace_exit("da_read_obs_netcdf4ahi_geocat") + return + end if + + nchan = iv%instid(inst)%nchan + write(unit=stdout,fmt=*)'AHI nchan: ',nchan + allocate(data_all(1:nchan)) + +! 1.0 Assign file names and prepare to read ahi files +!------------------------------------------------------------------------- + nfile = 0 !initialize + fname_tb(:) = '' !initialize + + ! first check if ahi nc file is available + filename1 = trim(infile) + inquire (file=filename1, exist=fexist) + if ( fexist ) then + nfile = 1 + fname_tb(nfile) = filename1 + else + ! check if netcdf4 files are available for multiple input files + ! here 0x is the input file sequence number + ! do not confuse it with fgat time slot index + do i = 1, nfile_max + write(filename1, fmt='(a, i2.2, a)') trim(infile), i +! write(filename1,fmt='(A,A,I2.2,A)') trim(infile),'-',i + inquire (file=filename1, exist=fexist) + if ( fexist ) then + nfile = nfile + 1 + fname_tb(nfile) = filename1 + else + exit + end if + write(unit=stdout,fmt=*)'AHI file name=: ',fname_tb(nfile) + end do + end if + + write(unit=stdout,fmt=*)'AHI file numbers=: ',nfile + if ( nfile == 0 ) then + call da_warning(__FILE__,__LINE__, & + (/"No valid AHI file found."/)) + if (trace_use) call da_trace_exit("da_read_obs_netcdf4ahi_geocat") + return + end if + + + !open the data area info file + open(unit=1990,file='ahi_info',status='old',iostat=iret) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__,(/"area_info file read error"/)) + endif + !read date information + read(1990,*) + read(1990,*) + read(1990,*) + read(1990,*) + read(1990,*) + read(1990,*) lonstart,latstart,nlongitude,nlatitude + close(1990) + + write(*,*) lonstart,latstart,nlongitude,nlatitude + + allocate(vlatitude(nlongitude,nlatitude)) + allocate(vlongitude(nlongitude,nlatitude)) + allocate(tbb(nlongitude,nlatitude,nchan)) + allocate(sat_zenith(nlongitude,nlatitude)) + allocate(sun_zenith(nlongitude,nlatitude)) + allocate(cloud_mask(nlongitude,nlatitude)) + allocate(cloud_zou(nlongitude,nlatitude)) + allocate(tropo_temp(nlongitude,nlatitude)) + infile_loop: do ifile = 1, nfile + num_ahi_file_local = 0 + num_ahi_local_local = 0 + num_ahi_global_local = 0 + + ! open NETCDF4 L1 file for read + iret = nf90_open(fname_tb(ifile), nf90_NOWRITE, ncid) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"Cannot open NETCDF4 file "//trim(fname_tb(ifile))/)) + cycle infile_loop + endif + + ! read array: time + iret = nf90_get_att(ncid, nf90_global, "Image_Date_Time", filename) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: observation date"/)) + end if + read(filename,"(I4,A1,I2,A1,I2,A1,I2,A1,I2,A1,I2,A1)") idate5(1),str_tmp,idate5(2),str_tmp,& + idate5(3),str_tmp,idate5(4),str_tmp,idate5(5),str_tmp,idate5(6),str_tmp + write(unit=stdout,fmt=*)'observation date: ', idate5 + + ! read array: lat + ! read lat + iret = nf90_inq_varid(ncid, 'latitude', latid) +!wuyl allocate(vlatitude(nlongitude,nlatitude)) + iret = nf90_get_var(ncid,latid,vlatitude,start=(/lonstart,latstart/), & + count=(/nlongitude,nlatitude/)) ! + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: Latitude of Observation Point"/)) + endif + ! sample display + write(unit=stdout,fmt=*)'vlatitude(pixel=1,scan=1): ',vlatitude(1,1) + + ! read lon + iret = nf90_inq_varid(ncid, 'longitude', lonid) +!wuyl allocate(vlongitude(nlongitude,nlatitude)) + iret = nf90_get_var(ncid,lonid,vlongitude,start=(/lonstart,latstart/), & + count=(/nlongitude,nlatitude/)) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: Longitude of Observation Point"/)) + call da_trace_exit("da_read_obs_netcdf4ahi_geocat") + endif + ! sample display + write(unit=stdout,fmt=*)'vlongitude(pixel=1,scan=1): ',vlongitude(1,1) + + ! read array: tb for band 7-16 +!wuyl allocate(tbb(nlongitude,nlatitude,nchan)) + iret = nf90_inq_varid(ncid, "BT", tbb_id) + iret = nf90_get_var(ncid,tbb_id,tbb,start=(/lonstart,latstart,1/), & + count=(/nlongitude,nlatitude,10/)) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: Brightness Temperature"/)) + endif + ! sample display + do k=1,10 + write(unit=stdout,fmt=*) 'tbb(pixel=1,scan=1,chan=',k,'): ', tbb(1,1,k) + enddo + + ! read array: satellite zenith angle + ! read + iret = nf90_inq_varid(ncid, 'satZenith', sazid) +!wuyl allocate(sat_zenith(nlongitude,nlatitude)) + iret = nf90_get_var(ncid,sazid,sat_zenith,start=(/lonstart,latstart/), & + count=(/nlongitude,nlatitude/)) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: satellite zenith angle"/)) + endif + ! sample display + write(unit=stdout,fmt=*) 'satellite zenith angle(pixel=1,scan=1): ',sat_zenith(1,1) + + ! read array: sun zenith angle + iret = nf90_inq_varid(ncid, 'sunZenith', sozid) +!wuyl allocate(sun_zenith(nlongitude,nlatitude)) + iret = nf90_get_var(ncid,sozid,sun_zenith,start=(/lonstart,latstart/), & + count=(/nlongitude,nlatitude/)) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: sun zenith angle"/)) + endif + ! sample display + write(unit=stdout,fmt=*) 'sun zenith angle(pixel=1,scan=1): ',sun_zenith(1,1) + + ! read array: satellite zenith angle + iret = nf90_inq_varid(ncid, 'cloudmask', cltyid) +!wuyl allocate(cloud_mask(nlongitude,nlatitude)) + iret = nf90_get_var(ncid,cltyid,cloud_mask,start=(/lonstart,latstart/), & + count=(/nlongitude,nlatitude/)) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: satellite zenith angle"/)) + endif + ! sample display + write(unit=stdout,fmt=*) 'cloud mask of origin (pixel=1,scan=1): ',cloud_mask(1,1) + + ! read array: cloud mask of Zhuge and Zou(2017) + iret = nf90_inq_varid(ncid, 'clm_zou', cltyid) +!wuyl allocate(cloud_zou(nlongitude,nlatitude)) + iret = nf90_get_var(ncid,cltyid,cloud_zou,start=(/lonstart,latstart/), & + count=(/nlongitude,nlatitude/)) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: satellite zenith angle"/)) + endif + ! sample display + write(unit=stdout,fmt=*) 'cloud mask of zou (pixel=1,scan=1): ',cloud_zou(1,1) + + ! close infile_tb file + iret = nf90_close(ncid) + +! read tropopause temprature + iret = nf90_open("trop_ahi.nc", nf90_NOWRITE, ncid) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"Cannot open NETCDF4 tropopause temprature file "/)) + endif + iret = nf90_inq_varid(ncid, "AhiTrp", ttp_id) +!wuyl allocate(tropo_temp(nlongitude,nlatitude)) + iret = nf90_get_var(ncid,ttp_id,tropo_temp) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: Tropopause Temperature"/)) + endif + iret = nf90_close(ncid) + +! 2.0 Loop to read netcdf and assign information to a sequential structure +!------------------------------------------------------------------------- + + ! Allocate arrays to hold data + if ( .not. head_allocated ) then + allocate (head) + nullify ( head % next ) + p => head + head_allocated = .true. + end if + + ! start scan_loop + scan_loop: do ilatitude=1, nlatitude + + call da_get_julian_time(idate5(1),idate5(2),idate5(3),idate5(4),idate5(5),obs_time) + if ( obs_time < time_slots(0) .or. & + obs_time >= time_slots(num_fgat_time) ) cycle scan_loop + do ifgat=1,num_fgat_time + if ( obs_time >= time_slots(ifgat-1) .and. & + obs_time < time_slots(ifgat) ) exit + end do + + ! start fov_loop + fov_loop: do ilongitude=1, nlongitude + + if ( sat_zenith(ilongitude,ilatitude) > 65.0 ) cycle fov_loop + + num_ahi_file = num_ahi_file + 1 + num_ahi_file_local = num_ahi_file_local + 1 + info%lat = vlatitude(ilongitude,ilatitude) + info%lon = vlongitude(ilongitude,ilatitude) + + call da_llxy (info, loc, outside, outside_all) + if (outside_all) cycle fov_loop + + num_ahi_global = num_ahi_global + 1 + num_ahi_global_local = num_ahi_global_local + 1 + ptotal(ifgat) = ptotal(ifgat) + 1 + if (outside) cycle fov_loop ! No good for this PE + + num_ahi_local = num_ahi_local + 1 + num_ahi_local_local = num_ahi_local_local + 1 + write(unit=info%date_char, & + fmt='(i4.4,a,i2.2,a,i2.2,a,i2.2,a,i2.2,a,i2.2)') & + idate5(1), '-', idate5(2), '-', idate5(3), '_', idate5(4), & + ':', idate5(5), ':', idate5(6) + info%elv = 0.0 + +! 3.0 Make Thinning +! Map obs to thinning grid +!------------------------------------------------------------------- + if (thinning) then + dlat_earth = info%lat !degree + dlon_earth = info%lon + if (dlon_earth=r360) dlon_earth = dlon_earth-r360 + dlat_earth = dlat_earth*deg2rad !radian + dlon_earth = dlon_earth*deg2rad + crit = 1. + call map2grids(inst,ifgat,dlat_earth,dlon_earth,crit,iobs,itx,1,itt,iout,iuse) + if (.not. iuse) then + num_ahi_thinned = num_ahi_thinned+1 + cycle fov_loop + end if + end if + + num_ahi_used = num_ahi_used + 1 + data_all = missing_r + + do k=1,nchan + tb = tbb(ilongitude,ilatitude,k) + if( tb < tbmin .or. tb > tbmax ) tb = missing_r + data_all(k)= tb + enddo + +! 4.0 assign information to sequential radiance structure +!-------------------------------------------------------------------------- + allocate ( p % tb_inv (1:nchan )) + p%info = info + p%loc = loc + p%landsea_mask = 1 + p%scanpos = ilongitude !nint(sat_zenith(ilongitude,ilatitude))+1.001_r_kind ! + p%satzen = sat_zenith(ilongitude,ilatitude) + p%satazi = 0 + p%solzen = 0 + p%solazi = 0 + p%tb_inv(1:nchan) = data_all(1:nchan) + p%sensor_index = inst + p%ifgat = ifgat +!wuyl p%cloudflag = cloud_mask(ilongitude,ilatitude) + p%cloudflag = cloud_zou(ilongitude,ilatitude) + + allocate (p%next) ! add next data + p => p%next + nullify (p%next) + end do fov_loop + end do scan_loop + + write(stdout,fmt='(3a,i10)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_file : ',num_ahi_file_local + write(stdout,fmt='(3a,i10)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_global : ',num_ahi_global_local + write(stdout,fmt='(3a,i10)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_local : ',num_ahi_local_local + end do infile_loop + + deallocate(data_all) ! Deallocate data arrays + !deallocate(cloudflag) + deallocate(vlatitude) + deallocate(vlongitude) + deallocate(tbb) + deallocate(sat_zenith) +! if( got_clp_file ) deallocate(cloud_mask) + + if (thinning .and. num_ahi_global > 0 ) then +#ifdef DM_PARALLEL + ! Get minimum crit and associated processor index. + j = 0 + do ifgat = 1, num_fgat_time + j = j + thinning_grid(inst,ifgat)%itxmax + end do + + allocate ( in (j) ) + allocate ( out (j) ) + j = 0 + do ifgat = 1, num_fgat_time + do i = 1, thinning_grid(inst,ifgat)%itxmax + j = j + 1 + in(j) = thinning_grid(inst,ifgat)%score_crit(i) + end do + end do + call mpi_reduce(in, out, j, true_mpi_real, mpi_min, root, comm, ierr) + + call wrf_dm_bcast_real (out, j) + + j = 0 + do ifgat = 1, num_fgat_time + do i = 1, thinning_grid(inst,ifgat)%itxmax + j = j + 1 + if ( ABS(out(j)-thinning_grid(inst,ifgat)%score_crit(i)) > 1.0E-10 ) & + thinning_grid(inst,ifgat)%ibest_obs(i) = 0 + end do + end do + + deallocate( in ) + deallocate( out ) + +#endif + + ! Delete the nodes which being thinning out + p => head + prev => head + head_found = .false. + num_ahi_used_tmp = num_ahi_used + do j = 1, num_ahi_used_tmp + n = p%sensor_index + ifgat = p%ifgat + found = .false. + + do i = 1, thinning_grid(n,ifgat)%itxmax + if ( thinning_grid(n,ifgat)%ibest_obs(i) == j .and. thinning_grid(n,ifgat)%score_crit(i) < 9.99e6_r_kind ) then + found = .true. + exit + end if + end do + + ! free current data + if ( .not. found ) then + + current => p + p => p%next + + if ( head_found ) then + prev%next => p + else + head => p + prev => p + end if + + deallocate ( current % tb_inv ) + deallocate ( current ) + + num_ahi_thinned = num_ahi_thinned + 1 + num_ahi_used = num_ahi_used - 1 + continue + end if + + if ( found .and. head_found ) then + prev => p + p => p%next + continue + end if + + if ( found .and. .not. head_found ) then + head_found = .true. + head => p + prev => p + p => p%next + end if + + end do + end if ! End of thinning + + iv%total_rad_pixel = iv%total_rad_pixel + num_ahi_used + iv%total_rad_channel = iv%total_rad_channel + num_ahi_used*nchan + + iv%info(radiance)%nlocal = iv%info(radiance)%nlocal + num_ahi_used + iv%info(radiance)%ntotal = iv%info(radiance)%ntotal + num_ahi_global + + do i = 1, num_fgat_time + ptotal(i) = ptotal(i) + ptotal(i-1) + iv%info(radiance)%ptotal(i) = iv%info(radiance)%ptotal(i) + ptotal(i) + end do + if ( iv%info(radiance)%ptotal(num_fgat_time) /= iv%info(radiance)%ntotal ) then + write(unit=message(1),fmt='(A,I10,A,I10)') & + "Number of ntotal:",iv%info(radiance)%ntotal," is different from the sum of ptotal:", iv%info(radiance)%ptotal(num_fgat_time) + call da_warning(__FILE__,__LINE__,message(1:1)) + endif + + write(unit=stdout,fmt='(a)') 'AHI data counts: ' + write(stdout,fmt='(a,i10)') ' In file: ',num_ahi_file + write(stdout,fmt='(a,i10)') ' Global : ',num_ahi_global + write(stdout,fmt='(a,i10)') ' Local : ',num_ahi_local + write(stdout,fmt='(a,i10)') ' Used : ',num_ahi_used + write(stdout,fmt='(a,i10)') ' Thinned: ',num_ahi_thinned + +! 5.0 allocate innovation radiance structure +!---------------------------------------------------------------- + + if (num_ahi_used > 0) then + iv%instid(inst)%num_rad = num_ahi_used + iv%instid(inst)%info%nlocal = num_ahi_used + write(UNIT=stdout,FMT='(a,i3,2x,a,3x,i10)') & + 'Allocating space for radiance innov structure', & + inst, iv%instid(inst)%rttovid_string, iv%instid(inst)%num_rad +! call da_allocate_rad_iv (inst, nchan, iv) + end if + +iv%instid(inst)%info%ptotal=ptotal +! 6.0 assign sequential structure to innovation structure +!------------------------------------------------------------- + p => head + call da_allocate_rad_iv (inst, nchan, iv) + + do n = 1, num_ahi_used + i = p%sensor_index + call da_initialize_rad_iv (i, n, iv, p) + current => p + p => p%next + ! free current data + deallocate ( current % tb_inv ) + deallocate ( current ) + end do + deallocate ( p ) + deallocate (ptotal) + + if (trace_use) call da_trace_exit("da_read_obs_netcdf4ahi_geocat") + + write(unit=stdout,fmt=*) 'da_read_obs_AHI.nc well done' +end subroutine da_read_obs_AHI diff --git a/var/da/da_radiance/da_read_obs_AHI.inc.1 b/var/da/da_radiance/da_read_obs_AHI.inc.1 new file mode 100644 index 0000000000..05803a0708 --- /dev/null +++ b/var/da/da_radiance/da_read_obs_AHI.inc.1 @@ -0,0 +1,566 @@ +subroutine da_read_obs_AHI (iv, infile) + !-------------------------------------------------------- + ! Purpose: read in GEOCAT AHI Level-1 and Level-2 data in NETCDF4 format + ! and form innovation structure + ! + ! METHOD: use F90 sequantial data structure to avoid read the file twice + ! 1. read file radiance data in sequential data structure + ! 2. do gross QC check + ! 3. assign sequential data structure to innovation structure + ! and deallocate sequential data structure + ! + ! HISTORY: 2016/10/22 - Creation Yuanbing Wang, NUIST/CAS, NCAR/NESL/MMM/DAS + ! To be devoloped: 1.time information; 2.dimension sequence + !------------------------------------------------------------------------------ + + use netcdf + implicit none + + character(len=*), intent(in) :: infile + type(iv_type), intent(inout) :: iv + +! fixed parameter values + integer,parameter::time_dims=6 ! Time dimension + integer,parameter::nfile_max = 8 ! each netcdf file contains + +! interface variable + integer iret, rcode, ncid ! return status + +! array data + real(4), allocatable :: vlatitude(:,:) ! value for latitude + real(4), allocatable :: vlongitude(:,:) ! value for longitude + + real(4), allocatable :: tbb(:,:,:) ! tb for band 7-16 + real(4), allocatable :: sat_zenith(:,:) + + byte, allocatable ::cloud_mask(:,:) + + real(r_kind),parameter :: tbmin = 50._r_kind + real(r_kind),parameter :: tbmax = 550._r_kind + + real(kind=8) :: obs_time + type (datalink_type),pointer :: head, p, current, prev + type(info_type) :: info + type(model_loc_type) :: loc + + integer(i_kind) :: idate5(6) + character(len=80) :: filename,str_tmp + + integer(i_kind) :: inst,platform_id,satellite_id,sensor_id + real(r_kind) :: tb, crit + integer(i_kind) :: ifgat, iout, iobs + logical :: outside, outside_all, iuse + + integer :: i,j,k,l,m,n, ifile, landsea_mask + logical :: found, head_found, head_allocated + +! Other work variables + real(r_kind) :: dlon_earth,dlat_earth + integer(i_kind) :: num_ahi_local, num_ahi_global, num_ahi_used, num_ahi_thinned + integer(i_kind) :: num_ahi_used_tmp, num_ahi_file + integer(i_kind) :: num_ahi_local_local, num_ahi_global_local, num_ahi_file_local + integer(i_kind) :: itx, itt + character(80) :: filename1,filename2 + integer :: nchan,nlongitude,nlatitude,ilongitude,ilatitude,ichannels + integer :: lonstart,latstart + integer :: LatDimID,LonDimID + integer :: latid,lonid,tbb_id,sazid,cltyid + integer :: nfile + character(80) :: fname_tb(nfile_max),fname_clp(nfile_max) + integer :: vtype + character(80) :: vname + logical :: fexist,got_clp_file + +! Allocatable arrays + integer(i_kind),allocatable :: ptotal(:) + real,allocatable :: in(:), out(:) + real(r_kind),allocatable :: data_all(:) + + character(len=2) tbb_name + data tbb_name/'BT'/ + + if (trace_use) call da_trace_entry("da_read_obs_netcdf4ahi_zout") + +! 0.0 Initialize variables +!----------------------------------- + head_allocated = .false. + platform_id = 31 ! Table-2 Col 1 corresponding to 'himawari' + satellite_id = 8 ! Table-2 Col 3 + sensor_id = 56 ! Table-3 Col 2 corresponding to 'ahi' + + allocate(ptotal(0:num_fgat_time)) + ptotal(0:num_fgat_time) = 0 + iobs = 0 ! for thinning, argument is inout + num_ahi_file = 0 + num_ahi_local = 0 + num_ahi_global = 0 + num_ahi_used = 0 + num_ahi_thinned = 0 + + do i = 1, rtminit_nsensor + if (platform_id == rtminit_platform(i) & + .and. satellite_id == rtminit_satid(i) & + .and. sensor_id == rtminit_sensor(i)) then + inst = i + exit + end if + end do + if (inst == 0) then + call da_warning(__FILE__,__LINE__, & + (/"The combination of Satellite_Id and Sensor_Id for AHI is not found"/)) + if (trace_use) call da_trace_exit("da_read_obs_netcdf4ahi_geocat") + return + end if + + nchan = iv%instid(inst)%nchan + write(unit=stdout,fmt=*)'AHI nchan: ',nchan + allocate(data_all(1:nchan)) + +! 1.0 Assign file names and prepare to read ahi files +!------------------------------------------------------------------------- + nfile = 0 !initialize + fname_tb(:) = '' !initialize + + ! first check if ahi nc file is available + filename1 = trim(infile) + inquire (file=filename1, exist=fexist) + if ( fexist ) then + nfile = 1 + fname_tb(nfile) = filename1 + else + ! check if netcdf4 files are available for multiple input files + ! here 0x is the input file sequence number + ! do not confuse it with fgat time slot index + do i = 1, nfile_max + write(filename1,fmt='(A,A,I2.2,A)') trim(infile),'-',i + inquire (file=filename1, exist=fexist) + if ( fexist ) then + nfile = nfile + 1 + fname_tb(nfile) = filename1 + else + exit + end if + end do + end if + + if ( nfile == 0 ) then + call da_warning(__FILE__,__LINE__, & + (/"No valid AHI file found."/)) + if (trace_use) call da_trace_exit("da_read_obs_netcdf4ahi_geocat") + return + end if + + + !open the data area info file + open(unit=1990,file='ahi_info',status='old',iostat=iret) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__,(/"area_info file read error"/)) + endif + !read date information + read(1990,*) + read(1990,*) + read(1990,*) + read(1990,*) + read(1990,*) + read(1990,*) lonstart,latstart,nlongitude,nlatitude + close(1990) + + write(*,*) lonstart,latstart,nlongitude,nlatitude + + infile_loop: do ifile = 1, nfile + num_ahi_file_local = 0 + num_ahi_local_local = 0 + num_ahi_global_local = 0 + + ! open NETCDF4 L1 file for read + iret = nf90_open(fname_tb(ifile), nf90_NOWRITE, ncid) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"Cannot open NETCDF4 file "//trim(fname_tb(ifile))/)) + cycle infile_loop + endif + + ! read dimensions: latitude and longitude + ! iret = nf90_inq_dimid(ncid, "lines", LatDimID) + ! iret = nf90_inquire_dimension(ncid, LatDimID, len=nlatitude) + + ! iret = nf90_inq_dimid(ncid, "elements", LonDimID) + ! iret = nf90_inquire_dimension(ncid, LonDimID, len=nlongitude) + + ! write(unit=stdout,fmt=*) nlongitude,nlatitude + + + ! read array: time + iret = nf90_get_att(ncid, nf90_global, "Image_Date_Time", filename) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: observation date"/)) + end if + read(filename,"(I4,A1,I2,A1,I2,A1,I2,A1,I2,A1,I2,A1)") idate5(1),str_tmp,idate5(2),str_tmp,& + idate5(3),str_tmp,idate5(4),str_tmp,idate5(5),str_tmp,idate5(6),str_tmp + write(unit=stdout,fmt=*)'observation date: ', idate5 + + ! read array: lat + ! read lat + iret = nf90_inq_varid(ncid, 'latitude', latid) + allocate(vlatitude(nlongitude,nlatitude)) + iret = nf90_get_var(ncid,latid,vlatitude,start=(/lonstart,latstart/), & + count=(/nlongitude,nlatitude/)) ! + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: Latitude of Observation Point"/)) + endif +! do j=1,nlatitude +! do i=1,nlongitude +! vlatitude(i,j)=vlatitude(i,j) * scale_factor_lat +! end do +! end do + ! sample display + write(unit=stdout,fmt=*)'vlatitude(pixel=1,scan=1): ',vlatitude(1,1) + + ! read lon + iret = nf90_inq_varid(ncid, 'longitude', lonid) + allocate(vlongitude(nlongitude,nlatitude)) + iret = nf90_get_var(ncid,lonid,vlongitude,start=(/lonstart,latstart/), & + count=(/nlongitude,nlatitude/)) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: Longitude of Observation Point"/)) + call da_trace_exit("da_read_obs_netcdf4ahi_geocat") + endif +! do j=1,nlatitude +! do i=1,nlongitude +! vlongitude(i,j)=vlongitude(i,j) * scale_factor_lon +! end do +! end do + ! sample display + write(unit=stdout,fmt=*)'vlongitude(pixel=1,scan=1): ',vlongitude(1,1) + + ! read array: tb for band 7-16 + ! read + allocate(tbb(nlongitude,nlatitude,nchan)) +! do k=1,nchan + iret = nf90_inq_varid(ncid, tbb_name, tbb_id) + iret = nf90_get_var(ncid,tbb_id,tbb(:,:,:),start=(/lonstart,latstart,1/), & + count=(/nlongitude,nlatitude,10/)) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: Brightness Temperature"/)) + endif +! do j=1,nlatitude +! do i=1,nlongitude +! if(k==1) then +! tbb(i,j,k)=tbb(i,j,k) * scale_factor_tb1 + add_offset_tb1 +! end if +! if(k>=2 .and. k<=4) then +! tbb(i,j,k)=tbb(i,j,k) * scale_factor_tb2 + add_offset_tb2 +! end if +! if(k>=5 .and. k<=9) then +! tbb(i,j,k)=tbb(i,j,k) * scale_factor_tb3 + add_offset_tb3 +! end if +! if(k==10) then +! tbb(i,j,k)=tbb(i,j,k) * scale_factor_tb4 + add_offset_tb4 +! end if +! end do +! end do + ! sample display + do k=1,nchan + write(unit=stdout,fmt=*) 'tbb(pixel=1,scan=1,chan=',k,'): ', tbb(1,1,k) + end do + + ! read array: satellite zenith angle + ! read + iret = nf90_inq_varid(ncid, 'satZenith', sazid) + allocate(sat_zenith(nlongitude,nlatitude)) + iret = nf90_get_var(ncid,sazid,sat_zenith,start=(/lonstart,latstart/), & + count=(/nlongitude,nlatitude/)) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: satellite zenith angle"/)) + endif +! do j=1,nlatitude +! do i=1,nlongitude +! sat_zenith(i,j)=sat_zenith(i,j) * scale_factor_saz + add_offset_saz +! end do +! end do + ! sample display + write(unit=stdout,fmt=*) 'satellite zenith angle(pixel=1,scan=1): ',sat_zenith(1,1) + + ! close infile_tb file + iret = nf90_close(ncid) + + !open infile_clp file +! got_clp_file = .false. +! iret = nf90_open(fname_clp(ifile), nf90_NOWRITE, ncid) +! if ( iret == 0 ) then +! got_clp_file = .true. +! endif + +! if ( got_clp_file ) then + ! read array: eps_cmask_ahi_cloud_mask + rcode = nf90_inq_varid(ncid, "clm_zou", cltyid) + allocate(cloud_mask(nlongitude,nlatitude)) + iret = nf90_get_var(ncid,cltyid,cloud_mask,start=(/lonstart,latstart/), & + count=(/nlongitude,nlatitude/)) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__,(/"NETCDF4 read error for: CLTYPE data"/)) + endif + ! sample display + write(unit=stdout,fmt=*)'cloud_mask(pixel=1,scan=1): ',cloud_mask(1,1) + ! close infile_clp file + iret = nf90_close(ncid) +! end if + +! 2.0 Loop to read netcdf and assign information to a sequential structure +!------------------------------------------------------------------------- + + ! Allocate arrays to hold data + if ( .not. head_allocated ) then + allocate (head) + nullify ( head % next ) + p => head + head_allocated = .true. + end if + + ! start scan_loop + scan_loop: do ilatitude=1, nlatitude + + call da_get_julian_time(idate5(1),idate5(2),idate5(3),idate5(4),idate5(5),obs_time) + if ( obs_time < time_slots(0) .or. & + obs_time >= time_slots(num_fgat_time) ) cycle scan_loop + do ifgat=1,num_fgat_time + if ( obs_time >= time_slots(ifgat-1) .and. & + obs_time < time_slots(ifgat) ) exit + end do + + ! start fov_loop + fov_loop: do ilongitude=1, nlongitude + + if ( sat_zenith(ilongitude,ilatitude) > 65.0 ) cycle fov_loop + + num_ahi_file = num_ahi_file + 1 + num_ahi_file_local = num_ahi_file_local + 1 + info%lat = vlatitude(ilongitude,ilatitude) + info%lon = vlongitude(ilongitude,ilatitude) + + call da_llxy (info, loc, outside, outside_all) + if (outside_all) cycle fov_loop + + num_ahi_global = num_ahi_global + 1 + num_ahi_global_local = num_ahi_global_local + 1 + ptotal(ifgat) = ptotal(ifgat) + 1 + if (outside) cycle fov_loop ! No good for this PE + + num_ahi_local = num_ahi_local + 1 + num_ahi_local_local = num_ahi_local_local + 1 + write(unit=info%date_char, & + fmt='(i4.4,a,i2.2,a,i2.2,a,i2.2,a,i2.2,a,i2.2)') & + idate5(1), '-', idate5(2), '-', idate5(3), '_', idate5(4), & + ':', idate5(5), ':', idate5(6) + info%elv = 0.0 + +! 3.0 Make Thinning +! Map obs to thinning grid +!------------------------------------------------------------------- + if (thinning) then + dlat_earth = info%lat !degree + dlon_earth = info%lon + if (dlon_earth=r360) dlon_earth = dlon_earth-r360 + dlat_earth = dlat_earth*deg2rad !radian + dlon_earth = dlon_earth*deg2rad + crit = 1. + call map2grids(inst,ifgat,dlat_earth,dlon_earth,crit,iobs,itx,1,itt,iout,iuse) + if (.not. iuse) then + num_ahi_thinned = num_ahi_thinned+1 + cycle fov_loop + end if + end if + + num_ahi_used = num_ahi_used + 1 + data_all = missing_r + + do k=1,nchan + tb = tbb(ilongitude,ilatitude,k) + if( tb < tbmin .or. tb > tbmax ) tb = missing_r + data_all(k)= tb + enddo + +! 4.0 assign information to sequential radiance structure +!-------------------------------------------------------------------------- + allocate ( p % tb_inv (1:nchan )) + p%info = info + p%loc = loc + p%landsea_mask = 1 + p%scanpos = ilongitude !nint(sat_zenith(ilongitude,ilatitude))+1.001_r_kind ! + p%satzen = sat_zenith(ilongitude,ilatitude) + p%satazi = 0 + p%solzen = 0 + p%solazi = 0 + p%tb_inv(1:nchan) = data_all(1:nchan) + p%sensor_index = inst + p%ifgat = ifgat + p%cloudflag = cloud_mask(ilongitude,ilatitude) + + allocate (p%next) ! add next data + p => p%next + nullify (p%next) + end do fov_loop + end do scan_loop + + write(stdout,fmt='(3a,i10)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_file : ',num_ahi_file_local + write(stdout,fmt='(3a,i10)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_global : ',num_ahi_global_local + write(stdout,fmt='(3a,i10)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_local : ',num_ahi_local_local + end do infile_loop + + deallocate(data_all) ! Deallocate data arrays + !deallocate(cloudflag) + deallocate(vlatitude) + deallocate(vlongitude) + deallocate(tbb) + deallocate(sat_zenith) + if( got_clp_file ) deallocate(cloud_mask) + + if (thinning .and. num_ahi_global > 0 ) then +#ifdef DM_PARALLEL + ! Get minimum crit and associated processor index. + j = 0 + do ifgat = 1, num_fgat_time + j = j + thinning_grid(inst,ifgat)%itxmax + end do + + allocate ( in (j) ) + allocate ( out (j) ) + j = 0 + do ifgat = 1, num_fgat_time + do i = 1, thinning_grid(inst,ifgat)%itxmax + j = j + 1 + in(j) = thinning_grid(inst,ifgat)%score_crit(i) + end do + end do + call mpi_reduce(in, out, j, true_mpi_real, mpi_min, root, comm, ierr) + + call wrf_dm_bcast_real (out, j) + + j = 0 + do ifgat = 1, num_fgat_time + do i = 1, thinning_grid(inst,ifgat)%itxmax + j = j + 1 + if ( ABS(out(j)-thinning_grid(inst,ifgat)%score_crit(i)) > 1.0E-10 ) & + thinning_grid(inst,ifgat)%ibest_obs(i) = 0 + end do + end do + + deallocate( in ) + deallocate( out ) + +#endif + + ! Delete the nodes which being thinning out + p => head + prev => head + head_found = .false. + num_ahi_used_tmp = num_ahi_used + do j = 1, num_ahi_used_tmp + n = p%sensor_index + ifgat = p%ifgat + found = .false. + + do i = 1, thinning_grid(n,ifgat)%itxmax + if ( thinning_grid(n,ifgat)%ibest_obs(i) == j .and. thinning_grid(n,ifgat)%score_crit(i) < 9.99e6_r_kind ) then + found = .true. + exit + end if + end do + + ! free current data + if ( .not. found ) then + + current => p + p => p%next + + if ( head_found ) then + prev%next => p + else + head => p + prev => p + end if + + deallocate ( current % tb_inv ) + deallocate ( current ) + + num_ahi_thinned = num_ahi_thinned + 1 + num_ahi_used = num_ahi_used - 1 + continue + end if + + if ( found .and. head_found ) then + prev => p + p => p%next + continue + end if + + if ( found .and. .not. head_found ) then + head_found = .true. + head => p + prev => p + p => p%next + end if + + end do + end if ! End of thinning + + iv%total_rad_pixel = iv%total_rad_pixel + num_ahi_used + iv%total_rad_channel = iv%total_rad_channel + num_ahi_used*nchan + + iv%info(radiance)%nlocal = iv%info(radiance)%nlocal + num_ahi_used + iv%info(radiance)%ntotal = iv%info(radiance)%ntotal + num_ahi_global + + do i = 1, num_fgat_time + ptotal(i) = ptotal(i) + ptotal(i-1) + iv%info(radiance)%ptotal(i) = iv%info(radiance)%ptotal(i) + ptotal(i) + end do + if ( iv%info(radiance)%ptotal(num_fgat_time) /= iv%info(radiance)%ntotal ) then + write(unit=message(1),fmt='(A,I10,A,I10)') & + "Number of ntotal:",iv%info(radiance)%ntotal," is different from the sum of ptotal:", iv%info(radiance)%ptotal(num_fgat_time) + call da_warning(__FILE__,__LINE__,message(1:1)) + endif + + write(unit=stdout,fmt='(a)') 'AHI data counts: ' + write(stdout,fmt='(a,i10)') ' In file: ',num_ahi_file + write(stdout,fmt='(a,i10)') ' Global : ',num_ahi_global + write(stdout,fmt='(a,i10)') ' Local : ',num_ahi_local + write(stdout,fmt='(a,i10)') ' Used : ',num_ahi_used + write(stdout,fmt='(a,i10)') ' Thinned: ',num_ahi_thinned + +! 5.0 allocate innovation radiance structure +!---------------------------------------------------------------- + + if (num_ahi_used > 0) then + iv%instid(inst)%num_rad = num_ahi_used + iv%instid(inst)%info%nlocal = num_ahi_used + write(UNIT=stdout,FMT='(a,i3,2x,a,3x,i10)') & + 'Allocating space for radiance innov structure', & + inst, iv%instid(inst)%rttovid_string, iv%instid(inst)%num_rad + call da_allocate_rad_iv (inst, nchan, iv) + end if + +! 6.0 assign sequential structure to innovation structure +!------------------------------------------------------------- + p => head + + do n = 1, num_ahi_used + i = p%sensor_index + call da_initialize_rad_iv (i, n, iv, p) + current => p + p => p%next + ! free current data + deallocate ( current % tb_inv ) + deallocate ( current ) + end do + deallocate ( p ) + deallocate (ptotal) + + if (trace_use) call da_trace_exit("da_read_obs_netcdf4ahi_geocat") + +end subroutine da_read_obs_AHI diff --git a/var/da/da_radiance/da_read_obs_fy3.inc b/var/da/da_radiance/da_read_obs_fy3.inc index c6f38b283f..543460a2c6 100644 --- a/var/da/da_radiance/da_read_obs_fy3.inc +++ b/var/da/da_radiance/da_read_obs_fy3.inc @@ -219,7 +219,7 @@ bufrfile: do ibufr=1,numbufr iostat = iost, status = 'old') if (iost /= 0) then call da_warning(__FILE__,__LINE__, & - (/"Cannot open file "//filename/)) + (/"Cannot open file "//infile/)) if (trace_use) call da_trace_exit("da_read_obs_fy3") return end if diff --git a/var/da/da_radiance/da_read_obs_hdf5ahi.inc b/var/da/da_radiance/da_read_obs_hdf5ahi.inc new file mode 100644 index 0000000000..f7e5a510b0 --- /dev/null +++ b/var/da/da_radiance/da_read_obs_hdf5ahi.inc @@ -0,0 +1,643 @@ +subroutine da_read_obs_hdf5ahi (iv,infile_tb,infile_clp) + !-------------------------------------------------------- + ! Purpose: read in CMA AHI Level-1B and Level-2 data in HDF5 format + ! and form innovation structure + ! + ! METHOD: use F90 sequantial data structure to avoid read the file twice + ! 1. read file radiance data in sequential data structure + ! 2. do gross QC check + ! 3. assign sequential data structure to innovation structure + ! and deallocate sequential data structure + ! + ! HISTORY: 2016/10/12 - Creation Yuanbing Wang, NUIST/CAS, NCAR/NESL/MMM/DAS + ! + ! To be developed: + ! 1. more general variable names; + ! 2. get time and dimension information from file + ! 3. more readable and efficient programm + !------------------------------------------------------------------------------ + + implicit none + + character(len=*), intent(in) :: infile_tb, infile_clp + type(iv_type), intent(inout) :: iv + +#if defined(HDF5) +! fixed parameter values + integer,parameter::nlatitude=600 ! Maximum allowed NumberOfScans + integer,parameter::nlongitude=700 ! low resolution pixel width + integer,parameter::time_dims=6 ! Time dimension + integer,parameter::nfile_max = 8 ! each hdf file contains ~50min of data + ! at most 8 files for a 6-h time window +! interface variable + integer iret ! return status + integer(HID_T) fhnd1 ! file handle + integer(HID_T) dhnd1 ! dataset handle + integer(HSIZE_T) sz1(2) ! array size 1 + +! array data + real(4) :: vlatitude(nlongitude,nlatitude) ! value for latitude + real(4) :: vlongitude(nlongitude,nlatitude) ! value for longitude + + real(4) :: tb07(nlongitude,nlatitude) ! tb for band 7 + real(4) :: tb08(nlongitude,nlatitude) ! tb for band 8 + real(4) :: tb09(nlongitude,nlatitude) ! tb for band 9 + real(4) :: tb10(nlongitude,nlatitude) ! tb for band 10 + real(4) :: tb11(nlongitude,nlatitude) ! tb for band 11 + real(4) :: tb12(nlongitude,nlatitude) ! tb for band 12 + real(4) :: tb13(nlongitude,nlatitude) ! tb for band 13 + real(4) :: tb14(nlongitude,nlatitude) ! tb for band 14 + real(4) :: tb15(nlongitude,nlatitude) ! tb for band 15 + real(4) :: tb16(nlongitude,nlatitude) ! tb for band 16 + + real(4) :: sat_zenith(nlongitude,nlatitude) ! satellite_zenith_angle + integer(4) :: cloud_mask(nlongitude,nlatitude) !obs cloud mask + + real(r_kind),parameter :: tbmin = 50._r_kind + real(r_kind),parameter :: tbmax = 550._r_kind + real(r_kind),parameter :: tb_scale = 100._r_kind + + real(kind=8) :: obs_time + type (datalink_type),pointer :: head, p, current, prev + type(info_type) :: info + type(model_loc_type) :: loc + + integer(i_kind) :: idate5(6) + integer(i_kind) :: inst,platform_id,satellite_id,sensor_id + real(r_kind) :: tb, crit + integer(i_kind) :: ifgat, iout, iobs + logical :: outside, outside_all, iuse + + integer :: i,j,k,l,m,n, ifile,landsea_mask + logical :: found, head_found, head_allocated + +! Other work variables + real(r_kind) :: dlon_earth,dlat_earth + integer(i_kind) :: num_ahi_local, num_ahi_global, num_ahi_used, num_ahi_thinned + integer(i_kind) :: num_ahi_used_tmp, num_ahi_file + integer(i_kind) :: num_ahi_local_local, num_ahi_global_local, num_ahi_file_local + integer(i_kind) :: itx, itt + character(80) :: filename1, filename2 + integer :: nchan,ilongitude,ilatitude,ichannels + integer :: nfile + character(80) :: fname_tb(nfile_max) + character(80) :: fname_clp(nfile_max) + logical :: fexist, got_clp_file + +! Allocatable arrays + integer(i_kind),allocatable :: ptotal(:) + real,allocatable :: in(:), out(:) + real(r_kind),allocatable :: data_all(:) + + if (trace_use) call da_trace_entry("da_read_obs_hdf5ahi") + +! 0.0 Initialize variables +!----------------------------------- + head_allocated = .false. + platform_id = 31 ! Table-2 Col 1 corresponding to 'himawari' + satellite_id = 8 ! Table-2 Col 3 + sensor_id = 56 ! Table-3 Col 2 corresponding to 'ahi' + + allocate(ptotal(0:num_fgat_time)) + ptotal(0:num_fgat_time) = 0 + iobs = 0 ! for thinning, argument is inout + num_ahi_file = 0 + num_ahi_local = 0 + num_ahi_global = 0 + num_ahi_used = 0 + num_ahi_thinned = 0 + + sz1(1)=nlongitude + sz1(2)=nlatitude + + do i = 1, rtminit_nsensor + if (platform_id == rtminit_platform(i) & + .and. satellite_id == rtminit_satid(i) & + .and. sensor_id == rtminit_sensor(i)) then + inst = i + exit + end if + end do + if (inst == 0) then + call da_warning(__FILE__,__LINE__, & + (/"The combination of Satellite_Id and Sensor_Id for AHI is not found"/)) + if (trace_use) call da_trace_exit("da_read_obs_hdf5ahi") + return + end if + +! Initialize HDF5 library and Fortran90 interface + call H5open_f(iret) + if(iret.lt.0)then + call da_warning(__FILE__,__LINE__,(/"Problems initializing HDF5 Lib, can't read AHI data."/)) + if (trace_use) call da_trace_exit("da_read_obs_hdf5ahi") + return + endif + + nchan = iv%instid(inst)%nchan + write(unit=stdout,fmt=*)'AHI nchan: ',nchan + allocate(data_all(1:nchan)) + +! 1.0 Assign file names and prepare to read ahi files +!------------------------------------------------------------------------- + nfile = 0 !initialize + fname_tb(:) = '' !initialize + ! first check if hdf file is available + filename1 = trim(infile_tb) + filename2 = trim(infile_clp) + inquire (file=filename1, exist=fexist) + if ( fexist ) then + nfile = 1 + fname_tb(nfile) = filename1 + fname_clp(nfile) = filename2 + else + ! check if L1SGRTBR-0x.h5 is available for multiple input files + ! here 0x is the input file sequence number + ! do not confuse it with fgat time slot index + do i = 1, nfile_max + write(filename1,fmt='(A,A,I2.2,A)') trim(infile_tb),'-',i + write(filename2,fmt='(A,A,I2.2,A)') trim(infile_clp),'-',i + inquire (file=filename1, exist=fexist) + if ( fexist ) then + nfile = nfile + 1 + fname_tb(nfile) = filename1 + fname_clp(nfile) = filename2 + else + exit + end if + end do + end if + + if ( nfile == 0 ) then + call da_warning(__FILE__,__LINE__,(/"No valid AHI file found."/)) + if (trace_use) call da_trace_exit("da_read_obs_hdf5ahi") + return + end if + + !open the data info file + open(unit=1990,file='ahi_info',status='old',iostat=iret) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__,(/"data_info file read error"/)) + endif + read(1990,*) + read(1990,*) + read(1990,*) + read(1990,*) + read(1990,*) + read(1990,*) + read(1990,*) + + infile_loop: do ifile = 1, nfile + num_ahi_file_local = 0 + num_ahi_local_local = 0 + num_ahi_global_local = 0 + + ! open infile_tb HDF5 file for read + call H5Fopen_f(fname_tb(ifile),H5F_ACC_RDONLY_F,fhnd1,iret,H5P_DEFAULT_F) + if(iret.lt.0)then + call da_warning(__FILE__,__LINE__,(/"Cannot open HDF5 file"//trim(fname_tb(ifile))/)) + cycle infile_loop + endif + + ! read lat + call H5Dopen_f(fhnd1,'pixel_latitude',dhnd1,iret) + call H5Dread_f(dhnd1,H5T_IEEE_F32LE,vlatitude,sz1,iret,H5S_ALL_F,H5S_ALL_F) + if(iret.lt.0)then + call da_warning(__FILE__,__LINE__,(/"HDF5 read error for: Latitude"/)) + endif + call H5Dclose_f(dhnd1,iret) + + ! read lon + call H5Dopen_f(fhnd1,'pixel_longitude',dhnd1,iret) + call H5Dread_f(dhnd1,H5T_IEEE_F32LE,vlongitude,sz1,iret,H5S_ALL_F,H5S_ALL_F) + if(iret.lt.0)then + call da_warning(__FILE__,__LINE__,(/"HDF5 read error for: Longitude"/)) + call da_trace_exit("da_read_obs_hdf5ahi") + endif + call H5Dclose_f(dhnd1,iret) + ! sample display + write(unit=stdout,fmt=*)'latitude,longitude(pixel=1,scan=1): ',vlatitude(1,1),vlongitude(1,1) + + ! read tb for band 7 + call H5Dopen_f(fhnd1,'NOMChannelIRX0390_2000',dhnd1,iret) + call H5Dread_f(dhnd1,H5T_NATIVE_REAL,tb07,sz1,iret,H5S_ALL_F,H5S_ALL_F) + if(iret.lt.0)then + call da_warning(__FILE__,__LINE__,(/"HDF5 read error for: Band 7"/)) + endif + call H5Dclose_f(dhnd1,iret) + ! sample display + write(unit=stdout,fmt=*) 'tb07(pixel=1,scan=1): ',tb07(1,1) + + ! read tb for band 8 + call H5Dopen_f(fhnd1,'NOMChannelIRX0620_2000',dhnd1,iret) + call H5Dread_f(dhnd1,H5T_NATIVE_REAL,tb08,sz1,iret,H5S_ALL_F,H5S_ALL_F) + if(iret.lt.0)then + call da_warning(__FILE__,__LINE__,(/"HDF5 read error for: Band 8"/)) + endif + call H5Dclose_f(dhnd1,iret) + ! sample display + write(unit=stdout,fmt=*) 'tb08(pixel=1,scan=1): ',tb08(1,1) + + ! read tb for band 9 + call H5Dopen_f(fhnd1,'NOMChannelIRX0700_2000',dhnd1,iret) + call H5Dread_f(dhnd1,H5T_NATIVE_REAL,tb09,sz1,iret,H5S_ALL_F,H5S_ALL_F) + if(iret.lt.0)then + call da_warning(__FILE__,__LINE__,(/"HDF5 read error for: Band 9"/)) + endif + call H5Dclose_f(dhnd1,iret) + ! sample display + write(unit=stdout,fmt=*) 'tb09(pixel=1,scan=1): ',tb09(1,1) + + ! read tb for band 10 + call H5Dopen_f(fhnd1,'NOMChannelIRX0730_2000',dhnd1,iret) + call H5Dread_f(dhnd1,H5T_NATIVE_REAL,tb10,sz1,iret,H5S_ALL_F,H5S_ALL_F) + if(iret.lt.0)then + call da_warning(__FILE__,__LINE__,(/"HDF5 read error for: Band 10"/)) + endif + call H5Dclose_f(dhnd1,iret) + ! sample display + write(unit=stdout,fmt=*) 'tb10(pixel=1,scan=1): ',tb10(1,1) + + ! read tb for band 11 + call H5Dopen_f(fhnd1,'NOMChannelIRX0860_2000',dhnd1,iret) + call H5Dread_f(dhnd1,H5T_NATIVE_REAL,tb11,sz1,iret,H5S_ALL_F,H5S_ALL_F) + if(iret.lt.0)then + call da_warning(__FILE__,__LINE__,(/"HDF5 read error for: Band 11"/)) + endif + call H5Dclose_f(dhnd1,iret) + ! sample display + write(unit=stdout,fmt=*) 'tb11(pixel=1,scan=1): ',tb11(1,1) + + ! read tb for band 12 + call H5Dopen_f(fhnd1,'NOMChannelIRX0960_2000',dhnd1,iret) + call H5Dread_f(dhnd1,H5T_NATIVE_REAL,tb12,sz1,iret,H5S_ALL_F,H5S_ALL_F) + if(iret.lt.0)then + call da_warning(__FILE__,__LINE__,(/"HDF5 read error for: Band 12"/)) + endif + call H5Dclose_f(dhnd1,iret) + ! sample display + write(unit=stdout,fmt=*) 'tb12(pixel=1,scan=1): ',tb12(1,1) + + ! read tb for band 13 + call H5Dopen_f(fhnd1,'NOMChannelIRX1040_2000',dhnd1,iret) + call H5Dread_f(dhnd1,H5T_NATIVE_REAL,tb13,sz1,iret,H5S_ALL_F,H5S_ALL_F) + if(iret.lt.0)then + call da_warning(__FILE__,__LINE__,(/"HDF5 read error for: 13"/)) + endif + call H5Dclose_f(dhnd1,iret) + ! sample display + write(unit=stdout,fmt=*) 'tb13(pixel=1,scan=1): ',tb13(1,1) + + ! read tb for band 14 + call H5Dopen_f(fhnd1, 'NOMChannelIRX1120_2000',dhnd1,iret) + call H5Dread_f(dhnd1,H5T_NATIVE_REAL,tb14,sz1,iret,H5S_ALL_F,H5S_ALL_F) + if(iret.lt.0)then + call da_warning(__FILE__,__LINE__,(/"HDF5 read error for: Band 14"/)) + endif + call H5Dclose_f(dhnd1,iret) + ! sample display + write(unit=stdout,fmt=*) 'tb14(pixel=1,scan=1): ',tb14(1,1) + + ! read tb for band 15 + call H5Dopen_f(fhnd1,'NOMChannelIRX1230_2000',dhnd1,iret) + call H5Dread_f(dhnd1,H5T_NATIVE_REAL,tb15,sz1,iret,H5S_ALL_F,H5S_ALL_F) + if(iret.lt.0)then + call da_warning(__FILE__,__LINE__,(/"HDF5 read error for: 15"/)) + endif + call H5Dclose_f(dhnd1,iret) + ! sample display + write(unit=stdout,fmt=*) 'tb15(pixel=1,scan=1): ',tb15(1,1) + + ! read tb for band 16 + call H5Dopen_f(fhnd1,'NOMChannelIRX1330_2000',dhnd1,iret) + call H5Dread_f(dhnd1,H5T_NATIVE_REAL,tb16,sz1,iret,H5S_ALL_F,H5S_ALL_F) + if(iret.lt.0)then + call da_warning(__FILE__,__LINE__,(/"HDF5 read error for: 16"/)) + endif + call H5Dclose_f(dhnd1,iret) + ! sample display + write(unit=stdout,fmt=*) 'tb16(pixel=1,scan=1): ',tb16(1,1) + + ! read array: satellite_zenith_angle + ! read + call H5Dopen_f(fhnd1,'pixel_satellite_zenith_angle',dhnd1,iret) + call H5Dread_f(dhnd1,H5T_IEEE_F32LE,sat_zenith,sz1,iret,H5S_ALL_F,H5S_ALL_F) + if(iret.lt.0)then + call da_warning(__FILE__,__LINE__,(/"HDF5 read error for: satellite_zenith_angle"/)) + endif + call H5Dclose_f(dhnd1,iret) + ! sample display + write(unit=stdout,fmt=*)'sat_zenith(pixel=1,scan=1): ',sat_zenith(1,1) + + ! close infile_tb and HDF5 + call H5Fclose_f(fhnd1,iret) + + !open infile_clw file and HDF5 + got_clp_file = .false. + call H5Fopen_f(fname_clp(ifile),H5F_ACC_RDONLY_F,fhnd1,iret,H5P_DEFAULT_F) + if ( iret == 0 ) then + got_clp_file = .true. + endif + ! to do: when got_clp_file=.true., need to check GranuleID for consistency + ! betweee tb and clw files + + if ( got_clp_file ) then + + ! read CLOUD_MASK from infile_clw: + call H5Dopen_f(fhnd1,'cloud_mask',dhnd1,iret) + call H5Dread_f(dhnd1,H5T_NATIVE_INTEGER,cloud_mask,sz1,iret,H5S_ALL_F,H5S_ALL_F) + if(iret.lt.0)then + call da_warning(__FILE__,__LINE__,(/"HDF5 read error for: CLOUD_MASK data"/)) + endif + call H5Dclose_f(dhnd1,iret) + ! sample display + write(unit=stdout,fmt=*)'cloud_mask(pixel=1,scan=1): ',cloud_mask(1,1) + + ! close infile_clw file and HDF5 + call H5Fclose_f(fhnd1,iret) + end if + + !read date information + read(1990,*) idate5(1),idate5(2),idate5(3),idate5(4),idate5(5),idate5(6) + +! 2.0 Loop to read hdf file and assign information to a sequential structure +!------------------------------------------------------------------------- + + ! Allocate arrays to hold data + if ( .not. head_allocated ) then + allocate (head) + nullify ( head % next ) + p => head + head_allocated = .true. + end if + + ! start scan_loop + scan_loop: do ilatitude=1, nlatitude + + call da_get_julian_time(idate5(1),idate5(2),idate5(3),idate5(4),idate5(5),obs_time) + + if ( obs_time < time_slots(0) .or. obs_time >= time_slots(num_fgat_time) ) cycle scan_loop + do ifgat=1,num_fgat_time + if ( obs_time >= time_slots(ifgat-1) .and. obs_time < time_slots(ifgat) ) exit + end do + + ! start fov_loop: longitude + fov_loop: do ilongitude=1, nlongitude + + if ( sat_zenith(ilongitude,ilatitude) > 65.0 ) cycle fov_loop + + num_ahi_file = num_ahi_file + 1 + num_ahi_file_local = num_ahi_file_local + 1 + info%lat = vlatitude(ilongitude,ilatitude) + info%lon = vlongitude(ilongitude,ilatitude) + + call da_llxy (info, loc, outside, outside_all) + if (outside_all) cycle fov_loop + + num_ahi_global = num_ahi_global + 1 + num_ahi_global_local = num_ahi_global_local + 1 + ptotal(ifgat) = ptotal(ifgat) + 1 + if (outside) cycle fov_loop ! No good for this PE + + num_ahi_local = num_ahi_local + 1 + num_ahi_local_local = num_ahi_local_local + 1 + write(unit=info%date_char, & + fmt='(i4.4,a,i2.2,a,i2.2,a,i2.2,a,i2.2,a,i2.2)') & + idate5(1), '-', idate5(2), '-', idate5(3), '_', idate5(4), & + ':', idate5(5), ':', idate5(6) + info%elv = 0.0 + +! 3.0 Make Thinning +! Map obs to thinning grid +!------------------------------------------------------------------- + if (thinning) then + dlat_earth = info%lat !degree + dlon_earth = info%lon + if (dlon_earth=r360) dlon_earth = dlon_earth-r360 + dlat_earth = dlat_earth*deg2rad !radian + dlon_earth = dlon_earth*deg2rad + crit = 1. + call map2grids(inst,ifgat,dlat_earth,dlon_earth,crit,iobs,itx,1,itt,iout,iuse) + if (.not. iuse) then + num_ahi_thinned = num_ahi_thinned+1 + cycle fov_loop + end if + end if + + num_ahi_used = num_ahi_used + 1 + data_all = missing_r + + tb = tb07(ilongitude,ilatitude) / tb_scale + if( tb < tbmin .or. tb > tbmax ) tb = missing_r + data_all(1)= tb + + tb = tb08(ilongitude,ilatitude) / tb_scale + if( tb < tbmin .or. tb > tbmax ) tb = missing_r + data_all(2)= tb + + tb = tb09(ilongitude,ilatitude) / tb_scale + if( tb < tbmin .or. tb > tbmax ) tb = missing_r + data_all(3)= tb + + tb = tb10(ilongitude,ilatitude) / tb_scale + if( tb < tbmin .or. tb > tbmax ) tb = missing_r + data_all(4)= tb + + tb = tb11(ilongitude,ilatitude) / tb_scale + if( tb < tbmin .or. tb > tbmax ) tb = missing_r + data_all(5)= tb + + tb = tb12(ilongitude,ilatitude) / tb_scale + if( tb < tbmin .or. tb > tbmax ) tb = missing_r + data_all(6)= tb + + tb = tb13(ilongitude,ilatitude) / tb_scale + if( tb < tbmin .or. tb > tbmax ) tb = missing_r + data_all(7)= tb + + tb = tb14(ilongitude,ilatitude) / tb_scale + if( tb < tbmin .or. tb > tbmax ) tb = missing_r + data_all(8)= tb + + tb = tb15(ilongitude,ilatitude) / tb_scale + if( tb < tbmin .or. tb > tbmax ) tb = missing_r + data_all(9)= tb + + tb = tb16(ilongitude,ilatitude) / tb_scale + if( tb < tbmin .or. tb > tbmax ) tb = missing_r + data_all(10)= tb + +! 4.0 assign information to sequential radiance structure +!-------------------------------------------------------------------------- + allocate ( p % tb_inv (1:nchan )) + p%info = info + p%loc = loc + p%landsea_mask = 1 + p%scanpos = ilongitude !nint(sat_zenith(ilongitude,ilatitude))+1.001_r_kind ! + p%satzen = sat_zenith(ilongitude,ilatitude) + p%satazi = 0 + p%solzen = 0 + p%solazi = 0 + p%cloudflag = cloud_mask(ilongitude,ilatitude) + p%tb_inv(1:nchan) = data_all(1:nchan) + p%sensor_index = inst + p%ifgat = ifgat + + allocate (p%next) ! add next data + p => p%next + nullify (p%next) + end do fov_loop + end do scan_loop + + write(stdout,fmt='(3a,i7)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_file : ',num_ahi_file_local + write(stdout,fmt='(3a,i7)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_global : ',num_ahi_global_local + write(stdout,fmt='(3a,i7)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_local : ',num_ahi_local_local + end do infile_loop + + close(1990) !close date information file + call H5close_f(iret) + deallocate(data_all) ! Deallocate data arrays + + if (thinning .and. num_ahi_global > 0 ) then +#ifdef DM_PARALLEL + ! Get minimum crit and associated processor index. + j = 0 + do ifgat = 1, num_fgat_time + j = j + thinning_grid(inst,ifgat)%itxmax + end do + + allocate ( in (j) ) + allocate ( out (j) ) + j = 0 + do ifgat = 1, num_fgat_time + do i = 1, thinning_grid(inst,ifgat)%itxmax + j = j + 1 + in(j) = thinning_grid(inst,ifgat)%score_crit(i) + end do + end do + call mpi_reduce(in, out, j, true_mpi_real, mpi_min, root, comm, ierr) + + call wrf_dm_bcast_real (out, j) + + j = 0 + do ifgat = 1, num_fgat_time + do i = 1, thinning_grid(inst,ifgat)%itxmax + j = j + 1 + if ( ABS(out(j)-thinning_grid(inst,ifgat)%score_crit(i)) > 1.0E-10 ) & + thinning_grid(inst,ifgat)%ibest_obs(i) = 0 + end do + end do + + deallocate( in ) + deallocate( out ) + +#endif + + ! Delete the nodes which being thinning out + p => head + prev => head + head_found = .false. + num_ahi_used_tmp = num_ahi_used + do j = 1, num_ahi_used_tmp + n = p%sensor_index + ifgat = p%ifgat + found = .false. + + do i = 1, thinning_grid(n,ifgat)%itxmax + if ( thinning_grid(n,ifgat)%ibest_obs(i) == j .and. thinning_grid(n,ifgat)%score_crit(i) < 9.99e6_r_kind ) then + found = .true. + exit + end if + end do + + ! free current data + if ( .not. found ) then + current => p + p => p%next + if ( head_found ) then + prev%next => p + else + head => p + prev => p + end if + deallocate ( current % tb_inv ) + deallocate ( current ) + num_ahi_thinned = num_ahi_thinned + 1 + num_ahi_used = num_ahi_used - 1 + continue + end if + + if ( found .and. head_found ) then + prev => p + p => p%next + continue + end if + + if ( found .and. .not. head_found ) then + head_found = .true. + head => p + prev => p + p => p%next + end if + + end do + + end if ! End of thinning + + iv%total_rad_pixel = iv%total_rad_pixel + num_ahi_used + iv%total_rad_channel = iv%total_rad_channel + num_ahi_used*nchan + + iv%info(radiance)%nlocal = iv%info(radiance)%nlocal + num_ahi_used + iv%info(radiance)%ntotal = iv%info(radiance)%ntotal + num_ahi_global + + do i = 1, num_fgat_time + ptotal(i) = ptotal(i) + ptotal(i-1) + iv%info(radiance)%ptotal(i) = iv%info(radiance)%ptotal(i) + ptotal(i) + end do + if ( iv%info(radiance)%ptotal(num_fgat_time) /= iv%info(radiance)%ntotal ) then + write(unit=message(1),fmt='(A,I10,A,I10)') & + "Number of ntotal:",iv%info(radiance)%ntotal," is different from the sum of ptotal:", iv%info(radiance)%ptotal(num_fgat_time) + call da_warning(__FILE__,__LINE__,message(1:1)) + endif + + write(unit=stdout,fmt='(a)') 'AHI data counts: ' + write(stdout,fmt='(a,i7)') ' In file: ',num_ahi_file + write(stdout,fmt='(a,i7)') ' Global : ',num_ahi_global + write(stdout,fmt='(a,i7)') ' Local : ',num_ahi_local + write(stdout,fmt='(a,i7)') ' Used : ',num_ahi_used + write(stdout,fmt='(a,i7)') ' Thinned: ',num_ahi_thinned + + +! 5.0 allocate innovation radiance structure +!---------------------------------------------------------------- + + if (num_ahi_used > 0) then + iv%instid(inst)%num_rad = num_ahi_used + iv%instid(inst)%info%nlocal = num_ahi_used + write(UNIT=stdout,FMT='(a,i3,2x,a,3x,i10)') & + 'Allocating space for radiance innov structure', & + inst, iv%instid(inst)%rttovid_string, iv%instid(inst)%num_rad + call da_allocate_rad_iv (inst, nchan, iv) + end if + +! 6.0 assign sequential structure to innovation structure +!------------------------------------------------------------- + p => head + + do n = 1, num_ahi_used + i = p%sensor_index + call da_initialize_rad_iv (i, n, iv, p) + current => p + p => p%next + ! free current data + deallocate ( current % tb_inv ) + deallocate ( current ) + end do + deallocate ( p ) + deallocate (ptotal) + + if (trace_use) call da_trace_exit("da_read_obs_hdf5ahi") +#else + call da_error(__FILE__,__LINE__,(/"Needs to be compiled with HDF5 library"/)) +#endif +end subroutine da_read_obs_hdf5ahi diff --git a/var/da/da_radiance/da_read_obs_netcdf4ahi_geocat.inc b/var/da/da_radiance/da_read_obs_netcdf4ahi_geocat.inc new file mode 100644 index 0000000000..9963de61e2 --- /dev/null +++ b/var/da/da_radiance/da_read_obs_netcdf4ahi_geocat.inc @@ -0,0 +1,590 @@ +subroutine da_read_obs_netcdf4ahi_geocat (iv, infile_tb, infile_clp) + !-------------------------------------------------------- + ! Purpose: read in GEOCAT AHI Level-1 and Level-2 data in NETCDF4 format + ! and form innovation structure + ! + ! METHOD: use F90 sequantial data structure to avoid read the file twice + ! 1. read file radiance data in sequential data structure + ! 2. do gross QC check + ! 3. assign sequential data structure to innovation structure + ! and deallocate sequential data structure + ! + ! HISTORY: 2016/10/22 - Creation Yuanbing Wang, NUIST/CAS, NCAR/NESL/MMM/DAS + ! To be devoloped: 1.time information; 2.dimension sequence + !------------------------------------------------------------------------------ + + use netcdf + implicit none + + character(len=*), intent(in) :: infile_tb, infile_clp + type(iv_type), intent(inout) :: iv + +! fixed parameter values + integer,parameter::time_dims=6 ! Time dimension + integer,parameter::nfile_max = 8 ! each netcdf file contains + real,parameter::add_offset_tb1=285.0 + real,parameter::add_offset_tb2=235.0 + real,parameter::add_offset_tb3=260.0 + real,parameter::add_offset_tb4=240.0 + real,parameter::add_offset_saz=90.0 + real,parameter::scale_factor_tb1=0.00350962858973968 + real,parameter::scale_factor_tb2=0.00198370311593982 + real,parameter::scale_factor_tb3=0.00274666585283975 + real,parameter::scale_factor_tb4=0.00213629566331980 + real,parameter::scale_factor_lat=0.00274666585283975 + real,parameter::scale_factor_lon=0.00549333170567949 + real,parameter::scale_factor_saz=0.00274666585283975 + +! interface variable + integer iret, rcode, ncid ! return status + +! array data + real(4), allocatable :: vlatitude(:,:) ! value for latitude + real(4), allocatable :: vlongitude(:,:) ! value for longitude + + real(4), allocatable :: tbb(:,:,:) ! tb for band 7-16 + real(4), allocatable :: sat_zenith(:,:) + + byte, allocatable ::cloud_mask(:,:) + + real(r_kind),parameter :: tbmin = 50._r_kind + real(r_kind),parameter :: tbmax = 550._r_kind + + real(kind=8) :: obs_time + type (datalink_type),pointer :: head, p, current, prev + type(info_type) :: info + type(model_loc_type) :: loc + + integer(i_kind) :: idate5(6) + character(len=80) :: filename,str_tmp + + integer(i_kind) :: inst,platform_id,satellite_id,sensor_id + real(r_kind) :: tb, crit + integer(i_kind) :: ifgat, iout, iobs + logical :: outside, outside_all, iuse + + integer :: i,j,k,l,m,n, ifile, landsea_mask + logical :: found, head_found, head_allocated + +! Other work variables + real(r_kind) :: dlon_earth,dlat_earth + integer(i_kind) :: num_ahi_local, num_ahi_global, num_ahi_used, num_ahi_thinned + integer(i_kind) :: num_ahi_used_tmp, num_ahi_file + integer(i_kind) :: num_ahi_local_local, num_ahi_global_local, num_ahi_file_local + integer(i_kind) :: itx, itt + character(80) :: filename1,filename2 + integer :: nchan,nlongitude,nlatitude,ilongitude,ilatitude,ichannels + integer :: lonstart,latstart + integer :: LatDimID,LonDimID + integer :: latid,lonid,tbb_id,sazid,cltyid + integer :: nfile + character(80) :: fname_tb(nfile_max),fname_clp(nfile_max) + integer :: vtype + character(80) :: vname + logical :: fexist,got_clp_file + +! Allocatable arrays + integer(i_kind),allocatable :: ptotal(:) + real,allocatable :: in(:), out(:) + real(r_kind),allocatable :: data_all(:) + + character(len=80) tbb_name(10) + data tbb_name/'himawari_8_ahi_channel_7_brightness_temperature',& + 'himawari_8_ahi_channel_8_brightness_temperature',& + 'himawari_8_ahi_channel_9_brightness_temperature',& + 'himawari_8_ahi_channel_10_brightness_temperature',& + 'himawari_8_ahi_channel_11_brightness_temperature',& + 'himawari_8_ahi_channel_12_brightness_temperature',& + 'himawari_8_ahi_channel_13_brightness_temperature',& + 'himawari_8_ahi_channel_14_brightness_temperature',& + 'himawari_8_ahi_channel_15_brightness_temperature',& + 'himawari_8_ahi_channel_16_brightness_temperature'/ + + if (trace_use) call da_trace_entry("da_read_obs_netcdf4ahi_geocat") + +! 0.0 Initialize variables +!----------------------------------- + head_allocated = .false. + platform_id = 31 ! Table-2 Col 1 corresponding to 'himawari' + satellite_id = 8 ! Table-2 Col 3 + sensor_id = 56 ! Table-3 Col 2 corresponding to 'ahi' + + allocate(ptotal(0:num_fgat_time)) + ptotal(0:num_fgat_time) = 0 + iobs = 0 ! for thinning, argument is inout + num_ahi_file = 0 + num_ahi_local = 0 + num_ahi_global = 0 + num_ahi_used = 0 + num_ahi_thinned = 0 + + do i = 1, rtminit_nsensor + if (platform_id == rtminit_platform(i) & + .and. satellite_id == rtminit_satid(i) & + .and. sensor_id == rtminit_sensor(i)) then + inst = i + exit + end if + end do + if (inst == 0) then + call da_warning(__FILE__,__LINE__, & + (/"The combination of Satellite_Id and Sensor_Id for AHI is not found"/)) + if (trace_use) call da_trace_exit("da_read_obs_netcdf4ahi_geocat") + return + end if + + nchan = iv%instid(inst)%nchan + write(unit=stdout,fmt=*)'AHI nchan: ',nchan + allocate(data_all(1:nchan)) + +! 1.0 Assign file names and prepare to read ahi files +!------------------------------------------------------------------------- + nfile = 0 !initialize + fname_tb(:) = '' !initialize + + ! first check if ahi nc file is available + filename1 = trim(infile_tb) + filename2 = trim(infile_clp) + inquire (file=filename1, exist=fexist) + if ( fexist ) then + nfile = 1 + fname_tb(nfile) = filename1 + fname_clp(nfile) = filename2 + else + ! check if netcdf4 files are available for multiple input files + ! here 0x is the input file sequence number + ! do not confuse it with fgat time slot index + do i = 1, nfile_max + write(filename1,fmt='(A,A,I2.2,A)') trim(infile_tb),'-',i + write(filename2,fmt='(A,A,I2.2,A)') trim(infile_clp),'-',i + inquire (file=filename1, exist=fexist) + if ( fexist ) then + nfile = nfile + 1 + fname_tb(nfile) = filename1 + fname_clp(nfile) = filename2 + else + exit + end if + end do + end if + + if ( nfile == 0 ) then + call da_warning(__FILE__,__LINE__, & + (/"No valid AHI file found."/)) + if (trace_use) call da_trace_exit("da_read_obs_netcdf4ahi_geocat") + return + end if + + + !open the data area info file + open(unit=1990,file='ahi_info',status='old',iostat=iret) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__,(/"area_info file read error"/)) + endif + !read date information + read(1990,*) + read(1990,*) + read(1990,*) + read(1990,*) + read(1990,*) + read(1990,*) lonstart,latstart,nlongitude,nlatitude + close(1990) + + write(*,*) lonstart,latstart,nlongitude,nlatitude + + infile_loop: do ifile = 1, nfile + num_ahi_file_local = 0 + num_ahi_local_local = 0 + num_ahi_global_local = 0 + + ! open NETCDF4 L1 file for read + iret = nf90_open(fname_tb(ifile), nf90_NOWRITE, ncid) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"Cannot open NETCDF4 file "//trim(fname_tb(ifile))/)) + cycle infile_loop + endif + + ! read dimensions: latitude and longitude + ! iret = nf90_inq_dimid(ncid, "lines", LatDimID) + ! iret = nf90_inquire_dimension(ncid, LatDimID, len=nlatitude) + + ! iret = nf90_inq_dimid(ncid, "elements", LonDimID) + ! iret = nf90_inquire_dimension(ncid, LonDimID, len=nlongitude) + + ! write(unit=stdout,fmt=*) nlongitude,nlatitude + + + ! read array: time + iret = nf90_get_att(ncid, nf90_global, "Image_Date_Time", filename) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: observation date"/)) + end if + read(filename,"(I4,A1,I2,A1,I2,A1,I2,A1,I2,A1,I2,A1)") idate5(1),str_tmp,idate5(2),str_tmp,& + idate5(3),str_tmp,idate5(4),str_tmp,idate5(5),str_tmp,idate5(6),str_tmp + write(unit=stdout,fmt=*)'observation date: ', idate5 + + ! read array: lat + ! read lat + iret = nf90_inq_varid(ncid, 'pixel_latitude', latid) + allocate(vlatitude(nlongitude,nlatitude)) + iret = nf90_get_var(ncid,latid,vlatitude,start=(/lonstart,latstart/), & + count=(/nlongitude,nlatitude/)) ! + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: Latitude of Observation Point"/)) + endif + do j=1,nlatitude + do i=1,nlongitude + vlatitude(i,j)=vlatitude(i,j) * scale_factor_lat + end do + end do + ! sample display + write(unit=stdout,fmt=*)'vlatitude(pixel=1,scan=1): ',vlatitude(1,1) + + ! read lon + iret = nf90_inq_varid(ncid, 'pixel_longitude', lonid) + allocate(vlongitude(nlongitude,nlatitude)) + iret = nf90_get_var(ncid,lonid,vlongitude,start=(/lonstart,latstart/), & + count=(/nlongitude,nlatitude/)) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: Longitude of Observation Point"/)) + call da_trace_exit("da_read_obs_netcdf4ahi_geocat") + endif + do j=1,nlatitude + do i=1,nlongitude + vlongitude(i,j)=vlongitude(i,j) * scale_factor_lon + end do + end do + ! sample display + write(unit=stdout,fmt=*)'vlongitude(pixel=1,scan=1): ',vlongitude(1,1) + + ! read array: tb for band 7-16 + ! read + allocate(tbb(nlongitude,nlatitude,nchan)) + do k=1,nchan + iret = nf90_inq_varid(ncid, tbb_name(k), tbb_id) + iret = nf90_get_var(ncid,tbb_id,tbb(:,:,k),start=(/lonstart,latstart/), & + count=(/nlongitude,nlatitude/)) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: Brightness Temperature"/)) + endif + do j=1,nlatitude + do i=1,nlongitude + if(k==1) then + tbb(i,j,k)=tbb(i,j,k) * scale_factor_tb1 + add_offset_tb1 + end if + if(k>=2 .and. k<=4) then + tbb(i,j,k)=tbb(i,j,k) * scale_factor_tb2 + add_offset_tb2 + end if + if(k>=5 .and. k<=9) then + tbb(i,j,k)=tbb(i,j,k) * scale_factor_tb3 + add_offset_tb3 + end if + if(k==10) then + tbb(i,j,k)=tbb(i,j,k) * scale_factor_tb4 + add_offset_tb4 + end if + end do + end do + ! sample display + write(unit=stdout,fmt=*) 'tbb(pixel=1,scan=1,chan=',k,'): ', tbb(1,1,k) + end do + + ! read array: satellite zenith angle + ! read + iret = nf90_inq_varid(ncid, 'pixel_satellite_zenith_angle', sazid) + allocate(sat_zenith(nlongitude,nlatitude)) + iret = nf90_get_var(ncid,sazid,sat_zenith,start=(/lonstart,latstart/), & + count=(/nlongitude,nlatitude/)) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: satellite zenith angle"/)) + endif + do j=1,nlatitude + do i=1,nlongitude + sat_zenith(i,j)=sat_zenith(i,j) * scale_factor_saz + add_offset_saz + end do + end do + ! sample display + write(unit=stdout,fmt=*) 'satellite zenith angle(pixel=1,scan=1): ',sat_zenith(1,1) + + ! close infile_tb file + iret = nf90_close(ncid) + + !open infile_clp file + got_clp_file = .false. + iret = nf90_open(fname_clp(ifile), nf90_NOWRITE, ncid) + if ( iret == 0 ) then + got_clp_file = .true. + endif + + if ( got_clp_file ) then + ! read array: eps_cmask_ahi_cloud_mask + rcode = nf90_inq_varid(ncid, "eps_cmask_ahi_cloud_mask", cltyid) + allocate(cloud_mask(nlongitude,nlatitude)) + iret = nf90_get_var(ncid,cltyid,cloud_mask,start=(/lonstart,latstart/), & + count=(/nlongitude,nlatitude/)) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__,(/"NETCDF4 read error for: CLTYPE data"/)) + endif + ! sample display + write(unit=stdout,fmt=*)'cloud_mask(pixel=1,scan=1): ',cloud_mask(1,1) + ! close infile_clp file + iret = nf90_close(ncid) + end if + +! 2.0 Loop to read netcdf and assign information to a sequential structure +!------------------------------------------------------------------------- + + ! Allocate arrays to hold data + if ( .not. head_allocated ) then + allocate (head) + nullify ( head % next ) + p => head + head_allocated = .true. + end if + + ! start scan_loop + scan_loop: do ilatitude=1, nlatitude + + call da_get_julian_time(idate5(1),idate5(2),idate5(3),idate5(4),idate5(5),obs_time) + if ( obs_time < time_slots(0) .or. & + obs_time >= time_slots(num_fgat_time) ) cycle scan_loop + do ifgat=1,num_fgat_time + if ( obs_time >= time_slots(ifgat-1) .and. & + obs_time < time_slots(ifgat) ) exit + end do + + ! start fov_loop + fov_loop: do ilongitude=1, nlongitude + + if ( sat_zenith(ilongitude,ilatitude) > 65.0 ) cycle fov_loop + + num_ahi_file = num_ahi_file + 1 + num_ahi_file_local = num_ahi_file_local + 1 + info%lat = vlatitude(ilongitude,ilatitude) + info%lon = vlongitude(ilongitude,ilatitude) + + call da_llxy (info, loc, outside, outside_all) + if (outside_all) cycle fov_loop + + num_ahi_global = num_ahi_global + 1 + num_ahi_global_local = num_ahi_global_local + 1 + ptotal(ifgat) = ptotal(ifgat) + 1 + if (outside) cycle fov_loop ! No good for this PE + + num_ahi_local = num_ahi_local + 1 + num_ahi_local_local = num_ahi_local_local + 1 + write(unit=info%date_char, & + fmt='(i4.4,a,i2.2,a,i2.2,a,i2.2,a,i2.2,a,i2.2)') & + idate5(1), '-', idate5(2), '-', idate5(3), '_', idate5(4), & + ':', idate5(5), ':', idate5(6) + info%elv = 0.0 + +! 3.0 Make Thinning +! Map obs to thinning grid +!------------------------------------------------------------------- + if (thinning) then + dlat_earth = info%lat !degree + dlon_earth = info%lon + if (dlon_earth=r360) dlon_earth = dlon_earth-r360 + dlat_earth = dlat_earth*deg2rad !radian + dlon_earth = dlon_earth*deg2rad + crit = 1. + call map2grids(inst,ifgat,dlat_earth,dlon_earth,crit,iobs,itx,1,itt,iout,iuse) + if (.not. iuse) then + num_ahi_thinned = num_ahi_thinned+1 + cycle fov_loop + end if + end if + + num_ahi_used = num_ahi_used + 1 + data_all = missing_r + + do k=1,nchan + tb = tbb(ilongitude,ilatitude,k) + if( tb < tbmin .or. tb > tbmax ) tb = missing_r + data_all(k)= tb + enddo + +! 4.0 assign information to sequential radiance structure +!-------------------------------------------------------------------------- + allocate ( p % tb_inv (1:nchan )) + p%info = info + p%loc = loc + p%landsea_mask = 1 + p%scanpos = ilongitude !nint(sat_zenith(ilongitude,ilatitude))+1.001_r_kind ! + p%satzen = sat_zenith(ilongitude,ilatitude) + p%satazi = 0 + p%solzen = 0 + p%solazi = 0 + p%tb_inv(1:nchan) = data_all(1:nchan) + p%sensor_index = inst + p%ifgat = ifgat + p%cloudflag = cloud_mask(ilongitude,ilatitude) + + allocate (p%next) ! add next data + p => p%next + nullify (p%next) + end do fov_loop + end do scan_loop + + write(stdout,fmt='(3a,i10)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_file : ',num_ahi_file_local + write(stdout,fmt='(3a,i10)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_global : ',num_ahi_global_local + write(stdout,fmt='(3a,i10)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_local : ',num_ahi_local_local + end do infile_loop + + deallocate(data_all) ! Deallocate data arrays + !deallocate(cloudflag) + deallocate(vlatitude) + deallocate(vlongitude) + deallocate(tbb) + deallocate(sat_zenith) + if( got_clp_file ) deallocate(cloud_mask) + + if (thinning .and. num_ahi_global > 0 ) then +#ifdef DM_PARALLEL + ! Get minimum crit and associated processor index. + j = 0 + do ifgat = 1, num_fgat_time + j = j + thinning_grid(inst,ifgat)%itxmax + end do + + allocate ( in (j) ) + allocate ( out (j) ) + j = 0 + do ifgat = 1, num_fgat_time + do i = 1, thinning_grid(inst,ifgat)%itxmax + j = j + 1 + in(j) = thinning_grid(inst,ifgat)%score_crit(i) + end do + end do + call mpi_reduce(in, out, j, true_mpi_real, mpi_min, root, comm, ierr) + + call wrf_dm_bcast_real (out, j) + + j = 0 + do ifgat = 1, num_fgat_time + do i = 1, thinning_grid(inst,ifgat)%itxmax + j = j + 1 + if ( ABS(out(j)-thinning_grid(inst,ifgat)%score_crit(i)) > 1.0E-10 ) & + thinning_grid(inst,ifgat)%ibest_obs(i) = 0 + end do + end do + + deallocate( in ) + deallocate( out ) + +#endif + + ! Delete the nodes which being thinning out + p => head + prev => head + head_found = .false. + num_ahi_used_tmp = num_ahi_used + do j = 1, num_ahi_used_tmp + n = p%sensor_index + ifgat = p%ifgat + found = .false. + + do i = 1, thinning_grid(n,ifgat)%itxmax + if ( thinning_grid(n,ifgat)%ibest_obs(i) == j .and. thinning_grid(n,ifgat)%score_crit(i) < 9.99e6_r_kind ) then + found = .true. + exit + end if + end do + + ! free current data + if ( .not. found ) then + + current => p + p => p%next + + if ( head_found ) then + prev%next => p + else + head => p + prev => p + end if + + deallocate ( current % tb_inv ) + deallocate ( current ) + + num_ahi_thinned = num_ahi_thinned + 1 + num_ahi_used = num_ahi_used - 1 + continue + end if + + if ( found .and. head_found ) then + prev => p + p => p%next + continue + end if + + if ( found .and. .not. head_found ) then + head_found = .true. + head => p + prev => p + p => p%next + end if + + end do + end if ! End of thinning + + iv%total_rad_pixel = iv%total_rad_pixel + num_ahi_used + iv%total_rad_channel = iv%total_rad_channel + num_ahi_used*nchan + + iv%info(radiance)%nlocal = iv%info(radiance)%nlocal + num_ahi_used + iv%info(radiance)%ntotal = iv%info(radiance)%ntotal + num_ahi_global + + do i = 1, num_fgat_time + ptotal(i) = ptotal(i) + ptotal(i-1) + iv%info(radiance)%ptotal(i) = iv%info(radiance)%ptotal(i) + ptotal(i) + end do + if ( iv%info(radiance)%ptotal(num_fgat_time) /= iv%info(radiance)%ntotal ) then + write(unit=message(1),fmt='(A,I10,A,I10)') & + "Number of ntotal:",iv%info(radiance)%ntotal," is different from the sum of ptotal:", iv%info(radiance)%ptotal(num_fgat_time) + call da_warning(__FILE__,__LINE__,message(1:1)) + endif + + write(unit=stdout,fmt='(a)') 'AHI data counts: ' + write(stdout,fmt='(a,i10)') ' In file: ',num_ahi_file + write(stdout,fmt='(a,i10)') ' Global : ',num_ahi_global + write(stdout,fmt='(a,i10)') ' Local : ',num_ahi_local + write(stdout,fmt='(a,i10)') ' Used : ',num_ahi_used + write(stdout,fmt='(a,i10)') ' Thinned: ',num_ahi_thinned + +! 5.0 allocate innovation radiance structure +!---------------------------------------------------------------- + + if (num_ahi_used > 0) then + iv%instid(inst)%num_rad = num_ahi_used + iv%instid(inst)%info%nlocal = num_ahi_used + write(UNIT=stdout,FMT='(a,i3,2x,a,3x,i10)') & + 'Allocating space for radiance innov structure', & + inst, iv%instid(inst)%rttovid_string, iv%instid(inst)%num_rad + call da_allocate_rad_iv (inst, nchan, iv) + end if + +! 6.0 assign sequential structure to innovation structure +!------------------------------------------------------------- + p => head + + do n = 1, num_ahi_used + i = p%sensor_index + call da_initialize_rad_iv (i, n, iv, p) + current => p + p => p%next + ! free current data + deallocate ( current % tb_inv ) + deallocate ( current ) + end do + deallocate ( p ) + deallocate (ptotal) + + if (trace_use) call da_trace_exit("da_read_obs_netcdf4ahi_geocat") + +end subroutine da_read_obs_netcdf4ahi_geocat diff --git a/var/da/da_radiance/da_read_obs_netcdf4ahi_jaxa.inc b/var/da/da_radiance/da_read_obs_netcdf4ahi_jaxa.inc new file mode 100644 index 0000000000..c55b78d757 --- /dev/null +++ b/var/da/da_radiance/da_read_obs_netcdf4ahi_jaxa.inc @@ -0,0 +1,521 @@ +subroutine da_read_obs_netcdf4ahi_jaxa (iv, infile_tb, infile_clp) + !-------------------------------------------------------- + ! Purpose: read in JAXA AHI Level-1 and Level-2 data in NETCDF4 format + ! and form innovation structure + ! + ! METHOD: use F90 sequantial data structure to avoid read the file twice + ! 1. read file radiance data in sequential data structure + ! 2. do gross QC check + ! 3. assign sequential data structure to innovation structure + ! and deallocate sequential data structure + ! + ! HISTORY: 2016/10/22 - Creation Yuanbing Wang, NUIST/CAS, NCAR/NESL/MMM/DAS + ! To be devoloped: 1.time information; 2.dimension sequence + !------------------------------------------------------------------------------ + + use netcdf + + implicit none + + character(len=*), intent(in) :: infile_tb, infile_clp + type(iv_type), intent(inout) :: iv + +! fixed parameter values + integer,parameter::time_dims=6 ! Time dimension + integer,parameter::nfile_max = 8 ! each netcdf file contains + real,parameter::scale_factor_tb=0.01 ! Maximum allowed NumberOfScans + real,parameter::add_offset_tb=273.15 ! low resolution pixel width + +! interface variable + integer iret, rcode, ncid ! return status + +! array data + real(4), allocatable :: vlatitude(:) ! value for latitude + real(4), allocatable :: vlongitude(:) ! value for longitude + + real(4), allocatable :: tbb(:,:,:) ! tb for band 7-16 + real(4), allocatable :: sat_zenith(:,:) + integer(2), allocatable :: cloud_type(:,:) + + real(r_kind),parameter :: tbmin = 50._r_kind + real(r_kind),parameter :: tbmax = 550._r_kind + + real(kind=8) :: obs_time + type (datalink_type),pointer :: head, p, current, prev + type(info_type) :: info + type(model_loc_type) :: loc + + integer(i_kind) :: idate5(6) + character(len=80) :: filename,str1,str2 + + integer(i_kind) :: inst,platform_id,satellite_id,sensor_id + real(r_kind) :: tb, crit + integer(i_kind) :: ifgat, iout, iobs + logical :: outside, outside_all, iuse + + integer :: i,j,k,l,m,n, ifile, landsea_mask + logical :: found, head_found, head_allocated + +! Other work variables + real(r_kind) :: dlon_earth,dlat_earth + integer(i_kind) :: num_ahi_local, num_ahi_global, num_ahi_used, num_ahi_thinned + integer(i_kind) :: num_ahi_used_tmp, num_ahi_file + integer(i_kind) :: num_ahi_local_local, num_ahi_global_local, num_ahi_file_local + integer(i_kind) :: itx, itt + character(80) :: filename1,filename2 + integer :: nchan,nlongitude,nlatitude,ilongitude,ilatitude,ichannels + integer :: LatDimID,LonDimID + integer :: latid,lonid,tbb_id,sazid,cltyid + integer :: nfile + character(80) :: fname_tb(nfile_max),fname_clp(nfile_max) + logical :: fexist, got_clp_file + +! Allocatable arrays + integer(i_kind),allocatable :: ptotal(:) + real,allocatable :: in(:), out(:) + real(r_kind),allocatable :: data_all(:) + + character(len=80) tbb_name(10) + data tbb_name/'tbb_07','tbb_08','tbb_09','tbb_10','tbb_11', & + 'tbb_12','tbb_13','tbb_14','tbb_15','tbb_16'/ + + if (trace_use) call da_trace_entry("da_read_obs_netcdf4ahi_jaxa") + +! 0.0 Initialize variables +!----------------------------------- + head_allocated = .false. + platform_id = 31 ! Table-2 Col 1 corresponding to 'himawari' + satellite_id = 8 ! Table-2 Col 3 + sensor_id = 56 ! Table-3 Col 2 corresponding to 'ahi' + + allocate(ptotal(0:num_fgat_time)) + ptotal(0:num_fgat_time) = 0 + iobs = 0 ! for thinning, argument is inout + num_ahi_file = 0 + num_ahi_local = 0 + num_ahi_global = 0 + num_ahi_used = 0 + num_ahi_thinned = 0 + + do i = 1, rtminit_nsensor + if (platform_id == rtminit_platform(i) & + .and. satellite_id == rtminit_satid(i) & + .and. sensor_id == rtminit_sensor(i)) then + inst = i + exit + end if + end do + if (inst == 0) then + call da_warning(__FILE__,__LINE__, & + (/"The combination of Satellite_Id and Sensor_Id for AHI is not found"/)) + if (trace_use) call da_trace_exit("da_read_obs_netcdf4ahi_jaxa") + return + end if + + nchan = iv%instid(inst)%nchan + write(unit=stdout,fmt=*)'AHI nchan: ',nchan + allocate(data_all(1:nchan)) + +! 1.0 Assign file names and prepare to read ahi files +!------------------------------------------------------------------------- + nfile = 0 !initialize + fname_tb(:) = '' !initialize + + ! first check if ahi nc file is available + filename1 = trim(infile_tb) + filename2 = trim(infile_clp) + inquire (file=filename1, exist=fexist) + if ( fexist ) then + nfile = 1 + fname_tb(nfile) = filename1 + fname_clp(nfile) = filename2 + else + ! check if netcdf4 files are available for multiple input files + ! here 0x is the input file sequence number + ! do not confuse it with fgat time slot index + do i = 1, nfile_max + write(filename1,fmt='(A,A,I2.2,A)') trim(infile_tb),'-',i + write(filename2,fmt='(A,A,I2.2,A)') trim(infile_clp),'-',i + inquire (file=filename1, exist=fexist) + if ( fexist ) then + nfile = nfile + 1 + fname_tb(nfile) = filename1 + fname_clp(nfile) = filename2 + else + exit + end if + end do + end if + + if ( nfile == 0 ) then + call da_warning(__FILE__,__LINE__, & + (/"No valid AHI file found."/)) + if (trace_use) call da_trace_exit("da_read_obs_netcdf4ahi_jaxa") + return + end if + + infile_loop: do ifile = 1, nfile + num_ahi_file_local = 0 + num_ahi_local_local = 0 + num_ahi_global_local = 0 + + ! open NETCDF4 L1 file for read + iret = nf90_open(fname_tb(ifile), NF90_NOWRITE, ncid) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"Cannot open NETCDF4 file "//trim(fname_tb(ifile))/)) + cycle infile_loop + endif + + ! read dimensions: latitude and longitude + iret = nf90_inq_dimid(ncid, "latitude", LatDimID) + iret = nf90_inquire_dimension(ncid, LatDimID, len=nlatitude) + + iret = nf90_inq_dimid(ncid, "longitude", LonDimID) + iret = nf90_inquire_dimension(ncid, LonDimID, len=nlongitude) + + write(unit=stdout,fmt=*)'nlongitude,nlatitude: ',nlongitude,nlatitude + + ! read array: time + iret = nf90_get_att(ncid, nf90_global, "id", filename) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: observation date"/)) + endif + read(filename,"(A7,I4,I2,I2,A1,I2,I2)") str1,idate5(1),idate5(2),idate5(3), & + str2,idate5(4),idate5(5) + idate5(6)=00 + write(unit=stdout,fmt=*)'observation date: ', idate5 + + ! read array: latlon + ! read lat + iret = nf90_inq_varid(ncid, 'latitude', latid) + allocate( vlatitude(nlatitude)) + iret = nf90_get_var(ncid, latid, vlatitude) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: Latitude of Observation Point"/)) + endif + ! read lon + iret = nf90_inq_varid(ncid, 'longitude', lonid) + allocate( vlongitude(nlongitude)) + iret = nf90_get_var(ncid, lonid, vlongitude) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: Longitude of Observation Point"/)) + call da_trace_exit("da_read_obs_netcdf4ahi_jaxa") + endif + ! sample display + write(unit=stdout,fmt=*)'latitude,longitude(pixel=1,scan=1): ',vlatitude(1),vlongitude(1) + + ! read array: tb for band 7-16 + ! read + allocate( tbb(nlongitude,nlatitude,nchan)) + do k=1,nchan + iret = nf90_inq_varid(ncid, tbb_name(k), tbb_id) + iret = nf90_get_var(ncid, tbb_id, tbb(:,:,k)) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: Brightness Temperature"/)) + endif + do j=1,nlatitude + do i=1,nlongitude + tbb(i,j,k)=tbb(i,j,k) * scale_factor_tb + add_offset_tb + end do + end do + ! sample display + write(unit=stdout,fmt=*)& + 'tbb(pixel=1,scan=1,chan=',k,'): ', tbb(1,1,k) + end do + + ! read array: satellite zenith angle + ! read + iret = nf90_inq_varid(ncid, 'SAZ', sazid) + allocate( sat_zenith(nlongitude,nlatitude)) + iret = nf90_get_var(ncid, sazid, sat_zenith) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: satellite zenith angle"/)) + endif + do j=1,nlatitude + do i=1,nlongitude + sat_zenith(i,j)=sat_zenith(i,j) * scale_factor_tb + end do + end do + ! sample display + write(unit=stdout,fmt=*)& + 'satellite zenith angle(pixel=1,scan=1): ',sat_zenith(1,1) + + ! close infile_tb file + iret = nf90_close(ncid) + + !open infile_clp file + got_clp_file = .false. + iret = nf90_open(fname_clp(ifile), NF90_NOWRITE, ncid) + if ( iret == 0 ) then + got_clp_file = .true. + endif + + if ( got_clp_file ) then + ! read array: satellite zenith angle + rcode = nf90_inq_varid(ncid, 'CLTYPE', cltyid) + allocate( cloud_type(nlongitude,nlatitude)) + iret = nf90_get_var(ncid, cltyid, cloud_type) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__,(/"NETCDF4 read error for: CLTYPE data"/)) + endif + ! sample display + write(unit=stdout,fmt=*)'cloud_type(pixel=1,scan=1): ',cloud_type(1,1) + + ! close infile_clp file + iret = nf90_close(ncid) + end if + +! 2.0 Loop to read netcdf and assign information to a sequential structure +!------------------------------------------------------------------------- + ! Allocate arrays to hold data + if ( .not. head_allocated ) then + allocate (head) + nullify ( head % next ) + p => head + head_allocated = .true. + end if + + ! start scan_loop + scan_loop: do ilatitude=1, nlatitude + + call da_get_julian_time(idate5(1),idate5(2),idate5(3),idate5(4),idate5(5),obs_time) + if ( obs_time < time_slots(0) .or. & + obs_time >= time_slots(num_fgat_time) ) cycle scan_loop + do ifgat=1,num_fgat_time + if ( obs_time >= time_slots(ifgat-1) .and. & + obs_time < time_slots(ifgat) ) exit + end do + + ! start fov_loop + fov_loop: do ilongitude=1, nlongitude + + if ( sat_zenith(ilongitude,ilatitude) > 65.0 ) cycle fov_loop + + num_ahi_file = num_ahi_file + 1 + num_ahi_file_local = num_ahi_file_local + 1 + info%lat = vlatitude(ilatitude) + info%lon = vlongitude(ilongitude) + + call da_llxy (info, loc, outside, outside_all) + if (outside_all) cycle fov_loop + + num_ahi_global = num_ahi_global + 1 + num_ahi_global_local = num_ahi_global_local + 1 + ptotal(ifgat) = ptotal(ifgat) + 1 + if (outside) cycle fov_loop ! No good for this PE + + num_ahi_local = num_ahi_local + 1 + num_ahi_local_local = num_ahi_local_local + 1 + write(unit=info%date_char, & + fmt='(i4.4,a,i2.2,a,i2.2,a,i2.2,a,i2.2,a,i2.2)') & + idate5(1), '-', idate5(2), '-', idate5(3), '_', idate5(4), & + ':', idate5(5), ':', idate5(6) + info%elv = 0.0 + +! 3.0 Make Thinning +! Map obs to thinning grid +!------------------------------------------------------------------- + if (thinning) then + dlat_earth = info%lat !degree + dlon_earth = info%lon + if (dlon_earth=r360) dlon_earth = dlon_earth-r360 + dlat_earth = dlat_earth*deg2rad !radian + dlon_earth = dlon_earth*deg2rad + crit = 1. + call map2grids(inst,ifgat,dlat_earth,dlon_earth,crit,iobs,itx,1,itt,iout,iuse) + if (.not. iuse) then + num_ahi_thinned = num_ahi_thinned+1 + cycle fov_loop + end if + end if + + num_ahi_used = num_ahi_used + 1 + data_all = missing_r + + do k=1,nchan + tb = tbb(ilongitude,ilatitude,k) + if( tb < tbmin .or. tb > tbmax ) tb = missing_r + data_all(k)= tb + end do + +! 4.0 assign information to sequential radiance structure +!-------------------------------------------------------------------------- + allocate ( p % tb_inv (1:nchan )) + p%info = info + p%loc = loc + p%landsea_mask = 1 + p%scanpos = ilongitude !nint(sat_zenith(ilongitude,ilatitude))+1.001_r_kind ! + p%satzen = sat_zenith(ilongitude,ilatitude) + p%satazi = 0 + p%solzen = 0 + p%solazi = 0 + p%tb_inv(1:nchan) = data_all(1:nchan) + p%sensor_index = inst + p%ifgat = ifgat + p%cloudflag = cloud_type(ilongitude,ilatitude) + + allocate (p%next) ! add next data + p => p%next + nullify (p%next) + end do fov_loop + end do scan_loop + + write(stdout,fmt='(3a,i7)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_file : ',num_ahi_file_local + write(stdout,fmt='(3a,i7)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_global : ',num_ahi_global_local + write(stdout,fmt='(3a,i7)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_local : ',num_ahi_local_local + end do infile_loop + + deallocate(data_all) ! Deallocate data arrays + deallocate(vlatitude) + deallocate(vlongitude) + deallocate(tbb) + deallocate(sat_zenith) + if( got_clp_file ) deallocate(cloud_type) + + if (thinning .and. num_ahi_global > 0 ) then +#ifdef DM_PARALLEL + ! Get minimum crit and associated processor index. + j = 0 + do ifgat = 1, num_fgat_time + j = j + thinning_grid(inst,ifgat)%itxmax + end do + + allocate ( in (j) ) + allocate ( out (j) ) + j = 0 + do ifgat = 1, num_fgat_time + do i = 1, thinning_grid(inst,ifgat)%itxmax + j = j + 1 + in(j) = thinning_grid(inst,ifgat)%score_crit(i) + end do + end do + call mpi_reduce(in, out, j, true_mpi_real, mpi_min, root, comm, ierr) + + call wrf_dm_bcast_real (out, j) + + j = 0 + do ifgat = 1, num_fgat_time + do i = 1, thinning_grid(inst,ifgat)%itxmax + j = j + 1 + if ( ABS(out(j)-thinning_grid(inst,ifgat)%score_crit(i)) > 1.0E-10 ) & + thinning_grid(inst,ifgat)%ibest_obs(i) = 0 + end do + end do + + deallocate( in ) + deallocate( out ) + +#endif + + ! Delete the nodes which being thinning out + p => head + prev => head + head_found = .false. + num_ahi_used_tmp = num_ahi_used + do j = 1, num_ahi_used_tmp + n = p%sensor_index + ifgat = p%ifgat + found = .false. + + do i = 1, thinning_grid(n,ifgat)%itxmax + if ( thinning_grid(n,ifgat)%ibest_obs(i) == j .and. thinning_grid(n,ifgat)%score_crit(i) < 9.99e6_r_kind ) then + found = .true. + exit + end if + end do + + ! free current data + if ( .not. found ) then + current => p + p => p%next + if ( head_found ) then + prev%next => p + else + head => p + prev => p + end if + deallocate ( current % tb_inv ) + deallocate ( current ) + num_ahi_thinned = num_ahi_thinned + 1 + num_ahi_used = num_ahi_used - 1 + continue + end if + + if ( found .and. head_found ) then + prev => p + p => p%next + continue + end if + + if ( found .and. .not. head_found ) then + head_found = .true. + head => p + prev => p + p => p%next + end if + + end do + + end if ! End of thinning + + iv%total_rad_pixel = iv%total_rad_pixel + num_ahi_used + iv%total_rad_channel = iv%total_rad_channel + num_ahi_used*nchan + + iv%info(radiance)%nlocal = iv%info(radiance)%nlocal + num_ahi_used + iv%info(radiance)%ntotal = iv%info(radiance)%ntotal + num_ahi_global + + do i = 1, num_fgat_time + ptotal(i) = ptotal(i) + ptotal(i-1) + iv%info(radiance)%ptotal(i) = iv%info(radiance)%ptotal(i) + ptotal(i) + end do + if ( iv%info(radiance)%ptotal(num_fgat_time) /= iv%info(radiance)%ntotal ) then + write(unit=message(1),fmt='(A,I10,A,I10)') & + "Number of ntotal:",iv%info(radiance)%ntotal," is different from the sum of ptotal:", iv%info(radiance)%ptotal(num_fgat_time) + call da_warning(__FILE__,__LINE__,message(1:1)) + endif + + write(unit=stdout,fmt='(a)') 'AHI data counts: ' + write(stdout,fmt='(a,i7)') ' In file: ',num_ahi_file + write(stdout,fmt='(a,i7)') ' Global : ',num_ahi_global + write(stdout,fmt='(a,i7)') ' Local : ',num_ahi_local + write(stdout,fmt='(a,i7)') ' Used : ',num_ahi_used + write(stdout,fmt='(a,i7)') ' Thinned: ',num_ahi_thinned + +! 5.0 allocate innovation radiance structure +!---------------------------------------------------------------- + + if (num_ahi_used > 0) then + iv%instid(inst)%num_rad = num_ahi_used + iv%instid(inst)%info%nlocal = num_ahi_used + write(UNIT=stdout,FMT='(a,i3,2x,a,3x,i10)') & + 'Allocating space for radiance innov structure', & + inst, iv%instid(inst)%rttovid_string, iv%instid(inst)%num_rad + call da_allocate_rad_iv (inst, nchan, iv) + end if + +! 6.0 assign sequential structure to innovation structure +!------------------------------------------------------------- + p => head + + do n = 1, num_ahi_used + i = p%sensor_index + call da_initialize_rad_iv (i, n, iv, p) + current => p + p => p%next + ! free current data + deallocate ( current % tb_inv ) + deallocate ( current ) + end do + deallocate ( p ) + deallocate (ptotal) + + if (trace_use) call da_trace_exit("da_read_obs_netcdf4ahi_jaxa") + +end subroutine da_read_obs_netcdf4ahi_jaxa diff --git a/var/da/da_radiance/da_read_obs_netcdf4ahi_zou.inc b/var/da/da_radiance/da_read_obs_netcdf4ahi_zou.inc new file mode 100644 index 0000000000..e854b2c6b0 --- /dev/null +++ b/var/da/da_radiance/da_read_obs_netcdf4ahi_zou.inc @@ -0,0 +1,556 @@ +subroutine da_read_obs_AHI (iv, infile) + !-------------------------------------------------------- + ! Purpose: read in GEOCAT AHI Level-1 and Level-2 data in NETCDF4 format + ! and form innovation structure + ! + ! METHOD: use F90 sequantial data structure to avoid read the file twice + ! 1. read file radiance data in sequential data structure + ! 2. do gross QC check + ! 3. assign sequential data structure to innovation structure + ! and deallocate sequential data structure + ! + ! HISTORY: 2016/10/22 - Creation Yuanbing Wang, NUIST/CAS, NCAR/NESL/MMM/DAS + ! To be devoloped: 1.time information; 2.dimension sequence + !------------------------------------------------------------------------------ + + use netcdf + implicit none + + character(len=*), intent(in) :: infile + type(iv_type), intent(inout) :: iv + +! fixed parameter values + integer,parameter::time_dims=6 ! Time dimension + integer,parameter::nfile_max = 8 ! each netcdf file contains + +! interface variable + integer iret, rcode, ncid ! return status + +! array data + real(4), allocatable :: vlatitude(:,:) ! value for latitude + real(4), allocatable :: vlongitude(:,:) ! value for longitude + + real(4), allocatable :: tbb(:,:,:) ! tb for band 7-16 + real(4), allocatable :: sat_zenith(:,:) + real(4), allocatable :: sun_zenith(:,:) + real(4), allocatable :: tropo_temp(:,:) + + byte, allocatable :: cloud_mask(:,:) + byte, allocatable :: cloud_zou(:,:) + + real(r_kind),parameter :: tbmin = 50._r_kind + real(r_kind),parameter :: tbmax = 550._r_kind + + real(kind=8) :: obs_time + type (datalink_type),pointer :: head, p, current, prev + type(info_type) :: info + type(model_loc_type) :: loc + + integer(i_kind) :: idate5(6) + character(len=80) :: filename,str_tmp + + integer(i_kind) :: inst,platform_id,satellite_id,sensor_id + real(r_kind) :: tb, crit + integer(i_kind) :: ifgat, iout, iobs + logical :: outside, outside_all, iuse + + integer :: i,j,k,l,m,n, ifile, landsea_mask + logical :: found, head_found, head_allocated + +! Other work variables + real(r_kind) :: dlon_earth,dlat_earth + integer(i_kind) :: num_ahi_local, num_ahi_global, num_ahi_used, num_ahi_thinned + integer(i_kind) :: num_ahi_used_tmp, num_ahi_file + integer(i_kind) :: num_ahi_local_local, num_ahi_global_local, num_ahi_file_local + integer(i_kind) :: itx, itt + character(80) :: filename1,filename2 + integer :: nchan,nlongitude,nlatitude,ilongitude,ilatitude,ichannels + integer :: lonstart,latstart + integer :: LatDimID,LonDimID + integer :: latid,lonid,tbb_id,sazid,cltyid,sozid,ttp_id + integer :: nfile + character(80) :: fname_tb(nfile_max),fname_clp(nfile_max) + integer :: vtype + character(80) :: vname + logical :: fexist,got_clp_file + +! Allocatable arrays + integer(i_kind),allocatable :: ptotal(:) + real,allocatable :: in(:), out(:) + real(r_kind),allocatable :: data_all(:) + + character(len=2) tbb_name + + + if (trace_use) call da_trace_entry("da_read_obs_netcdf4ahi_geocat") + +! 0.0 Initialize variables +!----------------------------------- + head_allocated = .false. + platform_id = 31 ! Table-2 Col 1 corresponding to 'himawari' + satellite_id = 8 ! Table-2 Col 3 + sensor_id = 56 ! Table-3 Col 2 corresponding to 'ahi' + + allocate(ptotal(0:num_fgat_time)) + ptotal(0:num_fgat_time) = 0 + iobs = 0 ! for thinning, argument is inout + num_ahi_file = 0 + num_ahi_local = 0 + num_ahi_global = 0 + num_ahi_used = 0 + num_ahi_thinned = 0 + + do i = 1, rtminit_nsensor + if (platform_id == rtminit_platform(i) & + .and. satellite_id == rtminit_satid(i) & + .and. sensor_id == rtminit_sensor(i)) then + inst = i + exit + end if + end do + if (inst == 0) then + call da_warning(__FILE__,__LINE__, & + (/"The combination of Satellite_Id and Sensor_Id for AHI is not found"/)) + if (trace_use) call da_trace_exit("da_read_obs_netcdf4ahi_geocat") + return + end if + + nchan = iv%instid(inst)%nchan + write(unit=stdout,fmt=*)'AHI nchan: ',nchan + allocate(data_all(1:nchan)) + +! 1.0 Assign file names and prepare to read ahi files +!------------------------------------------------------------------------- + nfile = 0 !initialize + fname_tb(:) = '' !initialize + + ! first check if ahi nc file is available + filename1 = trim(infile) + inquire (file=filename1, exist=fexist) + if ( fexist ) then + nfile = 1 + fname_tb(nfile) = filename1 + else + ! check if netcdf4 files are available for multiple input files + ! here 0x is the input file sequence number + ! do not confuse it with fgat time slot index + do i = 1, nfile_max + write(filename1,fmt='(A,A,I2.2,A)') trim(infile),'-',i + inquire (file=filename1, exist=fexist) + if ( fexist ) then + nfile = nfile + 1 + fname_tb(nfile) = filename1 + fname_clp(nfile) = filename2 + else + exit + end if + end do + end if + + if ( nfile == 0 ) then + call da_warning(__FILE__,__LINE__, & + (/"No valid AHI file found."/)) + if (trace_use) call da_trace_exit("da_read_obs_netcdf4ahi_geocat") + return + end if + + + !open the data area info file + open(unit=1990,file='ahi_info',status='old',iostat=iret) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__,(/"area_info file read error"/)) + endif + !read date information + read(1990,*) + read(1990,*) + read(1990,*) + read(1990,*) + read(1990,*) + read(1990,*) lonstart,latstart,nlongitude,nlatitude + close(1990) + + write(*,*) lonstart,latstart,nlongitude,nlatitude + + infile_loop: do ifile = 1, nfile + num_ahi_file_local = 0 + num_ahi_local_local = 0 + num_ahi_global_local = 0 + + ! open NETCDF4 L1 file for read + iret = nf90_open(fname_tb(ifile), nf90_NOWRITE, ncid) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"Cannot open NETCDF4 file "//trim(fname_tb(ifile))/)) + cycle infile_loop + endif + + ! read array: time + iret = nf90_get_att(ncid, nf90_global, "Image_Date_Time", filename) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: observation date"/)) + end if + read(filename,"(I4,A1,I2,A1,I2,A1,I2,A1,I2,A1,I2,A1)") idate5(1),str_tmp,idate5(2),str_tmp,& + idate5(3),str_tmp,idate5(4),str_tmp,idate5(5),str_tmp,idate5(6),str_tmp + write(unit=stdout,fmt=*)'observation date: ', idate5 + + ! read array: lat + ! read lat + iret = nf90_inq_varid(ncid, 'latitude', latid) + allocate(vlatitude(nlongitude,nlatitude)) + iret = nf90_get_var(ncid,latid,vlatitude,start=(/lonstart,latstart/), & + count=(/nlongitude,nlatitude/)) ! + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: Latitude of Observation Point"/)) + endif + ! sample display + write(unit=stdout,fmt=*)'vlatitude(pixel=1,scan=1): ',vlatitude(1,1) + + ! read lon + iret = nf90_inq_varid(ncid, 'longitude', lonid) + allocate(vlongitude(nlongitude,nlatitude)) + iret = nf90_get_var(ncid,lonid,vlongitude,start=(/lonstart,latstart/), & + count=(/nlongitude,nlatitude/)) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: Longitude of Observation Point"/)) + call da_trace_exit("da_read_obs_netcdf4ahi_geocat") + endif + ! sample display + write(unit=stdout,fmt=*)'vlongitude(pixel=1,scan=1): ',vlongitude(1,1) + + ! read array: tb for band 7-16 + allocate(tbb(nlongitude,nlatitude,nchan)) + iret = nf90_inq_varid(ncid, "BT", tbb_id) + iret = nf90_get_var(ncid,tbb_id,tbb,start=(/lonstart,latstart,1/), & + count=(/nlongitude,nlatitude,10/)) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: Brightness Temperature"/)) + endif + ! sample display + do k=1,10 + write(unit=stdout,fmt=*) 'tbb(pixel=1,scan=1,chan=',k,'): ', tbb(1,1,k) + enddo + + ! read array: satellite zenith angle + ! read + iret = nf90_inq_varid(ncid, 'satZenith', sazid) + allocate(sat_zenith(nlongitude,nlatitude)) + iret = nf90_get_var(ncid,sazid,sat_zenith,start=(/lonstart,latstart/), & + count=(/nlongitude,nlatitude/)) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: satellite zenith angle"/)) + endif + ! sample display + write(unit=stdout,fmt=*) 'satellite zenith angle(pixel=1,scan=1): ',sat_zenith(1,1) + + ! read array: sun zenith angle + iret = nf90_inq_varid(ncid, 'sunZenith', sazid) + allocate(sun_zenith(nlongitude,nlatitude)) + iret = nf90_get_var(ncid,sozid,sun_zenith,start=(/lonstart,latstart/), & + count=(/nlongitude,nlatitude/)) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: sun zenith angle"/)) + endif + ! sample display + write(unit=stdout,fmt=*) 'sun zenith angle(pixel=1,scan=1): ',sun_zenith(1,1) + + ! read array: satellite zenith angle + iret = nf90_inq_varid(ncid, 'cloudmask', sazid) + allocate(cloud_mask(nlongitude,nlatitude)) + iret = nf90_get_var(ncid,cltyid,cloud_mask,start=(/lonstart,latstart/), & + count=(/nlongitude,nlatitude/)) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: satellite zenith angle"/)) + endif + ! sample display + write(unit=stdout,fmt=*) 'cloud mask of origin (pixel=1,scan=1): ',cloud_mask(1,1) + + ! read array: cloud mask of Zhuge and Zou(2017) + iret = nf90_inq_varid(ncid, 'clm_zou', sazid) + allocate(cloud_zou(nlongitude,nlatitude)) + iret = nf90_get_var(ncid,cltyid,cloud_zou,start=(/lonstart,latstart/), & + count=(/nlongitude,nlatitude/)) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: satellite zenith angle"/)) + endif + ! sample display + write(unit=stdout,fmt=*) 'cloud mask of zou (pixel=1,scan=1): ',cloud_zou(1,1) + + ! close infile_tb file + iret = nf90_close(ncid) + +! read tropopause temprature + iret = nf90_open("trop_ahi.nc", nf90_NOWRITE, ncid) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"Cannot open NETCDF4 tropopause temprature file "/)) + endif + iret = nf90_inq_varid(ncid, "AhiTrp", ttp_id) + allocate(tropo_temp(nlongitude,nlatitude)) + iret = nf90_get_var(ncid,ttp_id,tropo_temp) + if(iret /= 0)then + call da_warning(__FILE__,__LINE__, & + (/"NETCDF4 read error for: Tropopause Temperature"/)) + endif + iret = nf90_close(ncid) + +! 2.0 Loop to read netcdf and assign information to a sequential structure +!------------------------------------------------------------------------- + + ! Allocate arrays to hold data + if ( .not. head_allocated ) then + allocate (head) + nullify ( head % next ) + p => head + head_allocated = .true. + end if + + ! start scan_loop + scan_loop: do ilatitude=1, nlatitude + + call da_get_julian_time(idate5(1),idate5(2),idate5(3),idate5(4),idate5(5),obs_time) + if ( obs_time < time_slots(0) .or. & + obs_time >= time_slots(num_fgat_time) ) cycle scan_loop + do ifgat=1,num_fgat_time + if ( obs_time >= time_slots(ifgat-1) .and. & + obs_time < time_slots(ifgat) ) exit + end do + + ! start fov_loop + fov_loop: do ilongitude=1, nlongitude + + if ( sat_zenith(ilongitude,ilatitude) > 65.0 ) cycle fov_loop + + num_ahi_file = num_ahi_file + 1 + num_ahi_file_local = num_ahi_file_local + 1 + info%lat = vlatitude(ilongitude,ilatitude) + info%lon = vlongitude(ilongitude,ilatitude) + + call da_llxy (info, loc, outside, outside_all) + if (outside_all) cycle fov_loop + + num_ahi_global = num_ahi_global + 1 + num_ahi_global_local = num_ahi_global_local + 1 + ptotal(ifgat) = ptotal(ifgat) + 1 + if (outside) cycle fov_loop ! No good for this PE + + num_ahi_local = num_ahi_local + 1 + num_ahi_local_local = num_ahi_local_local + 1 + write(unit=info%date_char, & + fmt='(i4.4,a,i2.2,a,i2.2,a,i2.2,a,i2.2,a,i2.2)') & + idate5(1), '-', idate5(2), '-', idate5(3), '_', idate5(4), & + ':', idate5(5), ':', idate5(6) + info%elv = 0.0 + +! 3.0 Make Thinning +! Map obs to thinning grid +!------------------------------------------------------------------- + if (thinning) then + dlat_earth = info%lat !degree + dlon_earth = info%lon + if (dlon_earth=r360) dlon_earth = dlon_earth-r360 + dlat_earth = dlat_earth*deg2rad !radian + dlon_earth = dlon_earth*deg2rad + crit = 1. + call map2grids(inst,ifgat,dlat_earth,dlon_earth,crit,iobs,itx,1,itt,iout,iuse) + if (.not. iuse) then + num_ahi_thinned = num_ahi_thinned+1 + cycle fov_loop + end if + end if + + num_ahi_used = num_ahi_used + 1 + data_all = missing_r + + do k=1,nchan + tb = tbb(ilongitude,ilatitude,k) + if( tb < tbmin .or. tb > tbmax ) tb = missing_r + data_all(k)= tb + enddo + +! 4.0 assign information to sequential radiance structure +!-------------------------------------------------------------------------- + allocate ( p % tb_inv (1:nchan )) + p%info = info + p%loc = loc + p%landsea_mask = 1 + p%scanpos = ilongitude !nint(sat_zenith(ilongitude,ilatitude))+1.001_r_kind ! + p%satzen = sat_zenith(ilongitude,ilatitude) + p%satazi = 0 + p%solzen = 0 + p%solazi = 0 + p%tb_inv(1:nchan) = data_all(1:nchan) + p%sensor_index = inst + p%ifgat = ifgat + p%cloudflag = cloud_mask(ilongitude,ilatitude) + + allocate (p%next) ! add next data + p => p%next + nullify (p%next) + end do fov_loop + end do scan_loop + + write(stdout,fmt='(3a,i10)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_file : ',num_ahi_file_local + write(stdout,fmt='(3a,i10)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_global : ',num_ahi_global_local + write(stdout,fmt='(3a,i10)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_local : ',num_ahi_local_local + end do infile_loop + + deallocate(data_all) ! Deallocate data arrays + !deallocate(cloudflag) + deallocate(vlatitude) + deallocate(vlongitude) + deallocate(tbb) + deallocate(sat_zenith) + if( got_clp_file ) deallocate(cloud_mask) + + if (thinning .and. num_ahi_global > 0 ) then +#ifdef DM_PARALLEL + ! Get minimum crit and associated processor index. + j = 0 + do ifgat = 1, num_fgat_time + j = j + thinning_grid(inst,ifgat)%itxmax + end do + + allocate ( in (j) ) + allocate ( out (j) ) + j = 0 + do ifgat = 1, num_fgat_time + do i = 1, thinning_grid(inst,ifgat)%itxmax + j = j + 1 + in(j) = thinning_grid(inst,ifgat)%score_crit(i) + end do + end do + call mpi_reduce(in, out, j, true_mpi_real, mpi_min, root, comm, ierr) + + call wrf_dm_bcast_real (out, j) + + j = 0 + do ifgat = 1, num_fgat_time + do i = 1, thinning_grid(inst,ifgat)%itxmax + j = j + 1 + if ( ABS(out(j)-thinning_grid(inst,ifgat)%score_crit(i)) > 1.0E-10 ) & + thinning_grid(inst,ifgat)%ibest_obs(i) = 0 + end do + end do + + deallocate( in ) + deallocate( out ) + +#endif + + ! Delete the nodes which being thinning out + p => head + prev => head + head_found = .false. + num_ahi_used_tmp = num_ahi_used + do j = 1, num_ahi_used_tmp + n = p%sensor_index + ifgat = p%ifgat + found = .false. + + do i = 1, thinning_grid(n,ifgat)%itxmax + if ( thinning_grid(n,ifgat)%ibest_obs(i) == j .and. thinning_grid(n,ifgat)%score_crit(i) < 9.99e6_r_kind ) then + found = .true. + exit + end if + end do + + ! free current data + if ( .not. found ) then + + current => p + p => p%next + + if ( head_found ) then + prev%next => p + else + head => p + prev => p + end if + + deallocate ( current % tb_inv ) + deallocate ( current ) + + num_ahi_thinned = num_ahi_thinned + 1 + num_ahi_used = num_ahi_used - 1 + continue + end if + + if ( found .and. head_found ) then + prev => p + p => p%next + continue + end if + + if ( found .and. .not. head_found ) then + head_found = .true. + head => p + prev => p + p => p%next + end if + + end do + end if ! End of thinning + + iv%total_rad_pixel = iv%total_rad_pixel + num_ahi_used + iv%total_rad_channel = iv%total_rad_channel + num_ahi_used*nchan + + iv%info(radiance)%nlocal = iv%info(radiance)%nlocal + num_ahi_used + iv%info(radiance)%ntotal = iv%info(radiance)%ntotal + num_ahi_global + + do i = 1, num_fgat_time + ptotal(i) = ptotal(i) + ptotal(i-1) + iv%info(radiance)%ptotal(i) = iv%info(radiance)%ptotal(i) + ptotal(i) + end do + if ( iv%info(radiance)%ptotal(num_fgat_time) /= iv%info(radiance)%ntotal ) then + write(unit=message(1),fmt='(A,I10,A,I10)') & + "Number of ntotal:",iv%info(radiance)%ntotal," is different from the sum of ptotal:", iv%info(radiance)%ptotal(num_fgat_time) + call da_warning(__FILE__,__LINE__,message(1:1)) + endif + + write(unit=stdout,fmt='(a)') 'AHI data counts: ' + write(stdout,fmt='(a,i10)') ' In file: ',num_ahi_file + write(stdout,fmt='(a,i10)') ' Global : ',num_ahi_global + write(stdout,fmt='(a,i10)') ' Local : ',num_ahi_local + write(stdout,fmt='(a,i10)') ' Used : ',num_ahi_used + write(stdout,fmt='(a,i10)') ' Thinned: ',num_ahi_thinned + +! 5.0 allocate innovation radiance structure +!---------------------------------------------------------------- + + if (num_ahi_used > 0) then + iv%instid(inst)%num_rad = num_ahi_used + iv%instid(inst)%info%nlocal = num_ahi_used + write(UNIT=stdout,FMT='(a,i3,2x,a,3x,i10)') & + 'Allocating space for radiance innov structure', & + inst, iv%instid(inst)%rttovid_string, iv%instid(inst)%num_rad + call da_allocate_rad_iv (inst, nchan, iv) + end if + +! 6.0 assign sequential structure to innovation structure +!------------------------------------------------------------- + p => head + + do n = 1, num_ahi_used + i = p%sensor_index + call da_initialize_rad_iv (i, n, iv, p) + current => p + p => p%next + ! free current data + deallocate ( current % tb_inv ) + deallocate ( current ) + end do + deallocate ( p ) + deallocate (ptotal) + + if (trace_use) call da_trace_exit("da_read_obs_netcdf4ahi_geocat") + +end subroutine da_read_obs_netcdf4ahi_geocat diff --git a/var/da/da_radiance/da_setup_radiance_structures.inc b/var/da/da_radiance/da_setup_radiance_structures.inc index bc31216a25..c76f44994a 100644 --- a/var/da/da_radiance/da_setup_radiance_structures.inc +++ b/var/da/da_radiance/da_setup_radiance_structures.inc @@ -19,6 +19,8 @@ subroutine da_setup_radiance_structures( grid, ob, iv ) real :: rlonlat(4) ! crtm_cloud integer :: n1,n2,k,its,ite,jts,jte,kts,kte,inst + ! ahi data added by wyb + integer :: data_format,iret if (trace_use) call da_trace_entry("da_setup_radiance_structures") @@ -199,6 +201,63 @@ subroutine da_setup_radiance_structures( grid, ob, iv ) call da_error(__FILE__,__LINE__,message(1:1)) #endif end if + if (use_ahiobs) then + + !open the ahi info file + open(unit=1990,file='ahi_info',status='old',iostat=iret) + if(iret /= 0)then + call da_error(__FILE__,__LINE__,(/"Read ahi_info error: no such file"/)) + end if + !read ahi information + read(1990,*) + read(1990,*) data_format + close(1990) + +! if (data_format==1) then +!#if defined(HDF5) +! write(unit=stdout,fmt='(a)') 'Reading AHI data from cma hdf5' +! call da_read_obs_hdf5ahi (iv, 'L1AHITBR', 'L2AHICLP') +!#else +! call da_error(__FILE__,__LINE__,(/"To read AHI data, WRFDA must be compiled with HDF5"/)) +!#endif +! end if +!! if (data_format==2) then +!! write(unit=stdout,fmt='(a)') 'Reading AHI data from geocat NETCDF4' +!! if (num_fgat_time > 1) then +!! +!! do n=1, num_fgat_time +!! iv%time = n +!! filename = ' ' +!! +!! ! read AHI observation file +!! write(filename(1:10), fmt='(a, i2.2, a)') 'L1AHITBR', n +!! write(unit=stdout,fmt='(a)') 'Reading AHI data from geocat NETCDF4' +!! write(unit=stdout,fmt='(a)') filename(1:10) +!! call da_read_obs_AHI(iv, filename) +!! +!! end do +!! else +!! iv%time = 1 +!! +!! ! read AHI observation file +!! call da_read_obs_AHI(iv, 'L1AHITBR') +!! end if +!! end if +!! + if (data_format==2) then + write(unit=stdout,fmt='(a)') 'Reading AHI data from geocat NETCDF4' + call da_read_obs_AHI (iv, 'L1AHITBR') + end if +! if (data_format==3) then +! write(unit=stdout,fmt='(a)') 'Reading AHI data from JAXA NETCDF4' +! call da_read_obs_netcdf4ahi_jaxa (iv, 'L1AHITBR', 'L2AHICLP') +! end if +! !if (data_format==4) then +! !filename = 'ahi' +! !call da_read_obs_bufrahi ('ahi ',iv, filename) +! !end if + + end if end if if ( use_filtered_rad ) then diff --git a/var/da/da_radiance/da_transform_xtoy_crtm.inc b/var/da/da_radiance/da_transform_xtoy_crtm.inc index 447ce6dea2..9750b9304d 100644 --- a/var/da/da_radiance/da_transform_xtoy_crtm.inc +++ b/var/da/da_radiance/da_transform_xtoy_crtm.inc @@ -243,20 +243,18 @@ subroutine da_transform_xtoy_crtm (cv_size, cv, grid, iv, y ) call da_interp_2d_partial (grid%xa%q(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, & absorber(kte-k+1,:)) - if ( crtm_cloud .and. cloud_cv_options > 0 ) then - - call da_interp_2d_partial (grid%xa%qcw(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, & - qcw(kte-k+1,:)) - call da_interp_2d_partial (grid%xa%qrn(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, & - qrn(kte-k+1,:)) - if ( cloud_cv_options > 1 ) then - call da_interp_2d_partial (grid%xa%qci(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, & - qci(kte-k+1,:)) - call da_interp_2d_partial (grid%xa%qsn(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, & - qsn(kte-k+1,:)) - call da_interp_2d_partial (grid%xa%qgr(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, & - qgr(kte-k+1,:)) - end if + if (crtm_cloud) then + + call da_interp_2d_partial (grid%xa%qcw(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, & + qcw(kte-k+1,:)) + call da_interp_2d_partial (grid%xa%qci(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, & + qci(kte-k+1,:)) + call da_interp_2d_partial (grid%xa%qrn(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, & + qrn(kte-k+1,:)) + call da_interp_2d_partial (grid%xa%qsn(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, & + qsn(kte-k+1,:)) + call da_interp_2d_partial (grid%xa%qgr(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, & + qgr(kte-k+1,:)) end if diff --git a/var/da/da_radiance/da_transform_xtoy_crtm_adj.inc b/var/da/da_radiance/da_transform_xtoy_crtm_adj.inc index 06047ed068..871a38b324 100644 --- a/var/da/da_radiance/da_transform_xtoy_crtm_adj.inc +++ b/var/da/da_radiance/da_transform_xtoy_crtm_adj.inc @@ -542,14 +542,12 @@ subroutine da_transform_xtoy_crtm_adj ( cv_size, cv, iv, jo_grad_y, jo_grad_x ) !!! call wrf_dm_sum_reals(cv_local, cv) !#endif - if ( crtm_cloud .and. cloud_cv_options > 0 ) then + if (crtm_cloud) then call da_interp_lin_2d_adj_partial(jo_grad_x%qcw(:,:,kts:kte),iv%instid(inst)%info, kts,kte, qcw_ad) + call da_interp_lin_2d_adj_partial(jo_grad_x%qci(:,:,kts:kte),iv%instid(inst)%info, kts,kte, qci_ad) call da_interp_lin_2d_adj_partial(jo_grad_x%qrn(:,:,kts:kte),iv%instid(inst)%info, kts,kte, qrn_ad) - if ( cloud_cv_options > 1 ) then - call da_interp_lin_2d_adj_partial(jo_grad_x%qci(:,:,kts:kte),iv%instid(inst)%info, kts,kte, qci_ad) - call da_interp_lin_2d_adj_partial(jo_grad_x%qsn(:,:,kts:kte),iv%instid(inst)%info, kts,kte, qsn_ad) - call da_interp_lin_2d_adj_partial(jo_grad_x%qgr(:,:,kts:kte),iv%instid(inst)%info, kts,kte, qgr_ad) - end if + call da_interp_lin_2d_adj_partial(jo_grad_x%qsn(:,:,kts:kte),iv%instid(inst)%info, kts,kte, qsn_ad) + call da_interp_lin_2d_adj_partial(jo_grad_x%qgr(:,:,kts:kte),iv%instid(inst)%info, kts,kte, qgr_ad) endif call da_interp_lin_2d_adj_partial(jo_grad_x%t(:,:,kts:kte), iv%instid(inst)%info, kts,kte, t_ad) diff --git a/var/da/da_radiance/da_write_filtered_rad.inc b/var/da/da_radiance/da_write_filtered_rad.inc index fc8eceb164..04b3f84694 100644 --- a/var/da/da_radiance/da_write_filtered_rad.inc +++ b/var/da/da_radiance/da_write_filtered_rad.inc @@ -12,7 +12,7 @@ subroutine da_write_filtered_rad(ob, iv) type (iv_type), intent(in) :: iv ! O-B structure. integer :: n ! Loop counter. - integer :: i ! Index dimension. + integer :: i,m,m1,m2 ! Index dimension. integer :: ios, filtered_rad_unit character(len=50) :: filename @@ -22,6 +22,19 @@ subroutine da_write_filtered_rad(ob, iv) do i = 1, iv%num_inst if (iv%instid(i)%num_rad < 1) cycle + do m=num_fgat_time,1,-1 + iv%instid(i)%info%n1 = iv%instid(i)%info%plocal(m-1) + 1 + iv%instid(i)%info%n2=iv%instid(i)%info%plocal(m) + + if (num_fgat_time >1) then +#ifdef DM_PARALLEL + write(unit=filename, fmt='(a,i2.2,a,i4.4)') & + 'filtered_'//trim(iv%instid(i)%rttovid_string)//'_',m,'.', myproc +#else + write(unit=filename, fmt='(a,i2.2)') & + 'filtered_'//trim(iv%instid(i)%rttovid_string)//'_',m +#endif + else #ifdef DM_PARALLEL write(unit=filename, fmt='(a,i4.4)') & 'filtered_'//trim(iv%instid(i)%rttovid_string)//'.', myproc @@ -29,6 +42,7 @@ subroutine da_write_filtered_rad(ob, iv) write(unit=filename, fmt='(a)') & 'filtered_'//trim(iv%instid(i)%rttovid_string) #endif + end if call da_get_unit(filtered_rad_unit) open(unit=filtered_rad_unit,file=trim(filename), & @@ -38,9 +52,10 @@ subroutine da_write_filtered_rad(ob, iv) (/"Cannot open filtered radiance file"//filename/)) Endif - write(unit=filtered_rad_unit) iv%instid(i)%num_rad + write(unit=filtered_rad_unit) iv%instid(i)%info%n1-iv%instid(i)%info%n2 - do n =1,iv%instid(i)%num_rad +! do n =1,iv%instid(i)%num_rad + do n=iv%instid(i)%info%n1,iv%instid(i)%info%n2 write(unit=filtered_rad_unit) n, & iv%instid(i)%info%date_char(n), & iv%instid(i)%scanpos(n) , & @@ -58,6 +73,7 @@ subroutine da_write_filtered_rad(ob, iv) end do ! end do pixels close(unit=filtered_rad_unit) call da_free_unit(filtered_rad_unit) + end do ! enddo wuyl n1,n2 end do !! end do instruments if (trace_use) call da_trace_exit("da_write_filtered_rad") diff --git a/var/da/da_radiance/da_write_iv_rad_ascii.inc b/var/da/da_radiance/da_write_iv_rad_ascii.inc index 4c14d51466..2a106fa9d9 100644 --- a/var/da/da_radiance/da_write_iv_rad_ascii.inc +++ b/var/da/da_radiance/da_write_iv_rad_ascii.inc @@ -1,4 +1,4 @@ -subroutine da_write_iv_rad_ascii (it, ob, iv ) +subroutine da_write_iv_rad_ascii (it,ob, iv ) !--------------------------------------------------------------------------- ! Purpose: write out innovation vector structure for radiance data. @@ -11,7 +11,7 @@ subroutine da_write_iv_rad_ascii (it, ob, iv ) type (iv_type), intent(in) :: iv ! O-B structure. integer :: n ! Loop counter. - integer :: i, k, l ! Index dimension. + integer :: i, k, l, m, m1, m2 ! Index dimension. integer :: nlevelss ! Number of obs levels. integer :: ios, innov_rad_unit @@ -32,11 +32,16 @@ subroutine da_write_iv_rad_ascii (it, ob, iv ) ! count number of obs within the loc%proc_domain ! --------------------------------------------- + do m=num_fgat_time,1,-1 + iv%instid(i)%info%n1 = iv%instid(i)%info%plocal(m-1) + 1 + iv%instid(i)%info%n2=iv%instid(i)%info%plocal(m) ndomain = 0 - do n =1,iv%instid(i)%num_rad - if (iv%instid(i)%info%proc_domain(1,n)) then +! do n =1,iv%instid(i)%num_rad + do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 + + if (iv%instid(i)%info%proc_domain(1,n)) then ndomain = ndomain + 1 - end if + end if end do if (ndomain < 1) cycle @@ -49,9 +54,18 @@ subroutine da_write_iv_rad_ascii (it, ob, iv ) end if amsr2 = index(iv%instid(i)%rttovid_string,'amsr2') > 0 - +!wuyl +! do m=num_fgat_time,1,-1 +! iv%time=m +! iv%instid(i)%info%n1 = iv%instid(i)%info%plocal(m-1) + 1 +! iv%instid(i)%info%n2=iv%instid(i)%info%plocal(m) + + if (num_fgat_time >1) then + + write(unit=filename, fmt='(i2.2,a,i2.2,a,i4.4)') it,'_inv_'//trim(iv%instid(i)%rttovid_string)//'_',m,'.', myproc + else write(unit=filename, fmt='(i2.2,a,i4.4)') it,'_inv_'//trim(iv%instid(i)%rttovid_string)//'.', myproc - + end if call da_get_unit(innov_rad_unit) open(unit=innov_rad_unit,file=trim(filename),form='formatted',iostat=ios) if (ios /= 0 ) then @@ -71,7 +85,8 @@ subroutine da_write_iv_rad_ascii (it, ob, iv ) write(unit=innov_rad_unit,fmt='(a)') ' grid%xb-surf-info : i t2m mr2m(ppmv) u10 v10 ps ts smois tslb snowh isflg & & soiltyp vegtyp vegfra elev clwp' ndomain = 0 - do n =1,iv%instid(i)%num_rad +!wuyl do n =1,iv%instid(i)%num_rad + do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 if (iv%instid(i)%info%proc_domain(1,n)) then ndomain=ndomain+1 if ( amsr2 ) then ! write out clw @@ -300,7 +315,7 @@ subroutine da_write_iv_rad_ascii (it, ob, iv ) end if ! end if write_jacobian end if ! end if proc_domain - end do ! end do pixels + end do ! end do pixels if (rtm_option==rtm_option_crtm .and. write_jacobian ) then deallocate ( dtransmt ) deallocate ( transmt_jac ) @@ -310,7 +325,8 @@ subroutine da_write_iv_rad_ascii (it, ob, iv ) end if close(unit=innov_rad_unit) call da_free_unit(innov_rad_unit) - end do ! end do instruments + end do ! n1,n2 wuyl +end do ! end do instruments if (trace_use) call da_trace_exit("da_write_iv_rad_ascii") diff --git a/var/da/da_radiance/da_write_iv_rad_for_multi_inc.inc b/var/da/da_radiance/da_write_iv_rad_for_multi_inc.inc new file mode 100644 index 0000000000..138ed09a5a --- /dev/null +++ b/var/da/da_radiance/da_write_iv_rad_for_multi_inc.inc @@ -0,0 +1,140 @@ +subroutine da_write_iv_rad_for_multi_inc (it,ob, iv ) + + !--------------------------------------------------------------------------- + ! Purpose: write out innovation vector structure for radiance data. + !--------------------------------------------------------------------------- + + implicit none + + integer , intent(in) :: it ! outer loop count + type (y_type), intent(in) :: ob ! Observation structure. + type (iv_type), intent(in) :: iv ! O-B structure. + + integer :: n ! Loop counter. + integer :: i, k, l, m, m1, m2,nobs_tot ! Index dimension. + integer :: nlevelss ! Number of obs levels. + integer :: my,iobs + integer :: ios, innov_rad_unit + character(len=filename_len) :: filename + character(len=7) :: surftype + integer :: ndomain + logical :: amsr2 + real, allocatable :: data2d(:,:) + real, allocatable :: data3d(:,:,:) + real, allocatable :: data2d_g(:,:) + real, allocatable :: data3d_g(:,:,:) + + if (trace_use) call da_trace_entry("da_write_iv_rad_for_multi_inc") + + write(unit=message(1),fmt='(A)') 'Writing radiance OMB ascii file for multi_inc' + call da_message(message(1:1)) + + do i = 1, iv%num_inst + if (iv%instid(i)%num_rad < 1) cycle + + ! count number of obs within the loc%proc_domain + ! --------------------------------------------- + nobs_tot = iv%instid(i)%info%ptotal(num_fgat_time) - iv%instid(i)%info%ptotal(0) +! write(unit=message(1),fmt='(A)') 'calculate nobs_tot' + do m=num_fgat_time,1,-1 + if ( nobs_tot > 0 ) then + write(unit=message(1),fmt='(A)') 'begin to write' + if ( rootproc ) then + write(unit=filename, fmt='(a,i3.3)') 'inv_'//trim(iv%instid(i)%rttovid_string)//'_',m + open(unit=innov_rad_unit,file=trim(filename),form='unformatted',status='replace',iostat=ios) + if (ios /= 0 ) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open innovation radiance file"//filename/)) + Endif + write(unit=message(1),fmt='(A)') filename + call da_message(message(1:1)) + write(innov_rad_unit) nobs_tot + end if ! root open ounit + + iv%instid(i)%info%n1 = iv%instid(i)%info%plocal(m-1) + 1 + iv%instid(i)%info%n2=iv%instid(i)%info%plocal(m) + ndomain = 0 + + do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 + + if (iv%instid(i)%info%proc_domain(1,n)) then + ndomain = ndomain + 1 + end if + end do + if (ndomain < 1) cycle + + if ( amsr2 ) then ! write out clw + my=3 + else + my=2 + end if + allocate( data2d(nobs_tot, my) ) + data2d = 0.0 + do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 + if (iv%instid(i)%info%proc_domain(1,n)) then +! iobs = iv%instid(i)%info%obs_global_index(n) + iobs = n + write(unit=message(1),fmt='(I)') iobs + call da_message(message(1:1)) + if ( amsr2 ) then ! write out clw + data2d(iobs, 1) = iv%instid(i)%info%lat(1,n) + data2d(iobs, 2) = iv%instid(i)%info%lon(1,n) + data2d(iobs, 3) = iv%instid(i)%clw(n) + else ! no clw info + data2d(iobs, 1) = iv%instid(i)%info%lat(1,n) + data2d(iobs, 2) = iv%instid(i)%info%lon(1,n) + end if + end if + end do !n1,n2 + + write(unit=message(1),fmt='(A)') 'begin to write data2d' + call da_message(message(1:1)) + + allocate( data2d_g(nobs_tot, my) ) +#ifdef DM_PARALLEL + call mpi_reduce(data2d, data2d_g, nobs_tot*my, true_mpi_real, mpi_sum, root, comm, ierr) +#else + data2d_g = data2d +#endif + deallocate( data2d ) + + if ( rootproc ) then + write(innov_rad_unit) data2d_g + end if + deallocate( data2d_g ) + + allocate( data3d(nobs_tot, iv%instid(i)%nchan, 3) ) + data3d = 0.0 + do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 + if (iv%instid(i)%info%proc_domain(1,n)) then + ! iobs = iv%instid(i)%info%obs_global_index(n) + iobs = n + data3d(iobs,:, 1)=iv%instid(i)%tb_inv(:,n) + data3d(iobs,:, 2)=iv%instid(i)%tb_error(:,n) + data3d(iobs,:, 3)=iv%instid(i)%tb_qc(:,n) * 1.0 + end if + end do + allocate( data3d_g(nobs_tot, iv%instid(i)%nchan, 3) ) +#ifdef DM_PARALLEL + call mpi_reduce(data3d, data3d_g, nobs_tot*iv%instid(i)%nchan*3, true_mpi_real, mpi_sum, root, comm, ierr) +#else + data3d_g = data3d +#endif + deallocate( data3d ) + if ( rootproc ) then + write(innov_rad_unit) data3d_g + end if + deallocate( data3d_g ) + + if ( rootproc ) then + close(unit=innov_rad_unit) + end if + call da_free_unit(innov_rad_unit) + end if ! nobs_tot > 0 + end do !num_fgat +end do ! end do instruments + +if (trace_use) call da_trace_exit("da_write_iv_rad_for_multi_inc") + +end subroutine da_write_iv_rad_for_multi_inc + diff --git a/var/da/da_radiance/da_write_oa_rad_ascii.inc b/var/da/da_radiance/da_write_oa_rad_ascii.inc index 8f6d5f1bfc..d702f67f45 100644 --- a/var/da/da_radiance/da_write_oa_rad_ascii.inc +++ b/var/da/da_radiance/da_write_oa_rad_ascii.inc @@ -12,7 +12,7 @@ subroutine da_write_oa_rad_ascii (it, ob, iv, re ) type (y_type), intent(in) :: re ! O-A structure. integer :: n ! Loop counter. - integer :: i, k ! Index dimension. + integer :: i, k, m, m1, m2 ! Index dimension. integer :: nlevelss ! Number of obs levels. integer :: ios, oma_rad_unit @@ -31,8 +31,12 @@ subroutine da_write_oa_rad_ascii (it, ob, iv, re ) ! count number of obs within the proc_domain !--------------------------------------------- + do m=num_fgat_time,1,-1 + iv%instid(i)%info%n1 = iv%instid(i)%info%plocal(m-1) + 1 + iv%instid(i)%info%n2=iv%instid(i)%info%plocal(m) ndomain = 0 - do n =1,iv%instid(i)%num_rad + ! do n =1,iv%instid(i)%num_rad + do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 if (iv%instid(i)%info%proc_domain(1,n)) then ndomain = ndomain + 1 end if @@ -41,7 +45,11 @@ subroutine da_write_oa_rad_ascii (it, ob, iv, re ) amsr2 = index(iv%instid(i)%rttovid_string,'amsr2') > 0 + if (num_fgat_time >1) then + write(unit=filename, fmt='(i2.2,a,i2.2,a,i4.4)') it,'_oma_'//trim(iv%instid(i)%rttovid_string)//'_',m,'.', myproc + else write(unit=filename, fmt='(i2.2,a,i4.4)') it,'_oma_'//trim(iv%instid(i)%rttovid_string)//'.', myproc + end if call da_get_unit(oma_rad_unit) open(unit=oma_rad_unit,file=trim(filename),form='formatted',iostat=ios) @@ -62,7 +70,8 @@ subroutine da_write_oa_rad_ascii (it, ob, iv, re ) write(unit=oma_rad_unit,fmt='(a)') ' xb-surf-info : i t2m mr2m(ppmv) u10 v10 ps ts smois tslb snowh isflg & & soiltyp vegtyp vegfra elev clwp' ndomain = 0 - do n=1,iv%instid(i)%num_rad +! do n=1,iv%instid(i)%num_rad + do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 if (iv%instid(i)%info%proc_domain(1,n)) then ndomain=ndomain+1 if ( amsr2 ) then !write out clw @@ -214,6 +223,7 @@ subroutine da_write_oa_rad_ascii (it, ob, iv, re ) end do ! end do pixels close(unit=oma_rad_unit) call da_free_unit(oma_rad_unit) + end do ! n1,n2 wuyl end do !! end do instruments if (trace_use) call da_trace_exit("da_write_oa_rad_ascii") diff --git a/var/da/da_radiance/log b/var/da/da_radiance/log new file mode 100644 index 0000000000..c88f635743 --- /dev/null +++ b/var/da/da_radiance/log @@ -0,0 +1,76 @@ +da_crtm.f:48: use da_tools, only: da_get_time_slots, da_eof_decomposition +da_crtm.f:1950: call da_eof_decomposition(nclouds, hessian, eignvec, eignval) +da_gen_be.f:5065:subroutine da_eof_decomposition (kz, bx, e, l) +da_gen_be.f:5089: if (trace_use) call da_trace_entry("da_eof_decomposition") +da_gen_be.f:5104: call da_error("da_eof_decomposition.inc",40,message(1:1)) +da_gen_be.f:5114: if (trace_use) call da_trace_exit("da_eof_decomposition") +da_gen_be.f:5116:end subroutine da_eof_decomposition +da_gen_be.f:5119:subroutine da_eof_decomposition_test (kz, bx, e, l) +da_gen_be.f:5145: if (trace_use) call da_trace_entry("da_eof_decomposition_test") +da_gen_be.f:5239: if (trace_use) call da_trace_exit("da_eof_decomposition_test") +da_gen_be.f:5241:end subroutine da_eof_decomposition_test +da_radiance1.f:27: use da_tools, only : da_residual_new, da_eof_decomposition +da_radiance1.f:1018:!!! call da_eof_decomposition(ndim, hessian, eignvec, eignval) +da_setup_structures.f:92: use da_vtox_transforms, only : da_check_eof_decomposition +da_setup_structures.f:1368: call da_check_eof_decomposition(be%v1%val_g(:), be%v1%evec_g(:,:),& +da_setup_structures.f:1370: call da_check_eof_decomposition(be%v2%val_g(:), be%v2%evec_g(:,:),& +da_setup_structures.f:1372: call da_check_eof_decomposition(be%v3%val_g(:), be%v3%evec_g(:,:),& +da_setup_structures.f:1374: call da_check_eof_decomposition(be%v4%val_g(:), be%v4%evec_g(:,:),& +da_setup_structures.f:3702: call da_check_eof_decomposition(be1_eval_glo(:), be1_evec_glo(:,:), be % v1 % name) +da_setup_structures.f:3703: call da_check_eof_decomposition(be2_eval_glo(:), be2_evec_glo(:,:), be % v2 % name) +da_setup_structures.f:3704: call da_check_eof_decomposition(be3_eval_glo(:), be3_evec_glo(:,:), be % v3 % name) +da_setup_structures.f:3705: call da_check_eof_decomposition(be4_eval_glo(:), be4_evec_glo(:,:), be % v4 % name) +da_setup_structures.f:3708: call da_check_eof_decomposition(be6_eval_glo(:), be6_evec_glo(:,:), be % v6 % name) +da_setup_structures.f:3709: call da_check_eof_decomposition(be7_eval_glo(:), be7_evec_glo(:,:), be % v7 % name) +da_setup_structures.f:3710: call da_check_eof_decomposition(be8_eval_glo(:), be8_evec_glo(:,:), be % v8 % name) +da_setup_structures.f:3711: call da_check_eof_decomposition(be9_eval_glo(:), be9_evec_glo(:,:), be % v9 % name) +da_setup_structures.f:3712: call da_check_eof_decomposition(be10_eval_glo(:), be10_evec_glo(:,:), be % v10 % name) +da_setup_structures.f:3716: call da_check_eof_decomposition(be11_eval_glo(:), be11_evec_glo(:,:), be % v11 % name) +da_setup_structures.f:3917: call da_check_eof_decomposition(be%v1%val_g(:), be%v1%evec_g(:,:),& +da_setup_structures.f:3919: call da_check_eof_decomposition(be%v2%val_g(:), be%v2%evec_g(:,:),& +da_setup_structures.f:3921: call da_check_eof_decomposition(be%v3%val_g(:), be%v3%evec_g(:,:),& +da_setup_structures.f:3923: call da_check_eof_decomposition(be%v4%val_g(:), be%v4%evec_g(:,:),& +da_setup_structures.f:3927: call da_check_eof_decomposition(be%v6%val_g(:), be%v6%evec_g(:,:),& +da_setup_structures.f:3929: call da_check_eof_decomposition(be%v7%val_g(:), be%v7%evec_g(:,:),& +da_setup_structures.f:3931: call da_check_eof_decomposition(be%v8%val_g(:), be%v8%evec_g(:,:),& +da_setup_structures.f:3933: call da_check_eof_decomposition(be%v9%val_g(:), be%v9%evec_g(:,:),& +da_setup_structures.f:3935: call da_check_eof_decomposition(be%v10%val_g(:), be%v10%evec_g(:,:),& +da_setup_structures.f:3939: call da_check_eof_decomposition(be%v11%val_g(:), be%v11%evec_g(:,:),& +da_setup_structures.f:4719: call da_check_eof_decomposition(be1_eval_glo(:), be1_evec_glo(:,:), be % v1 % name) +da_setup_structures.f:4720: call da_check_eof_decomposition(be2_eval_glo(:), be2_evec_glo(:,:), be % v2 % name) +da_setup_structures.f:4721: call da_check_eof_decomposition(be3_eval_glo(:), be3_evec_glo(:,:), be % v3 % name) +da_setup_structures.f:4722: call da_check_eof_decomposition(be4_eval_glo(:), be4_evec_glo(:,:), be % v4 % name) +da_setup_structures.f:4824: call da_check_eof_decomposition(be%v1%val_g(:), be%v1%evec_g(:,:),& +da_setup_structures.f:4826: call da_check_eof_decomposition(be%v2%val_g(:), be%v2%evec_g(:,:),& +da_setup_structures.f:4828: call da_check_eof_decomposition(be%v3%val_g(:), be%v3%evec_g(:,:),& +da_setup_structures.f:4830: call da_check_eof_decomposition(be%v4%val_g(:), be%v4%evec_g(:,:),& +da_tools.f:4091:subroutine da_eof_decomposition_test (kz, bx, e, l) +da_tools.f:4117: if (trace_use) call da_trace_entry("da_eof_decomposition_test") +da_tools.f:4211: if (trace_use) call da_trace_exit("da_eof_decomposition_test") +da_tools.f:4213:end subroutine da_eof_decomposition_test +da_tools.f:4216:subroutine da_eof_decomposition (kz, bx, e, l) +da_tools.f:4240: if (trace_use) call da_trace_entry("da_eof_decomposition") +da_tools.f:4255: call da_error("da_eof_decomposition.inc",40,message(1:1)) +da_tools.f:4265: if (trace_use) call da_trace_exit("da_eof_decomposition") +da_tools.f:4267:end subroutine da_eof_decomposition +da_varbc.f:18: use da_tools, only : da_eof_decomposition +da_varbc.f:578: call da_eof_decomposition(npred, hessian(1:npred,1:npred), & +da_vtox_transforms.f:166:subroutine da_check_eof_decomposition(be_eigenval, be_eigenvec, name) +da_vtox_transforms.f:192: if (trace_use) call da_trace_entry("da_check_eof_decomposition") +da_vtox_transforms.f:277: if (trace_use) call da_trace_exit("da_check_eof_decomposition") +da_vtox_transforms.f:279:end subroutine da_check_eof_decomposition +gen_be_stage2_1dvar.f:13: use da_gen_be, only : da_eof_decomposition, da_eof_decomposition_test +gen_be_stage2_1dvar.f:561: call da_eof_decomposition( nk, be, evec, eval ) +gen_be_stage2_1dvar.f:565: call da_eof_decomposition_test( nk, be, evec, eval ) +gen_be_stage2.f:6: use da_gen_be, only : da_eof_decomposition,da_eof_decomposition_test +gen_be_stage2.f:290: call da_eof_decomposition( nk, work, evec, eval ) +gen_be_stage2.f:293: call da_eof_decomposition_test( nk, work, evec, eval ) +gen_be_stage3.f:4: use da_gen_be, only : da_eof_decomposition_test, da_eof_decomposition, & +gen_be_stage3.f:229: call da_eof_decomposition( nk, work, e_vec, e_val ) +gen_be_stage3.f:241: call da_eof_decomposition( nk, work, e_vec, e_val ) +gen_be_stage3.f:244: call da_eof_decomposition_test( nk, work, e_vec, e_val ) +gen_be_vertloc.f:3: use da_gen_be, only : da_eof_decomposition +gen_be_vertloc.f:88: call da_eof_decomposition( nk, cov, evec, eval ) +gen_mbe_stage2.f:1369: use da_gen_be, only : da_eof_decomposition,da_eof_decomposition_test +gen_mbe_stage2.f:1410: call da_eof_decomposition( nk, work, evec, eval ) +gen_mbe_stage2.f:1413: call da_eof_decomposition_test( nk, work, evec, eval ) diff --git a/var/da/da_radiance/module_radiance.f90 b/var/da/da_radiance/module_radiance.f90 index 9a83cd8969..36c0216f05 100644 --- a/var/da/da_radiance/module_radiance.f90 +++ b/var/da/da_radiance/module_radiance.f90 @@ -111,7 +111,7 @@ module module_radiance & 'coriolis', 'npp ', 'gifts ', 'tiros ', 'meghat ', & & 'kalpana ', 'tiros ', 'fy3 ', 'coms ', 'xxxxxxxx', & & 'xxxxxxxx', 'xxxxxxxx', 'reserved', 'gcom-w ', 'xxxxxxxx', & - & 'xxxxxxxx', 'xxxxxxxx', 'xxxxxxxx', 'xxxxxxxx', 'xxxxxxxx'/) + & 'himawari', 'xxxxxxxx', 'xxxxxxxx', 'xxxxxxxx', 'xxxxxxxx'/) ! cf. rttov_inst_name above and CRTM: v2.1.3 User Guide Table B.1 ! List of instruments !!!! HIRS is number 0 @@ -131,7 +131,7 @@ module module_radiance & 'mwts ', 'mwhs ', 'iras ', 'mwri ', 'abi ', & & 'xxxxxxxx', 'xxxxxxxx', 'reserved', 'xxxxxxxx', 'xxxxxxxx', & & 'reserved', 'reserved', 'reserved', 'reserved', 'xxxxxxxx', & - & 'xxxxxxxx', 'xxxxxxxx', 'xxxxxxxx', 'xxxxxxxx', 'xxxxxxxx', & + & 'xxxxxxxx', 'ahi ', 'xxxxxxxx', 'xxxxxxxx', 'xxxxxxxx', & & 'xxxxxxxx', 'xxxxxxxx', 'xxxxxxxx', 'amsr2 ', 'vissr ', & & 'xxxxxxxx'/) diff --git a/var/da/da_setup_structures/da_setup_obs_structures.inc b/var/da/da_setup_structures/da_setup_obs_structures.inc index 95385bd80e..20496e4881 100644 --- a/var/da/da_setup_structures/da_setup_obs_structures.inc +++ b/var/da/da_setup_structures/da_setup_obs_structures.inc @@ -90,7 +90,7 @@ subroutine da_setup_obs_structures( grid, ob, iv, j_cost) use_hsbobs .OR. use_kma1dvar .OR. use_filtered_rad .OR. & use_ssmisobs .OR. use_hirs4obs .OR. use_mhsobs .OR. use_pseudo_rad .OR. & use_mwtsobs .OR. use_mwhsobs .OR. use_atmsobs .OR. use_simulated_rad .OR. & - use_iasiobs .OR. use_seviriobs .OR. use_amsr2obs) then + use_iasiobs .OR. use_seviriobs .OR. use_amsr2obs .OR. use_ahiobs) then use_rad = .true. else use_rad = .false. diff --git a/var/da/da_setup_structures/da_setup_structures.f90 b/var/da/da_setup_structures/da_setup_structures.f90 index d954836ea9..21b137243f 100644 --- a/var/da/da_setup_structures/da_setup_structures.f90 +++ b/var/da/da_setup_structures/da_setup_structures.f90 @@ -64,7 +64,7 @@ module da_setup_structures fmt_info, fmt_srfc, fmt_each, unit_end, max_ext_its, & psi_chi_factor, psi_t_factor, psi_ps_factor, psi_rh_factor, & chi_u_t_factor, chi_u_ps_factor,chi_u_rh_factor, t_u_rh_factor, ps_u_rh_factor, & - interpolate_stats, be_eta, thin_rainobs, fgat_rain_flags, use_iasiobs, & + interpolate_stats, be_eta, thin_rainobs, fgat_rain_flags, use_iasiobs,use_ahiobs, & use_seviriobs, jds_int, jde_int, anal_type_hybrid_dual_res, use_amsr2obs, nrange, use_4denvar use da_control, only: rden_bin, use_lsac use da_control, only: use_cv_w diff --git a/var/da/da_tools/da_get_time_slots.inc b/var/da/da_tools/da_get_time_slots.inc index 0dc9cd1378..e9720ab503 100644 --- a/var/da/da_tools/da_get_time_slots.inc +++ b/var/da/da_tools/da_get_time_slots.inc @@ -43,7 +43,8 @@ subroutine da_get_time_slots(nt,tmin,tana,tmax,time_slots,itime_ana) if (nt > 1) then dt = (time_slots(nt)-time_slots(0))/float(nt-1) time_slots(1) = time_slots(0)+dt*0.5 - do it=2,nt-1 +! do it=2,nt-1 + do it=2,nt !wuyl time_slots(it) = time_slots(it-1)+dt end do end if diff --git a/var/da/da_transfer_model/da_transfer_xatowrf.inc b/var/da/da_transfer_model/da_transfer_xatowrf.inc index becab0f5c2..ccea3d7ba1 100644 --- a/var/da/da_transfer_model/da_transfer_xatowrf.inc +++ b/var/da/da_transfer_model/da_transfer_xatowrf.inc @@ -442,18 +442,15 @@ subroutine da_transfer_xatowrf(grid, config_flags) grid%moist(i,j,k,P_QV) = grid%moist(i,j,k,P_QV)+q_cgrid(i,j,k) end if - if (size(grid%moist,dim=4) >= 4) then - grid%moist(i,j,k,p_qc) = max(grid%moist(i,j,k,p_qc) + grid%xa%qcw(i,j,k), 0.0) - grid%moist(i,j,k,p_qr) = max(grid%moist(i,j,k,p_qr) + grid%xa%qrn(i,j,k), 0.0) + if ( cloud_cv_options >= 1 ) then + if ( f_qc ) grid%moist(i,j,k,p_qc) = max(grid%moist(i,j,k,p_qc) + grid%xa%qcw(i,j,k), 0.0) + if ( f_qr ) grid%moist(i,j,k,p_qr) = max(grid%moist(i,j,k,p_qr) + grid%xa%qrn(i,j,k), 0.0) end if - if (size(grid%moist,dim=4) >= 6) then - grid%moist(i,j,k,p_qi) = max(grid%moist(i,j,k,p_qi) + grid%xa%qci(i,j,k), 0.0) - grid%moist(i,j,k,p_qs) = max(grid%moist(i,j,k,p_qs) + grid%xa%qsn(i,j,k), 0.0) - end if - - if (size(grid%moist,dim=4) >= 7) then - grid%moist(i,j,k,p_qg) = max(grid%moist(i,j,k,p_qg) + grid%xa%qgr(i,j,k), 0.0) + if ( cloud_cv_options >= 2 ) then + if ( f_qi ) grid%moist(i,j,k,p_qi) = max(grid%moist(i,j,k,p_qi) + grid%xa%qci(i,j,k), 0.0) + if ( f_qs ) grid%moist(i,j,k,p_qs) = max(grid%moist(i,j,k,p_qs) + grid%xa%qsn(i,j,k), 0.0) + if ( f_qg ) grid%moist(i,j,k,p_qg) = max(grid%moist(i,j,k,p_qg) + grid%xa%qgr(i,j,k), 0.0) end if end do end do diff --git a/var/run/VARBC.in b/var/run/VARBC.in deleted file mode 100644 index 9d7d52d5b1..0000000000 --- a/var/run/VARBC.in +++ /dev/null @@ -1,2147 +0,0 @@ - VARBC version 1.0 - Number of instruments: - 34 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 1 15 3 15 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9281.9 11619.0 294.4 30.5 7.2 80.0 1107.7 - 0.0 147.2 172.9 6.7 11.9 5.4 104.1 1955.8 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 2 2 0 0 0 0 0 0 0 0 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 3 3 0 0 0 0 0 0 0 0 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 4 4 0 0 0 0 0 0 0 0 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 5 5 0 0 0 0 0 0 0 0 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 6 6 0 0 0 0 0 0 0 0 1.195 0.009 -0.048 0.082 -0.055 -1.055 0.894 -0.481 - 7 7 0 0 0 0 0 0 0 0 1.653 0.037 -0.072 0.066 -0.097 -1.610 0.345 0.302 - 8 8 0 0 0 0 0 0 0 0 0.582 0.253 -0.041 -0.042 -0.031 -0.803 0.227 0.076 - 9 9 0 0 0 0 0 0 0 0 1.696 -0.085 -0.265 0.164 -0.152 0.080 -0.876 0.257 - 10 10 0 0 0 0 0 0 0 0 1.696 -0.085 -0.265 0.164 -0.152 0.080 -0.876 0.257 - 11 11 0 0 0 0 0 0 0 0 1.696 -0.085 -0.265 0.164 -0.152 0.080 -0.876 0.257 - 12 12 0 0 0 0 0 0 0 0 1.696 -0.085 -0.265 0.164 -0.152 0.080 -0.876 0.257 - 13 13 0 0 0 0 0 0 0 0 1.696 -0.085 -0.265 0.164 -0.152 0.080 -0.876 0.257 - 14 14 0 0 0 0 0 0 0 0 1.696 -0.085 -0.265 0.164 -0.152 0.080 -0.876 0.257 - 15 15 0 0 0 0 0 0 0 0 1.696 -0.085 -0.265 0.164 -0.152 0.080 -0.876 0.257 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 1 16 3 15 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9297.9 11421.4 297.7 33.7 13.7 269.4 6111.7 - 0.0 184.5 228.6 5.9 11.5 9.0 276.4 7844.2 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 2 2 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 3 3 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 4 4 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 5 5 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 6 6 0 0 0 0 0 0 0 0 1.238 0.505 -0.218 -0.057 -0.027 -0.884 1.095 -0.241 - 7 7 0 0 0 0 0 0 0 0 0.487 0.456 -0.179 -0.142 0.028 -2.095 1.520 0.657 - 8 8 0 0 0 0 0 0 0 0 0.235 0.233 -0.161 -0.125 0.083 -1.252 0.674 0.915 - 9 9 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 10 10 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 11 11 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 12 12 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 13 13 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 14 14 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 15 15 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 1 18 3 15 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9297.9 11421.4 297.7 33.7 13.7 269.4 6111.7 - 0.0 184.5 228.6 5.9 11.5 9.0 276.4 7844.2 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 2 2 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 3 3 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 4 4 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 5 5 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 6 6 0 0 0 0 0 0 0 0 1.238 0.505 -0.218 -0.057 -0.027 -0.884 1.095 -0.241 - 7 7 0 0 0 0 0 0 0 0 0.487 0.456 -0.179 -0.142 0.028 -2.095 1.520 0.657 - 8 8 0 0 0 0 0 0 0 0 0.235 0.233 -0.161 -0.125 0.083 -1.252 0.674 0.915 - 9 9 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 10 10 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 11 11 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 12 12 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 13 13 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 14 14 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 15 15 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 1 19 3 15 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9297.9 11421.4 297.7 33.7 13.7 269.4 6111.7 - 0.0 184.5 228.6 5.9 11.5 9.0 276.4 7844.2 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 2 2 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 3 3 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 4 4 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 5 5 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 6 6 0 0 0 0 0 0 0 0 1.238 0.505 -0.218 -0.057 -0.027 -0.884 1.095 -0.241 - 7 7 0 0 0 0 0 0 0 0 0.487 0.456 -0.179 -0.142 0.028 -2.095 1.520 0.657 - 8 8 0 0 0 0 0 0 0 0 0.235 0.233 -0.161 -0.125 0.083 -1.252 0.674 0.915 - 9 9 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 10 10 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 11 11 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 12 12 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 13 13 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 14 14 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 15 15 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 23 1 40 4 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9297.9 11421.4 297.7 33.7 13.7 269.4 6111.7 - 0.0 184.5 228.6 5.9 11.5 9.0 276.4 7844.2 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 2 2 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 3 3 0 0 0 0 0 0 0 0 0.487 0.456 -0.179 -0.142 0.028 -2.095 1.520 0.657 - 4 4 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ -23 2 40 4 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9297.9 11421.4 297.7 33.7 13.7 269.4 6111.7 - 0.0 184.5 228.6 5.9 11.5 9.0 276.4 7844.2 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 2 2 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 3 3 0 0 0 0 0 0 0 0 0.487 0.456 -0.179 -0.142 0.028 -2.095 1.520 0.657 - 4 4 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 10 1 3 15 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9297.9 11421.4 297.7 33.7 13.7 269.4 6111.7 - 0.0 184.5 228.6 5.9 11.5 9.0 276.4 7844.2 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 - 2 2 0 0 0 0 0 0 0 0 - 3 3 0 0 0 0 0 0 0 0 - 4 4 0 0 0 0 0 0 0 0 - 5 5 0 0 0 0 0 0 0 0 - 6 6 0 0 0 0 0 0 0 0 - 7 7 0 0 0 0 0 0 0 0 - 8 8 0 0 0 0 0 0 0 0 - 9 9 0 0 0 0 0 0 0 0 - 10 10 0 0 0 0 0 0 0 0 - 11 11 0 0 0 0 0 0 0 0 - 12 12 0 0 0 0 0 0 0 0 - 13 13 0 0 0 0 0 0 0 0 - 14 14 0 0 0 0 0 0 0 0 - 15 15 0 0 0 0 0 0 0 0 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 10 2 3 15 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9297.9 11421.4 297.7 33.7 13.7 269.4 6111.7 - 0.0 184.5 228.6 5.9 11.5 9.0 276.4 7844.2 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 2 2 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 3 3 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 4 4 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 5 5 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 6 6 0 0 0 0 0 0 0 0 1.238 0.505 -0.218 -0.057 -0.027 -0.884 1.095 -0.241 - 7 7 0 0 0 0 0 0 0 0 0.487 0.456 -0.179 -0.142 0.028 -2.095 1.520 0.657 - 8 8 0 0 0 0 0 0 0 0 0.235 0.233 -0.161 -0.125 0.083 -1.252 0.674 0.915 - 9 9 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 10 10 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 11 11 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 12 12 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 13 13 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 14 14 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 15 15 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 1 15 4 5 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9279.4 11625.1 294.3 30.4 20.7 703.6 29535.0 - 0.0 152.7 163.7 6.8 12.5 16.6 945.7 53363.9 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 8.995 1.633 0.121 4.111 -1.963 -1.314 5.795 -2.646 - 2 2 0 0 0 0 0 0 0 0 8.995 1.633 0.121 4.111 -1.963 -1.314 5.795 -2.646 - 3 3 0 0 0 0 0 0 0 0 8.995 1.633 0.121 4.111 -1.963 -1.314 5.795 -2.646 - 4 4 0 0 0 0 0 0 0 0 3.321 0.371 -1.303 1.339 -0.457 16.761 -17.252 5.303 - 5 5 0 0 0 0 0 0 0 0 3.439 -0.617 -1.034 1.374 -0.928 -4.139 7.309 -2.178 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 1 16 4 5 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9340.6 11468.1 297.7 38.1 43.5 2647.7 184372.6 - 0.0 144.3 122.7 5.9 11.5 27.5 2588.9 223562.0 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 8.995 1.633 0.121 4.111 -1.963 -1.314 5.795 -2.646 - 2 2 0 0 0 0 0 0 0 0 8.995 1.633 0.121 4.111 -1.963 -1.314 5.795 -2.646 - 3 3 0 0 0 0 0 0 0 0 4.308 -1.406 0.210 2.250 0.538 3.227 -4.057 1.333 - 4 4 0 0 0 0 0 0 0 0 3.403 -0.786 0.049 1.880 0.615 1.483 -0.080 -1.417 - 5 5 0 0 0 0 0 0 0 0 0.482 -0.939 0.107 2.587 0.215 -2.675 5.244 -2.241 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 1 17 4 5 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9340.6 11468.1 297.7 38.1 43.5 2647.7 184372.6 - 0.0 144.3 122.7 5.9 11.5 27.5 2588.9 223562.0 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 8.995 1.633 0.121 4.111 -1.963 -1.314 5.795 -2.646 - 2 2 0 0 0 0 0 0 0 0 8.995 1.633 0.121 4.111 -1.963 -1.314 5.795 -2.646 - 3 3 0 0 0 0 0 0 0 0 4.308 -1.406 0.210 2.250 0.538 3.227 -4.057 1.333 - 4 4 0 0 0 0 0 0 0 0 3.403 -0.786 0.049 1.880 0.615 1.483 -0.080 -1.417 - 5 5 0 0 0 0 0 0 0 0 0.482 -0.939 0.107 2.587 0.215 -2.675 5.244 -2.241 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 1 18 15 5 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9340.6 11468.1 297.7 38.1 43.5 2647.7 184372.6 - 0.0 144.3 122.7 5.9 11.5 27.5 2588.9 223562.0 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 8.995 1.633 0.121 4.111 -1.963 -1.314 5.795 -2.646 - 2 2 0 0 0 0 0 0 0 0 8.995 1.633 0.121 4.111 -1.963 -1.314 5.795 -2.646 - 3 3 0 0 0 0 0 0 0 0 4.308 -1.406 0.210 2.250 0.538 3.227 -4.057 1.333 - 4 4 0 0 0 0 0 0 0 0 3.403 -0.786 0.049 1.880 0.615 1.483 -0.080 -1.417 - 5 5 0 0 0 0 0 0 0 0 0.482 -0.939 0.107 2.587 0.215 -2.675 5.244 -2.241 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 1 19 15 5 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9340.6 11468.1 297.7 38.1 43.5 2647.7 184372.6 - 0.0 144.3 122.7 5.9 11.5 27.5 2588.9 223562.0 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 8.995 1.633 0.121 4.111 -1.963 -1.314 5.795 -2.646 - 2 2 0 0 0 0 0 0 0 0 8.995 1.633 0.121 4.111 -1.963 -1.314 5.795 -2.646 - 3 3 0 0 0 0 0 0 0 0 4.308 -1.406 0.210 2.250 0.538 3.227 -4.057 1.333 - 4 4 0 0 0 0 0 0 0 0 3.403 -0.786 0.049 1.880 0.615 1.483 -0.080 -1.417 - 5 5 0 0 0 0 0 0 0 0 0.482 -0.939 0.107 2.587 0.215 -2.675 5.244 -2.241 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 23 1 41 5 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9340.6 11468.1 297.7 38.1 43.5 2647.7 184372.6 - 0.0 144.3 122.7 5.9 11.5 27.5 2588.9 223562.0 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 8.995 1.633 0.121 4.111 -1.963 -1.314 5.795 -2.646 - 2 2 0 0 0 0 0 0 0 0 8.995 1.633 0.121 4.111 -1.963 -1.314 5.795 -2.646 - 3 3 0 0 0 0 0 0 0 0 4.308 -1.406 0.210 2.250 0.538 3.227 -4.057 1.333 - 4 4 0 0 0 0 0 0 0 0 3.403 -0.786 0.049 1.880 0.615 1.483 -0.080 -1.417 - 5 5 0 0 0 0 0 0 0 0 0.482 -0.939 0.107 2.587 0.215 -2.675 5.244 -2.241 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ -23 2 41 5 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9340.6 11468.1 297.7 38.1 43.5 2647.7 184372.6 - 0.0 144.3 122.7 5.9 11.5 27.5 2588.9 223562.0 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 8.995 1.633 0.121 4.111 -1.963 -1.314 5.795 -2.646 - 2 2 0 0 0 0 0 0 0 0 8.995 1.633 0.121 4.111 -1.963 -1.314 5.795 -2.646 - 3 3 0 0 0 0 0 0 0 0 4.308 -1.406 0.210 2.250 0.538 3.227 -4.057 1.333 - 4 4 0 0 0 0 0 0 0 0 3.403 -0.786 0.049 1.880 0.615 1.483 -0.080 -1.417 - 5 5 0 0 0 0 0 0 0 0 0.482 -0.939 0.107 2.587 0.215 -2.675 5.244 -2.241 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 10 1 15 5 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9340.6 11468.1 297.7 38.1 43.5 2647.7 184372.6 - 0.0 144.3 122.7 5.9 11.5 27.5 2588.9 223562.0 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 - 2 2 0 0 0 0 0 0 0 0 - 3 3 0 0 0 0 0 0 0 0 - 4 4 0 0 0 0 0 0 0 0 - 5 5 0 0 0 0 0 0 0 0 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 10 2 15 5 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9340.6 11468.1 297.7 38.1 43.5 2647.7 184372.6 - 0.0 144.3 122.7 5.9 11.5 27.5 2588.9 223562.0 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 8.995 1.633 0.121 4.111 -1.963 -1.314 5.795 -2.646 - 2 2 0 0 0 0 0 0 0 0 8.995 1.633 0.121 4.111 -1.963 -1.314 5.795 -2.646 - 3 3 0 0 0 0 0 0 0 0 4.308 -1.406 0.210 2.250 0.538 3.227 -4.057 1.333 - 4 4 0 0 0 0 0 0 0 0 3.403 -0.786 0.049 1.880 0.615 1.483 -0.080 -1.417 - 5 5 0 0 0 0 0 0 0 0 0.482 -0.939 0.107 2.587 0.215 -2.675 5.244 -2.241 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 17 0 19 22 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9297.9 11421.4 297.7 33.7 13.7 269.4 6111.7 - 0.0 184.5 228.6 5.9 11.5 9.0 276.4 7844.2 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 2 2 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 3 3 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 4 4 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 5 5 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 6 6 0 0 0 0 0 0 0 0 4.005 0.295 -0.208 -0.018 -0.005 3.615 -1.856 -1.841 - 7 7 0 0 0 0 0 0 0 0 1.238 0.505 -0.218 -0.057 -0.027 -0.884 1.095 -0.241 - 8 8 0 0 0 0 0 0 0 0 0.487 0.456 -0.179 -0.142 0.028 -2.095 1.520 0.657 - 9 9 0 0 0 0 0 0 0 0 0.235 0.233 -0.161 -0.125 0.083 -1.252 0.674 0.915 - 10 10 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 11 11 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 12 12 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 13 13 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 14 14 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 15 15 0 0 0 0 0 0 0 0 2.058 0.276 -0.487 0.067 0.132 0.717 -1.035 0.578 - 16 16 0 0 0 0 0 0 0 0 8.995 1.633 0.121 4.111 -1.963 -1.314 5.795 -2.646 - 17 17 0 0 0 0 0 0 0 0 8.995 1.633 0.121 4.111 -1.963 -1.314 5.795 -2.646 - 18 18 0 0 0 0 0 0 0 0 0.482 -0.939 0.107 2.587 0.215 -2.675 5.244 -2.241 - 19 19 0 0 0 0 0 0 0 0 0.482 -0.939 0.107 2.587 0.215 -2.675 5.244 -2.241 - 20 20 0 0 0 0 0 0 0 0 3.403 -0.786 0.049 1.880 0.615 1.483 -0.080 -1.417 - 21 21 0 0 0 0 0 0 0 0 4.308 -1.406 0.210 2.250 0.538 3.227 -4.057 1.333 - 22 22 0 0 0 0 0 0 0 0 4.308 -1.406 0.210 2.250 0.538 3.227 -4.057 1.333 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 2 16 10 24 5 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9281.9 11619.0 294.4 30.5 7.2 80.0 1107.7 - 0.0 147.2 172.9 6.7 11.9 5.4 104.1 1955.8 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 -1 -1 -1 8.995 1.633 0.121 4.111 -1.963 -1.314 5.795 -2.646 - 2 2 0 0 0 0 0 -1 -1 -1 8.995 1.633 0.121 4.111 -1.963 -1.314 5.795 -2.646 - 3 3 0 0 0 0 0 -1 -1 -1 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 4 4 0 0 0 0 0 -1 -1 -1 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 5 5 0 0 0 0 0 -1 -1 -1 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 6 6 0 0 0 0 0 -1 -1 -1 1.195 0.009 -0.048 0.082 -0.055 -1.055 0.894 -0.481 - 7 7 0 0 0 0 0 -1 -1 -1 1.195 0.009 -0.048 0.082 -0.055 -1.055 0.894 -0.481 - 8 8 0 0 0 0 0 -1 -1 -1 1.653 0.037 -0.072 0.066 -0.097 -1.610 0.345 0.302 - 9 9 0 0 0 0 0 -1 -1 -1 1.653 0.037 -0.072 0.066 -0.097 -1.610 0.345 0.302 - 10 10 0 0 0 0 0 -1 -1 -1 0.582 0.253 -0.041 -0.042 -0.031 -0.803 0.227 0.076 - 11 11 0 0 0 0 0 -1 -1 -1 1.696 -0.085 -0.265 0.164 -0.152 0.080 -0.876 0.257 - 12 12 0 0 0 0 0 -1 -1 -1 8.995 1.633 0.121 4.111 -1.963 -1.314 5.795 -2.646 - 13 13 0 0 0 0 0 -1 -1 -1 8.995 1.633 0.121 4.111 -1.963 -1.314 5.795 -2.646 - 14 14 0 0 0 0 0 -1 -1 -1 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 15 15 0 0 0 0 0 -1 -1 -1 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 16 16 0 0 0 0 0 -1 -1 -1 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 17 17 0 0 0 0 0 -1 -1 -1 1.195 0.009 -0.048 0.082 -0.055 -1.055 0.894 -0.481 - 18 18 0 0 0 0 0 -1 -1 -1 1.195 0.009 -0.048 0.082 -0.055 -1.055 0.894 -0.481 - 19 19 0 0 0 0 0 -1 -1 -1 1.653 0.037 -0.072 0.066 -0.097 -1.610 0.345 0.302 - 20 20 0 0 0 0 0 -1 -1 -1 1.653 0.037 -0.072 0.066 -0.097 -1.610 0.345 0.302 - 21 21 0 0 0 0 0 -1 -1 -1 0.582 0.253 -0.041 -0.042 -0.031 -0.803 0.227 0.076 - 22 22 0 0 0 0 0 -1 -1 -1 1.696 -0.085 -0.265 0.164 -0.152 0.080 -0.876 0.257 - 23 23 0 0 0 0 0 -1 -1 -1 0.582 0.253 -0.041 -0.042 -0.031 -0.803 0.227 0.076 - 24 24 0 0 0 0 0 -1 -1 -1 1.696 -0.085 -0.265 0.164 -0.152 0.080 -0.876 0.257 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 9 2 3 15 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9281.9 11619.0 294.4 30.5 7.2 80.0 1107.7 - 0.0 147.2 172.9 6.7 11.9 5.4 104.1 1955.8 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 2 2 0 0 0 0 0 0 0 0 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 3 3 0 0 0 0 0 0 0 0 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 4 4 0 0 0 0 0 0 0 0 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 5 5 0 0 0 0 0 0 0 0 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 6 6 0 0 0 0 0 0 0 0 1.195 0.009 -0.048 0.082 -0.055 -1.055 0.894 -0.481 - 7 7 0 0 0 0 0 0 0 0 1.653 0.037 -0.072 0.066 -0.097 -1.610 0.345 0.302 - 8 8 0 0 0 0 0 0 0 0 0.582 0.253 -0.041 -0.042 -0.031 -0.803 0.227 0.076 - 9 9 0 0 0 0 0 0 0 0 1.696 -0.085 -0.265 0.164 -0.152 0.080 -0.876 0.257 - 10 10 0 0 0 0 0 0 0 0 1.696 -0.085 -0.265 0.164 -0.152 0.080 -0.876 0.257 - 11 11 0 0 0 0 0 0 0 0 1.696 -0.085 -0.265 0.164 -0.152 0.080 -0.876 0.257 - 12 12 0 0 0 0 0 0 0 0 1.696 -0.085 -0.265 0.164 -0.152 0.080 -0.876 0.257 - 13 13 0 0 0 0 0 0 0 0 1.696 -0.085 -0.265 0.164 -0.152 0.080 -0.876 0.257 - 14 14 0 0 0 0 0 0 0 0 1.696 -0.085 -0.265 0.164 -0.152 0.080 -0.876 0.257 - 15 15 0 0 0 0 0 0 0 0 1.696 -0.085 -0.265 0.164 -0.152 0.080 -0.876 0.257 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 9 2 11 281 9 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 - 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 - 10000 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 -1 -1 -1 -1 0 0 0 -1 -3.500 0.000 0.000 0.000 - 2 6 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 3 7 0 -1 -1 -1 -1 0 0 0 -1 -4.065 -0.229 -0.036 0.454 - 4 10 0 -1 -1 -1 -1 0 0 0 -1 0.400 0.000 0.000 0.000 - 5 11 0 -1 -1 -1 -1 0 0 0 -1 1.600 0.000 0.000 0.000 - 6 15 0 -1 -1 -1 -1 0 0 0 -1 -8.858 -1.073 -0.409 2.544 - 7 16 0 -1 -1 -1 -1 0 0 0 -1 -3.300 0.000 0.000 0.000 - 8 17 0 -1 -1 -1 -1 0 0 0 -1 3.300 0.000 0.000 0.000 - 9 20 0 -1 -1 -1 -1 0 0 0 -1 -0.257 -0.208 -0.035 0.277 - 10 21 0 -1 -1 -1 -1 0 0 0 -1 -0.793 -0.102 -0.002 0.249 - 11 22 0 -1 -1 -1 -1 0 0 0 -1 0.062 0.066 -0.003 -0.010 - 12 24 0 -1 -1 -1 -1 0 0 0 -1 0.700 0.000 0.000 0.000 - 13 27 0 -1 -1 -1 -1 0 0 0 -1 -0.503 -0.148 -0.025 0.374 - 14 28 0 -1 -1 -1 -1 0 0 0 -1 -3.494 -0.250 -0.055 0.680 - 15 30 0 -1 -1 -1 -1 0 0 0 -1 3.400 0.000 0.000 0.000 - 16 36 0 -1 -1 -1 -1 0 0 0 -1 2.900 0.000 0.000 0.000 - 17 39 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 18 40 0 -1 -1 -1 -1 0 0 0 -1 -4.349 -0.167 -0.040 0.397 - 19 42 0 -1 -1 -1 -1 0 0 0 -1 1.900 0.000 0.000 0.000 - 20 51 0 -1 -1 -1 -1 0 0 0 -1 -1.900 0.000 0.000 0.000 - 21 52 0 -1 -1 -1 -1 0 0 0 -1 0.279 -0.141 -0.033 0.306 - 22 54 0 -1 -1 -1 -1 0 0 0 -1 7.500 0.000 0.000 0.000 - 23 55 0 -1 -1 -1 -1 0 0 0 -1 3.700 0.000 0.000 0.000 - 24 56 0 -1 -1 -1 -1 0 0 0 -1 1.500 0.000 0.000 0.000 - 25 59 0 -1 -1 -1 -1 0 0 0 -1 -0.700 0.000 0.000 0.000 - 26 62 0 -1 -1 -1 -1 0 0 0 -1 -3.600 0.000 0.000 0.000 - 27 63 0 -1 -1 -1 -1 0 0 0 -1 -1.200 0.000 0.000 0.000 - 28 68 0 -1 -1 -1 -1 0 0 0 -1 -1.800 0.000 0.000 0.000 - 29 69 0 -1 -1 -1 -1 0 0 0 -1 -0.102 -0.208 -0.056 0.516 - 30 71 0 -1 -1 -1 -1 0 0 0 -1 -2.600 0.000 0.000 0.000 - 31 72 0 -1 -1 -1 -1 0 0 0 -1 -2.488 -0.463 -0.152 1.276 - 32 73 0 -1 -1 -1 -1 0 0 0 -1 8.100 0.000 0.000 0.000 - 33 74 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 34 75 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 35 76 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 36 77 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 37 78 0 -1 -1 -1 -1 0 0 0 -1 9.700 0.000 0.000 0.000 - 38 79 0 -1 -1 -1 -1 0 0 0 -1 7.800 0.000 0.000 0.000 - 39 80 0 -1 -1 -1 -1 0 0 0 -1 4.500 0.000 0.000 0.000 - 40 82 0 -1 -1 -1 -1 0 0 0 -1 5.800 0.000 0.000 0.000 - 41 83 0 -1 -1 -1 -1 0 0 0 -1 4.600 0.000 0.000 0.000 - 42 84 0 -1 -1 -1 -1 0 0 0 -1 0.400 0.000 0.000 0.000 - 43 86 0 -1 -1 -1 -1 0 0 0 -1 -5.300 0.000 0.000 0.000 - 44 92 0 -1 -1 -1 -1 0 0 0 -1 -9.979 -0.797 -0.229 1.096 - 45 93 0 -1 -1 -1 -1 0 0 0 -1 -5.422 -0.308 -0.063 0.740 - 46 98 0 -1 -1 -1 -1 0 0 0 -1 -8.063 -0.738 -1.113 3.414 - 47 99 0 -1 -1 -1 -1 0 0 0 -1 -5.561 -0.518 -0.116 1.263 - 48 101 0 -1 -1 -1 -1 0 0 0 -1 1.900 0.000 0.000 0.000 - 49 104 0 -1 -1 -1 -1 0 0 0 -1 -6.559 -0.626 -0.149 1.479 - 50 105 0 -1 -1 -1 -1 0 0 0 -1 -4.747 -0.408 -0.061 0.886 - 51 108 0 -1 -1 -1 -1 0 0 0 -1 2.700 0.000 0.000 0.000 - 52 110 0 -1 -1 -1 -1 0 0 0 -1 -6.027 -0.433 -0.133 1.189 - 53 111 0 -1 -1 -1 -1 0 0 0 -1 -4.488 -0.415 -0.096 1.129 - 54 113 0 -1 -1 -1 -1 0 0 0 -1 3.400 0.000 0.000 0.000 - 55 116 0 -1 -1 -1 -1 0 0 0 -1 -3.907 -0.102 -0.040 0.362 - 56 117 0 -1 -1 -1 -1 0 0 0 -1 -4.978 -0.453 -0.119 1.213 - 57 123 0 -1 -1 -1 -1 0 0 0 -1 -4.606 -0.443 -0.093 1.037 - 58 124 0 -1 -1 -1 -1 0 0 0 -1 -2.900 0.000 0.000 0.000 - 59 128 0 -1 -1 -1 -1 0 0 0 -1 -3.851 -0.062 -0.020 0.163 - 60 129 0 -1 -1 -1 -1 0 0 0 -1 -0.800 -0.110 -0.017 0.280 - 61 138 0 -1 -1 -1 -1 0 0 0 -1 -5.155 -0.009 -0.049 0.305 - 62 139 0 -1 -1 -1 -1 0 0 0 -1 -4.237 0.093 0.000 -0.052 - 63 144 0 -1 -1 -1 -1 0 0 0 -1 -1.449 0.028 0.002 0.028 - 64 145 0 -1 -1 -1 -1 0 0 0 -1 -2.997 -0.085 -0.034 0.246 - 65 150 0 -1 -1 -1 -1 0 0 0 -1 -0.673 -0.043 -0.022 0.129 - 66 151 0 -1 -1 -1 -1 0 0 0 -1 -1.726 0.065 -0.003 -0.094 - 67 156 0 -1 -1 -1 -1 0 0 0 -1 -1.066 0.102 0.001 -0.116 - 68 157 0 -1 -1 -1 -1 0 0 0 -1 -1.418 0.114 0.009 -0.074 - 69 159 0 -1 -1 -1 -1 0 0 0 -1 1.300 0.000 0.000 0.000 - 70 162 0 -1 -1 -1 -1 0 0 0 -1 -0.744 0.095 -0.003 -0.158 - 71 165 0 -1 -1 -1 -1 0 0 0 -1 0.300 0.000 0.000 0.000 - 72 168 0 -1 -1 -1 -1 0 0 0 -1 -0.513 -0.022 -0.024 0.082 - 73 169 0 -1 -1 -1 -1 0 0 0 -1 -0.947 0.086 -0.007 -0.046 - 74 170 0 -1 -1 -1 -1 0 0 0 -1 -0.500 0.000 0.000 0.000 - 75 172 0 -1 -1 -1 -1 0 0 0 -1 -0.900 0.244 0.014 -0.343 - 76 173 0 -1 -1 -1 -1 0 0 0 -1 -0.045 0.174 0.004 -0.164 - 77 174 0 -1 -1 -1 -1 0 0 0 -1 -0.262 0.079 -0.012 -0.055 - 78 175 0 -1 -1 -1 -1 0 0 0 -1 -1.401 0.177 0.012 -0.116 - 79 177 0 -1 -1 -1 -1 0 0 0 -1 -0.400 0.000 0.000 0.000 - 80 179 0 -1 -1 -1 -1 0 0 0 -1 0.030 0.112 0.007 -0.116 - 81 180 0 -1 -1 -1 -1 0 0 0 -1 -0.062 0.062 -0.003 -0.036 - 82 182 0 -1 -1 -1 -1 0 0 0 -1 -0.400 0.000 0.000 0.000 - 83 185 0 -1 -1 -1 -1 0 0 0 -1 0.101 0.086 0.004 -0.010 - 84 186 0 -1 -1 -1 -1 0 0 0 -1 -0.420 0.278 0.012 -0.336 - 85 190 0 -1 -1 -1 -1 0 0 0 -1 1.250 0.491 0.041 -0.682 - 86 192 0 -1 -1 -1 -1 0 0 0 -1 0.103 0.078 0.000 0.014 - 87 198 0 -1 -1 -1 -1 0 0 0 -1 0.241 -0.055 -0.007 0.057 - 88 201 0 -1 -1 -1 -1 0 0 0 -1 1.160 0.060 -0.007 0.049 - 89 204 0 -1 -1 -1 -1 0 0 0 -1 0.584 0.019 -0.003 -0.007 - 90 207 0 -1 -1 -1 -1 0 0 0 -1 0.218 -0.025 -0.006 0.131 - 91 210 0 -1 -1 -1 -1 0 0 0 -1 4.710 1.162 0.127 -1.212 - 92 215 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 93 216 0 -1 -1 -1 -1 0 0 0 -1 8.257 1.529 0.258 -2.944 - 94 221 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 95 226 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 96 227 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 97 232 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 98 252 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 99 253 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 100 256 0 -1 -1 -1 -1 0 0 0 -1 8.400 0.000 0.000 0.000 - 101 257 0 -1 -1 -1 -1 0 0 0 -1 3.482 2.312 0.040 0.713 - 102 261 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 103 262 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 104 267 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 105 272 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 106 295 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 107 299 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 108 300 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 109 305 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 110 310 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 111 321 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 112 325 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 113 333 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 114 338 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 115 355 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 116 362 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 117 375 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 118 453 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 119 475 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 120 484 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 121 497 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 122 528 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 123 587 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 124 672 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 125 787 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 126 791 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 127 843 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 128 870 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 129 914 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 130 950 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 131 1003 0 -1 -1 -1 -1 0 0 0 -1 -5.900 0.000 0.000 0.000 - 132 1012 0 -1 -1 -1 -1 0 0 0 -1 -9.500 0.000 0.000 0.000 - 133 1019 0 -1 -1 -1 -1 0 0 0 -1 -9.800 0.000 0.000 0.000 - 134 1024 0 -1 -1 -1 -1 0 0 0 -1 -9.500 0.000 0.000 0.000 - 135 1030 0 -1 -1 -1 -1 0 0 0 -1 -9.900 0.000 0.000 0.000 - 136 1038 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 137 1048 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 138 1069 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 139 1079 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 140 1082 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 141 1083 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 142 1088 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 143 1090 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 144 1092 0 -1 -1 -1 -1 0 0 0 -1 3.200 0.000 0.000 0.000 - 145 1095 0 -1 -1 -1 -1 0 0 0 -1 -8.500 0.000 0.000 0.000 - 146 1104 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 147 1111 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 148 1115 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 149 1116 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 150 1119 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 151 1120 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 152 1123 0 -1 -1 -1 -1 0 0 0 -1 -9.800 0.000 0.000 0.000 - 153 1130 0 -1 -1 -1 -1 0 0 0 -1 -7.100 0.000 0.000 0.000 - 154 1138 0 -1 -1 -1 -1 0 0 0 -1 -1.600 0.000 0.000 0.000 - 155 1142 0 -1 -1 -1 -1 0 0 0 -1 -1.900 0.000 0.000 0.000 - 156 1178 0 -1 -1 -1 -1 0 0 0 -1 -2.000 0.000 0.000 0.000 - 157 1199 0 -1 -1 -1 -1 0 0 0 -1 -2.300 0.000 0.000 0.000 - 158 1206 0 -1 -1 -1 -1 0 0 0 -1 -2.200 0.000 0.000 0.000 - 159 1221 0 -1 -1 -1 -1 0 0 0 -1 -2.500 0.000 0.000 0.000 - 160 1237 0 -1 -1 -1 -1 0 0 0 -1 -1.800 0.000 0.000 0.000 - 161 1252 0 -1 -1 -1 -1 0 0 0 -1 -2.300 0.000 0.000 0.000 - 162 1260 0 -1 -1 -1 -1 0 0 0 -1 -1.300 0.000 0.000 0.000 - 163 1263 0 -1 -1 -1 -1 0 0 0 -1 -0.700 0.000 0.000 0.000 - 164 1266 0 -1 -1 -1 -1 0 0 0 -1 -0.100 0.000 0.000 0.000 - 165 1285 0 -1 -1 -1 -1 0 0 0 -1 -0.900 0.000 0.000 0.000 - 166 1301 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 167 1304 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 168 1329 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 169 1371 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 170 1382 0 -1 -1 -1 -1 0 0 0 -1 -0.908 0.075 -0.082 0.334 - 171 1415 0 -1 -1 -1 -1 0 0 0 -1 -0.092 0.091 -0.120 0.383 - 172 1424 0 -1 -1 -1 -1 0 0 0 -1 0.960 0.072 -0.128 0.265 - 173 1449 0 -1 -1 -1 -1 0 0 0 -1 0.287 0.285 -0.111 0.144 - 174 1455 0 -1 -1 -1 -1 0 0 0 -1 0.758 0.108 -0.144 0.391 - 175 1466 0 -1 -1 -1 -1 0 0 0 -1 2.837 -0.042 -0.191 0.094 - 176 1477 0 -1 -1 -1 -1 0 0 0 -1 0.812 0.086 -0.151 0.441 - 177 1500 0 -1 -1 -1 -1 0 0 0 -1 1.089 0.050 -0.142 0.376 - 178 1519 0 -1 -1 -1 -1 0 0 0 -1 1.195 -0.006 -0.155 0.349 - 179 1538 0 -1 -1 -1 -1 0 0 0 -1 1.503 -0.057 -0.156 0.293 - 180 1545 0 -1 -1 -1 -1 0 0 0 -1 1.070 0.061 -0.143 0.329 - 181 1565 0 -1 -1 -1 -1 0 0 0 -1 2.235 -0.044 -0.169 0.152 - 182 1574 0 -1 -1 -1 -1 0 0 0 -1 2.407 -0.098 -0.195 0.042 - 183 1583 0 -1 -1 -1 -1 0 0 0 -1 2.066 -0.061 -0.166 0.220 - 184 1593 0 -1 -1 -1 -1 0 0 0 -1 2.447 -0.018 -0.161 0.338 - 185 1614 0 -1 -1 -1 -1 0 0 0 -1 3.333 -0.055 -0.136 0.204 - 186 1627 0 -1 -1 -1 -1 0 0 0 -1 2.443 -0.082 -0.177 0.149 - 187 1636 0 -1 -1 -1 -1 0 0 0 -1 2.861 -0.106 -0.193 0.101 - 188 1644 0 -1 -1 -1 -1 0 0 0 -1 2.755 -0.155 -0.149 0.364 - 189 1652 0 -1 -1 -1 -1 0 0 0 -1 2.750 -0.052 -0.173 0.167 - 190 1669 0 -1 -1 -1 -1 0 0 0 -1 3.185 -0.138 -0.215 0.057 - 191 1674 0 -1 -1 -1 -1 0 0 0 -1 3.208 -0.038 -0.103 0.109 - 192 1681 0 -1 -1 -1 -1 0 0 0 -1 3.495 -0.063 -0.163 0.232 - 193 1694 0 -1 -1 -1 -1 0 0 0 -1 4.130 -0.142 -0.221 0.074 - 194 1708 0 -1 -1 -1 -1 0 0 0 -1 3.626 -0.186 -0.230 0.154 - 195 1717 0 -1 -1 -1 -1 0 0 0 -1 3.683 0.073 -0.134 0.031 - 196 1723 0 -1 -1 -1 -1 0 0 0 -1 3.435 -0.127 -0.236 0.240 - 197 1740 0 -1 -1 -1 -1 0 0 0 -1 3.892 -0.116 -0.235 0.159 - 198 1748 0 -1 -1 -1 -1 0 0 0 -1 3.737 0.053 -0.223 0.186 - 199 1751 0 -1 -1 -1 -1 0 0 0 -1 3.919 -0.080 -0.079 0.059 - 200 1756 0 -1 -1 -1 -1 0 0 0 -1 3.688 -0.042 -0.205 0.343 - 201 1763 0 -1 -1 -1 -1 0 0 0 -1 3.360 -0.045 -0.098 0.146 - 202 1766 0 -1 -1 -1 -1 0 0 0 -1 3.369 -0.019 -0.175 0.322 - 203 1771 0 -1 -1 -1 -1 0 0 0 -1 3.136 -0.079 -0.224 0.101 - 204 1777 0 -1 -1 -1 -1 0 0 0 -1 3.419 -0.082 -0.227 0.236 - 205 1780 0 -1 -1 -1 -1 0 0 0 -1 3.243 0.084 -0.140 -0.044 - 206 1783 0 -1 -1 -1 -1 0 0 0 -1 3.606 -0.076 -0.189 0.218 - 207 1794 0 -1 -1 -1 -1 0 0 0 -1 3.430 -0.081 -0.232 0.348 - 208 1800 0 -1 -1 -1 -1 0 0 0 -1 3.351 0.007 -0.222 0.087 - 209 1803 0 -1 -1 -1 -1 0 0 0 -1 3.531 -0.002 -0.121 0.079 - 210 1806 0 -1 -1 -1 -1 0 0 0 -1 3.334 -0.053 -0.233 0.093 - 211 1812 0 -1 -1 -1 -1 0 0 0 -1 2.736 -0.076 -0.057 -0.055 - 212 1826 0 -1 -1 -1 -1 0 0 0 -1 3.152 -0.058 -0.192 -0.008 - 213 1843 0 -1 -1 -1 -1 0 0 0 -1 2.264 0.000 -0.182 -0.001 - 214 1852 0 -1 -1 -1 -1 0 0 0 -1 2.360 -0.131 -0.191 0.114 - 215 1865 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 216 1866 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 217 1868 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 218 1869 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 219 1872 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 220 1873 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 221 1876 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 222 1881 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 223 1882 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 224 1883 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 225 1911 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 226 1917 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 227 1918 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 228 1924 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 229 1928 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 230 1937 0 -1 -1 -1 -1 0 0 0 -1 -0.400 0.000 0.000 0.000 - 231 1941 0 -1 -1 -1 -1 0 0 0 -1 -0.700 0.000 0.000 0.000 - 232 2099 0 -1 -1 -1 -1 0 0 0 -1 4.200 0.000 0.000 0.000 - 233 2100 0 -1 -1 -1 -1 0 0 0 -1 2.300 0.000 0.000 0.000 - 234 2101 0 -1 -1 -1 -1 0 0 0 -1 4.000 0.000 0.000 0.000 - 235 2103 0 -1 -1 -1 -1 0 0 0 -1 1.000 0.000 0.000 0.000 - 236 2104 0 -1 -1 -1 -1 0 0 0 -1 0.900 0.000 0.000 0.000 - 237 2106 0 -1 -1 -1 -1 0 0 0 -1 0.100 0.000 0.000 0.000 - 238 2107 0 -1 -1 -1 -1 0 0 0 -1 0.500 0.000 0.000 0.000 - 239 2108 0 -1 -1 -1 -1 0 0 0 -1 1.900 0.000 0.000 0.000 - 240 2109 0 -1 -1 -1 -1 0 0 0 -1 4.400 0.000 0.000 0.000 - 241 2110 0 -1 -1 -1 -1 0 0 0 -1 9.300 0.000 0.000 0.000 - 242 2111 0 -1 -1 -1 -1 0 0 0 -1 5.700 0.000 0.000 0.000 - 243 2112 0 -1 -1 -1 -1 0 0 0 -1 0.500 0.000 0.000 0.000 - 244 2113 0 -1 -1 -1 -1 0 0 0 -1 -0.400 0.000 0.000 0.000 - 245 2114 0 -1 -1 -1 -1 0 0 0 -1 2.200 0.000 0.000 0.000 - 246 2115 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - 247 2116 0 -1 -1 -1 -1 0 0 0 -1 -1.500 0.000 0.000 0.000 - 248 2117 0 -1 -1 -1 -1 0 0 0 -1 -1.300 0.000 0.000 0.000 - 249 2118 0 -1 -1 -1 -1 0 0 0 -1 -1.500 0.000 0.000 0.000 - 250 2119 0 -1 -1 -1 -1 0 0 0 -1 -1.400 0.000 0.000 0.000 - 251 2120 0 -1 -1 -1 -1 0 0 0 -1 -1.600 0.000 0.000 0.000 - 252 2121 0 -1 -1 -1 -1 0 0 0 -1 -1.700 0.000 0.000 0.000 - 253 2122 0 -1 -1 -1 -1 0 0 0 -1 -1.600 0.000 0.000 0.000 - 254 2123 0 -1 -1 -1 -1 0 0 0 -1 -1.500 0.000 0.000 0.000 - 255 2128 0 -1 -1 -1 -1 0 0 0 -1 -1.400 0.000 0.000 0.000 - 256 2134 0 -1 -1 -1 -1 0 0 0 -1 -1.300 0.000 0.000 0.000 - 257 2141 0 -1 -1 -1 -1 0 0 0 -1 -1.300 0.000 0.000 0.000 - 258 2145 0 -1 -1 -1 -1 0 0 0 -1 -1.100 0.000 0.000 0.000 - 259 2149 0 -1 -1 -1 -1 0 0 0 -1 -1.000 0.000 0.000 0.000 - 260 2153 0 -1 -1 -1 -1 0 0 0 -1 -1.100 0.000 0.000 0.000 - 261 2164 0 -1 -1 -1 -1 0 0 0 -1 -1.000 0.000 0.000 0.000 - 262 2189 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - 263 2197 0 -1 -1 -1 -1 0 0 0 -1 -1.200 0.000 0.000 0.000 - 264 2209 0 -1 -1 -1 -1 0 0 0 -1 -0.700 0.000 0.000 0.000 - 265 2226 0 -1 -1 -1 -1 0 0 0 -1 -1.100 0.000 0.000 0.000 - 266 2234 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - 267 2280 0 -1 -1 -1 -1 0 0 0 -1 -0.900 0.000 0.000 0.000 - 268 2318 0 -1 -1 -1 -1 0 0 0 -1 -0.800 0.000 0.000 0.000 - 269 2321 0 -1 -1 -1 -1 0 0 0 -1 -0.300 0.000 0.000 0.000 - 270 2325 0 -1 -1 -1 -1 0 0 0 -1 0.300 0.000 0.000 0.000 - 271 2328 0 -1 -1 -1 -1 0 0 0 -1 -1.000 0.000 0.000 0.000 - 272 2333 0 -1 -1 -1 -1 0 0 0 -1 -1.400 0.000 0.000 0.000 - 273 2339 0 -1 -1 -1 -1 0 0 0 -1 0.200 0.000 0.000 0.000 - 274 2348 0 -1 -1 -1 -1 0 0 0 -1 -1.000 0.000 0.000 0.000 - 275 2353 0 -1 -1 -1 -1 0 0 0 -1 0.200 0.000 0.000 0.000 - 276 2355 0 -1 -1 -1 -1 0 0 0 -1 -0.200 0.000 0.000 0.000 - 277 2357 0 -1 -1 -1 -1 0 0 0 -1 -0.300 0.000 0.000 0.000 - 278 2363 0 -1 -1 -1 -1 0 0 0 -1 -0.800 0.000 0.000 0.000 - 279 2370 0 -1 -1 -1 -1 0 0 0 -1 0.200 0.000 0.000 0.000 - 280 2371 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - 281 2377 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 19 0 0 19 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9281.9 11619.0 294.4 30.5 7.2 80.0 1107.7 - 0.0 147.2 172.9 6.7 11.9 5.4 104.1 1955.8 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 - 2 2 0 0 0 0 0 0 0 0 - 3 3 0 0 0 0 0 0 0 0 - 4 4 0 0 0 0 0 0 0 0 - 5 5 0 0 0 0 0 0 0 0 - 6 6 0 0 0 0 0 0 0 0 - 7 7 0 0 0 0 0 0 0 0 - 8 8 0 0 0 0 0 0 0 0 - 9 9 0 0 0 0 0 0 0 0 - 10 10 0 0 0 0 0 0 0 0 - 11 11 0 0 0 0 0 0 0 0 - 12 12 0 0 0 0 0 0 0 0 - 13 13 0 0 0 0 0 0 0 0 - 14 14 0 0 0 0 0 0 0 0 - 15 15 0 0 0 0 0 0 0 0 - 16 16 0 0 0 0 0 0 0 0 - 17 17 0 0 0 0 0 0 0 0 - 18 18 0 0 0 0 0 0 0 0 - 19 19 0 0 0 0 0 0 0 0 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 1 11 0 19 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9281.9 11619.0 294.4 30.5 7.2 80.0 1107.7 - 0.0 147.2 172.9 6.7 11.9 5.4 104.1 1955.8 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 - 2 2 0 0 0 0 0 0 0 0 - 3 3 0 0 0 0 0 0 0 0 - 4 4 0 0 0 0 0 0 0 0 - 5 5 0 0 0 0 0 0 0 0 - 6 6 0 0 0 0 0 0 0 0 - 7 7 0 0 0 0 0 0 0 0 - 8 8 0 0 0 0 0 0 0 0 - 9 9 0 0 0 0 0 0 0 0 - 10 10 0 0 0 0 0 0 0 0 - 11 11 0 0 0 0 0 0 0 0 - 12 12 0 0 0 0 0 0 0 0 - 13 13 0 0 0 0 0 0 0 0 - 14 14 0 0 0 0 0 0 0 0 - 15 15 0 0 0 0 0 0 0 0 - 16 16 0 0 0 0 0 0 0 0 - 17 17 0 0 0 0 0 0 0 0 - 18 18 0 0 0 0 0 0 0 0 - 19 19 0 0 0 0 0 0 0 0 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 1 12 0 19 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9281.9 11619.0 294.4 30.5 7.2 80.0 1107.7 - 0.0 147.2 172.9 6.7 11.9 5.4 104.1 1955.8 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 - 2 2 0 0 0 0 0 0 0 0 - 3 3 0 0 0 0 0 0 0 0 - 4 4 0 0 0 0 0 0 0 0 - 5 5 0 0 0 0 0 0 0 0 - 6 6 0 0 0 0 0 0 0 0 - 7 7 0 0 0 0 0 0 0 0 - 8 8 0 0 0 0 0 0 0 0 - 9 9 0 0 0 0 0 0 0 0 - 10 10 0 0 0 0 0 0 0 0 - 11 11 0 0 0 0 0 0 0 0 - 12 12 0 0 0 0 0 0 0 0 - 13 13 0 0 0 0 0 0 0 0 - 14 14 0 0 0 0 0 0 0 0 - 15 15 0 0 0 0 0 0 0 0 - 16 16 0 0 0 0 0 0 0 0 - 17 17 0 0 0 0 0 0 0 0 - 18 18 0 0 0 0 0 0 0 0 - 19 19 0 0 0 0 0 0 0 0 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 1 14 0 19 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9281.9 11619.0 294.4 30.5 7.2 80.0 1107.7 - 0.0 147.2 172.9 6.7 11.9 5.4 104.1 1955.8 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 - 2 2 0 0 0 0 0 0 0 0 - 3 3 0 0 0 0 0 0 0 0 - 4 4 0 0 0 0 0 0 0 0 - 5 5 0 0 0 0 0 0 0 0 - 6 6 0 0 0 0 0 0 0 0 - 7 7 0 0 0 0 0 0 0 0 - 8 8 0 0 0 0 0 0 0 0 - 9 9 0 0 0 0 0 0 0 0 - 10 10 0 0 0 0 0 0 0 0 - 11 11 0 0 0 0 0 0 0 0 - 12 12 0 0 0 0 0 0 0 0 - 13 13 0 0 0 0 0 0 0 0 - 14 14 0 0 0 0 0 0 0 0 - 15 15 0 0 0 0 0 0 0 0 - 16 16 0 0 0 0 0 0 0 0 - 17 17 0 0 0 0 0 0 0 0 - 18 18 0 0 0 0 0 0 0 0 - 19 19 0 0 0 0 0 0 0 0 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 19 0 1 4 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9297.9 11421.4 297.7 33.7 13.7 269.4 6111.7 - 0.0 184.5 228.6 5.9 11.5 9.0 276.4 7844.2 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 - 2 2 0 0 0 0 0 0 0 0 - 3 3 0 0 0 0 0 0 0 0 - 4 4 0 0 0 0 0 0 0 0 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 1 11 1 4 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9297.9 11421.4 297.7 33.7 13.7 269.4 6111.7 - 0.0 184.5 228.6 5.9 11.5 9.0 276.4 7844.2 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 - 2 2 0 0 0 0 0 0 0 0 - 3 3 0 0 0 0 0 0 0 0 - 4 4 0 0 0 0 0 0 0 0 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 1 12 1 4 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9297.9 11421.4 297.7 33.7 13.7 269.4 6111.7 - 0.0 184.5 228.6 5.9 11.5 9.0 276.4 7844.2 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 - 2 2 0 0 0 0 0 0 0 0 - 3 3 0 0 0 0 0 0 0 0 - 4 4 0 0 0 0 0 0 0 0 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 1 14 1 4 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 1.0 9297.9 11421.4 297.7 33.7 13.7 269.4 6111.7 - 0.0 184.5 228.6 5.9 11.5 9.0 276.4 7844.2 - 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 - 2 2 0 0 0 0 0 0 0 0 - 3 3 0 0 0 0 0 0 0 0 - 4 4 0 0 0 0 0 0 0 0 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 10 1 16 616 9 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 - 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 - 10000 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 16 0 -1 -1 -1 -1 0 0 0 -1 -3.500 0.000 0.000 0.000 - 2 29 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 3 32 0 -1 -1 -1 -1 0 0 0 -1 -4.065 -0.229 -0.036 0.454 - 4 35 0 -1 -1 -1 -1 0 0 0 -1 0.400 0.000 0.000 0.000 - 5 38 0 -1 -1 -1 -1 0 0 0 -1 1.600 0.000 0.000 0.000 - 6 41 0 -1 -1 -1 -1 0 0 0 -1 -8.858 -1.073 -0.409 2.544 - 7 44 0 -1 -1 -1 -1 0 0 0 -1 -3.300 0.000 0.000 0.000 - 8 47 0 -1 -1 -1 -1 0 0 0 -1 3.300 0.000 0.000 0.000 - 9 49 0 -1 -1 -1 -1 0 0 0 -1 -0.257 -0.208 -0.035 0.277 - 10 50 0 -1 -1 -1 -1 0 0 0 -1 -0.793 -0.102 -0.002 0.249 - 11 51 0 -1 -1 -1 -1 0 0 0 -1 0.062 0.066 -0.003 -0.010 - 12 53 0 -1 -1 -1 -1 0 0 0 -1 0.700 0.000 0.000 0.000 - 13 55 0 -1 -1 -1 -1 0 0 0 -1 -0.503 -0.148 -0.025 0.374 - 14 56 0 -1 -1 -1 -1 0 0 0 -1 -3.494 -0.250 -0.055 0.680 - 15 57 0 -1 -1 -1 -1 0 0 0 -1 3.400 0.000 0.000 0.000 - 16 59 0 -1 -1 -1 -1 0 0 0 -1 2.900 0.000 0.000 0.000 - 17 61 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 18 62 0 -1 -1 -1 -1 0 0 0 -1 -4.349 -0.167 -0.040 0.397 - 19 63 0 -1 -1 -1 -1 0 0 0 -1 1.900 0.000 0.000 0.000 - 20 66 0 -1 -1 -1 -1 0 0 0 -1 -1.900 0.000 0.000 0.000 - 21 68 0 -1 -1 -1 -1 0 0 0 -1 0.279 -0.141 -0.033 0.306 - 22 70 0 -1 -1 -1 -1 0 0 0 -1 7.500 0.000 0.000 0.000 - 23 72 0 -1 -1 -1 -1 0 0 0 -1 3.700 0.000 0.000 0.000 - 24 74 0 -1 -1 -1 -1 0 0 0 -1 1.500 0.000 0.000 0.000 - 25 76 0 -1 -1 -1 -1 0 0 0 -1 -0.700 0.000 0.000 0.000 - 26 78 0 -1 -1 -1 -1 0 0 0 -1 -3.600 0.000 0.000 0.000 - 27 79 0 -1 -1 -1 -1 0 0 0 -1 -1.200 0.000 0.000 0.000 - 28 81 0 -1 -1 -1 -1 0 0 0 -1 -1.800 0.000 0.000 0.000 - 29 82 0 -1 -1 -1 -1 0 0 0 -1 -0.102 -0.208 -0.056 0.516 - 30 83 0 -1 -1 -1 -1 0 0 0 -1 -2.600 0.000 0.000 0.000 - 31 84 0 -1 -1 -1 -1 0 0 0 -1 -2.488 -0.463 -0.152 1.276 - 32 85 0 -1 -1 -1 -1 0 0 0 -1 8.100 0.000 0.000 0.000 - 33 86 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 34 87 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 35 89 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 36 92 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 37 93 0 -1 -1 -1 -1 0 0 0 -1 9.700 0.000 0.000 0.000 - 38 95 0 -1 -1 -1 -1 0 0 0 -1 7.800 0.000 0.000 0.000 - 39 97 0 -1 -1 -1 -1 0 0 0 -1 4.500 0.000 0.000 0.000 - 40 99 0 -1 -1 -1 -1 0 0 0 -1 5.800 0.000 0.000 0.000 - 41 101 0 -1 -1 -1 -1 0 0 0 -1 4.600 0.000 0.000 0.000 - 42 103 0 -1 -1 -1 -1 0 0 0 -1 0.400 0.000 0.000 0.000 - 43 104 0 -1 -1 -1 -1 0 0 0 -1 -5.300 0.000 0.000 0.000 - 44 106 0 -1 -1 -1 -1 0 0 0 -1 -9.979 -0.797 -0.229 1.096 - 45 109 0 -1 -1 -1 -1 0 0 0 -1 -5.422 -0.308 -0.063 0.740 - 46 110 0 -1 -1 -1 -1 0 0 0 -1 -8.063 -0.738 -1.113 3.414 - 47 111 0 -1 -1 -1 -1 0 0 0 -1 -5.561 -0.518 -0.116 1.263 - 48 113 0 -1 -1 -1 -1 0 0 0 -1 1.900 0.000 0.000 0.000 - 49 116 0 -1 -1 -1 -1 0 0 0 -1 -6.559 -0.626 -0.149 1.479 - 50 119 0 -1 -1 -1 -1 0 0 0 -1 -4.747 -0.408 -0.061 0.886 - 51 122 0 -1 -1 -1 -1 0 0 0 -1 2.700 0.000 0.000 0.000 - 52 125 0 -1 -1 -1 -1 0 0 0 -1 -6.027 -0.433 -0.133 1.189 - 53 128 0 -1 -1 -1 -1 0 0 0 -1 -4.488 -0.415 -0.096 1.129 - 54 131 0 -1 -1 -1 -1 0 0 0 -1 3.400 0.000 0.000 0.000 - 55 133 0 -1 -1 -1 -1 0 0 0 -1 -3.907 -0.102 -0.040 0.362 - 56 135 0 -1 -1 -1 -1 0 0 0 -1 -4.978 -0.453 -0.119 1.213 - 57 138 0 -1 -1 -1 -1 0 0 0 -1 -4.606 -0.443 -0.093 1.037 - 58 141 0 -1 -1 -1 -1 0 0 0 -1 -2.900 0.000 0.000 0.000 - 59 144 0 -1 -1 -1 -1 0 0 0 -1 -3.851 -0.062 -0.020 0.163 - 60 146 0 -1 -1 -1 -1 0 0 0 -1 -0.800 -0.110 -0.017 0.280 - 61 148 0 -1 -1 -1 -1 0 0 0 -1 -5.155 -0.009 -0.049 0.305 - 62 150 0 -1 -1 -1 -1 0 0 0 -1 -4.237 0.093 0.000 -0.052 - 63 151 0 -1 -1 -1 -1 0 0 0 -1 -1.449 0.028 0.002 0.028 - 64 154 0 -1 -1 -1 -1 0 0 0 -1 -2.997 -0.085 -0.034 0.246 - 65 157 0 -1 -1 -1 -1 0 0 0 -1 -0.673 -0.043 -0.022 0.129 - 66 159 0 -1 -1 -1 -1 0 0 0 -1 -1.726 0.065 -0.003 -0.094 - 67 160 0 -1 -1 -1 -1 0 0 0 -1 -1.066 0.102 0.001 -0.116 - 68 161 0 -1 -1 -1 -1 0 0 0 -1 -1.418 0.114 0.009 -0.074 - 69 163 0 -1 -1 -1 -1 0 0 0 -1 1.300 0.000 0.000 0.000 - 70 167 0 -1 -1 -1 -1 0 0 0 -1 -0.744 0.095 -0.003 -0.158 - 71 170 0 -1 -1 -1 -1 0 0 0 -1 0.300 0.000 0.000 0.000 - 72 173 0 -1 -1 -1 -1 0 0 0 -1 -0.513 -0.022 -0.024 0.082 - 73 176 0 -1 -1 -1 -1 0 0 0 -1 -0.947 0.086 -0.007 -0.046 - 74 179 0 -1 -1 -1 -1 0 0 0 -1 -0.500 0.000 0.000 0.000 - 75 180 0 -1 -1 -1 -1 0 0 0 -1 -0.900 0.244 0.014 -0.343 - 76 185 0 -1 -1 -1 -1 0 0 0 -1 -0.045 0.174 0.004 -0.164 - 77 187 0 -1 -1 -1 -1 0 0 0 -1 -0.262 0.079 -0.012 -0.055 - 78 191 0 -1 -1 -1 -1 0 0 0 -1 -1.401 0.177 0.012 -0.116 - 79 193 0 -1 -1 -1 -1 0 0 0 -1 -0.400 0.000 0.000 0.000 - 80 197 0 -1 -1 -1 -1 0 0 0 -1 0.030 0.112 0.007 -0.116 - 81 199 0 -1 -1 -1 -1 0 0 0 -1 -0.062 0.062 -0.003 -0.036 - 82 200 0 -1 -1 -1 -1 0 0 0 -1 -0.400 0.000 0.000 0.000 - 83 202 0 -1 -1 -1 -1 0 0 0 -1 0.101 0.086 0.004 -0.010 - 84 203 0 -1 -1 -1 -1 0 0 0 -1 -0.420 0.278 0.012 -0.336 - 85 205 0 -1 -1 -1 -1 0 0 0 -1 1.250 0.491 0.041 -0.682 - 86 207 0 -1 -1 -1 -1 0 0 0 -1 0.103 0.078 0.000 0.014 - 87 210 0 -1 -1 -1 -1 0 0 0 -1 0.241 -0.055 -0.007 0.057 - 88 212 0 -1 -1 -1 -1 0 0 0 -1 1.160 0.060 -0.007 0.049 - 89 213 0 -1 -1 -1 -1 0 0 0 -1 0.584 0.019 -0.003 -0.007 - 90 214 0 -1 -1 -1 -1 0 0 0 -1 0.218 -0.025 -0.006 0.131 - 91 217 0 -1 -1 -1 -1 0 0 0 -1 4.710 1.162 0.127 -1.212 - 92 218 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 93 219 0 -1 -1 -1 -1 0 0 0 -1 8.257 1.529 0.258 -2.944 - 94 222 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 95 224 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 96 225 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 97 226 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 98 228 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 99 230 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 100 231 0 -1 -1 -1 -1 0 0 0 -1 8.400 0.000 0.000 0.000 - 101 232 0 -1 -1 -1 -1 0 0 0 -1 3.482 2.312 0.040 0.713 - 102 236 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 103 237 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 104 239 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 105 243 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 106 246 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 107 249 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 108 252 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 109 254 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 110 259 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 111 260 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 112 262 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 113 265 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 114 267 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 115 269 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 116 275 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 117 279 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 118 282 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 119 285 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 120 294 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 121 296 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 122 299 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 123 300 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 124 303 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 125 306 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 126 309 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 127 313 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 128 320 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 129 323 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 130 326 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 131 327 0 -1 -1 -1 -1 0 0 0 -1 -5.900 0.000 0.000 0.000 - 132 329 0 -1 -1 -1 -1 0 0 0 -1 -9.500 0.000 0.000 0.000 - 133 332 0 -1 -1 -1 -1 0 0 0 -1 -9.800 0.000 0.000 0.000 - 134 335 0 -1 -1 -1 -1 0 0 0 -1 -9.500 0.000 0.000 0.000 - 135 345 0 -1 -1 -1 -1 0 0 0 -1 -9.900 0.000 0.000 0.000 - 136 347 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 137 350 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 138 354 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 139 356 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 140 360 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 141 363 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 142 366 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 143 371 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 144 372 0 -1 -1 -1 -1 0 0 0 -1 3.200 0.000 0.000 0.000 - 145 373 0 -1 -1 -1 -1 0 0 0 -1 -8.500 0.000 0.000 0.000 - 146 375 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 147 377 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 148 379 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 149 381 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 150 383 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 151 386 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 152 389 0 -1 -1 -1 -1 0 0 0 -1 -9.800 0.000 0.000 0.000 - 153 398 0 -1 -1 -1 -1 0 0 0 -1 -7.100 0.000 0.000 0.000 - 154 401 0 -1 -1 -1 -1 0 0 0 -1 -1.600 0.000 0.000 0.000 - 155 404 0 -1 -1 -1 -1 0 0 0 -1 -1.900 0.000 0.000 0.000 - 156 405 0 -1 -1 -1 -1 0 0 0 -1 -2.000 0.000 0.000 0.000 - 157 407 0 -1 -1 -1 -1 0 0 0 -1 -2.300 0.000 0.000 0.000 - 158 408 0 -1 -1 -1 -1 0 0 0 -1 -2.200 0.000 0.000 0.000 - 159 410 0 -1 -1 -1 -1 0 0 0 -1 -2.500 0.000 0.000 0.000 - 160 411 0 -1 -1 -1 -1 0 0 0 -1 -1.800 0.000 0.000 0.000 - 161 414 0 -1 -1 -1 -1 0 0 0 -1 -2.300 0.000 0.000 0.000 - 162 416 0 -1 -1 -1 -1 0 0 0 -1 -1.300 0.000 0.000 0.000 - 163 418 0 -1 -1 -1 -1 0 0 0 -1 -0.700 0.000 0.000 0.000 - 164 423 0 -1 -1 -1 -1 0 0 0 -1 -0.100 0.000 0.000 0.000 - 165 426 0 -1 -1 -1 -1 0 0 0 -1 -0.900 0.000 0.000 0.000 - 166 428 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 167 432 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 168 433 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 169 434 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 170 439 0 -1 -1 -1 -1 0 0 0 -1 -0.908 0.075 -0.082 0.334 - 171 442 0 -1 -1 -1 -1 0 0 0 -1 -0.092 0.091 -0.120 0.383 - 172 445 0 -1 -1 -1 -1 0 0 0 -1 0.960 0.072 -0.128 0.265 - 173 450 0 -1 -1 -1 -1 0 0 0 -1 0.287 0.285 -0.111 0.144 - 174 457 0 -1 -1 -1 -1 0 0 0 -1 0.758 0.108 -0.144 0.391 - 175 459 0 -1 -1 -1 -1 0 0 0 -1 2.837 -0.042 -0.191 0.094 - 176 472 0 -1 -1 -1 -1 0 0 0 -1 0.812 0.086 -0.151 0.441 - 177 477 0 -1 -1 -1 -1 0 0 0 -1 1.089 0.050 -0.142 0.376 - 178 483 0 -1 -1 -1 -1 0 0 0 -1 1.195 -0.006 -0.155 0.349 - 179 509 0 -1 -1 -1 -1 0 0 0 -1 1.503 -0.057 -0.156 0.293 - 180 515 0 -1 -1 -1 -1 0 0 0 -1 1.070 0.061 -0.143 0.329 - 181 546 0 -1 -1 -1 -1 0 0 0 -1 2.235 -0.044 -0.169 0.152 - 182 552 0 -1 -1 -1 -1 0 0 0 -1 2.407 -0.098 -0.195 0.042 - 183 559 0 -1 -1 -1 -1 0 0 0 -1 2.066 -0.061 -0.166 0.220 - 184 566 0 -1 -1 -1 -1 0 0 0 -1 2.447 -0.018 -0.161 0.338 - 185 571 0 -1 -1 -1 -1 0 0 0 -1 3.333 -0.055 -0.136 0.204 - 186 573 0 -1 -1 -1 -1 0 0 0 -1 2.443 -0.082 -0.177 0.149 - 187 578 0 -1 -1 -1 -1 0 0 0 -1 2.861 -0.106 -0.193 0.101 - 188 584 0 -1 -1 -1 -1 0 0 0 -1 2.755 -0.155 -0.149 0.364 - 189 594 0 -1 -1 -1 -1 0 0 0 -1 2.750 -0.052 -0.173 0.167 - 190 625 0 -1 -1 -1 -1 0 0 0 -1 3.185 -0.138 -0.215 0.057 - 191 646 0 -1 -1 -1 -1 0 0 0 -1 3.208 -0.038 -0.103 0.109 - 192 662 0 -1 -1 -1 -1 0 0 0 -1 3.495 -0.063 -0.163 0.232 - 193 668 0 -1 -1 -1 -1 0 0 0 -1 4.130 -0.142 -0.221 0.074 - 194 705 0 -1 -1 -1 -1 0 0 0 -1 3.626 -0.186 -0.230 0.154 - 195 739 0 -1 -1 -1 -1 0 0 0 -1 3.683 0.073 -0.134 0.031 - 196 756 0 -1 -1 -1 -1 0 0 0 -1 3.435 -0.127 -0.236 0.240 - 197 797 0 -1 -1 -1 -1 0 0 0 -1 3.892 -0.116 -0.235 0.159 - 198 867 0 -1 -1 -1 -1 0 0 0 -1 3.737 0.053 -0.223 0.186 - 199 906 0 -1 -1 -1 -1 0 0 0 -1 3.919 -0.080 -0.079 0.059 - 200 921 0 -1 -1 -1 -1 0 0 0 -1 3.688 -0.042 -0.205 0.343 - 201 1027 0 -1 -1 -1 -1 0 0 0 -1 3.360 -0.045 -0.098 0.146 - 202 1046 0 -1 -1 -1 -1 0 0 0 -1 3.369 -0.019 -0.175 0.322 - 203 1090 0 -1 -1 -1 -1 0 0 0 -1 3.136 -0.079 -0.224 0.101 - 204 1098 0 -1 -1 -1 -1 0 0 0 -1 3.419 -0.082 -0.227 0.236 - 205 1121 0 -1 -1 -1 -1 0 0 0 -1 3.243 0.084 -0.140 -0.044 - 206 1133 0 -1 -1 -1 -1 0 0 0 -1 3.606 -0.076 -0.189 0.218 - 207 1173 0 -1 -1 -1 -1 0 0 0 -1 3.430 -0.081 -0.232 0.348 - 208 1191 0 -1 -1 -1 -1 0 0 0 -1 3.351 0.007 -0.222 0.087 - 209 1194 0 -1 -1 -1 -1 0 0 0 -1 3.531 -0.002 -0.121 0.079 - 210 1222 0 -1 -1 -1 -1 0 0 0 -1 3.334 -0.053 -0.233 0.093 - 211 1271 0 -1 -1 -1 -1 0 0 0 -1 2.736 -0.076 -0.057 -0.055 - 212 1283 0 -1 -1 -1 -1 0 0 0 -1 3.152 -0.058 -0.192 -0.008 - 213 1338 0 -1 -1 -1 -1 0 0 0 -1 2.264 0.000 -0.182 -0.001 - 214 1409 0 -1 -1 -1 -1 0 0 0 -1 2.360 -0.131 -0.191 0.114 - 215 1414 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 216 1420 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 217 1424 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 218 1427 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 219 1430 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 220 1434 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 221 1440 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 222 1442 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 223 1445 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 224 1450 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 225 1454 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 226 1460 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 227 1463 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 228 1469 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 229 1474 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 230 1479 0 -1 -1 -1 -1 0 0 0 -1 -0.400 0.000 0.000 0.000 - 231 1483 0 -1 -1 -1 -1 0 0 0 -1 -0.700 0.000 0.000 0.000 - 232 1487 0 -1 -1 -1 -1 0 0 0 -1 4.200 0.000 0.000 0.000 - 233 1494 0 -1 -1 -1 -1 0 0 0 -1 2.300 0.000 0.000 0.000 - 234 1496 0 -1 -1 -1 -1 0 0 0 -1 4.000 0.000 0.000 0.000 - 235 1502 0 -1 -1 -1 -1 0 0 0 -1 1.000 0.000 0.000 0.000 - 236 1505 0 -1 -1 -1 -1 0 0 0 -1 0.900 0.000 0.000 0.000 - 237 1509 0 -1 -1 -1 -1 0 0 0 -1 0.100 0.000 0.000 0.000 - 238 1510 0 -1 -1 -1 -1 0 0 0 -1 0.500 0.000 0.000 0.000 - 239 1513 0 -1 -1 -1 -1 0 0 0 -1 1.900 0.000 0.000 0.000 - 240 1518 0 -1 -1 -1 -1 0 0 0 -1 4.400 0.000 0.000 0.000 - 241 1521 0 -1 -1 -1 -1 0 0 0 -1 9.300 0.000 0.000 0.000 - 242 1526 0 -1 -1 -1 -1 0 0 0 -1 5.700 0.000 0.000 0.000 - 243 1529 0 -1 -1 -1 -1 0 0 0 -1 0.500 0.000 0.000 0.000 - 244 1532 0 -1 -1 -1 -1 0 0 0 -1 -0.400 0.000 0.000 0.000 - 245 1536 0 -1 -1 -1 -1 0 0 0 -1 2.200 0.000 0.000 0.000 - 246 1537 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - 247 1541 0 -1 -1 -1 -1 0 0 0 -1 -1.500 0.000 0.000 0.000 - 248 1545 0 -1 -1 -1 -1 0 0 0 -1 -1.300 0.000 0.000 0.000 - 249 1548 0 -1 -1 -1 -1 0 0 0 -1 -1.500 0.000 0.000 0.000 - 250 1553 0 -1 -1 -1 -1 0 0 0 -1 -1.400 0.000 0.000 0.000 - 251 1560 0 -1 -1 -1 -1 0 0 0 -1 -1.600 0.000 0.000 0.000 - 252 1568 0 -1 -1 -1 -1 0 0 0 -1 -1.700 0.000 0.000 0.000 - 253 1574 0 -1 -1 -1 -1 0 0 0 -1 -1.600 0.000 0.000 0.000 - 254 1579 0 -1 -1 -1 -1 0 0 0 -1 -1.500 0.000 0.000 0.000 - 255 1583 0 -1 -1 -1 -1 0 0 0 -1 -1.400 0.000 0.000 0.000 - 256 1585 0 -1 -1 -1 -1 0 0 0 -1 -1.300 0.000 0.000 0.000 - 257 1587 0 -1 -1 -1 -1 0 0 0 -1 -1.300 0.000 0.000 0.000 - 258 1606 0 -1 -1 -1 -1 0 0 0 -1 -1.100 0.000 0.000 0.000 - 259 1626 0 -1 -1 -1 -1 0 0 0 -1 -1.000 0.000 0.000 0.000 - 260 1639 0 -1 -1 -1 -1 0 0 0 -1 -1.100 0.000 0.000 0.000 - 261 1643 0 -1 -1 -1 -1 0 0 0 -1 -1.000 0.000 0.000 0.000 - 262 1652 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - 263 1658 0 -1 -1 -1 -1 0 0 0 -1 -1.200 0.000 0.000 0.000 - 264 1659 0 -1 -1 -1 -1 0 0 0 -1 -0.700 0.000 0.000 0.000 - 265 1666 0 -1 -1 -1 -1 0 0 0 -1 -1.100 0.000 0.000 0.000 - 266 1671 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - 267 1675 0 -1 -1 -1 -1 0 0 0 -1 -0.900 0.000 0.000 0.000 - 268 1681 0 -1 -1 -1 -1 0 0 0 -1 -0.800 0.000 0.000 0.000 - 269 1694 0 -1 -1 -1 -1 0 0 0 -1 -0.300 0.000 0.000 0.000 - 270 1697 0 -1 -1 -1 -1 0 0 0 -1 0.300 0.000 0.000 0.000 - 271 1710 0 -1 -1 -1 -1 0 0 0 -1 -1.000 0.000 0.000 0.000 - 272 1786 0 -1 -1 -1 -1 0 0 0 -1 -1.400 0.000 0.000 0.000 - 273 1791 0 -1 -1 -1 -1 0 0 0 -1 0.200 0.000 0.000 0.000 - 274 1805 0 -1 -1 -1 -1 0 0 0 -1 -1.000 0.000 0.000 0.000 - 275 1839 0 -1 -1 -1 -1 0 0 0 -1 0.200 0.000 0.000 0.000 - 276 1884 0 -1 -1 -1 -1 0 0 0 -1 -0.200 0.000 0.000 0.000 - 277 1913 0 -1 -1 -1 -1 0 0 0 -1 -0.300 0.000 0.000 0.000 - 278 1946 0 -1 -1 -1 -1 0 0 0 -1 -0.800 0.000 0.000 0.000 - 279 1947 0 -1 -1 -1 -1 0 0 0 -1 0.200 0.000 0.000 0.000 - 280 1991 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - 281 2019 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - 282 2094 0 -1 -1 -1 -1 0 0 0 -1 -3.500 0.000 0.000 0.000 - 283 2119 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 284 2213 0 -1 -1 -1 -1 0 0 0 -1 -4.065 -0.229 -0.036 0.454 - 285 2239 0 -1 -1 -1 -1 0 0 0 -1 0.400 0.000 0.000 0.000 - 286 2271 0 -1 -1 -1 -1 0 0 0 -1 1.600 0.000 0.000 0.000 - 287 2289 0 -1 -1 -1 -1 0 0 0 -1 -8.858 -1.073 -0.409 2.544 - 288 2321 0 -1 -1 -1 -1 0 0 0 -1 -3.300 0.000 0.000 0.000 - 289 2333 0 -1 -1 -1 -1 0 0 0 -1 3.300 0.000 0.000 0.000 - 290 2346 0 -1 -1 -1 -1 0 0 0 -1 -0.257 -0.208 -0.035 0.277 - 291 2349 0 -1 -1 -1 -1 0 0 0 -1 -0.793 -0.102 -0.002 0.249 - 292 2352 0 -1 -1 -1 -1 0 0 0 -1 0.062 0.066 -0.003 -0.010 - 293 2359 0 -1 -1 -1 -1 0 0 0 -1 0.700 0.000 0.000 0.000 - 294 2367 0 -1 -1 -1 -1 0 0 0 -1 -0.503 -0.148 -0.025 0.374 - 295 2374 0 -1 -1 -1 -1 0 0 0 -1 -3.494 -0.250 -0.055 0.680 - 296 2398 0 -1 -1 -1 -1 0 0 0 -1 3.400 0.000 0.000 0.000 - 297 2426 0 -1 -1 -1 -1 0 0 0 -1 2.900 0.000 0.000 0.000 - 298 2562 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 299 2701 0 -1 -1 -1 -1 0 0 0 -1 -4.349 -0.167 -0.040 0.397 - 300 2741 0 -1 -1 -1 -1 0 0 0 -1 1.900 0.000 0.000 0.000 - 301 2745 0 -1 -1 -1 -1 0 0 0 -1 -1.900 0.000 0.000 0.000 - 302 2760 0 -1 -1 -1 -1 0 0 0 -1 0.279 -0.141 -0.033 0.306 - 303 2819 0 -1 -1 -1 -1 0 0 0 -1 7.500 0.000 0.000 0.000 - 304 2889 0 -1 -1 -1 -1 0 0 0 -1 3.700 0.000 0.000 0.000 - 305 2907 0 -1 -1 -1 -1 0 0 0 -1 1.500 0.000 0.000 0.000 - 306 2910 0 -1 -1 -1 -1 0 0 0 -1 -0.700 0.000 0.000 0.000 - 307 2919 0 -1 -1 -1 -1 0 0 0 -1 -3.600 0.000 0.000 0.000 - 308 2921 0 -1 -1 -1 -1 0 0 0 -1 -1.200 0.000 0.000 0.000 - 309 2939 0 -1 -1 -1 -1 0 0 0 -1 -1.800 0.000 0.000 0.000 - 310 2944 0 -1 -1 -1 -1 0 0 0 -1 -0.102 -0.208 -0.056 0.516 - 311 2945 0 -1 -1 -1 -1 0 0 0 -1 -2.600 0.000 0.000 0.000 - 312 2948 0 -1 -1 -1 -1 0 0 0 -1 -2.488 -0.463 -0.152 1.276 - 313 2951 0 -1 -1 -1 -1 0 0 0 -1 8.100 0.000 0.000 0.000 - 314 2958 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 315 2971 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 316 2977 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 317 2985 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 318 2988 0 -1 -1 -1 -1 0 0 0 -1 9.700 0.000 0.000 0.000 - 319 2990 0 -1 -1 -1 -1 0 0 0 -1 7.800 0.000 0.000 0.000 - 320 2991 0 -1 -1 -1 -1 0 0 0 -1 4.500 0.000 0.000 0.000 - 321 2993 0 -1 -1 -1 -1 0 0 0 -1 5.800 0.000 0.000 0.000 - 322 3002 0 -1 -1 -1 -1 0 0 0 -1 4.600 0.000 0.000 0.000 - 323 3008 0 -1 -1 -1 -1 0 0 0 -1 0.400 0.000 0.000 0.000 - 324 3014 0 -1 -1 -1 -1 0 0 0 -1 -5.300 0.000 0.000 0.000 - 325 3027 0 -1 -1 -1 -1 0 0 0 -1 -9.979 -0.797 -0.229 1.096 - 326 3029 0 -1 -1 -1 -1 0 0 0 -1 -5.422 -0.308 -0.063 0.740 - 327 3030 0 -1 -1 -1 -1 0 0 0 -1 -8.063 -0.738 -1.113 3.414 - 328 3036 0 -1 -1 -1 -1 0 0 0 -1 -5.561 -0.518 -0.116 1.263 - 329 3047 0 -1 -1 -1 -1 0 0 0 -1 1.900 0.000 0.000 0.000 - 330 3049 0 -1 -1 -1 -1 0 0 0 -1 -6.559 -0.626 -0.149 1.479 - 331 3052 0 -1 -1 -1 -1 0 0 0 -1 -4.747 -0.408 -0.061 0.886 - 332 3053 0 -1 -1 -1 -1 0 0 0 -1 2.700 0.000 0.000 0.000 - 333 3055 0 -1 -1 -1 -1 0 0 0 -1 -6.027 -0.433 -0.133 1.189 - 334 3058 0 -1 -1 -1 -1 0 0 0 -1 -4.488 -0.415 -0.096 1.129 - 335 3064 0 -1 -1 -1 -1 0 0 0 -1 3.400 0.000 0.000 0.000 - 336 3069 0 -1 -1 -1 -1 0 0 0 -1 -3.907 -0.102 -0.040 0.362 - 337 3087 0 -1 -1 -1 -1 0 0 0 -1 -4.978 -0.453 -0.119 1.213 - 338 3093 0 -1 -1 -1 -1 0 0 0 -1 -4.606 -0.443 -0.093 1.037 - 339 3098 0 -1 -1 -1 -1 0 0 0 -1 -2.900 0.000 0.000 0.000 - 340 3105 0 -1 -1 -1 -1 0 0 0 -1 -3.851 -0.062 -0.020 0.163 - 341 3107 0 -1 -1 -1 -1 0 0 0 -1 -5.155 -0.009 -0.049 0.305 - 342 3110 0 -1 -1 -1 -1 0 0 0 -1 -4.237 0.093 0.000 -0.052 - 343 3116 0 -1 -1 -1 -1 0 0 0 -1 -1.449 0.028 0.002 0.028 - 344 3127 0 -1 -1 -1 -1 0 0 0 -1 -2.997 -0.085 -0.034 0.246 - 345 3129 0 -1 -1 -1 -1 0 0 0 -1 -0.673 -0.043 -0.022 0.129 - 346 3136 0 -1 -1 -1 -1 0 0 0 -1 -1.726 0.065 -0.003 -0.094 - 347 3146 0 -1 -1 -1 -1 0 0 0 -1 -1.066 0.102 0.001 -0.116 - 348 3151 0 -1 -1 -1 -1 0 0 0 -1 -1.418 0.114 0.009 -0.074 - 349 3160 0 -1 -1 -1 -1 0 0 0 -1 1.300 0.000 0.000 0.000 - 350 3165 0 -1 -1 -1 -1 0 0 0 -1 -0.800 -0.110 -0.017 0.280 - 351 3168 0 -1 -1 -1 -1 0 0 0 -1 -5.155 -0.009 -0.049 0.305 - 352 3175 0 -1 -1 -1 -1 0 0 0 -1 -4.237 0.093 0.000 -0.052 - 353 3178 0 -1 -1 -1 -1 0 0 0 -1 -1.449 0.028 0.002 0.028 - 354 3189 0 -1 -1 -1 -1 0 0 0 -1 -2.997 -0.085 -0.034 0.246 - 355 3207 0 -1 -1 -1 -1 0 0 0 -1 -0.673 -0.043 -0.022 0.129 - 356 3228 0 -1 -1 -1 -1 0 0 0 -1 -1.726 0.065 -0.003 -0.094 - 357 3244 0 -1 -1 -1 -1 0 0 0 -1 -1.066 0.102 0.001 -0.116 - 358 3248 0 -1 -1 -1 -1 0 0 0 -1 -1.418 0.114 0.009 -0.074 - 359 3252 0 -1 -1 -1 -1 0 0 0 -1 1.300 0.000 0.000 0.000 - 360 3256 0 -1 -1 -1 -1 0 0 0 -1 -0.744 0.095 -0.003 -0.158 - 361 3263 0 -1 -1 -1 -1 0 0 0 -1 0.300 0.000 0.000 0.000 - 362 3281 0 -1 -1 -1 -1 0 0 0 -1 -0.513 -0.022 -0.024 0.082 - 363 3295 0 -1 -1 -1 -1 0 0 0 -1 -0.947 0.086 -0.007 -0.046 - 364 3303 0 -1 -1 -1 -1 0 0 0 -1 -0.500 0.000 0.000 0.000 - 365 3309 0 -1 -1 -1 -1 0 0 0 -1 -0.900 0.244 0.014 -0.343 - 366 3312 0 -1 -1 -1 -1 0 0 0 -1 -0.045 0.174 0.004 -0.164 - 367 3322 0 -1 -1 -1 -1 0 0 0 -1 -0.262 0.079 -0.012 -0.055 - 368 3326 0 -1 -1 -1 -1 0 0 0 -1 -1.401 0.177 0.012 -0.116 - 369 3354 0 -1 -1 -1 -1 0 0 0 -1 -0.400 0.000 0.000 0.000 - 370 3366 0 -1 -1 -1 -1 0 0 0 -1 0.030 0.112 0.007 -0.116 - 371 3375 0 -1 -1 -1 -1 0 0 0 -1 -0.062 0.062 -0.003 -0.036 - 372 3378 0 -1 -1 -1 -1 0 0 0 -1 -0.400 0.000 0.000 0.000 - 373 3411 0 -1 -1 -1 -1 0 0 0 -1 0.101 0.086 0.004 -0.010 - 374 3416 0 -1 -1 -1 -1 0 0 0 -1 -0.420 0.278 0.012 -0.336 - 375 3432 0 -1 -1 -1 -1 0 0 0 -1 1.250 0.491 0.041 -0.682 - 376 3438 0 -1 -1 -1 -1 0 0 0 -1 0.103 0.078 0.000 0.014 - 377 3440 0 -1 -1 -1 -1 0 0 0 -1 0.241 -0.055 -0.007 0.057 - 378 3442 0 -1 -1 -1 -1 0 0 0 -1 1.160 0.060 -0.007 0.049 - 379 3444 0 -1 -1 -1 -1 0 0 0 -1 0.584 0.019 -0.003 -0.007 - 380 3446 0 -1 -1 -1 -1 0 0 0 -1 0.218 -0.025 -0.006 0.131 - 381 3448 0 -1 -1 -1 -1 0 0 0 -1 4.710 1.162 0.127 -1.212 - 382 3450 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 383 3452 0 -1 -1 -1 -1 0 0 0 -1 8.257 1.529 0.258 -2.944 - 384 3454 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 385 3458 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 386 3467 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 387 3476 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 388 3484 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 389 3491 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 390 3497 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 391 3499 0 -1 -1 -1 -1 0 0 0 -1 8.400 0.000 0.000 0.000 - 392 3504 0 -1 -1 -1 -1 0 0 0 -1 3.482 2.312 0.040 0.713 - 393 3506 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 394 3509 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 395 3518 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 396 3527 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 397 3555 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 398 3575 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 399 3577 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 400 3580 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 401 3582 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 402 3586 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 403 3589 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 404 3599 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 405 3610 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 406 3626 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 407 3638 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 408 3646 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 409 3653 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 410 3658 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 411 3661 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 412 3673 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 413 3689 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 414 3700 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 415 3710 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 416 3726 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 417 3763 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 418 3814 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 419 3841 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 420 3888 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 421 4032 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 422 4059 0 -1 -1 -1 -1 0 0 0 -1 -5.900 0.000 0.000 0.000 - 423 4068 0 -1 -1 -1 -1 0 0 0 -1 -9.500 0.000 0.000 0.000 - 424 4082 0 -1 -1 -1 -1 0 0 0 -1 -9.800 0.000 0.000 0.000 - 425 4095 0 -1 -1 -1 -1 0 0 0 -1 -9.500 0.000 0.000 0.000 - 426 4160 0 -1 -1 -1 -1 0 0 0 -1 -9.900 0.000 0.000 0.000 - 427 4234 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 428 4257 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 429 4411 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 430 4498 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 431 4520 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 432 4552 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 433 4567 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 434 4608 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 435 4646 0 -1 -1 -1 -1 0 0 0 -1 3.200 0.000 0.000 0.000 - 436 4698 0 -1 -1 -1 -1 0 0 0 -1 -8.500 0.000 0.000 0.000 - 437 4808 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 438 4849 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 439 4920 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 440 4939 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 441 4947 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 442 4967 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 443 4991 0 -1 -1 -1 -1 0 0 0 -1 -9.800 0.000 0.000 0.000 - 444 4996 0 -1 -1 -1 -1 0 0 0 -1 -7.100 0.000 0.000 0.000 - 445 5015 0 -1 -1 -1 -1 0 0 0 -1 -1.600 0.000 0.000 0.000 - 446 5028 0 -1 -1 -1 -1 0 0 0 -1 -1.900 0.000 0.000 0.000 - 447 5056 0 -1 -1 -1 -1 0 0 0 -1 -2.000 0.000 0.000 0.000 - 448 5128 0 -1 -1 -1 -1 0 0 0 -1 -2.300 0.000 0.000 0.000 - 449 5130 0 -1 -1 -1 -1 0 0 0 -1 -2.200 0.000 0.000 0.000 - 450 5144 0 -1 -1 -1 -1 0 0 0 -1 -2.500 0.000 0.000 0.000 - 451 5170 0 -1 -1 -1 -1 0 0 0 -1 -1.800 0.000 0.000 0.000 - 452 5178 0 -1 -1 -1 -1 0 0 0 -1 -2.300 0.000 0.000 0.000 - 453 5183 0 -1 -1 -1 -1 0 0 0 -1 -1.300 0.000 0.000 0.000 - 454 5188 0 -1 -1 -1 -1 0 0 0 -1 -0.700 0.000 0.000 0.000 - 455 5191 0 -1 -1 -1 -1 0 0 0 -1 -0.100 0.000 0.000 0.000 - 456 5368 0 -1 -1 -1 -1 0 0 0 -1 -0.900 0.000 0.000 0.000 - 457 5371 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 458 5379 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 459 5381 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 460 5383 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 461 5397 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 462 5399 0 -1 -1 -1 -1 0 0 0 -1 -0.908 0.075 -0.082 0.334 - 463 5401 0 -1 -1 -1 -1 0 0 0 -1 -0.092 0.091 -0.120 0.383 - 464 5403 0 -1 -1 -1 -1 0 0 0 -1 0.960 0.072 -0.128 0.265 - 465 5405 0 -1 -1 -1 -1 0 0 0 -1 0.287 0.285 -0.111 0.144 - 466 5446 0 -1 -1 -1 -1 0 0 0 -1 0.758 0.108 -0.144 0.391 - 467 5455 0 -1 -1 -1 -1 0 0 0 -1 2.837 -0.042 -0.191 0.094 - 468 5472 0 -1 -1 -1 -1 0 0 0 -1 0.812 0.086 -0.151 0.441 - 469 5480 0 -1 -1 -1 -1 0 0 0 -1 1.089 0.050 -0.142 0.376 - 470 5483 0 -1 -1 -1 -1 0 0 0 -1 1.195 -0.006 -0.155 0.349 - 471 5485 0 -1 -1 -1 -1 0 0 0 -1 1.503 -0.057 -0.156 0.293 - 472 5492 0 -1 -1 -1 -1 0 0 0 -1 1.070 0.061 -0.143 0.329 - 473 5497 0 -1 -1 -1 -1 0 0 0 -1 2.235 -0.044 -0.169 0.152 - 474 5502 0 -1 -1 -1 -1 0 0 0 -1 2.407 -0.098 -0.195 0.042 - 475 5507 0 -1 -1 -1 -1 0 0 0 -1 2.066 -0.061 -0.166 0.220 - 476 5509 0 -1 -1 -1 -1 0 0 0 -1 2.447 -0.018 -0.161 0.338 - 477 5517 0 -1 -1 -1 -1 0 0 0 -1 3.333 -0.055 -0.136 0.204 - 478 5528 0 -1 -1 -1 -1 0 0 0 -1 2.443 -0.082 -0.177 0.149 - 479 5558 0 -1 -1 -1 -1 0 0 0 -1 2.861 -0.106 -0.193 0.101 - 480 5697 0 -1 -1 -1 -1 0 0 0 -1 2.755 -0.155 -0.149 0.364 - 481 5714 0 -1 -1 -1 -1 0 0 0 -1 2.750 -0.052 -0.173 0.167 - 482 5749 0 -1 -1 -1 -1 0 0 0 -1 3.185 -0.138 -0.215 0.057 - 483 5766 0 -1 -1 -1 -1 0 0 0 -1 3.208 -0.038 -0.103 0.109 - 484 5785 0 -1 -1 -1 -1 0 0 0 -1 3.495 -0.063 -0.163 0.232 - 485 5798 0 -1 -1 -1 -1 0 0 0 -1 4.130 -0.142 -0.221 0.074 - 486 5799 0 -1 -1 -1 -1 0 0 0 -1 3.626 -0.186 -0.230 0.154 - 487 5801 0 -1 -1 -1 -1 0 0 0 -1 3.683 0.073 -0.134 0.031 - 488 5817 0 -1 -1 -1 -1 0 0 0 -1 3.435 -0.127 -0.236 0.240 - 489 5833 0 -1 -1 -1 -1 0 0 0 -1 3.892 -0.116 -0.235 0.159 - 490 5834 0 -1 -1 -1 -1 0 0 0 -1 3.737 0.053 -0.223 0.186 - 491 5836 0 -1 -1 -1 -1 0 0 0 -1 3.919 -0.080 -0.079 0.059 - 492 5849 0 -1 -1 -1 -1 0 0 0 -1 3.688 -0.042 -0.205 0.343 - 493 5851 0 -1 -1 -1 -1 0 0 0 -1 3.360 -0.045 -0.098 0.146 - 494 5852 0 -1 -1 -1 -1 0 0 0 -1 3.369 -0.019 -0.175 0.322 - 495 5865 0 -1 -1 -1 -1 0 0 0 -1 3.136 -0.079 -0.224 0.101 - 496 5869 0 -1 -1 -1 -1 0 0 0 -1 3.419 -0.082 -0.227 0.236 - 497 5881 0 -1 -1 -1 -1 0 0 0 -1 3.243 0.084 -0.140 -0.044 - 498 5884 0 -1 -1 -1 -1 0 0 0 -1 3.606 -0.076 -0.189 0.218 - 499 5897 0 -1 -1 -1 -1 0 0 0 -1 3.430 -0.081 -0.232 0.348 - 500 5900 0 -1 -1 -1 -1 0 0 0 -1 3.351 0.007 -0.222 0.087 - 501 5916 0 -1 -1 -1 -1 0 0 0 -1 3.531 -0.002 -0.121 0.079 - 502 5932 0 -1 -1 -1 -1 0 0 0 -1 3.334 -0.053 -0.233 0.093 - 503 5948 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 504 5963 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 505 5968 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 506 5978 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 507 5988 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 508 5992 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 509 5994 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 510 5997 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 511 6003 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 512 6008 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 513 6023 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 514 6026 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 515 6039 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 516 6053 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 517 6056 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 518 6067 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 519 6071 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 520 6082 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 521 6085 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 522 6098 0 -1 -1 -1 -1 0 0 0 -1 -5.900 0.000 0.000 0.000 - 523 6112 0 -1 -1 -1 -1 0 0 0 -1 -9.500 0.000 0.000 0.000 - 524 6126 0 -1 -1 -1 -1 0 0 0 -1 -9.800 0.000 0.000 0.000 - 525 6135 0 -1 -1 -1 -1 0 0 0 -1 -9.500 0.000 0.000 0.000 - 526 6140 0 -1 -1 -1 -1 0 0 0 -1 -9.900 0.000 0.000 0.000 - 527 6149 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 528 6154 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 529 6158 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 530 6161 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 531 6168 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 532 6174 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 533 6182 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 534 6187 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 535 6205 0 -1 -1 -1 -1 0 0 0 -1 3.200 0.000 0.000 0.000 - 536 6209 0 -1 -1 -1 -1 0 0 0 -1 -8.500 0.000 0.000 0.000 - 537 6213 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 538 6317 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 539 6339 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 540 6342 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 541 6366 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 542 6381 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 543 6391 0 -1 -1 -1 -1 0 0 0 -1 -9.800 0.000 0.000 0.000 - 544 6489 0 -1 -1 -1 -1 0 0 0 -1 -7.100 0.000 0.000 0.000 - 545 6962 0 -1 -1 -1 -1 0 0 0 -1 -1.600 0.000 0.000 0.000 - 546 6966 0 -1 -1 -1 -1 0 0 0 -1 2.736 -0.076 -0.057 -0.055 - 547 6970 0 -1 -1 -1 -1 0 0 0 -1 3.152 -0.058 -0.192 -0.008 - 548 6975 0 -1 -1 -1 -1 0 0 0 -1 2.264 0.000 -0.182 -0.001 - 549 6977 0 -1 -1 -1 -1 0 0 0 -1 2.360 -0.131 -0.191 0.114 - 550 6982 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 551 6985 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 552 6987 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 553 6989 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 554 6991 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 555 6993 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 556 6995 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 557 6997 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 558 6999 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 559 7000 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 560 7004 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 561 7008 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 562 7013 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 563 7016 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 564 7021 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 565 7024 0 -1 -1 -1 -1 0 0 0 -1 -0.400 0.000 0.000 0.000 - 566 7027 0 -1 -1 -1 -1 0 0 0 -1 -0.700 0.000 0.000 0.000 - 567 7029 0 -1 -1 -1 -1 0 0 0 -1 4.200 0.000 0.000 0.000 - 568 7032 0 -1 -1 -1 -1 0 0 0 -1 2.300 0.000 0.000 0.000 - 569 7038 0 -1 -1 -1 -1 0 0 0 -1 4.000 0.000 0.000 0.000 - 570 7043 0 -1 -1 -1 -1 0 0 0 -1 1.000 0.000 0.000 0.000 - 571 7046 0 -1 -1 -1 -1 0 0 0 -1 0.900 0.000 0.000 0.000 - 572 7049 0 -1 -1 -1 -1 0 0 0 -1 0.100 0.000 0.000 0.000 - 573 7069 0 -1 -1 -1 -1 0 0 0 -1 0.500 0.000 0.000 0.000 - 574 7072 0 -1 -1 -1 -1 0 0 0 -1 1.900 0.000 0.000 0.000 - 575 7076 0 -1 -1 -1 -1 0 0 0 -1 4.400 0.000 0.000 0.000 - 576 7081 0 -1 -1 -1 -1 0 0 0 -1 9.300 0.000 0.000 0.000 - 577 7084 0 -1 -1 -1 -1 0 0 0 -1 5.700 0.000 0.000 0.000 - 578 7089 0 -1 -1 -1 -1 0 0 0 -1 0.500 0.000 0.000 0.000 - 579 7099 0 -1 -1 -1 -1 0 0 0 -1 -0.400 0.000 0.000 0.000 - 580 7209 0 -1 -1 -1 -1 0 0 0 -1 2.200 0.000 0.000 0.000 - 581 7222 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - 582 7231 0 -1 -1 -1 -1 0 0 0 -1 -1.500 0.000 0.000 0.000 - 583 7235 0 -1 -1 -1 -1 0 0 0 -1 -1.300 0.000 0.000 0.000 - 584 7247 0 -1 -1 -1 -1 0 0 0 -1 -1.500 0.000 0.000 0.000 - 585 7267 0 -1 -1 -1 -1 0 0 0 -1 -1.400 0.000 0.000 0.000 - 586 7269 0 -1 -1 -1 -1 0 0 0 -1 -1.600 0.000 0.000 0.000 - 587 7284 0 -1 -1 -1 -1 0 0 0 -1 -1.700 0.000 0.000 0.000 - 588 7389 0 -1 -1 -1 -1 0 0 0 -1 -1.600 0.000 0.000 0.000 - 589 7419 0 -1 -1 -1 -1 0 0 0 -1 -1.500 0.000 0.000 0.000 - 590 7423 0 -1 -1 -1 -1 0 0 0 -1 -1.400 0.000 0.000 0.000 - 591 7424 0 -1 -1 -1 -1 0 0 0 -1 -1.300 0.000 0.000 0.000 - 592 7426 0 -1 -1 -1 -1 0 0 0 -1 -1.300 0.000 0.000 0.000 - 593 7428 0 -1 -1 -1 -1 0 0 0 -1 -1.100 0.000 0.000 0.000 - 594 7431 0 -1 -1 -1 -1 0 0 0 -1 -1.000 0.000 0.000 0.000 - 595 7436 0 -1 -1 -1 -1 0 0 0 -1 -1.100 0.000 0.000 0.000 - 596 7444 0 -1 -1 -1 -1 0 0 0 -1 -1.000 0.000 0.000 0.000 - 597 7475 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - 598 7549 0 -1 -1 -1 -1 0 0 0 -1 -1.200 0.000 0.000 0.000 - 599 7584 0 -1 -1 -1 -1 0 0 0 -1 -0.700 0.000 0.000 0.000 - 600 7665 0 -1 -1 -1 -1 0 0 0 -1 -1.100 0.000 0.000 0.000 - 601 7666 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - 602 7831 0 -1 -1 -1 -1 0 0 0 -1 -0.900 0.000 0.000 0.000 - 603 7836 0 -1 -1 -1 -1 0 0 0 -1 -0.800 0.000 0.000 0.000 - 604 7853 0 -1 -1 -1 -1 0 0 0 -1 -0.300 0.000 0.000 0.000 - 605 7865 0 -1 -1 -1 -1 0 0 0 -1 0.300 0.000 0.000 0.000 - 606 7885 0 -1 -1 -1 -1 0 0 0 -1 -1.000 0.000 0.000 0.000 - 607 7888 0 -1 -1 -1 -1 0 0 0 -1 -1.400 0.000 0.000 0.000 - 608 7912 0 -1 -1 -1 -1 0 0 0 -1 0.200 0.000 0.000 0.000 - 609 7950 0 -1 -1 -1 -1 0 0 0 -1 -1.000 0.000 0.000 0.000 - 610 7972 0 -1 -1 -1 -1 0 0 0 -1 0.200 0.000 0.000 0.000 - 611 7980 0 -1 -1 -1 -1 0 0 0 -1 -0.200 0.000 0.000 0.000 - 612 7995 0 -1 -1 -1 -1 0 0 0 -1 -0.300 0.000 0.000 0.000 - 613 8007 0 -1 -1 -1 -1 0 0 0 -1 -0.800 0.000 0.000 0.000 - 614 8015 0 -1 -1 -1 -1 0 0 0 -1 0.200 0.000 0.000 0.000 - 615 8055 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - 616 8078 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 10 2 16 616 9 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 - 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 - 10000 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 16 0 -1 -1 -1 -1 0 0 0 -1 -3.500 0.000 0.000 0.000 - 2 29 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 3 32 0 -1 -1 -1 -1 0 0 0 -1 -4.065 -0.229 -0.036 0.454 - 4 35 0 -1 -1 -1 -1 0 0 0 -1 0.400 0.000 0.000 0.000 - 5 38 0 -1 -1 -1 -1 0 0 0 -1 1.600 0.000 0.000 0.000 - 6 41 0 -1 -1 -1 -1 0 0 0 -1 -8.858 -1.073 -0.409 2.544 - 7 44 0 -1 -1 -1 -1 0 0 0 -1 -3.300 0.000 0.000 0.000 - 8 47 0 -1 -1 -1 -1 0 0 0 -1 3.300 0.000 0.000 0.000 - 9 49 0 -1 -1 -1 -1 0 0 0 -1 -0.257 -0.208 -0.035 0.277 - 10 50 0 -1 -1 -1 -1 0 0 0 -1 -0.793 -0.102 -0.002 0.249 - 11 51 0 -1 -1 -1 -1 0 0 0 -1 0.062 0.066 -0.003 -0.010 - 12 53 0 -1 -1 -1 -1 0 0 0 -1 0.700 0.000 0.000 0.000 - 13 55 0 -1 -1 -1 -1 0 0 0 -1 -0.503 -0.148 -0.025 0.374 - 14 56 0 -1 -1 -1 -1 0 0 0 -1 -3.494 -0.250 -0.055 0.680 - 15 57 0 -1 -1 -1 -1 0 0 0 -1 3.400 0.000 0.000 0.000 - 16 59 0 -1 -1 -1 -1 0 0 0 -1 2.900 0.000 0.000 0.000 - 17 61 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 18 62 0 -1 -1 -1 -1 0 0 0 -1 -4.349 -0.167 -0.040 0.397 - 19 63 0 -1 -1 -1 -1 0 0 0 -1 1.900 0.000 0.000 0.000 - 20 66 0 -1 -1 -1 -1 0 0 0 -1 -1.900 0.000 0.000 0.000 - 21 68 0 -1 -1 -1 -1 0 0 0 -1 0.279 -0.141 -0.033 0.306 - 22 70 0 -1 -1 -1 -1 0 0 0 -1 7.500 0.000 0.000 0.000 - 23 72 0 -1 -1 -1 -1 0 0 0 -1 3.700 0.000 0.000 0.000 - 24 74 0 -1 -1 -1 -1 0 0 0 -1 1.500 0.000 0.000 0.000 - 25 76 0 -1 -1 -1 -1 0 0 0 -1 -0.700 0.000 0.000 0.000 - 26 78 0 -1 -1 -1 -1 0 0 0 -1 -3.600 0.000 0.000 0.000 - 27 79 0 -1 -1 -1 -1 0 0 0 -1 -1.200 0.000 0.000 0.000 - 28 81 0 -1 -1 -1 -1 0 0 0 -1 -1.800 0.000 0.000 0.000 - 29 82 0 -1 -1 -1 -1 0 0 0 -1 -0.102 -0.208 -0.056 0.516 - 30 83 0 -1 -1 -1 -1 0 0 0 -1 -2.600 0.000 0.000 0.000 - 31 84 0 -1 -1 -1 -1 0 0 0 -1 -2.488 -0.463 -0.152 1.276 - 32 85 0 -1 -1 -1 -1 0 0 0 -1 8.100 0.000 0.000 0.000 - 33 86 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 34 87 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 35 89 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 36 92 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 37 93 0 -1 -1 -1 -1 0 0 0 -1 9.700 0.000 0.000 0.000 - 38 95 0 -1 -1 -1 -1 0 0 0 -1 7.800 0.000 0.000 0.000 - 39 97 0 -1 -1 -1 -1 0 0 0 -1 4.500 0.000 0.000 0.000 - 40 99 0 -1 -1 -1 -1 0 0 0 -1 5.800 0.000 0.000 0.000 - 41 101 0 -1 -1 -1 -1 0 0 0 -1 4.600 0.000 0.000 0.000 - 42 103 0 -1 -1 -1 -1 0 0 0 -1 0.400 0.000 0.000 0.000 - 43 104 0 -1 -1 -1 -1 0 0 0 -1 -5.300 0.000 0.000 0.000 - 44 106 0 -1 -1 -1 -1 0 0 0 -1 -9.979 -0.797 -0.229 1.096 - 45 109 0 -1 -1 -1 -1 0 0 0 -1 -5.422 -0.308 -0.063 0.740 - 46 110 0 -1 -1 -1 -1 0 0 0 -1 -8.063 -0.738 -1.113 3.414 - 47 111 0 -1 -1 -1 -1 0 0 0 -1 -5.561 -0.518 -0.116 1.263 - 48 113 0 -1 -1 -1 -1 0 0 0 -1 1.900 0.000 0.000 0.000 - 49 116 0 -1 -1 -1 -1 0 0 0 -1 -6.559 -0.626 -0.149 1.479 - 50 119 0 -1 -1 -1 -1 0 0 0 -1 -4.747 -0.408 -0.061 0.886 - 51 122 0 -1 -1 -1 -1 0 0 0 -1 2.700 0.000 0.000 0.000 - 52 125 0 -1 -1 -1 -1 0 0 0 -1 -6.027 -0.433 -0.133 1.189 - 53 128 0 -1 -1 -1 -1 0 0 0 -1 -4.488 -0.415 -0.096 1.129 - 54 131 0 -1 -1 -1 -1 0 0 0 -1 3.400 0.000 0.000 0.000 - 55 133 0 -1 -1 -1 -1 0 0 0 -1 -3.907 -0.102 -0.040 0.362 - 56 135 0 -1 -1 -1 -1 0 0 0 -1 -4.978 -0.453 -0.119 1.213 - 57 138 0 -1 -1 -1 -1 0 0 0 -1 -4.606 -0.443 -0.093 1.037 - 58 141 0 -1 -1 -1 -1 0 0 0 -1 -2.900 0.000 0.000 0.000 - 59 144 0 -1 -1 -1 -1 0 0 0 -1 -3.851 -0.062 -0.020 0.163 - 60 146 0 -1 -1 -1 -1 0 0 0 -1 -0.800 -0.110 -0.017 0.280 - 61 148 0 -1 -1 -1 -1 0 0 0 -1 -5.155 -0.009 -0.049 0.305 - 62 150 0 -1 -1 -1 -1 0 0 0 -1 -4.237 0.093 0.000 -0.052 - 63 151 0 -1 -1 -1 -1 0 0 0 -1 -1.449 0.028 0.002 0.028 - 64 154 0 -1 -1 -1 -1 0 0 0 -1 -2.997 -0.085 -0.034 0.246 - 65 157 0 -1 -1 -1 -1 0 0 0 -1 -0.673 -0.043 -0.022 0.129 - 66 159 0 -1 -1 -1 -1 0 0 0 -1 -1.726 0.065 -0.003 -0.094 - 67 160 0 -1 -1 -1 -1 0 0 0 -1 -1.066 0.102 0.001 -0.116 - 68 161 0 -1 -1 -1 -1 0 0 0 -1 -1.418 0.114 0.009 -0.074 - 69 163 0 -1 -1 -1 -1 0 0 0 -1 1.300 0.000 0.000 0.000 - 70 167 0 -1 -1 -1 -1 0 0 0 -1 -0.744 0.095 -0.003 -0.158 - 71 170 0 -1 -1 -1 -1 0 0 0 -1 0.300 0.000 0.000 0.000 - 72 173 0 -1 -1 -1 -1 0 0 0 -1 -0.513 -0.022 -0.024 0.082 - 73 176 0 -1 -1 -1 -1 0 0 0 -1 -0.947 0.086 -0.007 -0.046 - 74 179 0 -1 -1 -1 -1 0 0 0 -1 -0.500 0.000 0.000 0.000 - 75 180 0 -1 -1 -1 -1 0 0 0 -1 -0.900 0.244 0.014 -0.343 - 76 185 0 -1 -1 -1 -1 0 0 0 -1 -0.045 0.174 0.004 -0.164 - 77 187 0 -1 -1 -1 -1 0 0 0 -1 -0.262 0.079 -0.012 -0.055 - 78 191 0 -1 -1 -1 -1 0 0 0 -1 -1.401 0.177 0.012 -0.116 - 79 193 0 -1 -1 -1 -1 0 0 0 -1 -0.400 0.000 0.000 0.000 - 80 197 0 -1 -1 -1 -1 0 0 0 -1 0.030 0.112 0.007 -0.116 - 81 199 0 -1 -1 -1 -1 0 0 0 -1 -0.062 0.062 -0.003 -0.036 - 82 200 0 -1 -1 -1 -1 0 0 0 -1 -0.400 0.000 0.000 0.000 - 83 202 0 -1 -1 -1 -1 0 0 0 -1 0.101 0.086 0.004 -0.010 - 84 203 0 -1 -1 -1 -1 0 0 0 -1 -0.420 0.278 0.012 -0.336 - 85 205 0 -1 -1 -1 -1 0 0 0 -1 1.250 0.491 0.041 -0.682 - 86 207 0 -1 -1 -1 -1 0 0 0 -1 0.103 0.078 0.000 0.014 - 87 210 0 -1 -1 -1 -1 0 0 0 -1 0.241 -0.055 -0.007 0.057 - 88 212 0 -1 -1 -1 -1 0 0 0 -1 1.160 0.060 -0.007 0.049 - 89 213 0 -1 -1 -1 -1 0 0 0 -1 0.584 0.019 -0.003 -0.007 - 90 214 0 -1 -1 -1 -1 0 0 0 -1 0.218 -0.025 -0.006 0.131 - 91 217 0 -1 -1 -1 -1 0 0 0 -1 4.710 1.162 0.127 -1.212 - 92 218 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 93 219 0 -1 -1 -1 -1 0 0 0 -1 8.257 1.529 0.258 -2.944 - 94 222 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 95 224 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 96 225 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 97 226 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 98 228 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 99 230 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 100 231 0 -1 -1 -1 -1 0 0 0 -1 8.400 0.000 0.000 0.000 - 101 232 0 -1 -1 -1 -1 0 0 0 -1 3.482 2.312 0.040 0.713 - 102 236 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 103 237 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 104 239 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 105 243 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 106 246 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 107 249 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 108 252 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 109 254 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 110 259 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 111 260 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 112 262 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 113 265 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 114 267 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 115 269 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 116 275 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 117 279 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 118 282 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 119 285 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 120 294 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 121 296 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 122 299 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 123 300 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 124 303 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 125 306 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 126 309 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 127 313 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 128 320 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 129 323 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 130 326 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 131 327 0 -1 -1 -1 -1 0 0 0 -1 -5.900 0.000 0.000 0.000 - 132 329 0 -1 -1 -1 -1 0 0 0 -1 -9.500 0.000 0.000 0.000 - 133 332 0 -1 -1 -1 -1 0 0 0 -1 -9.800 0.000 0.000 0.000 - 134 335 0 -1 -1 -1 -1 0 0 0 -1 -9.500 0.000 0.000 0.000 - 135 345 0 -1 -1 -1 -1 0 0 0 -1 -9.900 0.000 0.000 0.000 - 136 347 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 137 350 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 138 354 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 139 356 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 140 360 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 141 363 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 142 366 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 143 371 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 144 372 0 -1 -1 -1 -1 0 0 0 -1 3.200 0.000 0.000 0.000 - 145 373 0 -1 -1 -1 -1 0 0 0 -1 -8.500 0.000 0.000 0.000 - 146 375 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 147 377 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 148 379 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 149 381 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 150 383 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 151 386 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 152 389 0 -1 -1 -1 -1 0 0 0 -1 -9.800 0.000 0.000 0.000 - 153 398 0 -1 -1 -1 -1 0 0 0 -1 -7.100 0.000 0.000 0.000 - 154 401 0 -1 -1 -1 -1 0 0 0 -1 -1.600 0.000 0.000 0.000 - 155 404 0 -1 -1 -1 -1 0 0 0 -1 -1.900 0.000 0.000 0.000 - 156 405 0 -1 -1 -1 -1 0 0 0 -1 -2.000 0.000 0.000 0.000 - 157 407 0 -1 -1 -1 -1 0 0 0 -1 -2.300 0.000 0.000 0.000 - 158 408 0 -1 -1 -1 -1 0 0 0 -1 -2.200 0.000 0.000 0.000 - 159 410 0 -1 -1 -1 -1 0 0 0 -1 -2.500 0.000 0.000 0.000 - 160 411 0 -1 -1 -1 -1 0 0 0 -1 -1.800 0.000 0.000 0.000 - 161 414 0 -1 -1 -1 -1 0 0 0 -1 -2.300 0.000 0.000 0.000 - 162 416 0 -1 -1 -1 -1 0 0 0 -1 -1.300 0.000 0.000 0.000 - 163 418 0 -1 -1 -1 -1 0 0 0 -1 -0.700 0.000 0.000 0.000 - 164 423 0 -1 -1 -1 -1 0 0 0 -1 -0.100 0.000 0.000 0.000 - 165 426 0 -1 -1 -1 -1 0 0 0 -1 -0.900 0.000 0.000 0.000 - 166 428 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 167 432 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 168 433 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 169 434 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 170 439 0 -1 -1 -1 -1 0 0 0 -1 -0.908 0.075 -0.082 0.334 - 171 442 0 -1 -1 -1 -1 0 0 0 -1 -0.092 0.091 -0.120 0.383 - 172 445 0 -1 -1 -1 -1 0 0 0 -1 0.960 0.072 -0.128 0.265 - 173 450 0 -1 -1 -1 -1 0 0 0 -1 0.287 0.285 -0.111 0.144 - 174 457 0 -1 -1 -1 -1 0 0 0 -1 0.758 0.108 -0.144 0.391 - 175 459 0 -1 -1 -1 -1 0 0 0 -1 2.837 -0.042 -0.191 0.094 - 176 472 0 -1 -1 -1 -1 0 0 0 -1 0.812 0.086 -0.151 0.441 - 177 477 0 -1 -1 -1 -1 0 0 0 -1 1.089 0.050 -0.142 0.376 - 178 483 0 -1 -1 -1 -1 0 0 0 -1 1.195 -0.006 -0.155 0.349 - 179 509 0 -1 -1 -1 -1 0 0 0 -1 1.503 -0.057 -0.156 0.293 - 180 515 0 -1 -1 -1 -1 0 0 0 -1 1.070 0.061 -0.143 0.329 - 181 546 0 -1 -1 -1 -1 0 0 0 -1 2.235 -0.044 -0.169 0.152 - 182 552 0 -1 -1 -1 -1 0 0 0 -1 2.407 -0.098 -0.195 0.042 - 183 559 0 -1 -1 -1 -1 0 0 0 -1 2.066 -0.061 -0.166 0.220 - 184 566 0 -1 -1 -1 -1 0 0 0 -1 2.447 -0.018 -0.161 0.338 - 185 571 0 -1 -1 -1 -1 0 0 0 -1 3.333 -0.055 -0.136 0.204 - 186 573 0 -1 -1 -1 -1 0 0 0 -1 2.443 -0.082 -0.177 0.149 - 187 578 0 -1 -1 -1 -1 0 0 0 -1 2.861 -0.106 -0.193 0.101 - 188 584 0 -1 -1 -1 -1 0 0 0 -1 2.755 -0.155 -0.149 0.364 - 189 594 0 -1 -1 -1 -1 0 0 0 -1 2.750 -0.052 -0.173 0.167 - 190 625 0 -1 -1 -1 -1 0 0 0 -1 3.185 -0.138 -0.215 0.057 - 191 646 0 -1 -1 -1 -1 0 0 0 -1 3.208 -0.038 -0.103 0.109 - 192 662 0 -1 -1 -1 -1 0 0 0 -1 3.495 -0.063 -0.163 0.232 - 193 668 0 -1 -1 -1 -1 0 0 0 -1 4.130 -0.142 -0.221 0.074 - 194 705 0 -1 -1 -1 -1 0 0 0 -1 3.626 -0.186 -0.230 0.154 - 195 739 0 -1 -1 -1 -1 0 0 0 -1 3.683 0.073 -0.134 0.031 - 196 756 0 -1 -1 -1 -1 0 0 0 -1 3.435 -0.127 -0.236 0.240 - 197 797 0 -1 -1 -1 -1 0 0 0 -1 3.892 -0.116 -0.235 0.159 - 198 867 0 -1 -1 -1 -1 0 0 0 -1 3.737 0.053 -0.223 0.186 - 199 906 0 -1 -1 -1 -1 0 0 0 -1 3.919 -0.080 -0.079 0.059 - 200 921 0 -1 -1 -1 -1 0 0 0 -1 3.688 -0.042 -0.205 0.343 - 201 1027 0 -1 -1 -1 -1 0 0 0 -1 3.360 -0.045 -0.098 0.146 - 202 1046 0 -1 -1 -1 -1 0 0 0 -1 3.369 -0.019 -0.175 0.322 - 203 1090 0 -1 -1 -1 -1 0 0 0 -1 3.136 -0.079 -0.224 0.101 - 204 1098 0 -1 -1 -1 -1 0 0 0 -1 3.419 -0.082 -0.227 0.236 - 205 1121 0 -1 -1 -1 -1 0 0 0 -1 3.243 0.084 -0.140 -0.044 - 206 1133 0 -1 -1 -1 -1 0 0 0 -1 3.606 -0.076 -0.189 0.218 - 207 1173 0 -1 -1 -1 -1 0 0 0 -1 3.430 -0.081 -0.232 0.348 - 208 1191 0 -1 -1 -1 -1 0 0 0 -1 3.351 0.007 -0.222 0.087 - 209 1194 0 -1 -1 -1 -1 0 0 0 -1 3.531 -0.002 -0.121 0.079 - 210 1222 0 -1 -1 -1 -1 0 0 0 -1 3.334 -0.053 -0.233 0.093 - 211 1271 0 -1 -1 -1 -1 0 0 0 -1 2.736 -0.076 -0.057 -0.055 - 212 1283 0 -1 -1 -1 -1 0 0 0 -1 3.152 -0.058 -0.192 -0.008 - 213 1338 0 -1 -1 -1 -1 0 0 0 -1 2.264 0.000 -0.182 -0.001 - 214 1409 0 -1 -1 -1 -1 0 0 0 -1 2.360 -0.131 -0.191 0.114 - 215 1414 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 216 1420 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 217 1424 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 218 1427 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 219 1430 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 220 1434 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 221 1440 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 222 1442 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 223 1445 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 224 1450 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 225 1454 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 226 1460 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 227 1463 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 228 1469 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 229 1474 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 230 1479 0 -1 -1 -1 -1 0 0 0 -1 -0.400 0.000 0.000 0.000 - 231 1483 0 -1 -1 -1 -1 0 0 0 -1 -0.700 0.000 0.000 0.000 - 232 1487 0 -1 -1 -1 -1 0 0 0 -1 4.200 0.000 0.000 0.000 - 233 1494 0 -1 -1 -1 -1 0 0 0 -1 2.300 0.000 0.000 0.000 - 234 1496 0 -1 -1 -1 -1 0 0 0 -1 4.000 0.000 0.000 0.000 - 235 1502 0 -1 -1 -1 -1 0 0 0 -1 1.000 0.000 0.000 0.000 - 236 1505 0 -1 -1 -1 -1 0 0 0 -1 0.900 0.000 0.000 0.000 - 237 1509 0 -1 -1 -1 -1 0 0 0 -1 0.100 0.000 0.000 0.000 - 238 1510 0 -1 -1 -1 -1 0 0 0 -1 0.500 0.000 0.000 0.000 - 239 1513 0 -1 -1 -1 -1 0 0 0 -1 1.900 0.000 0.000 0.000 - 240 1518 0 -1 -1 -1 -1 0 0 0 -1 4.400 0.000 0.000 0.000 - 241 1521 0 -1 -1 -1 -1 0 0 0 -1 9.300 0.000 0.000 0.000 - 242 1526 0 -1 -1 -1 -1 0 0 0 -1 5.700 0.000 0.000 0.000 - 243 1529 0 -1 -1 -1 -1 0 0 0 -1 0.500 0.000 0.000 0.000 - 244 1532 0 -1 -1 -1 -1 0 0 0 -1 -0.400 0.000 0.000 0.000 - 245 1536 0 -1 -1 -1 -1 0 0 0 -1 2.200 0.000 0.000 0.000 - 246 1537 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - 247 1541 0 -1 -1 -1 -1 0 0 0 -1 -1.500 0.000 0.000 0.000 - 248 1545 0 -1 -1 -1 -1 0 0 0 -1 -1.300 0.000 0.000 0.000 - 249 1548 0 -1 -1 -1 -1 0 0 0 -1 -1.500 0.000 0.000 0.000 - 250 1553 0 -1 -1 -1 -1 0 0 0 -1 -1.400 0.000 0.000 0.000 - 251 1560 0 -1 -1 -1 -1 0 0 0 -1 -1.600 0.000 0.000 0.000 - 252 1568 0 -1 -1 -1 -1 0 0 0 -1 -1.700 0.000 0.000 0.000 - 253 1574 0 -1 -1 -1 -1 0 0 0 -1 -1.600 0.000 0.000 0.000 - 254 1579 0 -1 -1 -1 -1 0 0 0 -1 -1.500 0.000 0.000 0.000 - 255 1583 0 -1 -1 -1 -1 0 0 0 -1 -1.400 0.000 0.000 0.000 - 256 1585 0 -1 -1 -1 -1 0 0 0 -1 -1.300 0.000 0.000 0.000 - 257 1587 0 -1 -1 -1 -1 0 0 0 -1 -1.300 0.000 0.000 0.000 - 258 1606 0 -1 -1 -1 -1 0 0 0 -1 -1.100 0.000 0.000 0.000 - 259 1626 0 -1 -1 -1 -1 0 0 0 -1 -1.000 0.000 0.000 0.000 - 260 1639 0 -1 -1 -1 -1 0 0 0 -1 -1.100 0.000 0.000 0.000 - 261 1643 0 -1 -1 -1 -1 0 0 0 -1 -1.000 0.000 0.000 0.000 - 262 1652 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - 263 1658 0 -1 -1 -1 -1 0 0 0 -1 -1.200 0.000 0.000 0.000 - 264 1659 0 -1 -1 -1 -1 0 0 0 -1 -0.700 0.000 0.000 0.000 - 265 1666 0 -1 -1 -1 -1 0 0 0 -1 -1.100 0.000 0.000 0.000 - 266 1671 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - 267 1675 0 -1 -1 -1 -1 0 0 0 -1 -0.900 0.000 0.000 0.000 - 268 1681 0 -1 -1 -1 -1 0 0 0 -1 -0.800 0.000 0.000 0.000 - 269 1694 0 -1 -1 -1 -1 0 0 0 -1 -0.300 0.000 0.000 0.000 - 270 1697 0 -1 -1 -1 -1 0 0 0 -1 0.300 0.000 0.000 0.000 - 271 1710 0 -1 -1 -1 -1 0 0 0 -1 -1.000 0.000 0.000 0.000 - 272 1786 0 -1 -1 -1 -1 0 0 0 -1 -1.400 0.000 0.000 0.000 - 273 1791 0 -1 -1 -1 -1 0 0 0 -1 0.200 0.000 0.000 0.000 - 274 1805 0 -1 -1 -1 -1 0 0 0 -1 -1.000 0.000 0.000 0.000 - 275 1839 0 -1 -1 -1 -1 0 0 0 -1 0.200 0.000 0.000 0.000 - 276 1884 0 -1 -1 -1 -1 0 0 0 -1 -0.200 0.000 0.000 0.000 - 277 1913 0 -1 -1 -1 -1 0 0 0 -1 -0.300 0.000 0.000 0.000 - 278 1946 0 -1 -1 -1 -1 0 0 0 -1 -0.800 0.000 0.000 0.000 - 279 1947 0 -1 -1 -1 -1 0 0 0 -1 0.200 0.000 0.000 0.000 - 280 1991 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - 281 2019 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - 282 2094 0 -1 -1 -1 -1 0 0 0 -1 -3.500 0.000 0.000 0.000 - 283 2119 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 284 2213 0 -1 -1 -1 -1 0 0 0 -1 -4.065 -0.229 -0.036 0.454 - 285 2239 0 -1 -1 -1 -1 0 0 0 -1 0.400 0.000 0.000 0.000 - 286 2271 0 -1 -1 -1 -1 0 0 0 -1 1.600 0.000 0.000 0.000 - 287 2289 0 -1 -1 -1 -1 0 0 0 -1 -8.858 -1.073 -0.409 2.544 - 288 2321 0 -1 -1 -1 -1 0 0 0 -1 -3.300 0.000 0.000 0.000 - 289 2333 0 -1 -1 -1 -1 0 0 0 -1 3.300 0.000 0.000 0.000 - 290 2346 0 -1 -1 -1 -1 0 0 0 -1 -0.257 -0.208 -0.035 0.277 - 291 2349 0 -1 -1 -1 -1 0 0 0 -1 -0.793 -0.102 -0.002 0.249 - 292 2352 0 -1 -1 -1 -1 0 0 0 -1 0.062 0.066 -0.003 -0.010 - 293 2359 0 -1 -1 -1 -1 0 0 0 -1 0.700 0.000 0.000 0.000 - 294 2367 0 -1 -1 -1 -1 0 0 0 -1 -0.503 -0.148 -0.025 0.374 - 295 2374 0 -1 -1 -1 -1 0 0 0 -1 -3.494 -0.250 -0.055 0.680 - 296 2398 0 -1 -1 -1 -1 0 0 0 -1 3.400 0.000 0.000 0.000 - 297 2426 0 -1 -1 -1 -1 0 0 0 -1 2.900 0.000 0.000 0.000 - 298 2562 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 299 2701 0 -1 -1 -1 -1 0 0 0 -1 -4.349 -0.167 -0.040 0.397 - 300 2741 0 -1 -1 -1 -1 0 0 0 -1 1.900 0.000 0.000 0.000 - 301 2745 0 -1 -1 -1 -1 0 0 0 -1 -1.900 0.000 0.000 0.000 - 302 2760 0 -1 -1 -1 -1 0 0 0 -1 0.279 -0.141 -0.033 0.306 - 303 2819 0 -1 -1 -1 -1 0 0 0 -1 7.500 0.000 0.000 0.000 - 304 2889 0 -1 -1 -1 -1 0 0 0 -1 3.700 0.000 0.000 0.000 - 305 2907 0 -1 -1 -1 -1 0 0 0 -1 1.500 0.000 0.000 0.000 - 306 2910 0 -1 -1 -1 -1 0 0 0 -1 -0.700 0.000 0.000 0.000 - 307 2919 0 -1 -1 -1 -1 0 0 0 -1 -3.600 0.000 0.000 0.000 - 308 2921 0 -1 -1 -1 -1 0 0 0 -1 -1.200 0.000 0.000 0.000 - 309 2939 0 -1 -1 -1 -1 0 0 0 -1 -1.800 0.000 0.000 0.000 - 310 2944 0 -1 -1 -1 -1 0 0 0 -1 -0.102 -0.208 -0.056 0.516 - 311 2945 0 -1 -1 -1 -1 0 0 0 -1 -2.600 0.000 0.000 0.000 - 312 2948 0 -1 -1 -1 -1 0 0 0 -1 -2.488 -0.463 -0.152 1.276 - 313 2951 0 -1 -1 -1 -1 0 0 0 -1 8.100 0.000 0.000 0.000 - 314 2958 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 315 2971 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 316 2977 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 317 2985 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 318 2988 0 -1 -1 -1 -1 0 0 0 -1 9.700 0.000 0.000 0.000 - 319 2990 0 -1 -1 -1 -1 0 0 0 -1 7.800 0.000 0.000 0.000 - 320 2991 0 -1 -1 -1 -1 0 0 0 -1 4.500 0.000 0.000 0.000 - 321 2993 0 -1 -1 -1 -1 0 0 0 -1 5.800 0.000 0.000 0.000 - 322 3002 0 -1 -1 -1 -1 0 0 0 -1 4.600 0.000 0.000 0.000 - 323 3008 0 -1 -1 -1 -1 0 0 0 -1 0.400 0.000 0.000 0.000 - 324 3014 0 -1 -1 -1 -1 0 0 0 -1 -5.300 0.000 0.000 0.000 - 325 3027 0 -1 -1 -1 -1 0 0 0 -1 -9.979 -0.797 -0.229 1.096 - 326 3029 0 -1 -1 -1 -1 0 0 0 -1 -5.422 -0.308 -0.063 0.740 - 327 3030 0 -1 -1 -1 -1 0 0 0 -1 -8.063 -0.738 -1.113 3.414 - 328 3036 0 -1 -1 -1 -1 0 0 0 -1 -5.561 -0.518 -0.116 1.263 - 329 3047 0 -1 -1 -1 -1 0 0 0 -1 1.900 0.000 0.000 0.000 - 330 3049 0 -1 -1 -1 -1 0 0 0 -1 -6.559 -0.626 -0.149 1.479 - 331 3052 0 -1 -1 -1 -1 0 0 0 -1 -4.747 -0.408 -0.061 0.886 - 332 3053 0 -1 -1 -1 -1 0 0 0 -1 2.700 0.000 0.000 0.000 - 333 3055 0 -1 -1 -1 -1 0 0 0 -1 -6.027 -0.433 -0.133 1.189 - 334 3058 0 -1 -1 -1 -1 0 0 0 -1 -4.488 -0.415 -0.096 1.129 - 335 3064 0 -1 -1 -1 -1 0 0 0 -1 3.400 0.000 0.000 0.000 - 336 3069 0 -1 -1 -1 -1 0 0 0 -1 -3.907 -0.102 -0.040 0.362 - 337 3087 0 -1 -1 -1 -1 0 0 0 -1 -4.978 -0.453 -0.119 1.213 - 338 3093 0 -1 -1 -1 -1 0 0 0 -1 -4.606 -0.443 -0.093 1.037 - 339 3098 0 -1 -1 -1 -1 0 0 0 -1 -2.900 0.000 0.000 0.000 - 340 3105 0 -1 -1 -1 -1 0 0 0 -1 -3.851 -0.062 -0.020 0.163 - 341 3107 0 -1 -1 -1 -1 0 0 0 -1 -5.155 -0.009 -0.049 0.305 - 342 3110 0 -1 -1 -1 -1 0 0 0 -1 -4.237 0.093 0.000 -0.052 - 343 3116 0 -1 -1 -1 -1 0 0 0 -1 -1.449 0.028 0.002 0.028 - 344 3127 0 -1 -1 -1 -1 0 0 0 -1 -2.997 -0.085 -0.034 0.246 - 345 3129 0 -1 -1 -1 -1 0 0 0 -1 -0.673 -0.043 -0.022 0.129 - 346 3136 0 -1 -1 -1 -1 0 0 0 -1 -1.726 0.065 -0.003 -0.094 - 347 3146 0 -1 -1 -1 -1 0 0 0 -1 -1.066 0.102 0.001 -0.116 - 348 3151 0 -1 -1 -1 -1 0 0 0 -1 -1.418 0.114 0.009 -0.074 - 349 3160 0 -1 -1 -1 -1 0 0 0 -1 1.300 0.000 0.000 0.000 - 350 3165 0 -1 -1 -1 -1 0 0 0 -1 -0.800 -0.110 -0.017 0.280 - 351 3168 0 -1 -1 -1 -1 0 0 0 -1 -5.155 -0.009 -0.049 0.305 - 352 3175 0 -1 -1 -1 -1 0 0 0 -1 -4.237 0.093 0.000 -0.052 - 353 3178 0 -1 -1 -1 -1 0 0 0 -1 -1.449 0.028 0.002 0.028 - 354 3189 0 -1 -1 -1 -1 0 0 0 -1 -2.997 -0.085 -0.034 0.246 - 355 3207 0 -1 -1 -1 -1 0 0 0 -1 -0.673 -0.043 -0.022 0.129 - 356 3228 0 -1 -1 -1 -1 0 0 0 -1 -1.726 0.065 -0.003 -0.094 - 357 3244 0 -1 -1 -1 -1 0 0 0 -1 -1.066 0.102 0.001 -0.116 - 358 3248 0 -1 -1 -1 -1 0 0 0 -1 -1.418 0.114 0.009 -0.074 - 359 3252 0 -1 -1 -1 -1 0 0 0 -1 1.300 0.000 0.000 0.000 - 360 3256 0 -1 -1 -1 -1 0 0 0 -1 -0.744 0.095 -0.003 -0.158 - 361 3263 0 -1 -1 -1 -1 0 0 0 -1 0.300 0.000 0.000 0.000 - 362 3281 0 -1 -1 -1 -1 0 0 0 -1 -0.513 -0.022 -0.024 0.082 - 363 3295 0 -1 -1 -1 -1 0 0 0 -1 -0.947 0.086 -0.007 -0.046 - 364 3303 0 -1 -1 -1 -1 0 0 0 -1 -0.500 0.000 0.000 0.000 - 365 3309 0 -1 -1 -1 -1 0 0 0 -1 -0.900 0.244 0.014 -0.343 - 366 3312 0 -1 -1 -1 -1 0 0 0 -1 -0.045 0.174 0.004 -0.164 - 367 3322 0 -1 -1 -1 -1 0 0 0 -1 -0.262 0.079 -0.012 -0.055 - 368 3326 0 -1 -1 -1 -1 0 0 0 -1 -1.401 0.177 0.012 -0.116 - 369 3354 0 -1 -1 -1 -1 0 0 0 -1 -0.400 0.000 0.000 0.000 - 370 3366 0 -1 -1 -1 -1 0 0 0 -1 0.030 0.112 0.007 -0.116 - 371 3375 0 -1 -1 -1 -1 0 0 0 -1 -0.062 0.062 -0.003 -0.036 - 372 3378 0 -1 -1 -1 -1 0 0 0 -1 -0.400 0.000 0.000 0.000 - 373 3411 0 -1 -1 -1 -1 0 0 0 -1 0.101 0.086 0.004 -0.010 - 374 3416 0 -1 -1 -1 -1 0 0 0 -1 -0.420 0.278 0.012 -0.336 - 375 3432 0 -1 -1 -1 -1 0 0 0 -1 1.250 0.491 0.041 -0.682 - 376 3438 0 -1 -1 -1 -1 0 0 0 -1 0.103 0.078 0.000 0.014 - 377 3440 0 -1 -1 -1 -1 0 0 0 -1 0.241 -0.055 -0.007 0.057 - 378 3442 0 -1 -1 -1 -1 0 0 0 -1 1.160 0.060 -0.007 0.049 - 379 3444 0 -1 -1 -1 -1 0 0 0 -1 0.584 0.019 -0.003 -0.007 - 380 3446 0 -1 -1 -1 -1 0 0 0 -1 0.218 -0.025 -0.006 0.131 - 381 3448 0 -1 -1 -1 -1 0 0 0 -1 4.710 1.162 0.127 -1.212 - 382 3450 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 383 3452 0 -1 -1 -1 -1 0 0 0 -1 8.257 1.529 0.258 -2.944 - 384 3454 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 385 3458 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 386 3467 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 387 3476 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 388 3484 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 389 3491 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 390 3497 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 391 3499 0 -1 -1 -1 -1 0 0 0 -1 8.400 0.000 0.000 0.000 - 392 3504 0 -1 -1 -1 -1 0 0 0 -1 3.482 2.312 0.040 0.713 - 393 3506 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 394 3509 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 395 3518 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 396 3527 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 397 3555 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 398 3575 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 399 3577 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 400 3580 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 401 3582 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 402 3586 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 403 3589 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 404 3599 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 405 3610 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 406 3626 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 407 3638 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 408 3646 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 409 3653 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 410 3658 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 411 3661 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 412 3673 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 413 3689 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 414 3700 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 415 3710 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 416 3726 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 417 3763 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 418 3814 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 419 3841 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 420 3888 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 421 4032 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 422 4059 0 -1 -1 -1 -1 0 0 0 -1 -5.900 0.000 0.000 0.000 - 423 4068 0 -1 -1 -1 -1 0 0 0 -1 -9.500 0.000 0.000 0.000 - 424 4082 0 -1 -1 -1 -1 0 0 0 -1 -9.800 0.000 0.000 0.000 - 425 4095 0 -1 -1 -1 -1 0 0 0 -1 -9.500 0.000 0.000 0.000 - 426 4160 0 -1 -1 -1 -1 0 0 0 -1 -9.900 0.000 0.000 0.000 - 427 4234 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 428 4257 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 429 4411 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 430 4498 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 431 4520 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 432 4552 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 433 4567 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 434 4608 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 435 4646 0 -1 -1 -1 -1 0 0 0 -1 3.200 0.000 0.000 0.000 - 436 4698 0 -1 -1 -1 -1 0 0 0 -1 -8.500 0.000 0.000 0.000 - 437 4808 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 438 4849 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 439 4920 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 440 4939 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 441 4947 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 442 4967 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 443 4991 0 -1 -1 -1 -1 0 0 0 -1 -9.800 0.000 0.000 0.000 - 444 4996 0 -1 -1 -1 -1 0 0 0 -1 -7.100 0.000 0.000 0.000 - 445 5015 0 -1 -1 -1 -1 0 0 0 -1 -1.600 0.000 0.000 0.000 - 446 5028 0 -1 -1 -1 -1 0 0 0 -1 -1.900 0.000 0.000 0.000 - 447 5056 0 -1 -1 -1 -1 0 0 0 -1 -2.000 0.000 0.000 0.000 - 448 5128 0 -1 -1 -1 -1 0 0 0 -1 -2.300 0.000 0.000 0.000 - 449 5130 0 -1 -1 -1 -1 0 0 0 -1 -2.200 0.000 0.000 0.000 - 450 5144 0 -1 -1 -1 -1 0 0 0 -1 -2.500 0.000 0.000 0.000 - 451 5170 0 -1 -1 -1 -1 0 0 0 -1 -1.800 0.000 0.000 0.000 - 452 5178 0 -1 -1 -1 -1 0 0 0 -1 -2.300 0.000 0.000 0.000 - 453 5183 0 -1 -1 -1 -1 0 0 0 -1 -1.300 0.000 0.000 0.000 - 454 5188 0 -1 -1 -1 -1 0 0 0 -1 -0.700 0.000 0.000 0.000 - 455 5191 0 -1 -1 -1 -1 0 0 0 -1 -0.100 0.000 0.000 0.000 - 456 5368 0 -1 -1 -1 -1 0 0 0 -1 -0.900 0.000 0.000 0.000 - 457 5371 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 458 5379 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 459 5381 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 460 5383 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 461 5397 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 462 5399 0 -1 -1 -1 -1 0 0 0 -1 -0.908 0.075 -0.082 0.334 - 463 5401 0 -1 -1 -1 -1 0 0 0 -1 -0.092 0.091 -0.120 0.383 - 464 5403 0 -1 -1 -1 -1 0 0 0 -1 0.960 0.072 -0.128 0.265 - 465 5405 0 -1 -1 -1 -1 0 0 0 -1 0.287 0.285 -0.111 0.144 - 466 5446 0 -1 -1 -1 -1 0 0 0 -1 0.758 0.108 -0.144 0.391 - 467 5455 0 -1 -1 -1 -1 0 0 0 -1 2.837 -0.042 -0.191 0.094 - 468 5472 0 -1 -1 -1 -1 0 0 0 -1 0.812 0.086 -0.151 0.441 - 469 5480 0 -1 -1 -1 -1 0 0 0 -1 1.089 0.050 -0.142 0.376 - 470 5483 0 -1 -1 -1 -1 0 0 0 -1 1.195 -0.006 -0.155 0.349 - 471 5485 0 -1 -1 -1 -1 0 0 0 -1 1.503 -0.057 -0.156 0.293 - 472 5492 0 -1 -1 -1 -1 0 0 0 -1 1.070 0.061 -0.143 0.329 - 473 5497 0 -1 -1 -1 -1 0 0 0 -1 2.235 -0.044 -0.169 0.152 - 474 5502 0 -1 -1 -1 -1 0 0 0 -1 2.407 -0.098 -0.195 0.042 - 475 5507 0 -1 -1 -1 -1 0 0 0 -1 2.066 -0.061 -0.166 0.220 - 476 5509 0 -1 -1 -1 -1 0 0 0 -1 2.447 -0.018 -0.161 0.338 - 477 5517 0 -1 -1 -1 -1 0 0 0 -1 3.333 -0.055 -0.136 0.204 - 478 5528 0 -1 -1 -1 -1 0 0 0 -1 2.443 -0.082 -0.177 0.149 - 479 5558 0 -1 -1 -1 -1 0 0 0 -1 2.861 -0.106 -0.193 0.101 - 480 5697 0 -1 -1 -1 -1 0 0 0 -1 2.755 -0.155 -0.149 0.364 - 481 5714 0 -1 -1 -1 -1 0 0 0 -1 2.750 -0.052 -0.173 0.167 - 482 5749 0 -1 -1 -1 -1 0 0 0 -1 3.185 -0.138 -0.215 0.057 - 483 5766 0 -1 -1 -1 -1 0 0 0 -1 3.208 -0.038 -0.103 0.109 - 484 5785 0 -1 -1 -1 -1 0 0 0 -1 3.495 -0.063 -0.163 0.232 - 485 5798 0 -1 -1 -1 -1 0 0 0 -1 4.130 -0.142 -0.221 0.074 - 486 5799 0 -1 -1 -1 -1 0 0 0 -1 3.626 -0.186 -0.230 0.154 - 487 5801 0 -1 -1 -1 -1 0 0 0 -1 3.683 0.073 -0.134 0.031 - 488 5817 0 -1 -1 -1 -1 0 0 0 -1 3.435 -0.127 -0.236 0.240 - 489 5833 0 -1 -1 -1 -1 0 0 0 -1 3.892 -0.116 -0.235 0.159 - 490 5834 0 -1 -1 -1 -1 0 0 0 -1 3.737 0.053 -0.223 0.186 - 491 5836 0 -1 -1 -1 -1 0 0 0 -1 3.919 -0.080 -0.079 0.059 - 492 5849 0 -1 -1 -1 -1 0 0 0 -1 3.688 -0.042 -0.205 0.343 - 493 5851 0 -1 -1 -1 -1 0 0 0 -1 3.360 -0.045 -0.098 0.146 - 494 5852 0 -1 -1 -1 -1 0 0 0 -1 3.369 -0.019 -0.175 0.322 - 495 5865 0 -1 -1 -1 -1 0 0 0 -1 3.136 -0.079 -0.224 0.101 - 496 5869 0 -1 -1 -1 -1 0 0 0 -1 3.419 -0.082 -0.227 0.236 - 497 5881 0 -1 -1 -1 -1 0 0 0 -1 3.243 0.084 -0.140 -0.044 - 498 5884 0 -1 -1 -1 -1 0 0 0 -1 3.606 -0.076 -0.189 0.218 - 499 5897 0 -1 -1 -1 -1 0 0 0 -1 3.430 -0.081 -0.232 0.348 - 500 5900 0 -1 -1 -1 -1 0 0 0 -1 3.351 0.007 -0.222 0.087 - 501 5916 0 -1 -1 -1 -1 0 0 0 -1 3.531 -0.002 -0.121 0.079 - 502 5932 0 -1 -1 -1 -1 0 0 0 -1 3.334 -0.053 -0.233 0.093 - 503 5948 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 504 5963 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 505 5968 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 506 5978 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 507 5988 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 508 5992 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 509 5994 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 510 5997 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 511 6003 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 512 6008 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 513 6023 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 514 6026 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 515 6039 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 516 6053 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 517 6056 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 518 6067 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 519 6071 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 520 6082 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 521 6085 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 522 6098 0 -1 -1 -1 -1 0 0 0 -1 -5.900 0.000 0.000 0.000 - 523 6112 0 -1 -1 -1 -1 0 0 0 -1 -9.500 0.000 0.000 0.000 - 524 6126 0 -1 -1 -1 -1 0 0 0 -1 -9.800 0.000 0.000 0.000 - 525 6135 0 -1 -1 -1 -1 0 0 0 -1 -9.500 0.000 0.000 0.000 - 526 6140 0 -1 -1 -1 -1 0 0 0 -1 -9.900 0.000 0.000 0.000 - 527 6149 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 528 6154 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 529 6158 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 530 6161 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 531 6168 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 532 6174 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 533 6182 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 534 6187 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 535 6205 0 -1 -1 -1 -1 0 0 0 -1 3.200 0.000 0.000 0.000 - 536 6209 0 -1 -1 -1 -1 0 0 0 -1 -8.500 0.000 0.000 0.000 - 537 6213 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 538 6317 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 539 6339 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 540 6342 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 541 6366 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 542 6381 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 543 6391 0 -1 -1 -1 -1 0 0 0 -1 -9.800 0.000 0.000 0.000 - 544 6489 0 -1 -1 -1 -1 0 0 0 -1 -7.100 0.000 0.000 0.000 - 545 6962 0 -1 -1 -1 -1 0 0 0 -1 -1.600 0.000 0.000 0.000 - 546 6966 0 -1 -1 -1 -1 0 0 0 -1 2.736 -0.076 -0.057 -0.055 - 547 6970 0 -1 -1 -1 -1 0 0 0 -1 3.152 -0.058 -0.192 -0.008 - 548 6975 0 -1 -1 -1 -1 0 0 0 -1 2.264 0.000 -0.182 -0.001 - 549 6977 0 -1 -1 -1 -1 0 0 0 -1 2.360 -0.131 -0.191 0.114 - 550 6982 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 551 6985 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 552 6987 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 553 6989 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 554 6991 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 555 6993 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 556 6995 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 557 6997 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 558 6999 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 559 7000 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 560 7004 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 561 7008 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 562 7013 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 563 7016 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 564 7021 0 -1 -1 -1 -1 0 0 0 -1 0.000 0.000 0.000 0.000 - 565 7024 0 -1 -1 -1 -1 0 0 0 -1 -0.400 0.000 0.000 0.000 - 566 7027 0 -1 -1 -1 -1 0 0 0 -1 -0.700 0.000 0.000 0.000 - 567 7029 0 -1 -1 -1 -1 0 0 0 -1 4.200 0.000 0.000 0.000 - 568 7032 0 -1 -1 -1 -1 0 0 0 -1 2.300 0.000 0.000 0.000 - 569 7038 0 -1 -1 -1 -1 0 0 0 -1 4.000 0.000 0.000 0.000 - 570 7043 0 -1 -1 -1 -1 0 0 0 -1 1.000 0.000 0.000 0.000 - 571 7046 0 -1 -1 -1 -1 0 0 0 -1 0.900 0.000 0.000 0.000 - 572 7049 0 -1 -1 -1 -1 0 0 0 -1 0.100 0.000 0.000 0.000 - 573 7069 0 -1 -1 -1 -1 0 0 0 -1 0.500 0.000 0.000 0.000 - 574 7072 0 -1 -1 -1 -1 0 0 0 -1 1.900 0.000 0.000 0.000 - 575 7076 0 -1 -1 -1 -1 0 0 0 -1 4.400 0.000 0.000 0.000 - 576 7081 0 -1 -1 -1 -1 0 0 0 -1 9.300 0.000 0.000 0.000 - 577 7084 0 -1 -1 -1 -1 0 0 0 -1 5.700 0.000 0.000 0.000 - 578 7089 0 -1 -1 -1 -1 0 0 0 -1 0.500 0.000 0.000 0.000 - 579 7099 0 -1 -1 -1 -1 0 0 0 -1 -0.400 0.000 0.000 0.000 - 580 7209 0 -1 -1 -1 -1 0 0 0 -1 2.200 0.000 0.000 0.000 - 581 7222 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - 582 7231 0 -1 -1 -1 -1 0 0 0 -1 -1.500 0.000 0.000 0.000 - 583 7235 0 -1 -1 -1 -1 0 0 0 -1 -1.300 0.000 0.000 0.000 - 584 7247 0 -1 -1 -1 -1 0 0 0 -1 -1.500 0.000 0.000 0.000 - 585 7267 0 -1 -1 -1 -1 0 0 0 -1 -1.400 0.000 0.000 0.000 - 586 7269 0 -1 -1 -1 -1 0 0 0 -1 -1.600 0.000 0.000 0.000 - 587 7284 0 -1 -1 -1 -1 0 0 0 -1 -1.700 0.000 0.000 0.000 - 588 7389 0 -1 -1 -1 -1 0 0 0 -1 -1.600 0.000 0.000 0.000 - 589 7419 0 -1 -1 -1 -1 0 0 0 -1 -1.500 0.000 0.000 0.000 - 590 7423 0 -1 -1 -1 -1 0 0 0 -1 -1.400 0.000 0.000 0.000 - 591 7424 0 -1 -1 -1 -1 0 0 0 -1 -1.300 0.000 0.000 0.000 - 592 7426 0 -1 -1 -1 -1 0 0 0 -1 -1.300 0.000 0.000 0.000 - 593 7428 0 -1 -1 -1 -1 0 0 0 -1 -1.100 0.000 0.000 0.000 - 594 7431 0 -1 -1 -1 -1 0 0 0 -1 -1.000 0.000 0.000 0.000 - 595 7436 0 -1 -1 -1 -1 0 0 0 -1 -1.100 0.000 0.000 0.000 - 596 7444 0 -1 -1 -1 -1 0 0 0 -1 -1.000 0.000 0.000 0.000 - 597 7475 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - 598 7549 0 -1 -1 -1 -1 0 0 0 -1 -1.200 0.000 0.000 0.000 - 599 7584 0 -1 -1 -1 -1 0 0 0 -1 -0.700 0.000 0.000 0.000 - 600 7665 0 -1 -1 -1 -1 0 0 0 -1 -1.100 0.000 0.000 0.000 - 601 7666 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - 602 7831 0 -1 -1 -1 -1 0 0 0 -1 -0.900 0.000 0.000 0.000 - 603 7836 0 -1 -1 -1 -1 0 0 0 -1 -0.800 0.000 0.000 0.000 - 604 7853 0 -1 -1 -1 -1 0 0 0 -1 -0.300 0.000 0.000 0.000 - 605 7865 0 -1 -1 -1 -1 0 0 0 -1 0.300 0.000 0.000 0.000 - 606 7885 0 -1 -1 -1 -1 0 0 0 -1 -1.000 0.000 0.000 0.000 - 607 7888 0 -1 -1 -1 -1 0 0 0 -1 -1.400 0.000 0.000 0.000 - 608 7912 0 -1 -1 -1 -1 0 0 0 -1 0.200 0.000 0.000 0.000 - 609 7950 0 -1 -1 -1 -1 0 0 0 -1 -1.000 0.000 0.000 0.000 - 610 7972 0 -1 -1 -1 -1 0 0 0 -1 0.200 0.000 0.000 0.000 - 611 7980 0 -1 -1 -1 -1 0 0 0 -1 -0.200 0.000 0.000 0.000 - 612 7995 0 -1 -1 -1 -1 0 0 0 -1 -0.300 0.000 0.000 0.000 - 613 8007 0 -1 -1 -1 -1 0 0 0 -1 -0.800 0.000 0.000 0.000 - 614 8015 0 -1 -1 -1 -1 0 0 0 -1 0.200 0.000 0.000 0.000 - 615 8055 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - 616 8078 0 -1 -1 -1 -1 0 0 0 -1 -0.600 0.000 0.000 0.000 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 12 2 21 8 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 - 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 - 10000 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 2 2 0 0 0 0 0 0 0 0 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 3 3 0 0 0 0 0 0 0 0 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 4 4 0 0 0 0 0 0 0 0 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 5 5 0 0 0 0 0 0 0 0 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 6 6 0 0 0 0 0 0 0 0 1.195 0.009 -0.048 0.082 -0.055 -1.055 0.894 -0.481 - 7 7 0 0 0 0 0 0 0 0 1.653 0.037 -0.072 0.066 -0.097 -1.610 0.345 0.302 - 8 8 0 0 0 0 0 0 0 0 0.582 0.253 -0.041 -0.042 -0.031 -0.803 0.227 0.076 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 12 3 21 8 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 - 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 - 10000 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 0 0 0 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 2 2 0 0 0 0 0 0 0 0 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 3 3 0 0 0 0 0 0 0 0 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 4 4 0 0 0 0 0 0 0 0 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 5 5 0 0 0 0 0 0 0 0 4.457 -0.211 -0.054 0.213 -0.101 1.770 -0.283 -0.794 - 6 6 0 0 0 0 0 0 0 0 1.195 0.009 -0.048 0.082 -0.055 -1.055 0.894 -0.481 - 7 7 0 0 0 0 0 0 0 0 1.653 0.037 -0.072 0.066 -0.097 -1.610 0.345 0.302 - 8 8 0 0 0 0 0 0 0 0 0.582 0.253 -0.041 -0.042 -0.031 -0.803 0.227 0.076 - ------------------------------------------------ - Platform_id Sat_id Sensor_id Nchanl Npredmax - ------------------------------------------------ - 29 1 63 14 8 - -----> Bias predictor statistics: Mean & Std & Nbgerr - 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 - 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 - 10000 10000 10000 10000 10000 10000 10000 10000 10000 - -----> Chanl_id Chanl_nb Pred_use(-1/0/1) Param - 1 1 0 0 0 0 0 -1 -1 -1 - 2 2 0 0 0 0 0 -1 -1 -1 - 3 3 0 0 0 0 0 -1 -1 -1 - 4 4 0 0 0 0 0 -1 -1 -1 - 5 5 0 0 0 0 0 -1 -1 -1 - 6 6 0 0 0 0 0 -1 -1 -1 - 7 7 0 0 0 0 0 -1 -1 -1 - 8 8 0 0 0 0 0 -1 -1 -1 - 9 9 0 0 0 0 0 -1 -1 -1 - 10 10 0 0 0 0 0 -1 -1 -1 - 11 11 0 0 0 0 0 -1 -1 -1 - 12 12 0 0 0 0 0 -1 -1 -1 - 13 13 0 0 0 0 0 -1 -1 -1 - 14 14 0 0 0 0 0 -1 -1 -1 diff --git a/var/run/VARBC.in b/var/run/VARBC.in new file mode 120000 index 0000000000..dfa3c6c3ec --- /dev/null +++ b/var/run/VARBC.in @@ -0,0 +1 @@ +/glade/work/wuyl/test/WRFDA_V3.9FD1_wyb2_3D/var/run/VARBC.in \ No newline at end of file diff --git a/var/run/ahi_info b/var/run/ahi_info new file mode 100644 index 0000000000..2d6da8f68b --- /dev/null +++ b/var/run/ahi_info @@ -0,0 +1,8 @@ +data source:1.cma hdf5;2.geocat netcdf4;3.jaxa netcdf4;4.ncep bufr +2 +nscan +3000 +area information for geocat netcdf4 data: lonstart latstart nlongitude nlatitude +1,1,1500,1000 +date infomation for cma hdf5 data +2016,07,18,19,00,00 diff --git a/var/run/radiance_info/himawari-8-ahi.info b/var/run/radiance_info/himawari-8-ahi.info new file mode 100644 index 0000000000..697e15f101 --- /dev/null +++ b/var/run/radiance_info/himawari-8-ahi.info @@ -0,0 +1,11 @@ +sensor channel IR/MW use idum varch polarisation(0:vertical;1:horizontal) + 478 1 1 -1 0 1.0520000000E+00 1.0000000000E+00 28.30175 + 478 2 1 1 0 1.3350000000E+00 1.0000000000E+00 57.58830 + 478 3 1 1 0 1.4630000000E+00 1.0000000000E+00 12.69287 + 478 4 1 1 0 1.1650000000E+00 1.0000000000E+00 27.33099 + 478 5 1 -1 0 2.0540000000E+00 1.0000000000E+00 23.24269 + 478 6 1 -1 0 9.9310000000E+00 1.0000000000E+00 53.35099 + 478 7 1 -1 0 2.1670000000E+00 1.0000000000E+00 36.07700 + 478 8 1 -1 0 2.0810000000E+00 1.0000000000E+00 33.61592 + 478 9 1 -1 0 1.8300000000E+00 1.0000000000E+00 33.61592 + 478 10 1 -1 0 1.0900000000E+00 1.0000000000E+00 33.61592 diff --git a/var/test/4dvar/namelist.input b/var/test/4dvar/namelist.input index 0d23aaedf5..8accd35130 100644 --- a/var/test/4dvar/namelist.input +++ b/var/test/4dvar/namelist.input @@ -28,6 +28,7 @@ use_gpspwobs=true, use_gpsrefobs=true, use_qscatobs=true, use_rainobs=false, +use_ahiobs=true, / &wrfvar5 check_max_iv=true, @@ -59,6 +60,26 @@ calculate_cg_cost_fn=false, &wrfvar13 / &wrfvar14 +rtminit_nsensor=1 +rtminit_platform=31 +rtminit_satid=8 +rtminit_sensor=56 +thinning_mesh=36.0, +thinning=true, +qc_rad=true, +write_iv_rad_ascii=true, +write_oa_rad_ascii=true, +rtm_option=2, +crtm_cloud=false, +only_sea_rad=false, +use_varbc=true, +varbc_nobsmin=10, +varbc_scan=2, +calc_weightfunc =false, +crtm_irland_coef='IGBP.IRland.EmisCoeff.bin' +write_profile =false, +write_jacobian = false, +write_filtered_rad = false, / &wrfvar15 / @@ -148,7 +169,7 @@ real_data_init_type=3, &perturbation trajectory_io=true, enable_identity=false, -jcdfi_use=false, +jcdfi_use=true, jcdfi_diag=1, jcdfi_penalty=1000.0, / From 4a3cd18caf62d3dcdb2cbacc0805808bace65e7e Mon Sep 17 00:00:00 2001 From: wishingprincess Date: Sat, 23 Feb 2019 15:03:33 -0700 Subject: [PATCH 42/91] modified: var/build/depend.txt --- var/build/depend.txt | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/var/build/depend.txt b/var/build/depend.txt index dd1b2623f0..bc007a90b2 100644 --- a/var/build/depend.txt +++ b/var/build/depend.txt @@ -206,8 +206,7 @@ gen_be_diags_read.o : gen_be_diags_read.f90 da_gen_be.o da_tools_serial.o da_con gen_be_ensmean.o : gen_be_ensmean.f90 da_reporting.o da_control.o gen_be_ensrf.o : gen_be_ensrf.f90 da_gen_be.o da_control.o gen_be_ep1.o : gen_be_ep1.f90 da_tools_serial.o da_gen_be.o da_control.o -gen_be_ep2.o : gen_be_ep2.f90 -gen_be_ep2_serial.o : gen_be_ep2_serial.f90 da_gen_be.o da_tools_serial.o da_control.o +gen_be_ep2.o : gen_be_ep2.f90 da_gen_be.o da_tools_serial.o da_control.o gen_be_etkf.o : gen_be_etkf.f90 da_reporting.o da_etkf.o da_control.o gen_be_hist.o : gen_be_hist.f90 da_tools_serial.o da_control.o gen_be_read_regcoeffs.o : gen_be_read_regcoeffs.f90 From 330560c53f578b458865d8c75e2d05a07d741efb Mon Sep 17 00:00:00 2001 From: wishingprincess Date: Sat, 23 Feb 2019 15:04:48 -0700 Subject: [PATCH 43/91] modified: format "I" to "I4" for gnu compile, var/da/da_radiance/da_write_iv_rad_for_multi_inc.inc --- var/da/da_radiance/da_write_iv_rad_for_multi_inc.inc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/var/da/da_radiance/da_write_iv_rad_for_multi_inc.inc b/var/da/da_radiance/da_write_iv_rad_for_multi_inc.inc index 138ed09a5a..008e49db3c 100644 --- a/var/da/da_radiance/da_write_iv_rad_for_multi_inc.inc +++ b/var/da/da_radiance/da_write_iv_rad_for_multi_inc.inc @@ -74,7 +74,7 @@ subroutine da_write_iv_rad_for_multi_inc (it,ob, iv ) if (iv%instid(i)%info%proc_domain(1,n)) then ! iobs = iv%instid(i)%info%obs_global_index(n) iobs = n - write(unit=message(1),fmt='(I)') iobs + write(unit=message(1),fmt='(I4)') iobs call da_message(message(1:1)) if ( amsr2 ) then ! write out clw data2d(iobs, 1) = iv%instid(i)%info%lat(1,n) From 2941195d82a8d8e6602375248f8b7b9d83e05ffc Mon Sep 17 00:00:00 2001 From: wishingprincess Date: Mon, 25 Feb 2019 14:28:40 -0700 Subject: [PATCH 44/91] modified: var/build/depend.txt (gen_be_ep2_serial.o) --- var/build/depend.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/var/build/depend.txt b/var/build/depend.txt index bc007a90b2..b2ba2cf4b3 100644 --- a/var/build/depend.txt +++ b/var/build/depend.txt @@ -207,6 +207,7 @@ gen_be_ensmean.o : gen_be_ensmean.f90 da_reporting.o da_control.o gen_be_ensrf.o : gen_be_ensrf.f90 da_gen_be.o da_control.o gen_be_ep1.o : gen_be_ep1.f90 da_tools_serial.o da_gen_be.o da_control.o gen_be_ep2.o : gen_be_ep2.f90 da_gen_be.o da_tools_serial.o da_control.o +gen_be_ep2_serial.o : gen_be_ep2_serial.f90 da_gen_be.o da_tools_serial.o da_control.o gen_be_etkf.o : gen_be_etkf.f90 da_reporting.o da_etkf.o da_control.o gen_be_hist.o : gen_be_hist.f90 da_tools_serial.o da_control.o gen_be_read_regcoeffs.o : gen_be_read_regcoeffs.f90 From bf3d506e5f9df00ee9f5eb67e43a280da9e102d8 Mon Sep 17 00:00:00 2001 From: wishingprincess Date: Thu, 28 Feb 2019 11:48:12 -0700 Subject: [PATCH 45/91] modified: var/da/da_radiance/da_radiance1.f90 (use da_qc_ahi_zou.inc rather than da_qc_ahi.inc) --- var/da/da_radiance/da_radiance1.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/var/da/da_radiance/da_radiance1.f90 b/var/da/da_radiance/da_radiance1.f90 index b2dcbe4e44..1ae884f7a0 100644 --- a/var/da/da_radiance/da_radiance1.f90 +++ b/var/da/da_radiance/da_radiance1.f90 @@ -248,7 +248,7 @@ module da_radiance1 #include "da_qc_atms.inc" #include "da_qc_seviri.inc" #include "da_qc_amsr2.inc" -#include "da_qc_ahi.inc" +!#include "da_qc_ahi.inc" #include "da_qc_goesimg.inc" #include "da_qc_ahi_zou.inc" #include "da_write_iv_rad_ascii.inc" From 0a801f02faa3372962031d0e90bb3d4b0b1ccc07 Mon Sep 17 00:00:00 2001 From: wishingprincess Date: Thu, 28 Feb 2019 13:07:55 -0700 Subject: [PATCH 46/91] modified: var/da/da_radiance/da_radiance.f90 modified: var/da/da_radiance/da_read_obs_netcdf4ahi_geocat.inc modified: var/da/da_varbc/da_varbc_pred.inc --- var/da/da_radiance/da_radiance.f90 | 1 - var/da/da_radiance/da_read_obs_netcdf4ahi_geocat.inc | 9 --------- var/da/da_varbc/da_varbc_pred.inc | 3 ++- 3 files changed, 2 insertions(+), 11 deletions(-) diff --git a/var/da/da_radiance/da_radiance.f90 b/var/da/da_radiance/da_radiance.f90 index c4a0e23011..207a8982dd 100644 --- a/var/da/da_radiance/da_radiance.f90 +++ b/var/da/da_radiance/da_radiance.f90 @@ -122,7 +122,6 @@ module da_radiance #include "da_read_obs_bufriasi.inc" #include "da_read_obs_bufrseviri.inc" #include "da_read_obs_hdf5amsr2.inc" -#include "da_read_obs_hdf5ahi.inc" #include "da_read_obs_netcdf4ahi_geocat.inc" #include "da_read_obs_netcdf4ahi_jaxa.inc" #include "da_read_obs_ncgoesimg.inc" diff --git a/var/da/da_radiance/da_read_obs_netcdf4ahi_geocat.inc b/var/da/da_radiance/da_read_obs_netcdf4ahi_geocat.inc index 0a21b7024a..e4a7261718 100644 --- a/var/da/da_radiance/da_read_obs_netcdf4ahi_geocat.inc +++ b/var/da/da_radiance/da_read_obs_netcdf4ahi_geocat.inc @@ -100,15 +100,6 @@ subroutine da_read_obs_netcdf4ahi_geocat (iv, infile_tb, infile_clp) 'himawari_8_ahi_channel_14_brightness_temperature',& 'himawari_8_ahi_channel_15_brightness_temperature',& 'himawari_8_ahi_channel_16_brightness_temperature'/ -======= - 'himawari_8_ahi_channel_10_brightness_temperature',& - 'himawari_8_ahi_channel_11_brightness_temperature',& - 'himawari_8_ahi_channel_12_brightness_temperature',& - 'himawari_8_ahi_channel_13_brightness_temperature',& - 'himawari_8_ahi_channel_14_brightness_temperature',& - 'himawari_8_ahi_channel_15_brightness_temperature',& - 'himawari_8_ahi_channel_16_brightness_temperature'/ ->>>>>>> develop if (trace_use) call da_trace_entry("da_read_obs_netcdf4ahi_geocat") diff --git a/var/da/da_varbc/da_varbc_pred.inc b/var/da/da_varbc/da_varbc_pred.inc index b699d63ab6..b0a8f60795 100644 --- a/var/da/da_varbc/da_varbc_pred.inc +++ b/var/da/da_varbc/da_varbc_pred.inc @@ -75,7 +75,8 @@ subroutine da_varbc_pred(iv) if (npredmax >= 5) iv%instid(inst)%varbc_info%pred(5,n) = pred_hk(4) ! Scan predictors - if (varbc_scan(inst) == 1) then ! use scanpos for polar-orbiting sensors +!wuyl if (varbc_scan(inst) == 1) then ! use scanpos for polar-orbiting sensors + if (varbc_scan == 1) then ! use scanpos for polar-orbiting sensors if (npredmax >= 6) iv%instid(inst)%varbc_info%pred(6,n) = iv%instid(inst)%scanpos(n) if (npredmax >= 7) iv%instid(inst)%varbc_info%pred(7,n) = iv%instid(inst)%scanpos(n)**2 if (npredmax >= 8) iv%instid(inst)%varbc_info%pred(8,n) = iv%instid(inst)%scanpos(n)**3 From 101c811e6d32c8df68de9ced3efaefc8094d8180 Mon Sep 17 00:00:00 2001 From: liujake Date: Tue, 17 Nov 2020 20:58:13 -0700 Subject: [PATCH 47/91] On branch v4_mri4dvar_ahi_develop Junmei Ban's additional changes modified: var/build/depend.txt modified: var/da/da_minimisation/da_get_innov_vector.inc modified: var/da/da_obs_io/da_final_write_obs.inc modified: var/da/da_radiance/da_get_innov_vector_crtm.inc modified: var/da/da_radiance/da_get_innov_vector_radiance.inc modified: var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc modified: var/da/da_radiance/da_write_iv_rad_for_multi_inc.inc --- var/build/depend.txt | 2 +- .../da_minimisation/da_get_innov_vector.inc | 10 +- var/da/da_obs_io/da_final_write_obs.inc | 156 +++--------- .../da_radiance/da_get_innov_vector_crtm.inc | 2 - .../da_get_innov_vector_radiance.inc | 1 - .../da_read_iv_rad_for_multi_inc.inc | 140 +++++++---- .../da_write_iv_rad_for_multi_inc.inc | 223 +++++++++++------- 7 files changed, 261 insertions(+), 273 deletions(-) diff --git a/var/build/depend.txt b/var/build/depend.txt index ebff05af46..6e099cda2b 100644 --- a/var/build/depend.txt +++ b/var/build/depend.txt @@ -144,7 +144,7 @@ da_qscat.o : da_qscat.f90 da_calculate_grady_qscat.inc da_transform_xtoy_qscat_a da_rad_diags.o : da_rad_diags.f90 da_radar.o : da_radar.f90 da_write_oa_radar_ascii.inc da_max_error_qc_radar.inc da_calculate_grady_radar.inc da_radial_velocity_adj.inc da_radial_velocity_lin.inc da_radial_velocity.inc da_radar_rf.inc da_get_innov_vector_radar.inc da_check_max_iv_radar.inc da_transform_xtoy_radar_adj.inc da_transform_xtoy_radar.inc da_print_stats_radar.inc da_oi_stats_radar.inc da_residual_radar.inc da_jo_and_grady_radar.inc da_ao_stats_radar.inc da_tools_serial.o da_reporting.o da_tracing.o da_tools.o da_statistics.o da_par_util1.o da_par_util.o da_interpolation.o da_define_structures.o da_control.o module_domain.o da_radiance.o : da_radiance.f90 da_blacklist_rad.inc da_read_pseudo_rad.inc da_get_innov_vector_radiance.inc da_radiance_init.inc da_setup_radiance_structures.inc da_sort_rad.inc da_read_kma1dvar.inc da_initialize_rad_iv.inc da_allocate_rad_iv.inc da_read_obs_bufrssmis.inc da_read_obs_bufrairs.inc da_read_obs_bufriasi.inc da_read_obs_bufrseviri.inc da_read_obs_bufrtovs.inc da_write_filtered_rad.inc da_read_simulated_rad.inc da_read_filtered_rad.inc da_calculate_grady_rad.inc gsi_thinning.o da_wrf_interfaces.o da_varbc.o da_tracing.o da_tools.o da_statistics.o da_rttov.o da_reporting.o da_radiance1.o da_physics.o da_par_util.o da_par_util1.o da_tools_serial.o da_interpolation.o da_define_structures.o da_crtm.o da_control.o module_radiance.o module_domain.o amsr2time_.c da_read_obs_hdf5amsr2.inc da_deallocate_radiance.inc da_read_obs_ncgoesimg.inc da_get_satzen.inc da_read_obs_hdf5ahi.inc da_read_obs_netcdf4ahi_jaxa.inc da_read_obs_netcdf4ahi_geocat.inc -da_radiance1.o : da_radiance1.f90 da_mspps_ts.inc da_mspps_emis.inc da_setup_satcv.inc da_qc_rad.inc da_print_stats_rad.inc da_oi_stats_rad.inc da_ao_stats_rad.inc da_cld_eff_radius.inc da_detsurtyp.inc da_write_oa_rad_ascii.inc da_write_iv_rad_ascii.inc da_qc_mhs.inc da_qc_ssmis.inc da_qc_hirs.inc da_qc_amsub.inc da_qc_amsua.inc da_qc_airs.inc da_cloud_detect_airs.inc da_cloud_sim.inc da_qc_seviri.inc da_qc_iasi.inc da_cloud_detect_iasi.inc da_qc_crtm.inc da_predictor_crtm.inc da_predictor_rttov.inc da_write_biasprep.inc da_biasprep.inc da_read_biascoef.inc da_biascorr.inc da_residual_rad.inc da_jo_and_grady_rad.inc gsi_constants.o da_tracing.o da_tools_serial.o da_tools.o da_statistics.o da_reporting.o da_par_util1.o da_par_util.o module_dm.o da_define_structures.o da_control.o module_radiance.o da_qc_amsr2.inc da_qc_goesimg.inc da_qc_ahi.inc +da_radiance1.o : da_radiance1.f90 da_mspps_ts.inc da_mspps_emis.inc da_setup_satcv.inc da_qc_rad.inc da_print_stats_rad.inc da_oi_stats_rad.inc da_ao_stats_rad.inc da_cld_eff_radius.inc da_detsurtyp.inc gsi_thinning.o da_write_oa_rad_ascii.inc da_write_iv_rad_ascii.inc da_write_iv_rad_for_multi_inc.inc da_read_iv_rad_for_multi_inc.inc da_qc_mhs.inc da_qc_ssmis.inc da_qc_hirs.inc da_qc_amsub.inc da_qc_amsua.inc da_qc_airs.inc da_cloud_detect_airs.inc da_cloud_sim.inc da_qc_seviri.inc da_qc_iasi.inc da_cloud_detect_iasi.inc da_qc_crtm.inc da_predictor_crtm.inc da_predictor_rttov.inc da_write_biasprep.inc da_biasprep.inc da_read_biascoef.inc da_biascorr.inc da_residual_rad.inc da_jo_and_grady_rad.inc gsi_constants.o da_tracing.o da_tools_serial.o da_tools.o da_statistics.o da_reporting.o da_par_util1.o da_par_util.o module_dm.o da_define_structures.o da_control.o module_radiance.o da_qc_amsr2.inc da_qc_goesimg.inc da_qc_ahi.inc da_rain.o : da_rain.f90 da_calculate_grady_rain.inc da_get_innov_vector_rain.inc da_get_hr_rain.inc da_check_max_iv_rain.inc da_transform_xtoy_rain_adj.inc da_transform_xtoy_rain.inc da_print_stats_rain.inc da_oi_stats_rain.inc da_residual_rain.inc da_jo_and_grady_rain.inc da_ao_stats_rain.inc da_tracing.o da_tools.o da_statistics.o da_par_util.o da_par_util1.o da_interpolation.o da_define_structures.o da_control.o module_comm_dm.o module_dm.o module_domain.o da_recursive_filter.o : da_recursive_filter.f90 da_apply_rf_adj.inc da_apply_rf.inc da_apply_rf_1v_adj.inc da_apply_rf_1v.inc da_transform_through_rf_adj.inc da_transform_through_rf.inc da_transform_through_rf_inv.inc da_recursive_filter_1d_adj.inc da_recursive_filter_1d.inc da_recursive_filter_1d_inv.inc da_calculate_rf_factors.inc da_transform_through_rf_dual_res.inc da_transform_through_rf_adj_dual_res.inc da_perform_2drf.inc da_rf_cv3.o da_rfz_cv3.o da_tracing.o da_par_util.o da_define_structures.o da_control.o module_domain.o da_reporting.o : da_reporting.f90 da_message2.inc da_message.inc da_warning.inc da_error.inc da_control.o diff --git a/var/da/da_minimisation/da_get_innov_vector.inc b/var/da/da_minimisation/da_get_innov_vector.inc index b63bf71b51..9c905e4372 100644 --- a/var/da/da_minimisation/da_get_innov_vector.inc +++ b/var/da/da_minimisation/da_get_innov_vector.inc @@ -84,10 +84,10 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) endif do n= num_fgat_time , 1, -1 +print*,"jban check timeslot=",n,iv%time iv%time = n iv%info(:)%n1 = iv%info(:)%plocal(iv%time-1) + 1 iv%info(:)%n2 = iv%info(:)%plocal(iv%time) - if (num_fgat_time > 1) then if (var4d) then call domain_clock_get( grid, current_timestr=timestr ) @@ -106,6 +106,7 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) call da_get_innov_vector_sound (it, num_qcstat_conv, grid, ob, iv) call da_get_innov_vector_sonde_sfc (it, num_qcstat_conv, grid, ob, iv) end if + if (iv%info(mtgirs)%nlocal > 0) & call da_get_innov_vector_mtgirs (it, num_qcstat_conv, grid, ob, iv) if (iv%info(tamdar)%nlocal > 0) & @@ -176,7 +177,6 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) !---------------------------------------------- ! [5] write out iv in ascii format !----------------------------------------------- - if ( multi_inc == 1 ) then if ( multi_inc_io_opt == 1 ) then @@ -194,12 +194,9 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) end if endif - if (n > 1 .and. var4d) call domain_clockadvance (grid) call domain_clockprint(150, grid, 'DEBUG Adjoint Forcing: get CurrTime from clock,') - end do - #if defined(RTTOV) || defined(CRTM) if (use_rad) then if ( use_varbc .or. freeze_varbc ) then @@ -224,7 +221,6 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) if ( use_varbc .and. it == 1 ) call da_varbc_precond(iv) !fixed by wuyl end if #endif - if ( use_rainobs .and. num_fgat_time > 1 .and. var4d) then deallocate (hr_rainc ) deallocate (hr_rainnc) @@ -242,13 +238,11 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) write(unit=stdout,fmt='(A,A)') 'Restore to first guess :fg at ',trim(analysis_date(1:19)) call da_read_basicstates ( xbx, grid, config_flags, timestr, filename1) end if - if (num_fgat_time > 1) then call nl_get_time_step ( grid%id, time_step_seconds) call domain_clock_set (grid, time_step_seconds=time_step_seconds) call domain_clockprint(150, grid, 'get CurrTime from clock,') end if - #if defined(CRTM) || defined(RTTOV) !---------------------------------------------- ! write out or read in radiance iv for multi in binary format diff --git a/var/da/da_obs_io/da_final_write_obs.inc b/var/da/da_obs_io/da_final_write_obs.inc index 311fdf34af..02b603876f 100644 --- a/var/da/da_obs_io/da_final_write_obs.inc +++ b/var/da/da_obs_io/da_final_write_obs.inc @@ -8,7 +8,7 @@ subroutine da_final_write_obs(it,iv) integer, intent(in) :: it type (iv_type), intent(in) :: iv ! O-B structure. - integer :: n, k, iunit,m, m1,m2 + integer :: n, k, iunit integer :: ios ! Error code from MPI routines. integer :: num_obs logical :: if_wind_sd @@ -23,34 +23,22 @@ subroutine da_final_write_obs(it,iv) call mpi_barrier(comm, ierr) #endif -!wuyl -do m= num_fgat_time , 1, -1 - - if (rootproc) then - call da_get_unit(iunit) - allocate (filename(0:num_procs-1)) - do k = 0,num_procs-1 - write(unit=filename(k),fmt ='(a,i2.2,a,i4.4)')'gts_omb_oma_',it,'.',k - end do - - - call da_get_unit(omb_unit) - if (num_fgat_time>1) then - write(unit=file,fmt ='(a,i2.2,a,i2.2)')'gts_omb_oma_',m,'_',it - else - write(unit=file,fmt ='(a,i2.2)')'gts_omb_oma_',it - end if - open(unit=omb_unit,file=trim(file),form='formatted', status='replace', iostat=ios) - if (ios /= 0) call da_error(__FILE__,__LINE__, & - (/"Cannot open file "//file/)) - end if + if (rootproc) then + call da_get_unit(iunit) + allocate (filename(0:num_procs-1)) + do k = 0,num_procs-1 + write(unit=filename(k),fmt ='(a,i2.2,a,i4.4)')'gts_omb_oma_',it,'.',k + end do + call da_get_unit(omb_unit) + write(unit=file,fmt ='(a,i2.2)')'gts_omb_oma_',it + open(unit=omb_unit,file=trim(file),form='formatted', status='replace', iostat=ios) + if (ios /= 0) call da_error(__FILE__,__LINE__, & + (/"Cannot open file "//file/)) + end if num_obs = 0 if (iv%info(synop)%nlocal > 0) then -!wuyl do n = 1, iv%info(synop)%nlocal - m1 = iv%info(synop)%plocal(m-1) + 1 - m2 = iv%info(synop)%plocal(m) - do n = m1,m2 + do n = 1, iv%info(synop)%nlocal if(iv%info(synop)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -71,10 +59,7 @@ do m= num_fgat_time , 1, -1 num_obs = 0 if (iv%info(metar)%nlocal > 0) then -!wuyl do n = 1, iv%info(metar)%nlocal - m1 = iv%info(metar)%plocal(m-1) + 1 - m2 = iv%info(metar)%plocal(m) - do n = m1,m2 + do n = 1, iv%info(metar)%nlocal if (iv%info(metar)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -95,10 +80,7 @@ do m= num_fgat_time , 1, -1 num_obs = 0 if (iv%info(ships)%nlocal > 0) then -!wuyl do n = 1, iv%info(ships)%nlocal - m1 = iv%info(ships)%plocal(m-1) + 1 - m2 = iv%info(ships)%plocal(m) - do n = m1,m2 + do n = 1, iv%info(ships)%nlocal if(iv%info(ships)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -119,10 +101,7 @@ do m= num_fgat_time , 1, -1 num_obs = 0 if (iv%info(geoamv)%nlocal > 0) then -!wuyl do n = 1, iv%info(geoamv)%nlocal - m1 = iv%info(geoamv)%plocal(m-1) + 1 - m2 = iv%info(geoamv)%plocal(m) - do n = m1,m2 + do n = 1, iv%info(geoamv)%nlocal if (iv%info(geoamv)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -143,10 +122,7 @@ do m= num_fgat_time , 1, -1 num_obs = 0 if (iv%info(polaramv)%nlocal > 0) then -!wuyl do n = 1, iv%info(polaramv)%nlocal - m1 = iv%info(polaramv)%plocal(m-1) + 1 - m2 = iv%info(polaramv)%plocal(m) - do n = m1,m2 + do n = 1, iv%info(polaramv)%nlocal if (iv%info(polaramv)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -167,10 +143,7 @@ do m= num_fgat_time , 1, -1 num_obs = 0 if (iv%info(gpspw)%nlocal > 0) then -!wuyl do n = 1, iv%info(gpspw)%nlocal - m1 = iv%info(gpspw)%plocal(m-1) + 1 - m2 = iv%info(gpspw)%plocal(m) - do n = m1,m2 + do n = 1, iv%info(gpspw)%nlocal if(iv%info(gpspw)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -190,10 +163,7 @@ do m= num_fgat_time , 1, -1 num_obs = 0 if (iv%info(sound)%nlocal > 0) then -!wuyl do n = 1, iv%info(sound)%nlocal - m1 = iv%info(sound)%plocal(m-1) + 1 - m2 = iv%info(sound)%plocal(m) - do n = m1,m2 + do n = 1, iv%info(sound)%nlocal if (iv%info(sound)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -211,10 +181,7 @@ do m= num_fgat_time , 1, -1 ! Now sonde_sfc num_obs = 0 if (iv%info(sonde_sfc)%nlocal > 0) then -!wuyl do n = 1, iv%info(sonde_sfc)%nlocal - m1 = iv%info(sonde_sfc)%plocal(m-1) + 1 - m2 = iv%info(sonde_sfc)%plocal(m) - do n = m1,m2 + do n = 1, iv%info(sonde_sfc)%nlocal if(iv%info(sonde_sfc)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -233,10 +200,7 @@ do m= num_fgat_time , 1, -1 num_obs = 0 if (iv%info(airep)%nlocal > 0) then -!wuyl do n = 1, iv%info(airep)%nlocal - m1 = iv%info(airep)%plocal(m-1) + 1 - m2 = iv%info(airep)%plocal(m) - do n = m1,m2 + do n = 1, iv%info(airep)%nlocal if(iv%info(airep)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -257,10 +221,7 @@ do m= num_fgat_time , 1, -1 num_obs = 0 if (iv%info(pilot)%nlocal > 0) then -! do n = 1, iv%info(pilot)%nlocal - m1 = iv%info(pilot)%plocal(m-1) + 1 - m2 = iv%info(pilot)%plocal(m) - do n = m1,m2 + do n = 1, iv%info(pilot)%nlocal if(iv%info(pilot)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -281,10 +242,7 @@ do m= num_fgat_time , 1, -1 num_obs = 0 if (iv%info(ssmi_rv)%nlocal > 0) then -! do n = 1, iv%info(ssmi_rv)%nlocal - m1 = iv%info(ssmi_rv)%plocal(m-1) + 1 - m2 = iv%info(ssmi_rv)%plocal(m) - do n = m1,m2 + do n = 1, iv%info(ssmi_rv)%nlocal if(iv%info(ssmi_rv)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -304,10 +262,7 @@ do m= num_fgat_time , 1, -1 num_obs = 0 if (iv%info(ssmi_tb)%nlocal > 0) then -! do n = 1, iv%info(ssmi_tb)%nlocal - m1 = iv%info(ssmi_tb)%plocal(m-1) + 1 - m2 = iv%info(ssmi_tb)%plocal(m) - do n = m1,m2 + do n = 1, iv%info(ssmi_tb)%nlocal if (iv%info(ssmi_tb)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -327,10 +282,7 @@ do m= num_fgat_time , 1, -1 num_obs = 0 if (iv%info(satem)%nlocal > 0) then -! do n = 1, iv%info(satem)%nlocal - m1 = iv%info(satem)%plocal(m-1) + 1 - m2 = iv%info(satem)%plocal(m) - do n = m1,m2 + do n = 1, iv%info(satem)%nlocal if(iv%info(satem)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -350,10 +302,7 @@ do m= num_fgat_time , 1, -1 num_obs = 0 if (iv%info(ssmt1)%nlocal > 0) then -! do n = 1, iv%info(ssmt1)%nlocal - m1 = iv%info(ssmt1)%plocal(m-1) + 1 - m2 = iv%info(ssmt1)%plocal(m) - do n = m1,m2 + do n = 1, iv%info(ssmt1)%nlocal if(iv%info(ssmt1)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -373,10 +322,7 @@ do m= num_fgat_time , 1, -1 num_obs = 0 if (iv%info(ssmt2)%nlocal > 0) then -! do n = 1, iv%info(ssmt2)%nlocal - m1 = iv%info(ssmt2)%plocal(m-1) + 1 - m2 = iv%info(ssmt2)%plocal(m) - do n = m1,m2 + do n = 1, iv%info(ssmt2)%nlocal if(iv%info(ssmt2)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -396,10 +342,7 @@ do m= num_fgat_time , 1, -1 num_obs = 0 if (iv%info(qscat)%nlocal > 0) then -! do n = 1, iv%info(qscat)%nlocal - m1 = iv%info(qscat)%plocal(m-1) + 1 - m2 = iv%info(qscat)%plocal(m) - do n = m1,m2 + do n = 1, iv%info(qscat)%nlocal if(iv%info(qscat)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -420,10 +363,7 @@ do m= num_fgat_time , 1, -1 num_obs = 0 if (iv%info(profiler)%nlocal > 0) then -! do n = 1, iv%info(profiler)%nlocal - m1 = iv%info(profiler)%plocal(m-1) + 1 - m2 = iv%info(profiler)%plocal(m) - do n = m1,m2 + do n = 1, iv%info(profiler)%nlocal if(iv%info(profiler)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -444,10 +384,7 @@ do m= num_fgat_time , 1, -1 num_obs = 0 if (iv%info(buoy)%nlocal > 0) then -! do n = 1, iv%info(buoy)%nlocal - m1 = iv%info(buoy)%plocal(m-1) + 1 - m2 = iv%info(buoy)%plocal(m) - do n = m1,m2 + do n = 1, iv%info(buoy)%nlocal if(iv%info(buoy)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -468,10 +405,7 @@ do m= num_fgat_time , 1, -1 num_obs = 0 if (iv%info(bogus)%nlocal > 0) then -! do n = 1, iv%info(bogus)%nlocal - m1 = iv%info(bogus)%plocal(m-1) + 1 - m2 = iv%info(bogus)%plocal(m) - do n = m1,m2 + do n = 1, iv%info(bogus)%nlocal if(iv%info(bogus)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -491,10 +425,7 @@ do m= num_fgat_time , 1, -1 num_obs = 0 if (iv%info(tamdar)%nlocal > 0) then -! do n = 1, iv%info(tamdar)%nlocal - m1 = iv%info(tamdar)%plocal(m-1) + 1 - m2 = iv%info(tamdar)%plocal(m) - do n = m1,m2 + do n = 1, iv%info(tamdar)%nlocal if (iv%info(tamdar)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -513,10 +444,7 @@ do m= num_fgat_time , 1, -1 ! Now tamdar_sfc num_obs = 0 if (iv%info(tamdar_sfc)%nlocal > 0) then -! do n = 1, iv%info(tamdar_sfc)%nlocal - m1 = iv%info(tamdar_sfc)%plocal(m-1) + 1 - m2 = iv%info(tamdar_sfc)%plocal(m) - do n = m1,m2 + do n = 1, iv%info(tamdar_sfc)%nlocal if(iv%info(tamdar_sfc)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -535,10 +463,7 @@ do m= num_fgat_time , 1, -1 num_obs = 0 if (iv%info(airsr)%nlocal > 0) then -! do n = 1, iv%info(airsr)%nlocal - m1 = iv%info(airsr)%plocal(m-1) + 1 - m2 = iv%info(airsr)%plocal(m) - do n = m1,m2 + do n = 1, iv%info(airsr)%nlocal if(iv%info(airsr)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -558,10 +483,7 @@ do m= num_fgat_time , 1, -1 num_obs = 0 if (iv%info(gpsref)%nlocal > 0) then -! do n = 1, iv%info(gpsref)%nlocal - m1 = iv%info(gpsref)%plocal(m-1) + 1 - m2 = iv%info(gpsref)%plocal(m) - do n = m1,m2 + do n = 1, iv%info(gpsref)%nlocal if(iv%info(gpsref)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -600,10 +522,7 @@ do m= num_fgat_time , 1, -1 num_obs = 0 if (iv%info(rain)%nlocal > 0) then -! do n = 1, iv%info(rain)%nlocal - m1 = iv%info(rain)%plocal(m-1) + 1 - m2 = iv%info(rain)%plocal(m) - do n = m1,m2 + do n = 1, iv%info(rain)%nlocal if(iv%info(rain)%proc_domain(1,n)) num_obs = num_obs + 1 end do end if @@ -626,7 +545,6 @@ do m= num_fgat_time , 1, -1 deallocate (filename) end if -end do !wuyl n1,n2 if (trace_use) call da_trace_exit("da_final_write_obs") end subroutine da_final_write_obs diff --git a/var/da/da_radiance/da_get_innov_vector_crtm.inc b/var/da/da_radiance/da_get_innov_vector_crtm.inc index 403337a44a..5b288461f0 100644 --- a/var/da/da_radiance/da_get_innov_vector_crtm.inc +++ b/var/da/da_radiance/da_get_innov_vector_crtm.inc @@ -195,7 +195,6 @@ subroutine da_get_innov_vector_crtm ( it, grid, ob, iv ) else if ( n_vegtype == IGBP_n_type ) then wrf_to_crtm_mw = igbp_to_crtm_mw end if - !------------------------------------------------------ ! [1.0] calculate the background bright temperature !------------------------------------------------------- @@ -918,7 +917,6 @@ subroutine da_get_innov_vector_crtm ( it, grid, ob, iv ) endif end do ! end loop for sensor - deallocate (wrf_to_crtm_mw) call CRTM_Atmosphere_Destroy (Atmosphere) diff --git a/var/da/da_radiance/da_get_innov_vector_radiance.inc b/var/da/da_radiance/da_get_innov_vector_radiance.inc index 1fca458d04..18f3e8bd83 100644 --- a/var/da/da_radiance/da_get_innov_vector_radiance.inc +++ b/var/da/da_radiance/da_get_innov_vector_radiance.inc @@ -60,7 +60,6 @@ subroutine da_get_innov_vector_radiance (it,grid, ob, iv) end if end if - else if (biascorr) then do inst = 1, iv%num_inst ! loop for sensor write(unit=stdout,fmt='(A,A)') 'Performing bias correction for ', & diff --git a/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc b/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc index a5f11b1347..2040fcbe0f 100644 --- a/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc +++ b/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc @@ -23,72 +23,110 @@ subroutine da_read_iv_rad_for_multi_inc (it,ob, iv ) real, allocatable :: data3d(:,:,:) real, allocatable :: data2d_g(:,:) real, allocatable :: data3d_g(:,:,:) + integer, allocatable :: counts(:), displs(:) + integer :: nk,ndomain_local,num,ndomain_sum,proc + integer, allocatable :: ndomain_global(:) + + real, allocatable :: lat(:),lon(:) if (trace_use) call da_trace_entry("da_read_iv_rad_ascii") write(unit=message(1),fmt='(A)') 'Reading radiance OMB for multi_inc' call da_message(message(1:1)) +!no thinning for coarse res.(setup in namelist), keep all the obs: do i = 1, iv%num_inst - - nobs_tot = iv%instid(i)%info%ptotal(num_fgat_time) - iv%instid(i)%info%ptotal(0) + amsr2 = index(iv%instid(i)%rttovid_string,'amsr2') > 0 !jban 2020-08-22 + !print*, "amsr2=",amsr2 + + nobs_tot = iv%info(radiance)%ptotal(num_fgat_time) - iv%info(radiance)%ptotal(0) + !print*, "nobs_tot=",nobs_tot + !print*, "iv%instid(i)%num_rad=",iv%instid(i)%num_rad + !print*, "iv%instid(i)%info%plocal=", iv%instid(i)%info%plocal(0:num_fgat_time) + !print*, "iv%instid(i)%info%ptotal=", iv%instid(i)%info%ptotal(0:num_fgat_time) + !print*, "iv%info(radiance)%plocal=", iv%info(radiance)%plocal(0:num_fgat_time) + !print*, "iv%info(radiance)%ptotal=", iv%info(radiance)%ptotal(0:num_fgat_time) + do m=num_fgat_time,1,-1 - if ( nobs_tot > 0 ) then + + iv%instid(i)%info%n1 = iv%instid(i)%info%plocal(m-1) + 1 + iv%instid(i)%info%n2=iv%instid(i)%info%plocal(m) + ndomain_local = 0 +!print*, "before read: timeslot,n1,n2=",m,iv%instid(i)%info%n1,iv%instid(i)%info%n2 + do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 + if (iv%instid(i)%info%proc_domain(1,n)) then + ndomain_local = ndomain_local + 1 + iv%instid(i)%tb_qc(:,n) = -1 +!write(unit=stdout,fmt='(a,3i8,3(2x,f10.5))') 'bcheckforplot ',m,iv%instid(i)%tb_qc(6,n),n,iv%instid(i)%info%lat(1,n),iv%instid(i)%info%lon(1,n),iv%instid(i)%tb_inv(6,n) + end if + end do + + allocate (ndomain_global(0:num_procs-1)) + call mpi_allgather( ndomain_local, 1, mpi_integer, & + ndomain_global, 1, mpi_integer, comm, ierr ) + ndomain_sum = sum(ndomain_global) +!print*,"ndomain_global=",ndomain_global + + if ( ndomain_sum > 0 ) then write(unit=filename, fmt='(a,i3.3)') 'inv_'//trim(iv%instid(i)%rttovid_string)//'_',m call da_get_unit(innov_rad_unit_in) inquire (file=filename, exist=fexist) if (.not. fexist) then exit else - open(unit=innov_rad_unit_in,file=trim(filename),form='unformatted',status='old',iostat=ios) - if (ios /= 0 ) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open innovation radiance file"//filename/)) - Endif - write(unit=message(1),fmt='(A)') filename - call da_message(message(1:1)) - read(innov_rad_unit_in) nobs_in - if ( nobs_in /= nobs_tot ) then - call da_error(__FILE__,__LINE__, & - (/"Dimensions (nobs_tot) mismatch "/)) - end if - iv%instid(i)%info%n1 = iv%instid(i)%info%plocal(m-1) + 1 - iv%instid(i)%info%n2=iv%instid(i)%info%plocal(m) - ndomain = 0 + open(unit=innov_rad_unit_in,file=trim(filename),form='unformatted',status='old',iostat=ios) + if (ios /= 0 ) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open innovation radiance file"//filename/)) + endif + write(unit=message(1),fmt='(A)') filename + call da_message(message(1:1)) + read(innov_rad_unit_in) nobs_in + !print*, "nobs_in=",nobs_in + !print*, "ndomain_sum=",ndomain_sum + !always does not match, so comment it out + !if ( nobs_in /= ndomain_sum ) then + ! call da_error(__FILE__,__LINE__, & + ! (/"Dimensions (nobs_tot) mismatch "/)) + !end if + + ndomain = 0 - if ( amsr2 ) then - my=3 - else - my=2 - end if - allocate( data2d(nobs_tot, my) ) - read(innov_rad_unit_in) data2d - do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 -! iobs = iv%instid(i)%info%obs_global_index(n) - iobs = n - end do - deallocate ( data2d ) - -! read(unit=innov_rad_unit_in,fmt='(10i5)') iv%instid(i)%ichan - - allocate( data3d(nobs_tot, iv%instid(i)%nchan, 3) ) - read(innov_rad_unit_in) data3d - - do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 -! iobs = iv%instid(i)%info%obs_global_index(n) - iobs = n - iv%instid(i)%tb_inv(:,n) = data3d (iobs,:,1) - iv%instid(i)%tb_error(:,n) = data3d (iobs,:,2) - iv%instid(i)%tb_qc(:,n) = int(data3d (iobs,:,3)) - end do - deallocate( data3d ) - - close(unit=innov_rad_unit_in) - call da_free_unit(innov_rad_unit_in) - end if !fexist - end if ! nobs_tot - end do !num_fgat -end do ! end do instruments + if ( amsr2 ) then + my=3 + else + my=2 + end if + + allocate( data2d(nobs_in, my) ) + read(innov_rad_unit_in) data2d + + allocate( data3d(nobs_in, iv%instid(i)%nchan, 3) ) + read(innov_rad_unit_in) data3d + !print*,'iv%instid(i)%nchan=',iv%instid(i)%nchan + do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 + if (iv%instid(i)%info%proc_domain(1,n)) then + do iobs = 1, nobs_in + if (iv%instid(i)%info%lat(1,n)==data2d(iobs, 1) .and. iv%instid(i)%info%lon(1,n)==data2d(iobs, 2)) then +!write(unit=stdout,fmt='(a,4i8,4(2x,f10.5))') 'acheckforplot ',m,iv%instid(i)%tb_qc(6,n),n,iobs,iv%instid(i)%info%lat(1,n),iv%instid(i)%info%lon(1,n),iv%instid(i)%tb_inv(6,n),data3d (iobs,6,1) + iv%instid(i)%tb_inv(:,n) = data3d (iobs,:,1) + iv%instid(i)%tb_error(:,n) = data3d (iobs,:,2) + iv%instid(i)%tb_qc(:,n) = int(data3d (iobs,:,3)) + !print*, "matchiobs=",m,iobs + end if + end do !if + end if !do + end do + + deallocate(data2d) + deallocate(data3d) + + call da_free_unit(innov_rad_unit_in) + end if ! fexist + end if ! ndomain_sum + deallocate(ndomain_global) + end do !num_fgat + end do ! end do instruments if (trace_use) call da_trace_exit("da_read_iv_rad_ascii") diff --git a/var/da/da_radiance/da_write_iv_rad_for_multi_inc.inc b/var/da/da_radiance/da_write_iv_rad_for_multi_inc.inc index 008e49db3c..e4c4c758b3 100644 --- a/var/da/da_radiance/da_write_iv_rad_for_multi_inc.inc +++ b/var/da/da_radiance/da_write_iv_rad_for_multi_inc.inc @@ -11,128 +11,169 @@ subroutine da_write_iv_rad_for_multi_inc (it,ob, iv ) type (iv_type), intent(in) :: iv ! O-B structure. integer :: n ! Loop counter. - integer :: i, k, l, m, m1, m2,nobs_tot ! Index dimension. + integer :: i, loc_i,loc_j, k, l, m, m1, m2,nobs_tot ! Index dimension. integer :: nlevelss ! Number of obs levels. - integer :: my,iobs + integer :: my,iobs, nobs_tot_all_sum integer :: ios, innov_rad_unit character(len=filename_len) :: filename character(len=7) :: surftype - integer :: ndomain + integer :: nk,ndomain_local,num,ndomain_sum,proc logical :: amsr2 real, allocatable :: data2d(:,:) real, allocatable :: data3d(:,:,:) real, allocatable :: data2d_g(:,:) real, allocatable :: data3d_g(:,:,:) + real, allocatable :: tbinv_local(:),tbinv_global(:),stbinv_local(:) + real, allocatable :: tberror_local(:),tberror_global(:) + real, allocatable :: tbqc_local(:),tbqc_global(:) + + integer, allocatable :: nobs_tot_all(:) + integer, allocatable :: ndomain_global(:) + integer, allocatable :: i_global(:),i_local(:) + integer, allocatable :: j_global(:),j_local(:) + integer, allocatable :: counts(:), displs(:) + integer, allocatable :: obs_index(:,:) if (trace_use) call da_trace_entry("da_write_iv_rad_for_multi_inc") - write(unit=message(1),fmt='(A)') 'Writing radiance OMB ascii file for multi_inc' + write(unit=message(1),fmt='(A)') 'Writing radiance OMB binary files for multi_inc' call da_message(message(1:1)) do i = 1, iv%num_inst - if (iv%instid(i)%num_rad < 1) cycle - ! count number of obs within the loc%proc_domain - ! --------------------------------------------- - nobs_tot = iv%instid(i)%info%ptotal(num_fgat_time) - iv%instid(i)%info%ptotal(0) -! write(unit=message(1),fmt='(A)') 'calculate nobs_tot' - do m=num_fgat_time,1,-1 - if ( nobs_tot > 0 ) then - write(unit=message(1),fmt='(A)') 'begin to write' - if ( rootproc ) then - write(unit=filename, fmt='(a,i3.3)') 'inv_'//trim(iv%instid(i)%rttovid_string)//'_',m - open(unit=innov_rad_unit,file=trim(filename),form='unformatted',status='replace',iostat=ios) - if (ios /= 0 ) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open innovation radiance file"//filename/)) - Endif - write(unit=message(1),fmt='(A)') filename - call da_message(message(1:1)) - write(innov_rad_unit) nobs_tot - end if ! root open ounit - - iv%instid(i)%info%n1 = iv%instid(i)%info%plocal(m-1) + 1 - iv%instid(i)%info%n2=iv%instid(i)%info%plocal(m) - ndomain = 0 - - do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 - - if (iv%instid(i)%info%proc_domain(1,n)) then - ndomain = ndomain + 1 - end if - end do - if (ndomain < 1) cycle - + amsr2 = index(iv%instid(i)%rttovid_string,'amsr2') > 0 !jban 2020-08-22 if ( amsr2 ) then ! write out clw my=3 else my=2 end if - allocate( data2d(nobs_tot, my) ) - data2d = 0.0 - do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 - if (iv%instid(i)%info%proc_domain(1,n)) then -! iobs = iv%instid(i)%info%obs_global_index(n) - iobs = n - write(unit=message(1),fmt='(I4)') iobs - call da_message(message(1:1)) - if ( amsr2 ) then ! write out clw - data2d(iobs, 1) = iv%instid(i)%info%lat(1,n) - data2d(iobs, 2) = iv%instid(i)%info%lon(1,n) - data2d(iobs, 3) = iv%instid(i)%clw(n) - else ! no clw info - data2d(iobs, 1) = iv%instid(i)%info%lat(1,n) - data2d(iobs, 2) = iv%instid(i)%info%lon(1,n) + + !print*, "iv%instid(i)%num_rad=",iv%instid(i)%num_rad + !print*, "iv%instid(i)%info%plocal=", iv%instid(i)%info%plocal(0:num_fgat_time) + !print*, "iv%instid(i)%info%ptotal=", iv%instid(i)%info%ptotal(0:num_fgat_time) + !print*, "iv%info(radiance)%plocal=", iv%info(radiance)%plocal(0:num_fgat_time) + !print*, "iv%info(radiance)%ptotal=", iv%info(radiance)%ptotal(0:num_fgat_time) + + do m=num_fgat_time,1,-1 + + iv%instid(i)%info%n1 = iv%instid(i)%info%plocal(m-1) + 1 + iv%instid(i)%info%n2=iv%instid(i)%info%plocal(m) + ndomain_local = 0 + do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 + if (iv%instid(i)%info%proc_domain(1,n)) then + ndomain_local = ndomain_local + 1 end if - end if - end do !n1,n2 - - write(unit=message(1),fmt='(A)') 'begin to write data2d' - call da_message(message(1:1)) + end do + + allocate (ndomain_global(0:num_procs-1)) + call mpi_allgather( ndomain_local, 1, mpi_integer, & + ndomain_global, 1, mpi_integer, comm, ierr ) + ndomain_sum = sum(ndomain_global) + !print *,"ndomain_local=", ndomain_local + !print *,"ndomain_global=",ndomain_global + !print *,"ndomain_sum=",ndomain_sum - allocate( data2d_g(nobs_tot, my) ) + if ( ndomain_sum > 0 ) then + write(unit=message(1),fmt='(A)') 'begin to write' + call da_message(message(1:1)) + + if (rootproc) then + call da_get_unit(innov_rad_unit) !jban 2020-08-22 + !write(unit=message(1),fmt='(A)') 'rootproc, writing file name' + !call da_message(message(1:1)) + print*, "print rootproc, writing file name" + write(unit=filename, fmt='(a,i3.3)') 'inv_'//trim(iv%instid(i)%rttovid_string)//'_',m + + open(unit=innov_rad_unit,file=trim(filename),form='unformatted',status='replace',iostat=ios) + if (ios /= 0 ) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open innovation radiance file"//filename/)) + endif + write(innov_rad_unit) ndomain_sum ! ,iv%instid(i)%nchan !jban 2020-08-22 + end if ! root open ounit + !print*,"check before write timesl,n:" + allocate( data2d(ndomain_sum, my) ) + data2d = 0.0 + + if (myproc == 0) then + iobs = 0 + else + iobs = sum (ndomain_global (0:myproc-1)) + end if + !print *, "myproc,iobs=",myproc,iobs + + do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 + if (iv%instid(i)%info%proc_domain(1,n)) then + iobs = iobs+1 + if ( amsr2 ) then ! write out clw + data2d(iobs, 1) = iv%instid(i)%info%lat(1,n) + data2d(iobs, 2) = iv%instid(i)%info%lon(1,n) + data2d(iobs, 3) = iv%instid(i)%clw(n) + else ! no clw info + data2d(iobs, 1) = iv%instid(i)%info%lat(1,n) + data2d(iobs, 2) = iv%instid(i)%info%lon(1,n) +!write(unit=stdout,fmt='(a,4i8,3(2x,f10.5))') 'checkforplot ',m,iv%instid(i)%tb_qc(6,n),n,iobs,iv%instid(i)%info%lat(1,n),iv%instid(i)%info%lon(1,n),iv%instid(i)%tb_inv(6,n) + end if + end if + end do !n1,n2 + + write(unit=message(1),fmt='(A)') 'begin to write data2d' + call da_message(message(1:1)) + + allocate( data2d_g(ndomain_sum, my) ) #ifdef DM_PARALLEL - call mpi_reduce(data2d, data2d_g, nobs_tot*my, true_mpi_real, mpi_sum, root, comm, ierr) + call mpi_reduce(data2d, data2d_g, ndomain_sum*my, true_mpi_real, mpi_sum, root, comm, ierr) #else - data2d_g = data2d + data2d_g = data2d #endif - deallocate( data2d ) + deallocate( data2d ) + + if (rootproc) then + write(innov_rad_unit) data2d_g + end if + deallocate( data2d_g ) - if ( rootproc ) then - write(innov_rad_unit) data2d_g - end if - deallocate( data2d_g ) + if (myproc == 0) then + iobs = 0 + else + iobs = sum (ndomain_global (0:myproc-1)) + end if - allocate( data3d(nobs_tot, iv%instid(i)%nchan, 3) ) - data3d = 0.0 - do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 - if (iv%instid(i)%info%proc_domain(1,n)) then - ! iobs = iv%instid(i)%info%obs_global_index(n) - iobs = n - data3d(iobs,:, 1)=iv%instid(i)%tb_inv(:,n) - data3d(iobs,:, 2)=iv%instid(i)%tb_error(:,n) - data3d(iobs,:, 3)=iv%instid(i)%tb_qc(:,n) * 1.0 - end if - end do - allocate( data3d_g(nobs_tot, iv%instid(i)%nchan, 3) ) + allocate( data3d(ndomain_sum, iv%instid(i)%nchan, 3) ) + data3d = 0.0 + do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 + if (iv%instid(i)%info%proc_domain(1,n)) then + iobs = iobs + 1 + data3d(iobs,:, 1)=iv%instid(i)%tb_inv(:,n) + data3d(iobs,:, 2)=iv%instid(i)%tb_error(:,n) + data3d(iobs,:, 3)=iv%instid(i)%tb_qc(:,n) * 1.0 +!write(unit=stdout,fmt='(a,i8,2x,i8,2x,i8,2x,i8,2x,f10.5,2x,f10.5,2x,f10.5)') 'check3d ',m,n,iobs,iv%instid(i)%tb_qc(6,n),iv%instid(i)%tb_inv(6,n),data3d(iobs,6, 1),iv%instid(i)%info%lat(1,n) + end if + end do + allocate( data3d_g(ndomain_sum, iv%instid(i)%nchan, 3) ) #ifdef DM_PARALLEL - call mpi_reduce(data3d, data3d_g, nobs_tot*iv%instid(i)%nchan*3, true_mpi_real, mpi_sum, root, comm, ierr) + call mpi_reduce(data3d, data3d_g, ndomain_sum*iv%instid(i)%nchan*3, true_mpi_real, mpi_sum, root, comm, ierr) #else - data3d_g = data3d + data3d_g = data3d #endif - deallocate( data3d ) - if ( rootproc ) then - write(innov_rad_unit) data3d_g - end if - deallocate( data3d_g ) - - if ( rootproc ) then - close(unit=innov_rad_unit) - end if - call da_free_unit(innov_rad_unit) - end if ! nobs_tot > 0 - end do !num_fgat -end do ! end do instruments + deallocate( data3d ) + + write(unit=message(1),fmt='(A)') 'begin to write data3d_g' + call da_message(message(1:1)) + + if (rootproc) then + write(innov_rad_unit) data3d_g + end if + deallocate( data3d_g ) + + if (rootproc) then + close(unit=innov_rad_unit) + call da_free_unit(innov_rad_unit) !jban + end if + end if ! ndomain_sum > 0 + deallocate (ndomain_global) + end do !num_fgat + end do ! end do instruments if (trace_use) call da_trace_exit("da_write_iv_rad_for_multi_inc") From 45de79e53c1c1b5519bc52f64bb29465548b5373 Mon Sep 17 00:00:00 2001 From: liujake Date: Tue, 17 Nov 2020 23:01:46 -0700 Subject: [PATCH 48/91] On branch latest_develop_mri4dvar Changes to be committed: deleted: README.CWB_v39a deleted: var/da/da_obs_io/log deleted: var/da/da_radiance/da_qc_ahi.inc.bak deleted: var/da/da_radiance/da_qc_ahi_zou.inc deleted: var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc.ok deleted: var/da/da_radiance/da_read_obs_AHI.inc.1 deleted: var/da/da_radiance/da_read_obs_netcdf4ahi_zou.inc deleted: var/da/da_radiance/log --- README.CWB_v39a | 52 -- var/da/da_obs_io/log | 24 - var/da/da_radiance/da_qc_ahi.inc.bak | 233 ------- var/da/da_radiance/da_qc_ahi_zou.inc | 617 ------------------ .../da_read_iv_rad_for_multi_inc.inc.ok | 334 ---------- var/da/da_radiance/da_read_obs_AHI.inc.1 | 566 ---------------- .../da_read_obs_netcdf4ahi_zou.inc | 556 ---------------- var/da/da_radiance/log | 76 --- 8 files changed, 2458 deletions(-) delete mode 100644 README.CWB_v39a delete mode 100644 var/da/da_obs_io/log delete mode 100644 var/da/da_radiance/da_qc_ahi.inc.bak delete mode 100644 var/da/da_radiance/da_qc_ahi_zou.inc delete mode 100644 var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc.ok delete mode 100644 var/da/da_radiance/da_read_obs_AHI.inc.1 delete mode 100644 var/da/da_radiance/da_read_obs_netcdf4ahi_zou.inc delete mode 100644 var/da/da_radiance/log diff --git a/README.CWB_v39a b/README.CWB_v39a deleted file mode 100644 index 96f8a5d23b..0000000000 --- a/README.CWB_v39a +++ /dev/null @@ -1,52 +0,0 @@ -This CWB_v39a code is branched off from the offical V3.9 release (commit hash eee16e3) -with the following new features added. - -New features (only in the CWB branch): - 1. Divergence constraint capability. - 2. Large Scale Analysis Constraint capability. - 3. Radar neighborhood no-rain scheme (radar_non_precip_opt=2). - 4. Multi-Resolution-Incremental 4DVAR. - 5. Improved gen_be_ep2.f90 utility. - -Bug fixes and enhancement since Aug 11, 2017. - 1. Bug fix for radar Vr operator from Siou-Ying. - 2. Improvement for ZTD assimilation. - -Bug fixes and enhancement since May 30, 2017. These changes are applied -to both the main repository for V3.9.1 release and CWB_v39a branch. -(git cherry-pick -n db7841c 49ec556 3e3c4ce ee3fd4a c4eeff5 81ca2ff d21f0db c7405bb) - 1. Bug fix and clean-up for WRFDA pseudo ob capability - 2. Bug fix for ZTD with 4DVAR when there are ZTD obs in non-first time slots - 3. Fix incorrect calculation of an unused variable cv_size_domain_jb - 4. WRFDA registry.var fixes for packaging moist variables and for non-4DVAR. - This reduces non-4DVAR memory usage by ~35%. - 5. Add packaging in registry.var for WRFDA derived type variables - This reduces 3DVAR memory usage by another ~15-20%. - -Enhancement since May 24, 2017 - 1. Add a few more LSAC namelist variables. - -Bug fixes since May 1, 2017 (only in the CWB branch) - 1. Bug fix for divergence constraint - grid%vp needs to be zeroed out before calling da_transform_vtox_adj - due to the introduction of the new 4DEnsVar capability. - -Bug fixes since V3.9 (April 17, 2017) - 1. Bug fix for radar_non_precip_opt == 1. - radar_non_precip_rh_w and radar_non_precip_rh_i namelist settings - were incorrectly modified within a loop, causing them to eventually - go to zero. - -General WRFDA improvements in V3.9 that are relevant to CWB's applications. - 1. Implementation of WRFDA cloud control variables is improved. - (1) Namelist cloud_cv_options default is changed from 1 to 0 (no cloud cv). - (2) Namelist variable use_3dvar_phy is removed. - (3) Setting environment variable CLOUD_CV is no longer needed. - -- Make the allocations of cloud variables in the be (background error) - structure depend on cloud_cv_options. - (4) Separate the w (z-wind) control variable from the handling of - cloud control variables and add a new namelist use_cv_w for it. - 2. Dual-resolution hybrid code is fixed and cleaned up. - 3. Pseudo ob implementation for ref/tpw/ztd is fixed and improved. - - diff --git a/var/da/da_obs_io/log b/var/da/da_obs_io/log deleted file mode 100644 index 111c030661..0000000000 --- a/var/da/da_obs_io/log +++ /dev/null @@ -1,24 +0,0 @@ -da_read_iv_for_multi_inc_opt2.inc:760: iobs = iv%info(radar)%obs_global_index(n) -da_read_iv_for_multi_inc_opt2.inc:770: iobs = iv%info(radar)%obs_global_index(n) -da_read_iv_for_multi_inc_opt2.inc:784: iobs = iv%info(radar)%obs_global_index(n) -da_read_iv_for_multi_inc_opt2.inc:798: iobs = iv%info(radar)%obs_global_index(n) -da_read_iv_for_multi_inc_opt2.inc:818: iobs = iv%info(radar)%obs_global_index(n) -da_read_lsac_util.inc:346: iv%info(bogus)%obs_global_index(nlocal) = nlocal -da_read_obs_ascii.inc:788: iv%info(tamdar)%obs_global_index(ilocal(tamdar)) = ntotal(tamdar) -da_read_obs_ascii.inc:1099: iv%info(airep)%obs_global_index(ilocal(airep)) = ntotal(airep) -da_read_obs_ascii.inc:1447: iv%info(obs_index)%obs_global_index(nlocal(obs_index)) = ntotal(obs_index) -da_read_obs_ascii.inc:1472: iv%info(sonde_sfc)%obs_global_index(ilocal(sonde_sfc)) = ntotal(obs_index) -da_read_obs_ascii.inc:1498: iv%info(tamdar_sfc)%obs_global_index(ilocal(tamdar_sfc)) = ntotal(tamdar_sfc) -da_read_obs_bufrgpsro.inc:56: integer :: obs_global_index -da_read_obs_bufrgpsro.inc:331: plink%obs_global_index = ntotal -da_read_obs_bufrgpsro.inc:399: allocate (iv%info(gpsref)%obs_global_index(iv%info(gpsref)%nlocal)) -da_read_obs_bufrgpsro.inc:443: iv%info(gpsref)%obs_global_index(nlocal) = plink%obs_global_index -da_read_obs_bufr.inc:2160: iv%info(obs_index)%obs_global_index(ilocal(obs_index)) = iv%info(obs_index)%ntotal -da_read_obs_bufr.inc:2186: iv%info(sonde_sfc)%obs_global_index(ilocal(sonde_sfc)) =iv%info(sonde_sfc)%ntotal -da_read_obs_radar.inc:285: iv%info(radar)%obs_global_index(ilocal) = ntotal -da_read_obs_rain.inc:247: iv%info(rain)%obs_global_index(ilocal) = ntotal -da_write_iv_for_multi_inc_opt2.inc:764: iobs = iv%info(radar)%obs_global_index(n) -da_write_iv_for_multi_inc_opt2.inc:786: iobs = iv%info(radar)%obs_global_index(n) -da_write_iv_for_multi_inc_opt2.inc:811: iobs = iv%info(radar)%obs_global_index(n) -da_write_iv_for_multi_inc_opt2.inc:836: iobs = iv%info(radar)%obs_global_index(n) -da_write_iv_for_multi_inc_opt2.inc:867: iobs = iv%info(radar)%obs_global_index(n) diff --git a/var/da/da_radiance/da_qc_ahi.inc.bak b/var/da/da_radiance/da_qc_ahi.inc.bak deleted file mode 100644 index 9dbcedcb73..0000000000 --- a/var/da/da_radiance/da_qc_ahi.inc.bak +++ /dev/null @@ -1,233 +0,0 @@ -subroutine da_qc_ahi (it, i, nchan, ob, iv) - - !--------------------------------------------------------------------------- - ! Purpose: perform quality control for ahi data. - ! To be developed: built in cloud_detection method - !--------------------------------------------------------------------------- - - implicit none - - integer, intent(in) :: it ! outer loop count - integer, intent(in) :: i ! sensor index. - integer, intent(in) :: nchan ! number of channel - type (y_type), intent(in) :: ob ! Observation structure. - type (iv_type), intent(inout) :: iv ! O-B structure. - - ! local variables - logical :: lmix, cloud_detection - integer :: n,k,isflg,ios,fgat_rad_unit - integer :: ngood(nchan),nrej(nchan),nrej_omb_abs(nchan), & - nrej_omb_std(nchan),nrej_eccloud(nchan), & - nrej_clw(nchan),num_proc_domain, & - nrej_mixsurface,nrej_land - - real :: inv_grosscheck - - character(len=30) :: filename - real :: c37_mean - - if (trace_use) call da_trace_entry("da_qc_ahi") - - ngood(:) = 0 - nrej(:) = 0 - nrej_omb_abs(:) = 0 - nrej_omb_std(:) = 0 - nrej_eccloud(:) = 0 - nrej_clw(:) = 0 - nrej_mixsurface = 0 - nrej_land = 0 - num_proc_domain = 0 - - - do n= iv%instid(i)%info%n1,iv%instid(i)%info%n2 - if (iv%instid(i)%info%proc_domain(1,n)) & - num_proc_domain = num_proc_domain + 1 - - if ( crtm_cloud ) then - ! calculate c37_mean - c37_mean = 1.0-(ob%instid(i)%tb(11,n)-ob%instid(i)%tb(12,n)+ & - iv%instid(i)%tb_xb(11,n)-iv%instid(i)%tb_xb(12,n))/ & - (2.0*(iv%instid(i)%tb_xb_clr(11,n)-iv%instid(i)%tb_xb_clr(12,n))) - end if - - ! 0.0 initialise QC by flags assuming good obs - !----------------------------------------------------------------- - iv%instid(i)%tb_qc(:,n) = qc_good - - ! 1.0 reject all channels over mixture surface type - !------------------------------------------------------ - isflg = iv%instid(i)%isflg(n) - lmix = (isflg==4) .or. (isflg==5) .or. (isflg==6) .or. (isflg==7) - if (lmix) then - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_mixsurface = nrej_mixsurface + 1 - end if - - if ( isflg > 0 ) then - do k = 1, nchan - if ( k /= 2 .and. k /= 3 .and. k /= 4 ) then - if (only_sea_rad) then - iv%instid(i)%tb_qc(k,n) = qc_bad - nrej_land = nrej_land + 1 - end if - end if - end do - end if - - ! 3.0 check iuse - !----------------------------------------------------------------- - do k = 1, nchan - if (satinfo(i)%iuse(k) .eq. -1) & - iv%instid(i)%tb_qc(k,n) = qc_bad - end do - - ! 4.0 check cloud - !----------------------------------------------------------------- - if (.not. crtm_cloud ) then - - do k = 1, nchan - - if (iv%instid(i)%clwp(n) >= 0.2) then - iv%instid(i)%tb_qc(k,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_clw(k) = nrej_clw(k) + 1 - end if - - cloud_detection=.false. - if (cloud_detection) then - if (iv%instid(i)%landsea_mask(n) == 0 ) then - if (iv%instid(i)%tb_xb(3,n)-ob%instid(i)%tb(3,n)>3.5) then - iv%instid(i)%tb_qc(k,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_eccloud(k) = nrej_eccloud(k) + 1 - end if - else - if (iv%instid(i)%tb_xb(3,n)-ob%instid(i)%tb(3,n)>2.5) then - iv%instid(i)%tb_qc(k,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_eccloud(k) = nrej_eccloud(k) + 1 - end if - end if - else - if (iv%instid(i)%cloudflag(n) < 3) then ! only use abs clear pixel - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_eccloud(k) = nrej_eccloud(k) + 1 - end if - end if - - end do - end if - - ! assigning obs errors - if (.not. crtm_cloud ) then - do k = 1, nchan - if (use_error_factor_rad) then - iv%instid(i)%tb_error(k,n) = & - satinfo(i)%error_std(k)*satinfo(i)%error_factor(k) - else - iv%instid(i)%tb_error(k,n) = satinfo(i)%error_std(k) - end if - end do ! nchan - - else !crtm_cloud - ! symmetric error model, Geer and Bauer (2011) - do k = 1, nchan - if (c37_mean.lt.0.05) then - iv%instid(i)%tb_error(k,n)= satinfo(i)%error_std(k) - else if (c37_mean.ge.0.05.and.c37_mean.lt.0.5) then - iv%instid(i)%tb_error(k,n)= satinfo(i)%error_std(k)+ & - (c37_mean-0.05)*(satinfo(i)%error_cld(k)-satinfo(i)%error_std(k))/(0.5-0.05) - else - iv%instid(i)%tb_error(k,n)= satinfo(i)%error_cld(k) - end if - end do ! nchan - - end if - - ! 5.0 check innovation - !----------------------------------------------------------------- - if (.not. crtm_cloud ) then - ! absolute departure check - do k = 1, nchan - inv_grosscheck = 15.0 - if (use_satcv(2)) inv_grosscheck = 100.0 - if (abs(iv%instid(i)%tb_inv(k,n)) > inv_grosscheck) then - iv%instid(i)%tb_qc(k,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_omb_abs(k) = nrej_omb_abs(k) + 1 - end if - end do ! nchan - end if - - do k = 1, nchan - ! relative departure check - if (abs(iv%instid(i)%tb_inv(k,n)) > 3.0*iv%instid(i)%tb_error(k,n)) then - iv%instid(i)%tb_qc(k,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_omb_std(k) = nrej_omb_std(k) + 1 - end if - - - ! final QC decsion - if (iv%instid(i)%tb_qc(k,n) == qc_bad) then - iv%instid(i)%tb_error(k,n) = 500.0 - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej(k) = nrej(k) + 1 - else - if (iv%instid(i)%info%proc_domain(1,n)) & - ngood(k) = ngood(k) + 1 - end if - end do ! nchan - - end do ! end loop pixel - - ! Do inter-processor communication to gather statistics. - call da_proc_sum_int (num_proc_domain) - call da_proc_sum_int (nrej_mixsurface) - call da_proc_sum_int (nrej_land) - call da_proc_sum_ints (nrej_eccloud) - call da_proc_sum_ints (nrej_omb_abs) - call da_proc_sum_ints (nrej_omb_std) - call da_proc_sum_ints (nrej_clw) - call da_proc_sum_ints (nrej) - call da_proc_sum_ints (ngood) - - if (rootproc) then - if (num_fgat_time > 1) then - write(filename,'(i2.2,a,i2.2)') it,'_qcstat_'//trim(iv%instid(i)%rttovid_string)//'_',iv%time - else - write(filename,'(i2.2,a)') it,'_qcstat_'//trim(iv%instid(i)%rttovid_string) - end if - - call da_get_unit(fgat_rad_unit) - open(fgat_rad_unit,file=trim(filename),form='formatted',iostat=ios) - if (ios /= 0) then - write(unit=message(1),fmt='(A,A)') 'error opening the output file ', filename - call da_error(__FILE__,__LINE__,message(1:1)) - end if - - write(fgat_rad_unit, fmt='(/a/)') ' Quality Control Statistics for '//iv%instid(i)%rttovid_string - if(num_proc_domain > 0) write(fgat_rad_unit,'(a20,i7)') ' num_proc_domain = ', num_proc_domain - write(fgat_rad_unit,'(a20,i7)') ' nrej_mixsurface = ', nrej_mixsurface - write(fgat_rad_unit,'(a20,i7)') ' nrej_land = ', nrej_land - write(fgat_rad_unit,'(a20)') ' nrej_eccloud(:) = ' - write(fgat_rad_unit,'(10i7)') nrej_eccloud(:) - write(fgat_rad_unit,'(a20)') ' nrej_clw(:) = ' - write(fgat_rad_unit,'(10i7)') nrej_clw(:) - write(fgat_rad_unit,'(a20)') ' nrej_omb_abs(:) = ' - write(fgat_rad_unit,'(10i7)') nrej_omb_abs(:) - write(fgat_rad_unit,'(a20)') ' nrej_omb_std(:) = ' - write(fgat_rad_unit,'(10i7)') nrej_omb_std(:) - write(fgat_rad_unit,'(a20)') ' nrej(:) = ' - write(fgat_rad_unit,'(10i7)') nrej(:) - write(fgat_rad_unit,'(a20)') ' ngood(:) = ' - write(fgat_rad_unit,'(10i7)') ngood(:) - - close(fgat_rad_unit) - call da_free_unit(fgat_rad_unit) - end if - if (trace_use) call da_trace_exit("da_qc_ahi") - -end subroutine da_qc_ahi diff --git a/var/da/da_radiance/da_qc_ahi_zou.inc b/var/da/da_radiance/da_qc_ahi_zou.inc deleted file mode 100644 index 45fe7f5634..0000000000 --- a/var/da/da_radiance/da_qc_ahi_zou.inc +++ /dev/null @@ -1,617 +0,0 @@ -subroutine da_qc_ahi (it, i, nchan, ob, iv) - - !--------------------------------------------------------------------------- - ! Purpose: perform quality control for ahi data. - ! To be developed: built in cloud_detection method - !--------------------------------------------------------------------------- - - implicit none - - integer, intent(in) :: it ! outer loop count - integer, intent(in) :: i ! sensor index. - integer, intent(in) :: nchan ! number of channel - type (y_type), intent(in) :: ob ! Observation structure. - type (iv_type), intent(inout) :: iv ! O-B structure. - - ! local variables - logical :: lmix, cloud_detection - integer :: n,k,isflg,ios,fgat_rad_unit - integer :: ngood(nchan),nrej(nchan),nrej_omb_abs(nchan), & - nrej_omb_std(nchan),nrej_eccloud(nchan), & - nrej_clw(nchan),num_proc_domain, & - nrej_mixsurface,nrej_land - -! additional variables using by Zhuge and Zou(2017) - integer :: nrej_etrop(nchan), nrej_pfmft(nchan),nrej_nfmft(nchan) - integer :: nrej_emiss4(nchan),nrej_ulst(nchan), nrej_emiss(nchan) - integer :: nrej_notc(nchan) -! ------- - real :: inv_grosscheck - - character(len=30) :: filename - real :: c37_mean -! additional variables using by Zhuge and Zou(2017) - real :: etrop, pfmft, nfmft, emiss4, ulst, e_emiss, notc - real :: rad_O14, rad_M14, rad_tropt - real :: rad_o_ch7, rad_b_ch7, rad_o_ch14, rad_b_ch14 - real :: Relaz, Glintzen, tb_temp1 - real :: wave_num(10) - real :: a1(10), a2(10) - real, parameter :: PI = 3.1415926535897 - real, parameter :: DTOR = PI/180. - real(8), parameter :: C1=1.19104276e-5 ! mWm-2sr-1(cm-1)-4 - real(8), parameter :: C2=1.43877516 ! 1.43877 K(cm-1)-1 - wave_num(1:10) = (/2575.767,1609.241,1442.079,1361.387,1164.443, & - 1038.108, 961.333, 890.741, 809.242, 753.369/) - a1(1:10) = (/0.4646738, 1.646845, 0.3081354,0.05736947,0.1351275, & - 0.09363042, 0.08965492, 0.1800931, 0.2439072, 0.06235635/) - a2(1:10) = (/0.9993416, 0.9964012, 0.9992591, 0.9998543, 0.9996156, & - 0.9997033, 0.9997001, 0.9993562, 0.9990461, 0.9997371/) - - if (trace_use) call da_trace_entry("da_qc_ahi") - - ngood(:) = 0 - nrej(:) = 0 - nrej_omb_abs(:) = 0 - nrej_omb_std(:) = 0 - nrej_eccloud(:) = 0 - nrej_clw(:) = 0 - nrej_mixsurface = 0 - nrej_land = 0 - num_proc_domain = 0 - - - do n= iv%instid(i)%info%n1,iv%instid(i)%info%n2 - if (iv%instid(i)%info%proc_domain(1,n)) & - num_proc_domain = num_proc_domain + 1 - - if ( crtm_cloud ) then - ! calculate c37_mean - c37_mean = 1.0-(ob%instid(i)%tb(11,n)-ob%instid(i)%tb(12,n)+ & - iv%instid(i)%tb_xb(11,n)-iv%instid(i)%tb_xb(12,n))/ & - (2.0*(iv%instid(i)%tb_xb_clr(11,n)-iv%instid(i)%tb_xb_clr(12,n))) - end if - - ! 0.0 initialise QC by flags assuming good obs - !----------------------------------------------------------------- - iv%instid(i)%tb_qc(:,n) = qc_good - - ! 1.0 reject all channels over mixture surface type - !------------------------------------------------------ - isflg = iv%instid(i)%isflg(n) - lmix = (isflg==4) .or. (isflg==5) .or. (isflg==6) .or. (isflg==7) - if (lmix) then - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_mixsurface = nrej_mixsurface + 1 - end if - - if ( isflg > 0 ) then - do k = 1, nchan -!wuyl if ( k /= 2 .and. k /= 3 .and. k /= 4 ) then - if (only_sea_rad) then - iv%instid(i)%tb_qc(k,n) = qc_bad - nrej_land = nrej_land + 1 - end if -!wuyl end if - end do - end if - - ! 2.0 check iuse - !----------------------------------------------------------------- - do k = 1, nchan - if (satinfo(i)%iuse(k) .eq. -1) & - iv%instid(i)%tb_qc(k,n) = qc_bad - end do - - ! 3.0 check cloud - !----------------------------------------------------------------- - if (.not. crtm_cloud ) then - - do k = 1, nchan - - if (iv%instid(i)%clwp(n) >= 0.2) then - iv%instid(i)%tb_qc(k,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_clw(k) = nrej_clw(k) + 1 - end if - - cloud_detection=.false. - if (cloud_detection) then - if (iv%instid(i)%landsea_mask(n) == 0 ) then - if (iv%instid(i)%tb_xb(3,n)-ob%instid(i)%tb(3,n)>3.5) then - iv%instid(i)%tb_qc(k,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_eccloud(k) = nrej_eccloud(k) + 1 - end if - else - if (iv%instid(i)%tb_xb(3,n)-ob%instid(i)%tb(3,n)>2.5) then - iv%instid(i)%tb_qc(k,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_eccloud(k) = nrej_eccloud(k) + 1 - end if - end if - else - if (iv%instid(i)%cloudflag(n) <= 0) then ! only use abs clear pixel, read clm by Zhuge and Zou(2017) - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_eccloud(k) = nrej_eccloud(k) + 1 - end if - end if - - end do - end if - - ! 4.0 check Zhuge X. and Zou X. JAMC, 2016. [ABI CM test] - !----------------------------------------------------------------- - ! 4.1 Cloud check: step 1 - ! Emissivity at Tropopause Test (ETROP) - ! (Zhuge and Zou, 2016, JAMC) for AGRI Chan12(10.8um) - ! Q: need tropopause temprature - ! select iv%instid(i)%isflg(n) - ! SEA(0),ICE(1),LAND(2),SNOW(3),MSEA(4),MICE(5),MLND(6),MSNO(7) - if ( iv%instid(i)%tb_xb(8,n) /=-999. .and. & - iv%instid(i)%tropt(n) /= -999. ) then - tb_temp1 = ob%instid(i)%tb(5,n) - rad_O14 = C1*wave_num(8)**3/( exp( C2*wave_num(8)/(a1(8)+a2(8)*tb_temp1 ) ) -1 ) - tb_temp1 = iv%instid(i)%tb_xb(5,n) - rad_M14 = C1*wave_num(8)**3/( exp( C2*wave_num(8)/(a1(8)+a2(8)*tb_temp1) ) -1 ) - tb_temp1 = iv%instid(i)%tropt(n) - rad_tropt = C1*wave_num(8)**3/( exp( C2*wave_num(8)/(a1(8)+a2(8)*tb_temp1) ) -1 ) - etrop = (rad_O14-rad_M14)/(rad_tropt-rad_M14) - else - etrop = -999. - end if -! write(*,"(a8,f12.8,a8,i4,2f8.2)") "etrop", etrop, "isflg", & -! isflg, iv%instid(i)%info%lat(1,n),iv%instid(i)%info%lon(1,n) - ! isflag: SEA(0),ICE(1),LAND(2),SNOW(3),MSEA(4),MICE(5),MLND(6),MSNO(7) - if ( isflg==0 .and. etrop > 0.1 ) then ! Ocean - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_etrop(:) = nrej_etrop(:) + 1 - end if - if ( isflg==2 .and. etrop > 0.3 ) then ! land - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_etrop(:) = nrej_etrop(:) + 1 - end if - if ( isflg==3 .and. etrop > 0.4 ) then ! snow - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_etrop(:) = nrej_etrop(:) + 1 - end if - if ( isflg==1 .and. etrop > 0.4 ) then ! ice equa snow - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_etrop(:) = nrej_etrop(:) + 1 - end if - ! 4.2 Cloud check: step 2 - ! Positive Fourteen Minus Fifteen Test - ! (Zhuge and Zou, 2016, JAMC) for AGRI Chan12(10.8um) and Chan13(12.0um) - ! e_pfmft = 0.8(Ocean), 2.5(land), 1.0(snow) - ! isflag: sea(1), ice(2), land(3), snow(4), msea(5), mice(6), mland(7), msnow(8) - if ( (iv%instid(i)%tb_inv(8,n)+iv%instid(i)%tb_xb(8,n)) >270. .and. & - iv%instid(i)%tb_xb(8,n) >270.) then - if (ob%instid(i)%tb(8,n) /= -999. .and. ob%instid(i)%tb(9,n) /= -999.) then -! using ob with VarBC -! pfmft = (iv%instid(i)%tb_inv(5,n)+iv%instid(i)%tb_xb(5,n) - & -! iv%instid(i)%tb_inv(6,n)+iv%instid(i)%tb_xb(6,n)) - & -! (iv%instid(i)%tb_xb(5,n)-iv%instid(i)%tb_xb(6,n))* & -! (iv%instid(i)%tb_inv(5,n)+iv%instid(i)%tb_xb(5,n)-260.)/ & -! (iv%instid(i)%tb_xb(5,n)-260.) -! using ob without VarBC - pfmft = (ob%instid(i)%tb(8,n)-ob%instid(i)%tb(9,n)) - & - (iv%instid(i)%tb_xb(8,n)-iv%instid(i)%tb_xb(9,n))* & - (ob%instid(i)%tb(8,n)-260.)/ & - (iv%instid(i)%tb_xb(8,n)-260.) - else - pfmft = -999.0 - end if -! write(*,"(a8,f12.8,a8,i4,3f8.2)") "pfmft", pfmft, "isflg", & -! isflg, iv%instid(i)%info%lat(1,n),iv%instid(i)%info%lon(1,n),iv%instid(i)%tb_xb(5,n) - ! SEA(0),ICE(1),LAND(2),SNOW(3),MSEA(4),MICE(5),MLND(6),MSNO(7) - if ( isflg==0 .and. pfmft > 0.8 ) then ! Ocean - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_pfmft(:) = nrej_pfmft(:) + 1 - end if - if ( isflg==2 .and. pfmft > 2.5 ) then ! land - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_pfmft(:) = nrej_pfmft(:) + 1 - end if - if ( isflg==3 .and. pfmft > 1.0 ) then ! snow - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_pfmft(:) = nrej_pfmft(:) + 1 - end if - if ( isflg==1 .and. pfmft > 1.0 ) then ! ice equa snow - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_pfmft(:) = nrej_pfmft(:) + 1 - end if - end if - - if ( (iv%instid(i)%tb_inv(8,n)+iv%instid(i)%tb_xb(8,n)) < 270. .and. & - iv%instid(i)%tb_xb(8,n) < 270.) then - if (ob%instid(i)%tb(8,n) /= 0. .and. ob%instid(i)%tb(9,n) /= 0.) then -! ------------------------------- -! using ob with VarBC -! pfmft = (iv%instid(i)%tb_inv(5,n)+iv%instid(i)%tb_xb(5,n) - & -! (iv%instid(i)%tb_inv(6,n)+iv%instid(i)%tb_xb(6,n)) ) -! using ob without VarBC - pfmft = ( ob%instid(i)%tb(8,n) - & - ob%instid(i)%tb(9,n) ) -! ------------------------------- - else - pfmft = -999. - end if -! write(*,"(a8,f12.8,a8,i4,2f8.2)") "pfmft", pfmft, "isflg", & -! isflg, iv%instid(i)%info%lat(1,n),iv%instid(i)%info%lon(1,n),iv%instid(i)%tb_xb(5,n) - ! SEA(0),ICE(1),LAND(2),SNOW(3),MSEA(4),MICE(5),MLND(6),MSNO(7) - if ( isflg==0 .and. pfmft > 0.8 ) then ! Ocean - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_pfmft(:) = nrej_pfmft(:) + 1 - end if - if ( isflg==2 .and. pfmft > 2.5 ) then ! land - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_pfmft(:) = nrej_pfmft(:) + 1 - end if - if ( isflg==3 .and. pfmft > 1.0 ) then ! snow - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_pfmft(:) = nrej_pfmft(:) + 1 - end if - if ( isflg==1 .and. pfmft > 1.0 ) then ! ice equa snow - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_pfmft(:) = nrej_pfmft(:) + 1 - end if - end if - - ! 4.3 Negative Fourteen Minus Fifteen Test - ! (Zhuge and Zou, 2016, JAMC) for AGRI Chan12(10.8um) and Chan13(12.0um) - ! e_nfmft = 1.0(Ocean), 2.0(land), 5.0(snow) - ! isflag: SEA(0),ICE(1),LAND(2),SNOW(3),MSEA(4),MICE(5),MLND(6),MSNO(7) - if (ob%instid(i)%tb(8,n) /= -999. .and. ob%instid(i)%tb(9,n) /= -999.) then - nfmft=iv%instid(i)%tb_inv(9,n)-iv%instid(i)%tb_inv(8,n) - else - nfmft=-999.0 - end if - ! write(*,"(a8,f12.8,a8,i4,2f8.2)") "nfmft", nfmft, "isflg", & - ! isflg, iv%instid(i)%info%lat(1,n),iv%instid(i)%info%lon(1,n) - - if ( isflg==0 .and. nfmft > 1.0 ) then ! Ocean - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_nfmft(:) = nrej_nfmft(:) + 1 - end if - if ( isflg==2 .and. nfmft > 2.0 ) then ! land - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_nfmft(:) = nrej_nfmft(:) + 1 - end if - if ( isflg==3 .and. nfmft > 5.0 ) then ! snow - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_nfmft(:) = nrej_nfmft(:) + 1 - end if - if ( isflg==1 .and. nfmft > 5.0 ) then ! ice equa snow - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_nfmft(:) = nrej_nfmft(:) + 1 - end if - - ! 4.4 4um Emissivity Test - ! (Zhuge and Zou, 2016, JAMC) for AGRI Chan8(3.725um) and Chan12(10.8um) - ! e_emiss4 = 0.1(Ocean), 0.2(land), 0.3(snow) for daytime, 2.86(Ocean) for dark - ! isflag: SEA(0),ICE(1),LAND(2),SNOW(3),MSEA(4),MICE(5),MLND(6),MSNO(7) - ! glinting - if (ob%instid(i)%tb(1,n) /= -999. .and. ob%instid(i)%tb(8,n) /= -999.) then -! using ob with VarBC -! rad_o_ch8 = TB2R(waveNum(1),iv%instid(i)%tb_inv(1,n)+iv%instid(i)%tb_xb(1,n)) -! rad_b_ch8 = TB2R(waveNum(1),iv%instid(i)%tb_xb(1,n)) -! rad_o_ch12 = TB2R(waveNum(1),iv%instid(i)%tb_inv(5,n)+iv%instid(i)%tb_xb(5,n)) -! rad_b_ch12 = TB2R(waveNum(1),iv%instid(i)%tb_xb(5,n)) -! using ob without VarBC -! rad_o_ch8 = C1*WaveNum(1)**3/( exp(C2*WaveNum(1)/ob%instid(i)%tb(1,n) ) -1 ) -! rad_b_ch8 = C1*WaveNum(1)**3/( exp(C2*WaveNum(1)/iv%instid(i)%tb_xb(1,n) ) -1 ) -! rad_o_ch12 = C1*WaveNum(1)**3/( exp(C2*WaveNum(1)/ob%instid(i)%tb(5,n) ) -1 ) -! rad_b_ch12 = C1*WaveNum(1)**3/( exp(C2*WaveNum(1)/iv%instid(i)%tb_xb(5,n) ) -1 ) -! search by lookup table - - tb_temp1 = ob%instid(i)%tb(1,n) - rad_o_ch7 = C1*wave_num(1)**3/( exp( C2*wave_num(1)/(a1(1)+a2(1)*tb_temp1 ) ) -1 ) - tb_temp1 = iv%instid(i)%tb_xb(1,n) - rad_b_ch7 = C1*wave_num(1)**3/( exp( C2*wave_num(1)/(a1(1)+a2(1)*tb_temp1 ) ) -1 ) - tb_temp1 = ob%instid(i)%tb(8,n) - rad_o_ch14 = C1*wave_num(1)**3/( exp( C2*wave_num(1)/(a1(1)+a2(1)*tb_temp1 ) ) -1 ) - tb_temp1 = iv%instid(i)%tb_xb(8,n) - rad_b_ch14 = C1*wave_num(1)**3/( exp( C2*wave_num(1)/(a1(1)+a2(1)*tb_temp1 ) ) -1 ) -! --------------------------------------- - emiss4 = (rad_o_ch7/rad_o_ch14 - rad_b_ch7/rad_b_ch14)/ & - rad_b_ch7/rad_b_ch14 - else - emiss4 = -999.0 - end if -! write(*,"(a8,f12.8,a8,i4,2f8.2)") "emiss4", emiss4, "isflg", & -! isflg, iv%instid(i)%info%lat(1,n),iv%instid(i)%info%lon(1,n) - if ( isflg==0 .and. emiss4 > 0.1 ) then ! Ocean - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_emiss4(:) = nrej_emiss4(:) + 1 - end if - if ( isflg==2 .and. emiss4 > 0.2 ) then ! land - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_emiss4(:) = nrej_emiss4(:) + 1 - end if - if ( isflg==3 .and. emiss4 > 0.3 ) then ! snow - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_emiss4(:) = nrej_emiss4(:) + 1 - end if - if ( isflg==1 .and. emiss4 > 0.3 ) then ! ice equa snow - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_emiss4(:) = nrej_emiss4(:) + 1 - end if - - ! Modify EMISS for sun glint area may be not work, because we are at north land - ! - compute relative azimuth - Relaz = RELATIVE_AZIMUTH(iv%instid(i)%solazi(n),iv%instid(i)%satazi(n)) - ! - compute glint angle - Glintzen = GLINT_ANGLE(iv%instid(i)%solzen(n),iv%instid(i)%satzen(n),Relaz ) - if ( Glintzen < 40.0 .and. isflg==0 .and. iv%instid(i)%tb_inv(1,n) < -2.86 ) then - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_emiss4(:) = nrej_emiss4(:) + 1 - end if - - ! 4.5 Uniform low staratus Test - ! (Zhuge and Zou, 2016, JAMC) for AGRI Chan8(3.725um) and Chan12(10.8um) - ! e_ulst = 0.05(Ocean), 0.1(land), 0.12(snow) for dark, no day time test - ! isflag: SEA(0),ICE(1),LAND(2),SNOW(3),MSEA(4),MICE(5),MLND(6),MSNO(7) - if (ob%instid(i)%tb(1,n) /= -999. .and. ob%instid(i)%tb(5,n) /= -999.) then - ulst = rad_b_ch7/rad_b_ch14 - rad_o_ch7/rad_o_ch14 - else - ulst = -999. - end if -! write(*,"(a8,f12.8,a8,i4,2f8.2)") "ulst", ulst, "isflg", & -! isflg, iv%instid(i)%info%lat(1,n),iv%instid(i)%info%lon(1,n) - if ( iv%instid(i)%solazi(n) >= 85.0 ) then ! night Time - if ( isflg==0 .and. ulst > 0.05 ) then ! Ocean - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_ulst(:) = nrej_ulst(:) + 1 - end if - if ( isflg==2 .and. ulst > 0.1 ) then ! land - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_ulst(:) = nrej_ulst(:) + 1 - end if - if ( isflg==3 .and. ulst > 0.12 ) then ! snow - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_ulst(:) = nrej_ulst(:) + 1 - end if - if ( isflg==1 .and. ulst > 0.12 ) then ! ice equa snow - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_ulst(:) = nrej_ulst(:) + 1 - end if - end if - - ! 4.6 N-OTC Test - ! (Zhuge and Zou, 2016, JAMC) for AGRI Chan8(3.725um) - ! e_ulst = 0.26-3*1.04(Ocean), 0.1(land), 0.12(snow) for dark, no day time test - ! isflag: SEA(0),ICE(1),LAND(2),SNOW(3),MSEA(4),MICE(5),MLND(6),MSNO(7) - if (ob%instid(i)%tb(1,n) /= -999. .and. ob%instid(i)%tb(9,n) /= -999.) then -! using ob with VarBC -! notc = iv%instid(i)%tb_inv(1,n)+iv%instid(i)%tb_xb(1,n) - & -! (iv%instid(i)%tb_inv(6,n)+iv%instid(i)%tb_xb(6,n)) -! using ob without VarBC - notc = ob%instid(i)%tb(1,n) - ob%instid(i)%tb(9,n) - else - notc = -999.0 - end if - ! write(*,"(a8,f12.8,a8,i4,2f8.2)") "notc", notc, "isflg", & - ! isflg, iv%instid(i)%info%lat(1,n),iv%instid(i)%info%lon(1,n) - if ( iv%instid(i)%solazi(n) < 85.0 ) then ! day Time - if ( isflg==0 .and. notc > 15. ) then ! Ocean - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_notc(:) = nrej_notc(:) + 1 - end if - if ( isflg==2 .and. notc > 21. ) then ! land - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_notc(:) = nrej_notc(:) + 1 - end if - if ( isflg==3 .and. notc > 10. ) then ! snow - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_notc(:) = nrej_notc(:) + 1 - end if - if ( isflg==1 .and. notc > 10. ) then ! ice equa snow - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_notc(:) = nrej_notc(:) + 1 - end if - else - if ( isflg==0 .and. notc > 11. ) then ! Ocean - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_notc(:) = nrej_notc(:) + 1 - end if - if ( isflg==2 .and. notc > 15. ) then ! land - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_notc(:) = nrej_notc(:) + 1 - end if - if ( isflg==3 .and. notc > 4.5 ) then ! snow - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_notc(:) = nrej_notc(:) + 1 - end if - if ( isflg==1 .and. notc > 4.5 ) then ! ice equa snow - iv%instid(i)%tb_qc(:,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_notc(:) = nrej_notc(:) + 1 - end if - end if - - ! --------------------------- - ! 5.0 assigning obs errors - if (.not. crtm_cloud ) then - do k = 1, nchan - if (use_error_factor_rad) then - iv%instid(i)%tb_error(k,n) = & - satinfo(i)%error_std(k)*satinfo(i)%error_factor(k) - else - iv%instid(i)%tb_error(k,n) = satinfo(i)%error_std(k) - end if - end do ! nchan - - else !crtm_cloud - ! symmetric error model, Geer and Bauer (2011) - do k = 1, nchan - if (c37_mean.lt.0.05) then - iv%instid(i)%tb_error(k,n)= satinfo(i)%error_std(k) - else if (c37_mean.ge.0.05.and.c37_mean.lt.0.5) then - iv%instid(i)%tb_error(k,n)= satinfo(i)%error_std(k)+ & - (c37_mean-0.05)*(satinfo(i)%error_cld(k)-satinfo(i)%error_std(k))/(0.5-0.05) - else - iv%instid(i)%tb_error(k,n)= satinfo(i)%error_cld(k) - end if - end do ! nchan - - end if - - ! 5.1 check innovation - !----------------------------------------------------------------- - if (.not. crtm_cloud ) then - ! absolute departure check - do k = 1, nchan - inv_grosscheck = 15.0 - if (use_satcv(2)) inv_grosscheck = 100.0 - if (abs(iv%instid(i)%tb_inv(k,n)) > inv_grosscheck) then - iv%instid(i)%tb_qc(k,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_omb_abs(k) = nrej_omb_abs(k) + 1 - end if - end do ! nchan - end if - - do k = 1, nchan - ! relative departure check - if (abs(iv%instid(i)%tb_inv(k,n)) > 3.0*iv%instid(i)%tb_error(k,n)) then - iv%instid(i)%tb_qc(k,n) = qc_bad - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej_omb_std(k) = nrej_omb_std(k) + 1 - end if - - - ! final QC decsion - if (iv%instid(i)%tb_qc(k,n) == qc_bad) then - iv%instid(i)%tb_error(k,n) = 500.0 - if (iv%instid(i)%info%proc_domain(1,n)) & - nrej(k) = nrej(k) + 1 - else - if (iv%instid(i)%info%proc_domain(1,n)) & - ngood(k) = ngood(k) + 1 - end if - end do ! nchan - - end do ! end loop pixel - - ! Do inter-processor communication to gather statistics. - call da_proc_sum_int (num_proc_domain) - call da_proc_sum_int (nrej_mixsurface) - call da_proc_sum_int (nrej_land) - call da_proc_sum_ints (nrej_eccloud) - call da_proc_sum_ints (nrej_omb_abs) - call da_proc_sum_ints (nrej_omb_std) - call da_proc_sum_ints (nrej_clw) - call da_proc_sum_ints (nrej) - call da_proc_sum_ints (ngood) - - if (rootproc) then - if (num_fgat_time > 1) then - write(filename,'(i2.2,a,i2.2)') it,'_qcstat_'//trim(iv%instid(i)%rttovid_string)//'_',iv%time - else - write(filename,'(i2.2,a)') it,'_qcstat_'//trim(iv%instid(i)%rttovid_string) - end if - - call da_get_unit(fgat_rad_unit) - open(fgat_rad_unit,file=trim(filename),form='formatted',iostat=ios) - if (ios /= 0) then - write(unit=message(1),fmt='(A,A)') 'error opening the output file ', filename - call da_error(__FILE__,__LINE__,message(1:1)) - end if - - write(fgat_rad_unit, fmt='(/a/)') ' Quality Control Statistics for '//iv%instid(i)%rttovid_string - if(num_proc_domain > 0) write(fgat_rad_unit,'(a20,i7)') ' num_proc_domain = ', num_proc_domain - write(fgat_rad_unit,'(a20,i7)') ' nrej_mixsurface = ', nrej_mixsurface - write(fgat_rad_unit,'(a20,i7)') ' nrej_land = ', nrej_land - write(fgat_rad_unit,'(a20)') ' nrej_eccloud(:) = ' - write(fgat_rad_unit,'(10i7)') nrej_eccloud(:) - write(fgat_rad_unit,'(a20)') ' nrej_clw(:) = ' - write(fgat_rad_unit,'(10i7)') nrej_clw(:) - write(fgat_rad_unit,'(a20)') ' nrej_omb_abs(:) = ' - write(fgat_rad_unit,'(10i7)') nrej_omb_abs(:) - write(fgat_rad_unit,'(a20)') ' nrej_omb_std(:) = ' - write(fgat_rad_unit,'(10i7)') nrej_omb_std(:) - write(fgat_rad_unit,'(a20)') ' nrej(:) = ' - write(fgat_rad_unit,'(10i7)') nrej(:) - write(fgat_rad_unit,'(a20)') ' ngood(:) = ' - write(fgat_rad_unit,'(10i7)') ngood(:) - - close(fgat_rad_unit) - call da_free_unit(fgat_rad_unit) - end if - if (trace_use) call da_trace_exit("da_qc_ahi") - -end subroutine da_qc_ahi - -function relative_azimuth ( sol_az ,sen_az ) - implicit none - real :: sol_az - real :: sen_az - real :: relative_azimuth - relative_azimuth = abs(sol_az - sen_az) - if (relative_azimuth > 180.0) then - relative_azimuth = 360.0 - relative_azimuth - endif - relative_azimuth = 180.0 - relative_azimuth -end function relative_azimuth - !------------------------------------------------------------------------------------ - ! Glint angle (the angle difference between direct "specular" reflection off - ! the surface and actual reflection toward the satellite.) - !------------------------------------------------------------------------------------ -function glint_angle ( sol_zen , sen_zen , rel_az ) - implicit none - real :: sol_zen - real :: sen_zen - real :: rel_az - real :: glint_angle - real, parameter :: PI = 3.1415926535897 - real, parameter :: DTOR = PI/180. - - glint_angle = cos(sol_zen*DTOR) * cos(sen_zen*DTOR) + & - sin(sol_zen*DTOR) * sin(sen_zen*DTOR) * cos(rel_az*DTOR) - glint_angle = max(-1.0 , min( glint_angle ,1.0 )) - glint_angle = acos(glint_angle) / DTOR -end function glint_angle - - - - - - - - - - diff --git a/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc.ok b/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc.ok deleted file mode 100644 index faa2f45882..0000000000 --- a/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc.ok +++ /dev/null @@ -1,334 +0,0 @@ -subroutine da_read_iv_rad_for_multi_inc (it,ob, iv ) - - !--------------------------------------------------------------------------- - ! Purpose: read out innovation vector structure for radiance data. - !--------------------------------------------------------------------------- - - implicit none - - integer , intent(in) :: it ! outer loop count - type (y_type), intent(in) :: ob ! Observation structure. - type (iv_type), intent(inout) :: iv ! O-B structure. - - integer :: n ! Loop counter. - integer :: i, k, l, m, m1, m2,nobs_tot,nobs_in ! Index dimension. - integer :: nlevelss ! Number of obs levels. - - integer :: ios, innov_rad_unit_in - character(len=filename_len) :: filename - character(len=7) :: surftype - integer :: ndomain - logical :: amsr2 - - real, allocatable :: dtransmt(:,:), transmt_jac(:,:), transmt(:,:), lod(:,:), lod_jac(:,:) - - if (trace_use) call da_trace_entry("da_read_iv_rad_ascii") - - write(unit=message(1),fmt='(A)') 'Reading radiance OMB ascii file' - call da_message(message(1:1)) - - do i = 1, iv%num_inst - if (iv%instid(i)%num_rad < 1) cycle - - ! count number of obs within the loc%proc_domain - ! --------------------------------------------- - nobs_tot = iv%instid(i)%info%ptotal(num_fgat_time) - iv%instid(i)%info%ptotal(0) - do m=num_fgat_time,1,-1 - if ( nobs_tot > 0 ) then - if ( rootproc ) then - write(unit=filename, fmt='(a,i3.3)') 'inv_'//trim(iv%instid(i)%rttovid_string)//'_',m - call da_get_unit(innov_rad_unit_in) - open(unit=innov_rad_unit_in,file=trim(filename),form='formatted',status='replace',iostat=ios) - if (ios /= 0 ) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open innovation radiance file"//filename/)) - Endif - read(innov_rad_unit_in) nobs_in - if ( nobs_in /= nobs_tot ) then - call da_error(__FILE__,__LINE__, & - (/"Dimensions (nobs_tot of radiance) mismatch "/)) - end if - end if ! root open ounit - iv%instid(i)%info%n1 = iv%instid(i)%info%plocal(m-1) + 1 - iv%instid(i)%info%n2=iv%instid(i)%info%plocal(m) - ndomain = 0 -! do n =1,iv%instid(i)%num_rad - do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 - - if (iv%instid(i)%info%proc_domain(1,n)) then - ndomain = ndomain + 1 - end if - end do - if (ndomain < 1) cycle - - if (rtm_option==rtm_option_crtm .and. write_jacobian ) then - allocate ( dtransmt(iv%instid(i)%nchan,iv%instid(i)%nlevels) ) - allocate ( transmt_jac(iv%instid(i)%nchan,iv%instid(i)%nlevels) ) - allocate ( transmt(iv%instid(i)%nchan,iv%instid(i)%nlevels) ) - allocate ( lod(iv%instid(i)%nchan,iv%instid(i)%nlevels) ) - allocate ( lod_jac(iv%instid(i)%nchan,iv%instid(i)%nlevels) ) - end if - - amsr2 = index(iv%instid(i)%rttovid_string,'amsr2') > 0 - - read(unit=innov_rad_unit_in,fmt='(a,a,i7,a,i5,a)') iv%instid(i)%rttovid_string, & - ' number-of-pixels : ', ndomain, & - ' channel-number-of-each-pixel : ', iv%instid(i)%nchan, & - ' index-of-channels : ' - read(unit=innov_rad_unit_in,fmt='(10i5)') iv%instid(i)%ichan - if ( amsr2 ) then - read(unit=innov_rad_unit_in,fmt='(a)') ' pixel-info : i date scanpos landsea_mask elv lat lon satzen satazi clw' - else - read(unit=innov_rad_unit_in,fmt='(a)') ' pixel-info : i date scanpos landsea_mask elv lat lon satzen satazi' - end if - read(unit=innov_rad_unit_in,fmt='(a)') ' grid%xb-surf-info : i t2m mr2m(ppmv) u10 v10 ps ts smois tslb snowh isflg & - & soiltyp vegtyp vegfra elev clwp' - ndomain = 0 -!wuyl do n =1,iv%instid(i)%num_rad - do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 - if (iv%instid(i)%info%proc_domain(1,n)) then - ndomain=ndomain+1 - if ( amsr2 ) then ! read out clw - read(unit=innov_rad_unit_in,fmt='(a,i7,2x,a,i6,i3,f6.0,4f8.2,f8.3)') 'INFO : ', ndomain, & - iv%instid(i)%info%date_char(n), & - iv%instid(i)%scanpos(n), & - iv%instid(i)%landsea_mask(n), & - iv%instid(i)%info%elv(n), & - iv%instid(i)%info%lat(1,n), & - iv%instid(i)%info%lon(1,n), & - iv%instid(i)%satzen(n), & - iv%instid(i)%satazi(n), & - iv%instid(i)%clw(n) - else ! no clw info - read(unit=innov_rad_unit_in,fmt='(a,i7,2x,a,i6,i3,f6.0,4f8.2)') 'INFO : ', ndomain, & - iv%instid(i)%info%date_char(n), & - iv%instid(i)%scanpos(n), & - iv%instid(i)%landsea_mask(n), & - iv%instid(i)%info%elv(n), & - iv%instid(i)%info%lat(1,n), & - iv%instid(i)%info%lon(1,n), & - iv%instid(i)%satzen(n), & - iv%instid(i)%satazi(n) - end if - select case (iv%instid(i)%isflg(n)) - case (0) ; - surftype = ' SEA : ' - case (1) ; - surftype = ' ICE : ' - case (2) ; - surftype = 'LAND : ' - case (3) ; - surftype = 'SNOW : ' - case (4) ; - surftype = 'MSEA : ' - case (5) ; - surftype = 'MICE : ' - case (6) ; - surftype = 'MLND : ' - case (7) ; - surftype = 'MSNO : ' - end select - read(unit=innov_rad_unit_in,fmt='(a,i7,9f10.2,3i3,f8.3,f10.2,f8.3)') surftype, n, & - iv%instid(i)%t2m(n), & - iv%instid(i)%mr2m(n), & - iv%instid(i)%u10(n), & - iv%instid(i)%v10(n), & - iv%instid(i)%ps(n), & - iv%instid(i)%ts(n), & - iv%instid(i)%smois(n), & - iv%instid(i)%tslb(n), & - iv%instid(i)%snowh(n), & - iv%instid(i)%isflg(n), & - nint(iv%instid(i)%soiltyp(n)), & - nint(iv%instid(i)%vegtyp(n)), & - iv%instid(i)%vegfra(n), & - iv%instid(i)%elevation(n), & - iv%instid(i)%clwp(n) - - read(unit=innov_rad_unit_in,fmt='(a)') 'OBS : ' - read(unit=innov_rad_unit_in,fmt='(10f11.2)') ob%instid(i)%tb(:,n) - read(unit=innov_rad_unit_in,fmt='(a)') 'BAK : ' - read(unit=innov_rad_unit_in,fmt='(10f11.2)') iv%instid(i)%tb_xb(:,n) - read(unit=innov_rad_unit_in,fmt='(a)') 'IVBC : ' - read(unit=innov_rad_unit_in,fmt='(10f11.2)') iv%instid(i)%tb_inv(:,n) - read(unit=innov_rad_unit_in,fmt='(a)') 'EMS : ' - read(unit=innov_rad_unit_in,fmt='(10f11.2)') iv%instid(i)%emiss(1:iv%instid(i)%nchan,n) - if (rtm_option==rtm_option_crtm .and. write_jacobian) then - read(unit=innov_rad_unit_in,fmt='(a)') 'EMS_JACOBIAN : ' - read(unit=innov_rad_unit_in,fmt='(10f10.3)') iv%instid(i)%emiss_jacobian(1:iv%instid(i)%nchan,n) - end if - read(unit=innov_rad_unit_in,fmt='(a)') 'ERR : ' - read(unit=innov_rad_unit_in,fmt='(10f11.2)') iv%instid(i)%tb_error(:,n) - read(unit=innov_rad_unit_in,fmt='(a)') 'QC : ' - read(unit=innov_rad_unit_in,fmt='(10i11)') iv%instid(i)%tb_qc(:,n) - - if (write_profile) then - nlevelss = iv%instid(i)%nlevels - if ( rtm_option == rtm_option_rttov ) then -#ifdef RTTOV - ! first, read RTTOV levels - read(unit=innov_rad_unit_in,fmt='(a)') 'RTM_level pres(mb) T(k) Q(ppmv)' - do k = 1, nlevelss - read(unit=innov_rad_unit_in,fmt='(i3,f10.2,f8.2,e11.4)') & - k, & ! RTTOV levels - coefs(i) % coef % ref_prfl_p(k) , & - iv%instid(i)%t(k,n) , & - iv%instid(i)%mr(k,n) - end do ! end loop RTTOV level - ! second, read WRF model levels - read(unit=innov_rad_unit_in,fmt='(a)') & - 'WRF_level pres(mb) T(k) q(g/kg) clw(g/kg) rain(g/kg)' - do k=kts,kte - read(unit=innov_rad_unit_in,fmt='(i3,f10.2,f8.2,3e11.4)') & - k, & ! WRF model levels - iv%instid(i)%pm(k,n) , & - iv%instid(i)%tm(k,n) , & - iv%instid(i)%qm(k,n)*1000 , & - iv%instid(i)%qcw(k,n)*1000.0, & - iv%instid(i)%qrn(k,n)*1000.0 - end do ! end loop model level -#endif - end if ! end if rtm_option_rttov - - if ( rtm_option == rtm_option_crtm ) then -#ifdef CRTM - read(unit=innov_rad_unit_in,fmt='(a)') & - 'level fullp(mb) halfp(mb) t(k) q(g/kg) water(mm) ice(mm) rain(mm) snow(mm) graupel(mm) hail(mm)' - if (crtm_cloud) then - do k=1,iv%instid(i)%nlevels-1 - read(unit=innov_rad_unit_in,fmt='(i3,2f10.2,f8.2,13f8.3)') & - k, & - iv%instid(i)%pf(k,n), & - iv%instid(i)%pm(k,n), & - iv%instid(i)%tm(k,n), & - iv%instid(i)%qm(k,n), & - iv%instid(i)%qcw(k,n), & - iv%instid(i)%qci(k,n), & - iv%instid(i)%qrn(k,n), & - iv%instid(i)%qsn(k,n), & - iv%instid(i)%qgr(k,n), & - iv%instid(i)%qhl(k,n), & - iv%instid(i)%rcw(k,n), & - iv%instid(i)%rci(k,n), & - iv%instid(i)%rrn(k,n), & - iv%instid(i)%rsn(k,n), & - iv%instid(i)%rgr(k,n), & - iv%instid(i)%rhl(k,n) - end do ! end loop profile - else ! no cloud - do k=1,iv%instid(i)%nlevels-1 - read(unit=innov_rad_unit_in,fmt='(i3,2f10.2,f8.2,7f8.3)') & - k, & - iv%instid(i)%pf(k,n), & - iv%instid(i)%pm(k,n), & - iv%instid(i)%tm(k,n), & - iv%instid(i)%qm(k,n), & - 0.0, & - 0.0, & - 0.0, & - 0.0, & - 0.0, & - 0.0 - end do ! end loop profile - end if ! end if crtm_cloud -#endif - end if ! end if rtm_option_crtm - - end if ! end if read_profile - - if ( rtm_option == rtm_option_crtm .and. write_jacobian) then -#ifdef CRTM - - if ( calc_weightfunc ) then - dtransmt(:,:) = iv%instid(i)%der_trans(:,:,n) - transmt(:,:) = iv%instid(i)%trans(:,:,n) - transmt_jac(:,:) = iv%instid(i)%trans_jacobian(:,:,n) - lod(:,:) = iv%instid(i)%lod(:,:,n) - lod_jac(:,:) = iv%instid(i)%lod_jacobian(:,:,n) - else - dtransmt(:,:) = 0.0 - transmt(:,:) = 0.0 - transmt_jac(:,:) = 0.0 - lod(:,:) = 0.0 - lod_jac(:,:) = 0.0 - end if - - read(unit=innov_rad_unit_in,fmt='(a)') & - 'channel level halfp(mb) t(k) q(g/kg) der_trans trans_jac trans lod_jac lod water(mm) ice(mm) rain(mm) snow(mm) graupel(mm) hail(mm)' - if (crtm_cloud) then - do l=1,iv%instid(i)%nchan - do k=1,iv%instid(i)%nlevels-1 - read(unit=innov_rad_unit_in,fmt='(i5,i3,f10.2,13f14.7,6f14.7)') & - l, k, & - iv%instid(i)%pm(k,n), & - iv%instid(i)%t_jacobian(l,k,n), & - iv%instid(i)%q_jacobian(l,k,n), & - dtransmt(l,k),& - transmt_jac(l,k),& - transmt(l,k),& - lod_jac(l,k),& - lod(l,k),& - iv%instid(i)%water_jacobian(l,k,n), & - iv%instid(i)%ice_jacobian(l,k,n), & - iv%instid(i)%rain_jacobian(l,k,n), & - iv%instid(i)%snow_jacobian(l,k,n), & - iv%instid(i)%graupel_jacobian(l,k,n), & - iv%instid(i)%hail_jacobian(l,k,n), & - iv%instid(i)%water_r_jacobian(l,k,n), & - iv%instid(i)%ice_r_jacobian(l,k,n), & - iv%instid(i)%rain_r_jacobian(l,k,n), & - iv%instid(i)%snow_r_jacobian(l,k,n), & - iv%instid(i)%graupel_r_jacobian(l,k,n), & - iv%instid(i)%hail_r_jacobian(l,k,n) - end do ! end loop profile - end do ! end loop channels - else ! no cloud - do l=1,iv%instid(i)%nchan - do k=1,iv%instid(i)%nlevels-1 - read(unit=innov_rad_unit_in,fmt='(i5,i3,f10.2,13f14.7,6f14.7)') & - l, k, & - iv%instid(i)%pm(k,n), & - iv%instid(i)%t_jacobian(l,k,n), & - iv%instid(i)%q_jacobian(l,k,n), & - dtransmt(l,k),& - transmt_jac(l,k),& - transmt(l,k),& - lod_jac(l,k),& - lod(l,k),& - 0., & - 0., & - 0., & - 0., & - 0., & - 0., & - 0., & - 0., & - 0., & - 0., & - 0., & - 0. - end do ! end loop profile - end do ! end loop channels - end if ! end if crtm_cloud -#endif - end if ! end if read_jacobian - - end if ! end if proc_domain - end do ! end do pixels - if (rtm_option==rtm_option_crtm .and. write_jacobian ) then - deallocate ( dtransmt ) - deallocate ( transmt_jac ) - deallocate ( transmt ) - deallocate ( lod ) - deallocate ( lod_jac ) - end if - close(unit=innov_rad_unit_in) - call da_free_unit(innov_rad_unit_in) - end if ! nobs_tot - end do ! n1,n2 wuyl -end do ! end do instruments - - if (trace_use) call da_trace_exit("da_read_iv_rad_ascii") - -end subroutine da_read_iv_rad_for_multi_inc - diff --git a/var/da/da_radiance/da_read_obs_AHI.inc.1 b/var/da/da_radiance/da_read_obs_AHI.inc.1 deleted file mode 100644 index 05803a0708..0000000000 --- a/var/da/da_radiance/da_read_obs_AHI.inc.1 +++ /dev/null @@ -1,566 +0,0 @@ -subroutine da_read_obs_AHI (iv, infile) - !-------------------------------------------------------- - ! Purpose: read in GEOCAT AHI Level-1 and Level-2 data in NETCDF4 format - ! and form innovation structure - ! - ! METHOD: use F90 sequantial data structure to avoid read the file twice - ! 1. read file radiance data in sequential data structure - ! 2. do gross QC check - ! 3. assign sequential data structure to innovation structure - ! and deallocate sequential data structure - ! - ! HISTORY: 2016/10/22 - Creation Yuanbing Wang, NUIST/CAS, NCAR/NESL/MMM/DAS - ! To be devoloped: 1.time information; 2.dimension sequence - !------------------------------------------------------------------------------ - - use netcdf - implicit none - - character(len=*), intent(in) :: infile - type(iv_type), intent(inout) :: iv - -! fixed parameter values - integer,parameter::time_dims=6 ! Time dimension - integer,parameter::nfile_max = 8 ! each netcdf file contains - -! interface variable - integer iret, rcode, ncid ! return status - -! array data - real(4), allocatable :: vlatitude(:,:) ! value for latitude - real(4), allocatable :: vlongitude(:,:) ! value for longitude - - real(4), allocatable :: tbb(:,:,:) ! tb for band 7-16 - real(4), allocatable :: sat_zenith(:,:) - - byte, allocatable ::cloud_mask(:,:) - - real(r_kind),parameter :: tbmin = 50._r_kind - real(r_kind),parameter :: tbmax = 550._r_kind - - real(kind=8) :: obs_time - type (datalink_type),pointer :: head, p, current, prev - type(info_type) :: info - type(model_loc_type) :: loc - - integer(i_kind) :: idate5(6) - character(len=80) :: filename,str_tmp - - integer(i_kind) :: inst,platform_id,satellite_id,sensor_id - real(r_kind) :: tb, crit - integer(i_kind) :: ifgat, iout, iobs - logical :: outside, outside_all, iuse - - integer :: i,j,k,l,m,n, ifile, landsea_mask - logical :: found, head_found, head_allocated - -! Other work variables - real(r_kind) :: dlon_earth,dlat_earth - integer(i_kind) :: num_ahi_local, num_ahi_global, num_ahi_used, num_ahi_thinned - integer(i_kind) :: num_ahi_used_tmp, num_ahi_file - integer(i_kind) :: num_ahi_local_local, num_ahi_global_local, num_ahi_file_local - integer(i_kind) :: itx, itt - character(80) :: filename1,filename2 - integer :: nchan,nlongitude,nlatitude,ilongitude,ilatitude,ichannels - integer :: lonstart,latstart - integer :: LatDimID,LonDimID - integer :: latid,lonid,tbb_id,sazid,cltyid - integer :: nfile - character(80) :: fname_tb(nfile_max),fname_clp(nfile_max) - integer :: vtype - character(80) :: vname - logical :: fexist,got_clp_file - -! Allocatable arrays - integer(i_kind),allocatable :: ptotal(:) - real,allocatable :: in(:), out(:) - real(r_kind),allocatable :: data_all(:) - - character(len=2) tbb_name - data tbb_name/'BT'/ - - if (trace_use) call da_trace_entry("da_read_obs_netcdf4ahi_zout") - -! 0.0 Initialize variables -!----------------------------------- - head_allocated = .false. - platform_id = 31 ! Table-2 Col 1 corresponding to 'himawari' - satellite_id = 8 ! Table-2 Col 3 - sensor_id = 56 ! Table-3 Col 2 corresponding to 'ahi' - - allocate(ptotal(0:num_fgat_time)) - ptotal(0:num_fgat_time) = 0 - iobs = 0 ! for thinning, argument is inout - num_ahi_file = 0 - num_ahi_local = 0 - num_ahi_global = 0 - num_ahi_used = 0 - num_ahi_thinned = 0 - - do i = 1, rtminit_nsensor - if (platform_id == rtminit_platform(i) & - .and. satellite_id == rtminit_satid(i) & - .and. sensor_id == rtminit_sensor(i)) then - inst = i - exit - end if - end do - if (inst == 0) then - call da_warning(__FILE__,__LINE__, & - (/"The combination of Satellite_Id and Sensor_Id for AHI is not found"/)) - if (trace_use) call da_trace_exit("da_read_obs_netcdf4ahi_geocat") - return - end if - - nchan = iv%instid(inst)%nchan - write(unit=stdout,fmt=*)'AHI nchan: ',nchan - allocate(data_all(1:nchan)) - -! 1.0 Assign file names and prepare to read ahi files -!------------------------------------------------------------------------- - nfile = 0 !initialize - fname_tb(:) = '' !initialize - - ! first check if ahi nc file is available - filename1 = trim(infile) - inquire (file=filename1, exist=fexist) - if ( fexist ) then - nfile = 1 - fname_tb(nfile) = filename1 - else - ! check if netcdf4 files are available for multiple input files - ! here 0x is the input file sequence number - ! do not confuse it with fgat time slot index - do i = 1, nfile_max - write(filename1,fmt='(A,A,I2.2,A)') trim(infile),'-',i - inquire (file=filename1, exist=fexist) - if ( fexist ) then - nfile = nfile + 1 - fname_tb(nfile) = filename1 - else - exit - end if - end do - end if - - if ( nfile == 0 ) then - call da_warning(__FILE__,__LINE__, & - (/"No valid AHI file found."/)) - if (trace_use) call da_trace_exit("da_read_obs_netcdf4ahi_geocat") - return - end if - - - !open the data area info file - open(unit=1990,file='ahi_info',status='old',iostat=iret) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__,(/"area_info file read error"/)) - endif - !read date information - read(1990,*) - read(1990,*) - read(1990,*) - read(1990,*) - read(1990,*) - read(1990,*) lonstart,latstart,nlongitude,nlatitude - close(1990) - - write(*,*) lonstart,latstart,nlongitude,nlatitude - - infile_loop: do ifile = 1, nfile - num_ahi_file_local = 0 - num_ahi_local_local = 0 - num_ahi_global_local = 0 - - ! open NETCDF4 L1 file for read - iret = nf90_open(fname_tb(ifile), nf90_NOWRITE, ncid) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"Cannot open NETCDF4 file "//trim(fname_tb(ifile))/)) - cycle infile_loop - endif - - ! read dimensions: latitude and longitude - ! iret = nf90_inq_dimid(ncid, "lines", LatDimID) - ! iret = nf90_inquire_dimension(ncid, LatDimID, len=nlatitude) - - ! iret = nf90_inq_dimid(ncid, "elements", LonDimID) - ! iret = nf90_inquire_dimension(ncid, LonDimID, len=nlongitude) - - ! write(unit=stdout,fmt=*) nlongitude,nlatitude - - - ! read array: time - iret = nf90_get_att(ncid, nf90_global, "Image_Date_Time", filename) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"NETCDF4 read error for: observation date"/)) - end if - read(filename,"(I4,A1,I2,A1,I2,A1,I2,A1,I2,A1,I2,A1)") idate5(1),str_tmp,idate5(2),str_tmp,& - idate5(3),str_tmp,idate5(4),str_tmp,idate5(5),str_tmp,idate5(6),str_tmp - write(unit=stdout,fmt=*)'observation date: ', idate5 - - ! read array: lat - ! read lat - iret = nf90_inq_varid(ncid, 'latitude', latid) - allocate(vlatitude(nlongitude,nlatitude)) - iret = nf90_get_var(ncid,latid,vlatitude,start=(/lonstart,latstart/), & - count=(/nlongitude,nlatitude/)) ! - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"NETCDF4 read error for: Latitude of Observation Point"/)) - endif -! do j=1,nlatitude -! do i=1,nlongitude -! vlatitude(i,j)=vlatitude(i,j) * scale_factor_lat -! end do -! end do - ! sample display - write(unit=stdout,fmt=*)'vlatitude(pixel=1,scan=1): ',vlatitude(1,1) - - ! read lon - iret = nf90_inq_varid(ncid, 'longitude', lonid) - allocate(vlongitude(nlongitude,nlatitude)) - iret = nf90_get_var(ncid,lonid,vlongitude,start=(/lonstart,latstart/), & - count=(/nlongitude,nlatitude/)) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"NETCDF4 read error for: Longitude of Observation Point"/)) - call da_trace_exit("da_read_obs_netcdf4ahi_geocat") - endif -! do j=1,nlatitude -! do i=1,nlongitude -! vlongitude(i,j)=vlongitude(i,j) * scale_factor_lon -! end do -! end do - ! sample display - write(unit=stdout,fmt=*)'vlongitude(pixel=1,scan=1): ',vlongitude(1,1) - - ! read array: tb for band 7-16 - ! read - allocate(tbb(nlongitude,nlatitude,nchan)) -! do k=1,nchan - iret = nf90_inq_varid(ncid, tbb_name, tbb_id) - iret = nf90_get_var(ncid,tbb_id,tbb(:,:,:),start=(/lonstart,latstart,1/), & - count=(/nlongitude,nlatitude,10/)) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"NETCDF4 read error for: Brightness Temperature"/)) - endif -! do j=1,nlatitude -! do i=1,nlongitude -! if(k==1) then -! tbb(i,j,k)=tbb(i,j,k) * scale_factor_tb1 + add_offset_tb1 -! end if -! if(k>=2 .and. k<=4) then -! tbb(i,j,k)=tbb(i,j,k) * scale_factor_tb2 + add_offset_tb2 -! end if -! if(k>=5 .and. k<=9) then -! tbb(i,j,k)=tbb(i,j,k) * scale_factor_tb3 + add_offset_tb3 -! end if -! if(k==10) then -! tbb(i,j,k)=tbb(i,j,k) * scale_factor_tb4 + add_offset_tb4 -! end if -! end do -! end do - ! sample display - do k=1,nchan - write(unit=stdout,fmt=*) 'tbb(pixel=1,scan=1,chan=',k,'): ', tbb(1,1,k) - end do - - ! read array: satellite zenith angle - ! read - iret = nf90_inq_varid(ncid, 'satZenith', sazid) - allocate(sat_zenith(nlongitude,nlatitude)) - iret = nf90_get_var(ncid,sazid,sat_zenith,start=(/lonstart,latstart/), & - count=(/nlongitude,nlatitude/)) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"NETCDF4 read error for: satellite zenith angle"/)) - endif -! do j=1,nlatitude -! do i=1,nlongitude -! sat_zenith(i,j)=sat_zenith(i,j) * scale_factor_saz + add_offset_saz -! end do -! end do - ! sample display - write(unit=stdout,fmt=*) 'satellite zenith angle(pixel=1,scan=1): ',sat_zenith(1,1) - - ! close infile_tb file - iret = nf90_close(ncid) - - !open infile_clp file -! got_clp_file = .false. -! iret = nf90_open(fname_clp(ifile), nf90_NOWRITE, ncid) -! if ( iret == 0 ) then -! got_clp_file = .true. -! endif - -! if ( got_clp_file ) then - ! read array: eps_cmask_ahi_cloud_mask - rcode = nf90_inq_varid(ncid, "clm_zou", cltyid) - allocate(cloud_mask(nlongitude,nlatitude)) - iret = nf90_get_var(ncid,cltyid,cloud_mask,start=(/lonstart,latstart/), & - count=(/nlongitude,nlatitude/)) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__,(/"NETCDF4 read error for: CLTYPE data"/)) - endif - ! sample display - write(unit=stdout,fmt=*)'cloud_mask(pixel=1,scan=1): ',cloud_mask(1,1) - ! close infile_clp file - iret = nf90_close(ncid) -! end if - -! 2.0 Loop to read netcdf and assign information to a sequential structure -!------------------------------------------------------------------------- - - ! Allocate arrays to hold data - if ( .not. head_allocated ) then - allocate (head) - nullify ( head % next ) - p => head - head_allocated = .true. - end if - - ! start scan_loop - scan_loop: do ilatitude=1, nlatitude - - call da_get_julian_time(idate5(1),idate5(2),idate5(3),idate5(4),idate5(5),obs_time) - if ( obs_time < time_slots(0) .or. & - obs_time >= time_slots(num_fgat_time) ) cycle scan_loop - do ifgat=1,num_fgat_time - if ( obs_time >= time_slots(ifgat-1) .and. & - obs_time < time_slots(ifgat) ) exit - end do - - ! start fov_loop - fov_loop: do ilongitude=1, nlongitude - - if ( sat_zenith(ilongitude,ilatitude) > 65.0 ) cycle fov_loop - - num_ahi_file = num_ahi_file + 1 - num_ahi_file_local = num_ahi_file_local + 1 - info%lat = vlatitude(ilongitude,ilatitude) - info%lon = vlongitude(ilongitude,ilatitude) - - call da_llxy (info, loc, outside, outside_all) - if (outside_all) cycle fov_loop - - num_ahi_global = num_ahi_global + 1 - num_ahi_global_local = num_ahi_global_local + 1 - ptotal(ifgat) = ptotal(ifgat) + 1 - if (outside) cycle fov_loop ! No good for this PE - - num_ahi_local = num_ahi_local + 1 - num_ahi_local_local = num_ahi_local_local + 1 - write(unit=info%date_char, & - fmt='(i4.4,a,i2.2,a,i2.2,a,i2.2,a,i2.2,a,i2.2)') & - idate5(1), '-', idate5(2), '-', idate5(3), '_', idate5(4), & - ':', idate5(5), ':', idate5(6) - info%elv = 0.0 - -! 3.0 Make Thinning -! Map obs to thinning grid -!------------------------------------------------------------------- - if (thinning) then - dlat_earth = info%lat !degree - dlon_earth = info%lon - if (dlon_earth=r360) dlon_earth = dlon_earth-r360 - dlat_earth = dlat_earth*deg2rad !radian - dlon_earth = dlon_earth*deg2rad - crit = 1. - call map2grids(inst,ifgat,dlat_earth,dlon_earth,crit,iobs,itx,1,itt,iout,iuse) - if (.not. iuse) then - num_ahi_thinned = num_ahi_thinned+1 - cycle fov_loop - end if - end if - - num_ahi_used = num_ahi_used + 1 - data_all = missing_r - - do k=1,nchan - tb = tbb(ilongitude,ilatitude,k) - if( tb < tbmin .or. tb > tbmax ) tb = missing_r - data_all(k)= tb - enddo - -! 4.0 assign information to sequential radiance structure -!-------------------------------------------------------------------------- - allocate ( p % tb_inv (1:nchan )) - p%info = info - p%loc = loc - p%landsea_mask = 1 - p%scanpos = ilongitude !nint(sat_zenith(ilongitude,ilatitude))+1.001_r_kind ! - p%satzen = sat_zenith(ilongitude,ilatitude) - p%satazi = 0 - p%solzen = 0 - p%solazi = 0 - p%tb_inv(1:nchan) = data_all(1:nchan) - p%sensor_index = inst - p%ifgat = ifgat - p%cloudflag = cloud_mask(ilongitude,ilatitude) - - allocate (p%next) ! add next data - p => p%next - nullify (p%next) - end do fov_loop - end do scan_loop - - write(stdout,fmt='(3a,i10)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_file : ',num_ahi_file_local - write(stdout,fmt='(3a,i10)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_global : ',num_ahi_global_local - write(stdout,fmt='(3a,i10)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_local : ',num_ahi_local_local - end do infile_loop - - deallocate(data_all) ! Deallocate data arrays - !deallocate(cloudflag) - deallocate(vlatitude) - deallocate(vlongitude) - deallocate(tbb) - deallocate(sat_zenith) - if( got_clp_file ) deallocate(cloud_mask) - - if (thinning .and. num_ahi_global > 0 ) then -#ifdef DM_PARALLEL - ! Get minimum crit and associated processor index. - j = 0 - do ifgat = 1, num_fgat_time - j = j + thinning_grid(inst,ifgat)%itxmax - end do - - allocate ( in (j) ) - allocate ( out (j) ) - j = 0 - do ifgat = 1, num_fgat_time - do i = 1, thinning_grid(inst,ifgat)%itxmax - j = j + 1 - in(j) = thinning_grid(inst,ifgat)%score_crit(i) - end do - end do - call mpi_reduce(in, out, j, true_mpi_real, mpi_min, root, comm, ierr) - - call wrf_dm_bcast_real (out, j) - - j = 0 - do ifgat = 1, num_fgat_time - do i = 1, thinning_grid(inst,ifgat)%itxmax - j = j + 1 - if ( ABS(out(j)-thinning_grid(inst,ifgat)%score_crit(i)) > 1.0E-10 ) & - thinning_grid(inst,ifgat)%ibest_obs(i) = 0 - end do - end do - - deallocate( in ) - deallocate( out ) - -#endif - - ! Delete the nodes which being thinning out - p => head - prev => head - head_found = .false. - num_ahi_used_tmp = num_ahi_used - do j = 1, num_ahi_used_tmp - n = p%sensor_index - ifgat = p%ifgat - found = .false. - - do i = 1, thinning_grid(n,ifgat)%itxmax - if ( thinning_grid(n,ifgat)%ibest_obs(i) == j .and. thinning_grid(n,ifgat)%score_crit(i) < 9.99e6_r_kind ) then - found = .true. - exit - end if - end do - - ! free current data - if ( .not. found ) then - - current => p - p => p%next - - if ( head_found ) then - prev%next => p - else - head => p - prev => p - end if - - deallocate ( current % tb_inv ) - deallocate ( current ) - - num_ahi_thinned = num_ahi_thinned + 1 - num_ahi_used = num_ahi_used - 1 - continue - end if - - if ( found .and. head_found ) then - prev => p - p => p%next - continue - end if - - if ( found .and. .not. head_found ) then - head_found = .true. - head => p - prev => p - p => p%next - end if - - end do - end if ! End of thinning - - iv%total_rad_pixel = iv%total_rad_pixel + num_ahi_used - iv%total_rad_channel = iv%total_rad_channel + num_ahi_used*nchan - - iv%info(radiance)%nlocal = iv%info(radiance)%nlocal + num_ahi_used - iv%info(radiance)%ntotal = iv%info(radiance)%ntotal + num_ahi_global - - do i = 1, num_fgat_time - ptotal(i) = ptotal(i) + ptotal(i-1) - iv%info(radiance)%ptotal(i) = iv%info(radiance)%ptotal(i) + ptotal(i) - end do - if ( iv%info(radiance)%ptotal(num_fgat_time) /= iv%info(radiance)%ntotal ) then - write(unit=message(1),fmt='(A,I10,A,I10)') & - "Number of ntotal:",iv%info(radiance)%ntotal," is different from the sum of ptotal:", iv%info(radiance)%ptotal(num_fgat_time) - call da_warning(__FILE__,__LINE__,message(1:1)) - endif - - write(unit=stdout,fmt='(a)') 'AHI data counts: ' - write(stdout,fmt='(a,i10)') ' In file: ',num_ahi_file - write(stdout,fmt='(a,i10)') ' Global : ',num_ahi_global - write(stdout,fmt='(a,i10)') ' Local : ',num_ahi_local - write(stdout,fmt='(a,i10)') ' Used : ',num_ahi_used - write(stdout,fmt='(a,i10)') ' Thinned: ',num_ahi_thinned - -! 5.0 allocate innovation radiance structure -!---------------------------------------------------------------- - - if (num_ahi_used > 0) then - iv%instid(inst)%num_rad = num_ahi_used - iv%instid(inst)%info%nlocal = num_ahi_used - write(UNIT=stdout,FMT='(a,i3,2x,a,3x,i10)') & - 'Allocating space for radiance innov structure', & - inst, iv%instid(inst)%rttovid_string, iv%instid(inst)%num_rad - call da_allocate_rad_iv (inst, nchan, iv) - end if - -! 6.0 assign sequential structure to innovation structure -!------------------------------------------------------------- - p => head - - do n = 1, num_ahi_used - i = p%sensor_index - call da_initialize_rad_iv (i, n, iv, p) - current => p - p => p%next - ! free current data - deallocate ( current % tb_inv ) - deallocate ( current ) - end do - deallocate ( p ) - deallocate (ptotal) - - if (trace_use) call da_trace_exit("da_read_obs_netcdf4ahi_geocat") - -end subroutine da_read_obs_AHI diff --git a/var/da/da_radiance/da_read_obs_netcdf4ahi_zou.inc b/var/da/da_radiance/da_read_obs_netcdf4ahi_zou.inc deleted file mode 100644 index e854b2c6b0..0000000000 --- a/var/da/da_radiance/da_read_obs_netcdf4ahi_zou.inc +++ /dev/null @@ -1,556 +0,0 @@ -subroutine da_read_obs_AHI (iv, infile) - !-------------------------------------------------------- - ! Purpose: read in GEOCAT AHI Level-1 and Level-2 data in NETCDF4 format - ! and form innovation structure - ! - ! METHOD: use F90 sequantial data structure to avoid read the file twice - ! 1. read file radiance data in sequential data structure - ! 2. do gross QC check - ! 3. assign sequential data structure to innovation structure - ! and deallocate sequential data structure - ! - ! HISTORY: 2016/10/22 - Creation Yuanbing Wang, NUIST/CAS, NCAR/NESL/MMM/DAS - ! To be devoloped: 1.time information; 2.dimension sequence - !------------------------------------------------------------------------------ - - use netcdf - implicit none - - character(len=*), intent(in) :: infile - type(iv_type), intent(inout) :: iv - -! fixed parameter values - integer,parameter::time_dims=6 ! Time dimension - integer,parameter::nfile_max = 8 ! each netcdf file contains - -! interface variable - integer iret, rcode, ncid ! return status - -! array data - real(4), allocatable :: vlatitude(:,:) ! value for latitude - real(4), allocatable :: vlongitude(:,:) ! value for longitude - - real(4), allocatable :: tbb(:,:,:) ! tb for band 7-16 - real(4), allocatable :: sat_zenith(:,:) - real(4), allocatable :: sun_zenith(:,:) - real(4), allocatable :: tropo_temp(:,:) - - byte, allocatable :: cloud_mask(:,:) - byte, allocatable :: cloud_zou(:,:) - - real(r_kind),parameter :: tbmin = 50._r_kind - real(r_kind),parameter :: tbmax = 550._r_kind - - real(kind=8) :: obs_time - type (datalink_type),pointer :: head, p, current, prev - type(info_type) :: info - type(model_loc_type) :: loc - - integer(i_kind) :: idate5(6) - character(len=80) :: filename,str_tmp - - integer(i_kind) :: inst,platform_id,satellite_id,sensor_id - real(r_kind) :: tb, crit - integer(i_kind) :: ifgat, iout, iobs - logical :: outside, outside_all, iuse - - integer :: i,j,k,l,m,n, ifile, landsea_mask - logical :: found, head_found, head_allocated - -! Other work variables - real(r_kind) :: dlon_earth,dlat_earth - integer(i_kind) :: num_ahi_local, num_ahi_global, num_ahi_used, num_ahi_thinned - integer(i_kind) :: num_ahi_used_tmp, num_ahi_file - integer(i_kind) :: num_ahi_local_local, num_ahi_global_local, num_ahi_file_local - integer(i_kind) :: itx, itt - character(80) :: filename1,filename2 - integer :: nchan,nlongitude,nlatitude,ilongitude,ilatitude,ichannels - integer :: lonstart,latstart - integer :: LatDimID,LonDimID - integer :: latid,lonid,tbb_id,sazid,cltyid,sozid,ttp_id - integer :: nfile - character(80) :: fname_tb(nfile_max),fname_clp(nfile_max) - integer :: vtype - character(80) :: vname - logical :: fexist,got_clp_file - -! Allocatable arrays - integer(i_kind),allocatable :: ptotal(:) - real,allocatable :: in(:), out(:) - real(r_kind),allocatable :: data_all(:) - - character(len=2) tbb_name - - - if (trace_use) call da_trace_entry("da_read_obs_netcdf4ahi_geocat") - -! 0.0 Initialize variables -!----------------------------------- - head_allocated = .false. - platform_id = 31 ! Table-2 Col 1 corresponding to 'himawari' - satellite_id = 8 ! Table-2 Col 3 - sensor_id = 56 ! Table-3 Col 2 corresponding to 'ahi' - - allocate(ptotal(0:num_fgat_time)) - ptotal(0:num_fgat_time) = 0 - iobs = 0 ! for thinning, argument is inout - num_ahi_file = 0 - num_ahi_local = 0 - num_ahi_global = 0 - num_ahi_used = 0 - num_ahi_thinned = 0 - - do i = 1, rtminit_nsensor - if (platform_id == rtminit_platform(i) & - .and. satellite_id == rtminit_satid(i) & - .and. sensor_id == rtminit_sensor(i)) then - inst = i - exit - end if - end do - if (inst == 0) then - call da_warning(__FILE__,__LINE__, & - (/"The combination of Satellite_Id and Sensor_Id for AHI is not found"/)) - if (trace_use) call da_trace_exit("da_read_obs_netcdf4ahi_geocat") - return - end if - - nchan = iv%instid(inst)%nchan - write(unit=stdout,fmt=*)'AHI nchan: ',nchan - allocate(data_all(1:nchan)) - -! 1.0 Assign file names and prepare to read ahi files -!------------------------------------------------------------------------- - nfile = 0 !initialize - fname_tb(:) = '' !initialize - - ! first check if ahi nc file is available - filename1 = trim(infile) - inquire (file=filename1, exist=fexist) - if ( fexist ) then - nfile = 1 - fname_tb(nfile) = filename1 - else - ! check if netcdf4 files are available for multiple input files - ! here 0x is the input file sequence number - ! do not confuse it with fgat time slot index - do i = 1, nfile_max - write(filename1,fmt='(A,A,I2.2,A)') trim(infile),'-',i - inquire (file=filename1, exist=fexist) - if ( fexist ) then - nfile = nfile + 1 - fname_tb(nfile) = filename1 - fname_clp(nfile) = filename2 - else - exit - end if - end do - end if - - if ( nfile == 0 ) then - call da_warning(__FILE__,__LINE__, & - (/"No valid AHI file found."/)) - if (trace_use) call da_trace_exit("da_read_obs_netcdf4ahi_geocat") - return - end if - - - !open the data area info file - open(unit=1990,file='ahi_info',status='old',iostat=iret) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__,(/"area_info file read error"/)) - endif - !read date information - read(1990,*) - read(1990,*) - read(1990,*) - read(1990,*) - read(1990,*) - read(1990,*) lonstart,latstart,nlongitude,nlatitude - close(1990) - - write(*,*) lonstart,latstart,nlongitude,nlatitude - - infile_loop: do ifile = 1, nfile - num_ahi_file_local = 0 - num_ahi_local_local = 0 - num_ahi_global_local = 0 - - ! open NETCDF4 L1 file for read - iret = nf90_open(fname_tb(ifile), nf90_NOWRITE, ncid) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"Cannot open NETCDF4 file "//trim(fname_tb(ifile))/)) - cycle infile_loop - endif - - ! read array: time - iret = nf90_get_att(ncid, nf90_global, "Image_Date_Time", filename) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"NETCDF4 read error for: observation date"/)) - end if - read(filename,"(I4,A1,I2,A1,I2,A1,I2,A1,I2,A1,I2,A1)") idate5(1),str_tmp,idate5(2),str_tmp,& - idate5(3),str_tmp,idate5(4),str_tmp,idate5(5),str_tmp,idate5(6),str_tmp - write(unit=stdout,fmt=*)'observation date: ', idate5 - - ! read array: lat - ! read lat - iret = nf90_inq_varid(ncid, 'latitude', latid) - allocate(vlatitude(nlongitude,nlatitude)) - iret = nf90_get_var(ncid,latid,vlatitude,start=(/lonstart,latstart/), & - count=(/nlongitude,nlatitude/)) ! - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"NETCDF4 read error for: Latitude of Observation Point"/)) - endif - ! sample display - write(unit=stdout,fmt=*)'vlatitude(pixel=1,scan=1): ',vlatitude(1,1) - - ! read lon - iret = nf90_inq_varid(ncid, 'longitude', lonid) - allocate(vlongitude(nlongitude,nlatitude)) - iret = nf90_get_var(ncid,lonid,vlongitude,start=(/lonstart,latstart/), & - count=(/nlongitude,nlatitude/)) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"NETCDF4 read error for: Longitude of Observation Point"/)) - call da_trace_exit("da_read_obs_netcdf4ahi_geocat") - endif - ! sample display - write(unit=stdout,fmt=*)'vlongitude(pixel=1,scan=1): ',vlongitude(1,1) - - ! read array: tb for band 7-16 - allocate(tbb(nlongitude,nlatitude,nchan)) - iret = nf90_inq_varid(ncid, "BT", tbb_id) - iret = nf90_get_var(ncid,tbb_id,tbb,start=(/lonstart,latstart,1/), & - count=(/nlongitude,nlatitude,10/)) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"NETCDF4 read error for: Brightness Temperature"/)) - endif - ! sample display - do k=1,10 - write(unit=stdout,fmt=*) 'tbb(pixel=1,scan=1,chan=',k,'): ', tbb(1,1,k) - enddo - - ! read array: satellite zenith angle - ! read - iret = nf90_inq_varid(ncid, 'satZenith', sazid) - allocate(sat_zenith(nlongitude,nlatitude)) - iret = nf90_get_var(ncid,sazid,sat_zenith,start=(/lonstart,latstart/), & - count=(/nlongitude,nlatitude/)) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"NETCDF4 read error for: satellite zenith angle"/)) - endif - ! sample display - write(unit=stdout,fmt=*) 'satellite zenith angle(pixel=1,scan=1): ',sat_zenith(1,1) - - ! read array: sun zenith angle - iret = nf90_inq_varid(ncid, 'sunZenith', sazid) - allocate(sun_zenith(nlongitude,nlatitude)) - iret = nf90_get_var(ncid,sozid,sun_zenith,start=(/lonstart,latstart/), & - count=(/nlongitude,nlatitude/)) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"NETCDF4 read error for: sun zenith angle"/)) - endif - ! sample display - write(unit=stdout,fmt=*) 'sun zenith angle(pixel=1,scan=1): ',sun_zenith(1,1) - - ! read array: satellite zenith angle - iret = nf90_inq_varid(ncid, 'cloudmask', sazid) - allocate(cloud_mask(nlongitude,nlatitude)) - iret = nf90_get_var(ncid,cltyid,cloud_mask,start=(/lonstart,latstart/), & - count=(/nlongitude,nlatitude/)) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"NETCDF4 read error for: satellite zenith angle"/)) - endif - ! sample display - write(unit=stdout,fmt=*) 'cloud mask of origin (pixel=1,scan=1): ',cloud_mask(1,1) - - ! read array: cloud mask of Zhuge and Zou(2017) - iret = nf90_inq_varid(ncid, 'clm_zou', sazid) - allocate(cloud_zou(nlongitude,nlatitude)) - iret = nf90_get_var(ncid,cltyid,cloud_zou,start=(/lonstart,latstart/), & - count=(/nlongitude,nlatitude/)) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"NETCDF4 read error for: satellite zenith angle"/)) - endif - ! sample display - write(unit=stdout,fmt=*) 'cloud mask of zou (pixel=1,scan=1): ',cloud_zou(1,1) - - ! close infile_tb file - iret = nf90_close(ncid) - -! read tropopause temprature - iret = nf90_open("trop_ahi.nc", nf90_NOWRITE, ncid) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"Cannot open NETCDF4 tropopause temprature file "/)) - endif - iret = nf90_inq_varid(ncid, "AhiTrp", ttp_id) - allocate(tropo_temp(nlongitude,nlatitude)) - iret = nf90_get_var(ncid,ttp_id,tropo_temp) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"NETCDF4 read error for: Tropopause Temperature"/)) - endif - iret = nf90_close(ncid) - -! 2.0 Loop to read netcdf and assign information to a sequential structure -!------------------------------------------------------------------------- - - ! Allocate arrays to hold data - if ( .not. head_allocated ) then - allocate (head) - nullify ( head % next ) - p => head - head_allocated = .true. - end if - - ! start scan_loop - scan_loop: do ilatitude=1, nlatitude - - call da_get_julian_time(idate5(1),idate5(2),idate5(3),idate5(4),idate5(5),obs_time) - if ( obs_time < time_slots(0) .or. & - obs_time >= time_slots(num_fgat_time) ) cycle scan_loop - do ifgat=1,num_fgat_time - if ( obs_time >= time_slots(ifgat-1) .and. & - obs_time < time_slots(ifgat) ) exit - end do - - ! start fov_loop - fov_loop: do ilongitude=1, nlongitude - - if ( sat_zenith(ilongitude,ilatitude) > 65.0 ) cycle fov_loop - - num_ahi_file = num_ahi_file + 1 - num_ahi_file_local = num_ahi_file_local + 1 - info%lat = vlatitude(ilongitude,ilatitude) - info%lon = vlongitude(ilongitude,ilatitude) - - call da_llxy (info, loc, outside, outside_all) - if (outside_all) cycle fov_loop - - num_ahi_global = num_ahi_global + 1 - num_ahi_global_local = num_ahi_global_local + 1 - ptotal(ifgat) = ptotal(ifgat) + 1 - if (outside) cycle fov_loop ! No good for this PE - - num_ahi_local = num_ahi_local + 1 - num_ahi_local_local = num_ahi_local_local + 1 - write(unit=info%date_char, & - fmt='(i4.4,a,i2.2,a,i2.2,a,i2.2,a,i2.2,a,i2.2)') & - idate5(1), '-', idate5(2), '-', idate5(3), '_', idate5(4), & - ':', idate5(5), ':', idate5(6) - info%elv = 0.0 - -! 3.0 Make Thinning -! Map obs to thinning grid -!------------------------------------------------------------------- - if (thinning) then - dlat_earth = info%lat !degree - dlon_earth = info%lon - if (dlon_earth=r360) dlon_earth = dlon_earth-r360 - dlat_earth = dlat_earth*deg2rad !radian - dlon_earth = dlon_earth*deg2rad - crit = 1. - call map2grids(inst,ifgat,dlat_earth,dlon_earth,crit,iobs,itx,1,itt,iout,iuse) - if (.not. iuse) then - num_ahi_thinned = num_ahi_thinned+1 - cycle fov_loop - end if - end if - - num_ahi_used = num_ahi_used + 1 - data_all = missing_r - - do k=1,nchan - tb = tbb(ilongitude,ilatitude,k) - if( tb < tbmin .or. tb > tbmax ) tb = missing_r - data_all(k)= tb - enddo - -! 4.0 assign information to sequential radiance structure -!-------------------------------------------------------------------------- - allocate ( p % tb_inv (1:nchan )) - p%info = info - p%loc = loc - p%landsea_mask = 1 - p%scanpos = ilongitude !nint(sat_zenith(ilongitude,ilatitude))+1.001_r_kind ! - p%satzen = sat_zenith(ilongitude,ilatitude) - p%satazi = 0 - p%solzen = 0 - p%solazi = 0 - p%tb_inv(1:nchan) = data_all(1:nchan) - p%sensor_index = inst - p%ifgat = ifgat - p%cloudflag = cloud_mask(ilongitude,ilatitude) - - allocate (p%next) ! add next data - p => p%next - nullify (p%next) - end do fov_loop - end do scan_loop - - write(stdout,fmt='(3a,i10)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_file : ',num_ahi_file_local - write(stdout,fmt='(3a,i10)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_global : ',num_ahi_global_local - write(stdout,fmt='(3a,i10)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_local : ',num_ahi_local_local - end do infile_loop - - deallocate(data_all) ! Deallocate data arrays - !deallocate(cloudflag) - deallocate(vlatitude) - deallocate(vlongitude) - deallocate(tbb) - deallocate(sat_zenith) - if( got_clp_file ) deallocate(cloud_mask) - - if (thinning .and. num_ahi_global > 0 ) then -#ifdef DM_PARALLEL - ! Get minimum crit and associated processor index. - j = 0 - do ifgat = 1, num_fgat_time - j = j + thinning_grid(inst,ifgat)%itxmax - end do - - allocate ( in (j) ) - allocate ( out (j) ) - j = 0 - do ifgat = 1, num_fgat_time - do i = 1, thinning_grid(inst,ifgat)%itxmax - j = j + 1 - in(j) = thinning_grid(inst,ifgat)%score_crit(i) - end do - end do - call mpi_reduce(in, out, j, true_mpi_real, mpi_min, root, comm, ierr) - - call wrf_dm_bcast_real (out, j) - - j = 0 - do ifgat = 1, num_fgat_time - do i = 1, thinning_grid(inst,ifgat)%itxmax - j = j + 1 - if ( ABS(out(j)-thinning_grid(inst,ifgat)%score_crit(i)) > 1.0E-10 ) & - thinning_grid(inst,ifgat)%ibest_obs(i) = 0 - end do - end do - - deallocate( in ) - deallocate( out ) - -#endif - - ! Delete the nodes which being thinning out - p => head - prev => head - head_found = .false. - num_ahi_used_tmp = num_ahi_used - do j = 1, num_ahi_used_tmp - n = p%sensor_index - ifgat = p%ifgat - found = .false. - - do i = 1, thinning_grid(n,ifgat)%itxmax - if ( thinning_grid(n,ifgat)%ibest_obs(i) == j .and. thinning_grid(n,ifgat)%score_crit(i) < 9.99e6_r_kind ) then - found = .true. - exit - end if - end do - - ! free current data - if ( .not. found ) then - - current => p - p => p%next - - if ( head_found ) then - prev%next => p - else - head => p - prev => p - end if - - deallocate ( current % tb_inv ) - deallocate ( current ) - - num_ahi_thinned = num_ahi_thinned + 1 - num_ahi_used = num_ahi_used - 1 - continue - end if - - if ( found .and. head_found ) then - prev => p - p => p%next - continue - end if - - if ( found .and. .not. head_found ) then - head_found = .true. - head => p - prev => p - p => p%next - end if - - end do - end if ! End of thinning - - iv%total_rad_pixel = iv%total_rad_pixel + num_ahi_used - iv%total_rad_channel = iv%total_rad_channel + num_ahi_used*nchan - - iv%info(radiance)%nlocal = iv%info(radiance)%nlocal + num_ahi_used - iv%info(radiance)%ntotal = iv%info(radiance)%ntotal + num_ahi_global - - do i = 1, num_fgat_time - ptotal(i) = ptotal(i) + ptotal(i-1) - iv%info(radiance)%ptotal(i) = iv%info(radiance)%ptotal(i) + ptotal(i) - end do - if ( iv%info(radiance)%ptotal(num_fgat_time) /= iv%info(radiance)%ntotal ) then - write(unit=message(1),fmt='(A,I10,A,I10)') & - "Number of ntotal:",iv%info(radiance)%ntotal," is different from the sum of ptotal:", iv%info(radiance)%ptotal(num_fgat_time) - call da_warning(__FILE__,__LINE__,message(1:1)) - endif - - write(unit=stdout,fmt='(a)') 'AHI data counts: ' - write(stdout,fmt='(a,i10)') ' In file: ',num_ahi_file - write(stdout,fmt='(a,i10)') ' Global : ',num_ahi_global - write(stdout,fmt='(a,i10)') ' Local : ',num_ahi_local - write(stdout,fmt='(a,i10)') ' Used : ',num_ahi_used - write(stdout,fmt='(a,i10)') ' Thinned: ',num_ahi_thinned - -! 5.0 allocate innovation radiance structure -!---------------------------------------------------------------- - - if (num_ahi_used > 0) then - iv%instid(inst)%num_rad = num_ahi_used - iv%instid(inst)%info%nlocal = num_ahi_used - write(UNIT=stdout,FMT='(a,i3,2x,a,3x,i10)') & - 'Allocating space for radiance innov structure', & - inst, iv%instid(inst)%rttovid_string, iv%instid(inst)%num_rad - call da_allocate_rad_iv (inst, nchan, iv) - end if - -! 6.0 assign sequential structure to innovation structure -!------------------------------------------------------------- - p => head - - do n = 1, num_ahi_used - i = p%sensor_index - call da_initialize_rad_iv (i, n, iv, p) - current => p - p => p%next - ! free current data - deallocate ( current % tb_inv ) - deallocate ( current ) - end do - deallocate ( p ) - deallocate (ptotal) - - if (trace_use) call da_trace_exit("da_read_obs_netcdf4ahi_geocat") - -end subroutine da_read_obs_netcdf4ahi_geocat diff --git a/var/da/da_radiance/log b/var/da/da_radiance/log deleted file mode 100644 index c88f635743..0000000000 --- a/var/da/da_radiance/log +++ /dev/null @@ -1,76 +0,0 @@ -da_crtm.f:48: use da_tools, only: da_get_time_slots, da_eof_decomposition -da_crtm.f:1950: call da_eof_decomposition(nclouds, hessian, eignvec, eignval) -da_gen_be.f:5065:subroutine da_eof_decomposition (kz, bx, e, l) -da_gen_be.f:5089: if (trace_use) call da_trace_entry("da_eof_decomposition") -da_gen_be.f:5104: call da_error("da_eof_decomposition.inc",40,message(1:1)) -da_gen_be.f:5114: if (trace_use) call da_trace_exit("da_eof_decomposition") -da_gen_be.f:5116:end subroutine da_eof_decomposition -da_gen_be.f:5119:subroutine da_eof_decomposition_test (kz, bx, e, l) -da_gen_be.f:5145: if (trace_use) call da_trace_entry("da_eof_decomposition_test") -da_gen_be.f:5239: if (trace_use) call da_trace_exit("da_eof_decomposition_test") -da_gen_be.f:5241:end subroutine da_eof_decomposition_test -da_radiance1.f:27: use da_tools, only : da_residual_new, da_eof_decomposition -da_radiance1.f:1018:!!! call da_eof_decomposition(ndim, hessian, eignvec, eignval) -da_setup_structures.f:92: use da_vtox_transforms, only : da_check_eof_decomposition -da_setup_structures.f:1368: call da_check_eof_decomposition(be%v1%val_g(:), be%v1%evec_g(:,:),& -da_setup_structures.f:1370: call da_check_eof_decomposition(be%v2%val_g(:), be%v2%evec_g(:,:),& -da_setup_structures.f:1372: call da_check_eof_decomposition(be%v3%val_g(:), be%v3%evec_g(:,:),& -da_setup_structures.f:1374: call da_check_eof_decomposition(be%v4%val_g(:), be%v4%evec_g(:,:),& -da_setup_structures.f:3702: call da_check_eof_decomposition(be1_eval_glo(:), be1_evec_glo(:,:), be % v1 % name) -da_setup_structures.f:3703: call da_check_eof_decomposition(be2_eval_glo(:), be2_evec_glo(:,:), be % v2 % name) -da_setup_structures.f:3704: call da_check_eof_decomposition(be3_eval_glo(:), be3_evec_glo(:,:), be % v3 % name) -da_setup_structures.f:3705: call da_check_eof_decomposition(be4_eval_glo(:), be4_evec_glo(:,:), be % v4 % name) -da_setup_structures.f:3708: call da_check_eof_decomposition(be6_eval_glo(:), be6_evec_glo(:,:), be % v6 % name) -da_setup_structures.f:3709: call da_check_eof_decomposition(be7_eval_glo(:), be7_evec_glo(:,:), be % v7 % name) -da_setup_structures.f:3710: call da_check_eof_decomposition(be8_eval_glo(:), be8_evec_glo(:,:), be % v8 % name) -da_setup_structures.f:3711: call da_check_eof_decomposition(be9_eval_glo(:), be9_evec_glo(:,:), be % v9 % name) -da_setup_structures.f:3712: call da_check_eof_decomposition(be10_eval_glo(:), be10_evec_glo(:,:), be % v10 % name) -da_setup_structures.f:3716: call da_check_eof_decomposition(be11_eval_glo(:), be11_evec_glo(:,:), be % v11 % name) -da_setup_structures.f:3917: call da_check_eof_decomposition(be%v1%val_g(:), be%v1%evec_g(:,:),& -da_setup_structures.f:3919: call da_check_eof_decomposition(be%v2%val_g(:), be%v2%evec_g(:,:),& -da_setup_structures.f:3921: call da_check_eof_decomposition(be%v3%val_g(:), be%v3%evec_g(:,:),& -da_setup_structures.f:3923: call da_check_eof_decomposition(be%v4%val_g(:), be%v4%evec_g(:,:),& -da_setup_structures.f:3927: call da_check_eof_decomposition(be%v6%val_g(:), be%v6%evec_g(:,:),& -da_setup_structures.f:3929: call da_check_eof_decomposition(be%v7%val_g(:), be%v7%evec_g(:,:),& -da_setup_structures.f:3931: call da_check_eof_decomposition(be%v8%val_g(:), be%v8%evec_g(:,:),& -da_setup_structures.f:3933: call da_check_eof_decomposition(be%v9%val_g(:), be%v9%evec_g(:,:),& -da_setup_structures.f:3935: call da_check_eof_decomposition(be%v10%val_g(:), be%v10%evec_g(:,:),& -da_setup_structures.f:3939: call da_check_eof_decomposition(be%v11%val_g(:), be%v11%evec_g(:,:),& -da_setup_structures.f:4719: call da_check_eof_decomposition(be1_eval_glo(:), be1_evec_glo(:,:), be % v1 % name) -da_setup_structures.f:4720: call da_check_eof_decomposition(be2_eval_glo(:), be2_evec_glo(:,:), be % v2 % name) -da_setup_structures.f:4721: call da_check_eof_decomposition(be3_eval_glo(:), be3_evec_glo(:,:), be % v3 % name) -da_setup_structures.f:4722: call da_check_eof_decomposition(be4_eval_glo(:), be4_evec_glo(:,:), be % v4 % name) -da_setup_structures.f:4824: call da_check_eof_decomposition(be%v1%val_g(:), be%v1%evec_g(:,:),& -da_setup_structures.f:4826: call da_check_eof_decomposition(be%v2%val_g(:), be%v2%evec_g(:,:),& -da_setup_structures.f:4828: call da_check_eof_decomposition(be%v3%val_g(:), be%v3%evec_g(:,:),& -da_setup_structures.f:4830: call da_check_eof_decomposition(be%v4%val_g(:), be%v4%evec_g(:,:),& -da_tools.f:4091:subroutine da_eof_decomposition_test (kz, bx, e, l) -da_tools.f:4117: if (trace_use) call da_trace_entry("da_eof_decomposition_test") -da_tools.f:4211: if (trace_use) call da_trace_exit("da_eof_decomposition_test") -da_tools.f:4213:end subroutine da_eof_decomposition_test -da_tools.f:4216:subroutine da_eof_decomposition (kz, bx, e, l) -da_tools.f:4240: if (trace_use) call da_trace_entry("da_eof_decomposition") -da_tools.f:4255: call da_error("da_eof_decomposition.inc",40,message(1:1)) -da_tools.f:4265: if (trace_use) call da_trace_exit("da_eof_decomposition") -da_tools.f:4267:end subroutine da_eof_decomposition -da_varbc.f:18: use da_tools, only : da_eof_decomposition -da_varbc.f:578: call da_eof_decomposition(npred, hessian(1:npred,1:npred), & -da_vtox_transforms.f:166:subroutine da_check_eof_decomposition(be_eigenval, be_eigenvec, name) -da_vtox_transforms.f:192: if (trace_use) call da_trace_entry("da_check_eof_decomposition") -da_vtox_transforms.f:277: if (trace_use) call da_trace_exit("da_check_eof_decomposition") -da_vtox_transforms.f:279:end subroutine da_check_eof_decomposition -gen_be_stage2_1dvar.f:13: use da_gen_be, only : da_eof_decomposition, da_eof_decomposition_test -gen_be_stage2_1dvar.f:561: call da_eof_decomposition( nk, be, evec, eval ) -gen_be_stage2_1dvar.f:565: call da_eof_decomposition_test( nk, be, evec, eval ) -gen_be_stage2.f:6: use da_gen_be, only : da_eof_decomposition,da_eof_decomposition_test -gen_be_stage2.f:290: call da_eof_decomposition( nk, work, evec, eval ) -gen_be_stage2.f:293: call da_eof_decomposition_test( nk, work, evec, eval ) -gen_be_stage3.f:4: use da_gen_be, only : da_eof_decomposition_test, da_eof_decomposition, & -gen_be_stage3.f:229: call da_eof_decomposition( nk, work, e_vec, e_val ) -gen_be_stage3.f:241: call da_eof_decomposition( nk, work, e_vec, e_val ) -gen_be_stage3.f:244: call da_eof_decomposition_test( nk, work, e_vec, e_val ) -gen_be_vertloc.f:3: use da_gen_be, only : da_eof_decomposition -gen_be_vertloc.f:88: call da_eof_decomposition( nk, cov, evec, eval ) -gen_mbe_stage2.f:1369: use da_gen_be, only : da_eof_decomposition,da_eof_decomposition_test -gen_mbe_stage2.f:1410: call da_eof_decomposition( nk, work, evec, eval ) -gen_mbe_stage2.f:1413: call da_eof_decomposition_test( nk, work, evec, eval ) From 056ea637dd62a8b33c63d569208b449bc23a8d22 Mon Sep 17 00:00:00 2001 From: liujake Date: Tue, 17 Nov 2020 23:18:37 -0700 Subject: [PATCH 49/91] modified: Registry/registry.var --- Registry/registry.var | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/Registry/registry.var b/Registry/registry.var index fcd86aa6bc..277767c0d2 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -189,7 +189,6 @@ rconfig logical use_hsbobs namelist,wrfvar4 1 .false. - "use rconfig logical use_ssmisobs namelist,wrfvar4 1 .false. - "use_ssmisobs" "" "" rconfig logical use_iasiobs namelist,wrfvar4 1 .false. - "use_iasiobs" "" "" rconfig logical use_ahiobs namelist,wrfvar4 1 .false. - "use_ahiobs" "" "" -#wuyl rconfig logical use_seviriobs namelist,wrfvar4 1 .false. - "use_seviriobs" "" "" rconfig logical use_amsr2obs namelist,wrfvar4 1 .false. - "use_amsr2obs" "" "" rconfig logical use_ahiobs namelist,wrfvar4 1 .false. - "use_ahiobs" "" "" @@ -269,7 +268,7 @@ rconfig integer tovs_end namelist,wrfvar5 1 10000000 - "tov rconfig logical gpsref_thinning namelist,wrfvar5 1 .false. - "gpsref_thinning" "" "" rconfig logical outer_loop_restart namelist,wrfvar6 1 .false. - "outer_loop_restart" "" "" rconfig integer max_ext_its namelist,wrfvar6 1 1 - "max_ext_its" "" "" -rconfig integer ntmax namelist,wrfvar6 max_outer_iterations 200 - "ntmax" "" "" +rconfig integer ntmax namelist,wrfvar6 max_outer_iterations 75 - "ntmax" "" "" rconfig logical use_inverse_squarerootb namelist,wrfvar6 1 .false. - "use_inverse_squarerootb" "" "" rconfig logical use_interpolate_cvt namelist,wrfvar6 1 .false. - "use_interpolate_cvt" "" "" rconfig integer nsave namelist,wrfvar6 1 4 - "nsave" "" "" @@ -435,7 +434,6 @@ rconfig integer tovs_min_transfer namelist,wrfvar14 1 10 - "to rconfig logical tovs_batch namelist,wrfvar14 1 .false. - "tovs_batch" "" "" rconfig integer rtm_option namelist,wrfvar14 1 1 - "rtm_option" "" "" rconfig integer varbc_scan namelist,wrfvar14 1 1 - "varbc_scan" "" "" -#wuyl rconfig logical use_crtm_kmatrix namelist,wrfvar14 1 .true. - "use_crtm_kmatrix" "" "" rconfig logical use_rttov_kmatrix namelist,wrfvar14 1 .false. - "use_rttov_kmatrix" "" "" rconfig logical crtm_cloud namelist,wrfvar14 1 .false. - "crtm_cloud" "" "" From d1fcfdf17ad5a6a37200beeab7c751d16cc58b79 Mon Sep 17 00:00:00 2001 From: liujake Date: Fri, 27 Nov 2020 13:09:48 -0700 Subject: [PATCH 50/91] On branch latest_develop_mri4dvar modified: var/build/gen_be.make modified: var/gen_be/Makefile renamed: var/gen_be/gen_be_ep2_serial.f90 -> var/gen_be/gen_be_ep2.f90 --- var/build/gen_be.make | 22 +- var/gen_be/Makefile | 12 +- var/gen_be/gen_be_ep2.f90 | 1097 ++++++++++++++++-------------- var/gen_be/gen_be_ep2_serial.f90 | 626 ----------------- 4 files changed, 581 insertions(+), 1176 deletions(-) delete mode 100644 var/gen_be/gen_be_ep2_serial.f90 diff --git a/var/build/gen_be.make b/var/build/gen_be.make index 26cacdcc3f..8f33449698 100644 --- a/var/build/gen_be.make +++ b/var/build/gen_be.make @@ -23,7 +23,6 @@ be : \ gen_be_stage0_gsi.exe \ gen_be_ep1.exe \ gen_be_ep2.exe \ - gen_be_ep2_serial.exe \ gen_be_stage1.exe \ gen_be_vertloc.exe \ gen_be_addmean.exe \ @@ -101,28 +100,19 @@ gen_be_ep1.exe : gen_be_ep1.o $(GEN_BE_OBJS) $(GEN_BE_LIBS) $(SFC) -o gen_be_ep1.exe $(LDFLAGS) $(GEN_BE_OBJS) gen_be_ep1.o $(GEN_BE_LIB) @ if test -x $@ ; then cd ../da; $(LN) ../build/$@ . ; fi -gen_be_ep2_serial.exe: gen_be_ep2_serial.o $(GEN_BE_OBJS) $(GEN_BE_LIBS) +gen_be_ep2.exe : gen_be_ep2.o $(GEN_BE_OBJS) $(GEN_BE_LIBS) $(RM) $@ - $(SED_FTN) gen_be_ep2_serial.f90 > gen_be_ep2_serial.b + $(SED_FTN) gen_be_ep2.f90 > gen_be_ep2.b x=`echo "$(SFC)" | awk '{print $$1}'` ; export x ; \ if [ $$x = "gfortran" ] ; then \ echo removing external declaration of iargc for gfortran ; \ - $(CPP) $(CPPFLAGS) $(FPPFLAGS) gen_be_ep2_serial.b | sed '/integer *, *external.*iargc/d' > gen_be_ep2_serial.f ;\ + $(CPP) $(CPPFLAGS) $(FPPFLAGS) gen_be_ep2.b | sed '/integer *, *external.*iargc/d' > gen_be_ep2.f ;\ else \ - $(CPP) $(CPPFLAGS) $(FPPFLAGS) gen_be_ep2_serial.b > gen_be_ep2_serial.f ; \ + $(CPP) $(CPPFLAGS) $(FPPFLAGS) gen_be_ep2.b > gen_be_ep2.f ; \ fi - $(RM) gen_be_ep2_serial.b - $(SFC) -c $(FCFLAGS) $(PROMOTION) gen_be_ep2_serial.f - $(SFC) -o gen_be_ep2_serial.exe $(LDFLAGS) $(GEN_BE_OBJS) gen_be_ep2_serial.o $(GEN_BE_LIB) - @ if test -x $@ ; then cd ../da; $(LN) ../build/$@ . ; fi - -gen_be_ep2.exe : gen_be_ep2.o $(GEN_BE_OBJS) $(GEN_BE_LIBS) - $(RM) $@ - $(SED_FTN) gen_be_ep2.f90 > gen_be_ep2.b - $(CPP) $(CPPFLAGS) $(FPPFLAGS) gen_be_ep2.b > gen_be_ep2.f ; \ $(RM) gen_be_ep2.b - $(FC) -c $(FCFLAGS) $(PROMOTION) gen_be_ep2.f - $(FC) -o gen_be_ep2.exe $(LDFLAGS) $(GEN_BE_OBJS) gen_be_ep2.o $(GEN_BE_LIB) + $(SFC) -c $(FCFLAGS) $(PROMOTION) gen_be_ep2.f + $(SFC) -o gen_be_ep2.exe $(LDFLAGS) $(GEN_BE_OBJS) gen_be_ep2.o $(GEN_BE_LIB) @ if test -x $@ ; then cd ../da; $(LN) ../build/$@ . ; fi gen_be_stage1.exe : gen_be_stage1.o $(GEN_BE_OBJS) $(GEN_BE_LIBS) diff --git a/var/gen_be/Makefile b/var/gen_be/Makefile index ae32ed090a..208c34d13a 100644 --- a/var/gen_be/Makefile +++ b/var/gen_be/Makefile @@ -13,7 +13,6 @@ gen_be : gen_be_ensrf.exe \ gen_be_stage0_wrf.exe \ gen_be_ep1.exe \ gen_be_ep2.exe \ - gen_be_ep2_serial.exe \ gen_be_vertloc.exe \ gen_be_addmean.exe gen_be_stage1.exe \ @@ -60,15 +59,10 @@ gen_be_ep1.exe : gen_be_ep1.f90 $(GEN_BE_OBJS) $(GEN_BE_LIBS) $(SFC) -c $(FCFLAGS) -I../da $(MODULE_DIRS) $(WRFVAR_INC) $(PROMOTION) gen_be_ep1.f $(SFC) -o gen_be_ep1.exe $(LDFLAGS) $(GEN_BE_OBJS) gen_be_ep1.o $(GEN_BE_LIB) -gen_be_ep2_serial.exe : gen_be_ep2_serial.f90 $(GEN_BE_OBJS) $(GEN_BE_LIBS) - $(CPP) $(CPPFLAGS) -I$(WRF_SRC_ROOT_DIR)/inc gen_be_ep2_serial.f90 > gen_be_ep2_serial.f - $(SFC) -c $(FCFLAGS) -I../da $(MODULE_DIRS) $(WRFVAR_INC) $(PROMOTION) gen_be_ep2_serial.f - $(SFC) -o gen_be_ep2_serial.exe $(LDFLAGS) $(GEN_BE_OBJS) gen_be_ep2_serial.o $(GEN_BE_LIB) - -gen_be_ep2.exe : gen_be_ep2.f90 $(GEN_BE_OBJS) $(GEN_BE_LIBS) +gen_be_ep2.exe : gen_be_ep2.f90 $(GEN_BE_OBJS) $(GEN_BE_LIBS) $(CPP) $(CPPFLAGS) -I$(WRF_SRC_ROOT_DIR)/inc gen_be_ep2.f90 > gen_be_ep2.f - $(FC) -c $(FCFLAGS) -I../da $(MODULE_DIRS) $(WRFVAR_INC) $(PROMOTION) gen_be_ep2.f - $(FC) -o gen_be_ep2.exe $(LDFLAGS) $(GEN_BE_OBJS) gen_be_ep2.o $(GEN_BE_LIB) + $(SFC) -c $(FCFLAGS) -I../da $(MODULE_DIRS) $(WRFVAR_INC) $(PROMOTION) gen_be_ep2.f + $(SFC) -o gen_be_ep2.exe $(LDFLAGS) $(GEN_BE_OBJS) gen_be_ep2.o $(GEN_BE_LIB) gen_be_vertloc.exe : gen_be_vertloc.f90 $(GEN_BE_OBJS) $(GEN_BE_LIBS) $(CPP) $(CPPFLAGS) -I$(WRF_SRC_ROOT_DIR)/inc gen_be_vertloc.f90 > gen_be_vertloc.f diff --git a/var/gen_be/gen_be_ep2.f90 b/var/gen_be/gen_be_ep2.f90 index 4292bb3c04..d9e15238a4 100644 --- a/var/gen_be/gen_be_ep2.f90 +++ b/var/gen_be/gen_be_ep2.f90 @@ -1,579 +1,626 @@ program gen_be_ep2 +! +!---------------------------------------------------------------------- +! Purpose : To convert WRF ensemble to format required for use as +! flow-dependent perturbations in WRF-Var (alpha control variable, +! alphacv_method = 2). +! +! Dale Barker (NCAR/MMM) January 2007 +! Arthur P. Mizzi (NCAR/MMM) February 2011 Modified to use .vari extension for +! ensemble variance file output from +! gen_be_ensmean.f90 +! +!---------------------------------------------------------------------- -!----------------------------------------------------------------------- -! Purpose: To convert WRF ensemble to format required for use as -! flow-dependent perturbations in WRFDA (alpha control variable, -! alphacv_method = 2). -! History: -! March 2017 - Creation Jamie Bresch -! new parallelized code to replace the previous gen_be_ep2 -! (now named gen_be_ep2_serial.f90) -!----------------------------------------------------------------------- - - implicit none - -#ifdef DM_PARALLEL - include 'mpif.h' -#if ( DWORDSIZE != RWORDSIZE ) - integer, parameter :: true_mpi_real = mpi_real -#else - integer, parameter :: true_mpi_real = mpi_real8 -#endif +#ifdef crayx1 +#define iargc ipxfargc #endif - integer, parameter :: DateStrLen = 19 !as in wrf_io.F - integer, parameter :: VarNameLen = 31 !as in wrf_io.F - integer, parameter :: stdout = 6 - integer, parameter :: root = 0 - integer, parameter :: nvar_max = 10 - real, parameter :: t00 = 300.0 - real, parameter :: p00 = 100000.0 - real, parameter :: gas_constant = 287.0 - real, parameter :: cp = 7.0*gas_constant/2.0 - real, parameter :: kappa = gas_constant/cp - - logical :: remove_mean = .true. - logical :: alpha_hydrometeors = .true. - logical :: write_mean_stdv = .true. - - type xdata_type - character(len=VarNameLen) :: name - real, allocatable :: value(:,:,:,:) - real, allocatable :: mean(:,:,:) - real, allocatable :: mnsq(:,:,:) !mean square - real, allocatable :: stdv(:,:,:) - end type xdata_type - type (xdata_type), allocatable :: xdata(:) - - character(len=VarNameLen) :: varnames(nvar_max) - character(len=VarNameLen) :: fnames(nvar_max) - - ! argument variables - character(len=512) :: directory, filename - character(len=VarNameLen) :: cvar - character(len=10) :: cdate10 - character(len=3) :: cne - integer :: numarg - integer :: icode - - integer :: num_procs, myproc - integer :: ounit - integer :: nvar, nens, iv, ivar, ie - integer :: i, j, k, ijk - integer :: ni, ni1, nj, nj1, nk - integer :: mp_physics - real :: ens_inv - - character(len=512) :: input_file, output_file - character(len=3) :: ce - - character(len=80), dimension(3) :: dimnames - character(len=4) :: staggering=' N/A' !dummy - character(len=3) :: ordering - character(len=DateStrLen) :: DateStr - character(len=VarNameLen) :: varname - integer, dimension(4) :: start_index, end_index - integer :: fid, ierr, ndim, wrftype - integer :: icnt - - integer :: avail(nvar_max) - integer :: readit(nvar_max) - integer, allocatable :: istart(:), iend(:) - integer, allocatable :: ncount(:), displs(:) - - real*4, allocatable :: pp(:,:,:) ! WRF perturbation P - real*4, allocatable :: pb(:,:,:) ! WRF base P - real*4, allocatable :: xfield(:,:,:) - real*4, allocatable :: xfield_u(:,:,:) - real*4, allocatable :: xfield_v(:,:,:) - - real, allocatable :: globuf(:,:,:,:) - real, allocatable :: globuf1d(:) - real, allocatable :: tmp1d(:) - -#ifdef DM_PARALLEL - call mpi_init(ierr) - call mpi_comm_size(mpi_comm_world,num_procs,ierr) - call mpi_comm_rank(mpi_comm_world,myproc,ierr) -#else - num_procs = 1 - myproc = 0 -#endif + use da_control, only : stderr, stdout, filename_len + use da_tools_serial, only : da_get_unit, da_free_unit + use da_gen_be, only : da_stage0_initialize, da_get_field, da_get_trh + + implicit none - ! variable names in wrfout files - varnames = (/ 'U ', 'V ', 'T ', 'QVAPOR', 'PSFC ', & - 'QCLOUD', 'QRAIN ', 'QICE ', 'QSNOW ', 'QGRAUP' /) - - ! variable names for output - fnames = (/ 'u ', 'v ', 't ', 'q ', 'ps ', & - 'qcloud', 'qrain ', 'qice ', 'qsnow ', 'qgraup' /) - - numarg = command_argument_count() - if ( numarg /= 4 .and. numarg /= 5 )then - write(stdout,FMT='(a)') & - "Usage: gen_be_ep2.exe date ne directory filename [varname]" -#ifdef DM_PARALLEL - call mpi_abort(mpi_comm_world,1,ierr) -#else + character (len=filename_len) :: directory ! General filename stub. + character (len=filename_len) :: filename ! General filename stub. + character (len=filename_len) :: input_file ! Input file. + character (len=filename_len) :: output_file ! Output file. + character (len=10) :: date ! Character date. + character (len=10) :: var ! Variable to search for. + character (len=3) :: cne ! Ensemble size. + character (len=3) :: ce ! Member index -> character. + character (len=filename_len) :: moist_string + + integer, external :: iargc + integer :: numarg + integer :: ne ! Ensemble size. + integer :: i, j, k, member ! Loop counters. + integer :: dim1 ! Dimensions of grid (T points). + integer :: dim1s ! Dimensions of grid (vor/psi pts). + integer :: dim2 ! Dimensions of grid (T points). + integer :: dim2s ! Dimensions of grid (vor/psi pts). + integer :: dim3 ! Dimensions of grid (T points). + integer :: mp_physics ! microphysics option + real :: member_inv ! 1 / member. + real :: ds ! Grid resolution. + logical :: remove_mean ! Remove mean from standard fields. + logical :: has_cloud, has_rain, has_ice, has_snow, has_graup + + real, allocatable :: u(:,:,:) ! u-wind. + real, allocatable :: v(:,:,:) ! v-wind. + real, allocatable :: temp(:,:,:) ! Temperature. + real, allocatable :: q(:,:,:) ! Specific humidity. + real, allocatable :: qcloud(:,:,:) ! Cloud. + real, allocatable :: qrain(:,:,:) ! Rain. + real, allocatable :: qice(:,:,:) ! ice + real, allocatable :: qsnow(:,:,:) ! snow + real, allocatable :: qgraup(:,:,:) ! graupel + real, allocatable :: psfc(:,:) ! Surface pressure. + real, allocatable :: u_mean(:,:,:) ! u-wind. + real, allocatable :: v_mean(:,:,:) ! v-wind. + real, allocatable :: temp_mean(:,:,:) ! Temperature. + real, allocatable :: q_mean(:,:,:) ! Specific humidity. + real, allocatable :: qcloud_mean(:,:,:) ! Cloud. + real, allocatable :: qrain_mean(:,:,:) ! Rain. + real, allocatable :: qice_mean(:,:,:) ! ice + real, allocatable :: qsnow_mean(:,:,:) ! snow + real, allocatable :: qgraup_mean(:,:,:) ! graupel + real, allocatable :: psfc_mean(:,:) ! Surface pressure. + real, allocatable :: u_mnsq(:,:,:) ! u-wind. + real, allocatable :: v_mnsq(:,:,:) ! v-wind. + real, allocatable :: temp_mnsq(:,:,:) ! Temperature. + real, allocatable :: q_mnsq(:,:,:) ! Specific humidity. + real, allocatable :: qcloud_mnsq(:,:,:) ! Cloud. + real, allocatable :: qrain_mnsq(:,:,:) ! Rain. + real, allocatable :: qice_mnsq(:,:,:) ! ice + real, allocatable :: qsnow_mnsq(:,:,:) ! snow + real, allocatable :: qgraup_mnsq(:,:,:) ! graupel + real, allocatable :: psfc_mnsq(:,:) ! Surface pressure. + + real, allocatable :: utmp(:,:) ! u-wind. + real, allocatable :: vtmp(:,:) ! v-wind. + real, allocatable :: ttmp(:,:) ! temperature. + real, allocatable :: dummy(:,:) ! dummy. + + integer :: gen_be_iunit, gen_be_ounit + + stderr = 0 + stdout = 6 + +!--------------------------------------------------------------------------------------------- + write(6,'(/a)')' [1] Initialize information.' +!--------------------------------------------------------------------------------------------- + + call da_get_unit(gen_be_iunit) + call da_get_unit(gen_be_ounit) + + remove_mean = .true. + + numarg = iargc() + if ( numarg /= 4 )then + write(UNIT=6,FMT='(a)') & + "Usage: gen_be_ep2 date ne Stop" stop -#endif end if - ! initialze argument variables - cdate10 = "" - cne = "" - directory = "" - filename = "" - cvar = "" - - call get_command_argument(number=1, value=cdate10) - call get_command_argument(number=2, value=cne) - read(cne,'(i3)') nens - call get_command_argument(number=3, value=directory) - call get_command_argument(number=4, value=filename) - if ( numarg == 5 ) then - call get_command_argument(number=5, value=cvar) - ! convert cvar to be in lowercase - do i = 1, len_trim(cvar) - icode = ichar(cvar(i:i)) - if (icode>=65 .and. icode<=90) then - cvar(i:i) = char(icode + 97 - 65) - end if - end do + ! Initialse to stop Cray compiler complaining + date="" + cne="" + directory="" + filename="" + + call getarg( 1, date ) + call getarg( 2, cne ) + read(cne,'(i3)')ne + call getarg( 3, directory ) + call getarg( 4, filename ) + + if ( remove_mean ) then + write(6,'(a,a)')' Computing gen_be ensemble perturbation files for date ', date else - cvar = 'all' + write(6,'(a,a)')' Computing gen_be ensemble forecast files for date ', date end if + write(6,'(a)')' Perturbations are in MODEL SPACE (u, v, t, q, ps)' + write(6,'(a,i4)')' Ensemble Size = ', ne + write(6,'(a,a)')' Directory = ', trim(directory) + write(6,'(a,a)')' Filename = ', trim(filename) - if ( myproc == root ) then - if ( remove_mean ) then - write(stdout,'(a,a)')' Computing gen_be ensemble perturbation files for date ', cdate10 - else - write(stdout,'(a,a)')' Computing gen_be ensemble forecast files for date ', cdate10 +!--------------------------------------------------------------------------------------------- + write(6,'(/a)')' [2] Set up data dimensions and allocate arrays:' +!--------------------------------------------------------------------------------------------- + +! Get grid dimensions from first T field: + var = "T" + input_file = trim(directory)//'/'//trim(filename)//'.e001' + call da_stage0_initialize( input_file, var, dim1, dim2, dim3, ds, mp_physics ) + dim1s = dim1+1 ! u i dimension is 1 larger. + dim2s = dim2+1 ! v j dimension is 1 larger. + +! Allocate arrays in output fields: + allocate( u(1:dim1,1:dim2,1:dim3) ) ! Note - interpolated to mass pts for output. + allocate( v(1:dim1,1:dim2,1:dim3) ) ! Note - interpolated to mass pts for output. + allocate( temp(1:dim1,1:dim2,1:dim3) ) + allocate( q(1:dim1,1:dim2,1:dim3) ) + allocate( psfc(1:dim1,1:dim2) ) + allocate( u_mean(1:dim1,1:dim2,1:dim3) ) ! Note - interpolated to chi pts for output. + allocate( v_mean(1:dim1,1:dim2,1:dim3) ) + allocate( temp_mean(1:dim1,1:dim2,1:dim3) ) + allocate( q_mean(1:dim1,1:dim2,1:dim3) ) + allocate( psfc_mean(1:dim1,1:dim2) ) + allocate( u_mnsq(1:dim1,1:dim2,1:dim3) ) ! Note - interpolated to chi pts for output. + allocate( v_mnsq(1:dim1,1:dim2,1:dim3) ) + allocate( temp_mnsq(1:dim1,1:dim2,1:dim3) ) + allocate( q_mnsq(1:dim1,1:dim2,1:dim3) ) + allocate( psfc_mnsq(1:dim1,1:dim2) ) + ! cloud variables + has_cloud = .false. + has_rain = .false. + has_ice = .false. + has_snow = .false. + has_graup = .false. + moist_string = '' + if ( mp_physics > 0 ) then + has_cloud = .true. + has_rain = .true. + allocate( qcloud(1:dim1,1:dim2,1:dim3) ) + allocate( qrain(1:dim1,1:dim2,1:dim3) ) + allocate( qcloud_mean(1:dim1,1:dim2,1:dim3) ) + allocate( qrain_mean(1:dim1,1:dim2,1:dim3) ) + allocate( qcloud_mnsq(1:dim1,1:dim2,1:dim3) ) + allocate( qrain_mnsq(1:dim1,1:dim2,1:dim3) ) + qcloud_mean = 0.0 + qrain_mean = 0.0 + qcloud_mnsq = 0.0 + qrain_mnsq = 0.0 + moist_string = trim(moist_string)//'qcloud, qrain ' + if ( mp_physics == 2 .or. mp_physics == 4 .or. & + mp_physics >= 6 ) then + has_ice = .true. + allocate( qice(1:dim1,1:dim2,1:dim3) ) + allocate( qice_mean(1:dim1,1:dim2,1:dim3) ) + allocate( qice_mnsq(1:dim1,1:dim2,1:dim3) ) + qice_mean = 0.0 + qice_mnsq = 0.0 + moist_string = trim(moist_string)//', qice ' end if - write(stdout,'(a)')' Perturbations are in MODEL SPACE' - write(stdout,'(a,i4)')' Ensemble Size = ', nens - write(stdout,'(a,a)')' Directory = ', trim(directory) - write(stdout,'(a,a)')' Filename = ', trim(filename) + if ( mp_physics == 2 .or. mp_physics >= 4 ) then + has_snow = .true. + allocate( qsnow(1:dim1,1:dim2,1:dim3) ) + allocate( qsnow_mean(1:dim1,1:dim2,1:dim3) ) + allocate( qsnow_mnsq(1:dim1,1:dim2,1:dim3) ) + qsnow_mean = 0.0 + qsnow_mnsq = 0.0 + moist_string = trim(moist_string)//', qsnow ' + end if + if ( mp_physics == 2 .or. mp_physics >= 6 ) then + if ( mp_physics /= 11 .and. mp_physics /= 13 .and. & + mp_physics /= 14 ) then + has_graup = .true. + allocate( qgraup(1:dim1,1:dim2,1:dim3) ) + allocate( qgraup_mean(1:dim1,1:dim2,1:dim3) ) + allocate( qgraup_mnsq(1:dim1,1:dim2,1:dim3) ) + qgraup_mean = 0.0 + qgraup_mnsq = 0.0 + moist_string = trim(moist_string)//', qgraup ' + end if + end if + write(6,'(a)')' cloud variables are '//trim(moist_string) end if - ounit = 61 + u_mean = 0.0 + v_mean = 0.0 + temp_mean = 0.0 + q_mean = 0.0 + psfc_mean = 0.0 + u_mnsq = 0.0 + v_mnsq = 0.0 + temp_mnsq = 0.0 + q_mnsq = 0.0 + psfc_mnsq = 0.0 + +! Temporary arrays: + allocate( utmp(1:dim1s,1:dim2) ) ! u on Arakawa C-grid. + allocate( vtmp(1:dim1,1:dim2s) ) ! v on Arakawa C-grid. + allocate( ttmp(1:dim1,1:dim2) ) + allocate( dummy(1:dim1,1:dim2) ) + +!--------------------------------------------------------------------------------------------- + write(6,'(/a)')' [3] Extract necessary fields from input NETCDF files and output.' +!--------------------------------------------------------------------------------------------- + + do member = 1, ne + + write(UNIT=ce,FMT='(i3.3)')member + input_file = trim(directory)//'/'//trim(filename)//'.e'//trim(ce) - call ext_ncd_ioinit("",ierr) + do k = 1, dim3 - ! open file e001 for retrieving general information + ! Read u, v: + var = "U" + call da_get_field( input_file, var, 3, dim1s, dim2, dim3, k, utmp ) + var = "V" + call da_get_field( input_file, var, 3, dim1, dim2s, dim3, k, vtmp ) - input_file = trim(directory)//'/'//trim(filename)//'.e001' - call ext_ncd_open_for_read(trim(input_file), 0, 0, "", fid, ierr) - if ( ierr /= 0 ) then - write(stdout, '(a,a,i8)') 'Error opening ', trim(input_file), ierr -#ifdef DM_PARALLEL - call mpi_abort(mpi_comm_world,1,ierr) -#else - stop -#endif - end if +! Interpolate u to mass pts: + do j = 1, dim2 + do i = 1, dim1 + u(i,j,k) = 0.5 * ( utmp(i,j) + utmp(i+1,j) ) + v(i,j,k) = 0.5 * ( vtmp(i,j) + vtmp(i,j+1) ) + end do + end do + +! Read theta, and convert to temperature: + call da_get_trh( input_file, dim1, dim2, dim3, k, ttmp, dummy ) + temp(:,:,k) = ttmp(:,:) + +! Read mixing ratio, and convert to specific humidity: + var = "QVAPOR" + call da_get_field( input_file, var, 3, dim1, dim2, dim3, k, dummy ) + q(:,:,k) = dummy(:,:) / ( 1.0 + dummy(:,:) ) - ! retrieve dimensions from variable T - - varname = "T" - call ext_ncd_get_var_info (fid, varname, ndim, ordering, staggering, & - start_index, end_index, wrftype, ierr) - ni = end_index(1) - nj = end_index(2) - nk = end_index(3) - ni1 = ni + 1 - nj1 = nj + 1 - ijk = ni * nj * nk - if ( myproc == root ) write(stdout, '(a,3i5)') ' ni, nj, nk = ', ni, nj, nk - - ! retrieve information for cloud variables - - mp_physics = 0 !initialize - call ext_ncd_get_dom_ti_integer (fid, 'MP_PHYSICS', mp_physics, 1, icnt, ierr) - - avail(1:5) = 1 ! initialize as available for 5 basic variables - avail(6:10) = 0 ! initialize as not available for cloud variables - if ( alpha_hydrometeors ) then - if ( mp_physics > 0 ) then - avail(6) = 1 ! qcloud - avail(7) = 1 ! qrain - if ( mp_physics == 2 .or. mp_physics == 4 .or. & - mp_physics >= 6 ) then - avail(8) = 1 ! qice +! Read hydrometeors + if ( has_cloud ) then + var = "QCLOUD" + call da_get_field( input_file, var, 3, dim1, dim2, dim3, k, dummy ) + qcloud(:,:,k) = dummy(:,:) end if - if ( mp_physics == 2 .or. mp_physics >= 4 ) then - avail(9) = 1 ! qsnow + if ( has_rain ) then + var = "QRAIN" + call da_get_field( input_file, var, 3, dim1, dim2, dim3, k, dummy ) + qrain(:,:,k) = dummy(:,:) end if - if ( mp_physics == 2 .or. mp_physics >= 6 ) then - if ( mp_physics /= 11 .and. mp_physics /= 13 .and. & - mp_physics /= 14 ) then - avail(10) = 1 ! qgraup - end if + if ( has_ice ) then + var = "QICE" + call da_get_field( input_file, var, 3, dim1, dim2, dim3, k, dummy ) + qice(:,:,k) = dummy(:,:) end if - end if - end if - - ! done retrieving information from file e001 - call ext_ncd_ioclose(fid, ierr) - - allocate (xfield (ni, nj, nk)) - allocate (xfield_u(ni1,nj, nk)) - allocate (xfield_v(ni, nj1,nk)) - - ! number of variables to read - readit(1:nvar_max) = 0 ! initilaze as not read - if ( trim(cvar) == 'all' ) then - readit(:) = 1 - else - do i = 1, nvar_max - if ( fnames(i) == trim(cvar) ) then - readit(i) = 1 - exit + if ( has_snow ) then + var = "QSNOW" + call da_get_field( input_file, var, 3, dim1, dim2, dim3, k, dummy ) + qsnow(:,:,k) = dummy(:,:) end if + if ( has_graup ) then + var = "QGRAUP" + call da_get_field( input_file, var, 3, dim1, dim2, dim3, k, dummy ) + qgraup(:,:,k) = dummy(:,:) + end if + end do - end if - nvar = 0 - do i = 1, nvar_max - if ( avail(i) == 1 .and. readit(i) == 1 ) then - nvar = nvar + 1 - end if - end do - if ( nvar < 1 ) then - write(stdout, '(a,i3)') 'invalid number of variables to process ', nvar -#ifdef DM_PARALLEL - call mpi_abort(mpi_comm_world,1,ierr) -#else - stop -#endif - end if +! Finally, extract surface pressure: + var = "PSFC" + call da_get_field( input_file, var, 2, dim1, dim2, dim3, 1, psfc ) + +! Write out ensemble forecasts for this member: + output_file = 'tmp.e'//ce + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)date, dim1, dim2, dim3 + write(gen_be_ounit)u + write(gen_be_ounit)v + write(gen_be_ounit)temp + write(gen_be_ounit)q + if ( has_cloud ) write(gen_be_ounit)qcloud + if ( has_rain ) write(gen_be_ounit)qrain + if ( has_ice ) write(gen_be_ounit)qice + if ( has_snow ) write(gen_be_ounit)qsnow + if ( has_graup ) write(gen_be_ounit)qgraup + write(gen_be_ounit)psfc + close(gen_be_ounit) + +! Calculate accumulating mean and mean square: + member_inv = 1.0 / real(member) + u_mean = ( real( member-1 ) * u_mean + u ) * member_inv + v_mean = ( real( member-1 ) * v_mean + v ) * member_inv + temp_mean = ( real( member-1 ) * temp_mean + temp ) * member_inv + q_mean = ( real( member-1 ) * q_mean + q ) * member_inv + psfc_mean = ( real( member-1 ) * psfc_mean + psfc ) * member_inv + u_mnsq = ( real( member-1 ) * u_mnsq + u * u ) * member_inv + v_mnsq = ( real( member-1 ) * v_mnsq + v * v ) * member_inv + temp_mnsq = ( real( member-1 ) * temp_mnsq + temp * temp ) * member_inv + q_mnsq = ( real( member-1 ) * q_mnsq + q * q ) * member_inv + psfc_mnsq = ( real( member-1 ) * psfc_mnsq + psfc * psfc ) * member_inv + if ( has_cloud ) then + qcloud_mean = ( real( member-1 ) * qcloud_mean + qcloud ) * member_inv + qcloud_mnsq = ( real( member-1 ) * qcloud_mnsq + qcloud * qcloud ) * member_inv + end if + if ( has_rain ) then + qrain_mean = ( real( member-1 ) * qrain_mean + qrain ) * member_inv + qrain_mnsq = ( real( member-1 ) * qrain_mnsq + qrain * qrain ) * member_inv + end if + if ( has_ice ) then + qice_mean = ( real( member-1 ) * qice_mean + qice ) * member_inv + qice_mnsq = ( real( member-1 ) * qice_mnsq + qice * qice ) * member_inv + end if + if ( has_snow ) then + qsnow_mean = ( real( member-1 ) * qsnow_mean + qsnow ) * member_inv + qsnow_mnsq = ( real( member-1 ) * qsnow_mnsq + qsnow * qsnow ) * member_inv + end if + if ( has_graup ) then + qgraup_mean = ( real( member-1 ) * qgraup_mean + qgraup ) * member_inv + qgraup_mnsq = ( real( member-1 ) * qgraup_mnsq + qgraup * qgraup ) * member_inv + end if - ! divide nens among available processors - allocate (istart(0:num_procs-1)) - allocate (iend (0:num_procs-1)) - allocate (ncount(0:num_procs-1)) - allocate (displs(0:num_procs-1)) - do i = 0, num_procs - 1 - call para_range(1, nens, num_procs, i, istart(i), iend(i)) - ncount(i) = iend(i) - istart(i) + 1 - end do - ! get displs to be used later in mpi gather - displs(0) = 0 - do i = 1, num_procs-1 - displs(i) = displs(i-1) + ncount(i-1) - end do - write(stdout,'(a,i4,a,i4,a,i4)') & - 'Processor ', myproc, ' will read files ', istart(myproc), ' - ', iend(myproc) - - allocate(xdata(nvar)) - do ivar = 1, nvar - allocate(xdata(ivar)%value(ni,nj,nk,istart(myproc):iend(myproc))) - allocate(xdata(ivar)%mean(ni,nj,nk)) - xdata(ivar)%value = 0.0 - xdata(ivar)%mean = 0.0 end do - allocate (pp(ni, nj, nk)) - allocate (pb(ni, nj, nk)) - - !do ie = 1, nens - do ie = istart(myproc), iend(myproc) ! each proc reads a subset of nens - - write(ce,'(i3.3)') ie - input_file = trim(directory)//'/'//trim(filename)//'.e'//trim(ce) - - call ext_ncd_open_for_read(trim(input_file), 0, 0, "", fid, ierr) - if ( ierr /= 0 ) then - write(stdout, '(a,a)') 'Error opening ', trim(input_file) -#ifdef DM_PARALLEL - call mpi_abort(mpi_comm_world,1,ierr) -#else - stop -#endif - end if + deallocate( utmp ) + deallocate( vtmp ) + deallocate( ttmp ) + deallocate( dummy ) - call ext_ncd_get_next_time(fid, DateStr, ierr) - - ! read P and PB for converting T (theta) to temperature - call ext_ncd_get_var_info (fid, 'P', ndim, ordering, staggering, & - start_index, end_index, wrftype, ierr) - call ext_ncd_read_field(fid, DateStr, 'P', & - pp, wrftype, & - 0, 0, 0, ordering, & - staggering, dimnames, & !dummy - start_index, end_index, & !dom - start_index, end_index, & !mem - start_index, end_index, & !pat - ierr ) - call ext_ncd_get_var_info (fid, 'PB', ndim, ordering, staggering, & - start_index, end_index, wrftype, ierr) - call ext_ncd_read_field(fid, DateStr, 'PB', & - pb, wrftype, & - 0, 0, 0, ordering, & - staggering, dimnames, & !dummy - start_index, end_index, & !dom - start_index, end_index, & !mem - start_index, end_index, & !pat - ierr ) - - ivar = 0 - var_loop: do iv = 1, nvar_max - - if ( avail(iv)==0 .or. readit(iv)==0 ) cycle var_loop - - varname = trim(varnames(iv)) - call ext_ncd_get_var_info (fid, varname, ndim, ordering, staggering, & - start_index, end_index, wrftype, ierr) - - ivar = ivar + 1 - xdata(ivar)%name = fnames(iv) - - write(stdout, '(a,a8,a,a)') ' Reading ', trim(varname), ' from ', trim(input_file) - - if ( varname == 'PSFC' ) then - call ext_ncd_read_field(fid, DateStr, varname, & - xfield(:,:,1), wrftype, & - 0, 0, 0, ordering, & - staggering, dimnames, & !dummy - start_index, end_index, & !dom - start_index, end_index, & !mem - start_index, end_index, & !pat - ierr ) - xdata(ivar)%value(:,:,1,ie) = xfield(:,:,1) - else if ( varname == 'U' ) then - call ext_ncd_read_field(fid, DateStr, varname, & - xfield_u(:,:,:), wrftype, & - 0, 0, 0, ordering, & - staggering, dimnames, & !dummy - start_index, end_index, & !dom - start_index, end_index, & !mem - start_index, end_index, & !pat - ierr ) - do k = 1, nk - do j = 1, nj - do i = 1, ni - xdata(ivar)%value(i,j,k,ie) = & - 0.5 * ( dble(xfield_u(i,j,k)) + dble(xfield_u(i+1,j,k)) ) - end do - end do - end do - else if ( varname == 'V' ) then - call ext_ncd_read_field(fid, DateStr, varname, & - xfield_v(:,:,:), wrftype, & - 0, 0, 0, ordering, & - staggering, dimnames, & !dummy - start_index, end_index, & !dom - start_index, end_index, & !mem - start_index, end_index, & !pat - ierr ) - do k = 1, nk - do j = 1, nj - do i = 1, ni - xdata(ivar)%value(i,j,k,ie) = & - 0.5 * ( dble(xfield_v(i,j,k)) + dble(xfield_v(i,j+1,k)) ) - end do - end do - end do - else - call ext_ncd_read_field(fid, DateStr, varname, & - xfield, wrftype, & - 0, 0, 0, ordering, & - staggering, dimnames, & !dummy - start_index, end_index, & !dom - start_index, end_index, & !mem - start_index, end_index, & !pat - ierr ) - if ( varname == 'QVAPOR' ) then - ! from mixing ratio to specific humidity - xdata(ivar)%value(:,:,:,ie) = xfield(:,:,:) / ( 1.0 + xfield(:,:,:) ) - else if ( varname == 'T' ) then - xdata(ivar)%value(:,:,:,ie) = & - (t00+xfield(:,:,:))*((pp(:,:,:)+pb(:,:,:))/p00)**kappa - else - xdata(ivar)%value(:,:,:,ie) = xfield - end if - end if +!--------------------------------------------------------------------------------------------- + write(6,'(/a)')' [4] Compute perturbations and output' +!--------------------------------------------------------------------------------------------- - end do var_loop ! nvar loop + if ( remove_mean ) then + write(6,'(a)') " Calculate ensemble perturbations" + else + write(6,'(a)') " WARNING: Not removing ensemble mean (outputs are full-fields)" + end if - call ext_ncd_ioclose(fid, ierr) + do member = 1, ne + write(UNIT=ce,FMT='(i3.3)')member + +! Re-read ensemble member standard fields: + input_file = 'tmp.e'//ce + open (gen_be_iunit, file = input_file, form='unformatted') + read(gen_be_iunit)date, dim1, dim2, dim3 + read(gen_be_iunit)u + read(gen_be_iunit)v + read(gen_be_iunit)temp + read(gen_be_iunit)q + if ( has_cloud ) read(gen_be_iunit)qcloud + if ( has_rain ) read(gen_be_iunit)qrain + if ( has_ice ) read(gen_be_iunit)qice + if ( has_snow ) read(gen_be_iunit)qsnow + if ( has_graup ) read(gen_be_iunit)qgraup + read(gen_be_iunit)psfc + close(gen_be_iunit) - end do ! nens loop + if ( remove_mean ) then + u = u - u_mean + v = v - v_mean + temp = temp - temp_mean + q = q - q_mean + if ( has_cloud ) qcloud = qcloud - qcloud_mean + if ( has_rain ) qrain = qrain - qrain_mean + if ( has_ice ) qice = qice - qice_mean + if ( has_snow ) qsnow = qsnow - qsnow_mean + if ( has_graup ) qgraup = qgraup - qgraup_mean + psfc = psfc - psfc_mean + end if - deallocate (pp) - deallocate (pb) - deallocate (xfield) - deallocate (xfield_u) - deallocate (xfield_v) +! Write out perturbations for this member: + + output_file = 'u.e'//trim(ce) ! Output u. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)u + close(gen_be_ounit) + + output_file = 'v.e'//trim(ce) ! Output v. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)v + close(gen_be_ounit) + + output_file = 't.e'//trim(ce) ! Output t. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)temp + close(gen_be_ounit) + + output_file = 'q.e'//trim(ce) ! Output q. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)q + close(gen_be_ounit) + + output_file = 'ps.e'//trim(ce) ! Output ps. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)psfc + close(gen_be_ounit) + + if ( has_cloud ) then + output_file = 'qcloud.e'//trim(ce) ! Output qcloud. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qcloud + close(gen_be_ounit) + end if - if ( myproc == root ) write(stdout,'(a)') ' Computing mean' - if ( myproc == root ) then - allocate (globuf (ni, nj, nk, nens)) - end if -#ifdef DM_PARALLEL - if ( myproc == root ) then - allocate (globuf1d(ijk*nens)) - end if - allocate (tmp1d (ijk*ncount(myproc))) -#endif + if ( has_rain ) then + output_file = 'qrain.e'//trim(ce) ! Output qrain. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qrain + close(gen_be_ounit) + end if - do ivar = 1, nvar -#ifdef DM_PARALLEL - tmp1d = reshape(xdata(ivar)%value(:,:,:,istart(myproc):iend(myproc)), & - (/ ijk*ncount(myproc) /)) - ! gather all ens members to root - call mpi_gatherv( tmp1d, & - ijk*ncount(myproc), true_mpi_real, & - globuf1d, & - ijk*ncount, ijk*displs, true_mpi_real, & - root, mpi_comm_world, ierr ) - if ( ierr /= 0 ) then - write(stdout, '(a, i2)') 'Error mpi_gatherv on proc ', myproc - call mpi_abort(mpi_comm_world,1,ierr) + if ( has_ice ) then + output_file = 'qice.e'//trim(ce) ! Output qice. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qice + close(gen_be_ounit) end if - if ( myproc == root ) then - globuf = reshape(globuf1d, (/ ni, nj, nk, nens /)) + + if ( has_snow ) then + output_file = 'qsnow.e'//trim(ce) ! Output qsnow. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qsnow + close(gen_be_ounit) end if -#else - globuf(:,:,:,:) = xdata(ivar)%value(:,:,:,:) -#endif - if ( myproc == root ) then - - allocate(xdata(ivar)%mnsq(ni,nj,nk)) - allocate(xdata(ivar)%stdv(ni,nj,nk)) - xdata(ivar)%mnsq = 0.0 - xdata(ivar)%stdv = 0.0 - - do ie = 1, nens ! loop over all ens member - ens_inv = 1.0/real(ie) - ! calculate accumulating mean and mean square - xdata(ivar)%mean(:,:,:) = (real(ie-1)*xdata(ivar)%mean(:,:,:)+globuf(:,:,:,ie))*ens_inv - xdata(ivar)%mnsq(:,:,:) = (real(ie-1)*xdata(ivar)%mnsq(:,:,:)+globuf(:,:,:,ie)*globuf(:,:,:,ie))*ens_inv - end do - if ( write_mean_stdv ) then - write(stdout,'(a,a)') ' Computing standard deviation and writing out for ', trim(xdata(ivar)%name) - xdata(ivar)%stdv(:,:,:) = sqrt(xdata(ivar)%mnsq(:,:,:)-xdata(ivar)%mean(:,:,:)*xdata(ivar)%mean(:,:,:)) - - ! output mean - output_file = trim(xdata(ivar)%name)//'.mean' - open (ounit, file = output_file, form='unformatted') - write(ounit) ni, nj, nk - if ( trim(xdata(ivar)%name) == 'ps' ) then - write(ounit) xdata(ivar)%mean(:,:,1) - else - write(ounit) xdata(ivar)%mean(:,:,1:nk) - end if - close(ounit) - - ! output stdv - output_file = trim(xdata(ivar)%name)//'.stdv' - open (ounit, file = output_file, form='unformatted') - write(ounit) ni, nj, nk - if ( trim(xdata(ivar)%name) == 'ps' ) then - write(ounit) xdata(ivar)%stdv(:,:,1) - else - write(ounit) xdata(ivar)%stdv(:,:,1:nk) - end if - close(ounit) - end if ! write_mean_stdv - deallocate(xdata(ivar)%mnsq) - deallocate(xdata(ivar)%stdv) - - end if ! root - -#ifdef DM_PARALLEL - if ( remove_mean ) then - call mpi_bcast(xdata(ivar)%mean, ijk , true_mpi_real , root , mpi_comm_world, ierr ) + if ( has_graup ) then + output_file = 'qgraup.e'//trim(ce) ! Output qgraup. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qgraup + close(gen_be_ounit) end if -#endif end do -#ifdef DM_PARALLEL - call mpi_barrier (mpi_comm_world,ierr) -#endif - - if ( myproc == root ) then - deallocate (globuf) - end if -#ifdef DM_PARALLEL - if ( myproc == root ) then - deallocate (globuf1d) +! Write out mean/stdv fields (stdv stored in mnsq arrays): + u_mnsq = sqrt( u_mnsq - u_mean * u_mean ) + v_mnsq = sqrt( v_mnsq - v_mean * v_mean ) + temp_mnsq = sqrt( temp_mnsq - temp_mean * temp_mean ) + q_mnsq = sqrt( q_mnsq - q_mean * q_mean ) + psfc_mnsq = sqrt( psfc_mnsq - psfc_mean * psfc_mean ) + if ( has_cloud ) qcloud_mnsq = sqrt( qcloud_mnsq - qcloud_mean * qcloud_mean ) + if ( has_rain ) qrain_mnsq = sqrt( qrain_mnsq - qrain_mean * qrain_mean ) + if ( has_ice ) qice_mnsq = sqrt( qice_mnsq - qice_mean * qice_mean ) + if ( has_snow ) qsnow_mnsq = sqrt( qsnow_mnsq - qsnow_mean * qsnow_mean ) + if ( has_graup ) qgraup_mnsq = sqrt( qgraup_mnsq - qgraup_mean * qgraup_mean ) + + output_file = 'u.mean' ! Output u. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)u_mean + close(gen_be_ounit) + + output_file = 'u.stdv' ! Output u. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)u_mnsq + close(gen_be_ounit) + + output_file = 'v.mean' ! Output v. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)v_mean + close(gen_be_ounit) + + output_file = 'v.stdv' ! Output v. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)v_mnsq + close(gen_be_ounit) + + output_file = 't.mean' ! Output t. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)temp_mean + close(gen_be_ounit) + + output_file = 't.stdv' ! Output t. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)temp_mnsq + close(gen_be_ounit) + + output_file = 'q.mean' ! Output q. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)q_mean + close(gen_be_ounit) + + output_file = 'q.stdv' ! Output q. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)q_mnsq + close(gen_be_ounit) + + output_file = 'ps.mean' ! Output ps. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)psfc_mean + close(gen_be_ounit) + + output_file = 'ps.stdv' ! Output ps. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)psfc_mnsq + close(gen_be_ounit) + + if ( has_cloud ) then + output_file = 'qcloud.mean' ! Output qcloud. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qcloud_mean + close(gen_be_ounit) + + output_file = 'qcloud.stdv' ! Output qcloud. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qcloud_mnsq + close(gen_be_ounit) end if - deallocate (tmp1d) -#endif - if ( myproc == root ) write(stdout,'(a)') ' Computing perturbations and writing out' - do ivar = 1, nvar - do ie = istart(myproc), iend(myproc) ! each proc loops over a subset of ens - if ( remove_mean ) then - xdata(ivar)%value(:,:,:,ie) = xdata(ivar)%value(:,:,:,ie) - xdata(ivar)%mean(:,:,:) - end if - write(ce,'(i3.3)') ie - output_file = trim(xdata(ivar)%name)//'.e'//trim(ce) - open (ounit, file = output_file, form='unformatted') - write(ounit) ni, nj, nk - if ( trim(xdata(ivar)%name) == 'ps' ) then - write(ounit) xdata(ivar)%value(:,:,1,ie) - else - write(ounit) xdata(ivar)%value(:,:,1:nk,ie) - end if - close(ounit) - end do - end do - -#ifdef DM_PARALLEL - call mpi_barrier (mpi_comm_world,ierr) -#endif + if ( has_rain ) then + output_file = 'qrain.mean' ! Output qrain. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qrain_mean + close(gen_be_ounit) + + output_file = 'qrain.stdv' ! Output qrain. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qrain_mnsq + close(gen_be_ounit) + end if - deallocate (istart) - deallocate (iend ) - deallocate (ncount) - deallocate (displs) + if ( has_ice ) then + output_file = 'qice.mean' ! Output qice. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qice_mean + close(gen_be_ounit) + + output_file = 'qice.stdv' ! Output qice. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qice_mnsq + close(gen_be_ounit) + end if - do ivar = 1, nvar - deallocate(xdata(ivar)%value) - deallocate(xdata(ivar)%mean) - end do - deallocate(xdata) + if ( has_snow ) then + output_file = 'qsnow.mean' ! Output qsnow. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qsnow_mean + close(gen_be_ounit) + + output_file = 'qsnow.stdv' ! Output qsnow. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qsnow_mnsq + close(gen_be_ounit) + end if - if ( myproc == root ) write(stdout,'(a)')' All Done!' + if ( has_graup ) then + output_file = 'qgraup.mean' ! Output qgraup. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qgraup_mean + close(gen_be_ounit) + + output_file = 'qgraup.stdv' ! Output qgraup. + open (gen_be_ounit, file = output_file, form='unformatted') + write(gen_be_ounit)dim1, dim2, dim3 + write(gen_be_ounit)qgraup_mnsq + close(gen_be_ounit) + end if -#ifdef DM_PARALLEL - call mpi_finalize(ierr) -#endif + call da_free_unit(gen_be_iunit) + call da_free_unit(gen_be_ounit) +#ifdef crayx1 contains -subroutine para_range(n1, n2, nprocs, myrank, ista, iend) -! -! Purpose: determines the start and end index for each PE -! given the loop range. -! History: 2014-02-24 Xin Zhang -! - implicit none + subroutine getarg(i, harg) + implicit none + character(len=*) :: harg + integer :: ierr, ilen, i - integer, intent(in) :: n1, n2, nprocs, myrank - integer, intent(out) :: ista, iend - - integer :: iwork1, iwork2 - - iwork1 = (n2 - n1 + 1) / nprocs - iwork2 = mod(n2 - n1 + 1, nprocs) - ista = myrank * iwork1 + n1 + min(myrank, iwork2) - iend = ista + iwork1 - 1 - if (iwork2 > myrank) iend = iend + 1 - return -end subroutine para_range + call pxfgetarg(i, harg, ilen, ierr) + return + end subroutine getarg +#endif end program gen_be_ep2 -! wrf_debug is called by ext_ncd_ subroutines -! add dummy subroutine wrf_debug here to avoid WRF dependency -SUBROUTINE wrf_debug( level , str ) - IMPLICIT NONE - CHARACTER*(*) str - INTEGER , INTENT (IN) :: level - RETURN -END SUBROUTINE wrf_debug diff --git a/var/gen_be/gen_be_ep2_serial.f90 b/var/gen_be/gen_be_ep2_serial.f90 deleted file mode 100644 index d9e15238a4..0000000000 --- a/var/gen_be/gen_be_ep2_serial.f90 +++ /dev/null @@ -1,626 +0,0 @@ -program gen_be_ep2 -! -!---------------------------------------------------------------------- -! Purpose : To convert WRF ensemble to format required for use as -! flow-dependent perturbations in WRF-Var (alpha control variable, -! alphacv_method = 2). -! -! Dale Barker (NCAR/MMM) January 2007 -! Arthur P. Mizzi (NCAR/MMM) February 2011 Modified to use .vari extension for -! ensemble variance file output from -! gen_be_ensmean.f90 -! -!---------------------------------------------------------------------- - -#ifdef crayx1 -#define iargc ipxfargc -#endif - - use da_control, only : stderr, stdout, filename_len - use da_tools_serial, only : da_get_unit, da_free_unit - use da_gen_be, only : da_stage0_initialize, da_get_field, da_get_trh - - implicit none - - character (len=filename_len) :: directory ! General filename stub. - character (len=filename_len) :: filename ! General filename stub. - character (len=filename_len) :: input_file ! Input file. - character (len=filename_len) :: output_file ! Output file. - character (len=10) :: date ! Character date. - character (len=10) :: var ! Variable to search for. - character (len=3) :: cne ! Ensemble size. - character (len=3) :: ce ! Member index -> character. - character (len=filename_len) :: moist_string - - integer, external :: iargc - integer :: numarg - integer :: ne ! Ensemble size. - integer :: i, j, k, member ! Loop counters. - integer :: dim1 ! Dimensions of grid (T points). - integer :: dim1s ! Dimensions of grid (vor/psi pts). - integer :: dim2 ! Dimensions of grid (T points). - integer :: dim2s ! Dimensions of grid (vor/psi pts). - integer :: dim3 ! Dimensions of grid (T points). - integer :: mp_physics ! microphysics option - real :: member_inv ! 1 / member. - real :: ds ! Grid resolution. - logical :: remove_mean ! Remove mean from standard fields. - logical :: has_cloud, has_rain, has_ice, has_snow, has_graup - - real, allocatable :: u(:,:,:) ! u-wind. - real, allocatable :: v(:,:,:) ! v-wind. - real, allocatable :: temp(:,:,:) ! Temperature. - real, allocatable :: q(:,:,:) ! Specific humidity. - real, allocatable :: qcloud(:,:,:) ! Cloud. - real, allocatable :: qrain(:,:,:) ! Rain. - real, allocatable :: qice(:,:,:) ! ice - real, allocatable :: qsnow(:,:,:) ! snow - real, allocatable :: qgraup(:,:,:) ! graupel - real, allocatable :: psfc(:,:) ! Surface pressure. - real, allocatable :: u_mean(:,:,:) ! u-wind. - real, allocatable :: v_mean(:,:,:) ! v-wind. - real, allocatable :: temp_mean(:,:,:) ! Temperature. - real, allocatable :: q_mean(:,:,:) ! Specific humidity. - real, allocatable :: qcloud_mean(:,:,:) ! Cloud. - real, allocatable :: qrain_mean(:,:,:) ! Rain. - real, allocatable :: qice_mean(:,:,:) ! ice - real, allocatable :: qsnow_mean(:,:,:) ! snow - real, allocatable :: qgraup_mean(:,:,:) ! graupel - real, allocatable :: psfc_mean(:,:) ! Surface pressure. - real, allocatable :: u_mnsq(:,:,:) ! u-wind. - real, allocatable :: v_mnsq(:,:,:) ! v-wind. - real, allocatable :: temp_mnsq(:,:,:) ! Temperature. - real, allocatable :: q_mnsq(:,:,:) ! Specific humidity. - real, allocatable :: qcloud_mnsq(:,:,:) ! Cloud. - real, allocatable :: qrain_mnsq(:,:,:) ! Rain. - real, allocatable :: qice_mnsq(:,:,:) ! ice - real, allocatable :: qsnow_mnsq(:,:,:) ! snow - real, allocatable :: qgraup_mnsq(:,:,:) ! graupel - real, allocatable :: psfc_mnsq(:,:) ! Surface pressure. - - real, allocatable :: utmp(:,:) ! u-wind. - real, allocatable :: vtmp(:,:) ! v-wind. - real, allocatable :: ttmp(:,:) ! temperature. - real, allocatable :: dummy(:,:) ! dummy. - - integer :: gen_be_iunit, gen_be_ounit - - stderr = 0 - stdout = 6 - -!--------------------------------------------------------------------------------------------- - write(6,'(/a)')' [1] Initialize information.' -!--------------------------------------------------------------------------------------------- - - call da_get_unit(gen_be_iunit) - call da_get_unit(gen_be_ounit) - - remove_mean = .true. - - numarg = iargc() - if ( numarg /= 4 )then - write(UNIT=6,FMT='(a)') & - "Usage: gen_be_ep2 date ne Stop" - stop - end if - - ! Initialse to stop Cray compiler complaining - date="" - cne="" - directory="" - filename="" - - call getarg( 1, date ) - call getarg( 2, cne ) - read(cne,'(i3)')ne - call getarg( 3, directory ) - call getarg( 4, filename ) - - if ( remove_mean ) then - write(6,'(a,a)')' Computing gen_be ensemble perturbation files for date ', date - else - write(6,'(a,a)')' Computing gen_be ensemble forecast files for date ', date - end if - write(6,'(a)')' Perturbations are in MODEL SPACE (u, v, t, q, ps)' - write(6,'(a,i4)')' Ensemble Size = ', ne - write(6,'(a,a)')' Directory = ', trim(directory) - write(6,'(a,a)')' Filename = ', trim(filename) - -!--------------------------------------------------------------------------------------------- - write(6,'(/a)')' [2] Set up data dimensions and allocate arrays:' -!--------------------------------------------------------------------------------------------- - -! Get grid dimensions from first T field: - var = "T" - input_file = trim(directory)//'/'//trim(filename)//'.e001' - call da_stage0_initialize( input_file, var, dim1, dim2, dim3, ds, mp_physics ) - dim1s = dim1+1 ! u i dimension is 1 larger. - dim2s = dim2+1 ! v j dimension is 1 larger. - -! Allocate arrays in output fields: - allocate( u(1:dim1,1:dim2,1:dim3) ) ! Note - interpolated to mass pts for output. - allocate( v(1:dim1,1:dim2,1:dim3) ) ! Note - interpolated to mass pts for output. - allocate( temp(1:dim1,1:dim2,1:dim3) ) - allocate( q(1:dim1,1:dim2,1:dim3) ) - allocate( psfc(1:dim1,1:dim2) ) - allocate( u_mean(1:dim1,1:dim2,1:dim3) ) ! Note - interpolated to chi pts for output. - allocate( v_mean(1:dim1,1:dim2,1:dim3) ) - allocate( temp_mean(1:dim1,1:dim2,1:dim3) ) - allocate( q_mean(1:dim1,1:dim2,1:dim3) ) - allocate( psfc_mean(1:dim1,1:dim2) ) - allocate( u_mnsq(1:dim1,1:dim2,1:dim3) ) ! Note - interpolated to chi pts for output. - allocate( v_mnsq(1:dim1,1:dim2,1:dim3) ) - allocate( temp_mnsq(1:dim1,1:dim2,1:dim3) ) - allocate( q_mnsq(1:dim1,1:dim2,1:dim3) ) - allocate( psfc_mnsq(1:dim1,1:dim2) ) - ! cloud variables - has_cloud = .false. - has_rain = .false. - has_ice = .false. - has_snow = .false. - has_graup = .false. - moist_string = '' - if ( mp_physics > 0 ) then - has_cloud = .true. - has_rain = .true. - allocate( qcloud(1:dim1,1:dim2,1:dim3) ) - allocate( qrain(1:dim1,1:dim2,1:dim3) ) - allocate( qcloud_mean(1:dim1,1:dim2,1:dim3) ) - allocate( qrain_mean(1:dim1,1:dim2,1:dim3) ) - allocate( qcloud_mnsq(1:dim1,1:dim2,1:dim3) ) - allocate( qrain_mnsq(1:dim1,1:dim2,1:dim3) ) - qcloud_mean = 0.0 - qrain_mean = 0.0 - qcloud_mnsq = 0.0 - qrain_mnsq = 0.0 - moist_string = trim(moist_string)//'qcloud, qrain ' - if ( mp_physics == 2 .or. mp_physics == 4 .or. & - mp_physics >= 6 ) then - has_ice = .true. - allocate( qice(1:dim1,1:dim2,1:dim3) ) - allocate( qice_mean(1:dim1,1:dim2,1:dim3) ) - allocate( qice_mnsq(1:dim1,1:dim2,1:dim3) ) - qice_mean = 0.0 - qice_mnsq = 0.0 - moist_string = trim(moist_string)//', qice ' - end if - if ( mp_physics == 2 .or. mp_physics >= 4 ) then - has_snow = .true. - allocate( qsnow(1:dim1,1:dim2,1:dim3) ) - allocate( qsnow_mean(1:dim1,1:dim2,1:dim3) ) - allocate( qsnow_mnsq(1:dim1,1:dim2,1:dim3) ) - qsnow_mean = 0.0 - qsnow_mnsq = 0.0 - moist_string = trim(moist_string)//', qsnow ' - end if - if ( mp_physics == 2 .or. mp_physics >= 6 ) then - if ( mp_physics /= 11 .and. mp_physics /= 13 .and. & - mp_physics /= 14 ) then - has_graup = .true. - allocate( qgraup(1:dim1,1:dim2,1:dim3) ) - allocate( qgraup_mean(1:dim1,1:dim2,1:dim3) ) - allocate( qgraup_mnsq(1:dim1,1:dim2,1:dim3) ) - qgraup_mean = 0.0 - qgraup_mnsq = 0.0 - moist_string = trim(moist_string)//', qgraup ' - end if - end if - write(6,'(a)')' cloud variables are '//trim(moist_string) - end if - - u_mean = 0.0 - v_mean = 0.0 - temp_mean = 0.0 - q_mean = 0.0 - psfc_mean = 0.0 - u_mnsq = 0.0 - v_mnsq = 0.0 - temp_mnsq = 0.0 - q_mnsq = 0.0 - psfc_mnsq = 0.0 - -! Temporary arrays: - allocate( utmp(1:dim1s,1:dim2) ) ! u on Arakawa C-grid. - allocate( vtmp(1:dim1,1:dim2s) ) ! v on Arakawa C-grid. - allocate( ttmp(1:dim1,1:dim2) ) - allocate( dummy(1:dim1,1:dim2) ) - -!--------------------------------------------------------------------------------------------- - write(6,'(/a)')' [3] Extract necessary fields from input NETCDF files and output.' -!--------------------------------------------------------------------------------------------- - - do member = 1, ne - - write(UNIT=ce,FMT='(i3.3)')member - input_file = trim(directory)//'/'//trim(filename)//'.e'//trim(ce) - - do k = 1, dim3 - - ! Read u, v: - var = "U" - call da_get_field( input_file, var, 3, dim1s, dim2, dim3, k, utmp ) - var = "V" - call da_get_field( input_file, var, 3, dim1, dim2s, dim3, k, vtmp ) - -! Interpolate u to mass pts: - do j = 1, dim2 - do i = 1, dim1 - u(i,j,k) = 0.5 * ( utmp(i,j) + utmp(i+1,j) ) - v(i,j,k) = 0.5 * ( vtmp(i,j) + vtmp(i,j+1) ) - end do - end do - -! Read theta, and convert to temperature: - call da_get_trh( input_file, dim1, dim2, dim3, k, ttmp, dummy ) - temp(:,:,k) = ttmp(:,:) - -! Read mixing ratio, and convert to specific humidity: - var = "QVAPOR" - call da_get_field( input_file, var, 3, dim1, dim2, dim3, k, dummy ) - q(:,:,k) = dummy(:,:) / ( 1.0 + dummy(:,:) ) - -! Read hydrometeors - if ( has_cloud ) then - var = "QCLOUD" - call da_get_field( input_file, var, 3, dim1, dim2, dim3, k, dummy ) - qcloud(:,:,k) = dummy(:,:) - end if - if ( has_rain ) then - var = "QRAIN" - call da_get_field( input_file, var, 3, dim1, dim2, dim3, k, dummy ) - qrain(:,:,k) = dummy(:,:) - end if - if ( has_ice ) then - var = "QICE" - call da_get_field( input_file, var, 3, dim1, dim2, dim3, k, dummy ) - qice(:,:,k) = dummy(:,:) - end if - if ( has_snow ) then - var = "QSNOW" - call da_get_field( input_file, var, 3, dim1, dim2, dim3, k, dummy ) - qsnow(:,:,k) = dummy(:,:) - end if - if ( has_graup ) then - var = "QGRAUP" - call da_get_field( input_file, var, 3, dim1, dim2, dim3, k, dummy ) - qgraup(:,:,k) = dummy(:,:) - end if - - end do - -! Finally, extract surface pressure: - var = "PSFC" - call da_get_field( input_file, var, 2, dim1, dim2, dim3, 1, psfc ) - -! Write out ensemble forecasts for this member: - output_file = 'tmp.e'//ce - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)date, dim1, dim2, dim3 - write(gen_be_ounit)u - write(gen_be_ounit)v - write(gen_be_ounit)temp - write(gen_be_ounit)q - if ( has_cloud ) write(gen_be_ounit)qcloud - if ( has_rain ) write(gen_be_ounit)qrain - if ( has_ice ) write(gen_be_ounit)qice - if ( has_snow ) write(gen_be_ounit)qsnow - if ( has_graup ) write(gen_be_ounit)qgraup - write(gen_be_ounit)psfc - close(gen_be_ounit) - -! Calculate accumulating mean and mean square: - member_inv = 1.0 / real(member) - u_mean = ( real( member-1 ) * u_mean + u ) * member_inv - v_mean = ( real( member-1 ) * v_mean + v ) * member_inv - temp_mean = ( real( member-1 ) * temp_mean + temp ) * member_inv - q_mean = ( real( member-1 ) * q_mean + q ) * member_inv - psfc_mean = ( real( member-1 ) * psfc_mean + psfc ) * member_inv - u_mnsq = ( real( member-1 ) * u_mnsq + u * u ) * member_inv - v_mnsq = ( real( member-1 ) * v_mnsq + v * v ) * member_inv - temp_mnsq = ( real( member-1 ) * temp_mnsq + temp * temp ) * member_inv - q_mnsq = ( real( member-1 ) * q_mnsq + q * q ) * member_inv - psfc_mnsq = ( real( member-1 ) * psfc_mnsq + psfc * psfc ) * member_inv - if ( has_cloud ) then - qcloud_mean = ( real( member-1 ) * qcloud_mean + qcloud ) * member_inv - qcloud_mnsq = ( real( member-1 ) * qcloud_mnsq + qcloud * qcloud ) * member_inv - end if - if ( has_rain ) then - qrain_mean = ( real( member-1 ) * qrain_mean + qrain ) * member_inv - qrain_mnsq = ( real( member-1 ) * qrain_mnsq + qrain * qrain ) * member_inv - end if - if ( has_ice ) then - qice_mean = ( real( member-1 ) * qice_mean + qice ) * member_inv - qice_mnsq = ( real( member-1 ) * qice_mnsq + qice * qice ) * member_inv - end if - if ( has_snow ) then - qsnow_mean = ( real( member-1 ) * qsnow_mean + qsnow ) * member_inv - qsnow_mnsq = ( real( member-1 ) * qsnow_mnsq + qsnow * qsnow ) * member_inv - end if - if ( has_graup ) then - qgraup_mean = ( real( member-1 ) * qgraup_mean + qgraup ) * member_inv - qgraup_mnsq = ( real( member-1 ) * qgraup_mnsq + qgraup * qgraup ) * member_inv - end if - - end do - - deallocate( utmp ) - deallocate( vtmp ) - deallocate( ttmp ) - deallocate( dummy ) - -!--------------------------------------------------------------------------------------------- - write(6,'(/a)')' [4] Compute perturbations and output' -!--------------------------------------------------------------------------------------------- - - if ( remove_mean ) then - write(6,'(a)') " Calculate ensemble perturbations" - else - write(6,'(a)') " WARNING: Not removing ensemble mean (outputs are full-fields)" - end if - - do member = 1, ne - write(UNIT=ce,FMT='(i3.3)')member - -! Re-read ensemble member standard fields: - input_file = 'tmp.e'//ce - open (gen_be_iunit, file = input_file, form='unformatted') - read(gen_be_iunit)date, dim1, dim2, dim3 - read(gen_be_iunit)u - read(gen_be_iunit)v - read(gen_be_iunit)temp - read(gen_be_iunit)q - if ( has_cloud ) read(gen_be_iunit)qcloud - if ( has_rain ) read(gen_be_iunit)qrain - if ( has_ice ) read(gen_be_iunit)qice - if ( has_snow ) read(gen_be_iunit)qsnow - if ( has_graup ) read(gen_be_iunit)qgraup - read(gen_be_iunit)psfc - close(gen_be_iunit) - - if ( remove_mean ) then - u = u - u_mean - v = v - v_mean - temp = temp - temp_mean - q = q - q_mean - if ( has_cloud ) qcloud = qcloud - qcloud_mean - if ( has_rain ) qrain = qrain - qrain_mean - if ( has_ice ) qice = qice - qice_mean - if ( has_snow ) qsnow = qsnow - qsnow_mean - if ( has_graup ) qgraup = qgraup - qgraup_mean - psfc = psfc - psfc_mean - end if - -! Write out perturbations for this member: - - output_file = 'u.e'//trim(ce) ! Output u. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)u - close(gen_be_ounit) - - output_file = 'v.e'//trim(ce) ! Output v. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)v - close(gen_be_ounit) - - output_file = 't.e'//trim(ce) ! Output t. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)temp - close(gen_be_ounit) - - output_file = 'q.e'//trim(ce) ! Output q. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)q - close(gen_be_ounit) - - output_file = 'ps.e'//trim(ce) ! Output ps. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)psfc - close(gen_be_ounit) - - if ( has_cloud ) then - output_file = 'qcloud.e'//trim(ce) ! Output qcloud. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qcloud - close(gen_be_ounit) - end if - - if ( has_rain ) then - output_file = 'qrain.e'//trim(ce) ! Output qrain. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qrain - close(gen_be_ounit) - end if - - if ( has_ice ) then - output_file = 'qice.e'//trim(ce) ! Output qice. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qice - close(gen_be_ounit) - end if - - if ( has_snow ) then - output_file = 'qsnow.e'//trim(ce) ! Output qsnow. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qsnow - close(gen_be_ounit) - end if - - if ( has_graup ) then - output_file = 'qgraup.e'//trim(ce) ! Output qgraup. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qgraup - close(gen_be_ounit) - end if - - end do - -! Write out mean/stdv fields (stdv stored in mnsq arrays): - u_mnsq = sqrt( u_mnsq - u_mean * u_mean ) - v_mnsq = sqrt( v_mnsq - v_mean * v_mean ) - temp_mnsq = sqrt( temp_mnsq - temp_mean * temp_mean ) - q_mnsq = sqrt( q_mnsq - q_mean * q_mean ) - psfc_mnsq = sqrt( psfc_mnsq - psfc_mean * psfc_mean ) - if ( has_cloud ) qcloud_mnsq = sqrt( qcloud_mnsq - qcloud_mean * qcloud_mean ) - if ( has_rain ) qrain_mnsq = sqrt( qrain_mnsq - qrain_mean * qrain_mean ) - if ( has_ice ) qice_mnsq = sqrt( qice_mnsq - qice_mean * qice_mean ) - if ( has_snow ) qsnow_mnsq = sqrt( qsnow_mnsq - qsnow_mean * qsnow_mean ) - if ( has_graup ) qgraup_mnsq = sqrt( qgraup_mnsq - qgraup_mean * qgraup_mean ) - - output_file = 'u.mean' ! Output u. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)u_mean - close(gen_be_ounit) - - output_file = 'u.stdv' ! Output u. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)u_mnsq - close(gen_be_ounit) - - output_file = 'v.mean' ! Output v. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)v_mean - close(gen_be_ounit) - - output_file = 'v.stdv' ! Output v. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)v_mnsq - close(gen_be_ounit) - - output_file = 't.mean' ! Output t. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)temp_mean - close(gen_be_ounit) - - output_file = 't.stdv' ! Output t. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)temp_mnsq - close(gen_be_ounit) - - output_file = 'q.mean' ! Output q. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)q_mean - close(gen_be_ounit) - - output_file = 'q.stdv' ! Output q. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)q_mnsq - close(gen_be_ounit) - - output_file = 'ps.mean' ! Output ps. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)psfc_mean - close(gen_be_ounit) - - output_file = 'ps.stdv' ! Output ps. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)psfc_mnsq - close(gen_be_ounit) - - if ( has_cloud ) then - output_file = 'qcloud.mean' ! Output qcloud. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qcloud_mean - close(gen_be_ounit) - - output_file = 'qcloud.stdv' ! Output qcloud. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qcloud_mnsq - close(gen_be_ounit) - end if - - if ( has_rain ) then - output_file = 'qrain.mean' ! Output qrain. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qrain_mean - close(gen_be_ounit) - - output_file = 'qrain.stdv' ! Output qrain. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qrain_mnsq - close(gen_be_ounit) - end if - - if ( has_ice ) then - output_file = 'qice.mean' ! Output qice. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qice_mean - close(gen_be_ounit) - - output_file = 'qice.stdv' ! Output qice. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qice_mnsq - close(gen_be_ounit) - end if - - if ( has_snow ) then - output_file = 'qsnow.mean' ! Output qsnow. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qsnow_mean - close(gen_be_ounit) - - output_file = 'qsnow.stdv' ! Output qsnow. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qsnow_mnsq - close(gen_be_ounit) - end if - - if ( has_graup ) then - output_file = 'qgraup.mean' ! Output qgraup. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qgraup_mean - close(gen_be_ounit) - - output_file = 'qgraup.stdv' ! Output qgraup. - open (gen_be_ounit, file = output_file, form='unformatted') - write(gen_be_ounit)dim1, dim2, dim3 - write(gen_be_ounit)qgraup_mnsq - close(gen_be_ounit) - end if - - call da_free_unit(gen_be_iunit) - call da_free_unit(gen_be_ounit) - -#ifdef crayx1 -contains - - subroutine getarg(i, harg) - implicit none - character(len=*) :: harg - integer :: ierr, ilen, i - - call pxfgetarg(i, harg, ilen, ierr) - return - end subroutine getarg -#endif - -end program gen_be_ep2 - From cb02d46c38e533d915101da5fa2afececca3994e Mon Sep 17 00:00:00 2001 From: liujake Date: Fri, 27 Nov 2020 13:23:57 -0700 Subject: [PATCH 51/91] On branch latest_develop_mri4dvar modified: var/build/depend.txt --- var/build/depend.txt | 13 ++----------- 1 file changed, 2 insertions(+), 11 deletions(-) diff --git a/var/build/depend.txt b/var/build/depend.txt index ad8ded7ac1..feea45cc64 100644 --- a/var/build/depend.txt +++ b/var/build/depend.txt @@ -153,11 +153,7 @@ da_rfz_cv3.o : da_rfz_cv3.f90 da_rsl_interfaces.o : da_rsl_interfaces.f90 da_rttov.o : da_rttov.f90 da_rttov_ad.inc da_rttov_tl.inc da_rttov_direct.inc da_rttov_init.inc da_transform_xtoy_rttov_adj.inc da_transform_xtoy_rttov.inc da_get_innov_vector_rttov.inc da_rttov_k.inc da_wrf_interfaces.o da_tracing.o da_tools.o da_radiance1.o da_par_util.o da_tools_serial.o da_interpolation.o da_control.o module_radiance.o da_reporting.o module_domain.o da_define_structures.o da_satem.o : da_satem.f90 da_calculate_grady_satem.inc da_get_innov_vector_satem.inc da_check_max_iv_satem.inc da_transform_xtoy_satem_adj.inc da_transform_xtoy_satem.inc da_print_stats_satem.inc da_oi_stats_satem.inc da_residual_satem.inc da_jo_and_grady_satem.inc da_ao_stats_satem.inc da_tracing.o da_tools.o da_statistics.o da_physics.o da_par_util1.o da_par_util.o da_define_structures.o da_control.o module_domain.o -<<<<<<< HEAD -da_setup_structures.o : da_setup_structures.f90 da_write_vp.inc da_truncate_spectra.inc da_get_bins_info.inc da_write_kma_increments.inc da_write_increments_for_wrf_nmm_regional.inc da_write_increments.inc da_qfrmrh.inc da_cumulus.inc da_lcl.inc da_cloud_model.inc da_setup_runconstants.inc da_setup_obs_interp_wts.inc da_setup_obs_structures_madis.inc da_setup_obs_structures_bufr.inc da_setup_obs_structures_ascii.inc da_setup_obs_structures_rain.inc da_setup_obs_structures_radar.inc da_setup_obs_structures.inc da_setup_flow_predictors.inc da_setup_flow_predictors_para_read_opt1.inc da_chgvres.inc da_setup_cv.inc da_setup_be_nmm_regional.inc da_setup_be_regional.inc da_setup_be_ncep_gfs.inc da_setup_be_global.inc da_setup_background_errors.inc da_scale_background_errors.inc da_scale_background_errors_cv3.inc da_rescale_background_errors.inc da_interpolate_regcoeff.inc da_get_vertical_truncation.inc gsi_thinning.o module_radiance.o da_rf_cv3.o da_rfz_cv3.o da_vtox_transforms.o da_tracing.o da_tools.o da_tools_serial.o da_ssmi.o da_spectral.o da_recursive_filter.o da_reporting.o da_radiance.o da_par_util.o da_par_util1.o da_obs_io.o da_obs.o da_control.o da_wrf_interfaces.o da_define_structures.o module_domain.o da_wavelet.o da_chg_be_Vres.inc da_gen_eigen.inc da_eigen_to_covmatrix.inc da_setup_pseudo_obs.inc -======= -da_setup_structures.o : da_setup_structures.f90 da_truncate_spectra.inc da_get_bins_info.inc da_write_kma_increments.inc da_write_increments_for_wrf_nmm_regional.inc da_write_increments.inc da_qfrmrh.inc da_cumulus.inc da_lcl.inc da_cloud_model.inc da_setup_runconstants.inc da_setup_obs_interp_wts.inc da_setup_obs_structures_madis.inc da_setup_obs_structures_bufr.inc da_setup_obs_structures_ascii.inc da_setup_obs_structures_rain.inc da_setup_obs_structures_radar.inc da_setup_obs_structures.inc da_setup_flow_predictors.inc da_setup_flow_predictors_para_read_opt1.inc da_chgvres.inc da_setup_cv.inc da_setup_be_nmm_regional.inc da_setup_be_regional.inc da_setup_be_ncep_gfs.inc da_setup_be_global.inc da_setup_background_errors.inc da_scale_background_errors.inc da_scale_background_errors_cv3.inc da_rescale_background_errors.inc da_interpolate_regcoeff.inc da_get_vertical_truncation.inc gsi_thinning.o module_radiance.o da_rf_cv3.o da_rfz_cv3.o da_vtox_transforms.o da_tracing.o da_tools.o da_tools_serial.o da_ssmi.o da_spectral.o da_recursive_filter.o da_reporting.o da_radiance.o da_par_util.o da_par_util1.o da_obs_io.o da_obs.o da_control.o da_wrf_interfaces.o da_define_structures.o module_domain.o da_wavelet.o da_chg_be_Vres.inc da_gen_eigen.inc da_eigen_to_covmatrix.inc da_setup_pseudo_obs.inc da_setup_flow_predictors_ep_format2.inc da_setup_flow_predictors_ep_format3.inc da_get_alpha_vertloc.inc ->>>>>>> latest_develop +da_setup_structures.o : da_setup_structures.f90 da_truncate_spectra.inc da_get_bins_info.inc da_write_kma_increments.inc da_write_increments_for_wrf_nmm_regional.inc da_write_increments.inc da_qfrmrh.inc da_cumulus.inc da_lcl.inc da_cloud_model.inc da_setup_runconstants.inc da_setup_obs_interp_wts.inc da_setup_obs_structures_madis.inc da_setup_obs_structures_bufr.inc da_setup_obs_structures_ascii.inc da_setup_obs_structures_rain.inc da_setup_obs_structures_radar.inc da_setup_obs_structures.inc da_setup_flow_predictors.inc da_setup_flow_predictors_para_read_opt1.inc da_chgvres.inc da_setup_cv.inc da_setup_be_nmm_regional.inc da_setup_be_regional.inc da_setup_be_ncep_gfs.inc da_setup_be_global.inc da_setup_background_errors.inc da_scale_background_errors.inc da_scale_background_errors_cv3.inc da_rescale_background_errors.inc da_interpolate_regcoeff.inc da_get_vertical_truncation.inc gsi_thinning.o module_radiance.o da_rf_cv3.o da_rfz_cv3.o da_vtox_transforms.o da_tracing.o da_tools.o da_tools_serial.o da_ssmi.o da_spectral.o da_recursive_filter.o da_reporting.o da_radiance.o da_par_util.o da_par_util1.o da_obs_io.o da_obs.o da_control.o da_wrf_interfaces.o da_define_structures.o module_domain.o da_wavelet.o da_chg_be_Vres.inc da_gen_eigen.inc da_eigen_to_covmatrix.inc da_setup_pseudo_obs.inc da_setup_flow_predictors_ep_format2.inc da_setup_flow_predictors_ep_format3.inc da_get_alpha_vertloc.inc da_write_vp.inc da_ships.o : da_ships.f90 da_calculate_grady_ships.inc da_get_innov_vector_ships.inc da_check_max_iv_ships.inc da_transform_xtoy_ships_adj.inc da_transform_xtoy_ships.inc da_print_stats_ships.inc da_oi_stats_ships.inc da_residual_ships.inc da_jo_and_grady_ships.inc da_ao_stats_ships.inc da_tracing.o da_tools.o da_statistics.o da_physics.o da_grid_definitions.o da_par_util1.o da_par_util.o da_interpolation.o da_define_structures.o da_control.o module_domain.o da_sound.o : da_sound.f90 da_calculate_grady_sonde_sfc.inc da_check_max_iv_sonde_sfc.inc da_get_innov_vector_sonde_sfc.inc da_transform_xtoy_sonde_sfc_adj.inc da_transform_xtoy_sonde_sfc.inc da_print_stats_sonde_sfc.inc da_oi_stats_sonde_sfc.inc da_residual_sonde_sfc.inc da_jo_sonde_sfc_uvtq.inc da_jo_and_grady_sonde_sfc.inc da_ao_stats_sonde_sfc.inc da_check_buddy_sound.inc da_calculate_grady_sound.inc da_get_innov_vector_sound.inc da_check_max_iv_sound.inc da_transform_xtoy_sound_adj.inc da_transform_xtoy_sound.inc da_print_stats_sound.inc da_oi_stats_sound.inc da_residual_sound.inc da_jo_sound_uvtq.inc da_jo_and_grady_sound.inc da_ao_stats_sound.inc da_tracing.o da_physics.o da_grid_definitions.o da_par_util1.o da_par_util.o da_tools.o da_statistics.o da_interpolation.o module_domain.o da_define_structures.o da_control.o da_spectral.o : da_spectral.f90 da_apply_power.inc da_legtra_inv_adj.inc da_vtovv_spectral_adj.inc da_vv_to_v_spectral.inc da_vtovv_spectral.inc da_test_spectral.inc da_setlegpol.inc da_setlegpol_test.inc da_legtra.inc da_legtra_inv.inc da_initialize_h.inc da_get_reglats.inc da_get_gausslats.inc da_calc_power_spectrum.inc da_asslegpol.inc da_tracing.o da_tools_serial.o da_reporting.o da_par_util1.o da_define_structures.o da_control.o @@ -186,11 +182,7 @@ da_verif_tools.o : da_verif_tools.f90 da_verif_obs_control.o : da_verif_obs_control.f90 da_verif_obs_init.o : da_verif_obs_init.f90 da_verif_obs_control.o -<<<<<<< HEAD -da_vtox_transforms.o : da_vtox_transforms.f90 da_apply_be_adj.inc da_apply_be.inc da_transform_bal_adj.inc da_transform_bal.inc da_transform_vtovv_global_adj.inc da_transform_vtovv_global.inc da_get_aspoles.inc da_get_avpoles.inc da_get_spoles.inc da_get_vpoles.inc da_vertical_transform.inc da_transform_vptovv.inc da_transform_vvtovp_adj.inc da_transform_vvtovp.inc da_transform_vvtovp_inv.inc da_transform_vptox_adj.inc da_transform_vptox.inc da_transform_vptox_inv.inc da_transform_xtoxa_adj.inc da_transform_vtox_adj.inc da_transform_xtoxa.inc da_transform_vtox.inc da_transform_vtox_inv.inc da_transform_rescale.inc da_transform_vtovv_adj.inc da_transform_vtovv.inc da_transform_vtovv_inv.inc da_check_eof_decomposition.inc da_add_flow_dependence_xa_adj.inc da_add_flow_dependence_xa.inc da_add_flow_dependence_vp_adj.inc da_add_flow_dependence_vp.inc da_transform_vvtovp_dual_res.inc da_transform_vvtovp_adj_dual_res.inc da_wavelet.o da_wrf_interfaces.o da_tracing.o da_tools.o da_ssmi.o da_spectral.o da_reporting.o da_recursive_filter.o da_par_util.o da_physics.o da_dynamics.o da_define_structures.o da_control.o module_domain.o module_comm_dm.o module_dm.o interp_fcn.o da_copy_xa.inc da_add_xa.inc da_calc_flow_dependence_xa_adj.inc da_calc_flow_dependence_xa.inc da_calc_flow_dependence_xa_dual_res.inc da_calc_flow_dependence_xa_adj_dual_res.inc da_transform_vpatox.inc da_transform_vpatox_adj.inc -======= -da_vtox_transforms.o : da_vtox_transforms.f90 da_apply_be_adj.inc da_apply_be.inc da_transform_bal_adj.inc da_transform_bal.inc da_transform_vtovv_global_adj.inc da_transform_vtovv_global.inc da_get_aspoles.inc da_get_avpoles.inc da_get_spoles.inc da_get_vpoles.inc da_vertical_transform.inc da_transform_vptovv.inc da_transform_vvtovp_adj.inc da_transform_vvtovp.inc da_transform_vptox_adj.inc da_transform_vptox.inc da_transform_xtoxa_adj.inc da_transform_vtox_adj.inc da_transform_xtoxa.inc da_transform_vtox.inc da_transform_rescale.inc da_transform_vtovv_adj.inc da_transform_vtovv.inc da_check_eof_decomposition.inc da_add_flow_dependence_xa_adj.inc da_add_flow_dependence_xa.inc da_add_flow_dependence_vp_adj.inc da_add_flow_dependence_vp.inc da_transform_vvtovp_dual_res.inc da_transform_vvtovp_adj_dual_res.inc da_wavelet.o da_wrf_interfaces.o da_tracing.o da_tools.o da_ssmi.o da_spectral.o da_reporting.o da_recursive_filter.o da_par_util.o da_physics.o da_dynamics.o da_define_structures.o da_control.o module_domain.o module_comm_dm.o module_dm.o interp_fcn.o da_copy_xa.inc da_add_xa.inc da_calc_flow_dependence_xa_adj.inc da_calc_flow_dependence_xa.inc da_calc_flow_dependence_xa_dual_res.inc da_calc_flow_dependence_xa_adj_dual_res.inc da_transform_vpatox.inc da_transform_vpatox_adj.inc da_dual_res_c2n_ad.inc ->>>>>>> latest_develop +da_vtox_transforms.o : da_vtox_transforms.f90 da_apply_be_adj.inc da_apply_be.inc da_transform_bal_adj.inc da_transform_bal.inc da_transform_vtovv_global_adj.inc da_transform_vtovv_global.inc da_get_aspoles.inc da_get_avpoles.inc da_get_spoles.inc da_get_vpoles.inc da_vertical_transform.inc da_transform_vptovv.inc da_transform_vvtovp_adj.inc da_transform_vvtovp.inc da_transform_vptox_adj.inc da_transform_vptox.inc da_transform_xtoxa_adj.inc da_transform_vtox_adj.inc da_transform_xtoxa.inc da_transform_vtox.inc da_transform_rescale.inc da_transform_vtovv_adj.inc da_transform_vtovv.inc da_check_eof_decomposition.inc da_add_flow_dependence_xa_adj.inc da_add_flow_dependence_xa.inc da_add_flow_dependence_vp_adj.inc da_add_flow_dependence_vp.inc da_transform_vvtovp_dual_res.inc da_transform_vvtovp_adj_dual_res.inc da_wavelet.o da_wrf_interfaces.o da_tracing.o da_tools.o da_ssmi.o da_spectral.o da_reporting.o da_recursive_filter.o da_par_util.o da_physics.o da_dynamics.o da_define_structures.o da_control.o module_domain.o module_comm_dm.o module_dm.o interp_fcn.o da_copy_xa.inc da_add_xa.inc da_calc_flow_dependence_xa_adj.inc da_calc_flow_dependence_xa.inc da_calc_flow_dependence_xa_dual_res.inc da_calc_flow_dependence_xa_adj_dual_res.inc da_transform_vpatox.inc da_transform_vpatox_adj.inc da_dual_res_c2n_ad.inc da_transform_vvtovp_inv.inc da_transform_vptox_inv.inc da_transform_vtox_inv.inc da_transform_vtovv_inv.inc @@ -216,7 +208,6 @@ gen_be_ensmean.o : gen_be_ensmean.f90 da_reporting.o da_control.o gen_be_ensrf.o : gen_be_ensrf.f90 da_gen_be.o da_control.o gen_be_ep1.o : gen_be_ep1.f90 da_tools_serial.o da_gen_be.o da_control.o gen_be_ep2.o : gen_be_ep2.f90 da_gen_be.o da_tools_serial.o da_control.o -gen_be_ep2_serial.o : gen_be_ep2_serial.f90 da_gen_be.o da_tools_serial.o da_control.o gen_be_etkf.o : gen_be_etkf.f90 da_reporting.o da_etkf.o da_control.o gen_be_hist.o : gen_be_hist.f90 da_tools_serial.o da_control.o gen_be_read_regcoeffs.o : gen_be_read_regcoeffs.f90 From 88b607dbbb2791bd34096a9506efbe1ac04010fe Mon Sep 17 00:00:00 2001 From: liujake Date: Fri, 27 Nov 2020 14:05:27 -0700 Subject: [PATCH 52/91] On branch latest_develop_mri4dvar Recover 4dvar namelist modified: var/test/4dvar/namelist.input --- var/test/4dvar/namelist.input | 23 +---------------------- 1 file changed, 1 insertion(+), 22 deletions(-) diff --git a/var/test/4dvar/namelist.input b/var/test/4dvar/namelist.input index 8accd35130..0d23aaedf5 100644 --- a/var/test/4dvar/namelist.input +++ b/var/test/4dvar/namelist.input @@ -28,7 +28,6 @@ use_gpspwobs=true, use_gpsrefobs=true, use_qscatobs=true, use_rainobs=false, -use_ahiobs=true, / &wrfvar5 check_max_iv=true, @@ -60,26 +59,6 @@ calculate_cg_cost_fn=false, &wrfvar13 / &wrfvar14 -rtminit_nsensor=1 -rtminit_platform=31 -rtminit_satid=8 -rtminit_sensor=56 -thinning_mesh=36.0, -thinning=true, -qc_rad=true, -write_iv_rad_ascii=true, -write_oa_rad_ascii=true, -rtm_option=2, -crtm_cloud=false, -only_sea_rad=false, -use_varbc=true, -varbc_nobsmin=10, -varbc_scan=2, -calc_weightfunc =false, -crtm_irland_coef='IGBP.IRland.EmisCoeff.bin' -write_profile =false, -write_jacobian = false, -write_filtered_rad = false, / &wrfvar15 / @@ -169,7 +148,7 @@ real_data_init_type=3, &perturbation trajectory_io=true, enable_identity=false, -jcdfi_use=true, +jcdfi_use=false, jcdfi_diag=1, jcdfi_penalty=1000.0, / From 159ae94a74b3b2df125eab8a56e264146251d0fe Mon Sep 17 00:00:00 2001 From: liujake Date: Fri, 27 Nov 2020 14:23:27 -0700 Subject: [PATCH 53/91] On branch latest_develop_mri4dvar Remove the code changes for neighborhood non-rain radar DA scheme modified: var/da/da_radar/da_get_innov_vector_radar.inc modified: var/da/da_radar/da_radar.f90 modified: var/da/da_radar/da_write_oa_radar_ascii.inc --- var/da/da_radar/da_get_innov_vector_radar.inc | 225 +----------------- var/da/da_radar/da_radar.f90 | 4 - var/da/da_radar/da_write_oa_radar_ascii.inc | 4 +- 3 files changed, 6 insertions(+), 227 deletions(-) diff --git a/var/da/da_radar/da_get_innov_vector_radar.inc b/var/da/da_radar/da_get_innov_vector_radar.inc index cff36ad935..427f186618 100644 --- a/var/da/da_radar/da_get_innov_vector_radar.inc +++ b/var/da/da_radar/da_get_innov_vector_radar.inc @@ -12,9 +12,6 @@ subroutine da_get_innov_vector_radar (it, grid, ob, iv) !----------------------------------------------------------------------- implicit none -#ifdef DM_PARALLEL - include 'mpif.h' -#endif integer, intent(in) :: it ! External iteration. type(domain), intent(in) :: grid ! first guess state. @@ -66,19 +63,6 @@ subroutine da_get_innov_vector_radar (it, grid, ob, iv) logical :: echo_non_precip, echo_rf_good - ! variables for neighborhood no-rain scheme (radar_non_precip_opt=2) - integer :: proc, i_start, i_end, itmp1, itmp2 - integer :: norain - integer :: nk, ncount_local, ncount_sum, s - integer, allocatable :: ncount_all(:), rec(:) - integer, allocatable :: counts(:), displs(:) - integer, allocatable :: decrease(:), decrease_glob(:), decrease_local(:) - real :: range_x, range_y, range_z - real :: coefa, coefb, coefc - real, allocatable :: rf_local(:), i_local(:), j_local(:), z_local(:) - real, allocatable :: qrn_local(:), qs_local(:), qv_local(:) - real, allocatable :: obs_global(:), x_global(:), y_global(:), z_global(:) - real, allocatable :: qrn_global(:), qs_global(:), qv_global(:) !------------------------ ! for jung et al 2008 !------------------------ @@ -120,6 +104,7 @@ subroutine da_get_innov_vector_radar (it, grid, ob, iv) irv = 0; irvf = 0; irf = 0; irff = 0 + ! No point in going through and allocating all these variables if we're just going to quit anyway if ( use_radar_rf .and. use_radar_rhv ) then @@ -128,7 +113,7 @@ subroutine da_get_innov_vector_radar (it, grid, ob, iv) call da_error(__FILE__,__LINE__,message(1:2)) end if -if ( iv%info(radar)%nlocal > 0 ) then + allocate (model_p(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) allocate (model_u(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) allocate (model_v(iv%info(radar)%max_lev,iv%info(radar)%n1:iv%info(radar)%n2)) @@ -246,8 +231,6 @@ END IF end do end if -end if ! nlocal>0 - ! calculate background/model LCL to be used by use_radar_rqv if ( use_radar_rqv .and. cloudbase_calc_opt == 2 ) then do j = jts, jte @@ -257,7 +240,6 @@ end if ! nlocal>0 end do end if ! lcl for use_radar_rqv -if ( iv%info(radar)%nlocal > 0 ) then do n=iv%info(radar)%n1,iv%info(radar)%n2 if ( use_radar_rf ) then @@ -442,8 +424,7 @@ if ( iv%info(radar)%nlocal > 0 ) then ob_radar_rf = ob % radar(n) % rf(k) - if ( radar_non_precip_opt > 0 .and. radar_non_precip_opt /= 3 ) then - ! assimilate non_precip echo + if ( radar_non_precip_opt > 0 ) then ! assimilate non_precip echo if ( echo_non_precip ) then ! ob is non-precip if ( bg_rf > -15.0 ) then ! when background/model is precip @@ -560,7 +541,7 @@ if ( iv%info(radar)%nlocal > 0 ) then iv % radar(n) % rqv(k) % qc = -5 if ( echo_non_precip ) then ! ob is non-precip - if ( radar_non_precip_opt == 1 ) then ! assimilate non_precip echo + if ( radar_non_precip_opt > 0 ) then ! assimilate non_precip echo if ( bg_rf >= 20.0 .and. iv%radar(n)%height(k) > model_lcl(n) ) then iv % radar(n) % rqv(k) % qc = 0 @@ -629,207 +610,11 @@ if ( iv%info(radar)%nlocal > 0 ) then end if ! not surface or model lid end do level_loop end do -end if ! nlocal>0 - - if ( use_radar_rqv .and. radar_non_precip_opt == 2 ) then ! neighborhood no-rain scheme - - ncount_local = 0 - if ( iv%info(radar)%nlocal > 0 ) then - do n = iv%info(radar)%n1,iv%info(radar)%n2 - do k = 1,iv%info(radar)%levels(n) - ncount_local = ncount_local + 1 - end do - end do - end if - - allocate (ncount_all(0:num_procs-1)) -#ifdef DM_PARALLEL - call mpi_allgather( ncount_local, 1, mpi_integer, & - ncount_all, 1, mpi_integer, comm, ierr ) -#else - ncount_all(:) = ncount_local -#endif - ncount_sum = sum(ncount_all) - - allocate ( rf_local(ncount_local)) - allocate ( i_local(ncount_local)) - allocate ( j_local(ncount_local)) - allocate ( z_local(ncount_local)) - allocate (qrn_local(ncount_local)) - allocate ( qs_local(ncount_local)) - allocate ( qv_local(ncount_local)) - - if ( iv%info(radar)%nlocal > 0 ) then - nk = 0 - do n = iv%info(radar)%n1,iv%info(radar)%n2 - do k = 1,iv%info(radar)%levels(n) - nk = nk + 1 - rf_local(nk) = ob%radar(n)%rf(k) - i_local(nk) = iv%info(radar)%i(k,n) - j_local(nk) = iv%info(radar)%j(k,n) - z_local(nk) = iv%radar(n)%height(k) - iv%radar(n)%stn_loc%elv - qrn_local(nk) = model_qrn(k,n) - qs_local(nk) = model_qs(k,n) - qv_local(nk) = model_qv(k,n) - end do - end do - end if - - allocate (obs_global(ncount_sum)) - allocate ( x_global(ncount_sum)) - allocate ( y_global(ncount_sum)) - allocate ( z_global(ncount_sum)) - allocate (qrn_global(ncount_sum)) - allocate ( qs_global(ncount_sum)) - allocate ( qv_global(ncount_sum)) - -#ifdef DM_PARALLEL - allocate (counts(0:num_procs-1)) - allocate (displs(0:num_procs-1)) - counts(:) = ncount_all(:) - displs(0) = 0 - do proc = 1, num_procs-1 - displs(proc) = displs(proc-1) + counts(proc-1) - end do - call mpi_allgatherv( rf_local, ncount_local, true_mpi_real, & - obs_global, counts, displs, true_mpi_real, & - comm, ierr ) - call mpi_allgatherv( i_local, ncount_local, true_mpi_real, & - x_global, counts, displs, true_mpi_real, & - comm, ierr ) - call mpi_allgatherv( j_local, ncount_local, true_mpi_real, & - y_global, counts, displs, true_mpi_real, & - comm, ierr ) - call mpi_allgatherv( z_local, ncount_local, true_mpi_real, & - z_global, counts, displs, true_mpi_real, & - comm, ierr ) - call mpi_allgatherv( qrn_local, ncount_local, true_mpi_real, & - qrn_global, counts, displs, true_mpi_real, & - comm, ierr ) - call mpi_allgatherv( qs_local, ncount_local, true_mpi_real, & - qs_global, counts, displs, true_mpi_real, & - comm, ierr ) - call mpi_allgatherv( qv_local, ncount_local, true_mpi_real, & - qv_global, counts, displs, true_mpi_real, & - comm, ierr ) -#else - obs_global(:) = rf_local(:) - x_global(:) = i_local(:) - y_global(:) = j_local(:) - z_global(:) = z_local(:) - qrn_global(:) = qrn_local(:) - qs_global(:) = qs_local(:) - qv_global(:) = qv_local(:) -#endif - - deallocate ( rf_local) - deallocate ( i_local) - deallocate ( j_local) - deallocate ( z_local) - deallocate (qrn_local) - deallocate ( qs_local) - deallocate ( qv_local) - deallocate(ncount_all) - - ! determine the loop indices (i_start, i_end) for each proc given ncount_sum - itmp1 = ncount_sum/num_procs - itmp2 = mod(ncount_sum, num_procs) - i_start = myproc * itmp1 + 1 + min(myproc, itmp2) - i_end = i_start + itmp1 - 1 - if (itmp2 > myproc) i_end = i_end + 1 - - !todo: range_x/y/z should be namelist variables - range_x = 30000.0 !meter - range_y = 30000.0 !meter - range_z = 3000.0 !meter - coefa = (grid%dx/range_x)**2 - coefb = (grid%dx/range_y)**2 - coefc = (1.0/range_z)**2 - - allocate ( rec(ncount_sum)) - allocate ( decrease(ncount_sum)) - decrease(:) = 0 - do s = i_start, i_end - ! if non-precip obs (rf = radar_non_precip_rf) - echo_non_precip = abs(obs_global(s) - radar_non_precip_rf) < 0.1 - if ( echo_non_precip .and. qrn_global(s)>0.0 .and. qv_global(s) > 0.85*qs_global(s))then - i=0 - do n = 1, ncount_sum - if ( ((x_global(s)-x_global(n))**2*coefa + & - (y_global(s)-y_global(n))**2*coefb + & - (z_global(s)-z_global(n))**2*coefc) <= 1 ) then - i = i+1 - rec(i) = n - end if - end do - if ( i > 0 ) then - norain = 0 - do n = 1, i - if ( abs(obs_global(rec(n)) - radar_non_precip_rf) < 0.1 ) then - norain = norain + 1 - end if - end do - if ( float(norain)/float(i) >= 0.85 ) then - decrease(s) = 1 - end if - end if - end if - end do - deallocate (rec) - deallocate (obs_global) - deallocate ( x_global) - deallocate ( y_global) - deallocate ( z_global) - deallocate (qrn_global) - deallocate ( qs_global) - deallocate ( qv_global) - - allocate (decrease_local(ncount_local)) -#ifdef DM_PARALLEL - allocate ( decrease_glob(ncount_sum)) - call mpi_reduce(decrease, decrease_glob, ncount_sum, & - mpi_integer, mpi_sum, root, comm, ierr) - call mpi_scatterv(decrease_glob, counts, displs, mpi_integer, & - decrease_local, ncount_local, mpi_integer, & - root, comm, ierr) - deallocate (decrease_glob) -#else - decrease_local = decrease -#endif - - if ( iv%info(radar)%nlocal > 0 ) then - nk = 0 - do n = iv%info(radar)%n1, iv%info(radar)%n2 - do k = 1, iv%info(radar)%levels(n) - nk = nk + 1 !index for decrease_local array - echo_non_precip = abs(ob%radar(n)%rf(k) - radar_non_precip_rf) < 0.1 - if ( echo_non_precip .and. decrease_local(nk)==1 .and. & - model_qrn(k,n)>0.0 .and. model_qv(k,n) > 0.85*model_qs(k,n) .and. & - iv%radar(n)%height(k) > model_lcl(n) ) then - iv % radar(n) % rqv(k) % qc = 0 - iv % radar(n) % rf(k) % qc = 0 - iv % radar(n) % rqvo(k) = 0.9*model_qv(k,n) - iv % radar(n) % rqv(k) % inv = iv % radar(n) % rqvo(k) - model_qv(k,n) - iv % radar(n) % rqv(k) % error = amax1(0.001,0.20*iv % radar(n) % rqvo(k)) - end if - end do !k loop - end do !n1-n2 loop - end if !nlocal>0 - - deallocate (decrease) - deallocate (decrease_local) -#ifdef DM_PARALLEL - deallocate(counts) - deallocate(displs) -#endif - - end if ! use_radar_rqv and radar_non_precip_opt=2 !------------------------------------------------------------------------ ! [4.0] Perform optional maximum error check: !------------------------------------------------------------------------ -if ( iv%info(radar)%nlocal > 0 ) then if (check_max_iv) then call da_check_max_iv_radar(iv, it, irv, irf, irvf, irff) end if @@ -874,8 +659,6 @@ if ( iv%info(radar)%nlocal > 0 ) then deallocate (model_qs_ice) end if -end if ! nlocal>0 - if (trace_use) call da_trace_exit("da_get_innov_vector_radar") end subroutine da_get_innov_vector_radar diff --git a/var/da/da_radar/da_radar.f90 b/var/da/da_radar/da_radar.f90 index d0af1428e6..d971f6f604 100644 --- a/var/da/da_radar/da_radar.f90 +++ b/var/da/da_radar/da_radar.f90 @@ -31,10 +31,6 @@ module da_radar use da_tracing, only : da_trace_entry, da_trace_exit use da_reporting, only : da_error, da_warning, da_message, message use da_tools_serial, only : da_get_unit, da_free_unit -#ifdef DM_PARALLEL - use da_control, only : root - use da_par_util1, only : true_mpi_real -#endif ! The "stats_radar_type" is ONLY used locally in da_radar: diff --git a/var/da/da_radar/da_write_oa_radar_ascii.inc b/var/da/da_radar/da_write_oa_radar_ascii.inc index db8bfd1142..d8d91b7213 100644 --- a/var/da/da_radar/da_write_oa_radar_ascii.inc +++ b/var/da/da_radar/da_write_oa_radar_ascii.inc @@ -154,8 +154,8 @@ subroutine da_write_oa_radar_ascii ( ob, iv, re, it ) (/"Cannot open file "//trim(filename1(k))/)) read(omb_radar_unit, '(20x,i8)', iostat=ios)num_obs IF(ios /= 0)THEN - !write(unit=message(1),fmt='(A,A)') 'Nothing to read from ',filename1(k) - !call da_message(message(1:1)) + write(unit=message(1),fmt='(A,A)') 'Nothing to read from ',filename1(k) + call da_message(message(1:1)) cycle ENDIF if (num_obs > 0) then From d4e1b3a34afa6a6b05469e0c7ea4dbac2343f073 Mon Sep 17 00:00:00 2001 From: liujake Date: Fri, 27 Nov 2020 14:41:53 -0700 Subject: [PATCH 54/91] On branch latest_develop_mri4dvar Remove Changes of be reading for hydrometeor variables modified: Registry/registry.var modified: var/da/da_setup_structures/da_scale_background_errors.inc modified: var/da/da_setup_structures/da_setup_be_regional.inc --- Registry/registry.var | 3 +- .../da_scale_background_errors.inc | 2 +- .../da_setup_be_regional.inc | 290 +----------------- 3 files changed, 15 insertions(+), 280 deletions(-) diff --git a/Registry/registry.var b/Registry/registry.var index 277767c0d2..fb5f53ae71 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -283,7 +283,6 @@ rconfig character lanczos_ep_filename namelist,wrfvar6 1 "../lanczos_eig rconfig logical orthonorm_gradient namelist,wrfvar6 1 .false. - "orthonorm_gradient" "" "" rconfig integer cv_options namelist,wrfvar7 1 5 - "cv_options" "" "" rconfig integer cloud_cv_options namelist,wrfvar7 1 0 - "cloud_cv_options" "0: off, 1: qt, 3: specified qc,qr,qi,qs,qg BE" "" -rconfig integer ccv_be_inp_opt namelist,wrfvar7 1 0 - "ccv_be_inp_opt" "0: original hard-coded, 1: user-specified, 2: BE (cloud/w variables are embedded in be.dat) generated by GEN_BE_2.0, 3: BE (each cloud and w variable in its own file) generated by GEN_BE_V3" "" rconfig logical use_cv_w namelist,wrfvar7 1 .false. - "use_cv_w" "if activate w control variable when cloud_cv_options=3" "" rconfig real as1 namelist,wrfvar7 3*max_outer_iterations -1.0 - "as1" "" "" rconfig real as2 namelist,wrfvar7 3*max_outer_iterations -1.0 - "as2" "" "" @@ -499,7 +498,7 @@ rconfig character pseudo_var namelist,wrfvar19 1 "t" rconfig character documentation_url namelist,wrfvar20 1 "http://www.mmm.ucar.edu/people/wrfhelp/wrfvar/code/trunk" - "documentation_url" "" "" rconfig character time_window_min namelist,wrfvar21 1 "2002-08-02_21:00:00.0000" - "time_window_min" "" "" rconfig character time_window_max namelist,wrfvar22 1 "2002-08-03_03:00:00.0000" - "time_window_max" "" "" -rconfig integer radar_non_precip_opt namelist,radar_da 1 0 - "radar_non_precip_opt" "" "0: off, 1: KNU scheme, 2: NCAR neighborhood scheme" +rconfig integer radar_non_precip_opt namelist,radar_da 1 0 - "radar_non_precip_opt" "" "0: off, 1: KNU scheme" rconfig real radar_non_precip_rf namelist,radar_da 1 -999.99 - "radar_non_precip_rf" "rf value used to indicate non-precip ob" "dBZ" rconfig real radar_non_precip_rh_w namelist,radar_da 1 95.0 - "radar_non_precip_rh_w" "RH wrt water for non_precip rqv" "%" rconfig real radar_non_precip_rh_i namelist,radar_da 1 85.0 - "radar_non_precip_rh_i" "RH wrt ice for non_precip rqv" "%" diff --git a/var/da/da_setup_structures/da_scale_background_errors.inc b/var/da/da_setup_structures/da_scale_background_errors.inc index 1c5fcac09d..04c660ea0f 100644 --- a/var/da/da_setup_structures/da_scale_background_errors.inc +++ b/var/da/da_setup_structures/da_scale_background_errors.inc @@ -20,7 +20,7 @@ subroutine da_scale_background_errors ( be, it ) ! Rewind the unit: be_rf_unit = unit_end + 1 be_print_unit = unit_end + 2 - if ( rootproc ) rewind (be_rf_unit) + rewind (be_rf_unit) ! ! Read the dimensions and allocate the arrays: read(be_rf_unit) kz, jy, ix, v1_mz, v2_mz, v3_mz, v4_mz, v5_mz, ds diff --git a/var/da/da_setup_structures/da_setup_be_regional.inc b/var/da/da_setup_structures/da_setup_be_regional.inc index 1c32b1428c..4c00ecb616 100644 --- a/var/da/da_setup_structures/da_setup_be_regional.inc +++ b/var/da/da_setup_structures/da_setup_be_regional.inc @@ -124,10 +124,6 @@ subroutine da_setup_be_regional(xb, be, grid) !real :: qrain_th_low, qrain_th_high integer :: be_unit, ier, be_rf_unit, be_print_unit, it, idummy - integer :: ccv_be_unit, n - real :: rval - logical :: fexist - character(len=32) :: fname !-----------for interpolating CV5-------------------------------------------------------------- REAL, ALLOCATABLE :: reg_psi_ps0(:,:), reg_psi_chi0(:,:), reg_psi_t0(:,:,:), & @@ -163,12 +159,6 @@ subroutine da_setup_be_regional(xb, be, grid) call da_error(__FILE__,__LINE__,message(1:1)) end if - if ( cloud_cv_options == 2 .and. & - (ccv_be_inp_opt /= 2 .and. ccv_be_inp_opt /= 3) ) then - write (unit=message(1),fmt='(3x,A)') 'Please set ccv_be_inp_opt = 2 or 3 for cloud_cv_options=2' - call da_error(__FILE__,__LINE__,message(1:1)) - end if - ix = xb % mix jy = xb % mjy kz = xb % mkz @@ -596,6 +586,7 @@ subroutine da_setup_be_regional(xb, be, grid) end if if ( cloud_cv_options == 3 ) then + ! hard-coded the v6-v11 BE values here be % v6 % name = "qcloud" be % v7 % name = "qrain" be % v8 % name = "qice" @@ -619,116 +610,9 @@ subroutine da_setup_be_regional(xb, be, grid) if ( use_cv_w ) then be11_rf_lengthscale = 1.0 end if - else if ( ccv_be_inp_opt == 1 ) then - fname = 'be_ccv.txt' - inquire(file=trim(fname), exist=fexist) - if ( .not. fexist ) then - write (unit=message(1),fmt='(3x,A,5e10.3)') trim(fname)//' does not exist for ccv_be_inp_opt=1' - call da_error(__FILE__,__LINE__,message(1:1)) - end if - call da_get_unit(ccv_be_unit) - open(unit=ccv_be_unit,file=trim(fname), status="old",form="formatted") - read(ccv_be_unit,*) rval - be6_eval_glo(:) = rval - read(ccv_be_unit,*) rval - be7_eval_glo(:) = rval - read(ccv_be_unit,*) rval - be8_eval_glo(:) = rval - read(ccv_be_unit,*) rval - be9_eval_glo(:) = rval - read(ccv_be_unit,*) rval - be10_eval_glo(:) = rval - if ( use_rf ) then - read(ccv_be_unit,*) rval - be6_rf_lengthscale(:) = rval - read(ccv_be_unit,*) rval - be7_rf_lengthscale(:) = rval - read(ccv_be_unit,*) rval - be8_rf_lengthscale(:) = rval - read(ccv_be_unit,*) rval - be9_rf_lengthscale(:) = rval - read(ccv_be_unit,*) rval - be10_rf_lengthscale(:) = rval - end if - close(ccv_be_unit) - call da_free_unit(ccv_be_unit) - write (unit=message(1),fmt='(3x,A,5e10.3)') 'eval from be_ccv.txt: ', & - be6_eval_glo(1), be7_eval_glo(1), be8_eval_glo(1), be9_eval_glo(1), & - be10_eval_glo(1) - write (unit=message(2),fmt='(3x,A,5f10.3)') 'sl from be_ccv.txt: ', & - be6_rf_lengthscale(1), be7_rf_lengthscale(1), be8_rf_lengthscale(1), & - be9_rf_lengthscale(1), be10_rf_lengthscale(1) - call da_message(message(1:2)) - else - write (unit=message(1),fmt='(3x,A)') 'Please set ccv_be_inp_opt = 0 or 1 for cloud_cv_options=3' - call da_error(__FILE__,__LINE__,message(1:1)) - end if ! ccv_be_inp_opt for cloud_cv_options=3 + end if end if - if ( use_cv_w ) then - be % v11 % name = "w" - if ( ccv_be_inp_opt == 0 ) then - be11_eval_glo = 1.0 - if ( use_rf ) then - be11_rf_lengthscale = 1.0 - end if - else if ( ccv_be_inp_opt == 1 ) then - fname = 'be_w.txt' - inquire(file=trim(fname), exist=fexist) - if ( .not. fexist ) then - write (unit=message(1),fmt='(3x,A,5e10.3)') trim(fname)//' does not exist for ccv_be_inp_opt=1' - call da_error(__FILE__,__LINE__,message(1:1)) - end if - call da_get_unit(ccv_be_unit) - open(unit=ccv_be_unit,file=trim(fname), status="old",form="formatted") - read(ccv_be_unit,*) rval - be11_eval_glo(:) = rval - if ( use_rf ) then - read(ccv_be_unit,*) rval - be11_rf_lengthscale(:) = rval - end if - close(ccv_be_unit) - call da_free_unit(ccv_be_unit) - write (unit=message(1),fmt='(3x,A,e10.3)') 'eval from be_w.txt: ', & - be11_eval_glo(1) - write (unit=message(2),fmt='(3x,A,f10.3)') 'sl from be_w.txt: ', & - be11_rf_lengthscale(1) - call da_message(message(1:2)) - else if ( ccv_be_inp_opt == 3 ) then - ! w - fname = 'be_W.dat' - inquire(file=trim(fname), exist=fexist) - if ( .not. fexist ) then - write (unit=message(1),fmt='(3x,A,5e10.3)') trim(fname)//' does not exist for ccv_be_inp_opt=3' - call da_error(__FILE__,__LINE__,message(1:1)) - end if - call da_get_unit(ccv_be_unit) - open(unit=ccv_be_unit,file=trim(fname), status="old",form="unformatted") - do n = 1, 7 - ! skip the first 7 records - read (ccv_be_unit) - end do - allocate (evec_loc(1:nk,1:nk,1:num_bins2d)) - allocate (eval_loc(1:nk, 1:num_bins2d)) - read (ccv_be_unit) be11_evec_glo - read (ccv_be_unit) be11_eval_glo - read (ccv_be_unit) evec_loc - read (ccv_be_unit) eval_loc - if ( use_rf ) then - read (ccv_be_unit) be11_rf_lengthscale - end if - do j=1,nj - b = bin2d(1,j) - be11_evec_loc(j,1:nk,1:nk) = evec_loc(1:nk,1:nk,b) - be11_eval_loc(j,1:nk ) = eval_loc(1:nk,b) - end do - close(ccv_be_unit) - call da_free_unit(ccv_be_unit) - deallocate (evec_loc) - deallocate (eval_loc) - end if ! ccv_be_inp_opt for w - end if ! use_cv_w - ! 2.2 Read in the eigenvector and eigenvalue print *, '-------- reading eigen vector/value -------' @@ -934,148 +818,6 @@ subroutine da_setup_be_regional(xb, be, grid) deallocate (evec_loc) deallocate (eval_loc) - if ( cloud_cv_options == 2 .and. ccv_be_inp_opt == 3 ) then - be % v6 % name = "qcloud" - be % v7 % name = "qrain" - be % v8 % name = "qice" - be % v9 % name = "qsnow" - be % v10 % name = "qgraup" - call da_get_unit(ccv_be_unit) - allocate (evec_loc(1:nk,1:nk,1:num_bins2d)) - allocate (eval_loc(1:nk, 1:num_bins2d)) - ! qcloud - fname = 'be_QCLOUD.dat' - inquire(file=trim(fname), exist=fexist) - if ( .not. fexist ) then - write (unit=message(1),fmt='(3x,A,5e10.3)') trim(fname)//' does not exist for ccv_be_inp_opt=3' - call da_error(__FILE__,__LINE__,message(1:1)) - end if - open(unit=ccv_be_unit,file=trim(fname), status="old",form="unformatted") - ! hcl-todo: - ! the reading needs to be improved in the future - ! no checks are done on the dimensions yet - do n = 1, 7 - ! skip the first 7 records - read (ccv_be_unit) - end do - read (ccv_be_unit) be6_evec_glo - read (ccv_be_unit) be6_eval_glo - read (ccv_be_unit) evec_loc - read (ccv_be_unit) eval_loc - if ( use_rf ) then - read (ccv_be_unit) be6_rf_lengthscale - end if - do j=1,nj - b = bin2d(1,j) - be6_evec_loc(j,1:nk,1:nk) = evec_loc(1:nk,1:nk,b) - be6_eval_loc(j,1:nk ) = eval_loc(1:nk,b) - end do - close(ccv_be_unit) - ! qrain - fname = 'be_QRAIN.dat' - inquire(file=trim(fname), exist=fexist) - if ( .not. fexist ) then - write (unit=message(1),fmt='(3x,A,5e10.3)') trim(fname)//' does not exist for ccv_be_inp_opt=3' - call da_error(__FILE__,__LINE__,message(1:1)) - end if - open(unit=ccv_be_unit,file=trim(fname), status="old",form="unformatted") - do n = 1, 7 - ! skip the first 7 records - read (ccv_be_unit) - end do - read (ccv_be_unit) be7_evec_glo - read (ccv_be_unit) be7_eval_glo - read (ccv_be_unit) evec_loc - read (ccv_be_unit) eval_loc - if ( use_rf ) then - read (ccv_be_unit) be7_rf_lengthscale - end if - do j=1,nj - b = bin2d(1,j) - be7_evec_loc(j,1:nk,1:nk) = evec_loc(1:nk,1:nk,b) - be7_eval_loc(j,1:nk ) = eval_loc(1:nk,b) - end do - close(ccv_be_unit) - ! qice - fname = 'be_QICE.dat' - inquire(file=trim(fname), exist=fexist) - if ( .not. fexist ) then - write (unit=message(1),fmt='(3x,A,5e10.3)') trim(fname)//' does not exist for ccv_be_inp_opt=3' - call da_error(__FILE__,__LINE__,message(1:1)) - end if - open(unit=ccv_be_unit,file=trim(fname), status="old",form="unformatted") - do n = 1, 7 - ! skip the first 7 records - read (ccv_be_unit) - end do - read (ccv_be_unit) be8_evec_glo - read (ccv_be_unit) be8_eval_glo - read (ccv_be_unit) evec_loc - read (ccv_be_unit) eval_loc - if ( use_rf ) then - read (ccv_be_unit) be8_rf_lengthscale - end if - do j=1,nj - b = bin2d(1,j) - be8_evec_loc(j,1:nk,1:nk) = evec_loc(1:nk,1:nk,b) - be8_eval_loc(j,1:nk ) = eval_loc(1:nk,b) - end do - close(ccv_be_unit) - ! qsnow - fname = 'be_QSNOW.dat' - inquire(file=trim(fname), exist=fexist) - if ( .not. fexist ) then - write (unit=message(1),fmt='(3x,A,5e10.3)') trim(fname)//' does not exist for ccv_be_inp_opt=3' - call da_error(__FILE__,__LINE__,message(1:1)) - end if - open(unit=ccv_be_unit,file=trim(fname), status="old",form="unformatted") - do n = 1, 7 - ! skip the first 7 records - read (ccv_be_unit) - end do - read (ccv_be_unit) be9_evec_glo - read (ccv_be_unit) be9_eval_glo - read (ccv_be_unit) evec_loc - read (ccv_be_unit) eval_loc - if ( use_rf ) then - read (ccv_be_unit) be9_rf_lengthscale - end if - do j=1,nj - b = bin2d(1,j) - be9_evec_loc(j,1:nk,1:nk) = evec_loc(1:nk,1:nk,b) - be9_eval_loc(j,1:nk ) = eval_loc(1:nk,b) - end do - close(ccv_be_unit) - ! qgraup - fname = 'be_QGRAUP.dat' - inquire(file=trim(fname), exist=fexist) - if ( .not. fexist ) then - write (unit=message(1),fmt='(3x,A,5e10.3)') trim(fname)//' does not exist for ccv_be_inp_opt=3' - call da_error(__FILE__,__LINE__,message(1:1)) - end if - open(unit=ccv_be_unit,file=trim(fname), status="old",form="unformatted") - do n = 1, 7 - ! skip the first 7 records - read (ccv_be_unit) - end do - read (ccv_be_unit) be10_evec_glo - read (ccv_be_unit) be10_eval_glo - read (ccv_be_unit) evec_loc - read (ccv_be_unit) eval_loc - if ( use_rf ) then - read (ccv_be_unit) be10_rf_lengthscale - end if - do j=1,nj - b = bin2d(1,j) - be10_evec_loc(j,1:nk,1:nk) = evec_loc(1:nk,1:nk,b) - be10_eval_loc(j,1:nk ) = eval_loc(1:nk,b) - end do - close(ccv_be_unit) - deallocate (evec_loc) - deallocate (eval_loc) - call da_free_unit(ccv_be_unit) - end if - if(use_radarobs .and. use_radar_rf .or. use_rad .and. crtm_cloud) then if ( cloud_cv_options == 1 ) be % v4 % name = 'qt ' end if @@ -1154,7 +896,7 @@ subroutine da_setup_be_regional(xb, be, grid) end select end do ! num_cv_3d_basic - if ( cloud_cv_options == 2 .and. ccv_be_inp_opt == 2 ) then + if ( cloud_cv_options == 2 ) then do i = num_cv_3d_basic+1 , num_cv_3d_basic+num_cv_3d_extra read (be_unit) variable print *, trim(adjustl(variable)) @@ -1489,10 +1231,9 @@ subroutine da_setup_be_regional(xb, be, grid) call da_check_eof_decomposition(be8_eval_glo(:), be8_evec_glo(:,:), be % v8 % name) call da_check_eof_decomposition(be9_eval_glo(:), be9_evec_glo(:,:), be % v9 % name) call da_check_eof_decomposition(be10_eval_glo(:), be10_evec_glo(:,:), be % v10 % name) - end if - - if ( use_cv_w .and. (ccv_be_inp_opt == 2 .or. ccv_be_inp_opt == 3) ) then - call da_check_eof_decomposition(be11_eval_glo(:), be11_evec_glo(:,:), be % v11 % name) + if ( use_cv_w ) then + call da_check_eof_decomposition(be11_eval_glo(:), be11_evec_glo(:,:), be % v11 % name) + end if end if end if @@ -1509,6 +1250,9 @@ subroutine da_setup_be_regional(xb, be, grid) call da_get_vertical_truncation(max_vert_var8, be8_eval_glo(:), be % v8) call da_get_vertical_truncation(max_vert_var9, be9_eval_glo(:), be % v9) call da_get_vertical_truncation(max_vert_var10,be10_eval_glo(:),be % v10) + if ( use_cv_w ) then + call da_get_vertical_truncation(max_vert_var11,be11_eval_glo(:),be % v11) + end if else if ( jb_factor > 0.0 ) then be % v6 % mz = xb % mkz @@ -1516,24 +1260,16 @@ subroutine da_setup_be_regional(xb, be, grid) be % v8 % mz = xb % mkz be % v9 % mz = xb % mkz be % v10 % mz = xb % mkz + if ( use_cv_w ) then + be % v11 % mz = xb % mkz + end if else be % v6 % mz = 0 be % v7 % mz = 0 be % v8 % mz = 0 be % v9 % mz = 0 be % v10 % mz = 0 - end if - end if - - if ( use_cv_w ) then - if ( ccv_be_inp_opt == 2 .or. ccv_be_inp_opt == 3 ) then - call da_get_vertical_truncation(max_vert_var11,be11_eval_glo(:),be % v11) - else - if ( jb_factor > 0.0 ) then - be % v11 % mz = xb % mkz - else - be % v11 % mz = 0 - end if + be % v11 % mz = 0 end if end if From 5f94b7bb0ed895538cad482bb4493233758906d9 Mon Sep 17 00:00:00 2001 From: liujake Date: Fri, 27 Nov 2020 14:46:22 -0700 Subject: [PATCH 55/91] On branch latest_develop_mri4dvar remove duplicate ahiobs modified: Registry/registry.var --- Registry/registry.var | 1 - 1 file changed, 1 deletion(-) diff --git a/Registry/registry.var b/Registry/registry.var index fb5f53ae71..70ac66e01f 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -188,7 +188,6 @@ rconfig logical use_eos_amsuaobs namelist,wrfvar4 1 .false. - "use rconfig logical use_hsbobs namelist,wrfvar4 1 .false. - "use_hsbobs" "" "" rconfig logical use_ssmisobs namelist,wrfvar4 1 .false. - "use_ssmisobs" "" "" rconfig logical use_iasiobs namelist,wrfvar4 1 .false. - "use_iasiobs" "" "" -rconfig logical use_ahiobs namelist,wrfvar4 1 .false. - "use_ahiobs" "" "" rconfig logical use_seviriobs namelist,wrfvar4 1 .false. - "use_seviriobs" "" "" rconfig logical use_amsr2obs namelist,wrfvar4 1 .false. - "use_amsr2obs" "" "" rconfig logical use_ahiobs namelist,wrfvar4 1 .false. - "use_ahiobs" "" "" From cb89086b6aa095eff152215b8b6f23cb8796b768 Mon Sep 17 00:00:00 2001 From: liujake Date: Fri, 27 Nov 2020 15:12:01 -0700 Subject: [PATCH 56/91] On branch latest_develop_mri4dvar remove duplicate 'tropt' defination modified: var/da/da_define_structures/da_define_structures.f90 --- var/da/da_define_structures/da_define_structures.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/var/da/da_define_structures/da_define_structures.f90 b/var/da/da_define_structures/da_define_structures.f90 index 4254f664c5..f970d57fa6 100644 --- a/var/da/da_define_structures/da_define_structures.f90 +++ b/var/da/da_define_structures/da_define_structures.f90 @@ -609,7 +609,6 @@ module da_define_structures real, pointer :: vegfra(:) real, pointer :: clwp(:) ! model/guess clwp real, pointer :: clw(:) ! currently AMSR2 only - real, pointer :: tropt(:) !(Zhuge and Zou, 2016, JAMC, cloud check),rewritted by wuyl real, pointer :: SDob(:) !(Okamoto, 2017, AHI allsky QC) ,rewritted by wuyl real, pointer :: ps_jacobian(:,:) ! only RTTOV real, pointer :: ts_jacobian(:,:) ! only over water CRTM From 2dc0ec1bef6a20542db459dbadfa4e11e5aa0207 Mon Sep 17 00:00:00 2001 From: liujake Date: Fri, 27 Nov 2020 15:31:23 -0700 Subject: [PATCH 57/91] On branch latest_develop_mri4dvar Remove 'old' varbc bugfix as this was already merged earlier in develop modified: var/da/da_minimisation/da_get_innov_vector.inc --- .../da_minimisation/da_get_innov_vector.inc | 35 +++---------------- 1 file changed, 5 insertions(+), 30 deletions(-) diff --git a/var/da/da_minimisation/da_get_innov_vector.inc b/var/da/da_minimisation/da_get_innov_vector.inc index 6b43dfa452..438158e649 100644 --- a/var/da/da_minimisation/da_get_innov_vector.inc +++ b/var/da/da_minimisation/da_get_innov_vector.inc @@ -5,8 +5,6 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) ! Purpose: driver routine for getting innovation vectors ! History:$ ! 10/22/2008 - Updated for Analysis on Arakawa-C grid (Syed RH Rizvi, NCAR) - ! 03/2017 - Radar neighborhood no-rain scheme (radar_non_precip_opt=2) - ! requires all processors to call da_get_innov_vector_radar !----------------------------------------------------------------------- implicit none @@ -85,10 +83,10 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) endif do n= num_fgat_time , 1, -1 -print*,"jban check timeslot=",n,iv%time iv%time = n iv%info(:)%n1 = iv%info(:)%plocal(iv%time-1) + 1 iv%info(:)%n2 = iv%info(:)%plocal(iv%time) + if (num_fgat_time > 1) then if (var4d) then call domain_clock_get( grid, current_timestr=timestr ) @@ -100,14 +98,11 @@ print*,"jban check timeslot=",n,iv%time endif end if -! if ( multi_inc == 0 .or. multi_inc == 1) then -! eof_decomposition error if uesed ! Radiosonde: if (iv%info(sound)%nlocal > 0) then call da_get_innov_vector_sound (it, num_qcstat_conv, grid, ob, iv) call da_get_innov_vector_sonde_sfc (it, num_qcstat_conv, grid, ob, iv) end if - if (iv%info(mtgirs)%nlocal > 0) & call da_get_innov_vector_mtgirs (it, num_qcstat_conv, grid, ob, iv) if (iv%info(tamdar)%nlocal > 0) & @@ -174,7 +169,6 @@ print*,"jban check timeslot=",n,iv%time if (iv%info(airsr)%nlocal > 0) & call da_get_innov_vector_airsr (it,num_qcstat_conv, grid, ob, iv) -! end if !---------------------------------------------- ! [5] write out iv in ascii format !----------------------------------------------- @@ -195,33 +189,14 @@ print*,"jban check timeslot=",n,iv%time end if endif + if (n > 1 .and. var4d) call domain_clockadvance (grid) call domain_clockprint(150, grid, 'DEBUG Adjoint Forcing: get CurrTime from clock,') + end do + #if defined(RTTOV) || defined(CRTM) if (use_rad) then - if ( use_varbc .or. freeze_varbc ) then -! if ( num_fgat_time > 1 ) call da_varbc_coldstart(iv) -! end if -! if ( use_varbc .and. it == 1 ) call da_varbc_precond(iv) - if ( num_fgat_time > 1 ) then - iv%instid(:)%info%n1 = 1 - iv%instid(:)%info%n2 = iv%instid(:)%info%plocal(num_fgat_time) - call da_varbc_coldstart(iv) - do n= num_fgat_time , 1, -1 - iv%time = n - iv%instid(:)%info%n1 = iv%instid(:)%info%plocal(iv%time-1) + 1 - iv%instid(:)%info%n2 = iv%instid(:)%info%plocal(iv%time) - call da_varbc_direct(iv) - if (qc_rad) then - call da_qc_rad(it, ob, iv) - end if ! qc is conducted inside n1-n2 - end do - end if - end if - if ( use_varbc .and. it == 1 ) call da_varbc_precond(iv) !fixed by wuyl - end if -#endif iv%time = num_fgat_time iv%instid(:)%info%n1 = 1 iv%instid(:)%info%n2 = iv%instid(:)%info%plocal(num_fgat_time) @@ -281,6 +256,7 @@ print*,"jban check timeslot=",n,iv%time write(unit=stdout,fmt='(A,A)') 'Restore to first guess :fg at ',trim(analysis_date(1:19)) call da_read_basicstates ( xbx, grid, config_flags, timestr, filename1) end if + if (num_fgat_time > 1) then call nl_get_time_step ( grid%id, time_step_seconds) call domain_clock_set (grid, time_step_seconds=time_step_seconds) @@ -352,7 +328,6 @@ print*,"jban check timeslot=",n,iv%time end if #endif - !---------------------------------------------------------- ! [6] write out filtered radiance obs in binary format !---------------------------------------------------------- From b297202c7e74a908921fe8c20204c53b2d5d201e Mon Sep 17 00:00:00 2001 From: liujake Date: Fri, 27 Nov 2020 15:40:32 -0700 Subject: [PATCH 58/91] On branch latest_develop_mri4dvar remove duplicate varbc_scan modified: Registry/registry.var --- Registry/registry.var | 1 - 1 file changed, 1 deletion(-) diff --git a/Registry/registry.var b/Registry/registry.var index 70ac66e01f..e6e7f03f20 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -431,7 +431,6 @@ rconfig integer mw_emis_sea namelist,wrfvar14 1 1 - "mw rconfig integer tovs_min_transfer namelist,wrfvar14 1 10 - "tovs_min_transfer" "" "" rconfig logical tovs_batch namelist,wrfvar14 1 .false. - "tovs_batch" "" "" rconfig integer rtm_option namelist,wrfvar14 1 1 - "rtm_option" "" "" -rconfig integer varbc_scan namelist,wrfvar14 1 1 - "varbc_scan" "" "" rconfig logical use_crtm_kmatrix namelist,wrfvar14 1 .true. - "use_crtm_kmatrix" "" "" rconfig logical use_rttov_kmatrix namelist,wrfvar14 1 .false. - "use_rttov_kmatrix" "" "" rconfig logical crtm_cloud namelist,wrfvar14 1 .false. - "crtm_cloud" "" "" From c3f29db4b264525f81e25cf3c202fb9bb85c89a8 Mon Sep 17 00:00:00 2001 From: liujake Date: Fri, 27 Nov 2020 16:05:26 -0700 Subject: [PATCH 59/91] On branch latest_develop_mri4dvar remove duplicate 'tropt' allocate/deallocate modified: var/da/da_radiance/da_allocate_rad_iv.inc modified: var/da/da_radiance/da_deallocate_radiance.inc --- var/da/da_radiance/da_allocate_rad_iv.inc | 1 - var/da/da_radiance/da_deallocate_radiance.inc | 1 - 2 files changed, 2 deletions(-) diff --git a/var/da/da_radiance/da_allocate_rad_iv.inc b/var/da/da_radiance/da_allocate_rad_iv.inc index 8452f1c06f..98d33cef74 100644 --- a/var/da/da_radiance/da_allocate_rad_iv.inc +++ b/var/da/da_radiance/da_allocate_rad_iv.inc @@ -114,7 +114,6 @@ subroutine da_allocate_rad_iv (i, nchan, iv) allocate (iv%instid(i)%scanline(iv%instid(i)%num_rad)) allocate (iv%instid(i)%ifgat(iv%instid(i)%num_rad)) allocate (iv%instid(i)%cloud_flag(nchan,iv%instid(i)%num_rad)) - allocate (iv%instid(i)%tropt(iv%instid(i)%num_rad)) !(Zhuge Zou,2016,cloud check) allocate (iv%instid(i)%rain_flag(iv%instid(i)%num_rad)) allocate (iv%instid(i)%satzen(iv%instid(i)%num_rad)) allocate (iv%instid(i)%satazi(iv%instid(i)%num_rad)) diff --git a/var/da/da_radiance/da_deallocate_radiance.inc b/var/da/da_radiance/da_deallocate_radiance.inc index 86cd53ffa4..caf5662a9f 100644 --- a/var/da/da_radiance/da_deallocate_radiance.inc +++ b/var/da/da_radiance/da_deallocate_radiance.inc @@ -137,7 +137,6 @@ deallocate (iv%instid(i)%scanline) deallocate (iv%instid(i)%ifgat) deallocate (iv%instid(i)%cloud_flag) - deallocate (iv%instid(i)%tropt) deallocate (iv%instid(i)%rain_flag) deallocate (iv%instid(i)%satzen) deallocate (iv%instid(i)%satazi) From e8f632d27420b91c75db375ac2d85253dc39d81a Mon Sep 17 00:00:00 2001 From: liujake Date: Fri, 27 Nov 2020 16:30:22 -0700 Subject: [PATCH 60/91] On branch latest_develop_mri4dvar Recover unnecessary changes. make it consistent with new code. modified: var/da/da_radiance/da_get_innov_vector_crtm.inc modified: var/da/da_radiance/da_get_innov_vector_radiance.inc modified: var/da/da_radiance/da_qc_ahi.inc modified: var/da/da_radiance/da_qc_rad.inc modified: var/da/da_radiance/da_radiance.f90 deleted: var/da/da_radiance/da_read_obs_AHI.inc --- .../da_radiance/da_get_innov_vector_crtm.inc | 1 + .../da_get_innov_vector_radiance.inc | 5 +- var/da/da_radiance/da_qc_ahi.inc | 2 +- var/da/da_radiance/da_qc_rad.inc | 5 +- var/da/da_radiance/da_radiance.f90 | 3 +- var/da/da_radiance/da_read_obs_AHI.inc | 570 ------------------ 6 files changed, 8 insertions(+), 578 deletions(-) delete mode 100644 var/da/da_radiance/da_read_obs_AHI.inc diff --git a/var/da/da_radiance/da_get_innov_vector_crtm.inc b/var/da/da_radiance/da_get_innov_vector_crtm.inc index 5adbae4bf3..31b18b2ef0 100644 --- a/var/da/da_radiance/da_get_innov_vector_crtm.inc +++ b/var/da/da_radiance/da_get_innov_vector_crtm.inc @@ -942,6 +942,7 @@ subroutine da_get_innov_vector_crtm ( it, grid, ob, iv ) endif end do ! end loop for sensor + deallocate (wrf_to_crtm_mw) if ( use_clddet_zz ) deallocate ( geoht_full ) call CRTM_Atmosphere_Destroy (Atmosphere) diff --git a/var/da/da_radiance/da_get_innov_vector_radiance.inc b/var/da/da_radiance/da_get_innov_vector_radiance.inc index 773c009763..7588471cb7 100644 --- a/var/da/da_radiance/da_get_innov_vector_radiance.inc +++ b/var/da/da_radiance/da_get_innov_vector_radiance.inc @@ -1,4 +1,4 @@ -subroutine da_get_innov_vector_radiance (it,grid, ob, iv) +subroutine da_get_innov_vector_radiance (it, grid, ob, iv) !--------------------------------------------------------------------------- ! PURPOSE: Calculate innovation vector for radiance data. @@ -24,6 +24,7 @@ subroutine da_get_innov_vector_radiance (it,grid, ob, iv) iv%instid(:)%info%n1 = iv%instid(:)%info%plocal(iv%time-1) + 1 iv%instid(:)%info%n2 = iv%instid(:)%info%plocal(iv%time) + !------------------------------------------------------------------------ ! [1.0] calculate components of innovation vector !------------------------------------------------------------------------ @@ -45,12 +46,12 @@ subroutine da_get_innov_vector_radiance (it,grid, ob, iv) else call da_warning(__FILE__,__LINE__,(/"Unknown Radiative Transfer Model"/)) endif + !------------------------------------------------------------------------ ! [2.0] Perform (Variational) bias correction !------------------------------------------------------------------------ if (use_varbc .or. freeze_varbc) then call da_varbc_pred(iv) - !varbc coldstart can not be done here when num_fgat_time>1 !because da_varbc_coldstart uses all obs from all time slots else if (biascorr) then diff --git a/var/da/da_radiance/da_qc_ahi.inc b/var/da/da_radiance/da_qc_ahi.inc index 3735e979ae..474ea603ab 100644 --- a/var/da/da_radiance/da_qc_ahi.inc +++ b/var/da/da_radiance/da_qc_ahi.inc @@ -493,7 +493,7 @@ subroutine da_qc_ahi (it, i, nchan, ob, iv) if (.not. crtm_cloud ) then ! absolute departure check do k = 1, nchan - inv_grosscheck = 15.0 + inv_grosscheck = 8.0 if (use_satcv(2)) inv_grosscheck = 100.0 if (abs(iv%instid(i)%tb_inv(k,n)) > inv_grosscheck) then tb_qc(k) = qc_bad diff --git a/var/da/da_radiance/da_qc_rad.inc b/var/da/da_radiance/da_qc_rad.inc index bbadc0bab2..5957d903f9 100644 --- a/var/da/da_radiance/da_qc_rad.inc +++ b/var/da/da_radiance/da_qc_rad.inc @@ -65,7 +65,8 @@ subroutine da_qc_rad (it, ob, iv) seviri = trim(rttov_inst_name(rtminit_sensor(i))) == 'seviri' amsr2 = trim(rttov_inst_name(rtminit_sensor(i))) == 'amsr2' imager = trim(rttov_inst_name(rtminit_sensor(i))) == 'imager' - ahi = trim(rttov_inst_name(rtminit_sensor(i))) == 'ahi' + ahi = trim(rttov_inst_name(rtminit_sensor(i))) == 'ahi' + if (hirs) then ! 1.0 QC for HIRS call da_qc_hirs(it, i,nchan,ob,iv) @@ -103,8 +104,6 @@ subroutine da_qc_rad (it, ob, iv) call da_qc_ahi(it,i,nchan,ob,iv) else if (imager) then call da_qc_goesimg(it,i,nchan,ob,iv) - else if (ahi) then - call da_qc_ahi(it,i,nchan,ob,iv) else write(unit=message(1),fmt='(A,A)') & "Unrecognized instrument",trim(rttov_inst_name(rtminit_sensor(i))) diff --git a/var/da/da_radiance/da_radiance.f90 b/var/da/da_radiance/da_radiance.f90 index 03004a492d..e41030262e 100644 --- a/var/da/da_radiance/da_radiance.f90 +++ b/var/da/da_radiance/da_radiance.f90 @@ -125,12 +125,11 @@ module da_radiance #include "da_read_obs_bufriasi.inc" #include "da_read_obs_bufrseviri.inc" #include "da_read_obs_hdf5amsr2.inc" +#include "da_read_obs_hdf5ahi.inc" #include "da_read_obs_netcdf4ahi_geocat.inc" #include "da_read_obs_netcdf4ahi_jaxa.inc" #include "da_read_obs_ncgoesimg.inc" #include "da_get_satzen.inc" -#include "da_read_obs_hdf5ahi.inc" -#include "da_read_obs_AHI.inc" #include "da_allocate_rad_iv.inc" #include "da_initialize_rad_iv.inc" #include "da_read_kma1dvar.inc" diff --git a/var/da/da_radiance/da_read_obs_AHI.inc b/var/da/da_radiance/da_read_obs_AHI.inc deleted file mode 100644 index 02a7473450..0000000000 --- a/var/da/da_radiance/da_read_obs_AHI.inc +++ /dev/null @@ -1,570 +0,0 @@ -subroutine da_read_obs_AHI (iv, infile) - !-------------------------------------------------------- - ! Purpose: read in GEOCAT AHI Level-1 and Level-2 data in NETCDF4 format - ! and form innovation structure - ! - ! METHOD: use F90 sequantial data structure to avoid read the file twice - ! 1. read file radiance data in sequential data structure - ! 2. do gross QC check - ! 3. assign sequential data structure to innovation structure - ! and deallocate sequential data structure - ! - ! HISTORY: 2016/10/22 - Creation Yuanbing Wang, NUIST/CAS, NCAR/NESL/MMM/DAS - ! To be devoloped: 1.time information; 2.dimension sequence - !------------------------------------------------------------------------------ - - use netcdf - implicit none - - character(len=*), intent(in) :: infile - type(iv_type), intent(inout) :: iv - -! fixed parameter values - integer,parameter::time_dims=6 ! Time dimension - integer,parameter::nfile_max = 8 ! each netcdf file contains - -! interface variable - integer iret, rcode, ncid ! return status - -! array data - real(4), allocatable :: vlatitude(:,:) ! value for latitude - real(4), allocatable :: vlongitude(:,:) ! value for longitude - - real(4), allocatable :: tbb(:,:,:) ! tb for band 7-16 - real(4), allocatable :: sat_zenith(:,:) - real(4), allocatable :: sun_zenith(:,:) - real(4), allocatable :: tropo_temp(:,:) - - byte, allocatable :: cloud_mask(:,:) - byte, allocatable :: cloud_zou(:,:) - - real(r_kind),parameter :: tbmin = 50._r_kind - real(r_kind),parameter :: tbmax = 550._r_kind - - real(kind=8) :: obs_time - type (datalink_type),pointer :: head, p, current, prev - type(info_type) :: info - type(model_loc_type) :: loc - - integer(i_kind) :: idate5(6) - character(len=80) :: filename,str_tmp - - integer(i_kind) :: inst,platform_id,satellite_id,sensor_id - real(r_kind) :: tb, crit - integer(i_kind) :: ifgat, iout, iobs - logical :: outside, outside_all, iuse - - integer :: i,j,k,l,m,n, ifile, landsea_mask - logical :: found, head_found, head_allocated - -! Other work variables - real(r_kind) :: dlon_earth,dlat_earth - integer(i_kind) :: num_ahi_local, num_ahi_global, num_ahi_used, num_ahi_thinned - integer(i_kind) :: num_ahi_used_tmp, num_ahi_file - integer(i_kind) :: num_ahi_local_local, num_ahi_global_local, num_ahi_file_local - integer(i_kind) :: itx, itt - character(80) :: filename1,filename2 - integer :: nchan,nlongitude,nlatitude,ilongitude,ilatitude,ichannels - integer :: lonstart,latstart - integer :: LatDimID,LonDimID - integer :: latid,lonid,tbb_id,sazid,cltyid,sozid,ttp_id - integer :: nfile - character(80) :: fname_tb(nfile_max),fname_clp(nfile_max) - integer :: vtype - character(80) :: vname - logical :: fexist,got_clp_file - -! Allocatable arrays - integer(i_kind),allocatable :: ptotal(:) - real,allocatable :: in(:), out(:) - real(r_kind),allocatable :: data_all(:) - - character(len=2) tbb_name - - - if (trace_use) call da_trace_entry("da_read_obs_netcdf4ahi_geocat") - -! 0.0 Initialize variables -!----------------------------------- - head_allocated = .false. - platform_id = 31 ! Table-2 Col 1 corresponding to 'himawari' - satellite_id = 8 ! Table-2 Col 3 - sensor_id = 56 ! Table-3 Col 2 corresponding to 'ahi' - - allocate(ptotal(0:num_fgat_time)) - ptotal(0:num_fgat_time) = 0 - iobs = 0 ! for thinning, argument is inout - num_ahi_file = 0 - num_ahi_local = 0 - num_ahi_global = 0 - num_ahi_used = 0 - num_ahi_thinned = 0 - - do i = 1, rtminit_nsensor - if (platform_id == rtminit_platform(i) & - .and. satellite_id == rtminit_satid(i) & - .and. sensor_id == rtminit_sensor(i)) then - inst = i - exit - end if - end do - if (inst == 0) then - call da_warning(__FILE__,__LINE__, & - (/"The combination of Satellite_Id and Sensor_Id for AHI is not found"/)) - if (trace_use) call da_trace_exit("da_read_obs_netcdf4ahi_geocat") - return - end if - - nchan = iv%instid(inst)%nchan - write(unit=stdout,fmt=*)'AHI nchan: ',nchan - allocate(data_all(1:nchan)) - -! 1.0 Assign file names and prepare to read ahi files -!------------------------------------------------------------------------- - nfile = 0 !initialize - fname_tb(:) = '' !initialize - - ! first check if ahi nc file is available - filename1 = trim(infile) - inquire (file=filename1, exist=fexist) - if ( fexist ) then - nfile = 1 - fname_tb(nfile) = filename1 - else - ! check if netcdf4 files are available for multiple input files - ! here 0x is the input file sequence number - ! do not confuse it with fgat time slot index - do i = 1, nfile_max - write(filename1, fmt='(a, i2.2, a)') trim(infile), i -! write(filename1,fmt='(A,A,I2.2,A)') trim(infile),'-',i - inquire (file=filename1, exist=fexist) - if ( fexist ) then - nfile = nfile + 1 - fname_tb(nfile) = filename1 - else - exit - end if - write(unit=stdout,fmt=*)'AHI file name=: ',fname_tb(nfile) - end do - end if - - write(unit=stdout,fmt=*)'AHI file numbers=: ',nfile - if ( nfile == 0 ) then - call da_warning(__FILE__,__LINE__, & - (/"No valid AHI file found."/)) - if (trace_use) call da_trace_exit("da_read_obs_netcdf4ahi_geocat") - return - end if - - - !open the data area info file - open(unit=1990,file='ahi_info',status='old',iostat=iret) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__,(/"area_info file read error"/)) - endif - !read date information - read(1990,*) - read(1990,*) - read(1990,*) - read(1990,*) - read(1990,*) - read(1990,*) lonstart,latstart,nlongitude,nlatitude - close(1990) - - write(*,*) lonstart,latstart,nlongitude,nlatitude - - allocate(vlatitude(nlongitude,nlatitude)) - allocate(vlongitude(nlongitude,nlatitude)) - allocate(tbb(nlongitude,nlatitude,nchan)) - allocate(sat_zenith(nlongitude,nlatitude)) - allocate(sun_zenith(nlongitude,nlatitude)) - allocate(cloud_mask(nlongitude,nlatitude)) - allocate(cloud_zou(nlongitude,nlatitude)) - allocate(tropo_temp(nlongitude,nlatitude)) - infile_loop: do ifile = 1, nfile - num_ahi_file_local = 0 - num_ahi_local_local = 0 - num_ahi_global_local = 0 - - ! open NETCDF4 L1 file for read - iret = nf90_open(fname_tb(ifile), nf90_NOWRITE, ncid) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"Cannot open NETCDF4 file "//trim(fname_tb(ifile))/)) - cycle infile_loop - endif - - ! read array: time - iret = nf90_get_att(ncid, nf90_global, "Image_Date_Time", filename) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"NETCDF4 read error for: observation date"/)) - end if - read(filename,"(I4,A1,I2,A1,I2,A1,I2,A1,I2,A1,I2,A1)") idate5(1),str_tmp,idate5(2),str_tmp,& - idate5(3),str_tmp,idate5(4),str_tmp,idate5(5),str_tmp,idate5(6),str_tmp - write(unit=stdout,fmt=*)'observation date: ', idate5 - - ! read array: lat - ! read lat - iret = nf90_inq_varid(ncid, 'latitude', latid) -!wuyl allocate(vlatitude(nlongitude,nlatitude)) - iret = nf90_get_var(ncid,latid,vlatitude,start=(/lonstart,latstart/), & - count=(/nlongitude,nlatitude/)) ! - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"NETCDF4 read error for: Latitude of Observation Point"/)) - endif - ! sample display - write(unit=stdout,fmt=*)'vlatitude(pixel=1,scan=1): ',vlatitude(1,1) - - ! read lon - iret = nf90_inq_varid(ncid, 'longitude', lonid) -!wuyl allocate(vlongitude(nlongitude,nlatitude)) - iret = nf90_get_var(ncid,lonid,vlongitude,start=(/lonstart,latstart/), & - count=(/nlongitude,nlatitude/)) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"NETCDF4 read error for: Longitude of Observation Point"/)) - call da_trace_exit("da_read_obs_netcdf4ahi_geocat") - endif - ! sample display - write(unit=stdout,fmt=*)'vlongitude(pixel=1,scan=1): ',vlongitude(1,1) - - ! read array: tb for band 7-16 -!wuyl allocate(tbb(nlongitude,nlatitude,nchan)) - iret = nf90_inq_varid(ncid, "BT", tbb_id) - iret = nf90_get_var(ncid,tbb_id,tbb,start=(/lonstart,latstart,1/), & - count=(/nlongitude,nlatitude,10/)) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"NETCDF4 read error for: Brightness Temperature"/)) - endif - ! sample display - do k=1,10 - write(unit=stdout,fmt=*) 'tbb(pixel=1,scan=1,chan=',k,'): ', tbb(1,1,k) - enddo - - ! read array: satellite zenith angle - ! read - iret = nf90_inq_varid(ncid, 'satZenith', sazid) -!wuyl allocate(sat_zenith(nlongitude,nlatitude)) - iret = nf90_get_var(ncid,sazid,sat_zenith,start=(/lonstart,latstart/), & - count=(/nlongitude,nlatitude/)) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"NETCDF4 read error for: satellite zenith angle"/)) - endif - ! sample display - write(unit=stdout,fmt=*) 'satellite zenith angle(pixel=1,scan=1): ',sat_zenith(1,1) - - ! read array: sun zenith angle - iret = nf90_inq_varid(ncid, 'sunZenith', sozid) -!wuyl allocate(sun_zenith(nlongitude,nlatitude)) - iret = nf90_get_var(ncid,sozid,sun_zenith,start=(/lonstart,latstart/), & - count=(/nlongitude,nlatitude/)) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"NETCDF4 read error for: sun zenith angle"/)) - endif - ! sample display - write(unit=stdout,fmt=*) 'sun zenith angle(pixel=1,scan=1): ',sun_zenith(1,1) - - ! read array: satellite zenith angle - iret = nf90_inq_varid(ncid, 'cloudmask', cltyid) -!wuyl allocate(cloud_mask(nlongitude,nlatitude)) - iret = nf90_get_var(ncid,cltyid,cloud_mask,start=(/lonstart,latstart/), & - count=(/nlongitude,nlatitude/)) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"NETCDF4 read error for: satellite zenith angle"/)) - endif - ! sample display - write(unit=stdout,fmt=*) 'cloud mask of origin (pixel=1,scan=1): ',cloud_mask(1,1) - - ! read array: cloud mask of Zhuge and Zou(2017) - iret = nf90_inq_varid(ncid, 'clm_zou', cltyid) -!wuyl allocate(cloud_zou(nlongitude,nlatitude)) - iret = nf90_get_var(ncid,cltyid,cloud_zou,start=(/lonstart,latstart/), & - count=(/nlongitude,nlatitude/)) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"NETCDF4 read error for: satellite zenith angle"/)) - endif - ! sample display - write(unit=stdout,fmt=*) 'cloud mask of zou (pixel=1,scan=1): ',cloud_zou(1,1) - - ! close infile_tb file - iret = nf90_close(ncid) - -! read tropopause temprature - iret = nf90_open("trop_ahi.nc", nf90_NOWRITE, ncid) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"Cannot open NETCDF4 tropopause temprature file "/)) - endif - iret = nf90_inq_varid(ncid, "AhiTrp", ttp_id) -!wuyl allocate(tropo_temp(nlongitude,nlatitude)) - iret = nf90_get_var(ncid,ttp_id,tropo_temp) - if(iret /= 0)then - call da_warning(__FILE__,__LINE__, & - (/"NETCDF4 read error for: Tropopause Temperature"/)) - endif - iret = nf90_close(ncid) - -! 2.0 Loop to read netcdf and assign information to a sequential structure -!------------------------------------------------------------------------- - - ! Allocate arrays to hold data - if ( .not. head_allocated ) then - allocate (head) - nullify ( head % next ) - p => head - head_allocated = .true. - end if - - ! start scan_loop - scan_loop: do ilatitude=1, nlatitude - - call da_get_julian_time(idate5(1),idate5(2),idate5(3),idate5(4),idate5(5),obs_time) - if ( obs_time < time_slots(0) .or. & - obs_time >= time_slots(num_fgat_time) ) cycle scan_loop - do ifgat=1,num_fgat_time - if ( obs_time >= time_slots(ifgat-1) .and. & - obs_time < time_slots(ifgat) ) exit - end do - - ! start fov_loop - fov_loop: do ilongitude=1, nlongitude - - if ( sat_zenith(ilongitude,ilatitude) > 65.0 ) cycle fov_loop - - num_ahi_file = num_ahi_file + 1 - num_ahi_file_local = num_ahi_file_local + 1 - info%lat = vlatitude(ilongitude,ilatitude) - info%lon = vlongitude(ilongitude,ilatitude) - - call da_llxy (info, loc, outside, outside_all) - if (outside_all) cycle fov_loop - - num_ahi_global = num_ahi_global + 1 - num_ahi_global_local = num_ahi_global_local + 1 - ptotal(ifgat) = ptotal(ifgat) + 1 - if (outside) cycle fov_loop ! No good for this PE - - num_ahi_local = num_ahi_local + 1 - num_ahi_local_local = num_ahi_local_local + 1 - write(unit=info%date_char, & - fmt='(i4.4,a,i2.2,a,i2.2,a,i2.2,a,i2.2,a,i2.2)') & - idate5(1), '-', idate5(2), '-', idate5(3), '_', idate5(4), & - ':', idate5(5), ':', idate5(6) - info%elv = 0.0 - -! 3.0 Make Thinning -! Map obs to thinning grid -!------------------------------------------------------------------- - if (thinning) then - dlat_earth = info%lat !degree - dlon_earth = info%lon - if (dlon_earth=r360) dlon_earth = dlon_earth-r360 - dlat_earth = dlat_earth*deg2rad !radian - dlon_earth = dlon_earth*deg2rad - crit = 1. - call map2grids(inst,ifgat,dlat_earth,dlon_earth,crit,iobs,itx,1,itt,iout,iuse) - if (.not. iuse) then - num_ahi_thinned = num_ahi_thinned+1 - cycle fov_loop - end if - end if - - num_ahi_used = num_ahi_used + 1 - data_all = missing_r - - do k=1,nchan - tb = tbb(ilongitude,ilatitude,k) - if( tb < tbmin .or. tb > tbmax ) tb = missing_r - data_all(k)= tb - enddo - -! 4.0 assign information to sequential radiance structure -!-------------------------------------------------------------------------- - allocate ( p % tb_inv (1:nchan )) - p%info = info - p%loc = loc - p%landsea_mask = 1 - p%scanpos = ilongitude !nint(sat_zenith(ilongitude,ilatitude))+1.001_r_kind ! - p%satzen = sat_zenith(ilongitude,ilatitude) - p%satazi = 0 - p%solzen = 0 - p%solazi = 0 - p%tb_inv(1:nchan) = data_all(1:nchan) - p%sensor_index = inst - p%ifgat = ifgat -!wuyl p%cloudflag = cloud_mask(ilongitude,ilatitude) - p%cloudflag = cloud_zou(ilongitude,ilatitude) - - allocate (p%next) ! add next data - p => p%next - nullify (p%next) - end do fov_loop - end do scan_loop - - write(stdout,fmt='(3a,i10)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_file : ',num_ahi_file_local - write(stdout,fmt='(3a,i10)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_global : ',num_ahi_global_local - write(stdout,fmt='(3a,i10)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_local : ',num_ahi_local_local - end do infile_loop - - deallocate(data_all) ! Deallocate data arrays - !deallocate(cloudflag) - deallocate(vlatitude) - deallocate(vlongitude) - deallocate(tbb) - deallocate(sat_zenith) -! if( got_clp_file ) deallocate(cloud_mask) - - if (thinning .and. num_ahi_global > 0 ) then -#ifdef DM_PARALLEL - ! Get minimum crit and associated processor index. - j = 0 - do ifgat = 1, num_fgat_time - j = j + thinning_grid(inst,ifgat)%itxmax - end do - - allocate ( in (j) ) - allocate ( out (j) ) - j = 0 - do ifgat = 1, num_fgat_time - do i = 1, thinning_grid(inst,ifgat)%itxmax - j = j + 1 - in(j) = thinning_grid(inst,ifgat)%score_crit(i) - end do - end do - call mpi_reduce(in, out, j, true_mpi_real, mpi_min, root, comm, ierr) - - call wrf_dm_bcast_real (out, j) - - j = 0 - do ifgat = 1, num_fgat_time - do i = 1, thinning_grid(inst,ifgat)%itxmax - j = j + 1 - if ( ABS(out(j)-thinning_grid(inst,ifgat)%score_crit(i)) > 1.0E-10 ) & - thinning_grid(inst,ifgat)%ibest_obs(i) = 0 - end do - end do - - deallocate( in ) - deallocate( out ) - -#endif - - ! Delete the nodes which being thinning out - p => head - prev => head - head_found = .false. - num_ahi_used_tmp = num_ahi_used - do j = 1, num_ahi_used_tmp - n = p%sensor_index - ifgat = p%ifgat - found = .false. - - do i = 1, thinning_grid(n,ifgat)%itxmax - if ( thinning_grid(n,ifgat)%ibest_obs(i) == j .and. thinning_grid(n,ifgat)%score_crit(i) < 9.99e6_r_kind ) then - found = .true. - exit - end if - end do - - ! free current data - if ( .not. found ) then - - current => p - p => p%next - - if ( head_found ) then - prev%next => p - else - head => p - prev => p - end if - - deallocate ( current % tb_inv ) - deallocate ( current ) - - num_ahi_thinned = num_ahi_thinned + 1 - num_ahi_used = num_ahi_used - 1 - continue - end if - - if ( found .and. head_found ) then - prev => p - p => p%next - continue - end if - - if ( found .and. .not. head_found ) then - head_found = .true. - head => p - prev => p - p => p%next - end if - - end do - end if ! End of thinning - - iv%total_rad_pixel = iv%total_rad_pixel + num_ahi_used - iv%total_rad_channel = iv%total_rad_channel + num_ahi_used*nchan - - iv%info(radiance)%nlocal = iv%info(radiance)%nlocal + num_ahi_used - iv%info(radiance)%ntotal = iv%info(radiance)%ntotal + num_ahi_global - - do i = 1, num_fgat_time - ptotal(i) = ptotal(i) + ptotal(i-1) - iv%info(radiance)%ptotal(i) = iv%info(radiance)%ptotal(i) + ptotal(i) - end do - if ( iv%info(radiance)%ptotal(num_fgat_time) /= iv%info(radiance)%ntotal ) then - write(unit=message(1),fmt='(A,I10,A,I10)') & - "Number of ntotal:",iv%info(radiance)%ntotal," is different from the sum of ptotal:", iv%info(radiance)%ptotal(num_fgat_time) - call da_warning(__FILE__,__LINE__,message(1:1)) - endif - - write(unit=stdout,fmt='(a)') 'AHI data counts: ' - write(stdout,fmt='(a,i10)') ' In file: ',num_ahi_file - write(stdout,fmt='(a,i10)') ' Global : ',num_ahi_global - write(stdout,fmt='(a,i10)') ' Local : ',num_ahi_local - write(stdout,fmt='(a,i10)') ' Used : ',num_ahi_used - write(stdout,fmt='(a,i10)') ' Thinned: ',num_ahi_thinned - -! 5.0 allocate innovation radiance structure -!---------------------------------------------------------------- - - if (num_ahi_used > 0) then - iv%instid(inst)%num_rad = num_ahi_used - iv%instid(inst)%info%nlocal = num_ahi_used - write(UNIT=stdout,FMT='(a,i3,2x,a,3x,i10)') & - 'Allocating space for radiance innov structure', & - inst, iv%instid(inst)%rttovid_string, iv%instid(inst)%num_rad -! call da_allocate_rad_iv (inst, nchan, iv) - end if - -iv%instid(inst)%info%ptotal=ptotal -! 6.0 assign sequential structure to innovation structure -!------------------------------------------------------------- - p => head - call da_allocate_rad_iv (inst, nchan, iv) - - do n = 1, num_ahi_used - i = p%sensor_index - call da_initialize_rad_iv (i, n, iv, p) - current => p - p => p%next - ! free current data - deallocate ( current % tb_inv ) - deallocate ( current ) - end do - deallocate ( p ) - deallocate (ptotal) - - if (trace_use) call da_trace_exit("da_read_obs_netcdf4ahi_geocat") - - write(unit=stdout,fmt=*) 'da_read_obs_AHI.nc well done' -end subroutine da_read_obs_AHI From 6b544ba72a10c236ab41ce3045951a7e96362e75 Mon Sep 17 00:00:00 2001 From: liujake Date: Fri, 27 Nov 2020 17:39:14 -0700 Subject: [PATCH 61/91] On branch latest_develop_mri4dvar Recover varbc_scan change modified: var/da/da_varbc/da_varbc_pred.inc --- var/da/da_varbc/da_varbc_pred.inc | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/var/da/da_varbc/da_varbc_pred.inc b/var/da/da_varbc/da_varbc_pred.inc index b0a8f60795..b699d63ab6 100644 --- a/var/da/da_varbc/da_varbc_pred.inc +++ b/var/da/da_varbc/da_varbc_pred.inc @@ -75,8 +75,7 @@ subroutine da_varbc_pred(iv) if (npredmax >= 5) iv%instid(inst)%varbc_info%pred(5,n) = pred_hk(4) ! Scan predictors -!wuyl if (varbc_scan(inst) == 1) then ! use scanpos for polar-orbiting sensors - if (varbc_scan == 1) then ! use scanpos for polar-orbiting sensors + if (varbc_scan(inst) == 1) then ! use scanpos for polar-orbiting sensors if (npredmax >= 6) iv%instid(inst)%varbc_info%pred(6,n) = iv%instid(inst)%scanpos(n) if (npredmax >= 7) iv%instid(inst)%varbc_info%pred(7,n) = iv%instid(inst)%scanpos(n)**2 if (npredmax >= 8) iv%instid(inst)%varbc_info%pred(8,n) = iv%instid(inst)%scanpos(n)**3 From d7d38d93d09b6617953388b15bcb9035045009f4 Mon Sep 17 00:00:00 2001 From: liujake Date: Fri, 27 Nov 2020 17:56:24 -0700 Subject: [PATCH 62/91] On branch latest_develop_mri4dvar recover undeeded change modified: var/da/da_radiance/da_read_obs_fy3.inc --- var/da/da_radiance/da_read_obs_fy3.inc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/var/da/da_radiance/da_read_obs_fy3.inc b/var/da/da_radiance/da_read_obs_fy3.inc index 543460a2c6..c6f38b283f 100644 --- a/var/da/da_radiance/da_read_obs_fy3.inc +++ b/var/da/da_radiance/da_read_obs_fy3.inc @@ -219,7 +219,7 @@ bufrfile: do ibufr=1,numbufr iostat = iost, status = 'old') if (iost /= 0) then call da_warning(__FILE__,__LINE__, & - (/"Cannot open file "//infile/)) + (/"Cannot open file "//filename/)) if (trace_use) call da_trace_exit("da_read_obs_fy3") return end if From 8938e58ab96be948c4cb62a2c8e2f46bf4a877df Mon Sep 17 00:00:00 2001 From: liujake Date: Fri, 27 Nov 2020 18:02:30 -0700 Subject: [PATCH 63/91] On branch latest_develop_mri4dvar recover unneeded change modified: var/da/da_radiance/da_read_obs_hdf5ahi.inc --- var/da/da_radiance/da_read_obs_hdf5ahi.inc | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/var/da/da_radiance/da_read_obs_hdf5ahi.inc b/var/da/da_radiance/da_read_obs_hdf5ahi.inc index de7a7b2cb8..66f789e0ae 100644 --- a/var/da/da_radiance/da_read_obs_hdf5ahi.inc +++ b/var/da/da_radiance/da_read_obs_hdf5ahi.inc @@ -174,17 +174,6 @@ subroutine da_read_obs_hdf5ahi (iv,infile_tb,infile_clp) end if !open the data info file -! open(unit=1990,file='ahi_info',status='old',iostat=iret) -! if(iret /= 0)then -! call da_warning(__FILE__,__LINE__,(/"data_info file read error"/)) -! endif -! read(1990,*) -! read(1990,*) -! read(1990,*) -! read(1990,*) -! read(1990,*) -! read(1990,*) -! read(1990,*) call da_get_unit(ahi_info_unit) open(unit=ahi_info_unit,file='ahi_info',status='old',iostat=iret) if(iret /= 0)then @@ -369,7 +358,6 @@ subroutine da_read_obs_hdf5ahi (iv,infile_tb,infile_clp) end if !read date information -! read(1990,*) idate5(1),idate5(2),idate5(3),idate5(4),idate5(5),idate5(6) read(ahi_info_unit,*) idate5(1),idate5(2),idate5(3),idate5(4),idate5(5),idate5(6) ! 2.0 Loop to read hdf file and assign information to a sequential structure @@ -507,7 +495,6 @@ subroutine da_read_obs_hdf5ahi (iv,infile_tb,infile_clp) write(stdout,fmt='(3a,i7)') ' In file: ',trim(fname_tb(ifile)),' got num_ahi_local : ',num_ahi_local_local end do infile_loop -! close(1990) !close date information file close(ahi_info_unit) !close date information file call da_free_unit(ahi_info_unit) call H5close_f(iret) From 2ed74c3c07cfcec352fa7456e2a4c3b93d35ab0d Mon Sep 17 00:00:00 2001 From: liujake Date: Fri, 27 Nov 2020 18:09:41 -0700 Subject: [PATCH 64/91] On branch latest_develop_mri4dvar recover unneeded change modified: var/da/da_radiance/da_read_obs_netcdf4ahi_geocat.inc --- .../da_read_obs_netcdf4ahi_geocat.inc | 25 ++++++++----------- 1 file changed, 10 insertions(+), 15 deletions(-) diff --git a/var/da/da_radiance/da_read_obs_netcdf4ahi_geocat.inc b/var/da/da_radiance/da_read_obs_netcdf4ahi_geocat.inc index e4a7261718..52ca3b664c 100644 --- a/var/da/da_radiance/da_read_obs_netcdf4ahi_geocat.inc +++ b/var/da/da_radiance/da_read_obs_netcdf4ahi_geocat.inc @@ -93,13 +93,13 @@ subroutine da_read_obs_netcdf4ahi_geocat (iv, infile_tb, infile_clp) data tbb_name/'himawari_8_ahi_channel_7_brightness_temperature',& 'himawari_8_ahi_channel_8_brightness_temperature',& 'himawari_8_ahi_channel_9_brightness_temperature',& - 'himawari_8_ahi_channel_10_brightness_temperature',& - 'himawari_8_ahi_channel_11_brightness_temperature',& - 'himawari_8_ahi_channel_12_brightness_temperature',& - 'himawari_8_ahi_channel_13_brightness_temperature',& - 'himawari_8_ahi_channel_14_brightness_temperature',& - 'himawari_8_ahi_channel_15_brightness_temperature',& - 'himawari_8_ahi_channel_16_brightness_temperature'/ + 'himawari_8_ahi_channel_10_brightness_temperature',& + 'himawari_8_ahi_channel_11_brightness_temperature',& + 'himawari_8_ahi_channel_12_brightness_temperature',& + 'himawari_8_ahi_channel_13_brightness_temperature',& + 'himawari_8_ahi_channel_14_brightness_temperature',& + 'himawari_8_ahi_channel_15_brightness_temperature',& + 'himawari_8_ahi_channel_16_brightness_temperature'/ if (trace_use) call da_trace_entry("da_read_obs_netcdf4ahi_geocat") @@ -178,20 +178,12 @@ subroutine da_read_obs_netcdf4ahi_geocat (iv, infile_tb, infile_clp) !open the data area info file -! open(unit=1990,file='ahi_info',status='old',iostat=iret) call da_get_unit(ahi_info_unit) open(unit=ahi_info_unit,file='ahi_info',status='old',iostat=iret) if(iret /= 0)then call da_warning(__FILE__,__LINE__,(/"area_info file read error"/)) endif !read date information -! read(1990,*) -! read(1990,*) -! read(1990,*) -! read(1990,*) -! read(1990,*) -! read(1990,*) lonstart,latstart,nlongitude,nlatitude -! close(1990) read(ahi_info_unit,*) read(ahi_info_unit,*) read(ahi_info_unit,*) @@ -219,8 +211,10 @@ subroutine da_read_obs_netcdf4ahi_geocat (iv, infile_tb, infile_clp) ! read dimensions: latitude and longitude ! iret = nf90_inq_dimid(ncid, "lines", LatDimID) ! iret = nf90_inquire_dimension(ncid, LatDimID, len=nlatitude) + ! iret = nf90_inq_dimid(ncid, "elements", LonDimID) ! iret = nf90_inquire_dimension(ncid, LonDimID, len=nlongitude) + ! write(unit=stdout,fmt=*) nlongitude,nlatitude ! read array: time @@ -318,6 +312,7 @@ subroutine da_read_obs_netcdf4ahi_geocat (iv, infile_tb, infile_clp) ! close infile_tb file iret = nf90_close(ncid) + !open infile_clp file got_clp_file = .false. iret = nf90_open(fname_clp(ifile), nf90_NOWRITE, ncid) From ef113b75958de44d2e018f64f11aaa70f368d249 Mon Sep 17 00:00:00 2001 From: liujake Date: Fri, 27 Nov 2020 18:19:26 -0700 Subject: [PATCH 65/91] modified: var/da/da_radiance/da_read_obs_netcdf4ahi_geocat.inc --- var/da/da_radiance/da_read_obs_netcdf4ahi_geocat.inc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/var/da/da_radiance/da_read_obs_netcdf4ahi_geocat.inc b/var/da/da_radiance/da_read_obs_netcdf4ahi_geocat.inc index 52ca3b664c..57c4d0f71e 100644 --- a/var/da/da_radiance/da_read_obs_netcdf4ahi_geocat.inc +++ b/var/da/da_radiance/da_read_obs_netcdf4ahi_geocat.inc @@ -214,7 +214,7 @@ subroutine da_read_obs_netcdf4ahi_geocat (iv, infile_tb, infile_clp) ! iret = nf90_inq_dimid(ncid, "elements", LonDimID) ! iret = nf90_inquire_dimension(ncid, LonDimID, len=nlongitude) - + ! write(unit=stdout,fmt=*) nlongitude,nlatitude ! read array: time From 22b49ab567a9e9424b7699262701ff3bb6ae2721 Mon Sep 17 00:00:00 2001 From: liujake Date: Fri, 27 Nov 2020 18:24:55 -0700 Subject: [PATCH 66/91] On branch latest_develop_mri4dvar remove unneeded change modified: var/da/da_radiance/da_setup_radiance_structures.inc --- .../da_setup_radiance_structures.inc | 57 ------------------- 1 file changed, 57 deletions(-) diff --git a/var/da/da_radiance/da_setup_radiance_structures.inc b/var/da/da_radiance/da_setup_radiance_structures.inc index 7f056d96ec..4e92945fcb 100644 --- a/var/da/da_radiance/da_setup_radiance_structures.inc +++ b/var/da/da_radiance/da_setup_radiance_structures.inc @@ -262,63 +262,6 @@ subroutine da_setup_radiance_structures( grid, ob, iv ) !end if !write(unit=stdout,fmt='(a)') 'Finish reading goesimg data' end if - if (use_ahiobs) then - - !open the ahi info file - open(unit=1990,file='ahi_info',status='old',iostat=iret) - if(iret /= 0)then - call da_error(__FILE__,__LINE__,(/"Read ahi_info error: no such file"/)) - end if - !read ahi information - read(1990,*) - read(1990,*) data_format - close(1990) - -! if (data_format==1) then -!#if defined(HDF5) -! write(unit=stdout,fmt='(a)') 'Reading AHI data from cma hdf5' -! call da_read_obs_hdf5ahi (iv, 'L1AHITBR', 'L2AHICLP') -!#else -! call da_error(__FILE__,__LINE__,(/"To read AHI data, WRFDA must be compiled with HDF5"/)) -!#endif -! end if -!! if (data_format==2) then -!! write(unit=stdout,fmt='(a)') 'Reading AHI data from geocat NETCDF4' -!! if (num_fgat_time > 1) then -!! -!! do n=1, num_fgat_time -!! iv%time = n -!! filename = ' ' -!! -!! ! read AHI observation file -!! write(filename(1:10), fmt='(a, i2.2, a)') 'L1AHITBR', n -!! write(unit=stdout,fmt='(a)') 'Reading AHI data from geocat NETCDF4' -!! write(unit=stdout,fmt='(a)') filename(1:10) -!! call da_read_obs_AHI(iv, filename) -!! -!! end do -!! else -!! iv%time = 1 -!! -!! ! read AHI observation file -!! call da_read_obs_AHI(iv, 'L1AHITBR') -!! end if -!! end if -!! - if (data_format==2) then - write(unit=stdout,fmt='(a)') 'Reading AHI data from geocat NETCDF4' - call da_read_obs_AHI (iv, 'L1AHITBR') - end if -! if (data_format==3) then -! write(unit=stdout,fmt='(a)') 'Reading AHI data from JAXA NETCDF4' -! call da_read_obs_netcdf4ahi_jaxa (iv, 'L1AHITBR', 'L2AHICLP') -! end if -! !if (data_format==4) then -! !filename = 'ahi' -! !call da_read_obs_bufrahi ('ahi ',iv, filename) -! !end if - - end if end if if ( use_filtered_rad ) then From c112852753378dd1dd4f5372ffcedc1c498c7887 Mon Sep 17 00:00:00 2001 From: liujake Date: Fri, 27 Nov 2020 18:39:49 -0700 Subject: [PATCH 67/91] On branch latest_develop_mri4dvar recover unneeded change modified: var/da/da_radiance/da_transform_xtoy_crtm.inc modified: var/da/da_radiance/da_transform_xtoy_crtm_adj.inc --- var/da/da_radiance/da_transform_xtoy_crtm.inc | 26 ++++++++++--------- .../da_transform_xtoy_crtm_adj.inc | 10 ++++--- 2 files changed, 20 insertions(+), 16 deletions(-) diff --git a/var/da/da_radiance/da_transform_xtoy_crtm.inc b/var/da/da_radiance/da_transform_xtoy_crtm.inc index a6b2ced7a1..ed9febc0c6 100644 --- a/var/da/da_radiance/da_transform_xtoy_crtm.inc +++ b/var/da/da_radiance/da_transform_xtoy_crtm.inc @@ -245,18 +245,20 @@ subroutine da_transform_xtoy_crtm (cv_size, cv, grid, iv, y ) call da_interp_2d_partial (grid%xa%q(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, & absorber(kte-k+1,:)) - if (crtm_cloud) then - - call da_interp_2d_partial (grid%xa%qcw(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, & - qcw(kte-k+1,:)) - call da_interp_2d_partial (grid%xa%qci(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, & - qci(kte-k+1,:)) - call da_interp_2d_partial (grid%xa%qrn(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, & - qrn(kte-k+1,:)) - call da_interp_2d_partial (grid%xa%qsn(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, & - qsn(kte-k+1,:)) - call da_interp_2d_partial (grid%xa%qgr(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, & - qgr(kte-k+1,:)) + if ( crtm_cloud .and. cloud_cv_options > 0 ) then + + call da_interp_2d_partial (grid%xa%qcw(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, & + qcw(kte-k+1,:)) + call da_interp_2d_partial (grid%xa%qrn(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, & + qrn(kte-k+1,:)) + if ( cloud_cv_options > 1 ) then + call da_interp_2d_partial (grid%xa%qci(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, & + qci(kte-k+1,:)) + call da_interp_2d_partial (grid%xa%qsn(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, & + qsn(kte-k+1,:)) + call da_interp_2d_partial (grid%xa%qgr(:,:,k), iv%instid(inst)%info, k, iv%instid(inst)%info%n1, iv%instid(inst)%info%n2, & + qgr(kte-k+1,:)) + end if end if diff --git a/var/da/da_radiance/da_transform_xtoy_crtm_adj.inc b/var/da/da_radiance/da_transform_xtoy_crtm_adj.inc index 5ecaec9607..9de898e492 100644 --- a/var/da/da_radiance/da_transform_xtoy_crtm_adj.inc +++ b/var/da/da_radiance/da_transform_xtoy_crtm_adj.inc @@ -545,12 +545,14 @@ subroutine da_transform_xtoy_crtm_adj ( cv_size, cv, iv, jo_grad_y, jo_grad_x ) !!! call wrf_dm_sum_reals(cv_local, cv) !#endif - if (crtm_cloud) then + if ( crtm_cloud .and. cloud_cv_options > 0 ) then call da_interp_lin_2d_adj_partial(jo_grad_x%qcw(:,:,kts:kte),iv%instid(inst)%info, kts,kte, qcw_ad) - call da_interp_lin_2d_adj_partial(jo_grad_x%qci(:,:,kts:kte),iv%instid(inst)%info, kts,kte, qci_ad) call da_interp_lin_2d_adj_partial(jo_grad_x%qrn(:,:,kts:kte),iv%instid(inst)%info, kts,kte, qrn_ad) - call da_interp_lin_2d_adj_partial(jo_grad_x%qsn(:,:,kts:kte),iv%instid(inst)%info, kts,kte, qsn_ad) - call da_interp_lin_2d_adj_partial(jo_grad_x%qgr(:,:,kts:kte),iv%instid(inst)%info, kts,kte, qgr_ad) + if ( cloud_cv_options > 1 ) then + call da_interp_lin_2d_adj_partial(jo_grad_x%qci(:,:,kts:kte),iv%instid(inst)%info, kts,kte, qci_ad) + call da_interp_lin_2d_adj_partial(jo_grad_x%qsn(:,:,kts:kte),iv%instid(inst)%info, kts,kte, qsn_ad) + call da_interp_lin_2d_adj_partial(jo_grad_x%qgr(:,:,kts:kte),iv%instid(inst)%info, kts,kte, qgr_ad) + end if endif call da_interp_lin_2d_adj_partial(jo_grad_x%t(:,:,kts:kte), iv%instid(inst)%info, kts,kte, t_ad) From f09e39f738fd59a22ea318480937d5002cca11f1 Mon Sep 17 00:00:00 2001 From: liujake Date: Fri, 27 Nov 2020 19:02:03 -0700 Subject: [PATCH 68/91] On branch latest_develop_mri4dvar recover change modified: var/da/da_radiance/da_radiance1.f90 modified: var/da/da_radiance/da_radiance_init.inc --- var/da/da_radiance/da_radiance1.f90 | 3 +-- var/da/da_radiance/da_radiance_init.inc | 24 ++++++------------------ 2 files changed, 7 insertions(+), 20 deletions(-) diff --git a/var/da/da_radiance/da_radiance1.f90 b/var/da/da_radiance/da_radiance1.f90 index 54cf628295..014e03a6d6 100644 --- a/var/da/da_radiance/da_radiance1.f90 +++ b/var/da/da_radiance/da_radiance1.f90 @@ -251,9 +251,8 @@ module da_radiance1 #include "da_qc_atms.inc" #include "da_qc_seviri.inc" #include "da_qc_amsr2.inc" -!#include "da_qc_ahi.inc" +#include "da_qc_ahi.inc" #include "da_qc_goesimg.inc" -#include "da_qc_ahi_zou.inc" #include "da_write_iv_rad_ascii.inc" #include "da_write_iv_rad_for_multi_inc.inc" #include "da_read_iv_rad_for_multi_inc.inc" diff --git a/var/da/da_radiance/da_radiance_init.inc b/var/da/da_radiance/da_radiance_init.inc index e5df892087..3ec39878bb 100644 --- a/var/da/da_radiance/da_radiance_init.inc +++ b/var/da/da_radiance/da_radiance_init.inc @@ -151,25 +151,13 @@ subroutine da_radiance_init(iv,ob) else if ( trim( crtm_sensor_name(rtminit_sensor(n))) == 'imgr' ) then nchanl(n) = 4 nscan(n) = 60 - else if ( trim( crtm_sensor_name(rtminit_sensor(n))) == 'ahi' ) then - - !open the ahi info file - open(unit=1990,file='ahi_info',status='old',iostat=iret) - if(iret /= 0)then - call da_error(__FILE__,__LINE__,(/"Read ahi_info error: no such file"/)) - end if - !read ahi information - read(1990,*) - read(1990,*) - read(1990,*) - read(1990,*) nscan(n) - close(1990) - write(*,*) nscan(n) - nchanl(n) = 10 - else - call da_error(__FILE__,__LINE__, & - (/"Unrecognized instrument"/)) + write(unit=message(1),fmt='(A)') "Unrecognized instrument: " + write(unit=message(2),fmt='(A,I4)') "rtminit_platform = ",rtminit_platform(n) + write(unit=message(3),fmt='(A,I4)') "rtminit_satid = ",rtminit_satid(n) + write(unit=message(4),fmt='(A,I4)') "rtminit_sensor = ",rtminit_sensor(n) + write(unit=message(5),fmt='(A)') "Check your namelist settings" + call da_error(__FILE__,__LINE__,message(1:5)) end if iv%instid(n)%nchan = nchanl(n) From 977c0b1833d8bb389fafadfe966ab7061b195282 Mon Sep 17 00:00:00 2001 From: liujake Date: Fri, 27 Nov 2020 19:29:43 -0700 Subject: [PATCH 69/91] On branch latest_develop_mri4dvar Remove ca_mean and SDob of all-sky ahi modified: var/da/da_define_structures/da_define_structures.f90 modified: var/da/da_radiance/da_allocate_rad_iv.inc modified: var/da/da_radiance/da_deallocate_radiance.inc modified: var/da/da_radiance/da_radiance1.f90 --- var/da/da_define_structures/da_define_structures.f90 | 2 -- var/da/da_radiance/da_allocate_rad_iv.inc | 2 -- var/da/da_radiance/da_deallocate_radiance.inc | 2 -- var/da/da_radiance/da_radiance1.f90 | 4 +--- 4 files changed, 1 insertion(+), 9 deletions(-) diff --git a/var/da/da_define_structures/da_define_structures.f90 b/var/da/da_define_structures/da_define_structures.f90 index f970d57fa6..bb0e2cefaa 100644 --- a/var/da/da_define_structures/da_define_structures.f90 +++ b/var/da/da_define_structures/da_define_structures.f90 @@ -538,7 +538,6 @@ module da_define_structures integer :: num_rad, nchan, nlevels integer :: num_rad_glo integer, pointer :: ichan(:) - real, pointer :: ca_mean(:,:) ! IR allsky control variable real, pointer :: tb_inv(:,:) integer, pointer :: tb_qc(:,:) real, pointer :: tb_error(:,:) @@ -609,7 +608,6 @@ module da_define_structures real, pointer :: vegfra(:) real, pointer :: clwp(:) ! model/guess clwp real, pointer :: clw(:) ! currently AMSR2 only - real, pointer :: SDob(:) !(Okamoto, 2017, AHI allsky QC) ,rewritted by wuyl real, pointer :: ps_jacobian(:,:) ! only RTTOV real, pointer :: ts_jacobian(:,:) ! only over water CRTM real, pointer :: windspeed_jacobian(:,:) ! only MV and over water CRTM diff --git a/var/da/da_radiance/da_allocate_rad_iv.inc b/var/da/da_radiance/da_allocate_rad_iv.inc index 98d33cef74..994ea46118 100644 --- a/var/da/da_radiance/da_allocate_rad_iv.inc +++ b/var/da/da_radiance/da_allocate_rad_iv.inc @@ -102,8 +102,6 @@ subroutine da_allocate_rad_iv (i, nchan, iv) allocate (iv%instid(i)%tb_qc(nchan,iv%instid(i)%num_rad)) allocate (iv%instid(i)%tb_inv(nchan,iv%instid(i)%num_rad)) allocate (iv%instid(i)%tb_error(nchan,iv%instid(i)%num_rad)) - allocate (iv%instid(i)%ca_mean(nchan,iv%instid(i)%num_rad)) - allocate (iv%instid(i)%SDob(iv%instid(i)%num_rad)) !(Okamoto,2017,ahi allsky) allocate (iv%instid(i)%tb_sens(nchan,iv%instid(i)%num_rad)) allocate (iv%instid(i)%tb_imp(nchan,iv%instid(i)%num_rad)) allocate (iv%instid(i)%rad_xb(nchan,iv%instid(i)%num_rad)) diff --git a/var/da/da_radiance/da_deallocate_radiance.inc b/var/da/da_radiance/da_deallocate_radiance.inc index caf5662a9f..5672d0484b 100644 --- a/var/da/da_radiance/da_deallocate_radiance.inc +++ b/var/da/da_radiance/da_deallocate_radiance.inc @@ -123,8 +123,6 @@ deallocate (iv%instid(i)%tb_xb_clr) end if deallocate (iv%instid(i)%tb_qc) - deallocate (iv%instid(i)%ca_mean) - deallocate (iv%instid(i)%SDob) deallocate (iv%instid(i)%tb_inv) deallocate (iv%instid(i)%tb_error) deallocate (iv%instid(i)%tb_sens) diff --git a/var/da/da_radiance/da_radiance1.f90 b/var/da/da_radiance/da_radiance1.f90 index 014e03a6d6..3e772fda0d 100644 --- a/var/da/da_radiance/da_radiance1.f90 +++ b/var/da/da_radiance/da_radiance1.f90 @@ -61,17 +61,15 @@ module da_radiance1 real, pointer :: pm(:), tm(:), qm(:), qrn(:), qcw(:),qci(:),qsn(:),qgr(:) real :: ps,ts,t2m,mr2m,u10,v10, clwp real :: smois, tslb, snowh, elevation,soiltyp,vegtyp,vegfra - real :: clw + real :: clw real :: tropt integer :: isflg integer :: cloudflag - real :: SDob ! real, pointer :: tb_xb(:) real, pointer :: tb_ob(:) real, pointer :: tb_inv(:) real, pointer :: tb_qc(:) - real, pointer :: ca_mean(:) real, pointer :: tb_error(:) integer :: sensor_index type (datalink_type), pointer :: next ! pointer to next data From 7aef7ad0dfdfaab46c52a176dca9576eb098eb10 Mon Sep 17 00:00:00 2001 From: liujake Date: Fri, 27 Nov 2020 19:39:10 -0700 Subject: [PATCH 70/91] On branch latest_develop_mri4dvar remove gmi/agri and ahi all-sky modified: var/da/da_radiance/da_allocate_rad_iv.inc modified: var/da/da_radiance/da_deallocate_radiance.inc --- var/da/da_radiance/da_allocate_rad_iv.inc | 15 +-------------- var/da/da_radiance/da_deallocate_radiance.inc | 15 +-------------- 2 files changed, 2 insertions(+), 28 deletions(-) diff --git a/var/da/da_radiance/da_allocate_rad_iv.inc b/var/da/da_radiance/da_allocate_rad_iv.inc index 994ea46118..97aedd1616 100644 --- a/var/da/da_radiance/da_allocate_rad_iv.inc +++ b/var/da/da_radiance/da_allocate_rad_iv.inc @@ -78,22 +78,9 @@ subroutine da_allocate_rad_iv (i, nchan, iv) if ( index(iv%instid(i)%rttovid_string, 'amsr2') > 0 ) then allocate (iv%instid(i)%clw(iv%instid(i)%num_rad)) end if - if ( index(iv%instid(i)%rttovid_string, 'gmi') > 0 ) then - allocate (iv%instid(i)%clw(iv%instid(i)%num_rad)) - end if - if ( index(iv%instid(i)%rttovid_string, 'ahi') > 0 ) then - allocate (iv%instid(i)%clw(iv%instid(i)%num_rad)) - end if - if ( index(iv%instid(i)%rttovid_string, 'agri') > 0 ) then - allocate (iv%instid(i)%clw(iv%instid(i)%num_rad)) - end if - if ( index(iv%instid(i)%rttovid_string, 'ahi') > 0 ) then allocate (iv%instid(i)%cloudflag(iv%instid(i)%num_rad)) - end if - if ( index(iv%instid(i)%rttovid_string, 'agri') > 0 ) then - allocate (iv%instid(i)%cloudflag(iv%instid(i)%num_rad)) - end if + end if allocate (iv%instid(i)%ps(iv%instid(i)%num_rad)) allocate (iv%instid(i)%tb_xb(nchan,iv%instid(i)%num_rad)) if ( crtm_cloud ) then diff --git a/var/da/da_radiance/da_deallocate_radiance.inc b/var/da/da_radiance/da_deallocate_radiance.inc index 5672d0484b..f7fe563e1b 100644 --- a/var/da/da_radiance/da_deallocate_radiance.inc +++ b/var/da/da_radiance/da_deallocate_radiance.inc @@ -101,22 +101,9 @@ if ( index(iv%instid(i)%rttovid_string,'amsr2') > 0 ) then deallocate (iv%instid(i)%clw) end if - if ( index(iv%instid(i)%rttovid_string,'gmi') > 0 ) then - deallocate (iv%instid(i)%clw) - end if - if ( index(iv%instid(i)%rttovid_string,'ahi') > 0 ) then - deallocate (iv%instid(i)%clw) - end if - if ( index(iv%instid(i)%rttovid_string,'agri') > 0 ) then - deallocate (iv%instid(i)%clw) - end if - if ( index(iv%instid(i)%rttovid_string, 'ahi') > 0 ) then deallocate (iv%instid(i)%cloudflag) - end if - if ( index(iv%instid(i)%rttovid_string, 'agri') > 0 ) then - deallocate (iv%instid(i)%cloudflag) - end if + end if deallocate (iv%instid(i)%ps) deallocate (iv%instid(i)%tb_xb) if ( crtm_cloud ) then From 4d47868e048bdc97717ad222e771d8e95b9bd0b7 Mon Sep 17 00:00:00 2001 From: liujake Date: Fri, 27 Nov 2020 19:43:02 -0700 Subject: [PATCH 71/91] copy from latest_develop modified: var/da/da_radiance/da_allocate_rad_iv.inc modified: var/da/da_radiance/da_deallocate_radiance.inc --- var/da/da_radiance/da_allocate_rad_iv.inc | 2 +- var/da/da_radiance/da_deallocate_radiance.inc | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/var/da/da_radiance/da_allocate_rad_iv.inc b/var/da/da_radiance/da_allocate_rad_iv.inc index 97aedd1616..1f8b825637 100644 --- a/var/da/da_radiance/da_allocate_rad_iv.inc +++ b/var/da/da_radiance/da_allocate_rad_iv.inc @@ -80,7 +80,7 @@ subroutine da_allocate_rad_iv (i, nchan, iv) end if if ( index(iv%instid(i)%rttovid_string, 'ahi') > 0 ) then allocate (iv%instid(i)%cloudflag(iv%instid(i)%num_rad)) - end if + end if allocate (iv%instid(i)%ps(iv%instid(i)%num_rad)) allocate (iv%instid(i)%tb_xb(nchan,iv%instid(i)%num_rad)) if ( crtm_cloud ) then diff --git a/var/da/da_radiance/da_deallocate_radiance.inc b/var/da/da_radiance/da_deallocate_radiance.inc index f7fe563e1b..d785b62c1f 100644 --- a/var/da/da_radiance/da_deallocate_radiance.inc +++ b/var/da/da_radiance/da_deallocate_radiance.inc @@ -103,7 +103,7 @@ end if if ( index(iv%instid(i)%rttovid_string, 'ahi') > 0 ) then deallocate (iv%instid(i)%cloudflag) - end if + end if deallocate (iv%instid(i)%ps) deallocate (iv%instid(i)%tb_xb) if ( crtm_cloud ) then From c633384c7e86666c0a0bed9eac89eaaa8dd8098d Mon Sep 17 00:00:00 2001 From: liujake Date: Fri, 27 Nov 2020 20:35:02 -0700 Subject: [PATCH 72/91] modified: var/da/da_minimisation/da_minimisation.f90 modified: var/da/da_obs_io/da_search_obs.inc modified: var/da/da_radiance/da_radiance1.f90 modified: var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc --- var/da/da_minimisation/da_minimisation.f90 | 4 ++-- var/da/da_obs_io/da_search_obs.inc | 1 + var/da/da_radiance/da_radiance1.f90 | 17 ++++------------- .../da_read_iv_rad_for_multi_inc.inc | 4 ++-- 4 files changed, 9 insertions(+), 17 deletions(-) diff --git a/var/da/da_minimisation/da_minimisation.f90 b/var/da/da_minimisation/da_minimisation.f90 index b6d7b5710d..18ebf3f626 100644 --- a/var/da/da_minimisation/da_minimisation.f90 +++ b/var/da/da_minimisation/da_minimisation.f90 @@ -33,7 +33,7 @@ module da_minimisation use da_buoy , only : da_calculate_grady_buoy, da_ao_stats_buoy, & da_oi_stats_buoy,da_get_innov_vector_buoy, da_residual_buoy, & da_jo_and_grady_buoy - use da_control, only : trace_use, var4d_bin, trajectory_io, analysis_date, qc_rad, & + use da_control, only : trace_use, var4d_bin, trajectory_io, analysis_date, & var4d, rootproc,jcdfi_use,jcdfi_diag,ierr,comm,num_fgat_time, & var4d_lbc, stdout, eps, stats_unit, test_dm_exact, global, multi_inc, & calculate_cg_cost_fn,anal_type_randomcv,cv_size_domain,je_factor, & @@ -165,7 +165,7 @@ module da_minimisation use da_transfer_model, only : da_transfer_wrftltoxa,da_transfer_xatowrftl, & da_transfer_xatowrftl_adj,da_transfer_wrftltoxa_adj #if defined(RTTOV) || defined(CRTM) - use da_varbc, only : da_varbc_tl,da_varbc_adj,da_varbc_precond,da_varbc_coldstart,da_varbc_direct + use da_varbc, only : da_varbc_tl,da_varbc_adj,da_varbc_precond,da_varbc_coldstart, da_varbc_direct #endif use da_vtox_transforms, only : da_transform_vtox,da_transform_vtox_adj,da_transform_xtoxa,da_transform_xtoxa_adj use da_vtox_transforms, only : da_copy_xa, da_add_xa, da_transform_vpatox, da_transform_vpatox_adj diff --git a/var/da/da_obs_io/da_search_obs.inc b/var/da/da_obs_io/da_search_obs.inc index 1576a82b27..b664655497 100644 --- a/var/da/da_obs_io/da_search_obs.inc +++ b/var/da/da_obs_io/da_search_obs.inc @@ -344,6 +344,7 @@ subroutine da_search_obs (ob_type_string, unit_in, num_obs, nth, iv, found_flag) do n = 1, num_obs read(unit_in,'(2i8,2E22.13)') n_dummy, levels, lat, lon + if ( abs(iv%info(radar)%lat(1,nth) - lat ) < MIN_ERR .and. & abs(iv%info(radar)%lon(1,nth) - lon ) < MIN_ERR ) then diff --git a/var/da/da_radiance/da_radiance1.f90 b/var/da/da_radiance/da_radiance1.f90 index 3e772fda0d..f03b0bd893 100644 --- a/var/da/da_radiance/da_radiance1.f90 +++ b/var/da/da_radiance/da_radiance1.f90 @@ -10,10 +10,10 @@ module da_radiance1 use module_radiance, only : CRTM_Planck_Radiance, CRTM_Planck_Temperature #endif #ifdef RTTOV - use module_radiance, only : coefs, coef_scatt + use module_radiance, only : coefs #endif - use da_control, only : trace_use,missing_r, rootproc, ierr,comm,root,& + use da_control, only : trace_use,missing_r, rootproc, & stdout,myproc,qc_good,num_fgat_time,qc_bad, & use_error_factor_rad,biasprep_unit,obs_qc_pointer, filename_len, & print_detail_rad, rtm_option, trace_use_dull, & @@ -28,7 +28,7 @@ module da_radiance1 be_type, clddet_geoir_type, superob_type use module_dm, only : wrf_dm_sum_real, wrf_dm_sum_integer use da_par_util, only : da_proc_stats_combine - use da_par_util1, only : da_proc_sum_int,da_proc_sum_ints,true_mpi_real + use da_par_util1, only : da_proc_sum_int,da_proc_sum_ints use da_reporting, only : da_error, message use da_statistics, only : da_stats_calculate use da_tools, only : da_residual_new, da_eof_decomposition @@ -62,7 +62,6 @@ module da_radiance1 real :: ps,ts,t2m,mr2m,u10,v10, clwp real :: smois, tslb, snowh, elevation,soiltyp,vegtyp,vegfra real :: clw - real :: tropt integer :: isflg integer :: cloudflag @@ -83,14 +82,6 @@ module da_radiance1 real , pointer :: t_jac(:,:) => null() real , pointer :: q_jac(:,:) => null() real , pointer :: ps_jac(:) => null() - - real , pointer :: ph(:) - real , pointer :: cc(:) - real , pointer :: clw(:) ! kg/kg - real , pointer :: ciw(:) ! kg/kg - real , pointer :: rain(:) ! kg/kg - real , pointer :: sp(:) ! kg/kg - end type con_vars_type type con_cld_vars_type @@ -192,6 +183,7 @@ module da_radiance1 real, pointer :: clw(:) ! cloud liquid water (kg/kg) real, pointer :: ciw(:) ! cloud ice water (kg/kg) integer, pointer :: cloudflag(:) ! cloud flag + end type rad_data_type type bias_type @@ -218,7 +210,6 @@ module da_radiance1 integer, allocatable :: tovs_recv_start(:,:) integer, allocatable :: tovs_copy_count(:) -include 'mpif.h' contains #include "da_jo_and_grady_rad.inc" diff --git a/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc b/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc index 2040fcbe0f..c2292654a5 100644 --- a/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc +++ b/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc @@ -29,7 +29,7 @@ subroutine da_read_iv_rad_for_multi_inc (it,ob, iv ) real, allocatable :: lat(:),lon(:) - if (trace_use) call da_trace_entry("da_read_iv_rad_ascii") + if (trace_use) call da_trace_entry("da_read_iv_rad_for_multi_inc") write(unit=message(1),fmt='(A)') 'Reading radiance OMB for multi_inc' call da_message(message(1:1)) @@ -128,7 +128,7 @@ subroutine da_read_iv_rad_for_multi_inc (it,ob, iv ) end do !num_fgat end do ! end do instruments -if (trace_use) call da_trace_exit("da_read_iv_rad_ascii") +if (trace_use) call da_trace_exit("da_read_iv_rad_for_multi_inc") end subroutine da_read_iv_rad_for_multi_inc From f069eb998917eb4d420b908d11ec4a0c32760cce Mon Sep 17 00:00:00 2001 From: liujake Date: Fri, 27 Nov 2020 20:51:17 -0700 Subject: [PATCH 73/91] modified: var/da/da_radiance/da_write_iv_rad_ascii.inc modified: var/run/radiance_info/himawari-8-ahi.info --- var/da/da_radiance/da_write_iv_rad_ascii.inc | 4 ++-- var/run/radiance_info/himawari-8-ahi.info | 18 +++++++++--------- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/var/da/da_radiance/da_write_iv_rad_ascii.inc b/var/da/da_radiance/da_write_iv_rad_ascii.inc index 3e4d9c9e4d..dd2865224a 100644 --- a/var/da/da_radiance/da_write_iv_rad_ascii.inc +++ b/var/da/da_radiance/da_write_iv_rad_ascii.inc @@ -1,4 +1,4 @@ -subroutine da_write_iv_rad_ascii (it,ob, iv ) +subroutine da_write_iv_rad_ascii (it, ob, iv ) !--------------------------------------------------------------------------- ! Purpose: write out innovation vector structure for radiance data. @@ -320,7 +320,7 @@ subroutine da_write_iv_rad_ascii (it,ob, iv ) end if ! end if write_jacobian end if ! end if proc_domain - end do ! end do pixels + end do ! end do pixels if (rtm_option==rtm_option_crtm .and. write_jacobian ) then deallocate ( dtransmt ) deallocate ( transmt_jac ) diff --git a/var/run/radiance_info/himawari-8-ahi.info b/var/run/radiance_info/himawari-8-ahi.info index 697e15f101..229563e49a 100644 --- a/var/run/radiance_info/himawari-8-ahi.info +++ b/var/run/radiance_info/himawari-8-ahi.info @@ -1,11 +1,11 @@ sensor channel IR/MW use idum varch polarisation(0:vertical;1:horizontal) 478 1 1 -1 0 1.0520000000E+00 1.0000000000E+00 28.30175 - 478 2 1 1 0 1.3350000000E+00 1.0000000000E+00 57.58830 - 478 3 1 1 0 1.4630000000E+00 1.0000000000E+00 12.69287 - 478 4 1 1 0 1.1650000000E+00 1.0000000000E+00 27.33099 - 478 5 1 -1 0 2.0540000000E+00 1.0000000000E+00 23.24269 - 478 6 1 -1 0 9.9310000000E+00 1.0000000000E+00 53.35099 - 478 7 1 -1 0 2.1670000000E+00 1.0000000000E+00 36.07700 - 478 8 1 -1 0 2.0810000000E+00 1.0000000000E+00 33.61592 - 478 9 1 -1 0 1.8300000000E+00 1.0000000000E+00 33.61592 - 478 10 1 -1 0 1.0900000000E+00 1.0000000000E+00 33.61592 + 478 2 1 1 0 1.7000000000E+00 1.0000000000E+00 57.58830 + 478 3 1 -1 0 1.7000000000E+00 1.0000000000E+00 12.69287 + 478 4 1 -1 0 1.3500000000E+00 1.0000000000E+00 27.33099 + 478 5 1 -1 0 0.8140000000E+00 1.0000000000E+00 23.24269 + 478 6 1 -1 0 0.9310000000E+00 1.0000000000E+00 53.35099 + 478 7 1 -1 0 0.8710000000E+00 1.0000000000E+00 36.07700 + 478 8 1 -1 0 0.9260000000E+00 1.0000000000E+00 33.61592 + 478 9 1 -1 0 0.9330000000E+00 1.0000000000E+00 33.61592 + 478 10 1 -1 0 0.7870000000E+00 1.0000000000E+00 33.61592 From 5b059c26d3f8e0f39773a48bb41a817f8621030f Mon Sep 17 00:00:00 2001 From: liujake Date: Sun, 29 Nov 2020 13:31:56 -0700 Subject: [PATCH 74/91] On branch latest_develop_mri4dvar Fixes so that code compiles Ok. modified: Registry/registry.var modified: var/da/da_main/da_solve.inc modified: var/da/da_main/da_wrfvar_top.f90 modified: var/da/da_radiance/da_radiance1.f90 --- Registry/registry.var | 1 - var/da/da_main/da_solve.inc | 61 +++++++---------------------- var/da/da_main/da_wrfvar_top.f90 | 2 + var/da/da_radiance/da_radiance1.f90 | 4 +- 4 files changed, 18 insertions(+), 50 deletions(-) diff --git a/Registry/registry.var b/Registry/registry.var index e6e7f03f20..b78a771649 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -265,7 +265,6 @@ rconfig integer report_end namelist,wrfvar5 1 10000000 - "rep rconfig integer tovs_start namelist,wrfvar5 1 1 - "tovs_start" "" "" rconfig integer tovs_end namelist,wrfvar5 1 10000000 - "tovs_end" "" "" rconfig logical gpsref_thinning namelist,wrfvar5 1 .false. - "gpsref_thinning" "" "" -rconfig logical outer_loop_restart namelist,wrfvar6 1 .false. - "outer_loop_restart" "" "" rconfig integer max_ext_its namelist,wrfvar6 1 1 - "max_ext_its" "" "" rconfig integer ntmax namelist,wrfvar6 max_outer_iterations 75 - "ntmax" "" "" rconfig logical use_inverse_squarerootb namelist,wrfvar6 1 .false. - "use_inverse_squarerootb" "" "" diff --git a/var/da/da_main/da_solve.inc b/var/da/da_main/da_solve.inc index 3cf192101c..3a761516e6 100644 --- a/var/da/da_main/da_solve.inc +++ b/var/da/da_main/da_solve.inc @@ -518,19 +518,6 @@ cv_size_domain_je = (ide_int - ids_int + 1) * (jde_int - jds_int + 1) * be % alpha % mz * be % ne endif - !write (*,*) "--------- Debug ---------------" - !write (*,*) "ids,ide,jds,jde,kds,kde= ", ids,ide,jds,jde,kds,kde - !write (*,*) "ips,ipe,jps,jpe,kps,kpe= ", ips,ipe,jps,jpe,kps,kpe - !write (*,*) "its,ite,jts,jte,kts,kte= ", its,ite,jts,jte,kts,kte - !write (*,*) "ims,ime,jms,jme,kms,kme= ", ims,ime,jms,jme,kms,kme - !write (*,*) "mz 1-5= ",be%v1%mz, be%v2%mz, be%v3%mz, be%v4%mz, be%v5%mz - !write (*,*) "be % cv % size_jb = ", be % cv % size_jb - !write (*,*) "be % cv % size_jp = ", be % cv % size_jp - !write (*,*) "be % cv % size_js = ", be % cv % size_js - !write (*,*) "be % cv % size_jl = ", be % cv % size_jl - !write (*,*) "be % cv % size_je = ", be % cv % size_je - !write (*,*) "--------- Debug ---------------" - !--------------------------------------------------------------------------- ! [5.2] Set up observation bias correction (VarBC): !--------------------------------------------------------------------------- @@ -623,13 +610,6 @@ ! allocate (full_eignvec(cv_size)) ! end if -! liuz: if multi_inc == 0: run normal 3D/4D-Var -!------------------------------------------------------------------------ - call da_initialize_cv (cv_size, cvt) - call da_zero_vp_type (grid%vp) - call da_zero_vp_type (grid%vv) - - if ( multi_inc == 2 ) then !------------------------------------------------------ ! set CV to random noise ("RANDOMCV") !------------------------------------------------------ @@ -656,12 +636,15 @@ ! Done with randomcv. ! Set the following to skip some code to get to the deallocation part. max_ext_its = 0 - outer_loop_restart = .false. end if !anal_type_randomcv - if ( outer_loop_restart ) then - !call da_get_unit(cvt_unit) - cvt_unit=600 +! mri-4dvar: if multi_inc == 0: run normal 3D/4D-Var +!------------------------------------------------------------------------ + call da_initialize_cv (cv_size, cvt) + call da_zero_vp_type (grid%vp) + call da_zero_vp_type (grid%vv) + + if ( multi_inc == 2 ) then if ( max_ext_its > 1 ) then max_ext_its=1 write(unit=message(1),fmt='(a)') "Re-set max_ext_its = 1 for multi_inc==2" @@ -686,17 +669,7 @@ write(unit=message(1),fmt='(a)') 'Reading vp from : '//trim(vpfile) end if call da_message(message(1:1)) - !read(vp_unit) mz1, mz2, mz3, mz4, mz5 - !print *, 'mz1-5=',mz1, mz2, mz3, mz4, mz5 read(vp_unit) i1, i2, i3, i4, i5, i6 ! read dimension of patch for current processor - ! i11, i22, i33, i44, i55, i66, & - ! dim1, dim2, dim3 - !if ( i1 /= ips ) print *, "task=", myproc, "i1=",i1, "ips=",ips - !if ( i2 /= ipe ) print *, "task=", myproc, "i2=",i2, "ipe=",ipe - !if ( i3 /= jps ) print *, "task=", myproc, "i3=",i3, "jps=",jps - !if ( i4 /= jpe ) print *, "task=", myproc, "i4=",i4, "jpe=",jpe - !if ( i5 /= kps ) print *, "task=", myproc, "i5=",i5, "kps=",kps - !if ( i6 /= kpe ) print *, "task=", myproc, "i6=",i6, "kpe=",kpe allocate( v1(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) allocate( v2(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) allocate( v3(1:i2-i1+1, 1:i4-i3+1, 1:i6-i5+1) ) @@ -781,7 +754,7 @@ call da_initialize_cv (cv_size, cvt) end if end if -! liuz: ------------------------------------------- +! mri-4dvar ------------------------------------------- call da_zero_vp_type (grid%vv) call da_zero_vp_type (grid%vp) @@ -818,7 +791,7 @@ call da_initialize_cv (cv_size, xhat) -! liuz:---------------------- +! mri-4dvar---------------------- ! Apply inverse transform of squareroot(B) for full-resolution non-stop Var ! from 2nd outer loop, this is to check correctness of inverse U transform ! does not apply this setting for real world application @@ -829,12 +802,12 @@ endif ! Reinitialize cvt=0 for full-resolution non-stop Var for each loop -!------------------------------ +!------another option not tested -------------- if (multi_inc == 0 .and. it > 1 .and. use_interpolate_cvt) then print '(/10X,"===> Reinitialize cvt as zeros for outer loop ",i2)', it call da_initialize_cv (cv_size, cvt) endif -! liuz:------------------------ +! mri-4dvar------------------------ ! [8.1] Calculate nonlinear model trajectory @@ -1007,7 +980,7 @@ ! Update outer-loop control variable cvt = cvt + xhat - if ( multi_inc == 2 .and. use_interpolate_cvt ) then + if ( multi_inc == 2 .and. use_interpolate_cvt ) then ! obsolete option call da_cv_to_vv( cv_size, cvt, be%cv_mz, be%ncv_mz, grid%vv ) call da_write_vp(grid,grid%vv,'vp_output.global') ! wrtie vv to vp file end if @@ -1035,11 +1008,11 @@ call da_transform_vpatox (grid,be,grid%ep,grid%vp) endif -! liuz:------------------------ +! mri-4dvar-------------------------- if (multi_inc == 2 .and. use_inverse_squarerootb) then call da_write_vp(grid,grid%vp,'vp_output.global') ! write vp to vp file end if -! liuz:-------------------------- +! mri-4dvar-------------------------- call da_transform_xtoxa (grid) @@ -1241,11 +1214,5 @@ if (trace_use) call da_trace_exit ("da_solve") - -contains - -#include "da_solve_init.inc" -#include "da_solve_dual_res_init.inc" - end subroutine da_solve diff --git a/var/da/da_main/da_wrfvar_top.f90 b/var/da/da_main/da_wrfvar_top.f90 index 8362e218fa..6ca3d7560e 100644 --- a/var/da/da_main/da_wrfvar_top.f90 +++ b/var/da/da_main/da_wrfvar_top.f90 @@ -152,5 +152,7 @@ module da_wrfvar_top #include "da_wrfvar_interface.inc" #include "da_wrfvar_finalize.inc" #include "da_solve.inc" +#include "da_solve_init.inc" +#include "da_solve_dual_res_init.inc" end module da_wrfvar_top diff --git a/var/da/da_radiance/da_radiance1.f90 b/var/da/da_radiance/da_radiance1.f90 index f03b0bd893..0e8393d65b 100644 --- a/var/da/da_radiance/da_radiance1.f90 +++ b/var/da/da_radiance/da_radiance1.f90 @@ -13,7 +13,7 @@ module da_radiance1 use module_radiance, only : coefs #endif - use da_control, only : trace_use,missing_r, rootproc, & + use da_control, only : trace_use,missing_r, rootproc, ierr,comm,root,& stdout,myproc,qc_good,num_fgat_time,qc_bad, & use_error_factor_rad,biasprep_unit,obs_qc_pointer, filename_len, & print_detail_rad, rtm_option, trace_use_dull, & @@ -28,7 +28,7 @@ module da_radiance1 be_type, clddet_geoir_type, superob_type use module_dm, only : wrf_dm_sum_real, wrf_dm_sum_integer use da_par_util, only : da_proc_stats_combine - use da_par_util1, only : da_proc_sum_int,da_proc_sum_ints + use da_par_util1, only : da_proc_sum_int,da_proc_sum_ints,true_mpi_real,mpi_sum,mpi_integer use da_reporting, only : da_error, message use da_statistics, only : da_stats_calculate use da_tools, only : da_residual_new, da_eof_decomposition From 58b201dc69a73975b086ce15aa7f34bd94681568 Mon Sep 17 00:00:00 2001 From: liujake Date: Sun, 29 Nov 2020 13:50:31 -0700 Subject: [PATCH 75/91] On branch latest_develop_mri4dvar remove obsolete da_read_iv_rad_ascii.inc modified: var/da/da_main/da_solve.inc deleted: var/da/da_radiance/da_read_iv_rad_ascii.inc --- var/da/da_main/da_solve.inc | 3 - var/da/da_radiance/da_read_iv_rad_ascii.inc | 334 -------------------- 2 files changed, 337 deletions(-) delete mode 100644 var/da/da_radiance/da_read_iv_rad_ascii.inc diff --git a/var/da/da_main/da_solve.inc b/var/da/da_main/da_solve.inc index 3a761516e6..d8fed61911 100644 --- a/var/da/da_main/da_solve.inc +++ b/var/da/da_main/da_solve.inc @@ -58,9 +58,6 @@ integer :: vp_unit, iost character(len=13) :: vpfile ! vp_input.0001 integer :: i1,i2,i3,i4,i5,i6 - !integer :: i11,i22,i33,i44,i55,i66 - !integer :: dim1, dim2, dim3 - !integer :: mz1, mz2, mz3, mz4, mz5 logical :: ex character(len=10) :: this_time diff --git a/var/da/da_radiance/da_read_iv_rad_ascii.inc b/var/da/da_radiance/da_read_iv_rad_ascii.inc deleted file mode 100644 index cd59c73026..0000000000 --- a/var/da/da_radiance/da_read_iv_rad_ascii.inc +++ /dev/null @@ -1,334 +0,0 @@ -subroutine da_read_iv_rad_ascii (it,ob, iv ) - - !--------------------------------------------------------------------------- - ! Purpose: read out innovation vector structure for radiance data. - !--------------------------------------------------------------------------- - - implicit none - - integer , intent(in) :: it ! outer loop count - type (y_type), intent(in) :: ob ! Observation structure. - type (iv_type), intent(inout) :: iv ! O-B structure. - - integer :: n ! Loop counter. - integer :: i, k, l, m, m1, m2,nobs_tot,nobs_in ! Index dimension. - integer :: nlevelss ! Number of obs levels. - - integer :: ios, innov_rad_unit_in - character(len=filename_len) :: filename - character(len=7) :: surftype - integer :: ndomain - logical :: amsr2 - - real, allocatable :: dtransmt(:,:), transmt_jac(:,:), transmt(:,:), lod(:,:), lod_jac(:,:) - - if (trace_use) call da_trace_entry("da_read_iv_rad_ascii") - - read(unit=message(1),fmt='(A)') 'Reading radiance OMB ascii file' - call da_message(message(1:1)) - - do i = 1, iv%num_inst - if (iv%instid(i)%num_rad < 1) cycle - - ! count number of obs within the loc%proc_domain - ! --------------------------------------------- - nobs_tot = iv%instid(i)%info%ptotal(num_fgat_time) - iv%instid(i)%info%ptotal(0) - do m=num_fgat_time,1,-1 - if ( nobs_tot > 0 ) then - if ( rootproc ) then - write(unit=filename, fmt='(a,i3.3)') 'inv_'//trim(iv%instid(i)%rttovid_string)//'_',m - call da_get_unit(innov_rad_unit_in) - open(unit=innov_rad_unit_in,file=trim(filename),form='formatted',status='replace',iostat=ios) - if (ios /= 0 ) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open innovation radiance file"//filename/)) - Endif - read(innov_rad_unit_in) nobs_in - if ( nobs_in /= nobs_tot ) then - call da_error(__FILE__,__LINE__, & - (/"Dimensions (nobs_tot of radiance) mismatch "/)) - end if - end if ! root open ounit - iv%instid(i)%info%n1 = iv%instid(i)%info%plocal(m-1) + 1 - iv%instid(i)%info%n2=iv%instid(i)%info%plocal(m) - ndomain = 0 -! do n =1,iv%instid(i)%num_rad - do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 - - if (iv%instid(i)%info%proc_domain(1,n)) then - ndomain = ndomain + 1 - end if - end do - if (ndomain < 1) cycle - - if (rtm_option==rtm_option_crtm .and. write_jacobian ) then - allocate ( dtransmt(iv%instid(i)%nchan,iv%instid(i)%nlevels) ) - allocate ( transmt_jac(iv%instid(i)%nchan,iv%instid(i)%nlevels) ) - allocate ( transmt(iv%instid(i)%nchan,iv%instid(i)%nlevels) ) - allocate ( lod(iv%instid(i)%nchan,iv%instid(i)%nlevels) ) - allocate ( lod_jac(iv%instid(i)%nchan,iv%instid(i)%nlevels) ) - end if - - amsr2 = index(iv%instid(i)%rttovid_string,'amsr2') > 0 - - read(unit=innov_rad_unit_in,fmt='(a,a,i7,a,i5,a)') trim(iv%instid(i)%rttovid_string), & - ' number-of-pixels : ', ndomain, & - ' channel-number-of-each-pixel : ', iv%instid(i)%nchan, & - ' index-of-channels : ' - read(unit=innov_rad_unit_in,fmt='(10i5)') iv%instid(i)%ichan - if ( amsr2 ) then - read(unit=innov_rad_unit_in,fmt='(a)') ' pixel-info : i date scanpos landsea_mask elv lat lon satzen satazi clw' - else - read(unit=innov_rad_unit_in,fmt='(a)') ' pixel-info : i date scanpos landsea_mask elv lat lon satzen satazi' - end if - read(unit=innov_rad_unit_in,fmt='(a)') ' grid%xb-surf-info : i t2m mr2m(ppmv) u10 v10 ps ts smois tslb snowh isflg & - & soiltyp vegtyp vegfra elev clwp' - ndomain = 0 -!wuyl do n =1,iv%instid(i)%num_rad - do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 - if (iv%instid(i)%info%proc_domain(1,n)) then - ndomain=ndomain+1 - if ( amsr2 ) then ! read out clw - read(unit=innov_rad_unit_in,fmt='(a,i7,2x,a,i6,i3,f6.0,4f8.2,f8.3)') 'INFO : ', ndomain, & - iv%instid(i)%info%date_char(n), & - iv%instid(i)%scanpos(n), & - iv%instid(i)%landsea_mask(n), & - iv%instid(i)%info%elv(n), & - iv%instid(i)%info%lat(1,n), & - iv%instid(i)%info%lon(1,n), & - iv%instid(i)%satzen(n), & - iv%instid(i)%satazi(n), & - iv%instid(i)%clw(n) - else ! no clw info - read(unit=innov_rad_unit_in,fmt='(a,i7,2x,a,i6,i3,f6.0,4f8.2)') 'INFO : ', ndomain, & - iv%instid(i)%info%date_char(n), & - iv%instid(i)%scanpos(n), & - iv%instid(i)%landsea_mask(n), & - iv%instid(i)%info%elv(n), & - iv%instid(i)%info%lat(1,n), & - iv%instid(i)%info%lon(1,n), & - iv%instid(i)%satzen(n), & - iv%instid(i)%satazi(n) - end if - select case (iv%instid(i)%isflg(n)) - case (0) ; - surftype = ' SEA : ' - case (1) ; - surftype = ' ICE : ' - case (2) ; - surftype = 'LAND : ' - case (3) ; - surftype = 'SNOW : ' - case (4) ; - surftype = 'MSEA : ' - case (5) ; - surftype = 'MICE : ' - case (6) ; - surftype = 'MLND : ' - case (7) ; - surftype = 'MSNO : ' - end select - read(unit=innov_rad_unit_in,fmt='(a,i7,9f10.2,3i3,f8.3,f10.2,f8.3)') surftype, n, & - iv%instid(i)%t2m(n), & - iv%instid(i)%mr2m(n), & - iv%instid(i)%u10(n), & - iv%instid(i)%v10(n), & - iv%instid(i)%ps(n), & - iv%instid(i)%ts(n), & - iv%instid(i)%smois(n), & - iv%instid(i)%tslb(n), & - iv%instid(i)%snowh(n), & - iv%instid(i)%isflg(n), & - nint(iv%instid(i)%soiltyp(n)), & - nint(iv%instid(i)%vegtyp(n)), & - iv%instid(i)%vegfra(n), & - iv%instid(i)%elevation(n), & - iv%instid(i)%clwp(n) - - read(unit=innov_rad_unit_in,fmt='(a)') 'OBS : ' - read(unit=innov_rad_unit_in,fmt='(10f11.2)') ob%instid(i)%tb(:,n) - read(unit=innov_rad_unit_in,fmt='(a)') 'BAK : ' - read(unit=innov_rad_unit_in,fmt='(10f11.2)') iv%instid(i)%tb_xb(:,n) - read(unit=innov_rad_unit_in,fmt='(a)') 'IVBC : ' - read(unit=innov_rad_unit_in,fmt='(10f11.2)') iv%instid(i)%tb_inv(:,n) - read(unit=innov_rad_unit_in,fmt='(a)') 'EMS : ' - read(unit=innov_rad_unit_in,fmt='(10f11.2)') iv%instid(i)%emiss(1:iv%instid(i)%nchan,n) - if (rtm_option==rtm_option_crtm .and. write_jacobian) then - read(unit=innov_rad_unit_in,fmt='(a)') 'EMS_JACOBIAN : ' - read(unit=innov_rad_unit_in,fmt='(10f10.3)') iv%instid(i)%emiss_jacobian(1:iv%instid(i)%nchan,n) - end if - read(unit=innov_rad_unit_in,fmt='(a)') 'ERR : ' - read(unit=innov_rad_unit_in,fmt='(10f11.2)') iv%instid(i)%tb_error(:,n) - read(unit=innov_rad_unit_in,fmt='(a)') 'QC : ' - read(unit=innov_rad_unit_in,fmt='(10i11)') iv%instid(i)%tb_qc(:,n) - - if (write_profile) then - nlevelss = iv%instid(i)%nlevels - if ( rtm_option == rtm_option_rttov ) then -#ifdef RTTOV - ! first, read RTTOV levels - read(unit=innov_rad_unit_in,fmt='(a)') 'RTM_level pres(mb) T(k) Q(ppmv)' - do k = 1, nlevelss - read(unit=innov_rad_unit_in,fmt='(i3,f10.2,f8.2,e11.4)') & - k, & ! RTTOV levels - coefs(i) % coef % ref_prfl_p(k) , & - iv%instid(i)%t(k,n) , & - iv%instid(i)%mr(k,n) - end do ! end loop RTTOV level - ! second, read WRF model levels - read(unit=innov_rad_unit_in,fmt='(a)') & - 'WRF_level pres(mb) T(k) q(g/kg) clw(g/kg) rain(g/kg)' - do k=kts,kte - read(unit=innov_rad_unit_in,fmt='(i3,f10.2,f8.2,3e11.4)') & - k, & ! WRF model levels - iv%instid(i)%pm(k,n) , & - iv%instid(i)%tm(k,n) , & - iv%instid(i)%qm(k,n)*1000 , & - iv%instid(i)%qcw(k,n)*1000.0, & - iv%instid(i)%qrn(k,n)*1000.0 - end do ! end loop model level -#endif - end if ! end if rtm_option_rttov - - if ( rtm_option == rtm_option_crtm ) then -#ifdef CRTM - read(unit=innov_rad_unit_in,fmt='(a)') & - 'level fullp(mb) halfp(mb) t(k) q(g/kg) water(mm) ice(mm) rain(mm) snow(mm) graupel(mm) hail(mm)' - if (crtm_cloud) then - do k=1,iv%instid(i)%nlevels-1 - read(unit=innov_rad_unit_in,fmt='(i3,2f10.2,f8.2,13f8.3)') & - k, & - iv%instid(i)%pf(k,n), & - iv%instid(i)%pm(k,n), & - iv%instid(i)%tm(k,n), & - iv%instid(i)%qm(k,n), & - iv%instid(i)%qcw(k,n), & - iv%instid(i)%qci(k,n), & - iv%instid(i)%qrn(k,n), & - iv%instid(i)%qsn(k,n), & - iv%instid(i)%qgr(k,n), & - iv%instid(i)%qhl(k,n), & - iv%instid(i)%rcw(k,n), & - iv%instid(i)%rci(k,n), & - iv%instid(i)%rrn(k,n), & - iv%instid(i)%rsn(k,n), & - iv%instid(i)%rgr(k,n), & - iv%instid(i)%rhl(k,n) - end do ! end loop profile - else ! no cloud - do k=1,iv%instid(i)%nlevels-1 - read(unit=innov_rad_unit_in,fmt='(i3,2f10.2,f8.2,7f8.3)') & - k, & - iv%instid(i)%pf(k,n), & - iv%instid(i)%pm(k,n), & - iv%instid(i)%tm(k,n), & - iv%instid(i)%qm(k,n), & - 0.0, & - 0.0, & - 0.0, & - 0.0, & - 0.0, & - 0.0 - end do ! end loop profile - end if ! end if crtm_cloud -#endif - end if ! end if rtm_option_crtm - - end if ! end if read_profile - - if ( rtm_option == rtm_option_crtm .and. write_jacobian) then -#ifdef CRTM - - if ( calc_weightfunc ) then - dtransmt(:,:) = iv%instid(i)%der_trans(:,:,n) - transmt(:,:) = iv%instid(i)%trans(:,:,n) - transmt_jac(:,:) = iv%instid(i)%trans_jacobian(:,:,n) - lod(:,:) = iv%instid(i)%lod(:,:,n) - lod_jac(:,:) = iv%instid(i)%lod_jacobian(:,:,n) - else - dtransmt(:,:) = 0.0 - transmt(:,:) = 0.0 - transmt_jac(:,:) = 0.0 - lod(:,:) = 0.0 - lod_jac(:,:) = 0.0 - end if - - read(unit=innov_rad_unit_in,fmt='(a)') & - 'channel level halfp(mb) t(k) q(g/kg) der_trans trans_jac trans lod_jac lod water(mm) ice(mm) rain(mm) snow(mm) graupel(mm) hail(mm)' - if (crtm_cloud) then - do l=1,iv%instid(i)%nchan - do k=1,iv%instid(i)%nlevels-1 - read(unit=innov_rad_unit_in,fmt='(i5,i3,f10.2,13f14.7,6f14.7)') & - l, k, & - iv%instid(i)%pm(k,n), & - iv%instid(i)%t_jacobian(l,k,n), & - iv%instid(i)%q_jacobian(l,k,n), & - dtransmt(l,k),& - transmt_jac(l,k),& - transmt(l,k),& - lod_jac(l,k),& - lod(l,k),& - iv%instid(i)%water_jacobian(l,k,n), & - iv%instid(i)%ice_jacobian(l,k,n), & - iv%instid(i)%rain_jacobian(l,k,n), & - iv%instid(i)%snow_jacobian(l,k,n), & - iv%instid(i)%graupel_jacobian(l,k,n), & - iv%instid(i)%hail_jacobian(l,k,n), & - iv%instid(i)%water_r_jacobian(l,k,n), & - iv%instid(i)%ice_r_jacobian(l,k,n), & - iv%instid(i)%rain_r_jacobian(l,k,n), & - iv%instid(i)%snow_r_jacobian(l,k,n), & - iv%instid(i)%graupel_r_jacobian(l,k,n), & - iv%instid(i)%hail_r_jacobian(l,k,n) - end do ! end loop profile - end do ! end loop channels - else ! no cloud - do l=1,iv%instid(i)%nchan - do k=1,iv%instid(i)%nlevels-1 - read(unit=innov_rad_unit_in,fmt='(i5,i3,f10.2,13f14.7,6f14.7)') & - l, k, & - iv%instid(i)%pm(k,n), & - iv%instid(i)%t_jacobian(l,k,n), & - iv%instid(i)%q_jacobian(l,k,n), & - dtransmt(l,k),& - transmt_jac(l,k),& - transmt(l,k),& - lod_jac(l,k),& - lod(l,k),& - 0., & - 0., & - 0., & - 0., & - 0., & - 0., & - 0., & - 0., & - 0., & - 0., & - 0., & - 0. - end do ! end loop profile - end do ! end loop channels - end if ! end if crtm_cloud -#endif - end if ! end if read_jacobian - - end if ! end if proc_domain - end do ! end do pixels - if (rtm_option==rtm_option_crtm .and. write_jacobian ) then - deallocate ( dtransmt ) - deallocate ( transmt_jac ) - deallocate ( transmt ) - deallocate ( lod ) - deallocate ( lod_jac ) - end if - close(unit=innov_rad_unit_in) - call da_free_unit(innov_rad_unit_in) - end if ! nobs_tot - end do ! n1,n2 wuyl -end do ! end do instruments - - if (trace_use) call da_trace_exit("da_read_iv_rad_ascii") - -end subroutine da_read_iv_rad_ascii - From 52f062d6eea8fbd2a1a62f4fcc8cc6def8781e11 Mon Sep 17 00:00:00 2001 From: liujake Date: Sun, 29 Nov 2020 15:01:38 -0700 Subject: [PATCH 76/91] deleted: var/mri4dvar/README.Multi_inc --- var/mri4dvar/README.Multi_inc | 86 ----------------------------------- 1 file changed, 86 deletions(-) delete mode 100644 var/mri4dvar/README.Multi_inc diff --git a/var/mri4dvar/README.Multi_inc b/var/mri4dvar/README.Multi_inc deleted file mode 100644 index 2efac074db..0000000000 --- a/var/mri4dvar/README.Multi_inc +++ /dev/null @@ -1,86 +0,0 @@ -1. How to build the 'tools' - -Set 'NETCDF' to your netcdf path and 'SFC' to the same Fortran 90 compiler -which used to build the NETCDF lib - - For csh, tcsh - setenv NETCDF /your/netcdf/path - setenv SFC pgf90 - For bash, ksh - export NETCDF=/your/netcdf/path - export SFC=pgf90 - -then run 'make' to build the tools - -notes: It depends on how NETCDF was build, '-lcurl' may need to be removed -or the path of libcurl need to be specified. - -2. Domain size requirment - -Only WRF input files at high resolution are required to run multi-inc 4DVAR. -WRF input files at low reselution are thinned from those at high resolution. -This requires that grid number at high/low reselutions to satify: - ( n - 1 ) mod m = 0 -where n is the grid number of high resolution in x or y direction, m is the -grid number of low resolution in x or y direction. - -The ratio of the high/low resolution must be odd, the default ration is 1:3. - -3. First guess files - -Multi-incremental 4DVAR run needs 2 time-level first guess files (fg & fg02), - -fg is at the analysis time - -fg02 is at the end of the analysis time window, or the 2nd time level of boundary -if boundary interval is less then analysis time window - -4. BE -Multi-incremental 4DVAR run only needs the low resolution BE - -5. How the wrapper script works - -What does this wrapper script CAN NOT DO? - - This wrapper script DOES NOT DO these - - link/copy any run-time files which needed by 4DVAR run - generate/prepare namelist.input for 4DVAR run - update boundary condition - -What does this wrapper CAN DO? - - This wrapper script DOES these - - generate low resolution fg & bdy by using the high resolution fg & fg02 - switch da_wrfvar.exe between stage1 & stage2 - amend namelist.input for appropriate stage - interpolate low resolution incremental to high resolution - -This wrapper script supposes these are done - -1) EVERYTHING IS OK FOR A STANDARD 4DVAR RUN under the run direcotry, -such as be.dat, namelist.input, *.tbl, fg, fg02, wrfbdy_d01, da_wrfvar.exe, -da_update_bc, ob*, etc. - -2) Environment variables 'MULTI_INC_TOOLS' points to the location of these -tools - -da_bdy.exe -da_bilin.exe -da_thin.exe - -3) Environment variables 'RUN_CMD' is already set to specific job submit command -instead of the default "mpirun -np 16 " - -4) namelist.input is already for a standard 4DVAR RUN (in high resolution) - -If everything is ready to go, just link/copy the wrapper script to the run -directory, call this wrapper script instead of da_wrfvar.exe for the -Multi-incremental 4DVAR run. - -6. Platform - -All the commands involved by this script are GNU/Linux commands on CentOS box. -If involved this script other than CentOS, commands may not run as your expect, -double check it before using. From 6d8c7ef79f2f746dd6eca0e960c162a8fcd8244b Mon Sep 17 00:00:00 2001 From: liujake Date: Sun, 29 Nov 2020 15:02:10 -0700 Subject: [PATCH 77/91] new file: var/mri4dvar/README.MRI-4DVar --- var/mri4dvar/README.MRI-4DVar | 86 +++++++++++++++++++++++++++++++++++ 1 file changed, 86 insertions(+) create mode 100644 var/mri4dvar/README.MRI-4DVar diff --git a/var/mri4dvar/README.MRI-4DVar b/var/mri4dvar/README.MRI-4DVar new file mode 100644 index 0000000000..2efac074db --- /dev/null +++ b/var/mri4dvar/README.MRI-4DVar @@ -0,0 +1,86 @@ +1. How to build the 'tools' + +Set 'NETCDF' to your netcdf path and 'SFC' to the same Fortran 90 compiler +which used to build the NETCDF lib + + For csh, tcsh + setenv NETCDF /your/netcdf/path + setenv SFC pgf90 + For bash, ksh + export NETCDF=/your/netcdf/path + export SFC=pgf90 + +then run 'make' to build the tools + +notes: It depends on how NETCDF was build, '-lcurl' may need to be removed +or the path of libcurl need to be specified. + +2. Domain size requirment + +Only WRF input files at high resolution are required to run multi-inc 4DVAR. +WRF input files at low reselution are thinned from those at high resolution. +This requires that grid number at high/low reselutions to satify: + ( n - 1 ) mod m = 0 +where n is the grid number of high resolution in x or y direction, m is the +grid number of low resolution in x or y direction. + +The ratio of the high/low resolution must be odd, the default ration is 1:3. + +3. First guess files + +Multi-incremental 4DVAR run needs 2 time-level first guess files (fg & fg02), + +fg is at the analysis time + +fg02 is at the end of the analysis time window, or the 2nd time level of boundary +if boundary interval is less then analysis time window + +4. BE +Multi-incremental 4DVAR run only needs the low resolution BE + +5. How the wrapper script works + +What does this wrapper script CAN NOT DO? + + This wrapper script DOES NOT DO these + + link/copy any run-time files which needed by 4DVAR run + generate/prepare namelist.input for 4DVAR run + update boundary condition + +What does this wrapper CAN DO? + + This wrapper script DOES these + + generate low resolution fg & bdy by using the high resolution fg & fg02 + switch da_wrfvar.exe between stage1 & stage2 + amend namelist.input for appropriate stage + interpolate low resolution incremental to high resolution + +This wrapper script supposes these are done + +1) EVERYTHING IS OK FOR A STANDARD 4DVAR RUN under the run direcotry, +such as be.dat, namelist.input, *.tbl, fg, fg02, wrfbdy_d01, da_wrfvar.exe, +da_update_bc, ob*, etc. + +2) Environment variables 'MULTI_INC_TOOLS' points to the location of these +tools + +da_bdy.exe +da_bilin.exe +da_thin.exe + +3) Environment variables 'RUN_CMD' is already set to specific job submit command +instead of the default "mpirun -np 16 " + +4) namelist.input is already for a standard 4DVAR RUN (in high resolution) + +If everything is ready to go, just link/copy the wrapper script to the run +directory, call this wrapper script instead of da_wrfvar.exe for the +Multi-incremental 4DVAR run. + +6. Platform + +All the commands involved by this script are GNU/Linux commands on CentOS box. +If involved this script other than CentOS, commands may not run as your expect, +double check it before using. From dce23d73646c6fc449200ec907152bb58e07ee06 Mon Sep 17 00:00:00 2001 From: liujake Date: Sun, 29 Nov 2020 15:27:38 -0700 Subject: [PATCH 78/91] modified: var/mri4dvar/README.MRI-4DVar --- var/mri4dvar/README.MRI-4DVar | 68 ++++++++++++++++++++--------------- 1 file changed, 39 insertions(+), 29 deletions(-) diff --git a/var/mri4dvar/README.MRI-4DVar b/var/mri4dvar/README.MRI-4DVar index 2efac074db..4f5bda6436 100644 --- a/var/mri4dvar/README.MRI-4DVar +++ b/var/mri4dvar/README.MRI-4DVar @@ -1,25 +1,44 @@ -1. How to build the 'tools' -Set 'NETCDF' to your netcdf path and 'SFC' to the same Fortran 90 compiler -which used to build the NETCDF lib +This directory contains offline programs needed for multi-resolution incremental 4DVar (MRI-4DVar) +-------------- - For csh, tcsh - setenv NETCDF /your/netcdf/path - setenv SFC pgf90 - For bash, ksh - export NETCDF=/your/netcdf/path - export SFC=pgf90 +Liu, Z., J. Ban, J.-S, Hong, and Y.-H. Kuo, 2020: Multi-resolution incremental 4D-Var for WRF: +Implementation and application at convective scale, Q. J. R. Meteorol. Soc. , 1-14. -then run 'make' to build the tools +da_bdy.f90 : -notes: It depends on how NETCDF was build, '-lcurl' may need to be removed -or the path of libcurl need to be specified. +da_bilin.f90 : bilinearly interpolate analysis increment + from low-resolution to high-resolution + +da_thin.f90 : thin wrfinput file + +da_vp_bilin.f90 : bilinearly interpolate control variable + from low-resolution to high-resolution + +da_vp_split.f90 : scatter global hires. control variables to different PEs + +1. To compile: +---------------- + (1) need to compile WRFDA first in 4DVAR mode, + cd your_WRFDA_dir + ./clean -a + ./configure 4dvar + ./compile all_wrfvar + (2) cd your_WRFDA_dir/var/mri4dvar + make + +da_bdy.exe +da_bilin.exe +da_thin.exe +da_vp_bilin.exe +da_vp_split.exe 2. Domain size requirment +--------------------------- -Only WRF input files at high resolution are required to run multi-inc 4DVAR. -WRF input files at low reselution are thinned from those at high resolution. -This requires that grid number at high/low reselutions to satify: +Only WRF input files at high resolution are required to run MRI-4DVAR. +WRF input files at low resolution are thinned from those at high resolution. +This requires that grid number at high/low resolutions to satify: ( n - 1 ) mod m = 0 where n is the grid number of high resolution in x or y direction, m is the grid number of low resolution in x or y direction. @@ -27,8 +46,9 @@ grid number of low resolution in x or y direction. The ratio of the high/low resolution must be odd, the default ration is 1:3. 3. First guess files +----------------------- -Multi-incremental 4DVAR run needs 2 time-level first guess files (fg & fg02), +MRI-4DVAR run needs 2 time-level first guess files (fg & fg02), fg is at the analysis time @@ -36,9 +56,11 @@ fg02 is at the end of the analysis time window, or the 2nd time level of boundar if boundary interval is less then analysis time window 4. BE -Multi-incremental 4DVAR run only needs the low resolution BE +-------- +MRI-4DVAR run only needs be.dat files at different inner loop resolutions. 5. How the wrapper script works +------------------------------------- What does this wrapper script CAN NOT DO? @@ -63,13 +85,6 @@ This wrapper script supposes these are done such as be.dat, namelist.input, *.tbl, fg, fg02, wrfbdy_d01, da_wrfvar.exe, da_update_bc, ob*, etc. -2) Environment variables 'MULTI_INC_TOOLS' points to the location of these -tools - -da_bdy.exe -da_bilin.exe -da_thin.exe - 3) Environment variables 'RUN_CMD' is already set to specific job submit command instead of the default "mpirun -np 16 " @@ -79,8 +94,3 @@ If everything is ready to go, just link/copy the wrapper script to the run directory, call this wrapper script instead of da_wrfvar.exe for the Multi-incremental 4DVAR run. -6. Platform - -All the commands involved by this script are GNU/Linux commands on CentOS box. -If involved this script other than CentOS, commands may not run as your expect, -double check it before using. From b213860da0fa46385098362c812e5d8703fbf105 Mon Sep 17 00:00:00 2001 From: liujake Date: Sun, 29 Nov 2020 15:49:08 -0700 Subject: [PATCH 79/91] modified: var/mri4dvar/README.MRI-4DVar modified: var/mri4dvar/run_mri3d4dvar.csh_lsf modified: var/mri4dvar/run_mri3d4dvar.csh_pbs modified: var/mri4dvar/wraper_mri3d4dvar.csh --- var/mri4dvar/README.MRI-4DVar | 55 ++++++++--------------------- var/mri4dvar/run_mri3d4dvar.csh_lsf | 2 +- var/mri4dvar/run_mri3d4dvar.csh_pbs | 2 +- var/mri4dvar/wraper_mri3d4dvar.csh | 6 ++-- 4 files changed, 20 insertions(+), 45 deletions(-) diff --git a/var/mri4dvar/README.MRI-4DVar b/var/mri4dvar/README.MRI-4DVar index 4f5bda6436..9adc4d9b12 100644 --- a/var/mri4dvar/README.MRI-4DVar +++ b/var/mri4dvar/README.MRI-4DVar @@ -19,13 +19,14 @@ da_vp_split.f90 : scatter global hires. control variables to different PEs 1. To compile: ---------------- - (1) need to compile WRFDA first in 4DVAR mode, - cd your_WRFDA_dir - ./clean -a - ./configure 4dvar - ./compile all_wrfvar - (2) cd your_WRFDA_dir/var/mri4dvar - make + (1) need to compile WRFDA first in 4DVAR mode, + cd your_WRFDA_dir + ./clean -a + ./configure 4dvar + ./compile all_wrfvar + (2) cd your_WRFDA_dir/var/mri4dvar + make + (3) make clean (to remove *.exe *.o files) da_bdy.exe da_bilin.exe @@ -59,38 +60,10 @@ if boundary interval is less then analysis time window -------- MRI-4DVAR run only needs be.dat files at different inner loop resolutions. -5. How the wrapper script works -------------------------------------- - -What does this wrapper script CAN NOT DO? - - This wrapper script DOES NOT DO these - - link/copy any run-time files which needed by 4DVAR run - generate/prepare namelist.input for 4DVAR run - update boundary condition - -What does this wrapper CAN DO? - - This wrapper script DOES these - - generate low resolution fg & bdy by using the high resolution fg & fg02 - switch da_wrfvar.exe between stage1 & stage2 - amend namelist.input for appropriate stage - interpolate low resolution incremental to high resolution - -This wrapper script supposes these are done - -1) EVERYTHING IS OK FOR A STANDARD 4DVAR RUN under the run direcotry, -such as be.dat, namelist.input, *.tbl, fg, fg02, wrfbdy_d01, da_wrfvar.exe, -da_update_bc, ob*, etc. - -3) Environment variables 'RUN_CMD' is already set to specific job submit command -instead of the default "mpirun -np 16 " - -4) namelist.input is already for a standard 4DVAR RUN (in high resolution) - -If everything is ready to go, just link/copy the wrapper script to the run -directory, call this wrapper script instead of da_wrfvar.exe for the -Multi-incremental 4DVAR run. +5. sample script for running 3-stage MRI-4DVar +---------------------------------------------- +wraper_mri3d4dvar.csh : wrapper script to configure MRI-4DVar +run_mri3d4dvar.csh_pbs : run 3-step MRI-4DVar with PBS job scheduler +run_mri3d4dvar.csh_lsf : run 3-step MRI-4DVar with LSF job scheduler +No support can be provided for MRI-4DVar. diff --git a/var/mri4dvar/run_mri3d4dvar.csh_lsf b/var/mri4dvar/run_mri3d4dvar.csh_lsf index 67b307fc47..b2efdd214d 100755 --- a/var/mri4dvar/run_mri3d4dvar.csh_lsf +++ b/var/mri4dvar/run_mri3d4dvar.csh_lsf @@ -4,7 +4,7 @@ set nonomatch set TOP_DIR=/glade/p/mmm/liuz/cwb2016 set JOB='LSF' -set PROJID='P64000471' +set PROJID='NMMM0015' set QUEUE='regular' set OS=`uname -s` set WRFDA_DIR=$TOP_DIR/liuz_newcode/WRFDA_V38 diff --git a/var/mri4dvar/run_mri3d4dvar.csh_pbs b/var/mri4dvar/run_mri3d4dvar.csh_pbs index 1dd05d8902..98a7331523 100755 --- a/var/mri4dvar/run_mri3d4dvar.csh_pbs +++ b/var/mri4dvar/run_mri3d4dvar.csh_pbs @@ -4,7 +4,7 @@ set nonomatch set TOP_DIR=/glade/p/mmm/liuz/cy_code/cwb2017 set JOB='PBS' # LSF or PBS -set PROJID='P64000471' +set PROJID='NMMM0015' set QUEUE='economy' set OS=`uname -s` set WRFDA_DIR=$TOP_DIR/../WRF_Github/wrf_myfork diff --git a/var/mri4dvar/wraper_mri3d4dvar.csh b/var/mri4dvar/wraper_mri3d4dvar.csh index 67863344b3..3da5da1e3f 100755 --- a/var/mri4dvar/wraper_mri3d4dvar.csh +++ b/var/mri4dvar/wraper_mri3d4dvar.csh @@ -1,5 +1,8 @@ #!/bin/tcsh -f -# script 1:VAR4D 2:MULTI_INC 3:use_cvt 4:use_vp 5:WORK_DIR 6/7:THIN_FACTOR 8:BE1 9:BE2 +# script 1:VAR4D 2:MULTI_INC 3:use_cvt 4:use_vp 5:WORK_DIR 6/7:THIN_FACTOR 8:BE1 9:BE2 + +./run_mri3d4dvar.csh_pbs true true false true ztd30min_mri4dvar_6km6km_512core 3 3 6km 6km > &! log.66 + #-------- 3DVAR runs with interpolation of CVT #./run_mri3d4dvar.csh false true true false mri3dvar_2km2km_cvt 1 1 2km 2km > &! log.22_cvt #./run_mri3d4dvar.csh false true true false mri3dvar_6km6km_cvt 3 3 6km 6km > &! log.66_cvt @@ -25,4 +28,3 @@ #./run_mri3d4dvar.csh true true false false mri3dvar_18km6km_cvt0 9 3 18km 6km > &! log.186_cvt0 #-------- 4DVAR runs with interpolation of CVT #./run_mri3d4dvar.csh true false false false ztd30min_4dvar_2km2km 1 1 2km 2km > &! log.22 -./run_mri3d4dvar.csh_pbs true true false true ztd30min_mri4dvar_6km6km_512core 3 3 6km 6km > &! log.66 From 5fc41dbb1e7e1fb14e03008d373bf45e7ccb9ee5 Mon Sep 17 00:00:00 2001 From: liujake Date: Sun, 29 Nov 2020 15:51:11 -0700 Subject: [PATCH 80/91] modified: var/mri4dvar/README.MRI-4DVar --- var/mri4dvar/README.MRI-4DVar | 1 + 1 file changed, 1 insertion(+) diff --git a/var/mri4dvar/README.MRI-4DVar b/var/mri4dvar/README.MRI-4DVar index 9adc4d9b12..9ac858966d 100644 --- a/var/mri4dvar/README.MRI-4DVar +++ b/var/mri4dvar/README.MRI-4DVar @@ -65,5 +65,6 @@ MRI-4DVAR run only needs be.dat files at different inner loop resolutions. wraper_mri3d4dvar.csh : wrapper script to configure MRI-4DVar run_mri3d4dvar.csh_pbs : run 3-step MRI-4DVar with PBS job scheduler run_mri3d4dvar.csh_lsf : run 3-step MRI-4DVar with LSF job scheduler +*.ncl: NCL scripts only for debugging purposes. No support can be provided for MRI-4DVar. From 5e5cc1cea69983600ea5fb7c0909bb3d1736a67d Mon Sep 17 00:00:00 2001 From: liujake Date: Sun, 29 Nov 2020 16:11:16 -0700 Subject: [PATCH 81/91] modified: var/da/da_vtox_transforms/da_transform_vtovv_inv.inc --- var/da/da_vtox_transforms/da_transform_vtovv_inv.inc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/var/da/da_vtox_transforms/da_transform_vtovv_inv.inc b/var/da/da_vtox_transforms/da_transform_vtovv_inv.inc index cf047eb450..3350e3940a 100644 --- a/var/da/da_vtox_transforms/da_transform_vtovv_inv.inc +++ b/var/da/da_vtox_transforms/da_transform_vtovv_inv.inc @@ -226,4 +226,4 @@ subroutine da_transform_vtovv_inv(grid, cv_size, be, cv, vv) if (trace_use) call da_trace_exit("da_transform_vtovv_inv") -endsubroutine da_transform_vtovv_inv +end subroutine da_transform_vtovv_inv From 4a2bbaeeb87463ef66cd123b656d56410ff018e5 Mon Sep 17 00:00:00 2001 From: "Zhiquan (Jake) Liu" Date: Mon, 30 Nov 2020 14:21:14 -0700 Subject: [PATCH 82/91] Update da_read_iv_rad_for_multi_inc.inc --- var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc b/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc index c2292654a5..6359ce0634 100644 --- a/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc +++ b/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc @@ -1,7 +1,7 @@ subroutine da_read_iv_rad_for_multi_inc (it,ob, iv ) !--------------------------------------------------------------------------- - ! Purpose: read out innovation vector structure for radiance data. + ! Purpose: read in innovation vector structure for radiance data. !--------------------------------------------------------------------------- implicit none From dd371c64591a40d26d7f91f0cfaf6d37ec97195c Mon Sep 17 00:00:00 2001 From: "Zhiquan (Jake) Liu" Date: Mon, 30 Nov 2020 14:22:54 -0700 Subject: [PATCH 83/91] Update da_read_iv_rad_for_multi_inc.inc --- var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc b/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc index 6359ce0634..b0563dfe3a 100644 --- a/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc +++ b/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc @@ -1,4 +1,4 @@ -subroutine da_read_iv_rad_for_multi_inc (it,ob, iv ) +subroutine da_read_iv_rad_for_multi_inc (it, ob, iv ) !--------------------------------------------------------------------------- ! Purpose: read in innovation vector structure for radiance data. From 3bf668cee97fab41dbe2f5eb054f61f4ca84544e Mon Sep 17 00:00:00 2001 From: liujake Date: Mon, 7 Dec 2020 19:53:07 -0700 Subject: [PATCH 84/91] Replace old da_read/write_iv_for_multi_inc.inc instead of keeping both versions. modified: Registry/registry.var modified: var/da/da_minimisation/da_get_innov_vector.inc modified: var/da/da_minimisation/da_minimisation.f90 modified: var/da/da_obs_io/da_obs_io.f90 modified: var/da/da_obs_io/da_read_iv_for_multi_inc.inc modified: var/da/da_obs_io/da_write_iv_for_multi_inc.inc --- Registry/registry.var | 1 - .../da_minimisation/da_get_innov_vector.inc | 16 +- var/da/da_minimisation/da_minimisation.f90 | 3 +- var/da/da_obs_io/da_obs_io.f90 | 2 - var/da/da_obs_io/da_read_iv_for_multi_inc.inc | 127 +++++++++---- .../da_obs_io/da_write_iv_for_multi_inc.inc | 172 +++++++++++++++--- 6 files changed, 248 insertions(+), 73 deletions(-) diff --git a/Registry/registry.var b/Registry/registry.var index b78a771649..a168f94c61 100644 --- a/Registry/registry.var +++ b/Registry/registry.var @@ -92,7 +92,6 @@ rconfig integer var4d_bin namelist,wrfvar1 1 3600 - "va rconfig integer var4d_bin_rain namelist,wrfvar1 1 3600 - "var4d_bin_rain" "" "" rconfig logical var4d_lbc namelist,wrfvar1 1 .false. - "var4d_lbc" "" "" rconfig integer multi_inc namelist,wrfvar1 1 0 - "multi_incremental_flag" "" "" -rconfig integer multi_inc_io_opt namelist,wrfvar1 1 1 - "multi_incremental_io_opt" "1: original 2:new" "" rconfig logical print_detail_radar namelist,wrfvar1 1 .false. - "print_detail_radar" "" "" rconfig logical print_detail_rain namelist,wrfvar1 1 .false. - "print_detail_rain" "" "" rconfig logical print_detail_rad namelist,wrfvar1 1 .false. - "print_detail_rad" "" "" diff --git a/var/da/da_minimisation/da_get_innov_vector.inc b/var/da/da_minimisation/da_get_innov_vector.inc index 438158e649..e61b058196 100644 --- a/var/da/da_minimisation/da_get_innov_vector.inc +++ b/var/da/da_minimisation/da_get_innov_vector.inc @@ -173,21 +173,9 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) ! [5] write out iv in ascii format !----------------------------------------------- if ( multi_inc == 1 ) then - - if ( multi_inc_io_opt == 1 ) then - call da_write_iv_for_multi_inc(n, iv) - else if ( multi_inc_io_opt == 2 ) then - call da_write_iv_for_multi_inc_opt2(n, iv) - end if - + call da_write_iv_for_multi_inc(n, iv) elseif ( multi_inc == 2 ) then - - if ( multi_inc_io_opt == 1 ) then - call da_read_iv_for_multi_inc(n, iv) - else if ( multi_inc_io_opt == 2 ) then - call da_read_iv_for_multi_inc_opt2(n, iv) - end if - + call da_read_iv_for_multi_inc(n, iv) endif if (n > 1 .and. var4d) call domain_clockadvance (grid) diff --git a/var/da/da_minimisation/da_minimisation.f90 b/var/da/da_minimisation/da_minimisation.f90 index 18ebf3f626..854c385642 100644 --- a/var/da/da_minimisation/da_minimisation.f90 +++ b/var/da/da_minimisation/da_minimisation.f90 @@ -58,8 +58,7 @@ module da_minimisation cloud_cv_options, use_cv_w, var_scaling6, var_scaling7, var_scaling8, var_scaling9, & var_scaling10, var_scaling11, & write_gts_omb_oma, write_unpert_obs, write_rej_obs_conv, pseudo_time, & - use_varbc_tamdar, varbc_tamdar_nobsmin, varbc_tamdar_unit, & - multi_inc_io_opt + use_varbc_tamdar, varbc_tamdar_nobsmin, varbc_tamdar_unit use da_define_structures, only : iv_type, y_type, j_type, be_type, & xbx_type, jo_type, da_allocate_y,da_zero_x,da_zero_y,da_deallocate_y, & da_zero_vp_type, qhat_type diff --git a/var/da/da_obs_io/da_obs_io.f90 b/var/da/da_obs_io/da_obs_io.f90 index bc63e84503..e9b0d2e99a 100644 --- a/var/da/da_obs_io/da_obs_io.f90 +++ b/var/da/da_obs_io/da_obs_io.f90 @@ -83,9 +83,7 @@ module da_obs_io #include "da_use_obs_errfac.inc" #include "da_write_obs.inc" #include "da_write_iv_for_multi_inc.inc" -#include "da_write_iv_for_multi_inc_opt2.inc" #include "da_read_iv_for_multi_inc.inc" -#include "da_read_iv_for_multi_inc_opt2.inc" #include "da_search_obs.inc" #include "da_write_obs_etkf.inc" #include "da_write_filtered_obs.inc" diff --git a/var/da/da_obs_io/da_read_iv_for_multi_inc.inc b/var/da/da_obs_io/da_read_iv_for_multi_inc.inc index d15162d110..f2ad1bd4b4 100644 --- a/var/da/da_obs_io/da_read_iv_for_multi_inc.inc +++ b/var/da/da_obs_io/da_read_iv_for_multi_inc.inc @@ -21,6 +21,12 @@ subroutine da_read_iv_for_multi_inc(file_index, iv) integer :: n, gn logical :: found_flag + integer :: nobs_tot, nlev_max, k , iobs + integer :: nobs_in, nlev_in + logical :: has_rv, has_rf, has_rhv, has_rqv + real, allocatable :: data2d(:,:) + real, allocatable :: data3d(:,:,:) + if (trace_use) call da_trace_entry("da_read_iv_for_multi_inc") !------------------------------------------------------------------------- @@ -63,7 +69,6 @@ subroutine da_read_iv_for_multi_inc(file_index, iv) ! [2] metar obs: if (iv%info(metar)%plocal(iv%time)-iv%info(metar)%plocal(iv%time-1) > 0) then - open(unit=unit_in,file=trim(filename)//'.metar',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -266,7 +271,6 @@ subroutine da_read_iv_for_multi_inc(file_index, iv) ! [9] buoy obs: if (iv%info(buoy)%plocal(iv%time)-iv%info(buoy)%plocal(iv%time-1) > 0) then - open(unit=unit_in,file=trim(filename)//'.buoy',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -499,7 +503,6 @@ subroutine da_read_iv_for_multi_inc(file_index, iv) ! [17] satem obs: if (iv%info(satem)%plocal(iv%time)-iv%info(satem)%plocal(iv%time-1) > 0) then - open(unit=unit_in,file=trim(filename)//'.satem',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -586,7 +589,6 @@ subroutine da_read_iv_for_multi_inc(file_index, iv) ! [20] scatterometer obs: if (iv%info(qscat)%plocal(iv%time)-iv%info(qscat)%plocal(iv%time-1) > 0) then - open(unit=unit_in,file=trim(filename)//'.qscat',form='formatted',status='old',iostat=ios) if (ios /= 0) Then call da_error(__FILE__,__LINE__, & @@ -731,33 +733,96 @@ subroutine da_read_iv_for_multi_inc(file_index, iv) ! [25] radar obs: - if (iv%info(radar)%plocal(iv%time)-iv%info(radar)%plocal(iv%time-1) > 0) then - - open(unit=unit_in,file=trim(filename)//'.radar',form='formatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'radar' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find radar marker. "/)) - gn = 0 - do n = iv%info(radar)%plocal(iv%time-1) + 1, & - iv%info(radar)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find radar obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(radar)%plocal(iv%time)-iv%info(radar)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - + nobs_tot = iv%info(radar)%ptotal(num_fgat_time) - iv%info(radar)%ptotal(0) + nlev_max = iv%info(radar)%max_lev + + if ( nobs_tot > 0 ) then + + write(unit=filename, fmt='(a,i3.3)') 'radar_innov_t', file_index + open(unit=unit_in,file=trim(filename),form='unformatted',status='old',iostat=ios) + if (ios /= 0) Then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file "//trim(filename)/)) + end if + + read(unit_in) nobs_in, nlev_in, has_rv, has_rf, has_rhv, has_rqv + if ( nobs_in /= nobs_tot .or. nlev_in /= nlev_max ) then + call da_error(__FILE__,__LINE__, & + (/"Dimensions (nobs_tot or nlev_max) mismatch "/)) + end if + allocate ( data2d(nobs_tot, 2) ) + read(unit_in) data2d + do n = iv%info(radar)%n1, iv%info(radar)%n2 + iobs = iv%info(radar)%obs_global_index(n) +! iv%info(radar)%lat(1,n) = data2d(iobs, 1) +! iv%info(radar)%lon(1,n) = data2d(iobs, 2) + end do + deallocate ( data2d ) + + if ( use_radar_rv .and. has_rv ) then + allocate( data3d(nobs_tot, nlev_max, 3) ) + read(unit_in) data3d + do n = iv%info(radar)%n1, iv%info(radar)%n2 + iobs = iv%info(radar)%obs_global_index(n) + do k = 1 , iv%info(radar)%levels(n) + iv%radar(n)%rv(k)%inv = data3d(iobs, k, 1) + iv%radar(n)%rv(k)%qc = int(data3d(iobs, k, 2)) + iv%radar(n)%rv(k)%error = data3d(iobs, k, 3) + end do + end do + deallocate( data3d ) + end if + + if ( use_radar_rf .and. has_rf ) then + allocate( data3d(nobs_tot, nlev_max, 3) ) + read(unit_in) data3d + do n = iv%info(radar)%n1, iv%info(radar)%n2 + iobs = iv%info(radar)%obs_global_index(n) + do k = 1 , iv%info(radar)%levels(n) + iv%radar(n)%rf(k)%inv = data3d(iobs, k, 1) + iv%radar(n)%rf(k)%qc = int(data3d(iobs, k, 2)) + iv%radar(n)%rf(k)%error = data3d(iobs, k, 3) + end do + end do + deallocate( data3d ) + end if + + if ( use_radar_rhv .and. has_rhv ) then + allocate( data3d(nobs_tot, nlev_max, 9) ) + read(unit_in) data3d + do n = iv%info(radar)%n1, iv%info(radar)%n2 + iobs = iv%info(radar)%obs_global_index(n) + do k = 1 , iv%info(radar)%levels(n) + iv%radar(n)%rrn(k)%inv = data3d(iobs, k, 1) + iv%radar(n)%rrn(k)%qc = int(data3d(iobs, k, 2)) + iv%radar(n)%rrn(k)%error = data3d(iobs, k, 3) + iv%radar(n)%rsn(k)%inv = data3d(iobs, k, 4) + iv%radar(n)%rsn(k)%qc = int(data3d(iobs, k, 5)) + iv%radar(n)%rsn(k)%error = data3d(iobs, k, 6) + iv%radar(n)%rgr(k)%inv = data3d(iobs, k, 7) + iv%radar(n)%rgr(k)%qc = int(data3d(iobs, k, 8)) + iv%radar(n)%rgr(k)%error = data3d(iobs, k, 9) + end do + end do + deallocate( data3d ) + end if + + if ( use_radar_rqv .and. has_rqv ) then + allocate( data3d(nobs_tot, nlev_max, 3) ) + read(unit_in) data3d + do n = iv%info(radar)%n1, iv%info(radar)%n2 + iobs = iv%info(radar)%obs_global_index(n) + do k = 1 , iv%info(radar)%levels(n) + iv%radar(n)%rqv(k)%inv = data3d(iobs, k, 1) + iv%radar(n)%rqv(k)%qc = int(data3d(iobs, k, 2)) + iv%radar(n)%rqv(k)%error = data3d(iobs, k, 3) + end do + end do + deallocate( data3d ) + end if + + close (unit_in) + end if ! nobs_tot > 0 999 continue close (unit_in) diff --git a/var/da/da_obs_io/da_write_iv_for_multi_inc.inc b/var/da/da_obs_io/da_write_iv_for_multi_inc.inc index 3fcde8bfe6..1d359c7f5f 100644 --- a/var/da/da_obs_io/da_write_iv_for_multi_inc.inc +++ b/var/da/da_obs_io/da_write_iv_for_multi_inc.inc @@ -13,6 +13,12 @@ subroutine da_write_iv_for_multi_inc(file_index, iv) integer :: ounit ! Output unit character(len=filename_len) :: filename + integer :: nobs_tot, nlev_max, iobs + real, allocatable :: data2d(:,:) + real, allocatable :: data3d(:,:,:) + real, allocatable :: data2d_g(:,:) + real, allocatable :: data3d_g(:,:,:) + if (trace_use) call da_trace_entry("da_write_iv_for_multi_inc") !------------------------------------------------------------------------- @@ -736,33 +742,153 @@ subroutine da_write_iv_for_multi_inc(file_index, iv) ! [25] radar obs: - if (iv%info(radar)%plocal(iv%time) - iv%info(radar)%plocal(iv%time-1) > 0) then + nobs_tot = iv%info(radar)%ptotal(num_fgat_time) - iv%info(radar)%ptotal(0) + nlev_max = iv%info(radar)%max_lev + + if ( nobs_tot > 0 ) then + if ( rootproc ) then + write(unit=filename, fmt='(a,i3.3,a)') 'radar_innov_t', file_index + open (unit=ounit,file=trim(filename),form='unformatted', & + status='replace', iostat=ios) + if (ios /= 0) then + call da_error(__FILE__,__LINE__, & + (/"Cannot open file "//trim(filename)/)) + end if + write(ounit) nobs_tot, nlev_max, use_radar_rv, use_radar_rf, use_radar_rhv, use_radar_rqv + end if ! root open ounit + + allocate( data2d(nobs_tot, 2) ) + data2d = 0.0 + do n = iv%info(radar)%n1, iv%info(radar)%n2 + if ( .not. iv%info(radar)%proc_domain(1,n) ) cycle + iobs = iv%info(radar)%obs_global_index(n) + data2d(iobs, 1) = iv%info(radar)%lat(1,n) + data2d(iobs, 2) = iv%info(radar)%lon(1,n) + end do - open (unit=ounit,file=trim(filename)//'.radar',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) + allocate( data2d_g(nobs_tot, 2) ) +#ifdef DM_PARALLEL + call mpi_reduce(data2d, data2d_g, nobs_tot*2, true_mpi_real, mpi_sum, root, comm, ierr) +#else + data2d_g = data2d +#endif + deallocate( data2d ) + if ( rootproc ) then + write(ounit) data2d_g + end if + deallocate( data2d_g ) + + if ( use_radar_rv ) then + allocate( data3d(nobs_tot, nlev_max, 3) ) + data3d = 0.0 + do n = iv%info(radar)%n1, iv%info(radar)%n2 + if ( .not. iv%info(radar)%proc_domain(1,n) ) cycle + iobs = iv%info(radar)%obs_global_index(n) + do k = 1 , iv%info(radar)%levels(n) + data3d(iobs, k, 1) = iv%radar(n)%rv(k)%inv + data3d(iobs, k, 2) = iv%radar(n)%rv(k)%qc * 1.0 !int to real + data3d(iobs, k, 3) = iv%radar(n)%rv(k)%error + end do + end do + allocate( data3d_g(nobs_tot, nlev_max, 3) ) +#ifdef DM_PARALLEL + call mpi_reduce(data3d, data3d_g, nobs_tot*nlev_max*3, true_mpi_real, mpi_sum, root, comm, ierr) +#else + data3d_g = data3d +#endif + deallocate( data3d ) + if ( rootproc ) then + write(ounit) data3d_g + end if + deallocate( data3d_g ) + end if ! use_radar_rv + + if ( use_radar_rf ) then + allocate( data3d(nobs_tot, nlev_max, 3) ) + data3d = 0.0 + do n = iv%info(radar)%n1, iv%info(radar)%n2 + if ( .not. iv%info(radar)%proc_domain(1,n) ) cycle + iobs = iv%info(radar)%obs_global_index(n) + do k = 1 , iv%info(radar)%levels(n) + data3d(iobs, k, 1) = iv%radar(n)%rf(k)%inv + data3d(iobs, k, 2) = iv%radar(n)%rf(k)%qc * 1.0 !int to real + data3d(iobs, k, 3) = iv%radar(n)%rf(k)%error + end do + end do + allocate( data3d_g(nobs_tot, nlev_max, 3) ) +#ifdef DM_PARALLEL + call mpi_reduce(data3d, data3d_g, nobs_tot*nlev_max*3, true_mpi_real, mpi_sum, root, comm, ierr) +#else + data3d_g = data3d +#endif + deallocate( data3d ) + if ( rootproc ) then + write(ounit) data3d_g + end if + deallocate( data3d_g ) + end if ! use_radar_rf + + if ( use_radar_rhv ) then + allocate( data3d(nobs_tot, nlev_max, 9) ) + data3d = 0.0 + do n = iv%info(radar)%n1, iv%info(radar)%n2 + if ( .not. iv%info(radar)%proc_domain(1,n) ) cycle + iobs = iv%info(radar)%obs_global_index(n) + do k = 1 , iv%info(radar)%levels(n) + data3d(iobs, k, 1) = iv%radar(n)%rrn(k)%inv + data3d(iobs, k, 2) = iv%radar(n)%rrn(k)%qc * 1.0 !int to real + data3d(iobs, k, 3) = iv%radar(n)%rrn(k)%error + data3d(iobs, k, 4) = iv%radar(n)%rsn(k)%inv + data3d(iobs, k, 5) = iv%radar(n)%rsn(k)%qc * 1.0 !int to real + data3d(iobs, k, 6) = iv%radar(n)%rsn(k)%error + data3d(iobs, k, 7) = iv%radar(n)%rgr(k)%inv + data3d(iobs, k, 8) = iv%radar(n)%rgr(k)%qc * 1.0 !int to real + data3d(iobs, k, 9) = iv%radar(n)%rgr(k)%error + end do + end do + allocate( data3d_g(nobs_tot, nlev_max, 9) ) +#ifdef DM_PARALLEL + call mpi_reduce(data3d, data3d_g, nobs_tot*nlev_max*9, true_mpi_real, mpi_sum, root, comm, ierr) +#else + data3d_g = data3d +#endif + deallocate( data3d ) + if ( rootproc ) then + write(ounit) data3d_g + end if + deallocate( data3d_g ) end if - write(ounit,'(a20,i8)')'radar', iv%info(radar)%plocal(iv%time) - & - iv%info(radar)%plocal(iv%time-1) - do n = iv%info(radar)%plocal(iv%time-1) + 1, & - iv%info(radar)%plocal(iv%time) - write(ounit,'(2i8,2E22.13)')& - n, iv%info(radar)%levels(n), & - iv%info(radar)%lat(1,n), & ! Latitude - iv%info(radar)%lon(1,n) ! Longitude - do k = 1 , iv%info(radar)%levels(n) - write(ounit,'(E22.13,i8,3E22.13)')& - iv%radar(n)%rv(k) ! radar_rv - - enddo - end do - close (ounit) - end if - + if ( use_radar_rqv ) then + allocate( data3d(nobs_tot, nlev_max, 3) ) + data3d = 0.0 + do n = iv%info(radar)%n1, iv%info(radar)%n2 + if ( .not. iv%info(radar)%proc_domain(1,n) ) cycle + iobs = iv%info(radar)%obs_global_index(n) + do k = 1 , iv%info(radar)%levels(n) + data3d(iobs, k, 1) = iv%radar(n)%rqv(k)%inv + data3d(iobs, k, 2) = iv%radar(n)%rqv(k)%qc * 1.0 !int to real + data3d(iobs, k, 3) = iv%radar(n)%rqv(k)%error + end do + end do + allocate( data3d_g(nobs_tot, nlev_max, 3) ) +#ifdef DM_PARALLEL + call mpi_reduce(data3d, data3d_g, nobs_tot*nlev_max*3, true_mpi_real, mpi_sum, root, comm, ierr) +#else + data3d_g = data3d +#endif + deallocate( data3d ) + if ( rootproc ) then + write(ounit) data3d_g + end if + deallocate( data3d_g ) + end if ! use_radar_rqv + + if ( rootproc ) then + close(ounit) + end if + end if ! nobs_tot > 0 !------------------------------------------------------------------------------- From 354371680983533d390ecb5c5a478a1a2941e979 Mon Sep 17 00:00:00 2001 From: liujake Date: Mon, 7 Dec 2020 19:58:14 -0700 Subject: [PATCH 85/91] deleted: var/da/da_obs_io/da_read_iv_for_multi_inc_opt2.inc deleted: var/da/da_obs_io/da_write_iv_for_multi_inc_opt2.inc --- .../da_read_iv_for_multi_inc_opt2.inc | 839 ---------------- .../da_write_iv_for_multi_inc_opt2.inc | 902 ------------------ 2 files changed, 1741 deletions(-) delete mode 100644 var/da/da_obs_io/da_read_iv_for_multi_inc_opt2.inc delete mode 100644 var/da/da_obs_io/da_write_iv_for_multi_inc_opt2.inc diff --git a/var/da/da_obs_io/da_read_iv_for_multi_inc_opt2.inc b/var/da/da_obs_io/da_read_iv_for_multi_inc_opt2.inc deleted file mode 100644 index f1f9e7fa7c..0000000000 --- a/var/da/da_obs_io/da_read_iv_for_multi_inc_opt2.inc +++ /dev/null @@ -1,839 +0,0 @@ -subroutine da_read_iv_for_multi_inc_opt2(file_index, iv) - - !----------------------------------------------------------------------- - ! Purpose: Read for Multi-incremental - !----------------------------------------------------------------------- - - !------------------------------------------------------------------------- - ! read iv=O-B structure written by WRFVAR - !------------------------------------------------------------------------- - - implicit none - - type (iv_type), intent(inout) :: iv ! O-B structure. - integer, intent(in) :: file_index - integer :: unit_in - character(len=filename_len) :: filename - - integer :: num_obs, ios - character*20 :: ob_type_string - - integer :: n, gn - logical :: found_flag - - integer :: nobs_tot, nlev_max, k , iobs - integer :: nobs_in, nlev_in - logical :: has_rv, has_rf, has_rhv, has_rqv - real, allocatable :: data2d(:,:) - real, allocatable :: data3d(:,:,:) - - if (trace_use) call da_trace_entry("da_read_iv_for_multi_inc_opt2") - - !------------------------------------------------------------------------- - ! Fix input unit - !------------------------------------------------------------------------- - - call da_get_unit(unit_in) - - write(unit=filename, fmt='(a,i3.3)') 'gts_omb.', file_index - - ! [1] surface obs: - - if (iv%info(synop)%plocal(iv%time)-iv%info(synop)%plocal(iv%time-1) > 0) then - - open(unit=unit_in,file=trim(filename)//'.synop',form='formatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'synop' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find synop marker. "/)) - gn = 0 - do n = iv%info(synop)%plocal(iv%time-1) + 1, & - iv%info(synop)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find synop obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(synop)%plocal(iv%time)-iv%info(synop)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - - ! [2] metar obs: - - if (iv%info(metar)%plocal(iv%time)-iv%info(metar)%plocal(iv%time-1) > 0) then - open(unit=unit_in,file=trim(filename)//'.metar',form='formatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'metar' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find metar marker. "/)) - gn = 0 - do n = iv%info(metar)%plocal(iv%time-1) + 1, & - iv%info(metar)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find metar obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(metar)%plocal(iv%time)-iv%info(metar)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - - ! [3] ships obs: - - if (iv%info(ships)%plocal(iv%time)-iv%info(ships)%plocal(iv%time-1) > 0) then - - open(unit=unit_in,file=trim(filename)//'.ships',form='formatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'ships' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find ships marker. "/)) - gn = 0 - do n = iv%info(ships)%plocal(iv%time-1) + 1, & - iv%info(ships)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find ships obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(ships)%plocal(iv%time)-iv%info(ships)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - - ! [4] sonde_sfc obs: - - if (iv%info(sonde_sfc)%plocal(iv%time)-iv%info(sonde_sfc)%plocal(iv%time-1) > 0) then - - open(unit=unit_in,file=trim(filename)//'.sonde_sfc',form='formatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'sonde_sfc' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find sonde_sfc marker. "/)) - gn = 0 - do n = iv%info(sonde_sfc)%plocal(iv%time-1) + 1, & - iv%info(sonde_sfc)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find sonde_sfc obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(sonde_sfc)%plocal(iv%time)-iv%info(sonde_sfc)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - - ! [5] sound obs: - - if (iv%info(sound)%plocal(iv%time)-iv%info(sound)%plocal(iv%time-1) > 0) then - - open(unit=unit_in,file=trim(filename)//'.sound',form='formatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'sound' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find sound marker. "/)) - gn = 0 - do n = iv%info(sound)%plocal(iv%time-1) + 1, & - iv%info(sound)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find sound obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(sound)%plocal(iv%time)-iv%info(sound)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - - ! [6] mtgirs obs: - - if (iv%info(mtgirs)%plocal(iv%time)-iv%info(mtgirs)%plocal(iv%time-1) > 0) then - - open(unit=unit_in,file=trim(filename)//'.mtgirs',form='formatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'mtgirs' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find mtgirs marker. "/)) - gn = 0 - do n = iv%info(mtgirs)%plocal(iv%time-1) + 1, & - iv%info(mtgirs)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find mtgirs obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(mtgirs)%plocal(iv%time)-iv%info(mtgirs)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - - ! [7] tamdar obs: - - if (iv%info(tamdar)%plocal(iv%time)-iv%info(tamdar)%plocal(iv%time-1) > 0) then - - open(unit=unit_in,file=trim(filename)//'.tamdar',form='formatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'tamdar' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find tamdar marker. "/)) - gn = 0 - do n = iv%info(tamdar)%plocal(iv%time-1) + 1, & - iv%info(tamdar)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find tamdar obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(tamdar)%plocal(iv%time)-iv%info(tamdar)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - - ! [8] tamdar_sfc obs: - - if (iv%info(tamdar_sfc)%plocal(iv%time)-iv%info(tamdar_sfc)%plocal(iv%time-1) > 0) then - - open(unit=unit_in,file=trim(filename)//'.tamdar_sfc',form='formatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'tamdar_sfc' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find tamdar_sfc marker. "/)) - gn = 0 - do n = iv%info(tamdar_sfc)%plocal(iv%time-1) + 1, & - iv%info(tamdar_sfc)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find tamdar_sfc obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(tamdar_sfc)%plocal(iv%time)-iv%info(tamdar_sfc)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - - ! [9] buoy obs: - - if (iv%info(buoy)%plocal(iv%time)-iv%info(buoy)%plocal(iv%time-1) > 0) then - open(unit=unit_in,file=trim(filename)//'.buoy',form='formatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'buoy' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find buoy marker. "/)) - gn = 0 - do n = iv%info(buoy)%plocal(iv%time-1) + 1, & - iv%info(buoy)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find buoy obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(buoy)%plocal(iv%time)-iv%info(buoy)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - - ! [10] Geo AMV obs: - - if (iv%info(geoamv)%plocal(iv%time)-iv%info(geoamv)%plocal(iv%time-1) > 0) then - - open(unit=unit_in,file=trim(filename)//'.geoamv',form='formatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'geoamv' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find geoamv marker. "/)) - gn = 0 - do n = iv%info(geoamv)%plocal(iv%time-1) + 1, & - iv%info(geoamv)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find geoamv obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(geoamv)%plocal(iv%time)-iv%info(geoamv)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - - ! [11] gpspw obs: - - if (iv%info(gpspw)%plocal(iv%time)-iv%info(gpspw)%plocal(iv%time-1) > 0) then - - open(unit=unit_in,file=trim(filename)//'.gpspw',form='formatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'gpspw' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find gpspw marker. "/)) - gn = 0 - do n = iv%info(gpspw)%plocal(iv%time-1) + 1, & - iv%info(gpspw)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find gpspw obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(gpspw)%plocal(iv%time)-iv%info(gpspw)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - - ! [12] SSM/I obs: - - if (iv%info(ssmi_rv)%plocal(iv%time)-iv%info(ssmi_rv)%plocal(iv%time-1) > 0) then - - open(unit=unit_in,file=trim(filename)//'.ssmir',form='formatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'ssmir' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find ssmir marker. "/)) - gn = 0 - do n = iv%info(ssmi_rv)%plocal(iv%time-1) + 1, & - iv%info(ssmi_rv)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find ssmir obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(ssmi_rv)%plocal(iv%time)-iv%info(ssmi_rv)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - - ! [13] airep obs: - - if (iv%info(airep)%plocal(iv%time)-iv%info(airep)%plocal(iv%time-1) > 0) then - - open(unit=unit_in,file=trim(filename)//'.airep',form='formatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'airep' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find airep marker. "/)) - gn = 0 - do n = iv%info(airep)%plocal(iv%time-1) + 1, & - iv%info(airep)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find airep obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(airep)%plocal(iv%time)-iv%info(airep)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - - ! [14] polaramv obs: - - if (iv%info(polaramv)%plocal(iv%time)-iv%info(polaramv)%plocal(iv%time-1) > 0) then - - open(unit=unit_in,file=trim(filename)//'.polaramv',form='formatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'polaramv' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find polaramv marker. "/)) - gn = 0 - do n = iv%info(polaramv)%plocal(iv%time-1) + 1, & - iv%info(polaramv)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find polaramv obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(polaramv)%plocal(iv%time)-iv%info(polaramv)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - - ! [15] pilot obs: - - if (iv%info(pilot)%plocal(iv%time)-iv%info(pilot)%plocal(iv%time-1) > 0) then - - open(unit=unit_in,file=trim(filename)//'.pilot',form='formatted',status='old',iostat=ios) - - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'pilot' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find pilot marker. "/)) - gn = 0 - do n = iv%info(pilot)%plocal(iv%time-1) + 1, & - iv%info(pilot)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find pilot obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(pilot)%plocal(iv%time)-iv%info(pilot)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - - ! [16] ssmi_tb obs: - - if (iv%info(ssmi_tb)%plocal(iv%time)-iv%info(ssmi_tb)%plocal(iv%time-1) > 0) then - - open(unit=unit_in,file=trim(filename)//'.ssmi_tb',form='formatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'ssmi_tb' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find ssmi_tb marker. "/)) - gn = 0 - do n = iv%info(ssmi_tb)%plocal(iv%time-1) + 1, & - iv%info(ssmi_tb)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find ssmi_tb obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(ssmi_tb)%plocal(iv%time)-iv%info(ssmi_tb)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - - ! [17] satem obs: - - if (iv%info(satem)%plocal(iv%time)-iv%info(satem)%plocal(iv%time-1) > 0) then - open(unit=unit_in,file=trim(filename)//'.satem',form='formatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'satem' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find satem marker. "/)) - gn = 0 - do n = iv%info(satem)%plocal(iv%time-1) + 1, & - iv%info(satem)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find satem obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(satem)%plocal(iv%time)-iv%info(satem)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - - ! [18] ssmt1 obs: - - if (iv%info(ssmt1)%plocal(iv%time)-iv%info(ssmt1)%plocal(iv%time-1) > 0) then - - open(unit=unit_in,file=trim(filename)//'.ssmt1',form='formatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'ssmt1' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find ssmt1 marker. "/)) - gn = 0 - do n = iv%info(ssmt1)%plocal(iv%time-1) + 1, & - iv%info(ssmt1)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find ssmt1 obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(ssmt1)%plocal(iv%time)-iv%info(ssmt1)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - - ! [19] ssmt2 obs: - - if (iv%info(ssmt2)%plocal(iv%time)-iv%info(ssmt2)%plocal(iv%time-1) > 0) then - - open(unit=unit_in,file=trim(filename)//'.ssmt2',form='formatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'ssmt2' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find ssmt2 marker. "/)) - gn = 0 - do n = iv%info(ssmt2)%plocal(iv%time-1) + 1, & - iv%info(ssmt2)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find ssmt2 obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(ssmt2)%plocal(iv%time)-iv%info(ssmt2)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - - ! [20] scatterometer obs: - - if (iv%info(qscat)%plocal(iv%time)-iv%info(qscat)%plocal(iv%time-1) > 0) then - open(unit=unit_in,file=trim(filename)//'.qscat',form='formatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'qscat' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find qscat marker. "/)) - gn = 0 - do n = iv%info(qscat)%plocal(iv%time-1) + 1, & - iv%info(qscat)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find qscat obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(qscat)%plocal(iv%time)-iv%info(qscat)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - - ! [21] profiler obs: - - if (iv%info(profiler)%plocal(iv%time)-iv%info(profiler)%plocal(iv%time-1) > 0) then - - open(unit=unit_in,file=trim(filename)//'.profiler',form='formatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'profiler' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find profiler marker. "/)) - gn = 0 - do n = iv%info(profiler)%plocal(iv%time-1) + 1, & - iv%info(profiler)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find profiler obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(profiler)%plocal(iv%time)-iv%info(profiler)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - - ! [22] TC bogus obs: - - if (iv%info(bogus)%plocal(iv%time)-iv%info(bogus)%plocal(iv%time-1) > 0) then - - open(unit=unit_in,file=trim(filename)//'.bogus',form='formatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'bogus' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find bogus marker. "/)) - gn = 0 - do n = iv%info(bogus)%plocal(iv%time-1) + 1, & - iv%info(bogus)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find bogus obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(bogus)%plocal(iv%time)-iv%info(bogus)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - - ! [23] AIRS retrievals: - - if (iv%info(airsr)%plocal(iv%time)-iv%info(airsr)%plocal(iv%time-1) > 0) then - - open(unit=unit_in,file=trim(filename)//'.airsr',form='formatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'airsr' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find airsr marker. "/)) - gn = 0 - do n = iv%info(airsr)%plocal(iv%time-1) + 1, & - iv%info(airsr)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find airsr obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(airsr)%plocal(iv%time)-iv%info(airsr)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - - ! [24] gpsref obs: - - if (iv%info(gpsref)%plocal(iv%time)-iv%info(gpsref)%plocal(iv%time-1) > 0) then - - open(unit=unit_in,file=trim(filename)//'.gpsref',form='formatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file"//filename/)) - end if - - read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs - if ( trim(adjustl(ob_type_string)) .ne. 'gpsref' ) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find gpsref marker. "/)) - gn = 0 - do n = iv%info(gpsref)%plocal(iv%time-1) + 1, & - iv%info(gpsref)%plocal(iv%time) - call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag) - if (found_flag .eqv. .false.) & - call da_error(__FILE__,__LINE__, & - (/"Cannot find gpsref obs. "/)) - gn = gn + 1 - end do - if (gn /= iv%info(gpsref)%plocal(iv%time)-iv%info(gpsref)%plocal(iv%time-1)) & - call da_error(__FILE__,__LINE__, & - (/"Unequal obs. found "/)) - close (unit_in) - end if - - - ! [25] radar obs: - - nobs_tot = iv%info(radar)%ptotal(num_fgat_time) - iv%info(radar)%ptotal(0) - nlev_max = iv%info(radar)%max_lev - - if ( nobs_tot > 0 ) then - - write(unit=filename, fmt='(a,i3.3)') 'radar_innov_t', file_index - open(unit=unit_in,file=trim(filename),form='unformatted',status='old',iostat=ios) - if (ios /= 0) Then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file "//trim(filename)/)) - end if - - read(unit_in) nobs_in, nlev_in, has_rv, has_rf, has_rhv, has_rqv - if ( nobs_in /= nobs_tot .or. nlev_in /= nlev_max ) then - call da_error(__FILE__,__LINE__, & - (/"Dimensions (nobs_tot or nlev_max) mismatch "/)) - end if - allocate ( data2d(nobs_tot, 2) ) - read(unit_in) data2d - do n = iv%info(radar)%n1, iv%info(radar)%n2 - iobs = iv%info(radar)%obs_global_index(n) -! iv%info(radar)%lat(1,n) = data2d(iobs, 1) -! iv%info(radar)%lon(1,n) = data2d(iobs, 2) - end do - deallocate ( data2d ) - - if ( use_radar_rv .and. has_rv ) then - allocate( data3d(nobs_tot, nlev_max, 3) ) - read(unit_in) data3d - do n = iv%info(radar)%n1, iv%info(radar)%n2 - iobs = iv%info(radar)%obs_global_index(n) - do k = 1 , iv%info(radar)%levels(n) - iv%radar(n)%rv(k)%inv = data3d(iobs, k, 1) - iv%radar(n)%rv(k)%qc = int(data3d(iobs, k, 2)) - iv%radar(n)%rv(k)%error = data3d(iobs, k, 3) - end do - end do - deallocate( data3d ) - end if - - if ( use_radar_rf .and. has_rf ) then - allocate( data3d(nobs_tot, nlev_max, 3) ) - read(unit_in) data3d - do n = iv%info(radar)%n1, iv%info(radar)%n2 - iobs = iv%info(radar)%obs_global_index(n) - do k = 1 , iv%info(radar)%levels(n) - iv%radar(n)%rf(k)%inv = data3d(iobs, k, 1) - iv%radar(n)%rf(k)%qc = int(data3d(iobs, k, 2)) - iv%radar(n)%rf(k)%error = data3d(iobs, k, 3) - end do - end do - deallocate( data3d ) - end if - - if ( use_radar_rhv .and. has_rhv ) then - allocate( data3d(nobs_tot, nlev_max, 9) ) - read(unit_in) data3d - do n = iv%info(radar)%n1, iv%info(radar)%n2 - iobs = iv%info(radar)%obs_global_index(n) - do k = 1 , iv%info(radar)%levels(n) - iv%radar(n)%rrn(k)%inv = data3d(iobs, k, 1) - iv%radar(n)%rrn(k)%qc = int(data3d(iobs, k, 2)) - iv%radar(n)%rrn(k)%error = data3d(iobs, k, 3) - iv%radar(n)%rsn(k)%inv = data3d(iobs, k, 4) - iv%radar(n)%rsn(k)%qc = int(data3d(iobs, k, 5)) - iv%radar(n)%rsn(k)%error = data3d(iobs, k, 6) - iv%radar(n)%rgr(k)%inv = data3d(iobs, k, 7) - iv%radar(n)%rgr(k)%qc = int(data3d(iobs, k, 8)) - iv%radar(n)%rgr(k)%error = data3d(iobs, k, 9) - end do - end do - deallocate( data3d ) - end if - - if ( use_radar_rqv .and. has_rqv ) then - allocate( data3d(nobs_tot, nlev_max, 3) ) - read(unit_in) data3d - do n = iv%info(radar)%n1, iv%info(radar)%n2 - iobs = iv%info(radar)%obs_global_index(n) - do k = 1 , iv%info(radar)%levels(n) - iv%radar(n)%rqv(k)%inv = data3d(iobs, k, 1) - iv%radar(n)%rqv(k)%qc = int(data3d(iobs, k, 2)) - iv%radar(n)%rqv(k)%error = data3d(iobs, k, 3) - end do - end do - deallocate( data3d ) - end if - - close (unit_in) - end if ! nobs_tot > 0 - -999 continue - close (unit_in) - call da_free_unit(unit_in) - - if (trace_use) call da_trace_exit("da_read_iv_for_multi_inc_opt2") - return - -1000 continue - write(unit=message(1), fmt='(a,i3)') & - 'read error on unit: ',unit_in - call da_warning(__FILE__,__LINE__,message(1:1)) - -end subroutine da_read_iv_for_multi_inc_opt2 diff --git a/var/da/da_obs_io/da_write_iv_for_multi_inc_opt2.inc b/var/da/da_obs_io/da_write_iv_for_multi_inc_opt2.inc deleted file mode 100644 index 76afc8411e..0000000000 --- a/var/da/da_obs_io/da_write_iv_for_multi_inc_opt2.inc +++ /dev/null @@ -1,902 +0,0 @@ -subroutine da_write_iv_for_multi_inc_opt2(file_index, iv) - - !------------------------------------------------------------------------- - ! Purpose: Writes out components of iv=O-B structure. - !------------------------------------------------------------------------- - - implicit none - - type (iv_type), intent(in) :: iv ! O-B structure. - integer, intent (in) :: file_index - - integer :: n, k, ios - integer :: ounit ! Output unit - character(len=filename_len) :: filename - - integer :: nobs_tot, nlev_max, iobs - real, allocatable :: data2d(:,:) - real, allocatable :: data3d(:,:,:) - real, allocatable :: data2d_g(:,:) - real, allocatable :: data3d_g(:,:,:) - - if (trace_use) call da_trace_entry("da_write_iv_for_multi_inc_opt2") - - !------------------------------------------------------------------------- - ! Fix output unit - !------------------------------------------------------------------------- - - call da_get_unit(ounit) -#ifdef DM_PARALLEL - write(unit=filename, fmt='(a,i3.3,a,i4.4)') 'stub.', file_index, '.', myproc -#else - write(unit=filename, fmt='(a,i3.3)') 'gts_omb.', file_index -#endif - ! [1] surface obs: - - if (iv%info(synop)%plocal(iv%time) - iv%info(synop)%plocal(iv%time-1) > 0) then - - open (unit=ounit,file=trim(filename)//'.synop',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) - end if - - write(ounit,'(a20,i8)')'synop',iv%info(synop)%plocal(iv%time) - & - iv%info(synop)%plocal(iv%time-1) - do n = iv%info(synop)%plocal(iv%time-1) + 1, & - iv%info(synop)%plocal(iv%time) - write(ounit,'(i8,a5,2E22.13)')& - n , iv%info(synop)%id(n), & ! Station - iv%info(synop)%lat(1,n), & ! Latitude - iv%info(synop)%lon(1,n) ! Longitude - write(ounit,'(E22.13,5(E22.13,i8,3E22.13))')& - iv%synop(n)%h, & - iv%synop(n)%u, &! O-B u - iv%synop(n)%v, &! O-B v - iv%synop(n)%t, &! O-B t - iv%synop(n)%p, &! O-B p - iv%synop(n)%q ! O-B q - end do - close (ounit) - end if - - ! [2] metar obs: - - if (iv%info(metar)%plocal(iv%time) - iv%info(metar)%plocal(iv%time-1) > 0) then - - open (unit=ounit,file=trim(filename)//'.metar',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) - end if - - write(ounit,'(a20,i8)')'metar', iv%info(metar)%plocal(iv%time) - & - iv%info(metar)%plocal(iv%time-1) - do n = iv%info(metar)%plocal(iv%time-1) + 1, & - iv%info(metar)%plocal(iv%time) - write(ounit,'(i8,a5,2E22.13)')& - n, iv%info(metar)%id(n), & ! Station - iv%info(metar)%lat(1,n), & ! Latitude - iv%info(metar)%lon(1,n) ! Longitude - write(ounit,'(E22.13,5(E22.13,i8,3E22.13))')& - iv%metar(n)%h, & - iv%metar(n)%u, &! O-B u - iv%metar(n)%v, &! O-B v - iv%metar(n)%t, &! O-B t - iv%metar(n)%p, &! O-B p - iv%metar(n)%q ! O-B q - end do - close (ounit) - end if - - ! [3] ships obs: - - if (iv%info(ships)%plocal(iv%time) - iv%info(ships)%plocal(iv%time-1) > 0) then - - open (unit=ounit,file=trim(filename)//'.ships',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) - end if - - write(ounit,'(a20,i8)')'ships', iv%info(ships)%plocal(iv%time) - & - iv%info(ships)%plocal(iv%time-1) - do n = iv%info(ships)%plocal(iv%time-1) + 1, & - iv%info(ships)%plocal(iv%time) - write(ounit,'(i8,a5,2E22.13)')& - n, iv%info(ships)%id(n), & ! Station - iv%info(ships)%lat(1,n), & ! Latitude - iv%info(ships)%lon(1,n) ! Longitude - write(ounit,'(E22.13,5(E22.13,i8,3E22.13))')& - iv%ships(n)%h, & - iv%ships(n)%u, &! O-B u - iv%ships(n)%v, &! O-B v - iv%ships(n)%t, &! O-B t - iv%ships(n)%p, &! O-B p - iv%ships(n)%q ! O-B q - end do - close (ounit) - end if - - ! [4] sonde_sfc obs: - - if (iv%info(sonde_sfc)%plocal(iv%time) - iv%info(sonde_sfc)%plocal(iv%time-1) > 0) then - - open (unit=ounit,file=trim(filename)//'.sonde_sfc',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) - end if - - write(ounit,'(a20,i8)')'sonde_sfc', iv%info(sonde_sfc)%plocal(iv%time) - & - iv%info(sonde_sfc)%plocal(iv%time-1) - do n = iv%info(sonde_sfc)%plocal(iv%time-1) + 1, & - iv%info(sonde_sfc)%plocal(iv%time) - write(ounit,'(i8,a5,2E22.13)')& - n, iv%info(sonde_sfc)%id(n), & ! Station - iv%info(sonde_sfc)%lat(1,n), & ! Latitude - iv%info(sonde_sfc)%lon(1,n) ! Longitude - write(ounit,'(E22.13,5(E22.13,i8,3E22.13))')& - iv%sonde_sfc(n)%h, & - iv%sonde_sfc(n)%u, &! O-B u - iv%sonde_sfc(n)%v, &! O-B v - iv%sonde_sfc(n)%t, &! O-B t - iv%sonde_sfc(n)%p, &! O-B p - iv%sonde_sfc(n)%q ! O-B q - end do - close (ounit) - end if - - ! [5] sound obs: - - if (iv%info(sound)%plocal(iv%time) - iv%info(sound)%plocal(iv%time-1) > 0) then - - open (unit=ounit,file=trim(filename)//'.sound',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) - end if - - write(ounit,'(a20,i8)')'sound', iv%info(sound)%plocal(iv%time) - & - iv%info(sound)%plocal(iv%time-1) - do n = iv%info(sound)%plocal(iv%time-1) + 1, & - iv%info(sound)%plocal(iv%time) - write(ounit,'(2i8,a5,2E22.13)')& - n, iv%info(sound)%levels(n), iv%info(sound)%id(n), & ! Station - iv%info(sound)%lat(1,n), & ! Latitude - iv%info(sound)%lon(1,n) ! Longitude - do k = 1 , iv%info(sound)%levels(n) - write(ounit,'(2E22.13,4(E22.13,i8,3E22.13))')& - iv%sound(n)%h(k), & - iv%sound(n)%p(k), & ! Obs Pressure - iv%sound(n)%u(k), &! O-B u - iv%sound(n)%v(k), &! O-B v - iv%sound(n)%t(k), &! O-B t - iv%sound(n)%q(k) ! O-B q - enddo - end do - close (ounit) - end if - - ! [6] mtgirs obs: - - if (iv%info(mtgirs)%plocal(iv%time) - iv%info(mtgirs)%plocal(iv%time-1) > 0) then - - open (unit=ounit,file=trim(filename)//'.mtgirs',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) - end if - - write(ounit,'(a20,i8)')'mtgirs', iv%info(mtgirs)%plocal(iv%time) - & - iv%info(mtgirs)%plocal(iv%time-1) - do n = iv%info(mtgirs)%plocal(iv%time-1) + 1, & - iv%info(mtgirs)%plocal(iv%time) - write(ounit,'(2i8,a5,2E22.13)')& - n, iv%info(mtgirs)%levels(n), iv%info(mtgirs)%id(n), & ! Station - iv%info(mtgirs)%lat(1,n), & ! Latitude - iv%info(mtgirs)%lon(1,n) ! Longitude - do k = 1 , iv%info(mtgirs)%levels(n) - write(ounit,'(2E22.13,4(E22.13,i8,3E22.13))')& - iv % mtgirs(n) % h(k), & - iv % mtgirs(n) % p(k), & ! Obs Pressure - iv%mtgirs(n)%u(k), &! O-B u - iv%mtgirs(n)%v(k), &! O-B v - iv%mtgirs(n)%t(k), &! O-B t - iv%mtgirs(n)%q(k) ! O-B q - - enddo - end do - close (ounit) - end if - - ! [7] tamdar - - if (iv%info(tamdar)%plocal(iv%time) - iv%info(tamdar)%plocal(iv%time-1) > 0) then - - open (unit=ounit,file=trim(filename)//'.tamdar',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) - end if - - write(ounit,'(a20,i8)')'tamdar', iv%info(tamdar)%plocal(iv%time) - & - iv%info(tamdar)%plocal(iv%time-1) - do n = iv%info(tamdar)%plocal(iv%time-1) + 1, & - iv%info(tamdar)%plocal(iv%time) - write(ounit,'(2i8,a5,2E22.13)')& - n, iv%info(tamdar)%levels(n), iv%info(tamdar)%id(n), & ! Station - iv%info(tamdar)%lat(1,n), & ! Latitude - iv%info(tamdar)%lon(1,n) ! Longitude - do k = 1 , iv%info(tamdar)%levels(n) - write(ounit,'(2E22.13,4(E22.13,i8,3E22.13))')& - iv%tamdar(n)%h(k), & - iv%tamdar(n)%p(k), & ! Obs Pressure - iv%tamdar(n)%u(k), &! O-B u - iv%tamdar(n)%v(k), &! O-B v - iv%tamdar(n)%t(k), &! O-B t - iv%tamdar(n)%q(k) ! O-B q - enddo - end do - close (ounit) - end if - - ! [8] tamdar_sfc - - if (iv%info(tamdar_sfc)%plocal(iv%time) - iv%info(tamdar_sfc)%plocal(iv%time-1) > 0) then - - open (unit=ounit,file=trim(filename)//'.tamdar_sfc',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) - end if - - write(ounit,'(a20,i8)')'tamdar_sfc', iv%info(tamdar_sfc)%plocal(iv%time) - & - iv%info(tamdar_sfc)%plocal(iv%time-1) - do n = iv%info(tamdar_sfc)%plocal(iv%time-1) + 1, & - iv%info(tamdar_sfc)%plocal(iv%time) - write(ounit,'(i8,a5,2E22.13)')& - n, iv%info(tamdar_sfc)%id(n), & ! Station - iv%info(tamdar_sfc)%lat(1,n), & ! Latitude - iv%info(tamdar_sfc)%lon(1,n) ! Longitude - write(ounit,'(E22.13,5(E22.13,i8,3E22.13))')& - iv%tamdar_sfc(n)%h, & - iv%tamdar_sfc(n)%u, &! O-B u - iv%tamdar_sfc(n)%v, &! O-B v - iv%tamdar_sfc(n)%t, &! O-B t - iv%tamdar_sfc(n)%p, &! O-B p - iv%tamdar_sfc(n)%q ! O-B q - end do - close (ounit) - end if - - ! [9] buoy obs: - - if (iv%info(buoy)%plocal(iv%time) - iv%info(buoy)%plocal(iv%time-1) > 0) then - - open (unit=ounit,file=trim(filename)//'.buoy',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) - end if - - write(ounit,'(a20,i8)')'buoy', iv%info(buoy)%plocal(iv%time) - & - iv%info(buoy)%plocal(iv%time-1) - do n = iv%info(buoy)%plocal(iv%time-1) + 1, & - iv%info(buoy)%plocal(iv%time) - write(ounit,'(i8,a5,2E22.13)')& - n, iv%info(buoy)%id(n), & ! Station - iv%info(buoy)%lat(1,n), & ! Latitude - iv%info(buoy)%lon(1,n) ! Longitude - write(ounit,'(E22.13,5(E22.13,i8,3E22.13))')& - iv%buoy(n)%h, & - iv%buoy(n)%u, &! O-B u - iv%buoy(n)%v, &! O-B v - iv%buoy(n)%t, &! O-B t - iv%buoy(n)%p, &! O-B p - iv%buoy(n)%q ! O-B q - end do - close (ounit) - end if - - ! [10] Geo AMVs obs: - - if (iv%info(geoamv)%plocal(iv%time) - iv%info(geoamv)%plocal(iv%time-1) > 0) then - - open (unit=ounit,file=trim(filename)//'.geoamv',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) - end if - - write(ounit,'(a20,i8)')'geoamv', iv%info(geoamv)%plocal(iv%time) - & - iv%info(geoamv)%plocal(iv%time-1) - do n = iv%info(geoamv)%plocal(iv%time-1) + 1, & - iv%info(geoamv)%plocal(iv%time) - write(ounit,'(2i8,a5,2E22.13)')& - n, iv%info(geoamv)%levels(n), iv%info(geoamv)%id(n), & ! Station - iv%info(geoamv)%lat(1,n), & ! Latitude - iv%info(geoamv)%lon(1,n) ! Longitude - do k = 1 , iv%info(geoamv)%levels(n) - write(ounit,'(E22.13,2(E22.13,i8,3E22.13))')& - iv%geoamv(n)%p(k), & ! Obs Pressure - iv%geoamv(n)%u(k), &! O-B u - iv%geoamv(n)%v(k) - enddo - end do - close (ounit) - end if - - ! [11] gpspw obs: - - if (iv%info(gpspw)%plocal(iv%time) - iv%info(gpspw)%plocal(iv%time-1) > 0) then - - open (unit=ounit,file=trim(filename)//'.gpspw',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) - end if - - write(ounit,'(a20,i8)')'gpspw', iv%info(gpspw)%plocal(iv%time) - & - iv%info(gpspw)%plocal(iv%time-1) - do n = iv%info(gpspw)%plocal(iv%time-1) + 1, & - iv%info(gpspw)%plocal(iv%time) - write(ounit,'(i8,a5,2E22.13)')& - n, iv%info(gpspw)%id(n), & ! Station - iv%info(gpspw)%lat(1,n), & ! Latitude - iv%info(gpspw)%lon(1,n) ! Longitude - write(ounit,'(E22.13,i8,3E22.13)')& - iv%gpspw(n)%tpw - end do - close (ounit) - end if - - ! [12] SSM/I obs: - - if (iv%info(ssmi_rv)%plocal(iv%time) - iv%info(ssmi_rv)%plocal(iv%time-1) > 0) then - - open (unit=ounit,file=trim(filename)//'.ssmir',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) - end if - - write(ounit,'(a20,i8)')'ssmir', iv%info(ssmi_rv)%plocal(iv%time) - & - iv%info(ssmi_rv)%plocal(iv%time-1) - do n = iv%info(ssmi_rv)%plocal(iv%time-1) + 1, & - iv%info(ssmi_rv)%plocal(iv%time) - write(ounit,'(i8,2E22.13)')& - n, & ! Station - iv%info(ssmi_rv)%lat(1,n), & ! Latitude - iv%info(ssmi_rv)%lon(1,n) ! Longitude - write(ounit,'(2(E22.13,i8,3E22.13))')& - iv%ssmi_rv(n)%speed, & ! O-B speed - iv%ssmi_rv(n)%tpw ! O-BA tpw - end do - close (ounit) - end if - - ! [13] airep obs: - - if (iv%info(airep)%plocal(iv%time) - iv%info(airep)%plocal(iv%time-1) > 0) then - - open (unit=ounit,file=trim(filename)//'.airep',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) - end if - - write(ounit,'(a20,i8)')'airep', iv%info(airep)%plocal(iv%time) - & - iv%info(airep)%plocal(iv%time-1) - do n = iv%info(airep)%plocal(iv%time-1) + 1, & - iv%info(airep)%plocal(iv%time) - write(ounit,'(2i8,a5,2E22.13)')& - n, iv%info(airep)%levels(n), iv%info(airep)%id(n), & ! Station - iv%info(airep)%lat(1,n), & ! Latitude - iv%info(airep)%lon(1,n) ! Longitude - do k = 1 , iv%info(airep)%levels(n) - write(ounit,'(2E22.13,4(E22.13,i8,3E22.13))')& - iv%airep(n)%h(k), & - iv%airep(n)%p(k), & ! Obs pressure - iv%airep(n)%u(k), &! O-B u - iv%airep(n)%v(k), &! O-B v - iv%airep(n)%t(k), & - iv%airep(n)%q(k) - enddo - end do - close (ounit) - end if - - ! [14] Polar AMVs obs: - - if (iv%info(polaramv)%plocal(iv%time) - iv%info(polaramv)%plocal(iv%time-1) > 0) then - - open (unit=ounit,file=trim(filename)//'.polaramv',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) - end if - - write(ounit,'(a20,i8)')'polaramv', iv%info(polaramv)%plocal(iv%time) - & - iv%info(polaramv)%plocal(iv%time-1) - do n = iv%info(polaramv)%plocal(iv%time-1) + 1, & - iv%info(polaramv)%plocal(iv%time) - write(ounit,'(2i8,a5,2E22.13)')& - n, iv%info(polaramv)%levels(n), iv%info(polaramv)%id(n), & ! Station - iv%info(polaramv)%lat(1,n), & ! Latitude - iv%info(polaramv)%lon(1,n) ! Longitude - do k = 1 , iv%info(polaramv)%levels(n) - write(ounit,'(E22.13,2(E22.13,i8,3E22.13))')& - iv%polaramv(n)%p(k), & ! Obs Pressure - iv%polaramv(n)%u(k), &! O-B u - iv%polaramv(n)%v(k) - enddo - end do - close (ounit) - end if - - ! [15] pilot obs: - - if (iv%info(pilot)%plocal(iv%time) - iv%info(pilot)%plocal(iv%time-1) > 0) then - - open (unit=ounit,file=trim(filename)//'.pilot',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) - end if - - write(ounit,'(a20,i8)')'pilot', iv%info(pilot)%plocal(iv%time) - & - iv%info(pilot)%plocal(iv%time-1) - do n = iv%info(pilot)%plocal(iv%time-1) + 1, & - iv%info(pilot)%plocal(iv%time) - write(ounit,'(2i8,a5,2E22.13)')& - n, iv%info(pilot)%levels(n), iv%info(pilot)%id(n), & ! Station - iv%info(pilot)%lat(1,n), & ! Latitude - iv%info(pilot)%lon(1,n) ! Longitude - do k = 1 , iv%info(pilot)%levels(n) - write(ounit,'(E22.13,2(E22.13,i8,3E22.13))')& - iv%pilot(n)%p(k), & ! Obs Pressure - iv%pilot(n)%u(k), &! O-B u - iv%pilot(n)%v(k) - enddo - end do - close (ounit) - end if - - ! [16] ssmi_tb obs: - - if (iv%info(ssmi_tb)%plocal(iv%time) - iv%info(ssmi_tb)%plocal(iv%time-1) > 0) then - - open (unit=ounit,file=trim(filename)//'.ssmi_tb',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) - end if - - write(ounit,'(a20,i8)')'ssmi_tb', iv%info(ssmi_tb)%plocal(iv%time) - & - iv%info(ssmi_tb)%plocal(iv%time-1) - do n = iv%info(ssmi_tb)%plocal(iv%time-1) + 1, & - iv%info(ssmi_tb)%plocal(iv%time) - write(ounit,'(i8,2E22.13)')& - n, & ! Station - iv%info(ssmi_tb)%lat(1,n), & ! Latitude - iv%info(ssmi_tb)%lon(1,n) ! Longitude - write(ounit,'(7(E22.13,i8,3E22.13))')& - iv%ssmi_tb(n)%tb19h, & ! O-B Tb19h - iv%ssmi_tb(n)%tb19v, & ! O-B Tb19v - iv%ssmi_tb(n)%tb22v, & ! O-B Tb22v - iv%ssmi_tb(n)%tb37h, & ! O-B Tb37h - iv%ssmi_tb(n)%tb37v, & ! O-B Tb37v - iv%ssmi_tb(n)%tb85h, & ! O-B Tb85h - iv%ssmi_tb(n)%tb85v ! O-B Tb85v - end do - close (ounit) - end if - - ! [17] satem obs: - - if (iv%info(satem)%plocal(iv%time) - iv%info(satem)%plocal(iv%time-1) > 0) then - - open (unit=ounit,file=trim(filename)//'.satem',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) - end if - - write(ounit,'(a20,i8)')'satem', iv%info(satem)%plocal(iv%time) - & - iv%info(satem)%plocal(iv%time-1) - do n = iv%info(satem)%plocal(iv%time-1) + 1, & - iv%info(satem)%plocal(iv%time) - write(ounit,'(2i8,a5,2E22.13)')& - n, iv%info(satem)%levels(n), iv%info(satem)%id(n), & ! Station - iv%info(satem)%lat(1,n), & ! Latitude - iv%info(satem)%lon(1,n) ! Longitude - do k = 1 , iv%info(satem)%levels(n) - write(ounit,'(E22.13,(E22.13,i8,3E22.13))')& - iv%satem(n)%p(k), & ! Obs Pressure - iv%satem(n)%thickness(k) - enddo - end do - close (ounit) - end if - - ! [18] ssmt1 obs: - - if (iv%info(ssmt1)%plocal(iv%time) - iv%info(ssmt1)%plocal(iv%time-1) > 0) then - - open (unit=ounit,file=trim(filename)//'.ssmt1',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) - end if - - write(ounit,'(a20,i8)')'ssmt1', iv%info(ssmt1)%plocal(iv%time) - & - iv%info(ssmt1)%plocal(iv%time-1) - do n = iv%info(ssmt1)%plocal(iv%time-1) + 1, & - iv%info(ssmt1)%plocal(iv%time) - write(ounit,'(2i8,a5,2E22.13)')& - n, iv%info(ssmt1)%levels(n), iv%info(ssmt1)%id(n), & ! Station - iv%info(ssmt1)%lat(1,n), & ! Latitude - iv%info(ssmt1)%lon(1,n) ! Longitude - do k = 1 , iv%info(ssmt1)%levels(n) - write(ounit,'(E22.13,(E22.13,i8,3E22.13))')& - iv%ssmt1(n)%h(k), & ! Obs height - iv%ssmt1(n)%t(k) - enddo - end do - close (ounit) - end if - - ! [19] ssmt2 obs: - - if (iv%info(ssmt2)%plocal(iv%time) - iv%info(ssmt2)%plocal(iv%time-1) > 0) then - - open (unit=ounit,file=trim(filename)//'.ssmt2',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) - end if - - write(ounit,'(a20,i8)')'ssmt2', iv%info(ssmt2)%plocal(iv%time) - & - iv%info(ssmt2)%plocal(iv%time-1) - do n = iv%info(ssmt2)%plocal(iv%time-1) + 1, & - iv%info(ssmt2)%plocal(iv%time) - write(ounit,'(2i8,a5,2E22.13)')& - n, iv%info(ssmt2)%levels(n), iv%info(ssmt2)%id(n), & ! Station - iv%info(ssmt2)%lat(1,n), & ! Latitude - iv%info(ssmt2)%lon(1,n) ! Longitude - do k = 1 , iv%info(ssmt2)%levels(n) - write(ounit,'(E22.13,(E22.13,i8,3E22.13))')& - iv%ssmt2(n)%h(k), & ! Obs height - iv%ssmt2(n)%rh(k) - enddo - end do - close (ounit) - end if - - ! [20] scatterometer obs: - - if (iv%info(qscat)%plocal(iv%time) - iv%info(qscat)%plocal(iv%time-1) > 0) then - - open (unit=ounit,file=trim(filename)//'.qscat',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) - end if - - write(ounit,'(a20,i8)')'qscat', iv%info(qscat)%plocal(iv%time) - & - iv%info(qscat)%plocal(iv%time-1) - do n = iv%info(qscat)%plocal(iv%time-1) + 1, & - iv%info(qscat)%plocal(iv%time) - write(ounit,'(i8,a5,2E22.13)')& - n, iv%info(qscat)%id(n), & ! Station - iv%info(qscat)%lat(1,n), & ! Latitude - iv%info(qscat)%lon(1,n) ! Longitude - write(ounit,'(E22.13,2(E22.13,i8,3E22.13))')& - iv%qscat(n)%h, & ! Obs height - iv%qscat(n)%u, &! O-B u - iv%qscat(n)%v ! O-B v - end do - close (ounit) - end if - - ! [21] profiler obs: - - if (iv%info(profiler)%plocal(iv%time) - iv%info(profiler)%plocal(iv%time-1) > 0) then - - open (unit=ounit,file=trim(filename)//'.profiler',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) - end if - - write(ounit,'(a20,i8)')'profiler', iv%info(profiler)%plocal(iv%time) - & - iv%info(profiler)%plocal(iv%time-1) - do n = iv%info(profiler)%plocal(iv%time-1) + 1, & - iv%info(profiler)%plocal(iv%time) - write(ounit,'(2i8,a5,2E22.13)')& - n, iv%info(profiler)%levels(n), iv%info(profiler)%id(n), & ! Station - iv%info(profiler)%lat(1,n), & ! Latitude - iv%info(profiler)%lon(1,n) ! Longitude - do k = 1 , iv%info(profiler)%levels(n) - write(ounit,'(E22.13,2(E22.13,i8,3E22.13))')& - iv%profiler(n)%p(k), & ! Obs Pressure - iv%profiler(n)%u(k), &! O-B u - iv%profiler(n)%v(k) ! O-B v - enddo - end do - close (ounit) - end if - - ! [22] TC bogus obs: - - if (iv%info(bogus)%plocal(iv%time) - iv%info(bogus)%plocal(iv%time-1) > 0) then - - open (unit=ounit,file=trim(filename)//'.bogus',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) - end if - - write(ounit,'(a20,i8)')'bogus', iv%info(bogus)%plocal(iv%time) - & - iv%info(bogus)%plocal(iv%time-1) - do n = iv%info(bogus)%plocal(iv%time-1) + 1, & - iv%info(bogus)%plocal(iv%time) - write(ounit,'(2i8,a5,2E22.13)')& - n, iv%info(bogus)%levels(n), iv%info(bogus)%id(n), & ! Station - iv%info(bogus)%lat(1,n), & ! Latitude - iv%info(bogus)%lon(1,n) ! Longitude - write(ounit,'(E22.13,i8,3E22.13)')& - iv%bogus(n)%slp ! O-B p - do k = 1 , iv%info(bogus)%levels(n) - write(ounit,'(2E22.13,4(E22.13,i8,3E22.13))')& - iv%bogus(n)%h(k), & - iv%bogus(n)%p(k), & ! Obs Pressure - iv%bogus(n)%u(k), &! O-B u - iv%bogus(n)%v(k), &! O-B v - iv%bogus(n)%t(k), &! O-B t - iv%bogus(n)%q(k) ! O-B q - enddo - end do - close (ounit) - end if - - ! [23] AIRS retrievals: - - if (iv%info(airsr)%plocal(iv%time) - iv%info(airsr)%plocal(iv%time-1) > 0) then - - open (unit=ounit,file=trim(filename)//'.airsr',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) - end if - - write(ounit,'(a20,i8)')'airsr', iv%info(airsr)%plocal(iv%time) - & - iv%info(airsr)%plocal(iv%time-1) - do n = iv%info(airsr)%plocal(iv%time-1) + 1, & - iv%info(airsr)%plocal(iv%time) - write(ounit,'(2i8,a5,2E22.13)')& - n, iv%info(airsr)%levels(n), iv%info(airsr)%id(n), & ! Station - iv%info(airsr)%lat(1,n), & ! Latitude - iv%info(airsr)%lon(1,n) ! Longitude - do k = 1 , iv%info(airsr)%levels(n) - write(ounit,'(E22.13,2(E22.13,i8,3E22.13))')& - iv%airsr(n)%p(k), & ! Obs Pressure - iv%airsr(n)%t(k), &! O-B t - iv%airsr(n)%q(k) ! O-B q - enddo - end do - close (ounit) - end if - - ! [24] gpsref obs: - - if (iv%info(gpsref)%plocal(iv%time) - iv%info(gpsref)%plocal(iv%time-1) > 0) then - - open (unit=ounit,file=trim(filename)//'.gpsref',form='formatted',status='replace', & - iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open conventional observation omb file"//filename/)) - end if - - write(ounit,'(a20,i8)')'gpsref', iv%info(gpsref)%plocal(iv%time) - & - iv%info(gpsref)%plocal(iv%time-1) - do n = iv%info(gpsref)%plocal(iv%time-1) + 1, & - iv%info(gpsref)%plocal(iv%time) - write(ounit,'(2i8,a5,2E22.13)')& - n, iv%info(gpsref)%levels(n), iv%info(gpsref)%id(n), & ! Station - iv%info(gpsref)%lat(1,n), & ! Latitude - iv%info(gpsref)%lon(1,n) ! Longitude - do k = 1 , iv%info(gpsref)%levels(n) - write(ounit,'(E22.13,(E22.13,i8,3E22.13))')& - iv%gpsref(n)%h(k), & ! Obs Height - iv%gpsref(n)%ref(k) ! O-B ref - enddo - end do - close (ounit) - end if - - ! [25] radar obs: - - nobs_tot = iv%info(radar)%ptotal(num_fgat_time) - iv%info(radar)%ptotal(0) - nlev_max = iv%info(radar)%max_lev - - if ( nobs_tot > 0 ) then - if ( rootproc ) then - write(unit=filename, fmt='(a,i3.3,a)') 'radar_innov_t', file_index - open (unit=ounit,file=trim(filename),form='unformatted', & - status='replace', iostat=ios) - if (ios /= 0) then - call da_error(__FILE__,__LINE__, & - (/"Cannot open file "//trim(filename)/)) - end if - write(ounit) nobs_tot, nlev_max, use_radar_rv, use_radar_rf, use_radar_rhv, use_radar_rqv - end if ! root open ounit - - allocate( data2d(nobs_tot, 2) ) - data2d = 0.0 - do n = iv%info(radar)%n1, iv%info(radar)%n2 - if ( .not. iv%info(radar)%proc_domain(1,n) ) cycle - iobs = iv%info(radar)%obs_global_index(n) - data2d(iobs, 1) = iv%info(radar)%lat(1,n) - data2d(iobs, 2) = iv%info(radar)%lon(1,n) - end do - - allocate( data2d_g(nobs_tot, 2) ) -#ifdef DM_PARALLEL - call mpi_reduce(data2d, data2d_g, nobs_tot*2, true_mpi_real, mpi_sum, root, comm, ierr) -#else - data2d_g = data2d -#endif - deallocate( data2d ) - if ( rootproc ) then - write(ounit) data2d_g - end if - deallocate( data2d_g ) - - if ( use_radar_rv ) then - allocate( data3d(nobs_tot, nlev_max, 3) ) - data3d = 0.0 - do n = iv%info(radar)%n1, iv%info(radar)%n2 - if ( .not. iv%info(radar)%proc_domain(1,n) ) cycle - iobs = iv%info(radar)%obs_global_index(n) - do k = 1 , iv%info(radar)%levels(n) - data3d(iobs, k, 1) = iv%radar(n)%rv(k)%inv - data3d(iobs, k, 2) = iv%radar(n)%rv(k)%qc * 1.0 !int to real - data3d(iobs, k, 3) = iv%radar(n)%rv(k)%error - end do - end do - allocate( data3d_g(nobs_tot, nlev_max, 3) ) -#ifdef DM_PARALLEL - call mpi_reduce(data3d, data3d_g, nobs_tot*nlev_max*3, true_mpi_real, mpi_sum, root, comm, ierr) -#else - data3d_g = data3d -#endif - deallocate( data3d ) - if ( rootproc ) then - write(ounit) data3d_g - end if - deallocate( data3d_g ) - end if ! use_radar_rv - - if ( use_radar_rf ) then - allocate( data3d(nobs_tot, nlev_max, 3) ) - data3d = 0.0 - do n = iv%info(radar)%n1, iv%info(radar)%n2 - if ( .not. iv%info(radar)%proc_domain(1,n) ) cycle - iobs = iv%info(radar)%obs_global_index(n) - do k = 1 , iv%info(radar)%levels(n) - data3d(iobs, k, 1) = iv%radar(n)%rf(k)%inv - data3d(iobs, k, 2) = iv%radar(n)%rf(k)%qc * 1.0 !int to real - data3d(iobs, k, 3) = iv%radar(n)%rf(k)%error - end do - end do - allocate( data3d_g(nobs_tot, nlev_max, 3) ) -#ifdef DM_PARALLEL - call mpi_reduce(data3d, data3d_g, nobs_tot*nlev_max*3, true_mpi_real, mpi_sum, root, comm, ierr) -#else - data3d_g = data3d -#endif - deallocate( data3d ) - if ( rootproc ) then - write(ounit) data3d_g - end if - deallocate( data3d_g ) - end if ! use_radar_rf - - if ( use_radar_rhv ) then - allocate( data3d(nobs_tot, nlev_max, 9) ) - data3d = 0.0 - do n = iv%info(radar)%n1, iv%info(radar)%n2 - if ( .not. iv%info(radar)%proc_domain(1,n) ) cycle - iobs = iv%info(radar)%obs_global_index(n) - do k = 1 , iv%info(radar)%levels(n) - data3d(iobs, k, 1) = iv%radar(n)%rrn(k)%inv - data3d(iobs, k, 2) = iv%radar(n)%rrn(k)%qc * 1.0 !int to real - data3d(iobs, k, 3) = iv%radar(n)%rrn(k)%error - data3d(iobs, k, 4) = iv%radar(n)%rsn(k)%inv - data3d(iobs, k, 5) = iv%radar(n)%rsn(k)%qc * 1.0 !int to real - data3d(iobs, k, 6) = iv%radar(n)%rsn(k)%error - data3d(iobs, k, 7) = iv%radar(n)%rgr(k)%inv - data3d(iobs, k, 8) = iv%radar(n)%rgr(k)%qc * 1.0 !int to real - data3d(iobs, k, 9) = iv%radar(n)%rgr(k)%error - end do - end do - allocate( data3d_g(nobs_tot, nlev_max, 9) ) -#ifdef DM_PARALLEL - call mpi_reduce(data3d, data3d_g, nobs_tot*nlev_max*9, true_mpi_real, mpi_sum, root, comm, ierr) -#else - data3d_g = data3d -#endif - deallocate( data3d ) - if ( rootproc ) then - write(ounit) data3d_g - end if - deallocate( data3d_g ) - end if - - if ( use_radar_rqv ) then - allocate( data3d(nobs_tot, nlev_max, 3) ) - data3d = 0.0 - do n = iv%info(radar)%n1, iv%info(radar)%n2 - if ( .not. iv%info(radar)%proc_domain(1,n) ) cycle - iobs = iv%info(radar)%obs_global_index(n) - do k = 1 , iv%info(radar)%levels(n) - data3d(iobs, k, 1) = iv%radar(n)%rqv(k)%inv - data3d(iobs, k, 2) = iv%radar(n)%rqv(k)%qc * 1.0 !int to real - data3d(iobs, k, 3) = iv%radar(n)%rqv(k)%error - end do - end do - allocate( data3d_g(nobs_tot, nlev_max, 3) ) -#ifdef DM_PARALLEL - call mpi_reduce(data3d, data3d_g, nobs_tot*nlev_max*3, true_mpi_real, mpi_sum, root, comm, ierr) -#else - data3d_g = data3d -#endif - deallocate( data3d ) - if ( rootproc ) then - write(ounit) data3d_g - end if - deallocate( data3d_g ) - end if ! use_radar_rqv - - if ( rootproc ) then - close(ounit) - end if - - end if ! nobs_tot > 0 - - !------------------------------------------------------------------------------- - - - call da_free_unit(ounit) - - if (trace_use) call da_trace_exit("da_write_iv_for_multi_inc_opt2") - -end subroutine da_write_iv_for_multi_inc_opt2 - - From 4c9b23d89dfd9cfc16b02ef2286c5789f3ea5c1c Mon Sep 17 00:00:00 2001 From: liujake Date: Mon, 7 Dec 2020 20:10:14 -0700 Subject: [PATCH 86/91] Remove opt2 interpolation modified: var/build/depend.txt --- var/build/depend.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/var/build/depend.txt b/var/build/depend.txt index feea45cc64..ad5275d2c4 100644 --- a/var/build/depend.txt +++ b/var/build/depend.txt @@ -132,7 +132,7 @@ da_module_couple_uv_ad.o : da_module_couple_uv_ad.f90 da_couple_ad.inc da_calc_m da_mtgirs.o : da_mtgirs.f90 da_calculate_grady_mtgirs.inc da_get_innov_vector_mtgirs.inc da_check_max_iv_mtgirs.inc da_transform_xtoy_mtgirs_adj.inc da_transform_xtoy_mtgirs.inc da_print_stats_mtgirs.inc da_oi_stats_mtgirs.inc da_residual_mtgirs.inc da_jo_mtgirs_uvtq.inc da_jo_and_grady_mtgirs.inc da_ao_stats_mtgirs.inc da_tracing.o da_physics.o da_grid_definitions.o da_par_util1.o da_par_util.o da_tools.o da_statistics.o da_interpolation.o module_domain.o da_define_structures.o da_control.o da_netcdf_interface.o : da_netcdf_interface.f90 da_atotime.inc da_get_bdytimestr_cdf.inc da_get_bdyfrq.inc da_put_att_cdf.inc da_get_att_cdf.inc da_put_var_2d_int_cdf.inc da_get_var_2d_int_cdf.inc da_put_var_2d_real_cdf.inc da_put_var_3d_real_cdf.inc da_get_var_2d_real_cdf.inc da_get_var_3d_real_cdf.inc da_get_gl_att_real_cdf.inc da_get_gl_att_int_cdf.inc da_get_dims_cdf.inc da_get_times_cdf.inc da_get_var_1d_real_cdf.inc da_obs.o : da_obs.f90 da_grid_definitions.o da_set_obs_missing.inc da_obs_sensitivity.inc da_count_filtered_obs.inc da_store_obs_grid_info_rad.inc da_store_obs_grid_info.inc da_random_omb_all.inc da_fill_obs_structures.inc da_fill_obs_structures_rain.inc da_fill_obs_structures_radar.inc da_check_missing.inc da_add_noise_to_ob.inc da_transform_xtoy_adj.inc da_transform_xtoy.inc da_obs_proc_station.inc module_dm.o da_tracing.o da_tools.o da_tools_serial.o da_synop.o da_ssmi.o da_tamdar.o da_mtgirs.o da_sound.o da_ships.o da_satem.o da_rttov.o da_reporting.o da_rain.o da_radar.o da_qscat.o da_pseudo.o da_profiler.o da_polaramv.o da_pilot.o da_physics.o da_metar.o da_gpsref.o da_gpspw.o da_geoamv.o da_crtm.o da_control.o da_buoy.o da_bogus.o da_airsr.o da_airep.o module_domain.o da_define_structures.o da_gpseph.o -da_obs_io.o : da_obs_io.f90 da_grid_definitions.o da_final_write_modified_filtered_obs.inc da_final_write_filtered_obs.inc da_write_noise_to_ob.inc da_read_omb_tmp.inc da_read_rand_unit.inc da_read_y_unit.inc da_final_write_y.inc da_final_write_obs.inc da_read_obs_bufrgpsro.inc da_read_obs_bufr.inc da_write_y.inc da_write_modified_filtered_obs.inc da_write_filtered_obs.inc da_write_obs_etkf.inc da_search_obs.inc da_read_iv_for_multi_inc.inc da_write_iv_for_multi_inc.inc da_write_obs.inc da_use_obs_errfac.inc da_read_errfac.inc da_read_obs_rain.inc da_scan_obs_rain.inc da_scan_obs_radar.inc da_read_obs_radar.inc da_scan_obs_ascii.inc da_read_obs_ascii.inc da_par_util.o gsi_thinning.o module_radiance.o da_tracing.o da_tools_serial.o da_tools.o da_reporting.o da_physics.o da_par_util1.o da_obs.o da_grid_definitions.o da_define_structures.o da_control.o module_domain.o da_read_lsac_util.inc da_read_obs_lsac.inc da_scan_obs_lsac.inc da_netcdf_interface.o da_gpseph.o da_read_obs_bufrgpsro_eph.inc da_write_iv_for_multi_inc_opt2.inc da_read_iv_for_multi_inc_opt2.inc +da_obs_io.o : da_obs_io.f90 da_grid_definitions.o da_final_write_modified_filtered_obs.inc da_final_write_filtered_obs.inc da_write_noise_to_ob.inc da_read_omb_tmp.inc da_read_rand_unit.inc da_read_y_unit.inc da_final_write_y.inc da_final_write_obs.inc da_read_obs_bufrgpsro.inc da_read_obs_bufr.inc da_write_y.inc da_write_modified_filtered_obs.inc da_write_filtered_obs.inc da_write_obs_etkf.inc da_search_obs.inc da_read_iv_for_multi_inc.inc da_write_iv_for_multi_inc.inc da_write_obs.inc da_use_obs_errfac.inc da_read_errfac.inc da_read_obs_rain.inc da_scan_obs_rain.inc da_scan_obs_radar.inc da_read_obs_radar.inc da_scan_obs_ascii.inc da_read_obs_ascii.inc da_par_util.o gsi_thinning.o module_radiance.o da_tracing.o da_tools_serial.o da_tools.o da_reporting.o da_physics.o da_par_util1.o da_obs.o da_grid_definitions.o da_define_structures.o da_control.o module_domain.o da_read_lsac_util.inc da_read_obs_lsac.inc da_scan_obs_lsac.inc da_netcdf_interface.o da_gpseph.o da_read_obs_bufrgpsro_eph.inc da_par_util.o : da_par_util.f90 da_proc_maxmin_combine.inc da_proc_stats_combine.inc da_system.inc da_y_facade_to_global.inc da_generic_boilerplate.inc da_deallocate_global_synop.inc da_deallocate_global_sound.inc da_deallocate_global_sonde_sfc.inc da_generic_methods.inc da_patch_to_global_3d.inc da_patch_to_global_dual_res.inc da_patch_to_global_2d.inc da_cv_to_global.inc da_transpose_y2x_v2.inc da_transpose_x2y_v2.inc da_transpose_z2y.inc da_transpose_y2z.inc da_transpose_x2z.inc da_transpose_z2x.inc da_transpose_y2x.inc da_transpose_x2y.inc da_unpack_count_obs.inc da_pack_count_obs.inc da_copy_tile_dims.inc da_copy_dims.inc da_alloc_and_copy_be_arrays.inc da_vv_to_cv.inc da_cv_to_vv.inc da_generic_typedefs.inc da_wrf_interfaces.o da_tracing.o da_reporting.o da_define_structures.o da_par_util1.o module_dm.o module_domain.o da_control.o da_par_util1.o : da_par_util1.f90 da_proc_sum_real.inc da_proc_sum_ints.inc da_proc_sum_int.inc da_control.o da_physics.o : da_physics.f90 da_uv_to_sd_lin.inc da_uv_to_sd_adj.inc da_integrat_dz.inc da_wdt.inc da_filter_adj.inc da_filter.inc da_evapo_lin.inc da_condens_lin.inc da_condens_adj.inc da_moist_phys_lin.inc da_moist_phys_adj.inc da_sfc_pre_adj.inc da_sfc_pre_lin.inc da_sfc_pre.inc da_transform_xtowtq_adj.inc da_transform_xtowtq.inc da_transform_xtopsfc_adj.inc da_transform_xtopsfc.inc da_sfc_wtq_adj.inc da_sfc_wtq_lin.inc da_sfc_wtq.inc da_julian_day.inc da_roughness_from_lanu.inc da_get_q_error.inc da_check_rh_simple.inc da_check_rh.inc da_transform_xtogpsref_lin.inc da_transform_xtogpsref_adj.inc da_transform_xtogpsref.inc da_transform_xtotpw_adj.inc da_transform_xtotpw.inc da_transform_xtoztd_adj.inc da_transform_xtoztd_lin.inc da_transform_xtoztd.inc da_tv_profile_tl.inc da_thickness_tl.inc da_find_layer_adj.inc da_thickness.inc da_tv_profile_adj.inc da_find_layer.inc da_thickness_adj.inc da_find_layer_tl.inc da_tv_profile.inc da_tpq_to_slp_adj.inc da_tpq_to_slp_lin.inc da_wrf_tpq_2_slp.inc da_tpq_to_slp.inc da_trh_to_td.inc da_tp_to_qs_lin1.inc da_tp_to_qs_lin.inc da_tp_to_qs_adj1.inc da_tp_to_qs_adj.inc da_tp_to_qs1.inc da_tp_to_qs.inc da_tprh_to_q_lin1.inc da_tprh_to_q_lin.inc da_tprh_to_q_adj1.inc da_tprh_to_q_adj.inc da_tpq_to_rh_lin1.inc da_tpq_to_rh_lin.inc da_tpq_to_rh.inc da_pt_to_rho_lin.inc da_pt_to_rho_adj.inc da_uvprho_to_w_adj.inc da_uvprho_to_w_lin.inc da_prho_to_t_lin.inc da_prho_to_t_adj.inc da_wrf_interfaces.o da_reporting.o da_dynamics.o da_interpolation.o da_tracing.o da_par_util.o da_define_structures.o da_control.o module_comm_dm.o module_dm.o module_domain.o da_grid_definitions.o da_gpseph.o From f5e7f4df234f402806f9a3e9157350f195bbc86a Mon Sep 17 00:00:00 2001 From: liujake Date: Mon, 7 Dec 2020 20:15:04 -0700 Subject: [PATCH 87/91] modified: var/da/da_minimisation/da_get_innov_vector.inc --- var/da/da_minimisation/da_get_innov_vector.inc | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/var/da/da_minimisation/da_get_innov_vector.inc b/var/da/da_minimisation/da_get_innov_vector.inc index e61b058196..490167203d 100644 --- a/var/da/da_minimisation/da_get_innov_vector.inc +++ b/var/da/da_minimisation/da_get_innov_vector.inc @@ -172,10 +172,15 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) !---------------------------------------------- ! [5] write out iv in ascii format !----------------------------------------------- + if ( multi_inc == 1 ) then - call da_write_iv_for_multi_inc(n, iv) + + call da_write_iv_for_multi_inc(n, iv) + elseif ( multi_inc == 2 ) then - call da_read_iv_for_multi_inc(n, iv) + + call da_read_iv_for_multi_inc(n, iv) + endif if (n > 1 .and. var4d) call domain_clockadvance (grid) From 01cfe8adbde9ba9fbdfb68611f7865239727e5c5 Mon Sep 17 00:00:00 2001 From: liujake Date: Mon, 7 Dec 2020 20:37:28 -0700 Subject: [PATCH 88/91] Revert changes. modified: var/da/da_radiance/da_write_filtered_rad.inc modified: var/da/da_radiance/da_write_iv_rad_ascii.inc modified: var/da/da_radiance/da_write_oa_rad_ascii.inc modified: var/da/da_setup_structures/da_setup_structures.f90 modified: var/da/da_tools/da_get_time_slots.inc --- var/da/da_radiance/da_write_filtered_rad.inc | 22 ++----------- var/da/da_radiance/da_write_iv_rad_ascii.inc | 32 +++++-------------- var/da/da_radiance/da_write_oa_rad_ascii.inc | 16 ++-------- .../da_setup_structures.f90 | 2 +- var/da/da_tools/da_get_time_slots.inc | 3 +- 5 files changed, 16 insertions(+), 59 deletions(-) diff --git a/var/da/da_radiance/da_write_filtered_rad.inc b/var/da/da_radiance/da_write_filtered_rad.inc index 04b3f84694..fc8eceb164 100644 --- a/var/da/da_radiance/da_write_filtered_rad.inc +++ b/var/da/da_radiance/da_write_filtered_rad.inc @@ -12,7 +12,7 @@ subroutine da_write_filtered_rad(ob, iv) type (iv_type), intent(in) :: iv ! O-B structure. integer :: n ! Loop counter. - integer :: i,m,m1,m2 ! Index dimension. + integer :: i ! Index dimension. integer :: ios, filtered_rad_unit character(len=50) :: filename @@ -22,19 +22,6 @@ subroutine da_write_filtered_rad(ob, iv) do i = 1, iv%num_inst if (iv%instid(i)%num_rad < 1) cycle - do m=num_fgat_time,1,-1 - iv%instid(i)%info%n1 = iv%instid(i)%info%plocal(m-1) + 1 - iv%instid(i)%info%n2=iv%instid(i)%info%plocal(m) - - if (num_fgat_time >1) then -#ifdef DM_PARALLEL - write(unit=filename, fmt='(a,i2.2,a,i4.4)') & - 'filtered_'//trim(iv%instid(i)%rttovid_string)//'_',m,'.', myproc -#else - write(unit=filename, fmt='(a,i2.2)') & - 'filtered_'//trim(iv%instid(i)%rttovid_string)//'_',m -#endif - else #ifdef DM_PARALLEL write(unit=filename, fmt='(a,i4.4)') & 'filtered_'//trim(iv%instid(i)%rttovid_string)//'.', myproc @@ -42,7 +29,6 @@ subroutine da_write_filtered_rad(ob, iv) write(unit=filename, fmt='(a)') & 'filtered_'//trim(iv%instid(i)%rttovid_string) #endif - end if call da_get_unit(filtered_rad_unit) open(unit=filtered_rad_unit,file=trim(filename), & @@ -52,10 +38,9 @@ subroutine da_write_filtered_rad(ob, iv) (/"Cannot open filtered radiance file"//filename/)) Endif - write(unit=filtered_rad_unit) iv%instid(i)%info%n1-iv%instid(i)%info%n2 + write(unit=filtered_rad_unit) iv%instid(i)%num_rad -! do n =1,iv%instid(i)%num_rad - do n=iv%instid(i)%info%n1,iv%instid(i)%info%n2 + do n =1,iv%instid(i)%num_rad write(unit=filtered_rad_unit) n, & iv%instid(i)%info%date_char(n), & iv%instid(i)%scanpos(n) , & @@ -73,7 +58,6 @@ subroutine da_write_filtered_rad(ob, iv) end do ! end do pixels close(unit=filtered_rad_unit) call da_free_unit(filtered_rad_unit) - end do ! enddo wuyl n1,n2 end do !! end do instruments if (trace_use) call da_trace_exit("da_write_filtered_rad") diff --git a/var/da/da_radiance/da_write_iv_rad_ascii.inc b/var/da/da_radiance/da_write_iv_rad_ascii.inc index dd2865224a..6e8a6acfeb 100644 --- a/var/da/da_radiance/da_write_iv_rad_ascii.inc +++ b/var/da/da_radiance/da_write_iv_rad_ascii.inc @@ -11,7 +11,7 @@ subroutine da_write_iv_rad_ascii (it, ob, iv ) type (iv_type), intent(in) :: iv ! O-B structure. integer :: n ! Loop counter. - integer :: i, k, l, m, m1, m2 ! Index dimension. + integer :: i, k, l ! Index dimension. integer :: nlevelss ! Number of obs levels. integer :: ios, innov_rad_unit @@ -32,16 +32,11 @@ subroutine da_write_iv_rad_ascii (it, ob, iv ) ! count number of obs within the loc%proc_domain ! --------------------------------------------- - do m=num_fgat_time,1,-1 - iv%instid(i)%info%n1 = iv%instid(i)%info%plocal(m-1) + 1 - iv%instid(i)%info%n2=iv%instid(i)%info%plocal(m) ndomain = 0 -! do n =1,iv%instid(i)%num_rad - do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 - - if (iv%instid(i)%info%proc_domain(1,n)) then + do n =1,iv%instid(i)%num_rad + if (iv%instid(i)%info%proc_domain(1,n)) then ndomain = ndomain + 1 - end if + end if end do if (ndomain < 1) cycle @@ -54,18 +49,9 @@ subroutine da_write_iv_rad_ascii (it, ob, iv ) end if amsr2 = index(iv%instid(i)%rttovid_string,'amsr2') > 0 -!wuyl -! do m=num_fgat_time,1,-1 -! iv%time=m -! iv%instid(i)%info%n1 = iv%instid(i)%info%plocal(m-1) + 1 -! iv%instid(i)%info%n2=iv%instid(i)%info%plocal(m) - - if (num_fgat_time >1) then - - write(unit=filename, fmt='(i2.2,a,i2.2,a,i4.4)') it,'_inv_'//trim(iv%instid(i)%rttovid_string)//'_',m,'.', myproc - else + write(unit=filename, fmt='(i2.2,a,i4.4)') it,'_inv_'//trim(iv%instid(i)%rttovid_string)//'.', myproc - end if + call da_get_unit(innov_rad_unit) open(unit=innov_rad_unit,file=trim(filename),form='formatted',iostat=ios) if (ios /= 0 ) then @@ -85,8 +71,7 @@ subroutine da_write_iv_rad_ascii (it, ob, iv ) write(unit=innov_rad_unit,fmt='(a)') ' grid%xb-surf-info : i t2m mr2m(ppmv) u10 v10 ps ts smois tslb snowh isflg & & soiltyp vegtyp vegfra elev clwp cloud_frac' ndomain = 0 -!wuyl do n =1,iv%instid(i)%num_rad - do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 + do n =1,iv%instid(i)%num_rad if (iv%instid(i)%info%proc_domain(1,n)) then ndomain=ndomain+1 if ( amsr2 ) then ! write out clw @@ -330,8 +315,7 @@ subroutine da_write_iv_rad_ascii (it, ob, iv ) end if close(unit=innov_rad_unit) call da_free_unit(innov_rad_unit) - end do ! n1,n2 wuyl -end do ! end do instruments + end do ! end do instruments if (trace_use) call da_trace_exit("da_write_iv_rad_ascii") diff --git a/var/da/da_radiance/da_write_oa_rad_ascii.inc b/var/da/da_radiance/da_write_oa_rad_ascii.inc index 50b9e0d8bd..2f058839df 100644 --- a/var/da/da_radiance/da_write_oa_rad_ascii.inc +++ b/var/da/da_radiance/da_write_oa_rad_ascii.inc @@ -12,7 +12,7 @@ subroutine da_write_oa_rad_ascii (it, ob, iv, re ) type (y_type), intent(in) :: re ! O-A structure. integer :: n ! Loop counter. - integer :: i, k, m, m1, m2 ! Index dimension. + integer :: i, k ! Index dimension. integer :: nlevelss ! Number of obs levels. integer :: ios, oma_rad_unit @@ -31,12 +31,8 @@ subroutine da_write_oa_rad_ascii (it, ob, iv, re ) ! count number of obs within the proc_domain !--------------------------------------------- - do m=num_fgat_time,1,-1 - iv%instid(i)%info%n1 = iv%instid(i)%info%plocal(m-1) + 1 - iv%instid(i)%info%n2=iv%instid(i)%info%plocal(m) ndomain = 0 - ! do n =1,iv%instid(i)%num_rad - do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 + do n =1,iv%instid(i)%num_rad if (iv%instid(i)%info%proc_domain(1,n)) then ndomain = ndomain + 1 end if @@ -45,11 +41,7 @@ subroutine da_write_oa_rad_ascii (it, ob, iv, re ) amsr2 = index(iv%instid(i)%rttovid_string,'amsr2') > 0 - if (num_fgat_time >1) then - write(unit=filename, fmt='(i2.2,a,i2.2,a,i4.4)') it,'_oma_'//trim(iv%instid(i)%rttovid_string)//'_',m,'.', myproc - else write(unit=filename, fmt='(i2.2,a,i4.4)') it,'_oma_'//trim(iv%instid(i)%rttovid_string)//'.', myproc - end if call da_get_unit(oma_rad_unit) open(unit=oma_rad_unit,file=trim(filename),form='formatted',iostat=ios) @@ -70,8 +62,7 @@ subroutine da_write_oa_rad_ascii (it, ob, iv, re ) write(unit=oma_rad_unit,fmt='(a)') ' xb-surf-info : i t2m mr2m(ppmv) u10 v10 ps ts smois tslb snowh isflg & & soiltyp vegtyp vegfra elev clwp' ndomain = 0 -! do n=1,iv%instid(i)%num_rad - do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 + do n=1,iv%instid(i)%num_rad if (iv%instid(i)%info%proc_domain(1,n)) then ndomain=ndomain+1 if ( amsr2 ) then !write out clw @@ -228,7 +219,6 @@ subroutine da_write_oa_rad_ascii (it, ob, iv, re ) end do ! end do pixels close(unit=oma_rad_unit) call da_free_unit(oma_rad_unit) - end do ! n1,n2 wuyl end do !! end do instruments if (trace_use) call da_trace_exit("da_write_oa_rad_ascii") diff --git a/var/da/da_setup_structures/da_setup_structures.f90 b/var/da/da_setup_structures/da_setup_structures.f90 index adfbcf2849..3d68bb7393 100644 --- a/var/da/da_setup_structures/da_setup_structures.f90 +++ b/var/da/da_setup_structures/da_setup_structures.f90 @@ -65,7 +65,7 @@ module da_setup_structures fmt_info, fmt_srfc, fmt_each, unit_end, max_ext_its, & psi_chi_factor, psi_t_factor, psi_ps_factor, psi_rh_factor, & chi_u_t_factor, chi_u_ps_factor,chi_u_rh_factor, t_u_rh_factor, ps_u_rh_factor, & - interpolate_stats, be_eta, thin_rainobs, fgat_rain_flags, use_iasiobs, use_ahiobs, & + interpolate_stats, be_eta, thin_rainobs, fgat_rain_flags, use_iasiobs, & use_seviriobs, jds_int, jde_int, anal_type_hybrid_dual_res, use_amsr2obs, nrange, use_4denvar, & use_goesimgobs, use_ahiobs use da_control, only: rden_bin, use_lsac diff --git a/var/da/da_tools/da_get_time_slots.inc b/var/da/da_tools/da_get_time_slots.inc index e9720ab503..0dc9cd1378 100644 --- a/var/da/da_tools/da_get_time_slots.inc +++ b/var/da/da_tools/da_get_time_slots.inc @@ -43,8 +43,7 @@ subroutine da_get_time_slots(nt,tmin,tana,tmax,time_slots,itime_ana) if (nt > 1) then dt = (time_slots(nt)-time_slots(0))/float(nt-1) time_slots(1) = time_slots(0)+dt*0.5 -! do it=2,nt-1 - do it=2,nt !wuyl + do it=2,nt-1 time_slots(it) = time_slots(it-1)+dt end do end if From ac6cfdbfe63710bc486cf670491c3b99135878fb Mon Sep 17 00:00:00 2001 From: liujake Date: Wed, 9 Dec 2020 23:26:38 -0700 Subject: [PATCH 89/91] modified: var/da/da_minimisation/da_minimisation.f90 --- var/da/da_minimisation/da_minimisation.f90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/var/da/da_minimisation/da_minimisation.f90 b/var/da/da_minimisation/da_minimisation.f90 index 854c385642..55d89a14c4 100644 --- a/var/da/da_minimisation/da_minimisation.f90 +++ b/var/da/da_minimisation/da_minimisation.f90 @@ -80,8 +80,7 @@ module da_minimisation da_jo_and_grady_gpseph use da_obs_io, only : da_final_write_y, da_write_y, da_final_write_obs, & da_write_obs,da_write_obs_etkf,da_write_noise_to_ob, da_use_obs_errfac, & - da_write_iv_for_multi_inc, da_read_iv_for_multi_inc, & - da_write_iv_for_multi_inc_opt2, da_read_iv_for_multi_inc_opt2 + da_write_iv_for_multi_inc, da_read_iv_for_multi_inc use da_metar, only : da_calculate_grady_metar, da_ao_stats_metar, & da_oi_stats_metar, da_get_innov_vector_metar, da_residual_metar, & da_jo_and_grady_metar From 1aa4a199c2bfeb73efab417137bfe028da2ef46d Mon Sep 17 00:00:00 2001 From: liujake Date: Thu, 10 Dec 2020 17:10:36 -0700 Subject: [PATCH 90/91] Enable serial compilation modified: var/da/da_radiance/da_radiance1.f90 modified: var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc modified: var/da/da_radiance/da_write_iv_rad_for_multi_inc.inc --- var/da/da_radiance/da_radiance1.f90 | 9 ++- .../da_read_iv_rad_for_multi_inc.inc | 65 ++++++++----------- .../da_write_iv_rad_for_multi_inc.inc | 65 ++++++++----------- 3 files changed, 59 insertions(+), 80 deletions(-) diff --git a/var/da/da_radiance/da_radiance1.f90 b/var/da/da_radiance/da_radiance1.f90 index 0e8393d65b..e7ae1d0a22 100644 --- a/var/da/da_radiance/da_radiance1.f90 +++ b/var/da/da_radiance/da_radiance1.f90 @@ -13,7 +13,7 @@ module da_radiance1 use module_radiance, only : coefs #endif - use da_control, only : trace_use,missing_r, rootproc, ierr,comm,root,& + use da_control, only : trace_use,missing_r, rootproc, & stdout,myproc,qc_good,num_fgat_time,qc_bad, & use_error_factor_rad,biasprep_unit,obs_qc_pointer, filename_len, & print_detail_rad, rtm_option, trace_use_dull, & @@ -28,7 +28,7 @@ module da_radiance1 be_type, clddet_geoir_type, superob_type use module_dm, only : wrf_dm_sum_real, wrf_dm_sum_integer use da_par_util, only : da_proc_stats_combine - use da_par_util1, only : da_proc_sum_int,da_proc_sum_ints,true_mpi_real,mpi_sum,mpi_integer + use da_par_util1, only : da_proc_sum_int,da_proc_sum_ints use da_reporting, only : da_error, message use da_statistics, only : da_stats_calculate use da_tools, only : da_residual_new, da_eof_decomposition @@ -42,6 +42,11 @@ module da_radiance1 use da_tracing, only : da_trace #endif +#ifdef DM_PARALLEL + use da_control, only : ierr,comm,root + use da_par_util1, only : true_mpi_real, mpi_sum,mpi_integer +#endif + implicit none type datalink_type diff --git a/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc b/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc index b0563dfe3a..90d9b2067f 100644 --- a/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc +++ b/var/da/da_radiance/da_read_iv_rad_for_multi_inc.inc @@ -11,61 +11,56 @@ subroutine da_read_iv_rad_for_multi_inc (it, ob, iv ) type (iv_type), intent(inout) :: iv ! O-B structure. integer :: n ! Loop counter. - integer :: i, k, l, m, m1, m2,my,nobs_tot,nobs_in,iobs ! Index dimension. - integer :: nlevelss ! Number of obs levels. + integer :: i, k, l, m, my,nobs_tot,nobs_in,iobs ! Index dimension. integer :: ios, innov_rad_unit_in character(len=filename_len) :: filename - character(len=7) :: surftype integer :: ndomain logical :: amsr2,fexist real, allocatable :: data2d(:,:) real, allocatable :: data3d(:,:,:) real, allocatable :: data2d_g(:,:) real, allocatable :: data3d_g(:,:,:) - integer, allocatable :: counts(:), displs(:) - integer :: nk,ndomain_local,num,ndomain_sum,proc + integer :: ndomain_local,ndomain_sum integer, allocatable :: ndomain_global(:) real, allocatable :: lat(:),lon(:) if (trace_use) call da_trace_entry("da_read_iv_rad_for_multi_inc") - write(unit=message(1),fmt='(A)') 'Reading radiance OMB for multi_inc' + write(unit=message(1),fmt='(A)') 'Reading binary radiance OMB for MRI-4DVar' call da_message(message(1:1)) !no thinning for coarse res.(setup in namelist), keep all the obs: do i = 1, iv%num_inst amsr2 = index(iv%instid(i)%rttovid_string,'amsr2') > 0 !jban 2020-08-22 - !print*, "amsr2=",amsr2 nobs_tot = iv%info(radiance)%ptotal(num_fgat_time) - iv%info(radiance)%ptotal(0) - !print*, "nobs_tot=",nobs_tot - !print*, "iv%instid(i)%num_rad=",iv%instid(i)%num_rad - !print*, "iv%instid(i)%info%plocal=", iv%instid(i)%info%plocal(0:num_fgat_time) - !print*, "iv%instid(i)%info%ptotal=", iv%instid(i)%info%ptotal(0:num_fgat_time) - !print*, "iv%info(radiance)%plocal=", iv%info(radiance)%plocal(0:num_fgat_time) - !print*, "iv%info(radiance)%ptotal=", iv%info(radiance)%ptotal(0:num_fgat_time) do m=num_fgat_time,1,-1 iv%instid(i)%info%n1 = iv%instid(i)%info%plocal(m-1) + 1 - iv%instid(i)%info%n2=iv%instid(i)%info%plocal(m) + iv%instid(i)%info%n2 = iv%instid(i)%info%plocal(m) ndomain_local = 0 -!print*, "before read: timeslot,n1,n2=",m,iv%instid(i)%info%n1,iv%instid(i)%info%n2 do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 if (iv%instid(i)%info%proc_domain(1,n)) then ndomain_local = ndomain_local + 1 iv%instid(i)%tb_qc(:,n) = -1 -!write(unit=stdout,fmt='(a,3i8,3(2x,f10.5))') 'bcheckforplot ',m,iv%instid(i)%tb_qc(6,n),n,iv%instid(i)%info%lat(1,n),iv%instid(i)%info%lon(1,n),iv%instid(i)%tb_inv(6,n) end if end do +#ifdef DM_PARALLEL + ! gather each tile's number of obs at one time slot into a global array + ! and distribute combined 'ndomain_global' to all processors allocate (ndomain_global(0:num_procs-1)) call mpi_allgather( ndomain_local, 1, mpi_integer, & ndomain_global, 1, mpi_integer, comm, ierr ) - ndomain_sum = sum(ndomain_global) -!print*,"ndomain_global=",ndomain_global + ndomain_sum = sum(ndomain_global) ! nobs over the entire domain in a time slot +#else + allocate (ndomain_global(1)) + ndomain_global = ndomain_local + ndomain_sum = sum(ndomain_global) +#endif if ( ndomain_sum > 0 ) then write(unit=filename, fmt='(a,i3.3)') 'inv_'//trim(iv%instid(i)%rttovid_string)//'_',m @@ -82,13 +77,6 @@ subroutine da_read_iv_rad_for_multi_inc (it, ob, iv ) write(unit=message(1),fmt='(A)') filename call da_message(message(1:1)) read(innov_rad_unit_in) nobs_in - !print*, "nobs_in=",nobs_in - !print*, "ndomain_sum=",ndomain_sum - !always does not match, so comment it out - !if ( nobs_in /= ndomain_sum ) then - ! call da_error(__FILE__,__LINE__, & - ! (/"Dimensions (nobs_tot) mismatch "/)) - !end if ndomain = 0 @@ -103,20 +91,19 @@ subroutine da_read_iv_rad_for_multi_inc (it, ob, iv ) allocate( data3d(nobs_in, iv%instid(i)%nchan, 3) ) read(innov_rad_unit_in) data3d - !print*,'iv%instid(i)%nchan=',iv%instid(i)%nchan - do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 - if (iv%instid(i)%info%proc_domain(1,n)) then - do iobs = 1, nobs_in - if (iv%instid(i)%info%lat(1,n)==data2d(iobs, 1) .and. iv%instid(i)%info%lon(1,n)==data2d(iobs, 2)) then -!write(unit=stdout,fmt='(a,4i8,4(2x,f10.5))') 'acheckforplot ',m,iv%instid(i)%tb_qc(6,n),n,iobs,iv%instid(i)%info%lat(1,n),iv%instid(i)%info%lon(1,n),iv%instid(i)%tb_inv(6,n),data3d (iobs,6,1) - iv%instid(i)%tb_inv(:,n) = data3d (iobs,:,1) - iv%instid(i)%tb_error(:,n) = data3d (iobs,:,2) - iv%instid(i)%tb_qc(:,n) = int(data3d (iobs,:,3)) - !print*, "matchiobs=",m,iobs - end if - end do !if - end if !do - end do + + do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 + if (iv%instid(i)%info%proc_domain(1,n)) then + do iobs = 1, nobs_in + if (iv%instid(i)%info%lat(1,n)==data2d(iobs, 1) .and. & + iv%instid(i)%info%lon(1,n)==data2d(iobs, 2)) then + iv%instid(i)%tb_inv(:,n) = data3d (iobs,:,1) + iv%instid(i)%tb_error(:,n) = data3d (iobs,:,2) + iv%instid(i)%tb_qc(:,n) = int(data3d (iobs,:,3)) + end if + end do !if + end if !do + end do deallocate(data2d) deallocate(data3d) diff --git a/var/da/da_radiance/da_write_iv_rad_for_multi_inc.inc b/var/da/da_radiance/da_write_iv_rad_for_multi_inc.inc index e4c4c758b3..eb25f471b5 100644 --- a/var/da/da_radiance/da_write_iv_rad_for_multi_inc.inc +++ b/var/da/da_radiance/da_write_iv_rad_for_multi_inc.inc @@ -10,30 +10,20 @@ subroutine da_write_iv_rad_for_multi_inc (it,ob, iv ) type (y_type), intent(in) :: ob ! Observation structure. type (iv_type), intent(in) :: iv ! O-B structure. - integer :: n ! Loop counter. - integer :: i, loc_i,loc_j, k, l, m, m1, m2,nobs_tot ! Index dimension. - integer :: nlevelss ! Number of obs levels. - integer :: my,iobs, nobs_tot_all_sum + integer :: n ! Loop counter. + integer :: i, k, l, m ! Index dimension. + integer :: my,iobs integer :: ios, innov_rad_unit character(len=filename_len) :: filename - character(len=7) :: surftype - integer :: nk,ndomain_local,num,ndomain_sum,proc + integer :: ndomain_local,ndomain_sum logical :: amsr2 real, allocatable :: data2d(:,:) real, allocatable :: data3d(:,:,:) real, allocatable :: data2d_g(:,:) real, allocatable :: data3d_g(:,:,:) - real, allocatable :: tbinv_local(:),tbinv_global(:),stbinv_local(:) - real, allocatable :: tberror_local(:),tberror_global(:) - real, allocatable :: tbqc_local(:),tbqc_global(:) - - integer, allocatable :: nobs_tot_all(:) integer, allocatable :: ndomain_global(:) - integer, allocatable :: i_global(:),i_local(:) - integer, allocatable :: j_global(:),j_local(:) - integer, allocatable :: counts(:), displs(:) - integer, allocatable :: obs_index(:,:) + if (trace_use) call da_trace_entry("da_write_iv_rad_for_multi_inc") write(unit=message(1),fmt='(A)') 'Writing radiance OMB binary files for multi_inc' @@ -41,23 +31,17 @@ subroutine da_write_iv_rad_for_multi_inc (it,ob, iv ) do i = 1, iv%num_inst - amsr2 = index(iv%instid(i)%rttovid_string,'amsr2') > 0 !jban 2020-08-22 + amsr2 = index(iv%instid(i)%rttovid_string,'amsr2') > 0 if ( amsr2 ) then ! write out clw my=3 else my=2 end if - !print*, "iv%instid(i)%num_rad=",iv%instid(i)%num_rad - !print*, "iv%instid(i)%info%plocal=", iv%instid(i)%info%plocal(0:num_fgat_time) - !print*, "iv%instid(i)%info%ptotal=", iv%instid(i)%info%ptotal(0:num_fgat_time) - !print*, "iv%info(radiance)%plocal=", iv%info(radiance)%plocal(0:num_fgat_time) - !print*, "iv%info(radiance)%ptotal=", iv%info(radiance)%ptotal(0:num_fgat_time) - do m=num_fgat_time,1,-1 iv%instid(i)%info%n1 = iv%instid(i)%info%plocal(m-1) + 1 - iv%instid(i)%info%n2=iv%instid(i)%info%plocal(m) + iv%instid(i)%info%n2 = iv%instid(i)%info%plocal(m) ndomain_local = 0 do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 if (iv%instid(i)%info%proc_domain(1,n)) then @@ -65,23 +49,25 @@ subroutine da_write_iv_rad_for_multi_inc (it,ob, iv ) end if end do +#ifdef DM_PARALLEL + ! gather each tile's number of obs at one time slot into a global array + ! and distribute combined 'ndomain_global' to all processors allocate (ndomain_global(0:num_procs-1)) call mpi_allgather( ndomain_local, 1, mpi_integer, & ndomain_global, 1, mpi_integer, comm, ierr ) - ndomain_sum = sum(ndomain_global) - !print *,"ndomain_local=", ndomain_local - !print *,"ndomain_global=",ndomain_global - !print *,"ndomain_sum=",ndomain_sum + ndomain_sum = sum(ndomain_global) ! nobs over the entire domain in a time slot +#else + allocate (ndomain_global(1)) + ndomain_global = ndomain_local + ndomain_sum = sum(ndomain_global) +#endif if ( ndomain_sum > 0 ) then - write(unit=message(1),fmt='(A)') 'begin to write' + write(unit=message(1),fmt='(A)') 'Begin to write binary radiance omb file for MRI-4DVar' call da_message(message(1:1)) if (rootproc) then - call da_get_unit(innov_rad_unit) !jban 2020-08-22 - !write(unit=message(1),fmt='(A)') 'rootproc, writing file name' - !call da_message(message(1:1)) - print*, "print rootproc, writing file name" + call da_get_unit(innov_rad_unit) ! one file per time slot write(unit=filename, fmt='(a,i3.3)') 'inv_'//trim(iv%instid(i)%rttovid_string)//'_',m open(unit=innov_rad_unit,file=trim(filename),form='unformatted',status='replace',iostat=ios) @@ -89,22 +75,24 @@ subroutine da_write_iv_rad_for_multi_inc (it,ob, iv ) call da_error(__FILE__,__LINE__, & (/"Cannot open innovation radiance file"//filename/)) endif - write(innov_rad_unit) ndomain_sum ! ,iv%instid(i)%nchan !jban 2020-08-22 + write(innov_rad_unit) ndomain_sum end if ! root open ounit - !print*,"check before write timesl,n:" + allocate( data2d(ndomain_sum, my) ) data2d = 0.0 - if (myproc == 0) then + if (myproc == 0) then ! global index of obs at each processor iobs = 0 else iobs = sum (ndomain_global (0:myproc-1)) end if - !print *, "myproc,iobs=",myproc,iobs do n = iv%instid(i)%info%n1,iv%instid(i)%info%n2 if (iv%instid(i)%info%proc_domain(1,n)) then - iobs = iobs+1 + iobs = iobs+1 ! global index + ! fill in global array with each processor's local array + ! note: data2d exists in each processor, initialized with zero + ! so only current processor is filled with non-zero values. if ( amsr2 ) then ! write out clw data2d(iobs, 1) = iv%instid(i)%info%lat(1,n) data2d(iobs, 2) = iv%instid(i)%info%lon(1,n) @@ -112,7 +100,6 @@ subroutine da_write_iv_rad_for_multi_inc (it,ob, iv ) else ! no clw info data2d(iobs, 1) = iv%instid(i)%info%lat(1,n) data2d(iobs, 2) = iv%instid(i)%info%lon(1,n) -!write(unit=stdout,fmt='(a,4i8,3(2x,f10.5))') 'checkforplot ',m,iv%instid(i)%tb_qc(6,n),n,iobs,iv%instid(i)%info%lat(1,n),iv%instid(i)%info%lon(1,n),iv%instid(i)%tb_inv(6,n) end if end if end do !n1,n2 @@ -122,6 +109,7 @@ subroutine da_write_iv_rad_for_multi_inc (it,ob, iv ) allocate( data2d_g(ndomain_sum, my) ) #ifdef DM_PARALLEL + ! sum of data2d from each processor into rootprocessor's data2d_g (other processors' data2d has zeros) call mpi_reduce(data2d, data2d_g, ndomain_sum*my, true_mpi_real, mpi_sum, root, comm, ierr) #else data2d_g = data2d @@ -147,7 +135,6 @@ subroutine da_write_iv_rad_for_multi_inc (it,ob, iv ) data3d(iobs,:, 1)=iv%instid(i)%tb_inv(:,n) data3d(iobs,:, 2)=iv%instid(i)%tb_error(:,n) data3d(iobs,:, 3)=iv%instid(i)%tb_qc(:,n) * 1.0 -!write(unit=stdout,fmt='(a,i8,2x,i8,2x,i8,2x,i8,2x,f10.5,2x,f10.5,2x,f10.5)') 'check3d ',m,n,iobs,iv%instid(i)%tb_qc(6,n),iv%instid(i)%tb_inv(6,n),data3d(iobs,6, 1),iv%instid(i)%info%lat(1,n) end if end do allocate( data3d_g(ndomain_sum, iv%instid(i)%nchan, 3) ) From f97c3a4e3995d2605ca5d0e3c37a419971ee10cc Mon Sep 17 00:00:00 2001 From: liujake Date: Thu, 10 Dec 2020 17:34:43 -0700 Subject: [PATCH 91/91] Change logic of vv/vp initialization when multi_inc=2 modified: var/da/da_main/da_solve.inc --- var/da/da_main/da_solve.inc | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/var/da/da_main/da_solve.inc b/var/da/da_main/da_solve.inc index d8fed61911..f0a74ecd97 100644 --- a/var/da/da_main/da_solve.inc +++ b/var/da/da_main/da_solve.inc @@ -635,8 +635,13 @@ max_ext_its = 0 end if !anal_type_randomcv -! mri-4dvar: if multi_inc == 0: run normal 3D/4D-Var +! mri-4dvar: if multi_inc /= 2: run normal 3D/4D-Var !------------------------------------------------------------------------ + ! cvt is outer loop control variable, it is zero for the first outer loop, + ! but non-zero from the second outer loop in normal 3d/4dvar. + ! for MRI-4DVar, vp from the previous outer loop needs to be read in, + ! then perform the inverse transform to derive cvt + !----------------------------------------------------- call da_initialize_cv (cv_size, cvt) call da_zero_vp_type (grid%vp) call da_zero_vp_type (grid%vv) @@ -748,14 +753,15 @@ else write(unit=message(1),fmt='(a)') "vp files '"//trim(vpfile)//"' does not exists, initiallizing cvt." call da_message(message(1:1)) - call da_initialize_cv (cv_size, cvt) + call da_initialize_cv (cv_size, cvt) ! perhaps better use da_error end if + + call da_zero_vp_type (grid%vv) + call da_zero_vp_type (grid%vp) + end if ! mri-4dvar ------------------------------------------- - call da_zero_vp_type (grid%vv) - call da_zero_vp_type (grid%vp) - if ( var4d ) then #ifdef VAR4D call da_zero_vp_type (grid%vv6)