├── .gitignore ├── LICENSE.md ├── README.md ├── awot ├── __init__.py ├── display │ ├── __init__.py │ └── rtd.py ├── graph │ ├── __init__.py │ ├── common.py │ ├── coord_transform.py │ ├── flight_level.py │ ├── microphysical_vertical.py │ ├── radar_3d.py │ ├── radar_horizontal.py │ ├── radar_sweep.py │ ├── radar_utility.py │ ├── radar_vertical.py │ ├── skew.py │ └── sonde.py ├── io │ ├── __init__.py │ ├── common.py │ ├── flight.py │ ├── name_maps_flight.py │ ├── read_ground_radar.py │ ├── read_hiaper_radar.py │ ├── read_latmos_falcon.py │ ├── read_nasa_hiwrap.py │ ├── read_p3_radar.py │ ├── read_radar_sweep.py │ ├── read_sonde.py │ ├── read_t28.py │ ├── read_uwka_lidar.py │ ├── read_uwka_radar.py │ └── write_radar_netcdf.py ├── src │ ├── interp │ │ ├── .DS_Store │ │ ├── Makefile │ │ ├── dualp_interp.f90 │ │ ├── dualp_interp.prm │ │ ├── fast_interp2.f90 │ │ ├── fast_interp_so_out.f90 │ │ ├── gage_interp.f │ │ ├── gage_interp.prm │ │ ├── gage_interp_iop1.prm │ │ ├── grnd_interp.doc │ │ ├── grnd_interp.f90 │ │ ├── grnd_interp.prm │ │ ├── grnd_interp_KOUN.prm │ │ ├── grnd_interp_KTLX.prm │ │ ├── hybrid_interp.f90 │ │ ├── hybrid_interp.prm │ │ ├── ncg_plot_gage.prm │ │ └── total_rain.dat │ ├── libs │ │ ├── Makefile │ │ ├── libdpj.so │ │ ├── libdpj │ │ │ ├── ASCII32_126.f │ │ │ ├── AzDif.f │ │ │ ├── Az_ConXYZ_LF.f │ │ │ ├── Az_Tilt_conXYZ.f │ │ │ ├── BinAng_Deg.f │ │ │ ├── Casefold.f │ │ │ ├── Change_Time.f │ │ │ ├── Change_TimeI2.f │ │ │ ├── CleanString.f │ │ │ ├── ClipIt.f │ │ │ ├── Convt_Km.f │ │ │ ├── FindPattern.f │ │ │ ├── FindPatternCF.f │ │ │ ├── FirstAnyChar.f │ │ │ ├── FirstChar.f │ │ │ ├── FirstNonAnyChar.f │ │ │ ├── FirstNonChar.f │ │ │ ├── FirstNonNum.f │ │ │ ├── GetToken.f │ │ │ ├── Goodbye.f │ │ │ ├── Ichk.f │ │ │ ├── Iseconds_2diff1.f │ │ │ ├── Iswap.f │ │ │ ├── Jdate2day.f │ │ │ ├── JulDate.f │ │ │ ├── JulDy.f │ │ │ ├── LastChar.f │ │ │ ├── LastNonChar.f │ │ │ ├── LenTrim.f │ │ │ ├── OkTime.f │ │ │ ├── Plt_Coverage.f │ │ │ ├── Plt_Map.f │ │ │ ├── String_len_c.f │ │ │ ├── Swap.f │ │ │ ├── Tilt_LF.f │ │ │ ├── TimeBefore.f │ │ │ ├── TimeOnBefore.f │ │ │ ├── Timz.f │ │ │ ├── Tmcon.f │ │ │ ├── Var_Range.f │ │ │ ├── Var_Range_Fill.f │ │ │ ├── Var_Range_Shift.f │ │ │ ├── abshm.f │ │ │ ├── adj.f │ │ │ ├── ajust.f │ │ │ ├── angle.f │ │ │ ├── atn2.f │ │ │ ├── atten_corr.f90 │ │ │ ├── beam_hgt.f │ │ │ ├── chktm.f │ │ │ ├── clot.f │ │ │ ├── comp.f │ │ │ ├── cradw.f │ │ │ ├── ctanw.f │ │ │ ├── ctme.f │ │ │ ├── density.f │ │ │ ├── detrm.f │ │ │ ├── dewpt.f │ │ │ ├── diret.f │ │ │ ├── dsedp.f │ │ │ ├── dsegy.f │ │ │ ├── enery.f │ │ │ ├── epot3.f │ │ │ ├── epott.f │ │ │ ├── fchar.f90 │ │ │ ├── fchs.f │ │ │ ├── fmixd.f │ │ │ ├── fmixr.f │ │ │ ├── linft.f │ │ │ ├── patop.f │ │ │ ├── pltsg.f │ │ │ ├── polft.f │ │ │ ├── potm.f │ │ │ ├── pott.f │ │ │ ├── potvt.f │ │ │ ├── ptopa.f │ │ │ ├── qsor2.f │ │ │ ├── qsort.f │ │ │ ├── radw.f │ │ │ ├── rhumd.f │ │ │ ├── rhumw.f │ │ │ ├── sept.f │ │ │ ├── sfcp.f │ │ │ ├── smoth.f │ │ │ ├── speed.f │ │ │ ├── sphum.f │ │ │ ├── stmix.f │ │ │ ├── tanw.f │ │ │ ├── tcnvt.f │ │ │ ├── tlcl2.f │ │ │ ├── tvird.f │ │ │ ├── tvirr.f │ │ │ ├── ucomp.f │ │ │ ├── utmsubs.f │ │ │ ├── vapor.f │ │ │ ├── vcomp.f │ │ │ ├── vp.f │ │ │ ├── vt_adj.f │ │ │ ├── wbulb.f │ │ │ ├── wcomp.f │ │ │ ├── wdir.f │ │ │ ├── wlap.f │ │ │ ├── wsedp.f │ │ │ ├── wsemr.f │ │ │ ├── wsesh.f │ │ │ └── xdist.f │ │ ├── libtmg.so │ │ ├── libtmg │ │ │ ├── absmx_3d.f │ │ │ ├── acosde.f │ │ │ ├── adjust_winds_2d.f │ │ │ ├── adjust_winds_to_div_2d.f │ │ │ ├── ainthi.f │ │ │ ├── aintlo.f │ │ │ ├── aintout.f │ │ │ ├── append_float.f │ │ │ ├── append_float_signif.f │ │ │ ├── append_float_signif_trunc.f │ │ │ ├── append_float_trunc.f │ │ │ ├── append_integer.f │ │ │ ├── append_scientific.f │ │ │ ├── append_scientific_ncarg.f │ │ │ ├── append_scientific_trunc.f │ │ │ ├── append_scientific_trunc_ncarg.f │ │ │ ├── append_string.f │ │ │ ├── asinde.f │ │ │ ├── atn3de.f │ │ │ ├── atn4de.f │ │ │ ├── atnde.f │ │ │ ├── bifilt.f │ │ │ ├── c_from_k.f │ │ │ ├── compare_strings.f │ │ │ ├── constant_field_3d.f │ │ │ ├── contained_in_tetrahedron.f │ │ │ ├── contained_in_triangle.f │ │ │ ├── copy_field_3d.f │ │ │ ├── cosdeg.f │ │ │ ├── cubic_spline.f │ │ │ ├── cubic_spline_interp.f │ │ │ ├── d2dt2_3d.f │ │ │ ├── d2dt2_3d_moving.f │ │ │ ├── d2dx2_3d.f │ │ │ ├── d2dy2_3d.f │ │ │ ├── d2dz2_3d.f │ │ │ ├── dbx_to_x.f │ │ │ ├── ddt_3d.f │ │ │ ├── ddt_3d_moving.f │ │ │ ├── ddx_3d.f │ │ │ ├── ddx_filter_2d.f │ │ │ ├── ddy_3d.f │ │ │ ├── ddy_filter_2d.f │ │ │ ├── ddz_3d.f │ │ │ ├── det_scaled_mat.f │ │ │ ├── determinant.f │ │ │ ├── difference_filter_2d.f │ │ │ ├── divergence_filter_2d.f │ │ │ ├── divergence_filter_2d_driver3.f │ │ │ ├── else_3d.f │ │ │ ├── er_2d.f │ │ │ ├── excise_string.f │ │ │ ├── f_from_k.f │ │ │ ├── field_statistics_3d.f │ │ │ ├── filter_2d.f │ │ │ ├── filter_2d_driver3.f │ │ │ ├── filter_weight_calculator.f │ │ │ ├── find_gridbox_1d.f │ │ │ ├── findchar.f │ │ │ ├── five_diagonal_efficient_dp.f │ │ │ ├── flexible_read.f │ │ │ ├── flexible_write.f │ │ │ ├── gauss_elim.f │ │ │ ├── gauss_elim_miss_vars.f │ │ │ ├── gauss_jordan_elim.f │ │ │ ├── gauss_jordan_elim_miss_vars.f │ │ │ ├── gridbox_1d.f │ │ │ ├── hole_fill_1d.f │ │ │ ├── hole_fill_1d_driver12.f │ │ │ ├── hole_fill_1d_one_pass.f │ │ │ ├── hole_fill_2d.f │ │ │ ├── hole_fill_2d_driver3.f │ │ │ ├── hole_fill_2d_one_pass.f │ │ │ ├── hole_fill_extend_1d.f │ │ │ ├── hole_fill_extend_1d_driver12.f │ │ │ ├── hole_fill_extend_1d_one_pass.f │ │ │ ├── hole_fill_extend_2d.f │ │ │ ├── hole_fill_extend_2d_driver3.f │ │ │ ├── hole_fill_extend_2d_one_pass.f │ │ │ ├── include_constants.inc │ │ │ ├── inhg_from_pa.f │ │ │ ├── insert_string.f │ │ │ ├── interp_1d.f │ │ │ ├── interp_2d.f │ │ │ ├── interp_3d.f │ │ │ ├── interp_4d.f │ │ │ ├── irregular_gridbox_1d.f │ │ │ ├── k_from_c.f │ │ │ ├── k_from_f.f │ │ │ ├── left_justify.f │ │ │ ├── linear_interp.f │ │ │ ├── linear_interpolation.f │ │ │ ├── linear_interpolation_1d.f │ │ │ ├── linear_interpolation_2d.f │ │ │ ├── linear_interpolation_3d.f │ │ │ ├── linear_interpolation_4d.f │ │ │ ├── linear_system_with_errors.f │ │ │ ├── lls.f │ │ │ ├── lls_cov.f │ │ │ ├── lls_data_coeffs.ff │ │ │ ├── lls_par_cov.f │ │ │ ├── lls_simple.f │ │ │ ├── lls_var.f │ │ │ ├── lls_var_response.f │ │ │ ├── load_float.f │ │ │ ├── load_float_right.f │ │ │ ├── load_float_signif.f │ │ │ ├── load_float_signif_right.f │ │ │ ├── load_float_signif_trunc.f │ │ │ ├── load_float_signif_trunc_right.f │ │ │ ├── load_float_trunc.f │ │ │ ├── load_float_trunc_right.f │ │ │ ├── load_integer.f │ │ │ ├── load_integer_right.f │ │ │ ├── load_scientific.f │ │ │ ├── load_scientific_ncarg.f │ │ │ ├── load_scientific_right.f │ │ │ ├── load_scientific_trunc.f │ │ │ ├── load_scientific_trunc_ncarg.f │ │ │ ├── load_string.f │ │ │ ├── load_string_right.f │ │ │ ├── mat_cholesky_factor.f │ │ │ ├── mat_inv.f │ │ │ ├── mat_inv_lowtri.f │ │ │ ├── mat_inv_sym_posdef.f │ │ │ ├── mat_inv_uptri.f │ │ │ ├── mat_mult.f │ │ │ ├── mat_singular.f │ │ │ ├── mat_write.f │ │ │ ├── mb_from_pa.f │ │ │ ├── median.f │ │ │ ├── mnmx_3d.f │ │ │ ├── multi_step_binomial_filter_weights.f │ │ │ ├── multi_step_leise_filter_weights.f │ │ │ ├── n_diagonal_efficient_dp.f │ │ │ ├── nsig_min.f │ │ │ ├── number_histogram.f │ │ │ ├── octant1.f │ │ │ ├── octant2.f │ │ │ ├── octant3.f │ │ │ ├── octant4.f │ │ │ ├── octant5.f │ │ │ ├── octant6.f │ │ │ ├── octant7.f │ │ │ ├── octant8.f │ │ │ ├── or_3d.f │ │ │ ├── pa_from_inhg.f │ │ │ ├── pa_from_mb.f │ │ │ ├── poisson_2d.f │ │ │ ├── poisson_2d_mgr.f │ │ │ ├── print_field_statistics_3d.f │ │ │ ├── probability_density_histogram.f │ │ │ ├── probability_histogram.f │ │ │ ├── read_i1.f │ │ │ ├── read_i2.f │ │ │ ├── read_i2_buf.f │ │ │ ├── read_i4.f │ │ │ ├── read_i4_buf.f │ │ │ ├── read_r4.f │ │ │ ├── read_r4_buf.f │ │ │ ├── regression_1.f │ │ │ ├── regression_2.f │ │ │ ├── regression_var_1.f │ │ │ ├── regression_var_2.f │ │ │ ├── replace_character.f │ │ │ ├── right_justify.f │ │ │ ├── rng01.f │ │ │ ├── rngab.f │ │ │ ├── rngij.f │ │ │ ├── rngn.f │ │ │ ├── round.f │ │ │ ├── round_signif.f │ │ │ ├── rowred_pp.f │ │ │ ├── s_l.f │ │ │ ├── same_side_of_line.f │ │ │ ├── same_side_of_plane.f │ │ │ ├── sf_f_dp.f │ │ │ ├── sf_i.f │ │ │ ├── sf_r_fix_trunc.f │ │ │ ├── sf_r_sig.f │ │ │ ├── sf_r_sig_fix.f │ │ │ ├── sf_r_sig_fix_trunc.f │ │ │ ├── sf_r_sig_trunc.f │ │ │ ├── sf_r_trunc.f │ │ │ ├── side1.f │ │ │ ├── side2.f │ │ │ ├── sindeg.f │ │ │ ├── smart_integer.f │ │ │ ├── smart_real.f │ │ │ ├── solve_3.f │ │ │ ├── sor.f │ │ │ ├── sor_multi_diagonal_efficient.f │ │ │ ├── sor_multi_diagonal_efficient_dp.f │ │ │ ├── sor_multi_diagonal_efficient_dp_init.f │ │ │ ├── sort_f.f │ │ │ ├── sort_fi_on_f.f │ │ │ ├── sort_fiiii_on_f.f │ │ │ ├── sort_fiiiiiiii_on_f.f │ │ │ ├── spiral_out_2d.f │ │ │ ├── string_length.f │ │ │ ├── substantial_ddt_3d.f │ │ │ ├── substantial_ddt_3d_moving.f │ │ │ ├── subtract_mean_3d.f │ │ │ ├── surrounded_2d.f │ │ │ ├── tandeg.f │ │ │ ├── thresh_on_field_3d.f │ │ │ ├── tmmlib.inc │ │ │ ├── tri_diagonal_efficient.f │ │ │ ├── tri_diagonal_efficient_dp.f │ │ │ ├── tri_diagonal_system.f │ │ │ ├── tri_diagonal_system_dp.f │ │ │ ├── two_field_max_3d.f │ │ │ ├── two_field_statistics_3d.f │ │ │ ├── uptri_pp.f │ │ │ ├── write_i2.f │ │ │ ├── write_i2_buf.f │ │ │ ├── write_i4.f │ │ │ ├── write_i4_buf.f │ │ │ ├── write_r4.f │ │ │ ├── write_r4_buf.f │ │ │ └── x_to_dbx.f │ │ ├── libtmr.so │ │ ├── libtmr │ │ │ ├── complete_new.ff │ │ │ ├── complete_var_col_soln.f │ │ │ ├── complete_var_col_soln_driver.f │ │ │ ├── complete_var_col_soln_sd.f │ │ │ ├── dealias.f │ │ │ ├── div_from_w_layers.f │ │ │ ├── div_from_w_levels.f │ │ │ ├── dop_1_comp_soln.f │ │ │ ├── dop_2_comp_soln.f │ │ │ ├── dop_2_comp_soln_simple.f │ │ │ ├── dop_3_comp_soln.f │ │ │ ├── dop_3_comp_soln_simple.f │ │ │ ├── dop_soln_driver_2.f │ │ │ ├── dop_soln_driver_2_simple.f │ │ │ ├── dop_soln_driver_3.f │ │ │ ├── dop_soln_driver_3_simple.f │ │ │ ├── dop_soln_driver_3else2.f │ │ │ ├── dop_soln_driver_3else2_simple.f │ │ │ ├── dop_soln_driver_3or2.f │ │ │ ├── dop_soln_driver_3or2_simple.f │ │ │ ├── echo_power.f │ │ │ ├── extend_down.f │ │ │ ├── extend_up.f │ │ │ ├── f_from_dbz.f │ │ │ ├── f_uniform.f │ │ │ ├── include_constants.inc │ │ │ ├── insert_level.f │ │ │ ├── qp_from_dbz.f │ │ │ ├── reflectivity_factor.f │ │ │ ├── restore_column.f │ │ │ ├── sd_w_down.f │ │ │ ├── sd_w_partial_obrien_or_down.f │ │ │ ├── tmrlib.inc │ │ │ ├── w_adjust_layers.f │ │ │ ├── w_adjust_levels.f │ │ │ ├── w_down.f │ │ │ ├── w_hydrometeor_layers.f │ │ │ ├── w_hydrometeor_levels.f │ │ │ ├── w_obrien.f │ │ │ ├── w_partial_obrien.f │ │ │ ├── w_partial_obrien_or_down.f │ │ │ ├── w_up.f │ │ │ ├── w_up_and_down.f │ │ │ ├── w_upward_downward_layers.f │ │ │ └── w_upward_downward_levels.f │ │ ├── libtmt.so │ │ ├── libtmt │ │ │ ├── ahum.f │ │ │ ├── ahums.f │ │ │ ├── ahumsi.f │ │ │ ├── aicblb.f │ │ │ ├── alhsub.f │ │ │ ├── alhvap.f │ │ │ ├── amix.f │ │ │ ├── amixs.f │ │ │ ├── amixsi.f │ │ │ ├── amolwt.f │ │ │ ├── av_denclr.f │ │ │ ├── av_denclr2.f │ │ │ ├── den.f │ │ │ ├── denclr.f │ │ │ ├── denclr2.f │ │ │ ├── dend.f │ │ │ ├── dpdzhs.f │ │ │ ├── dpfp.f │ │ │ ├── dpiceb.f │ │ │ ├── dpmix.f │ │ │ ├── dprh.f │ │ │ ├── dprhi.f │ │ │ ├── dpshum.f │ │ │ ├── dpwetb.f │ │ │ ├── dtdpda.f │ │ │ ├── eqpoti.f │ │ │ ├── eqpott.f │ │ │ ├── frost.f │ │ │ ├── get_tmtlib_badflag.f │ │ │ ├── include_constants.inc │ │ │ ├── lcl.f │ │ │ ├── ldl.f │ │ │ ├── p_sa.f │ │ │ ├── pclr.f │ │ │ ├── pclr2.f │ │ │ ├── pott.f │ │ │ ├── pottd.f │ │ │ ├── pottv.f │ │ │ ├── preduc.f │ │ │ ├── pseudi.f │ │ │ ├── pseudo.f │ │ │ ├── punred.f │ │ │ ├── rhum.f │ │ │ ├── rhumi.f │ │ │ ├── shum.f │ │ │ ├── shums.f │ │ │ ├── shumsi.f │ │ │ ├── spgasc.f │ │ │ ├── sphtcp.f │ │ │ ├── sphtcv.f │ │ │ ├── state1.f │ │ │ ├── state2.f │ │ │ ├── tmtlib.inc │ │ │ ├── tvclr.f │ │ │ ├── vapp.f │ │ │ ├── vapps.f │ │ │ ├── vappsi.f │ │ │ ├── virt.f │ │ │ ├── wbpoti.f │ │ │ ├── wbpott.f │ │ │ ├── wetblb.f │ │ │ ├── z_sa_to_clr.f │ │ │ ├── z_sa_to_clr2.f │ │ │ └── zclr.f │ │ ├── rebuild_libs │ │ └── tester │ └── windsyn │ │ ├── fib3.f │ │ ├── fib3.so │ │ ├── windsyn.f │ │ ├── windsyn.f.1 │ │ ├── windsyn.orig.f │ │ └── windsyn.pyf └── util │ ├── __init__.py │ ├── convert.py │ ├── google_earth_tools.py │ ├── helper.py │ ├── matcher.py │ ├── shearcalcs.py │ ├── sonde_calcs.py │ ├── thermocalcs.py │ ├── track_distance.py │ └── write_kmz.py ├── examples ├── T28_jpole_flight.ipynb ├── add_variable_to_awot.ipynb ├── awot_4panel_cappi.ipynb ├── awot_cfad_demo.ipynb ├── awot_create_netcdf_from_radar_grid.ipynb ├── awot_dropsonde_example.ipynb ├── awot_plot_flight_track.ipynb ├── awot_plot_grid_tdr.ipynb ├── awot_plot_sweep_file.ipynb ├── awot_plot_wcr2.ipynb ├── awot_radar_cross_section.ipynb ├── awot_time_series_flight_data.ipynb ├── awot_track_kmz_save.ipynb ├── awot_utilities_intro.ipynb └── hiwrap_plot.ipynb └── setup.py /.gitignore: -------------------------------------------------------------------------------- 1 | # Byte-compiled / optimized / DLL files 2 | __pycache__/ 3 | *.py[cod] 4 | 5 | # C extensions 6 | *.so 7 | 8 | # Distribution / packaging 9 | .Python 10 | env/ 11 | build/ 12 | develop-eggs/ 13 | dist/ 14 | eggs/ 15 | lib/ 16 | lib64/ 17 | parts/ 18 | sdist/ 19 | var/ 20 | *.egg-info/ 21 | .installed.cfg 22 | *.egg 23 | 24 | # PyInstaller 25 | # Usually these files are written by a python script from a template 26 | # before PyInstaller builds the exe, so as to inject date/other infos into it. 27 | *.manifest 28 | *.spec 29 | 30 | # Installer logs 31 | pip-log.txt 32 | pip-delete-this-directory.txt 33 | 34 | # Unit test / coverage reports 35 | htmlcov/ 36 | .tox/ 37 | .coverage 38 | .cache 39 | nosetests.xml 40 | coverage.xml 41 | 42 | # Translations 43 | *.mo 44 | *.pot 45 | 46 | # Django stuff: 47 | *.log 48 | 49 | # Sphinx documentation 50 | docs/_build/ 51 | 52 | # PyBuilder 53 | target/ 54 | -------------------------------------------------------------------------------- /awot/__init__.py: -------------------------------------------------------------------------------- 1 | """ 2 | awot - Airborne Weather Observations Toolkit 3 | ================================================ 4 | Probe Subpackage (:mod:'awot) 5 | ================================================ 6 | 7 | .. currentmodule:: awot 8 | 9 | .. autosummary:: 10 | :toctree: generated/ 11 | 12 | """ 13 | from __future__ import absolute_import 14 | 15 | # import subpackages 16 | from . import io 17 | from . import display 18 | from . import graph 19 | from . import util 20 | 21 | __all__ = [s for s in dir() if not s.startswith('_')] 22 | -------------------------------------------------------------------------------- /awot/display/__init__.py: -------------------------------------------------------------------------------- 1 | """ 2 | awot - Airborne Weather Observations Toolkit 3 | ================================================ 4 | Probe Subpackage (:mod:'awot.display) 5 | ================================================ 6 | 7 | .. currentmodule:: awot.display 8 | """ 9 | from . import rtd 10 | __all__ = [s for s in dir() if not s.startswith('_')] 11 | -------------------------------------------------------------------------------- /awot/graph/__init__.py: -------------------------------------------------------------------------------- 1 | """ 2 | awot - Airborne Weather Observations Toolkit 3 | ================================================ 4 | Probe Subpackage (:mod:'awot.graph) 5 | ================================================ 6 | 7 | .. currentmodule:: awot.graph 8 | """ 9 | 10 | from .flight_level import FlightLevel 11 | from .radar_horizontal import RadarHorizontalPlot 12 | from .radar_vertical import RadarVerticalPlot 13 | from .microphysical_vertical import MicrophysicalVerticalPlot 14 | from .radar_sweep import RadarSweepPlot 15 | from .radar_utility import RadarUtilityPlot 16 | # from .radar_swath import RadarSwathPlot 17 | from .radar_3d import Radar3DPlot 18 | from .common import create_basemap, save_figure 19 | from .sonde import (plot_skewt_logp, plot_hodograph, 20 | plot_aux_graph, plot_parameter_list, plot_thermo_calcs, 21 | plot_shear_calcs, plot_dryadiabats, plot_wind_barbs) 22 | from .skew import SkewXTick 23 | 24 | 25 | __all__ = [s for s in dir() if not s.startswith('_')] 26 | -------------------------------------------------------------------------------- /awot/io/__init__.py: -------------------------------------------------------------------------------- 1 | """ 2 | awot - Airborne Weather Observations Toolkit 3 | ================================================ 4 | Probe Subpackage (:mod:'awot.io) 5 | ================================================ 6 | 7 | .. currentmodule:: awot.io 8 | """ 9 | 10 | from __future__ import absolute_import 11 | from .flight import read_netcdf, read_netcdf_variable, read_nasa_ames 12 | 13 | from .read_ground_radar import read_ground_radar 14 | from .read_radar_sweep import read_tdr_sweep, read_lf_sweep 15 | 16 | from .read_latmos_falcon import (read_rasta_wind, read_rasta_radar, 17 | read_rasta_dynamic, read_rasta_microphysics) 18 | from .read_p3_radar import (read_windsyn_tdr_netcdf, read_tdr_grid_variable, 19 | read_windsyn_binary, read_lf_grid) 20 | from .read_uwka_lidar import read_wcl 21 | from .read_uwka_radar import read_wcr2 22 | from .read_sonde import (read_sounding_data, read_cls_dropsonde) 23 | from .read_nasa_hiwrap import read_hiwrap_netcdf, read_hiwrap_h5 24 | from .write_radar_netcdf import radar2nc 25 | from .read_hiaper_radar import read_hcr 26 | from .name_maps_flight import get_name_map 27 | 28 | 29 | 30 | __all__ = [s for s in dir() if not s.startswith('_')] 31 | -------------------------------------------------------------------------------- /awot/src/interp/.DS_Store: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nguy/AWOT/cf1a9f7632382a289063ee6e9c401222e2e10791/awot/src/interp/.DS_Store -------------------------------------------------------------------------------- /awot/src/interp/dualp_interp.prm: -------------------------------------------------------------------------------- 1 | dualp_interp ! Program ID - must be this to work 2 | debris-09 IOP4 ! Project name (16 chars max) 3 | /Users/davej/projects/debris/debris-09/Hybrid_Scan_Burbank.dat ! Hybrid scan file 4 | 175,175,0.075,0.075 ! Imax,Jmax,Sx,Sy 5 | 0 34.1833 -118.3167 090101 000000 0.0 0.0 ! Nmosm,Olat,Olon,T0 (yymmdd hhmmss),Su,Sv 6 | 217 1.32 0 1 ! MSL of radar, dbz offset, VPR corr, atten corr 7 | 1.0 0 0 ! Horiz influ, # of Elev Offsets, dbz flag (0:DZ 1:ZT) 8 | 9 | 10 | 0.000 359.9 2 11 ! number of elevation angle steps to add, max elev step 11 | -------------------------------------------------------------------------------- /awot/src/interp/gage_interp.prm: -------------------------------------------------------------------------------- 1 | gage_interp 2 | 38.67 -121.25 201 201 0.5 0.5 ! Corner Lat,Long Imax, Jmax, Resx, Resy 3 | 051129 000000 060306 234500 ! start & end times (yymmdd hhmmss) 4 | total_rain.dat ! output file name 5 | /Users/davej/projects/hmt/hmt_data/Raingages.txt ! File of the locations of ALERT gages 6 | -------------------------------------------------------------------------------- /awot/src/interp/gage_interp_iop1.prm: -------------------------------------------------------------------------------- 1 | gage_interp 2 | 38.67 -121.25 101 101 1.0 1.0 ! Corner Lat,Long Imax, Jmax, Resx, Resy 3 | 051130 210000 051202 080000 ! start & end times (yymmdd hhmmss) 4 | /Users/davej/projects/hmt/hmt_data/iop1_rain.dat ! output file name 5 | /Users/davej/projects/hmt/hmt_data/Raingages_iop1.txt ! File of the locations of ALERT gages 6 | -------------------------------------------------------------------------------- /awot/src/interp/grnd_interp.doc: -------------------------------------------------------------------------------- 1 | Use grnd_interp to interpolate ground-based radar data to a Cartesian grid: 2 | 3 | grnd_interp grnd_interp.prm file.UF ysmsds hsmsss yemede hemese 4 | 5 | where: 6 | grnd_interp.prm is the parameter file 7 | file.UF is the full path name to the UF file 8 | ysmsds - start year, start month, & start day 9 | hsmsss - start hour, start minute, & start second 10 | yemede - end year, end month, & end day 11 | hemese - end hour, end minute, & end second 12 | 13 | the parameters: ysmsds hsmsss yemede hemese are optional and if omitted the entire UF file is read 14 | (i.e., no start and end times) 15 | 16 | the format of grnd_interp.prm 17 | grnd_interp ! Program ID - must be this to work 18 | NSSL/ERIN ! Project name (16 chars max) 19 | 100,100,30,1.5,1.5,0.5,0.5 ! Imax,Jmax,Kmax,Sx,Sy,Sz,Z0 20 | 1 39.750 -85.200 030705 003000 +14.72 -2.60 ! Nmosm,Olat,Olon,T0 (yymmdd hhmmss),Su,Sv 21 | 370 ! MSL of radar 22 | 1.0 1.0 0.25 ! Horiz influ, Vert int, slope 23 | -------------------------------------------------------------------------------- /awot/src/interp/grnd_interp.prm: -------------------------------------------------------------------------------- 1 | grnd_interp ! Program ID - must be this to work 2 | NSSL/ERIN ! Project name (16 chars max) 3 | /Volumes/Data/Doppler/erin/KOUN_UF/ufd.1070819130829.KOUN.0.tape ! Input File Name 4 | /Volumes/Data/Doppler/erin/analysis/grd_KOUN_0708191308.dat ! Output File Name 5 | 120,120,30,1.0,1.0,0.5,0.5 ! Imax,Jmax,Kmax,Sx,Sy,Sz,Z0 6 | 0 34.78 -98.00 070819 131000 +14.72 -2.60 ! Nmosm,Olat,Olon,T0 (yymmdd hhmmss),Su,Sv 7 | OUN 370.0 DZ VE 1.0 1.0 0.25 ! ID, MSL of radar, Ref Field Name, Vel Field name, Horiz influ, Vert int, slope 8 | 070819 000000 070819 235959 ! Start time, End time (000000-235959 for all of volumn scan) 9 | -------------------------------------------------------------------------------- /awot/src/interp/grnd_interp_KOUN.prm: -------------------------------------------------------------------------------- 1 | grnd_interp ! Program ID - must be this to work 2 | NSSL/ERIN ! Project name (16 chars max) 3 | /Volumes/Data/Doppler/erin/KOUN_UF/ufd.1070819130829.KOUN.0.tape ! Input File Name 4 | /Volumes/Data/Doppler/erin/analysis/grd_KOUN_0708191308.dat ! Output File Name 5 | 130,130,30,1.0,1.0,0.5,0.5 ! Imax,Jmax,Kmax,Sx,Sy,Sz,Z0 6 | 0 34.78 -98.00 070819 131000 +14.72 -2.60 ! Nmosm,Olat,Olon,T0 (yymmdd hhmmss),Su,Sv 7 | 370.0 DZ VE 1.0 1.0 0.25 ! MSL of radar, Ref Field Name, Vel Field name, Horiz influ, Vert int, slope 8 | 070819 000000 070819 235959 ! Start time, End time (000000-235959 for all of volumn scan) 9 | -------------------------------------------------------------------------------- /awot/src/interp/grnd_interp_KTLX.prm: -------------------------------------------------------------------------------- 1 | grnd_interp ! Program ID - must be this to work 2 | NSSL/ERIN ! Project name (16 chars max) 3 | /Volumes/Data/Doppler/erin/KTLX_UF/ufd.1070819131059.KTLX.0.tape ! Input UF File Name 4 | /Volumes/Data/Doppler/erin/analysis/grd_KTLX_0708191310.dat ! Output File Name 5 | 130,130,30,1.0,1.0,0.5,0.5 ! Imax,Jmax,Kmax,Sx,Sy,Sz,Z0 6 | 0 34.78 -98.00 070819 131000 +14.72 -2.60 ! Nmosm,Olat,Olon,T0 (yymmdd hhmmss),Su,Sv 7 | 370.0 DZ VE 1.0 1.0 0.25 ! MSL of radar, Ref Field Name, Vel Field name, Horiz influ, Vert int, slope 8 | 070819 000000 070819 235959 ! Start time, End time (000000-235959 for all of volumn scan) 9 | -------------------------------------------------------------------------------- /awot/src/interp/hybrid_interp.prm: -------------------------------------------------------------------------------- 1 | hybrid_interp ! Program ID - must be this to work 2 | HMT-05/06 IOP7 ! Project name (16 chars max) 3 | /Users/davej/projects/hmt/hmt_data/HMT_SR1_Hybrid_Scan.dat ! Hybrid scan file 4 | 201,201,0.5,0.5 ! Imax,Jmax,Sx,Sy 5 | 0 38.670 -121.250 060227 023500 0.0 0.0 ! Nmosm,Olat,Olon,T0 (yymmdd hhmmss),Su,Sv 6 | 971 -5.61 1 ! MSL of radar, dbz offset, VPR corr 7 | 1.50 4.5 ! DelZ1, tanb (ice slope) 8 | /Users/davej/projects/hmt/hmt_data/topoe.prm ! topo .prm file 9 | 1.0 4 1 ! Horiz influ, # of Elev Offsets, dbz flag (0:DZ 1:ZT) 10 | 312.5 359.9 2 6 ! start azm, end azm, Elev step increase, max step 11 | 000.0 090.0 2 6 ! start azm, end azm, Elev step increase, max step 12 | 312.5 317.5 3 6 ! start azm, end azm, Elev, step increase, max step 13 | 001.5 004.5 3 6 ! start azm, end azm, Elev, step increase, max step 14 | -------------------------------------------------------------------------------- /awot/src/interp/ncg_plot_gage.prm: -------------------------------------------------------------------------------- 1 | ncg_plot 2 | North Fork American River Basin 3 | r 0.0 2.0 41 1 0.25 ! plot Radar(r) or topo(t), Cmin, Cint, # contours,grd 4 | 1 0.469 0.020 0.640 ! RGB color triplets for each contour + 1 5 | 2 0.403 0.227 0.559 6 | 3 0.164 0.055 0.582 7 | 4 0.227 0.055 0.672 8 | 5 0.289 0.055 0.766 9 | 6 0.352 0.141 0.898 10 | 7 0.414 0.375 0.996 11 | 8 0.445 0.559 0.996 12 | 9 0.281 0.590 0.602 13 | 10 0.188 0.523 0.371 14 | 11 0.004 0.445 0.000 15 | 12 0.000 0.492 0.000 16 | 13 0.000 0.539 0.000 17 | 14 0.059 0.586 0.059 18 | 15 0.176 0.633 0.176 19 | 16 0.289 0.680 0.289 20 | 17 0.402 0.723 0.402 21 | 18 0.520 0.770 0.520 22 | 19 0.633 0.816 0.633 23 | 20 0.750 0.863 0.750 24 | 21 0.863 0.910 0.863 25 | 22 0.938 0.906 0.703 26 | 23 0.938 0.859 0.352 27 | 24 0.938 0.812 0.000 28 | 25 0.938 0.766 0.023 29 | 26 0.938 0.719 0.055 30 | 27 0.926 0.672 0.086 31 | 28 0.871 0.625 0.117 32 | 29 0.816 0.578 0.148 33 | 30 0.758 0.531 0.180 34 | 31 0.703 0.484 0.211 35 | 32 0.648 0.438 0.242 36 | 33 0.590 0.391 0.250 37 | 34 0.535 0.344 0.250 38 | 35 0.485 0.328 0.297 39 | 36 0.629 0.312 0.375 40 | 37 0.625 0.003 0.000 41 | 38 0.718 0.086 0.188 42 | 39 0.813 0.148 0.273 43 | 40 0.879 0.211 0.355 44 | 41 0.949 0.273 0.355 45 | 42 1.000 0.012 0.000 46 | total_rain.dat ! rain gage file 47 | /Users/davej/projects/hmt/hmt_data/nfork_amer_pts.asc ! Basin delineation 48 | /Users/davej/projects/hmt/hmt_data/LandMarks.txt ! LandMarks file 49 | -------------------------------------------------------------------------------- /awot/src/interp/total_rain.dat: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nguy/AWOT/cf1a9f7632382a289063ee6e9c401222e2e10791/awot/src/interp/total_rain.dat -------------------------------------------------------------------------------- /awot/src/libs/libdpj.so: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nguy/AWOT/cf1a9f7632382a289063ee6e9c401222e2e10791/awot/src/libs/libdpj.so -------------------------------------------------------------------------------- /awot/src/libs/libdpj/AzDif.f: -------------------------------------------------------------------------------- 1 | C "<08-Oct-1993 21:54:25>" 2 | ************************************************************************* 3 | Real*4 Function AzDif(arg1,arg2, difMax) 4 | 5 | * Input: 6 | * arg1 and arg2 should be between 0.0 and 2.*difMax. 7 | * Output: 8 | * case 1: if -difMax <= arg1 -arg2 <= difMax, 9 | * then (arg1-arg2) will be returned. 10 | * case 2: if arg1 -arg2 < -difMax, 11 | * then (arg1-arg2)+2*difMax will be returned. 12 | * case 3: if arg1 -arg2 > difMax, 13 | * then (arg1-arg2)-2*difMax will be returned. 14 | * I.e., return difference of two arguments, where modulo 15 | * arithmetic of 2*difMax means the difference has magnitude <= difMax. 16 | 17 | Real*4 arg1, arg2, difMax 18 | Real*4 dif 19 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 20 | dif = arg1 - arg2 21 | if (dif .lt. -difMax)then 22 | AzDif = dif + 2.*difMax 23 | return 24 | else if (dif .gt. difMax)then 25 | AzDif = dif - 2.*difMax 26 | return 27 | end if 28 | AzDif = dif 29 | return 30 | end ! Real*4 function azDif ends 31 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/BinAng_Deg.f: -------------------------------------------------------------------------------- 1 | C "<08-Oct-1993 21:54:26>" 2 | **************************************************************************** 3 | Real*4 Function BinAng_Deg(I_Ang) 4 | 5 | c This function takes a 16-bit integer and converts to a real number. 6 | c Please note: "P3 Prog. Des. Manual 5 July 1988" describes seveal items 7 | c in the ray header as binary angles (16-bit). If a binary format had 8 | c been used, then the integer would have been interpreted as: 9 | c MSB: sign bit 10 | c 2ns MSB: 180 degrees 11 | c 3rd MSB: 90 degrees 12 | c and so on. The real number would then be -359.989 to 359.989. 13 | c However, the Sigmet routines brought back by Jorgensen July 13, 1988, 14 | c use a different scheme for what they label binary angles. Therefore 15 | c this routine will provide the inverse for the Sigmet routines, the 16 | c interpretation of the 16-bit integer being: 17 | c -32768 to 32767 are mapped to -180.0000 to 179.9945 degrees. 18 | c 19 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 20 | Integer*2 I_Ang 21 | Integer*4 J_Ang 22 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 23 | 24 | J_Ang = I_Ang 25 | BinAng_Deg = 90.0 * (Float (J_ang)/16384.0) 26 | 27 | Return 28 | 29 | End ! Function BinAng_Deg ends 30 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/Casefold.f: -------------------------------------------------------------------------------- 1 | C "<08-Oct-1993 21:54:27>" 2 | ************************************************************************ 3 | Subroutine Casefold(String) 4 | 5 | c This subroutine will convert all lower case letters (ASCII 97-122) 6 | c in string to upper case (ASCII 65 - 90) 7 | 8 | Implicit none 9 | Character String*(*) 10 | Integer*4 Length, II, IASC 11 | 12 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 13 | 14 | Length = Len(String) 15 | Do II = 1,Length 16 | Iasc = Ichar(String(II:II)) 17 | If ((Iasc .ge. 97) .and. (Iasc .le. 122)) 18 | > String(II:II) = Char(Iasc-32) ! convert to capital letter 19 | End Do 20 | Return 21 | End ! subroutine Casefold ends 22 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/CleanString.f: -------------------------------------------------------------------------------- 1 | C "<08-Oct-1993 21:54:29>" 2 | ************************************************************************* 3 | Subroutine CleanString(String,Marker,Clean) 4 | c Clean up a string (usually blanking out) all characters from the 5 | c "Marker" character onward. 6 | c Input conditions: 7 | c String: character string to clean 8 | c Marker: character string of length one; first occurence in the 9 | c string will cause from that position to end of string to 10 | c be replace by the Clean character. 11 | c Clean: character string of length one to use as a replacement. 12 | c Example of call 13 | c Call CleanString(LineRead,'!',' ') ! ignore after '!' in line 14 | c Exit Conditions: 15 | c Marker and Clean will be unchanged. 16 | c String will be changed if-and-only-if the Marker character was 17 | c found in the string. 18 | Implicit None 19 | Character String*(*), Marker*1, Clean*1 20 | Integer*4 Ilength, ii 21 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 22 | Ilength = Len(String) 23 | ii = 1 24 | Do While (ii .le. Ilength) 25 | if (String(ii:ii) .eq. Marker)then 26 | Do While (ii .le. Ilength) 27 | String(ii:ii) = Clean 28 | ii = ii + 1 29 | end do 30 | end if 31 | ii = ii + 1 32 | end do 33 | return 34 | end ! CleanString ends 35 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/Convt_Km.f: -------------------------------------------------------------------------------- 1 | ! "<23-Jun-1994 22:20:52>" 2 | Subroutine Convt_Km(Plat,Plon,xkm,ykm,Clat,Clon) 3 | 4 | c Routine to convert Plat,Plon to kilometers on a flat Earth, 5 | c with Clat,Clon used as origin (i.e., xkm,ykm = 0.0,0.0). 6 | 7 | Implicit none 8 | ! parameters 9 | Real*4 Plat,Plon,xkm,ykm,Clat,Clon 10 | 11 | ! local variables 12 | Real*4 Dlat,Dlon 13 | 14 | Dlon = Plon - Clon 15 | Dlat = Plat - Clat 16 | xkm = Dlon * 111.19 * Cos(Plat * 0.01745329) 17 | ykm = Dlat * 111.19 18 | 19 | Return 20 | End ! subroutine Convt_km ends 21 | ************************************************************************ 22 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/FindPattern.f: -------------------------------------------------------------------------------- 1 | ********************************************************************* 2 | Integer*4 Function FindPattern(pattern,string) 3 | ! "<20-May-1994 19:06:20>" 4 | c 5 | c This is function to check if a pattern can be found in the string 6 | c (NO case folding). 7 | c Input conditions: 8 | c pattern: character string pattern to search for in string. 9 | c string: character string 10 | c Output of function: 11 | c 0 is returned if pattern was not found. 12 | c >0 = n will be returned to mean the first occurrence of the 13 | c pattern begins in the n-th character position in the string. 14 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15 | Implicit none 16 | Character pattern*(*),String*(*) 17 | Integer*4 ipatlen,istringlen,ii 18 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 19 | ipatlen = len(pattern) 20 | istringlen = len (string) 21 | FindPattern = 0 22 | ii = 0 23 | Do While (ii + ipatlen .le. istringlen) 24 | ii = ii + 1 25 | if (pattern .eq. string(ii:ii+ipatlen-1))then 26 | FindPattern = ii 27 | return 28 | end if 29 | end do 30 | return 31 | end ! FindPattern ends 32 | ********************************************************************* 33 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/FirstChar.f: -------------------------------------------------------------------------------- 1 | C "<08-Oct-1993 21:54:29>" 2 | ************************************************************************* 3 | Integer*4 Function FirstChar(String,Char) 4 | 5 | c Find first occurence of character in character string. 6 | c Ex. FirstChar('001234','2') will equal 4 7 | c Ex. FirstChar('0012','2') will equal 4 8 | c Ex. FirstChar('223456','2') will equal 1 9 | c Ex. FirstChar('123','4') will equal 0, 10 | c i.e., zero will be returned if character is not present in string 11 | c (although one might have logically guessed the string_length + 1 12 | c would be returned). 13 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14 | Implicit none 15 | Character String*(*),Char*1 16 | Integer*4 LenString 17 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 18 | LenString = Len(String) 19 | FirstChar = 1 20 | Do While (FirstChar .le. LenString) 21 | If (String(FirstChar:FirstChar) .eq. Char) Return 22 | FirstChar = FirstChar +1 23 | End Do 24 | FirstChar = 0 ! character not found!! 25 | Return 26 | End ! Integer*4 Function FirstChar ends 27 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/Goodbye.f: -------------------------------------------------------------------------------- 1 | C "<08-Oct-1993 21:54:30>" 2 | ******************************************************************** 3 | Subroutine Goodbye(LuHomeW) 4 | c Say goodbye and exit. 5 | Implicit none 6 | Integer*4 LuhomeW 7 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 8 | Write (LuhomeW,50001) 9 | Stop 10 | 50001 Format(/' Exit - Hasta luego, Amigo mio! - A bientot, mon ami!'/ 11 | >' Tschuess, mein Freund - Assalaamu ''alaykum - Shalom aleichem'/ 12 | >' Dzai jian - sayonnara - Dag, mijn vriend! - Farvel, min ven!'/ 13 | >' Bless-Bless - Good-bye') 14 | End ! subroutine goodbye ends 15 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/Ichk.f: -------------------------------------------------------------------------------- 1 | ! "<23-Jun-1994 22:20:46>" 2 | Integer*4 Function Ichk(x,y,Xmin, Xmax, Ymin, Ymax) 3 | ! check to see if point is in box with boundaries xmin,xmax,ymin,ymax 4 | ! return 0: if in box 5 | ! add 1 if less than xmin, 6 | ! add 2 if greater than xmax, 7 | ! add 4 if less than ymin, 8 | ! add 8 if greater than ymax, 9 | Implicit none 10 | Real*4 x,y, Xmin, Xmax, Ymin, Ymax 11 | 12 | Ichk = 0 13 | 14 | If (x .lt. Xmin) Ichk = 1 15 | If (x .gt. Xmax) Ichk = 2 16 | If (y .gt. Ymax) Ichk = Ichk + 8 17 | If (y .lt. Ymin) Ichk = Ichk + 4 18 | 19 | Return 20 | End ! function Ichk ends 21 | ************************************************************************ 22 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/Iswap.f: -------------------------------------------------------------------------------- 1 | ! "<23-Jun-1994 22:20:47>" 2 | Subroutine Iswap(i,j) 3 | Implicit none 4 | ! parameters 5 | Integer*4 i,j 6 | 7 | ! local variables 8 | Integer*4 it 9 | 10 | it = i 11 | i = j 12 | j = it 13 | 14 | Return 15 | End ! subroutine Iswap ends 16 | ************************************************************************ 17 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/Jdate2day.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE Jdate2day (JD, YEAR,MONTH,DAY) 2 | C 3 | C---COMPUTES THE GREGORIAN CALENDAR DATE (YEAR,MONTH,DAY) 4 | C GIVEN THE JULIAN DATE (JD). 5 | C 6 | INTEGER JD,YEAR,MONTH,DAY,I,J,K 7 | C 8 | L= JD+68569 9 | N= 4*L/146097 10 | L= L-(146097*N+3)/4 11 | I= 4000*(L+1)/1461001 12 | L= L-1461*I/4+31 13 | J= 80*L/2447 14 | K= L-2447*J/80 15 | L= J/11 16 | J= J+2-12*L 17 | I= 100*(N-49)+I+L 18 | C 19 | YEAR= I 20 | MONTH= J 21 | DAY= K 22 | C 23 | RETURN 24 | END 25 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/JulDate.f: -------------------------------------------------------------------------------- 1 | INTEGER FUNCTION JulDate (YEAR, MONTH, DAY) 2 | C 3 | C---COMPUTES THE JULIAN DATE (JD) GIVEN A GREGORIAN CALENDAR 4 | C DATE (YEAR,MONTH,DAY) from 1 January 4713 BC 5 | C From http://aa.usno.navy.mil/faq/docs/JD_Formula.html 6 | C 7 | INTEGER YEAR, MONTH, DAY, I, J, K 8 | 9 | I= YEAR 10 | J= MONTH 11 | K= DAY 12 | 13 | JD= K-32075+1461*(I+4800+(J-14)/12)/4+367*(J-2-(J-14)/12*12) 14 | 2 /12-3*((I+4900+(J-14)/12)/100)/4 15 | 16 | Juldate = JD 17 | 18 | RETURN 19 | END 20 | 21 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/JulDy.f: -------------------------------------------------------------------------------- 1 | C "<08-Oct-1993 21:54:31>" 2 | ************************************************************** 3 | Integer*4 Function Juldy(Imon,Id,Iy)! get Julian day 4 | 5 | C*** COMPUTES JULIAN DAY FROM THE DATE (IMON,IDAY,IYEAR) 6 | C*** ----------------------------------( 09, 27 , 1980) 7 | c Little checking is done for the input year, month, day, 8 | c except the year must be >= 1800. 9 | c 10 | Implicit None 11 | Integer*4 Iy,Imon,Id 12 | Integer*4 ITD 13 | Dimension ITD(12) 14 | DATA ITD/31,59,90,120,151,181,212,243,273,304,334,365/ 15 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 16 | If ((Iy.lt.1800) .or. (Imon .lt.1).or.(Imon.gt.12))then 17 | JulDy = -999 18 | Return 19 | End If 20 | JulDy = Id 21 | if (Imon .eq. 1) return ! for January that's all 22 | JulDy = JulDy + ITD(Imon-1) ! add in previous months' days 23 | If ((Imon.ge.3).and.(Mod(Iy,4).eq.0).and. 24 | > ((Mod(Iy,400).eq. 0).or.(Mod(Iy,100).ne.0))) 25 | > JulDy = JulDy + 1 ! add in for March or later in leap year 26 | Return 27 | End ! Integer*4 Function JulDy ends 28 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/LastChar.f: -------------------------------------------------------------------------------- 1 | C "<08-Oct-1993 21:54:31>" 2 | ************************************************************************* 3 | Integer*4 Function LastChar(String,Char) 4 | 5 | c Find last occurence of character in character string. 6 | c Ex. LastChar('001234','2') will equal 4 7 | c Ex. LastChar('0012','2') will equal 4 8 | c Ex. LastChar('223456','2') will equal 2 9 | c Ex. LastChar('34567','2') will equal 0, 10 | c i.e., zero will be returned if character is not in string. 11 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12 | Implicit none 13 | Character String*(*),Char*1 14 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15 | LastChar = Len(String) 16 | Do While (LastChar .gt. 0) 17 | If (String(LastChar:LastChar) .eq. Char) Return 18 | LastChar = LastChar -1 19 | End Do 20 | Return 21 | End ! Integer*4 Function LastChar ends 22 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/LastNonChar.f: -------------------------------------------------------------------------------- 1 | C "<08-Oct-1993 21:54:32>" 2 | ************************************************************************ 3 | Integer*4 Function LastNonChar(String,Char) 4 | 5 | c Find last non-occurence of character in character string. 6 | c Ex. LastNonChar('001234','2') will equal 6 7 | c Ex. LastNonChar('0012','2') will equal 3 8 | c Ex. LastNonChar('222222','2') will equal 0, 9 | c i.e, zero will be returned if character matches all string characters. 10 | c Ex. LastNonChar('135','2') will equal 3 11 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12 | Implicit none 13 | Character String*(*),Char*1 14 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15 | LastNonChar = Len(String) 16 | Do While (LastNonChar .gt. 0) 17 | If (String(LastNonChar:LastNonChar) .ne. Char) Return 18 | LastNonChar = LastNonChar -1 19 | End Do 20 | Return 21 | End ! Integer*4 Function LastNonChar ends 22 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/OkTime.f: -------------------------------------------------------------------------------- 1 | C "<08-Oct-1993 21:54:33>" 2 | ************************************************************************ 3 | Logical*4 Function OkTime(Iy,Imon,Id,Ih,Imin,Isec)!Check if time ok 4 | c 5 | c Check is done for the input year, month, day, hour, minute, and sec. 6 | c The year must be >= 1800. 7 | c OkTime returns .false. if time is bad, .true. if it is ok. 8 | c 9 | Implicit None 10 | Integer*4 Iy,Imon,Id,Ih,Imin,Isec 11 | Integer*4 Idays,Idaysmon 12 | Dimension Idays(12) 13 | Data Idays /31,28,31,30,31,30,31,31,30,31,30,31/ 14 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15 | If ((Iy.lt.1800) .or. (Imon .lt.1).or.(Imon.gt.12))then 16 | OkTime = .false. 17 | Return 18 | End If 19 | 20 | Idaysmon= Idays(Imon) 21 | If ((Imon.eq.2).and.(Mod(Iy,4).eq.0).and. 22 | > ((Mod(Iy,400).eq. 0).or.(Mod(Iy,100).ne.0)))Idaysmon=29! leap year 23 | if ((Id .lt.1) .or. (Id .gt. Idaysmon) .or. 24 | > (Ih .lt.0) .or. (Ih .gt. 23) .or. 25 | > (Imin .lt.0) .or. (Imin .gt. 59) .or. 26 | > (Isec .lt.0) .or. (Isec .gt. 59))then 27 | OkTime = .false. 28 | Return 29 | end if 30 | OkTime = .true. 31 | return 32 | end ! Logical*4 function OkTime ends 33 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/String_len_c.f: -------------------------------------------------------------------------------- 1 | C "<08-Oct-1993 21:54:34>" 2 | ********************************************************************* 3 | Integer*4 Function String_len_c(string) 4 | c Find number of characters in string that are before a null byte which 5 | c is used in c for string terminator. 6 | c Return value is >=0 and <= length of string in Fortran sense. 7 | implicit none 8 | integer*4 length 9 | character string*(*) 10 | character NULL_BYTE*(1) 11 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12 | NULL_BYTE = char(0) 13 | length = len (string) ! get Fortran string length 14 | string_len_c = 1 15 | do while (string_len_c .le. length) 16 | if (string(string_len_c:string_len_c) .eq. NULL_BYTE)then 17 | string_len_c = string_len_c - 1 18 | return 19 | end if 20 | string_len_c = string_len_c + 1 21 | end do 22 | string_len_c = string_len_c - 1 23 | return 24 | end ! Integer*4 Function String_len_c ends 25 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/Swap.f: -------------------------------------------------------------------------------- 1 | ! "<23-Jun-1994 22:20:48>" 2 | Subroutine Swap(x,y) 3 | Implicit none 4 | ! parameters 5 | Real*4 x,y 6 | 7 | ! local variables 8 | Real*4 t 9 | 10 | t = x 11 | x = y 12 | y = t 13 | 14 | Return 15 | End ! subroutine Swap ends 16 | ************************************************************************ 17 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/Timz.f: -------------------------------------------------------------------------------- 1 | Function TIMZ(IH,IM,IS) ! Time: IH,IM,IS->seconds 2 | 3 | C Function to convert time from 3 integers (IH,IM,IS) to seconds. 4 | 5 | TIMZ = Float(IH)*3600.0 + Float(IM)*60.0 + Float(IS) 6 | 7 | Return 8 | 9 | End 10 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/Tmcon.f: -------------------------------------------------------------------------------- 1 | Function TMCON(TIME) !Time: hhmmss->seconds 2 | 3 | C Routine to convert time from hhmmss. format to seconds. 4 | 5 | IH = TIME/10000.0 6 | IM= (TIME-Float(IH)*10000.0)/100.0 7 | IS=TIME-Float(IH)*10000.0-Float(IM)*100.0 8 | TMCON=TIMZ(IH,IM,IS) 9 | 10 | Return 11 | End 12 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/Var_Range_Shift.f: -------------------------------------------------------------------------------- 1 | C "<08-Oct-1993 21:54:37>" 2 | ************************************************************************** 3 | Subroutine Var_range_shift(Iarray,Ind,I1,I2,Incre) 4 | c 5 | c This subroutine will do shifting and possible filtering for array 6 | c Iarray (Integer*2). 7 | c Input 8 | c Ind: number, after incrementing, for next slot in Iarray to 9 | c shift to. 10 | c The slots indexed by I1..I2, with increment Incre, will be shifted. 11 | c Incre should be >=1. 12 | c For example 13 | c On entry: 14 | c Iarray(1..16) = 2,4,6,8, 10,12,14,0, -, -, -, -, -, -, -, -, 15 | c Ind =8, I1=4, I2=8, Incre =2 16 | c On exit: 17 | c Iarray(1..16) = 2,4,6,8, 10,12,14,0, 8,12, 0, -, -, -, -, -, 18 | c Ind =11, I1=4, I2=8, Incre =2 19 | c 20 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 21 | 22 | Integer*2 Iarray(*) 23 | 24 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 25 | Do II = I1,I2,Incre 26 | Ind =Ind+1 27 | Iarray(Ind) = Iarray(II) 28 | End Do 29 | Return 30 | End ! subroutine Var_range_Shift ends 31 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/abshm.f: -------------------------------------------------------------------------------- 1 | Function ABSHM(T,DP,Q) 2 | 3 | ABSHM= Q /(461.5E-05*(T+273.16)) 4 | Return 5 | End 6 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/adj.f: -------------------------------------------------------------------------------- 1 | Function ADJ(T,PA,REF) 2 | 3 | ADJ=T+.005577*(PA-REF) 4 | Return 5 | End 6 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/ajust.f: -------------------------------------------------------------------------------- 1 | Function AJUST(TEMP,REFL,PALT,TLAP) 2 | 3 | C Returns A TEMPERATURE ADJUSTED TO A REFERENCE LEVEL IN (DEG C) 4 | C TEMP = TEMPERATURE TO BE ADJUSTED (DEG C) 5 | C REFL = REFERENCE LEVEL (M) 6 | C PALT = PRESSURE ALTITUDE (M) 7 | C TLAP = LAPSE RATED OF TEMPERATURE (DEG C/M) 8 | C TLAP = 0 DEFAULT VALUE,0.005577, IS USED 9 | 10 | If (TLAP.eq.0) TLAP=0.005577 11 | AJUST = TEMP + TLAP*(PALT-REFL) 12 | Return 13 | End 14 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/angle.f: -------------------------------------------------------------------------------- 1 | Function ANGLE(ACAR) 2 | 3 | C Returns THE TRIGONOMETRIC ANGLE (DEG) GIVEN THE CARDINAL ANGLE (DEG) 4 | 5 | A = 450.0 - ACAR 6 | If (A.gt.360.0) A = A - 360.0 7 | ANGLE = A 8 | Return 9 | End 10 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/atn2.f: -------------------------------------------------------------------------------- 1 | Function Atn2(y,x) 2 | 3 | c Routine to compute an arc-tangent from two arguements 4 | 5 | If (x .lt. 0.0001 .and. x .gt. -0.0001) Go To 2 ! x=0 ? 6 | If (y .ge. 0.0) Go To 7 ! y>0? 7 | 8 | Atn2 = 6.283185308 + Atan2(y,x) 9 | Return 10 | 11 | 7 Atn2 = Atan2(y,x) 12 | Return 13 | 14 | 2 If (y) 4,3,5 15 | 16 | 3 Atn2 = 3.141592654 17 | Return 18 | 19 | 4 Atn2 = 4.712388981 20 | Return 21 | 22 | 5 Atn2 = 1.570796327 23 | Return 24 | End 25 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/beam_hgt.f: -------------------------------------------------------------------------------- 1 | Function Beam_Hgt(Range, Elev) 2 | 3 | c Routine to calculate the radar beam height using the 4/3 Earth 4 | C radius technique 5 | 6 | c Input variables: 7 | c Range - Range from radar [km] 8 | c Elev - Elevation angle [deg] from horizontal 9 | 10 | c Beam_Hgt is returned as [km] 11 | 12 | Data Rah/5.885E-5/, Ctr/0.0174532925/ 13 | 14 | c The elevation angle term 15 | 16 | Term1 = Range * Sin(Elev*Ctr) 17 | 18 | c The 4/3 Earth radius of curvature term 19 | 20 | Term2 = Range * Range * Rah * Cos(Elev*Ctr) * Cos(Elev*Ctr) 21 | Beam_Hgt = Term1 + Term2 22 | 23 | Return 24 | End 25 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/chktm.f: -------------------------------------------------------------------------------- 1 | Subroutine CHKTM(T) 2 | 3 | C Routine to check for time flips over midnight 4 | C this will add 24 hours if a flip occurs 5 | 6 | DATA OCN /86400.0/, TMJMP /0.0/, TH /0.0/ 7 | Save Ocn, Th, Tmjmp 8 | 9 | IF (T .lt. 0.0) Return 10 | 11 | IF (T-TH .lt. -86300.0) Go To 1 12 | TH = T 13 | T = T + TMJMP 14 | Return 15 | 16 | 1 TMJMP = OCN 17 | TH = T 18 | T = T + TMJMP 19 | 20 | Return 21 | End 22 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/comp.f: -------------------------------------------------------------------------------- 1 | Subroutine COMP(U,V,WD,WS) 2 | 3 | c Routine to calculate u,v components from the wind direction [deg] 4 | c and speed [m/s] 5 | 6 | C WD WITH RESPECT TO NORTH 7 | 8 | U = Ws * Cos((270.0-Wd)*.0174532925) 9 | V = Ws * Sin((270.0-Wd)*.0174532925) 10 | 11 | Return 12 | End 13 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/cradw.f: -------------------------------------------------------------------------------- 1 | Function CRADW(TANW,RADW,ANGLE) 2 | 3 | C Function to correct radial wind for band crossing angle 4 | 5 | A=ANGLE*0.01745329 6 | CRADW=TANW*SIN(A) + RADW*Cos(A) 7 | Return 8 | End 9 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/ctanw.f: -------------------------------------------------------------------------------- 1 | Function CTANW(TANW,RADW,ANGLE) 2 | 3 | C Function to correct tangential wind for band crossing angle 4 | 5 | A=ANGLE*0.01745329 6 | CTANW=TANW*Cos(A) - RADW*SIN(A) 7 | Return 8 | End 9 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/ctme.f: -------------------------------------------------------------------------------- 1 | Subroutine Ctme (T,Ih,Im,Is) 2 | 3 | c Routine to convert time from seconds to hour,minutes,seconds 4 | 5 | Ih = T/3600.0 ! Hours 6 | Im = (T-Float(Ih)*3600.0)/60.0 ! Minutes 7 | Is = T-Float(Ih)*3600.0-Float(Im)*60.0 8 | Return 9 | 10 | End 11 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/density.f: -------------------------------------------------------------------------------- 1 | Function Density (P,T) 2 | 3 | c Computation of dry air density [g/cm3] 4 | c P is the pressure [mb] 5 | c T is the dry air temperature [degrees C] 6 | 7 | Density = (P * 1000.0) / (2.8704E06 * (T+273.16)) 8 | 9 | Return 10 | End 11 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/detrm.f: -------------------------------------------------------------------------------- 1 | Function DETRM(ARRAY,NORDER) 2 | 3 | C CALCULATE THE DETERMINATE OF A SQUARE MATRIX Function. SAME SOURCE 4 | C AS 'POLFIT'. 5 | 6 | DOUBLE PRECISION ARRAY, SAVE 7 | Dimension ARRAY(20,20) 8 | DETRM = 1.0 9 | 11 DO 50 K=1, NORDER 10 | C INTERCHANGE COLUMNS IF DIAGONAL ELEMENT IS ZERO. 11 | IF (ARRAY(K,K)) 41,21,41 12 | 21 DO 23 J=K,NORDER 13 | IF (ARRAY(K,J)) 31,23,31 14 | 23 Continue 15 | DETRM = 0.0 16 | GOTO 60 17 | 31 DO 34 I=K, NORDER 18 | SAVE = ARRAY(I,J) 19 | ARRAY(I,J) = ARRAY(I,K) 20 | 34 ARRAY(I,K) = SAVE 21 | DETRM =-DETRM 22 | C SUBTRACT ROW K FROM LOWER ROWS TO GET DIAGONAL MATRIX. 23 | 41 DETRM = DETRM*ARRAY(K,K) 24 | IF (K-NORDER) 43,50,50 25 | 43 K1 = K + 1 26 | DO 46 I=K1, NORDER 27 | DO 46 J =K1, NORDER 28 | 46 ARRAY(I,J) = ARRAY(I,J) - ARRAY(I,K)*ARRAY(K,J)/ARRAY(K,K) 29 | 50 Continue 30 | 60 Return 31 | End 32 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/dewpt.f: -------------------------------------------------------------------------------- 1 | Function Dewpt (T,Rh) 2 | 3 | c Function to return the dewpoint given the Temp (C) and 4 | c Relative Humidity (%) 5 | 6 | Q = Vapor(T) * Rh/100.0 7 | Enl = Alog(q) 8 | Dewpt = (243.5*Enl - 440.8)/(19.48-Enl) 9 | Return 10 | End 11 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/diret.f: -------------------------------------------------------------------------------- 1 | Function DIRET(U,V) 2 | 3 | C Returns DIRECTION (TOWARDS) GIVEN U & V COMPONENTS 4 | 5 | PI05 = 1.5707963 6 | PI15 = 4.7123889 7 | A = PI05 8 | If (U.lt.0.0) A = PI15 9 | If (U.eq.0.0) U = .1E-32 10 | DIRET = 57.2958*(A-ATAN(V/U)) 11 | Return 12 | End 13 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/dsedp.f: -------------------------------------------------------------------------------- 1 | Function DSEDP(TEMP,DEWP,ADJT,PRES,PREF,RA,ALAT) 2 | C 3 | C**** THIS Function COMPUTES THE DRY STATIC ENERGY IN UNITS (10**3 J/KG) 4 | C**** DSE = CP*T+PHI 5 | C**** TEMP = AIR TEMPERATURE (DEG.C) 6 | C**** DEWP = DEWPOINT (DEG.C) 7 | C**** ADJT = TEMPERATURE ADJUSTMENT TO THE REFERENCE LEVEL (DEG.C) 8 | C**** PRES = AIR PRESSURE (MB) 9 | C**** PREF = REFERENCE PRESSURE (MB) 10 | C**** RA = RADAR ALTITUDE (M) 11 | C**** ALAT = LATITUDE (RADIAN) 12 | C**** IF ADJT = 0.0 NO ADJUSTMENT IS MADE. 13 | C 14 | TP = TEMP + ADJT 15 | DP = DEWP + ADJT 16 | If ((DP-TP).gt.0.5.and.ADJT.ne.0.0) Go To 2 17 | AW = VAPOR(DP) 18 | AW = 0.622*AW /(PRES-AW ) 19 | TV = (TP+273.15)*((1.0+1.609*AW)/(1.0+AW)) 20 | G = 9.80616*(1.-0.0026373*Cos(2.*ALAT)) 21 | ADRA = 0.0 22 | If (ADJT.eq.0.0) Go To 1 23 | C 24 | C** GEOPOTENTIAL IS BEING ADJUSTED TO THE REFERENCE LEVEL 25 | C 26 | ARA = 286.998*ALOG(PREF/PRES) 27 | ADRA = -(ARA*TV)/(G-ARA*0.5*0.005577) 28 | 1 RH = RA + ADRA 29 | RE = G*648201.1446 30 | PHI = (G*RE*RH)/(RE+RH) 31 | H = 1004.0*(TP + 273.15) 32 | DSEDP =(H + PHI)*0.001 33 | Return 34 | 2 DSEDP = 1.E36 35 | Return 36 | End 37 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/dsegy.f: -------------------------------------------------------------------------------- 1 | Function DSEGY(TEMP,RA,ALAT) 2 | 3 | C**** THIS Function COMPUTES THE DRY STATIC ENERGY IN UNITS (10**3 J/KG) 4 | C**** DSE = CP*T+PHI 5 | C**** TEMP = AIR TEMPERATURE (DEG.C) 6 | C**** RA = RADAR ALTITUDE (M) 7 | C**** ALAT = LATITUDE (RADIAN) 8 | 9 | G = 9.80616*(1.0 - 0.0026373*Cos(2.*ALAT)) 10 | RE = G*648201.1446 11 | PHI = (G*RE*RA)/(RE+RA) 12 | H = 1004.0*(TEMP + 273.15) 13 | DSEGY =(H + PHI)*0.001 14 | Return 15 | End 16 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/epot3.f: -------------------------------------------------------------------------------- 1 | Function EPOT3(TEMP,PRESS,WMR) 2 | 3 | ! Returns EQUIVALENT POTENTIAL TEMPERATURE (DEG C) 4 | ! Given termperature (C0, Pressure [mb], and mixing ration [gm/gm] 5 | DATA M, C1, C2Kelvin /1, 2.64, 273.16/ 6 | 7 | R = 621.98*((WMR*PRESS)/621.98)/(PRESS-(WMR*PRESS)/621.98) 8 | EE=(WMR*PRESS)/621.98 9 | 10 | ! TETONS FORMULA 11 | 12 | THETA = (TEMP + C2Kelvin) * ((1000./PRESS)**0.28544) 13 | 14 | DO j = 1, 2 15 | THETE=THETA*EXP(C1*R/(TLCL2(TEMP,PRESS,WMR)+C2Kelvin)) 16 | C1=2.627+.0003*(THETE-300.) 17 | End Do 18 | 19 | EPOT3 = THETE - C2Kelvin 20 | Return 21 | 22 | End 23 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/epott.f: -------------------------------------------------------------------------------- 1 | Function EPOTT(TEMP,DEWP,PRESS) 2 | WMR = 6.11*(10.0**(7.5*DEWP/(237.3+DEWP))) 3 | WMR = 621.98*WMR/(PRESS - WMR) 4 | TL = TLCL2(TEMP,PRESS,WMR)+273.16 5 | A = (TEMP+273.16)*((1000.0+1.6078*WMR)/PRESS)**0.28544 6 | B = EXP((3.1329-0.00237*TL)*(WMR/TL)) 7 | C = EXP(EXP(1.62*ALOG(A*B)+14.3*ALOG(TL)-96.0)) 8 | EPOTT = A*B*C - 273.16 9 | Return 10 | End 11 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/fchar.f90: -------------------------------------------------------------------------------- 1 | Subroutine fchar(string) 2 | 3 | ! Routine to blank out non-charactes in a string 4 | 5 | Character String*(*) 6 | 7 | nch = Len(String) 8 | 9 | Do i = 1, nch 10 | If (String(i:i) .lt. ' ') String(i:i) = ' ' 11 | End Do 12 | 13 | End Subroutine fchar 14 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/fchs.f: -------------------------------------------------------------------------------- 1 | Function Fchs(Time) 2 | 3 | T = Aint(Time) 4 | Fchs = T + (Time-T)/0.6 5 | Return 6 | 7 | End 8 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/fmixd.f: -------------------------------------------------------------------------------- 1 | Function Fmixd (Dp,Press) 2 | 3 | C Returns MIXING RATIO IN (G/KG) 4 | C DP DEWPOINT (DEG C) 5 | C PRESS = PRESSURE (MB) 6 | 7 | E = VAPOR(DP) 8 | FMIXD = 621.98*E/(PRESS-E) 9 | 10 | Return 11 | End 12 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/fmixr.f: -------------------------------------------------------------------------------- 1 | Function FMIXR(TEMP,PRESS,RH) 2 | 3 | C Returns MIXING RATIO IN (G/KG) 4 | C TEMP = TEMPERATURE (DEG C) 5 | C PRESS = PRESSURE (MB) 6 | C RH = RELATIVE HUMIDITY (%) 7 | 8 | FMIXR = STMIX(TEMP,PRESS)*RH*0.01 9 | Return 10 | End 11 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/linft.f: -------------------------------------------------------------------------------- 1 | Subroutine Linft (X, Y, Npts, A, SigmaA, B, SigmaB, R, Bad) 2 | 3 | C Routine TO MAKE A LEAST SQUARES LINEAR FIT OF X AND Y 4 | c to the formula y = A + Bx 5 | 6 | DOUBLE PRECISION Sum, SumX, SumY, SumX2, SumXY, SumY2 7 | DOUBLE PRECISION X1, Y1, DELTA, VARNCE 8 | 9 | Dimension X(Npts), Y(Npts) 10 | 11 | Sum = 0.0 12 | SumX = 0.0 13 | SumY = 0.0 14 | SumX2 = 0.0 15 | SumXY = 0.0 16 | SumY2 = 0.0 17 | Mpts = 0 18 | 19 | Do i = 1, Npts 20 | If (X(i) .eq. Bad .or. Y(i) .eq. Bad) Cycle 21 | Mpts = Mpts + 1 22 | X1 = X(I) 23 | Y1 = Y(I) 24 | Sum = Sum + 1.0 25 | SumX = SumX + X1 26 | SumY = SumY + Y1 27 | SumX2 = SumX2 + X1*X1 28 | SumY2 = SumY2 + Y1*Y1 29 | SumXY = SumXY + X1*Y1 30 | End Do 31 | 32 | If (Mpts .lt. 3) Then 33 | A = Bad 34 | B = Bad 35 | SigmaA = Bad 36 | SigmaB = Bad 37 | R = Bad 38 | Else 39 | DELTA = Sum*SumX2 - SumX*SumX 40 | A = (SumX2*SumY-SumX*SumXY)/DELTA 41 | B = (SumXY*Sum-SumX*SumY)/DELTA 42 | 43 | C = Mpts-2 44 | VARNCE = (SumY2+A*A*Sum+B*B*SumX2-2.0*(A*SumY+B*SumXY-A*B*SumX))/C 45 | SIGMAA = Dsqrt(Dabs(VARNCE*SumX2/DELTA)) 46 | SIGMAB = Dsqrt(Dabs(VARNCE*Sum /DELTA)) 47 | R = (Sum*SumXY-SumX*SumY)/DSQRT(DELTA*(Sum*SumY2-SumY*SumY)) 48 | End If 49 | 50 | Return 51 | End 52 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/patop.f: -------------------------------------------------------------------------------- 1 | Function PATOP(PA) 2 | 3 | PATOP=1013.25*(1.0 - PA/44331.0)**5.25588265 4 | Return 5 | End 6 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/polft.f: -------------------------------------------------------------------------------- 1 | Subroutine POLFT(X,Y,Npts,NTERMS,A) 2 | 3 | C LEAST-SQUARES FIT TO A POLYNOMIAL FROM 'DATA REDUCTION AND ERROR 4 | C ANALYSIS FOR THE PHYSICAL SCIENCES BY PHILIP R. BEVINGTON. 5 | C COPYRIGHT 1969 MC GRAW-HILL INC. PP 140-142, 294. 6 | C*********************************************************************** 7 | C MAXIMUM NUMBER OF TERMS=20 8 | 9 | DOUBLE PRECISION SumX,SumY,XTERM,YTERM,ARRAY 10 | Dimension X(Npts),Y(Npts),A(NTERMS) 11 | Dimension SumX(29),SumY(20),ARRAY(20,20) 12 | 13 | C ACCUMULATE WEIGHTED SumS. 14 | 15 | WEIGHT=1 16 | 11 NMAX=NTERMS*2-1 17 | DO 13 N=1,NMAX 18 | 13 SumX(N)=0. 19 | DO 15 J=1,NTERMS 20 | 15 SumY(J)=0. 21 | 21 DO 50 I=1,Npts 22 | XI=X(I) 23 | YI=Y(I) 24 | XTERM=WEIGHT 25 | DO 44 N = 1,NMAX 26 | SumX(N) = SumX(N) +XTERM 27 | 44 XTERM=XTERM*XI 28 | 45 YTERM=YI 29 | DO 48 N=1,NTERMS 30 | SumY(N) = SumY(N) +YTERM 31 | 48 YTERM=YTERM*XI 32 | 50 Continue 33 | C CONSTRUCT MATRICES AND CALCULATE COEFFICIENTS. 34 | 51 DO 54 J=1,NTERMS 35 | DO 54 K=1,NTERMS 36 | N=J+K-1 37 | 54 ARRAY(J,K)=SumX(N) 38 | DELTA=DETRM(ARRAY,NTERMS) 39 | If (DELTA)61,57,61 40 | 57 CHISQR = 0. 41 | DO 59 J=1,NTERMS 42 | 59 A(J)=0. 43 | Go To 80 44 | 61 DO 70 L=1,NTERMS 45 | 62 DO 66 J=1,NTERMS 46 | DO 65 K=1,NTERMS 47 | N=J+K-1 48 | 65 ARRAY(J,K)=SumX(N) 49 | 66 ARRAY(J,L)=SumY(J) 50 | 70 A(L)=DETRM(ARRAY,NTERMS)/DELTA 51 | 80 Return 52 | End 53 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/potm.f: -------------------------------------------------------------------------------- 1 | Function POTM(TEMP,PRESS,WMR) 2 | 3 | C Returns THE POTENTIAL TEMPERATURE OF MOIST AIR 4 | C TEMP = TEMPERATURE (DEG C) 5 | C PRESS = PRESSURE (MB) 6 | C WMR = MIXING RATIO (G/KG) 7 | 8 | A = 0.28544*(1.0-0.245*WMR*0.001) 9 | POTM = (TEMP+273.16)*(1000.0/PRESS)**A - 273.16 10 | 11 | Return 12 | End 13 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/pott.f: -------------------------------------------------------------------------------- 1 | Function POTT(TEMP,PRESS) 2 | 3 | C Returns THE POTENTIAL TEMPERATUE (DEG C) 4 | C TEMP = TEMPERATURE (DEG C) 5 | C PRESS = PRESSURE (MB) 6 | 7 | POTT = (TEMP+273.16)*(1000.0/PRESS)**0.286714-273.16 8 | 9 | Return 10 | End 11 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/potvt.f: -------------------------------------------------------------------------------- 1 | Function POTVT(TEMP,PRESS,WMR) 2 | 3 | C Returns THE POTENTIAL VIRTUAL TEMPERATURE (DEG C) 4 | C TEMP = TEMPERATURE (DEG C) 5 | C PRESS = PRESSURE (MB) 6 | C WMR = MIXING RATIO (G/KG) 7 | 8 | w = wmr*0.001 9 | TV = (TEMP+273.16)*((1.0+1.609*W)/(1.0+w)) - 273.16 10 | POTVT = POTT(TV,PRESS) 11 | 12 | Return 13 | End 14 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/ptopa.f: -------------------------------------------------------------------------------- 1 | Function PTOPA(P) 2 | 3 | PTOPA=44331.*(1.0-(P/1013.25)**.190263) 4 | Return 5 | End 6 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/radw.f: -------------------------------------------------------------------------------- 1 | Function RADW(VLAT,VLON,U,V) 2 | 3 | R=SQRT(VLAT*VLAT + VLON*VLON) 4 | IF (R .eq. 0.0) Go To 1 5 | RADW=(VLON*U+VLAT*V)/R 6 | Return 7 | 1 RADW=0.0 8 | Return 9 | End 10 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/rhumd.f: -------------------------------------------------------------------------------- 1 | Function RHUMD(TEMP,PRESS,DP) 2 | 3 | C Returns RELATIVE HUMIDITY (%) 4 | C TEMP = TEMPERATURE (DEG C) 5 | C PRESS = PRESSURE (MB) 6 | C DP = DEWPOINT (DEG C) 7 | 8 | RHUMD = 100.*FMIXD(DP,PRESS)/STMIX(TEMP,PRESS) 9 | 10 | Return 11 | End 12 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/rhumw.f: -------------------------------------------------------------------------------- 1 | Function RHUMW(TEMP,PRESS,WMR) 2 | 3 | C Returns RELATIVE HUMIDTY (%) 4 | C TEMP = TEMPERATURE (DEG C) 5 | C PRESS = PRESSURE (MB) 6 | C WMR = MIXING RATIO (G/KG) 7 | 8 | RHUMW = 100.0*WMR/STMIX(TEMP,PRESS) 9 | Return 10 | End 11 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/sept.f: -------------------------------------------------------------------------------- 1 | Function Sept (Temp,Dp,Press) 2 | 3 | c Routine to compute equivalent potential temperature using 4 | c the Simpson method (handles tropical air better) 5 | c Input variables are Temp = Temperature [C], Dp = Dewpoint temperature [C] 6 | c and Press = Pressure [mb] 7 | 8 | If (Temp .lt. -40.0 .or. Temp .gt. 100.0) Go To 1 9 | If (Dp .lt. -40.0 .or. Dp .gt. 100.0) Go To 1 10 | If (Press .lt. 100.0 .or. Press .gt. 1100.0) Go To 1 11 | 12 | Q=6.11*(10.0**(7.5*DP/(237.3+DP))) 13 | WMR=621.98*Q/(PRESS-Q) 14 | TL = TLCL2(TEMP,PRESS,WMR)+273.16 15 | A = (TEMP+273.16)*((1000.0+1.6078*WMR)/PRESS)**0.28544 16 | B = EXP((3.1329-0.00237*TL)*(WMR/TL)) 17 | C = EXP(EXP(1.62*ALOG(A*B)+14.3*ALOG(TL)-96.0)) 18 | Sept = A*B*C 19 | Return 20 | 21 | 1 Sept = 1.E36 22 | Return 23 | 24 | End 25 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/sfcp.f: -------------------------------------------------------------------------------- 1 | Function SfcP (T, Td, GA, P) 2 | 3 | c Routine to compute surface pressure by extrapolation of the d-value 4 | c to the surface using the standard atmospheric lapse rate 5 | 6 | c T - Ambient Temperature (deg C) 7 | c TD - Dew Point Temperature (deg C) 8 | c P - Static Pressure (mb) 9 | c GA - Geopotential altitude 10 | c SfcP - the estimated surface pressure 11 | 12 | c Calculate Temperature in K 13 | Temp = T + 273.16 14 | 15 | c What is the vapor pressure? 16 | W = Vp(Td) 17 | 18 | c What is the mixing ratio? 19 | Q = 0.622*W/(P-W) 20 | 21 | c What is the virtual temperature? 22 | Tv = Temp*((1.0+1.609*Q)/(1.0+Q)) 23 | 24 | c What is the pressure altitude? 25 | Pa = PtoPA (P) 26 | 27 | c What would be the temperature at our height if we were in 28 | c at "standard atmosphere"? 29 | Tsa = 288.16 - 0.0065 * PA 30 | 31 | c Extrapolate the d-value (with a temperature correction) down to 32 | c z=0 to see what the surface pressure (SfcP) would be 33 | Pas = PA-GA * TSA/TV 34 | Sfcp = 1013.25*(1.0-PAS/44331.0)**5.25588 35 | 36 | Return 37 | End 38 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/speed.f: -------------------------------------------------------------------------------- 1 | Function SPEED(U,V) 2 | 3 | C Returns WIND SPEED GIVEN THE U & V COMPONENTS 4 | 5 | SPEED = SQRT(U*U+V*V) 6 | Return 7 | End 8 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/sphum.f: -------------------------------------------------------------------------------- 1 | Function SPHUM(DP,PRESS) 2 | 3 | C Returns SPECIFIC HUMIDTY IN (G/KG) 4 | C DP DEWPOINT (DEG C) 5 | C PRESS = PRESSURE (MB) 6 | 7 | E = VAPOR(DP) 8 | SPHUM = 621.98*E/(PRESS-0.37803*E) 9 | Return 10 | End 11 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/stmix.f: -------------------------------------------------------------------------------- 1 | Function STMIX(TEMP,PRESS) 2 | 3 | C Returns SATURATED MIXING RATIO (G/KG) 4 | C TEMP = TEMPERATURE (DEG C) 5 | C PRESS = PRESSURE (MB) 6 | 7 | ES = VAPOR(TEMP) 8 | STMIX = 621.98*ES/(PRESS-ES) 9 | Return 10 | End 11 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/tanw.f: -------------------------------------------------------------------------------- 1 | Function TANW(VLAT,VLON,U,V) 2 | 3 | R=SQRT(VLAT*VLAT+VLON*VLON) 4 | IF (R .eq. 0.0) Go To 1 5 | TANW=(VLON*V-VLAT*U)/R 6 | Return 7 | 1 TANW=0.0 8 | Return 9 | End 10 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/tcnvt.f: -------------------------------------------------------------------------------- 1 | Subroutine Tcnvt(Itime, Ih, Im, Is) ! Time: hhmmss->HH MM SS 2 | 3 | C Routine to convert time from hhmmss. format to hours, min, & secs 4 | 5 | IH = ITIME/10000 6 | IM = (ITIME - IH*10000)/100 7 | IS = ITIME - IH*10000 - IM*100 8 | 9 | Return 10 | End 11 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/tlcl2.f: -------------------------------------------------------------------------------- 1 | Function TLCL2(TEMP,PRESS,WMR) 2 | 3 | Dimension DT(8) 4 | DATA DT/1.5,.75,0.37,0.2,0.1,0.05,0.025,0.005/ 5 | DATA RES/1.0/,R1/1.0/,R2/1.0/,I/1/ 6 | T = TEMP + 273.16 7 | E = WMR*0.001*PRESS/(WMR*0.001+0.62198) 8 | A = 3.5*ALOG(T)-ALOG(E)-4.805 9 | TC= 2840.0/A+55.0 10 | RKM = 1.0/(0.28544*(1.0-0.245*WMR*0.001)) 11 | DO 50 K = 1,500 12 | R1 = SIGN(R1,RES) 13 | X = 6.11*(WMR+621.95)/(WMR*PRESS) 14 | Y = (T/TC)**RKM 15 | Z = 7.5*(TC-273.15)/(TC-35.85) 16 | RES = ALOG10(X*Y) + Z 17 | If (ABS(RES).le.0.005) Go To 100 18 | R2 = SIGN(R2,RES) 19 | If (SIGN(R1,R2).ne.SIGN(R2,R1)) I = I+1 20 | If (I.gt.8) I = 8 21 | TC = TC -R2*DT(I) 22 | 50 Continue 23 | 100 TLCL2 = TC-273.16 24 | Return 25 | End 26 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/tvird.f: -------------------------------------------------------------------------------- 1 | Function Tvird(Temp,Press,Dp) 2 | 3 | C Returns THE VIRTUAL TEMPERATURE (DEG C) 4 | C TEMP = TEMPERATURE (DEG C) 5 | C PRESS = PRESSURE (MB) 6 | C DP = DEWPOINT (DEG C) 7 | 8 | W = Fmixd(Dp,Press)*0.001 9 | Tvird = (Temp+273.16)*((1.0+1.609*W)/(1.0+W)) - 273.16 10 | 11 | Return 12 | End 13 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/tvirr.f: -------------------------------------------------------------------------------- 1 | Function Tvirr(Temp,Press,Rh) 2 | 3 | C TEMP = TEMPERATURE (DEG C) 4 | C PRESS = PRESSURE (MB) 5 | C RH = RELATIVE HUMIDITY (%) 6 | 7 | W = Fmixr(Temp,Press,Rh)*0.001 8 | Tvirr = (TEMP+273.16)*((1.0+1.609*W)/(1.0+W)) - 273.16 9 | 10 | Return 11 | End 12 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/ucomp.f: -------------------------------------------------------------------------------- 1 | Function UCOMP(WS,WD) 2 | 3 | C Returns THE U COMPONENT (EASTERLY) OF THE WIND 4 | C WS = WIND SPEED (M/S) 5 | C WD = WIND DIRECTION (DEG) 6 | 7 | A = ANGLE(WD) + 180.0 8 | If (A.gt.360.0) A = A - 360.0 9 | UCOMP = WS * Cos(A*0.01745329) 10 | Return 11 | End 12 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/vapor.f: -------------------------------------------------------------------------------- 1 | Function VAPOR(TT) 2 | 3 | C Returns VAPOUR PRESSURE IF TT = DEWPOINT (MB) 4 | C Returns SATURATED VAPOUR PRESSURE IF TT = TEMPERATURE (MB) 5 | C TT = TEMPERATURE (DEG C) 6 | 7 | T= TT+273.16 8 | 9 | If (t .lt. 0.0) Then 10 | vapor = 0.0 11 | Return 12 | End if 13 | 14 | VAPOR = 10.0**(22.5518-(2937.4/T)-4.9283*ALOG10(T))*10. 15 | Return 16 | End 17 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/vcomp.f: -------------------------------------------------------------------------------- 1 | Function VCOMP(WS,WD) 2 | 3 | C Returns THE V COMPONENT (NORTHERLY) OF THE WIND 4 | C WS = WIND SPEED (M/S) 5 | C WD = WIND DIRECTION (DEG) 6 | 7 | A = ANGLE(WD) + 180.0 8 | If (A.gt.360.0) A = A - 360.0 9 | VCOMP = WS * SIN(A*0.01745329) 10 | Return 11 | End 12 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/vp.f: -------------------------------------------------------------------------------- 1 | Function VP(T) 2 | 3 | TT=T+273.16 4 | VP=10.0**(22.5518- (2937.4/TT) -4.9283*ALOG10(TT))*10.0 5 | Return 6 | End 7 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/wcomp.f: -------------------------------------------------------------------------------- 1 | Function WCOMP(U,V,DIR) 2 | 3 | C Returns THE WIND COMPONENT ALONG A GIVEN CARDINAL DIRECTION 4 | C U,V WIND COMPONENTS ALONG EASTERLY,NORTHERLY DIRECTIONS 5 | C DIR = CARIDINAL DIRECTION (DEG) 6 | 7 | ANG = ANGLE(DIR) * 0.0174532925 8 | WCOMP = U * Cos(ANG) + V * SIN(ANG) 9 | Return 10 | End 11 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/wdir.f: -------------------------------------------------------------------------------- 1 | Function WDIR(U,V) 2 | 3 | C Returns THE WIND DIRECTION (FROM) GIVEN THE U & V COMPONENTS 4 | 5 | PI15 = 4.7123889 6 | PI05 = 1.5707963 7 | A = PI15 8 | If (U.lt.0.0) A = PI05 9 | If (U.eq.0.0) U = .1E-32 10 | WDIR = 57.2958*(A-ATAN(V/U)) 11 | Return 12 | End 13 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/wlap.f: -------------------------------------------------------------------------------- 1 | Function WLAP(TEMP,PRESS) 2 | C 3 | DOUBLE PRECISION F0,F1,F2 4 | C 5 | C TEMP = TEMPERATURE (DEG C) 6 | C PRESS = PRESSURE (MB) 7 | C WLAP = MOIST LAPSE RATE (DEG C/MB) 8 | H = (2500.-2.274*TEMP)*1000.0 9 | ES = VAPOR(TEMP) 10 | WS = 0.62198*ES/(PRESS-ES) 11 | F0 = H/(TEMP+273.16) 12 | F1 = 286.998+WS*F0 13 | F2 = 1004.*286.998+0.62198*WS*F0*F0 14 | WLAP = F1*286.998*(TEMP+273.16)/(PRESS*F2) 15 | Return 16 | End 17 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/wsedp.f: -------------------------------------------------------------------------------- 1 | Function WSEDP(TEMP,DEWP,ADJT,PRES,PREF,RA,ALAT) 2 | C 3 | C**** THIS Function COMPUTES THE DRY STATIC ENERGY IN UNITS (10**3 J/KG) 4 | C**** WSE = CP*T+PHI+L*W 5 | C**** TEMP = AIR TEMPERATURE (DEG.C) 6 | C**** DEWP = DEWPOINT (DEG.C) 7 | C**** ADJT = TEMPERATURE ADJUSTMENT TO THE REFERENCE LEVEL (DEG.C) 8 | C**** PRES = AIR PRESSURE (MB) 9 | C**** PREF = REFERENCE PRESSURE (MB) 10 | C**** RA = RADAR ALTITUDE (M) 11 | C**** ALAT = LATITUDE (RADIAN) 12 | C**** IF ADJT = 0.0 NO ADJUSTMENT IS MADE. 13 | TP = TEMP + ADJT 14 | DP = DEWP + ADJT 15 | If ((DP-TP).gt.0.5.and.ADJT.ne.0.0) Go To 2 16 | AW = VAPOR(DP) 17 | AW = 0.622*AW /(PRES-AW ) 18 | TV = (TP+273.15)*((1.0+1.609*AW)/(1.0+AW)) 19 | G = 9.80616*(1.-0.0026373*Cos(2.*ALAT)) 20 | ADRA = 0.0 21 | If (ADJT.eq.0.0) Go To 1 22 | C 23 | C** GEOPOTENTIAL IS BEING ADJUSTED TO THE REFERENCE LEVEL 24 | C 25 | ARA = 286.998*ALOG(PREF/PRES) 26 | ADRA = -(ARA*TV)/(G-ARA*0.5*0.005577) 27 | 1 RH = RA + ADRA 28 | RE = G*648201.1446 29 | PHI = (G*RE*RH)/(RE+RH) 30 | H = 1004.0*(TP + 273.15) 31 | HL = (2500.-2.274*TP)*1000.*AW 32 | WSEDP =(H+PHI+HL)*0.001 33 | Return 34 | 2 WSEDP = 1.E36 35 | Return 36 | End 37 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/wsemr.f: -------------------------------------------------------------------------------- 1 | Function WSEMR(TEMP,QRAT,RA,ALAT) 2 | C 3 | C**** THIS Function COMPUTES THE DRY STATIC ENERGY IN UNITS (10**3 J/KG) 4 | C**** WSE = CP*T+PHI+L*W 5 | C**** TEMP = AIR TEMPERATURE (DEG.C) 6 | C**** QRAT = MIXING RATIO (G/KG) 7 | C**** PRES = AIR PRESSURE (MB) 8 | C**** RA = RADAR ALTITUDE (M) 9 | C**** ALAT = LATITUDE (RADIAN) 10 | C 11 | C 12 | If (QRAT.lt.0.) Go To 2 13 | AW = QRAT*.001 14 | G = 9.80616*(1.-0.0026373*Cos(2.*ALAT)) 15 | RE = G*648201.1446 16 | PHI = (G*RE*RA)/(RE+RA) 17 | H = 1004.0*(TEMP + 273.15) 18 | HL = (2500.-2.274*TEMP)*1000.*AW 19 | WSEMR =(H+PHI+HL)*0.001 20 | Return 21 | 2 WSEMR = 1.E36 22 | Return 23 | End 24 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/wsesh.f: -------------------------------------------------------------------------------- 1 | Function WSESH(TEMP,SPHM,RA,ALAT) 2 | C 3 | C**** THIS Function COMPUTES THE DRY STATIC ENERGY IN UNITS (10**3 J/KG) 4 | C**** WSE = CP*T+PHI+L*W 5 | C**** TEMP = AIR TEMPERATURE (DEG.C) 6 | C**** SPHM = SPECIFIC HUMIDITY (G/KG) 7 | C**** RA = RADAR ALTITUDE (M) 8 | C**** ALAT = LATITUDE (RADIAN) 9 | C 10 | C 11 | If (SPHM.lt.0.) Go To 2 12 | AW = 0.001* SPHM/(1-SPHM*0.001) ! MIXING RATIO 13 | G = 9.80616*(1.-0.0026373*Cos(2.*ALAT)) 14 | RE = G*648201.1446 15 | PHI = (G*RE*RA)/(RE+RA) 16 | H = 1004.0*(TEMP + 273.15) 17 | HL = (2500.-2.274*TEMP)*1000.*AW 18 | WSESH =(H+PHI+HL)*0.001 19 | Return 20 | 2 WSESH = 1.E36 21 | Return 22 | End 23 | -------------------------------------------------------------------------------- /awot/src/libs/libdpj/xdist.f: -------------------------------------------------------------------------------- 1 | Function XDIST(XLON,CLON,PLAT) 2 | 3 | C*** Returns DISTANCE (+/-) OF THE POINT(XLON,PLAT) FROM THE ORIGIN 4 | C*** (CLON,PLAT) ON THE CONSTANT LATITUDE LINE ,PLAT 5 | 6 | CONS = 0.017453292 7 | RCOS = 6378.388 * Cos(PLAT*CONS) 8 | XM = 1.0 9 | If (XLON.lt.CLON) XM = -1.0 10 | DL = ABS( CLON - XLON ) * CONS 11 | XDIST = RCOS * DL *XM 12 | Return 13 | End 14 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg.so: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nguy/AWOT/cf1a9f7632382a289063ee6e9c401222e2e10791/awot/src/libs/libtmg.so -------------------------------------------------------------------------------- /awot/src/libs/libtmg/acosde.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION ACOSDE(XIN) 2 | 3 | C Thomas Matejka NOAA/NSSL 14 July 1995 4 | 5 | C This function returns the arccosine of XIN in degrees in the range 6 | C [0.,180.]. 7 | 8 | C If XIN is greater than 1. or less than -1., then XIN is assumed to be 9 | C 1. or -1.. 10 | 11 | IMPLICIT NONE 12 | INCLUDE 'include_constants.inc' 13 | REAL XIN,X 14 | 15 | IF(ABS(XIN).GT.1.)THEN 16 | X=SIGN(1.,XIN) 17 | ELSE 18 | X=XIN 19 | ENDIF 20 | ACOSDE=ACOS(X)*DEGRAD 21 | RETURN 22 | END 23 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/ainthi.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION AINTHI(A) 2 | 3 | C Thomas Matejka NOAA/NSSL 18 February 1993 4 | 5 | C This function returns A rounded up to a whole number. 6 | 7 | C 3.2 becomes 4., and -3.2 becomes -3.. 8 | 9 | IMPLICIT NONE 10 | REAL A 11 | 12 | AINTHI=AINT(A) 13 | IF(A.GT.0..AND. 14 | $AINTHI.NE.A)THEN 15 | AINTHI=AINTHI+1. 16 | ENDIF 17 | RETURN 18 | END 19 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/aintlo.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION AINTLO(A) 2 | 3 | C Thomas Matejka NOAA/NSSL 18 February 1993 4 | 5 | C This function returns A rounded down to a whole number. 6 | 7 | C 3.2 becomes 3., and -3.2 becomes -4.. 8 | 9 | IMPLICIT NONE 10 | REAL A 11 | 12 | AINTLO=AINT(A) 13 | IF(A.LT.0..AND. 14 | $AINTLO.NE.A)THEN 15 | AINTLO=AINTLO-1. 16 | ENDIF 17 | RETURN 18 | END 19 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/aintout.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION AINTOUT(A) 2 | 3 | C Thomas Matejka NOAA/NSSL 18 February 1993 4 | 5 | C This function returns A rounded out to a whole number. 6 | 7 | C 3.2 becomes 4., and -3.2 becomes -4.. 8 | 9 | IMPLICIT NONE 10 | REAL A 11 | 12 | AINTOUT=AINT(A) 13 | IF(AINTOUT.NE.A)THEN 14 | AINTOUT=AINTOUT+SIGN(1.,A) 15 | ENDIF 16 | RETURN 17 | END 18 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/append_float.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE APPEND_FLOAT(NBLANKS,A,NDECPT,OUTSTRING) 2 | 3 | C Thomas Matejka NOAA/NSSL 26 March 1993 4 | 5 | C This subroutine writes NBLANKS blanks and the floating-point number A 6 | C left justified into the string OUTSTRING starting after the last 7 | C non-blank character. The number is written with NDECPT digits after 8 | C the decimal point. The rest of OUTSTRING is filled with blanks. 9 | 10 | IMPLICIT NONE 11 | INCLUDE 'tmmlib.inc' 12 | CHARACTER*(MAX_NUMBER_STRING) STORE 13 | CHARACTER*(*) OUTSTRING 14 | INTEGER NBLANKS,NDECPT,NCHAR 15 | REAL A 16 | 17 | CALL LOAD_FLOAT(A,NDECPT,STORE,NCHAR) 18 | CALL APPEND_STRING(NBLANKS,STORE(1:NCHAR),OUTSTRING) 19 | RETURN 20 | END 21 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/append_float_signif.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE APPEND_FLOAT_SIGNIF(NBLANKS,A,NSIG,OUTSTRING) 2 | 3 | C Thomas Matejka NOAA/NSSL 26 March 1993 4 | 5 | C This subroutine writes NBLANKS blanks and the floating-point number A 6 | C left justified into the string OUTSTRING starting after the last 7 | C non-blank character. The number is written with NSIG significant 8 | C digits. The rest of OUTSTRING is filled with blanks. 9 | 10 | IMPLICIT NONE 11 | INCLUDE 'tmmlib.inc' 12 | CHARACTER*(MAX_NUMBER_STRING) STORE 13 | CHARACTER*(*) OUTSTRING 14 | INTEGER NBLANKS,NSIG,NCHAR 15 | REAL A 16 | 17 | CALL LOAD_FLOAT_SIGNIF(A,NSIG,STORE,NCHAR) 18 | CALL APPEND_STRING(NBLANKS,STORE(1:NCHAR),OUTSTRING) 19 | RETURN 20 | END 21 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/append_float_signif_trunc.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE APPEND_FLOAT_SIGNIF_TRUNC(NBLANKS,A,NSIG_MAX,OUTSTRING) 2 | 3 | C Thomas Matejka NOAA/NSSL 26 March 1993 4 | 5 | C This subroutine writes NBLANKS blanks and the floating-point number A 6 | C left justified into the string OUTSTRING starting after the last 7 | C non-blank character. The number is written with a maximum of 8 | C NSIG_MAX significant digits. Trailing zeroes are not written. The 9 | C decimal point is not written if no digits follow it. The rest of 10 | C OUTSTRING is filled with blanks. 11 | 12 | IMPLICIT NONE 13 | INCLUDE 'tmmlib.inc' 14 | CHARACTER*(MAX_NUMBER_STRING) STORE 15 | CHARACTER*(*) OUTSTRING 16 | INTEGER NBLANKS,NSIG_MAX,NCHAR 17 | REAL A 18 | 19 | CALL LOAD_FLOAT_SIGNIF_TRUNC(A,NSIG_MAX,STORE,NCHAR) 20 | CALL APPEND_STRING(NBLANKS,STORE(1:NCHAR),OUTSTRING) 21 | RETURN 22 | END 23 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/append_float_trunc.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE APPEND_FLOAT_TRUNC(NBLANKS,A,NDECPT_MAX,OUTSTRING) 2 | 3 | C Thomas Matejka NOAA/NSSL 26 March 1993 4 | 5 | C This subroutine writes NBLANKS blanks and the floating-point number A 6 | C left justified into the string OUTSTRING starting after the last 7 | C non-blank character. The number is written with a maximum of 8 | C NDECPT_MAX digits after the decimal point. Trailing zeroes are not 9 | C written. The decimal point is not written if no digits follow it. 10 | C The rest of OUTSTRING is filled with blanks. 11 | 12 | IMPLICIT NONE 13 | INCLUDE 'tmmlib.inc' 14 | CHARACTER*(MAX_NUMBER_STRING) STORE 15 | CHARACTER*(*) OUTSTRING 16 | INTEGER NBLANKS,NDECPT_MAX,NCHAR 17 | REAL A 18 | 19 | CALL LOAD_FLOAT_TRUNC(A,NDECPT_MAX,STORE,NCHAR) 20 | CALL APPEND_STRING(NBLANKS,STORE(1:NCHAR),OUTSTRING) 21 | RETURN 22 | END 23 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/append_integer.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE APPEND_INTEGER(NBLANKS,K,OUTSTRING) 2 | 3 | C Thomas Matejka NOAA/NSSL 26 March 1993 4 | 5 | C This subroutine writes NBLANKS blanks and the integer K left 6 | C justified into the string OUTSTRING starting after the last non-blank 7 | C character. The rest of OUTSTRING is filled with blanks. 8 | 9 | IMPLICIT NONE 10 | INCLUDE 'tmmlib.inc' 11 | CHARACTER*(MAX_NUMBER_STRING) STORE 12 | CHARACTER*(*) OUTSTRING 13 | INTEGER NBLANKS,K,NCHAR 14 | 15 | CALL LOAD_INTEGER(K,STORE,NCHAR) 16 | CALL APPEND_STRING(NBLANKS,STORE(1:NCHAR),OUTSTRING) 17 | RETURN 18 | END 19 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/append_scientific.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE APPEND_SCIENTIFIC(NBLANKS,A,NDECPT,OUTSTRING) 2 | 3 | C Thomas Matejka NOAA/NSSL 26 March 1993 4 | 5 | C This subroutine writes NBLANKS blanks and the floating-point number A 6 | C left justified into the string OUTSTRING starting after the last 7 | C non-blank character. The number is written in scientific notation 8 | C with NDECPT digits after the decimal point. The rest of OUTSTRING is 9 | C filled with blanks. 10 | 11 | IMPLICIT NONE 12 | INCLUDE 'tmmlib.inc' 13 | CHARACTER*(MAX_NUMBER_STRING) STORE 14 | CHARACTER*(*) OUTSTRING 15 | INTEGER NBLANKS,NDECPT,NCHAR 16 | REAL A 17 | 18 | CALL LOAD_SCIENTIFIC(A,NDECPT,STORE,NCHAR) 19 | CALL APPEND_STRING(NBLANKS,STORE(1:NCHAR),OUTSTRING) 20 | RETURN 21 | END 22 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/append_scientific_ncarg.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE APPEND_SCIENTIFIC_NCARG(NBLANKS,A,NDECPT,OUTSTRING) 2 | 3 | C Thomas Matejka NOAA/NSSL 13 May 1994 4 | 5 | C This subroutine writes NBLANKS blanks and the floating-point number A 6 | C left justified into the string OUTSTRING starting after the last 7 | C non-blank character. The number is written in ncargraphics 8 | C scientific notation with NDECPT digits after the decimal point. The 9 | C rest of OUTSTRING is filled with blanks. 10 | 11 | IMPLICIT NONE 12 | INCLUDE 'tmmlib.inc' 13 | CHARACTER*(MAX_STRING) STORE 14 | CHARACTER*(*) OUTSTRING 15 | INTEGER NBLANKS,NDECPT,NCHAR 16 | REAL A 17 | 18 | CALL LOAD_SCIENTIFIC_NCARG(A,NDECPT,STORE,NCHAR) 19 | CALL APPEND_STRING(NBLANKS,STORE(1:NCHAR),OUTSTRING) 20 | RETURN 21 | END 22 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/append_scientific_trunc.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE APPEND_SCIENTIFIC_TRUNC(NBLANKS,A,NDECPT_MAX,OUTSTRING) 2 | 3 | C Thomas Matejka NOAA/NSSL 12 May 1994 4 | 5 | C This subroutine writes NBLANKS blanks and the floating-point number A 6 | C left justified into the string OUTSTRING starting after the last 7 | C non-blank character. The number is written in scientific notation 8 | C with a maximum of NDECPT_MAX digits after the decimal point. 9 | C Trailing zeroes are not written. The rest of OUTSTRING is filled 10 | C with blanks. 11 | 12 | IMPLICIT NONE 13 | INCLUDE 'tmmlib.inc' 14 | CHARACTER*(MAX_NUMBER_STRING) STORE 15 | CHARACTER*(*) OUTSTRING 16 | INTEGER NBLANKS,NDECPT_MAX,NCHAR 17 | REAL A 18 | 19 | CALL LOAD_SCIENTIFIC_TRUNC(A,NDECPT_MAX,STORE,NCHAR) 20 | CALL APPEND_STRING(NBLANKS,STORE(1:NCHAR),OUTSTRING) 21 | RETURN 22 | END 23 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/append_scientific_trunc_ncarg.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE APPEND_SCIENTIFIC_TRUNC_NCARG(NBLANKS,A,NDECPT_MAX, 2 | $OUTSTRING) 3 | 4 | C Thomas Matejka NOAA/NSSL 13 May 1994 5 | 6 | C This subroutine writes NBLANKS blanks and the floating-point number A 7 | C left justified into the string OUTSTRING starting after the last 8 | C non-blank character. The number is written in ncargraphics 9 | C scientific notation with a maximum of NDECPT_MAX digits after the 10 | C decimal point. Trailing zeroes are not written. The rest of 11 | C OUTSTRING is filled with blanks. 12 | 13 | IMPLICIT NONE 14 | INCLUDE 'tmmlib.inc' 15 | CHARACTER*(MAX_STRING) STORE 16 | CHARACTER*(*) OUTSTRING 17 | INTEGER NBLANKS,NDECPT_MAX,NCHAR 18 | REAL A 19 | 20 | CALL LOAD_SCIENTIFIC_TRUNC_NCARG(A,NDECPT_MAX,STORE,NCHAR) 21 | CALL APPEND_STRING(NBLANKS,STORE(1:NCHAR),OUTSTRING) 22 | RETURN 23 | END 24 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/append_string.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE APPEND_STRING(NBLANKS,INSTRING,OUTSTRING) 2 | 3 | C Thomas Matejka NOAA/NSSL 26 March 1993 4 | 5 | C This subroutine writes NBLANKS blanks and the string INSTRING to the 6 | C last non-blank character left justified into the string OUTSTRING 7 | C starting after the last non-blank character. The rest of OUTSTRING is 8 | C filled with blanks. 9 | 10 | IMPLICIT NONE 11 | INCLUDE 'tmmlib.inc' 12 | INTEGER,EXTERNAL::S_L 13 | CHARACTER(LEN=*)::INSTRING,OUTSTRING 14 | INTEGER::NBLANKS,INEND,OUTSTART,OUTEND 15 | 16 | INEND=S_L(INSTRING) 17 | OUTSTART=S_L(OUTSTRING)+1 18 | OUTEND=LEN(OUTSTRING) 19 | IF(OUTSTART+NBLANKS+INEND-1.GT.OUTEND)THEN 20 | WRITE(TMMLIB_MESSAGE_UNIT,*)'APPEND_STRING: OUTSTRING IS TOO ', 21 | $ 'SHORT.' 22 | STOP 23 | ENDIF 24 | IF(OUTSTART.LE.OUTEND)THEN 25 | OUTSTRING(OUTSTART:OUTEND)='' 26 | ENDIF 27 | IF(INEND.GE.1)THEN 28 | OUTSTRING(OUTSTART+NBLANKS:OUTSTART+NBLANKS+INEND-1)= 29 | $ INSTRING(1:INEND) 30 | ENDIF 31 | 32 | END SUBROUTINE APPEND_STRING 33 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/asinde.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION ASINDE(XIN) 2 | 3 | C Thomas Matejka NOAA/NSSL 14 July 1995 4 | 5 | C This function returns the arcsine of XIN in degrees in the range 6 | C [-90.,90.]. 7 | 8 | C If XIN is greater than 1. or less than -1., then XIN is assumed to be 9 | C 1. or -1.. 10 | 11 | IMPLICIT NONE 12 | INCLUDE 'include_constants.inc' 13 | REAL XIN,X 14 | 15 | IF(ABS(XIN).GT.1.)THEN 16 | X=SIGN(1.,XIN) 17 | ELSE 18 | X=XIN 19 | ENDIF 20 | ASINDE=ASIN(X)*DEGRAD 21 | RETURN 22 | END 23 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/atn3de.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION ATN3DE(A,B) 2 | 3 | C Thomas Matejka NOAA/NSSL 14 July 1995 4 | 5 | C This function returns the arctangent of A/B in degrees in the range 6 | C [-180.,180.). 7 | 8 | C If A = 0. and B = 0., the arctangent is arbitrary and is returned 0. 9 | 10 | IMPLICIT NONE 11 | INCLUDE 'include_constants.inc' 12 | REAL A,B 13 | 14 | IF(A.NE.0..OR. 15 | $B.NE.0.)THEN 16 | ATN3DE=ATAN2(A,B)*DEGRAD 17 | IF(ATN3DE.LT.-180.)THEN 18 | ATN3DE=ATN3DE+360. 19 | ENDIF 20 | IF(ATN3DE.GE.180.)THEN 21 | ATN3DE=-180. 22 | ENDIF 23 | ELSE 24 | ATN3DE=0. 25 | ENDIF 26 | RETURN 27 | END 28 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/atn4de.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION ATN4DE(A,B) 2 | 3 | C Thomas Matejka NOAA/NSSL 14 July 1995 4 | 5 | C This function returns the arctangent of A/B in degrees in the range 6 | C [0.,360.). 7 | 8 | C If A = 0. and B = 0., the arctangent is arbitrary and is returned 0. 9 | 10 | IMPLICIT NONE 11 | INCLUDE 'include_constants.inc' 12 | REAL A,B 13 | 14 | IF(A.NE.0..OR. 15 | $B.NE.0.)THEN 16 | ATN4DE=ATAN2(A,B)*DEGRAD 17 | IF(ATN4DE.LT.0.)THEN 18 | ATN4DE=ATN4DE+360. 19 | ENDIF 20 | IF(ATN4DE.GE.360.)THEN 21 | ATN4DE=0. 22 | ENDIF 23 | ELSE 24 | ATN4DE=0. 25 | ENDIF 26 | RETURN 27 | END 28 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/atnde.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION ATNDE(A,B) 2 | 3 | C Thomas Matejka NOAA/NSSL 14 July 1995 4 | 5 | C This function returns the arctangent of A/B in degrees in the range 6 | C [-90.,90.]. The function assumes that B is supposed to be 7 | C non-negative, even though it may be negative because of computational 8 | C error. Therefore, arctangents less than -90. are set to -90., and 9 | C arctangents greater than 90. are set to 90.. 10 | 11 | C If A = 0. and B = 0., the arctangent is arbitrary and is returned 0. 12 | 13 | IMPLICIT NONE 14 | INCLUDE 'include_constants.inc' 15 | REAL A,B 16 | 17 | IF(A.NE.0..OR. 18 | $B.NE.0.)THEN 19 | ATNDE=ATAN2(A,B)*DEGRAD 20 | IF(ATNDE.LT.-90.)THEN 21 | ATNDE=-90. 22 | ENDIF 23 | IF(ATNDE.GT.90.)THEN 24 | ATNDE=90. 25 | ENDIF 26 | ELSE 27 | ATNDE=0. 28 | ENDIF 29 | RETURN 30 | END 31 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/c_from_k.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION C_FROM_K(K,BADDATA) 2 | 3 | C Thomas Matejka NOAA/NSSL 11 March 1994 4 | 5 | C This function converts a temperature from Kelvin to Celcius. 6 | 7 | C The function returns BADDATA if K = BADDATA. 8 | 9 | IMPLICIT NONE 10 | REAL K,BADDATA 11 | 12 | IF(K.NE.BADDATA)THEN 13 | C_FROM_K=K-273.15 14 | ELSE 15 | C_FROM_K=BADDATA 16 | ENDIF 17 | RETURN 18 | END 19 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/compare_strings.f: -------------------------------------------------------------------------------- 1 | LOGICAL FUNCTION COMPARE_STRINGS(STRING1,STRING2) 2 | 3 | C Thomas Matejka NOAA/NSSL 26 March 1993 4 | 5 | C This function returns .TRUE. if and only if the string STRING1 to the 6 | C last non-blank character and the string STRING2 to the last non-blank 7 | C character are identical. 8 | 9 | IMPLICIT NONE 10 | INTEGER S_L 11 | CHARACTER*(*) STRING1,STRING2 12 | INTEGER IEND1,IEND2 13 | 14 | IEND1=S_L(STRING1) 15 | IEND2=S_L(STRING2) 16 | IF(STRING1(1:IEND1).EQ.STRING2(1:IEND2))THEN 17 | COMPARE_STRINGS=.TRUE. 18 | ELSE 19 | COMPARE_STRINGS=.FALSE. 20 | ENDIF 21 | RETURN 22 | END 23 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/cosdeg.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION COSDEG(X) 2 | 3 | C Thomas Matejka NOAA/NSSL 23 February 1993 4 | 5 | C This function returns the cosine of X, where X is in degrees. 6 | 7 | IMPLICIT NONE 8 | INCLUDE 'include_constants.inc' 9 | REAL::X 10 | 11 | COSDEG=COS(X*RADDEG) 12 | 13 | END FUNCTION COSDEG 14 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/dbx_to_x.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION DBX_TO_X(DBX) 2 | 3 | C Thomas Matejka NOAA/NSSL 18 February 1993 4 | 5 | C This function converts DBX from decibels to a linear value. 6 | 7 | IMPLICIT NONE 8 | REAL DBX 9 | 10 | DBX_TO_X=10.**(DBX/10.) 11 | RETURN 12 | END 13 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/excise_string.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE EXCISE_STRING(STRING,ISTART,IEND) 2 | 3 | C Thomas Matejka NOAA/NSSL 16 October 1996 4 | 5 | C This subroutine excises character numbers ISTART to IEND in the 6 | C character string STRING. Trailing blanks are added to fill STRING. 7 | 8 | IMPLICIT NONE 9 | INCLUDE 'tmmlib.inc' 10 | CHARACTER(LEN=*)::STRING 11 | INTEGER::ISTART,IEND,L 12 | 13 | L=LEN(STRING) 14 | IF(IEND.LT.L)THEN 15 | STRING(ISTART:L-IEND+ISTART-1)=STRING(IEND+1:L) 16 | ENDIF 17 | STRING(L-IEND+ISTART:L)='' 18 | END 19 | 20 | 21 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/f_from_k.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION F_FROM_K(K,BADDATA) 2 | 3 | C Thomas Matejka NOAA/NSSL 11 March 1994 4 | 5 | C This function converts a temperature from Kelvin to Fahrenheit. 6 | 7 | C The function returns BADDATA if K = BADDATA. 8 | 9 | IMPLICIT NONE 10 | REAL K,BADDATA 11 | 12 | IF(K.NE.BADDATA)THEN 13 | F_FROM_K=(K-273.15)*9./5.+32. 14 | ELSE 15 | F_FROM_K=BADDATA 16 | ENDIF 17 | RETURN 18 | END 19 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/findchar.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE FINDCHAR(STRING,CHAR,OCCURRENCE,POS,SUCCESS) 2 | 3 | C Thomas Matejka NOAA/NSSL 19 May 2000 4 | 5 | C This subroutine calculates the position of the OCCURRENCEth 6 | C occurrence of the character CHAR in the string STRING. 7 | 8 | C SUCCESS is returned .FALSE. if and only if OCCURRENCE occurrences of 9 | C CHAR cannot be found. 10 | 11 | IMPLICIT NONE 12 | CHARACTER::CHAR 13 | CHARACTER(LEN=*)::STRING 14 | LOGICAL::SUCCESS 15 | INTEGER::I,IEND,OCCURRENCE,FOUND,POS 16 | 17 | IEND=LEN(STRING) 18 | FOUND=0 19 | DO I=1,IEND 20 | IF(STRING(I:I).EQ.CHAR)THEN 21 | FOUND=FOUND+1 22 | IF(FOUND.EQ.OCCURRENCE)THEN 23 | SUCCESS=.TRUE. 24 | POS=I 25 | RETURN 26 | ENDIF 27 | ENDIF 28 | ENDDO 29 | SUCCESS=.FALSE. 30 | 31 | END SUBROUTINE FINDCHAR 32 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/inhg_from_pa.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION INHG_FROM_PA(PA,BADDATA) 2 | 3 | C Thomas Matejka NOAA/NSSL 11 March 1994 4 | 5 | C This function converts a pressure from Pascals to inches of mercury. 6 | 7 | C The function returns BADDATA if PA = BADDATA. 8 | 9 | IMPLICIT NONE 10 | REAL PA,BADDATA 11 | 12 | IF(PA.NE.BADDATA)THEN 13 | INHG_FROM_PA=PA/3386.39 14 | ELSE 15 | INHG_FROM_PA=BADDATA 16 | ENDIF 17 | RETURN 18 | END 19 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/insert_string.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE INSERT_STRING(STRING,STRING_TO_INSERT,I) 2 | 3 | C Thomas Matejka NOAA/NSSL 16 October 1996 4 | 5 | C This subroutine inserts the character string STRING_TO_INSERT into 6 | C the character string STRING starting at character number I. If I 7 | C occurs before the last of the characters in STRING, the rest of 8 | C STRING follows the insertion. If I occurs after all the characters 9 | C in STRING, the intervening blanks are retained. All trailing blanks 10 | C in STRING_TO_INSERT are inserted. Trailing blanks in STRING that no 11 | C longer fit are discarded. If STRING is not long enough, the 12 | C subroutine stops. 13 | 14 | IMPLICIT NONE 15 | INCLUDE 'tmmlib.inc' 16 | INTEGER,EXTERNAL::S_L 17 | CHARACTER(LEN=*)::STRING,STRING_TO_INSERT 18 | INTEGER::I, 19 | $K,L,M 20 | 21 | K=S_L(STRING) 22 | L=LEN(STRING) 23 | M=LEN(STRING_TO_INSERT) 24 | IF(I.LE.K)THEN 25 | IF(K+M.GT.L)THEN 26 | WRITE(7,*)'INSERT_STRING: STRING IS TOO SHORT.' 27 | STOP 28 | ENDIF 29 | STRING(I+M:K+M)=STRING(I:K) 30 | ELSEIF(I-1+M.GT.L)THEN 31 | WRITE(7,*)'INSERT_STRING: STRING IS TOO SHORT.' 32 | STOP 33 | ENDIF 34 | STRING(I:I-1+M)=STRING_TO_INSERT(1:M) 35 | END 36 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/k_from_c.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION K_FROM_C(C,BADDATA) 2 | 3 | C Thomas Matejka NOAA/NSSL 11 March 1994 4 | 5 | C This function converts a temperature from Celcius to Kelvin. 6 | 7 | C The function returns BADDATA if C = BADDATA. 8 | 9 | IMPLICIT NONE 10 | REAL C,BADDATA 11 | 12 | IF(C.NE.BADDATA)THEN 13 | K_FROM_C=C+273.15 14 | ELSE 15 | K_FROM_C=BADDATA 16 | ENDIF 17 | RETURN 18 | END 19 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/k_from_f.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION K_FROM_F(F,BADDATA) 2 | 3 | C Thomas Matejka NOAA/NSSL 11 March 1994 4 | 5 | C This function converts a temperature from Fahrenheit to Kelvin. 6 | 7 | C The function returns BADDATA if F = BADDATA. 8 | 9 | IMPLICIT NONE 10 | REAL F,BADDATA 11 | 12 | IF(F.NE.BADDATA)THEN 13 | K_FROM_F=(F-32.)*5./9.+273.15 14 | ELSE 15 | K_FROM_F=BADDATA 16 | ENDIF 17 | RETURN 18 | END 19 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/left_justify.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE LEFT_JUSTIFY(STRING) 2 | 3 | C Thomas Matejka NOAA/NSSL 17 May 2000 4 | 5 | IMPLICIT NONE 6 | CHARACTER(LEN=*)::STRING 7 | INTEGER::I,L 8 | 9 | IF(STRING.NE.'')THEN 10 | L=LEN(STRING) 11 | DO I=1,L 12 | IF(STRING(I:I).NE.'')THEN 13 | EXIT 14 | ENDIF 15 | ENDDO 16 | IF(I.GT.1)THEN 17 | STRING(1:L-I+1)=STRING(I:L) 18 | STRING(L-I+2:L)='' 19 | ENDIF 20 | ENDIF 21 | 22 | END SUBROUTINE LEFT_JUSTIFY 23 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/lls_data_coeffs.ff: -------------------------------------------------------------------------------- 1 | SUBROUTINE LLS_DATA_COEFFS(NDATA,X,X_DIM_1,DATA_COEFF,SUCCESS) 2 | 3 | IMPLICIT NONE 4 | 5 | LOGICAL,PARAMETER::CHECK_SINGULAR=.FALSE. 6 | REAL,PARAMETER::SINGULAR_THRESHOLD=0.001 7 | 8 | LOGICAL::SUCCESS,INVERSE_SUCCESS 9 | INTEGER::NDATA,IDATA,IPARAM,JPARAM,X_DIM_1 10 | REAL,DIMENSION(NDATA)::DATA_COEFF 11 | REAL,DIMENSION(X_DIM_1,4)::X 12 | REAL,DIMENSION(4,4)::A,A_INV 13 | 14 | C Calculate A, the matrix of the sum of products of the predictor 15 | C variable data. 16 | DO IPARAM=1,4 17 | DO JPARAM=1,IPARAM 18 | A(IPARAM,JPARAM)=0. 19 | DO IDATA=1,NDATA 20 | A(IPARAM,JPARAM)=A(IPARAM,JPARAM)+X(IDATA,IPARAM)* 21 | $ X(IDATA,JPARAM) 22 | ENDDO 23 | ENDDO 24 | ENDDO 25 | DO IPARAM=2,4 26 | DO JPARAM=1,IPARAM-1 27 | A(JPARAM,IPARAM)=A(IPARAM,JPARAM) 28 | ENDDO 29 | ENDDO 30 | 31 | C Find the inverse of A. 32 | CALL MAT_INV(A,4,4,A_INV,4,CHECK_SINGULAR,SINGULAR_THRESHOLD,0, 33 | $INVERSE_SUCCESS) 34 | IF(.NOT.INVERSE_SUCCESS)THEN 35 | SUCCESS=.FALSE. 36 | RETURN 37 | ENDIF 38 | 39 | C Calculate the coefficient for each datum. 40 | DO IDATA=1,NDATA 41 | DATA_COEFF(IDATA)=0. 42 | DO IPARAM=1,4 43 | DATA_COEFF(IDATA)=DATA_COEFF(IDATA)+ 44 | $ A_INV(1,IPARAM)*X(IDATA,IPARAM) 45 | ENDDO 46 | ENDDO 47 | 48 | C Done. 49 | SUCCESS=.TRUE. 50 | END 51 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/load_float.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE LOAD_FLOAT(A,NDECPT,OUTSTRING,NCHAR) 2 | 3 | C Thomas Matejka NOAA/NSSL 26 March 1993 4 | 5 | C This subroutine writes the floating-point number A left justified 6 | C into the string OUTSTRING. The number is written with NDECPT digits 7 | C after the decimal point. If OUTSTRING is longer than needed, the end 8 | C of OUTSTRING is filled with blanks. 9 | 10 | C The number of digits used to represent the number is returned as 11 | C NCHAR. 12 | 13 | IMPLICIT NONE 14 | INCLUDE 'tmmlib.inc' 15 | CHARACTER*(MAX_STRING) FMT 16 | CHARACTER*(MAX_NUMBER_STRING) STORE 17 | CHARACTER*(*) OUTSTRING 18 | INTEGER NDECPT,NCHAR,I,N,IMIN 19 | REAL A 20 | 21 | IF(NDECPT.LT.0)THEN 22 | N=0 23 | ELSE 24 | N=NDECPT 25 | ENDIF 26 | WRITE(FMT,*)'(F',MAX_NUMBER_STRING,'.',N,')' 27 | WRITE(STORE,FMT)A 28 | IF(STORE(1:1).NE.' ')THEN 29 | WRITE(TMMLIB_MESSAGE_UNIT,*)'LOAD_FLOAT: MEMORY EXCEEDED. ', 30 | $ 'INCREASE MAX_NUMBER_STRING.' 31 | STOP 32 | ENDIF 33 | 34 | DO 1 I=MAX_NUMBER_STRING,1,-1 35 | IF(STORE(I:I).EQ.' ')THEN 36 | GOTO 2 37 | ENDIF 38 | 1 CONTINUE 39 | 2 CONTINUE 40 | IMIN=I+1 41 | 42 | CALL LOAD_STRING(STORE(IMIN:MAX_NUMBER_STRING),OUTSTRING) 43 | NCHAR=MAX_NUMBER_STRING-IMIN+1 44 | RETURN 45 | END 46 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/load_float_right.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE LOAD_FLOAT_RIGHT(A,NDECPT,OUTSTRING,NCHAR) 2 | 3 | C Thomas Matejka NOAA/NSSL 26 March 1993 4 | 5 | C This subroutine writes the floating-point number A right justified 6 | C into the string OUTSTRING. The number is written with NDECPT digits 7 | C after the decimal point. If OUTSTRING is longer than needed, the 8 | C beginning of OUTSTRING is filled with blanks. 9 | 10 | C The number of digits used to represent the number is returned as 11 | C NCHAR. 12 | 13 | IMPLICIT NONE 14 | INCLUDE 'tmmlib.inc' 15 | CHARACTER*(MAX_STRING) FMT 16 | CHARACTER*(MAX_NUMBER_STRING) STORE 17 | CHARACTER*(*) OUTSTRING 18 | INTEGER NDECPT,NCHAR,I,N,IMIN 19 | REAL A 20 | 21 | IF(NDECPT.LT.0)THEN 22 | N=0 23 | ELSE 24 | N=NDECPT 25 | ENDIF 26 | WRITE(FMT,*)'(F',MAX_NUMBER_STRING,'.',N,')' 27 | WRITE(STORE,FMT)A 28 | IF(STORE(1:1).NE.' ')THEN 29 | WRITE(TMMLIB_MESSAGE_UNIT,*)'LOAD_FLOAT_RIGHT: MEMORY ', 30 | $ 'EXCEEDED. INCREASE MAX_NUMBER_STRING.' 31 | STOP 32 | ENDIF 33 | 34 | DO 1 I=MAX_NUMBER_STRING,1,-1 35 | IF(STORE(I:I).EQ.' ')THEN 36 | GOTO 2 37 | ENDIF 38 | 1 CONTINUE 39 | 2 CONTINUE 40 | IMIN=I+1 41 | 42 | CALL LOAD_STRING_RIGHT(STORE(IMIN:MAX_NUMBER_STRING),OUTSTRING) 43 | NCHAR=MAX_NUMBER_STRING-IMIN+1 44 | RETURN 45 | END 46 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/load_float_signif.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE LOAD_FLOAT_SIGNIF(A,NSIG,OUTSTRING,NCHAR) 2 | 3 | C Thomas Matejka NOAA/NSSL 26 March 1993 4 | 5 | C This subroutine writes the floating-point number A left justified 6 | C into the string OUTSTRING. The number is written with NSIG 7 | C significant digits. If OUTSTRING is longer than needed, the end of 8 | C OUTSTRING is filled with blanks. 9 | 10 | C The number of digits used to represent the number is returned as 11 | C NCHAR. 12 | 13 | IMPLICIT NONE 14 | REAL ROUND 15 | CHARACTER*(*) OUTSTRING 16 | INTEGER NSIG,NCHAR,IEXP,N,NDECPT 17 | REAL A,B,C 18 | 19 | IF(NSIG.LE.0)THEN 20 | N=1 21 | ELSE 22 | N=NSIG 23 | ENDIF 24 | IF(A.NE.0.)THEN 25 | B=ALOG10(ABS(A)) 26 | IEXP=IFIX(B)+1 27 | IF(B.LT.0..AND. 28 | $ AMOD(B,1.).NE.0.)THEN 29 | IEXP=IEXP-1 30 | ENDIF 31 | ELSE 32 | IEXP=1 33 | ENDIF 34 | C=A/10.**IEXP 35 | C=ROUND(C,10.**(-N)) 36 | C=C*10.**IEXP 37 | IF(N-IEXP.GE.0)THEN 38 | NDECPT=N-IEXP 39 | ELSE 40 | NDECPT=0 41 | ENDIF 42 | CALL LOAD_FLOAT(C,NDECPT,OUTSTRING,NCHAR) 43 | RETURN 44 | END 45 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/load_float_signif_right.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE LOAD_FLOAT_SIGNIF_RIGHT(A,NSIG,OUTSTRING,NCHAR) 2 | 3 | C Thomas Matejka NOAA/NSSL 26 March 1993 4 | 5 | C This subroutine writes the floating-point number A right justified 6 | C into the string OUTSTRING. The number is written with NSIG 7 | C significant digits. If OUTSTRING is longer than needed, the 8 | C beginning of OUTSTRING is filled with blanks. 9 | 10 | C The number of digits used to represent the number is returned as 11 | C NCHAR. 12 | 13 | IMPLICIT NONE 14 | REAL ROUND 15 | CHARACTER*(*) OUTSTRING 16 | INTEGER NSIG,NCHAR,IEXP,N,NDECPT 17 | REAL A,B,C 18 | 19 | IF(NSIG.LE.0)THEN 20 | N=1 21 | ELSE 22 | N=NSIG 23 | ENDIF 24 | IF(A.NE.0.)THEN 25 | B=ALOG10(ABS(A)) 26 | IEXP=IFIX(B)+1 27 | IF(B.LT.0..AND. 28 | $ AMOD(B,1.).NE.0.)THEN 29 | IEXP=IEXP-1 30 | ENDIF 31 | ELSE 32 | IEXP=1 33 | ENDIF 34 | C=A/10.**IEXP 35 | C=ROUND(C,10.**(-N)) 36 | C=C*10.**IEXP 37 | IF(N-IEXP.GE.0)THEN 38 | NDECPT=N-IEXP 39 | ELSE 40 | NDECPT=0 41 | ENDIF 42 | CALL LOAD_FLOAT_RIGHT(C,NDECPT,OUTSTRING,NCHAR) 43 | RETURN 44 | END 45 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/load_float_signif_trunc.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE LOAD_FLOAT_SIGNIF_TRUNC(A,NSIG_MAX,OUTSTRING,NCHAR) 2 | 3 | C Thomas Matejka NOAA/NSSL 26 March 1993 4 | 5 | C This subroutine writes the floating-point number A left justified 6 | C into the string OUTSTRING. The number is written with a maximum of 7 | C NSIG_MAX significant digits. Trailing zeroes are not written. The 8 | C decimal point is not written if no digits follow it. If OUTSTRING is 9 | C longer than needed, the end of OUTSTRING is filled with blanks. 10 | 11 | C The number of digits used to represent the number is returned as 12 | C NCHAR. 13 | 14 | IMPLICIT NONE 15 | REAL ROUND 16 | CHARACTER*(*) OUTSTRING 17 | INTEGER NSIG_MAX,NCHAR,IEXP,N,NDECPT_MAX 18 | REAL A,B,C 19 | 20 | IF(NSIG_MAX.LE.0)THEN 21 | N=1 22 | ELSE 23 | N=NSIG_MAX 24 | ENDIF 25 | IF(A.NE.0.)THEN 26 | B=ALOG10(ABS(A)) 27 | IEXP=IFIX(B)+1 28 | IF(B.LT.0..AND. 29 | $ AMOD(B,1.).NE.0.)THEN 30 | IEXP=IEXP-1 31 | ENDIF 32 | ELSE 33 | IEXP=1 34 | ENDIF 35 | C=A/10.**IEXP 36 | C=ROUND(C,10.**(-N)) 37 | C=C*10.**IEXP 38 | IF(N-IEXP.GE.0)THEN 39 | NDECPT_MAX=N-IEXP 40 | ELSE 41 | NDECPT_MAX=0 42 | ENDIF 43 | CALL LOAD_FLOAT_TRUNC(C,NDECPT_MAX,OUTSTRING,NCHAR) 44 | RETURN 45 | END 46 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/load_float_signif_trunc_right.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE LOAD_FLOAT_SIGNIF_TRUNC_RIGHT(A,NSIG_MAX,OUTSTRING, 2 | $NCHAR) 3 | 4 | C Thomas Matejka NOAA/NSSL 26 March 1993 5 | 6 | C This subroutine writes the floating-point number A right justified 7 | C into the string OUTSTRING. The number is written with a maximum of 8 | C NSIG_MAX significant digits. Trailing zeroes are not written. The 9 | C decimal point is not written if no digits follow it. If OUTSTRING is 10 | C longer than needed, the beginning of OUTSTRING is filled with blanks. 11 | 12 | C The number of digits used to represent the number is returned as 13 | C NCHAR. 14 | 15 | IMPLICIT NONE 16 | REAL ROUND 17 | CHARACTER*(*) OUTSTRING 18 | INTEGER NSIG_MAX,NCHAR,IEXP,N,NDECPT_MAX 19 | REAL A,B,C 20 | 21 | IF(NSIG_MAX.LE.0)THEN 22 | N=1 23 | ELSE 24 | N=NSIG_MAX 25 | ENDIF 26 | IF(A.NE.0.)THEN 27 | B=ALOG10(ABS(A)) 28 | IEXP=IFIX(B)+1 29 | IF(B.LT.0..AND. 30 | $ AMOD(B,1.).NE.0.)THEN 31 | IEXP=IEXP-1 32 | ENDIF 33 | ELSE 34 | IEXP=1 35 | ENDIF 36 | C=A/10.**IEXP 37 | C=ROUND(C,10.**(-N)) 38 | C=C*10.**IEXP 39 | IF(N-IEXP.GE.0)THEN 40 | NDECPT_MAX=N-IEXP 41 | ELSE 42 | NDECPT_MAX=0 43 | ENDIF 44 | CALL LOAD_FLOAT_TRUNC_RIGHT(C,NDECPT_MAX,OUTSTRING,NCHAR) 45 | RETURN 46 | END 47 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/load_integer.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE LOAD_INTEGER(K,OUTSTRING,NCHAR) 2 | 3 | C Thomas Matejka NOAA/NSSL 26 March 1993 4 | 5 | C This subroutine writes the integer K left justified into the string 6 | C OUTSTRING. If OUTSTRING is longer than needed, the end of OUTSTRING 7 | C is filled with blanks. 8 | 9 | C The number of digits used to represent the number is returned as 10 | C NCHAR. 11 | 12 | IMPLICIT NONE 13 | INCLUDE 'tmmlib.inc' 14 | CHARACTER*(MAX_STRING) FMT 15 | CHARACTER*(MAX_NUMBER_STRING) STORE 16 | CHARACTER*(*) OUTSTRING 17 | INTEGER K,NCHAR,I,IMIN 18 | 19 | WRITE(FMT,*)'(I',MAX_NUMBER_STRING,')' 20 | WRITE(STORE,FMT)K 21 | IF(STORE(1:1).NE.' ')THEN 22 | WRITE(TMMLIB_MESSAGE_UNIT,*)'LOAD_INTEGER: MEMORY ', 23 | $ 'EXCEEDED. INCREASE MAX_NUMBER_STRING.' 24 | STOP 25 | ENDIF 26 | 27 | DO 1 I=MAX_NUMBER_STRING,1,-1 28 | IF(STORE(I:I).EQ.' ')THEN 29 | GOTO 2 30 | ENDIF 31 | 1 CONTINUE 32 | 2 CONTINUE 33 | IMIN=I+1 34 | 35 | CALL LOAD_STRING(STORE(IMIN:MAX_NUMBER_STRING),OUTSTRING) 36 | NCHAR=MAX_NUMBER_STRING-IMIN+1 37 | RETURN 38 | END 39 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/load_integer_right.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE LOAD_INTEGER_RIGHT(K,OUTSTRING,NCHAR) 2 | 3 | C Thomas Matejka NOAA/NSSL 26 March 1993 4 | 5 | C This subroutine writes the integer K right justified into the string 6 | C OUTSTRING. If OUTSTRING is longer than needed, the beginning of 7 | C OUTSTRING is filled with blanks. 8 | 9 | C The number of digits used to represent the number is returned as 10 | C NCHAR. 11 | 12 | IMPLICIT NONE 13 | INCLUDE 'tmmlib.inc' 14 | CHARACTER*(MAX_STRING) FMT 15 | CHARACTER*(MAX_NUMBER_STRING) STORE 16 | CHARACTER*(*) OUTSTRING 17 | INTEGER K,NCHAR,I,IMIN 18 | 19 | WRITE(FMT,*)'(I',MAX_NUMBER_STRING,')' 20 | WRITE(STORE,FMT)K 21 | IF(STORE(1:1).NE.' ')THEN 22 | WRITE(TMMLIB_MESSAGE_UNIT,*)'LOAD_INTEGER_RIGHT: MEMORY ', 23 | $ 'EXCEEDED. INCREASE MAX_NUMBER_STRING.' 24 | STOP 25 | ENDIF 26 | 27 | DO 1 I=MAX_NUMBER_STRING,1,-1 28 | IF(STORE(I:I).EQ.' ')THEN 29 | GOTO 2 30 | ENDIF 31 | 1 CONTINUE 32 | 2 CONTINUE 33 | IMIN=I+1 34 | 35 | CALL LOAD_STRING_RIGHT(STORE(IMIN:MAX_NUMBER_STRING),OUTSTRING) 36 | NCHAR=MAX_NUMBER_STRING-IMIN+1 37 | RETURN 38 | END 39 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/load_scientific.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE LOAD_SCIENTIFIC(A,NDECPT,OUTSTRING,NCHAR) 2 | 3 | C Thomas Matejka NOAA/NSSL 12 May 1994 4 | 5 | C This subroutine writes the floating-point number A left justified 6 | C into the string OUTSTRING. The number is written in scientific 7 | C notation with NDECPT digits after the decimal point. If OUTSTRING is 8 | C longer than needed, the end of OUTSTRING is filled with blanks. 9 | 10 | C The number of digits used to represent the number is returned as 11 | C NCHAR. 12 | 13 | IMPLICIT NONE 14 | INCLUDE 'tmmlib.inc' 15 | CHARACTER*(MAX_STRING) FMT 16 | CHARACTER*(MAX_NUMBER_STRING) STORE 17 | CHARACTER*(*) OUTSTRING 18 | INTEGER NDECPT,NCHAR,I,N,IMIN 19 | REAL A 20 | 21 | IF(NDECPT.LT.1)THEN 22 | N=1 23 | ELSE 24 | N=NDECPT 25 | ENDIF 26 | WRITE(FMT,*)'(E',MAX_NUMBER_STRING,'.',N,')' 27 | WRITE(STORE,FMT)A 28 | IF(STORE(1:1).NE.' ')THEN 29 | WRITE(TMMLIB_MESSAGE_UNIT,*)'LOAD_SCIENTIFIC: MEMORY ', 30 | $ 'EXCEEDED. INCREASE MAX_NUMBER_STRING.' 31 | STOP 32 | ENDIF 33 | 34 | DO 1 I=MAX_NUMBER_STRING,1,-1 35 | IF(STORE(I:I).EQ.' ')THEN 36 | GOTO 2 37 | ENDIF 38 | 1 CONTINUE 39 | 2 CONTINUE 40 | IMIN=I+1 41 | 42 | CALL LOAD_STRING(STORE(IMIN:MAX_NUMBER_STRING),OUTSTRING) 43 | NCHAR=MAX_NUMBER_STRING-IMIN+1 44 | RETURN 45 | END 46 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/load_scientific_right.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE LOAD_SCIENTIFIC_RIGHT(A,NDECPT,OUTSTRING,NCHAR) 2 | 3 | C Thomas Matejka NOAA/NSSL 12 May 1994 4 | 5 | C This subroutine writes the floating-point number A right justified 6 | C into the string OUTSTRING. The number is written in scientific 7 | C notation with NDECPT digits after the decimal point. If OUTSTRING is 8 | C longer than needed, the beginning of OUTSTRING is filled with blanks. 9 | 10 | C The number of digits used to represent the number is returned as 11 | C NCHAR. 12 | 13 | IMPLICIT NONE 14 | INCLUDE 'tmmlib.inc' 15 | CHARACTER*(MAX_STRING) FMT 16 | CHARACTER*(MAX_NUMBER_STRING) STORE 17 | CHARACTER*(*) OUTSTRING 18 | INTEGER NDECPT,NCHAR,I,N,IMIN 19 | REAL A 20 | 21 | IF(NDECPT.LT.1)THEN 22 | N=1 23 | ELSE 24 | N=NDECPT 25 | ENDIF 26 | WRITE(FMT,*)'(E',MAX_NUMBER_STRING,'.',N,')' 27 | WRITE(STORE,FMT)A 28 | IF(STORE(1:1).NE.' ')THEN 29 | WRITE(TMMLIB_MESSAGE_UNIT,*)'LOAD_SCIENTIFIC_RIGHT: MEMORY ', 30 | $ 'EXCEEDED. INCREASE MAX_NUMBER_STRING.' 31 | STOP 32 | ENDIF 33 | 34 | DO 1 I=MAX_NUMBER_STRING,1,-1 35 | IF(STORE(I:I).EQ.' ')THEN 36 | GOTO 2 37 | ENDIF 38 | 1 CONTINUE 39 | 2 CONTINUE 40 | IMIN=I+1 41 | 42 | CALL LOAD_STRING_RIGHT(STORE(IMIN:MAX_NUMBER_STRING),OUTSTRING) 43 | NCHAR=MAX_NUMBER_STRING-IMIN+1 44 | RETURN 45 | END 46 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/load_string.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE LOAD_STRING(INSTRING,OUTSTRING) 2 | 3 | C Thomas Matejka NOAA/NSSL 26 March 1993 4 | 5 | C This subroutine copies the string INSTRING left justified into the 6 | C string OUTSTRING. If OUTSTRING is longer than needed, the end of 7 | C OUTSTRING is filled with blanks. 8 | 9 | IMPLICIT NONE 10 | INCLUDE 'tmmlib.inc' 11 | CHARACTER*(*) INSTRING,OUTSTRING 12 | INTEGER INEND,OUTEND,J,JMAX 13 | 14 | INEND=LEN(INSTRING) 15 | OUTEND=LEN(OUTSTRING) 16 | IF(OUTEND.LT.INEND)THEN 17 | WRITE(TMMLIB_MESSAGE_UNIT,*)'LOAD_STRING: OUTSTRING IS TOO ', 18 | $ 'SHORT.' 19 | STOP 20 | ENDIF 21 | JMAX=INEND 22 | OUTSTRING(1:JMAX)=INSTRING(1:INEND) 23 | IF(JMAX.LT.OUTEND)THEN 24 | DO 1 J=JMAX+1,OUTEND 25 | OUTSTRING(J:J)=' ' 26 | 1 CONTINUE 27 | ENDIF 28 | RETURN 29 | END 30 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/load_string_right.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE LOAD_STRING_RIGHT(INSTRING,OUTSTRING) 2 | 3 | C Thomas Matejka NOAA/NSSL 26 March 1993 4 | 5 | C This subroutine copies the string INSTRING right justified into the 6 | C string OUTSTRING. If OUTSTRING is longer than needed, the beginning 7 | C of OUTSTRING is filled with blanks. 8 | 9 | IMPLICIT NONE 10 | INCLUDE 'tmmlib.inc' 11 | CHARACTER*(*) INSTRING,OUTSTRING 12 | INTEGER INEND,OUTEND,J,JMIN 13 | 14 | INEND=LEN(INSTRING) 15 | OUTEND=LEN(OUTSTRING) 16 | IF(OUTEND.LT.INEND)THEN 17 | WRITE(TMMLIB_MESSAGE_UNIT,*)'LOAD_STRING_RIGHT: OUTSTRING ', 18 | $ 'IS TOO SHORT.' 19 | STOP 20 | ENDIF 21 | JMIN=OUTEND-(INEND-1) 22 | OUTSTRING(JMIN:OUTEND)=INSTRING(1:INEND) 23 | IF(JMIN.GT.1)THEN 24 | DO 1 J=1,JMIN-1 25 | OUTSTRING(J:J)=' ' 26 | 1 CONTINUE 27 | ENDIF 28 | RETURN 29 | END 30 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/mat_singular.f: -------------------------------------------------------------------------------- 1 | LOGICAL FUNCTION MAT_SINGULAR(A,A_DIM_1,N,SINGULAR_THRESHOLD) 2 | 3 | C Thomas Matejka NOAA/NSSL 13 September 1995 4 | 5 | C This function tests whether a square matrix is singular or nearly 6 | C singular. 7 | 8 | C Input: 9 | 10 | C A is a two-dimensional real array. A(I,J) specifies the element in 11 | C the Ith row and Jth column of the square matrix to be tested for near 12 | C singularity. 13 | 14 | C A_DIM_1 is an integer variable that specifies the first dimension of 15 | C A in the calling program. 16 | 17 | C N is an integer variable that specifies the number of rows and the 18 | C number of columns in A. 19 | 20 | C SINGULAR_THRESHOLD is a real variable that controls the definition of 21 | C nearly singular. SINGULAR_THRESHOLD should be greater than or equal 22 | C to 0.. The smaller SINGULAR_THRESHOLD is, the more close to exactly 23 | C singular matrix A must be to be considered nearly singular. 24 | 25 | C Output: 26 | 27 | C The logical function returns .TRUE. if and only if A is singular or 28 | C nearly singular. 29 | 30 | IMPLICIT NONE 31 | REAL DET_SCALED_MAT 32 | INTEGER A_DIM_1,N 33 | REAL SINGULAR_THRESHOLD 34 | REAL A(A_DIM_1,N) 35 | 36 | C Compare the determinant of the scaled matrix to the specified 37 | C threshold. 38 | IF(ABS(DET_SCALED_MAT(A,A_DIM_1,N)).LT.SINGULAR_THRESHOLD) 39 | $THEN 40 | MAT_SINGULAR=.TRUE. 41 | ELSE 42 | MAT_SINGULAR=.FALSE. 43 | ENDIF 44 | 45 | C Done. 46 | RETURN 47 | END 48 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/mb_from_pa.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION MB_FROM_PA(PA,BADDATA) 2 | 3 | C Thomas Matejka NOAA/NSSL 11 March 1994 4 | 5 | C This function converts a pressure from Pascals to millibars. 6 | 7 | C The function returns BADDATA if PA = BADDATA. 8 | 9 | IMPLICIT NONE 10 | REAL PA,BADDATA 11 | 12 | IF(PA.NE.BADDATA)THEN 13 | MB_FROM_PA=PA*0.01 14 | ELSE 15 | MB_FROM_PA=BADDATA 16 | ENDIF 17 | RETURN 18 | END 19 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/median.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION MEDIAN(A,N) 2 | 3 | C Thomas Matejka NOAA/NSSL 13 January 1995 4 | 5 | C This function returns the median of the N elements of array A. 6 | 7 | IMPLICIT NONE 8 | INTEGER I,N,NDUM 9 | REAL A(N) 10 | REAL B(N) 11 | 12 | DO I=1,N 13 | B(I)=A(I) 14 | ENDDO 15 | CALL SORT_F(B,N,.FALSE.,NDUM) 16 | IF(MOD(N,2).EQ.0)THEN 17 | MEDIAN=(B(N/2)+B(N/2+1))/2. 18 | ELSE 19 | MEDIAN=B(N/2+1) 20 | ENDIF 21 | RETURN 22 | END 23 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/nsig_min.f: -------------------------------------------------------------------------------- 1 | INTEGER FUNCTION NSIG_MIN(A,N) 2 | 3 | C Thomas Matejka NOAA/NSSL 13 January 1995 4 | 5 | C This function returns the minimum number of significant digits that 6 | C are required to distinguish the numbers in the one-dimensional array 7 | C A. 8 | 9 | C Duplicate elements of A do not affect the result. 10 | 11 | IMPLICIT NONE 12 | INCLUDE 'tmmlib.inc' 13 | REAL ROUND_SIGNIF 14 | LOGICAL AGAIN 15 | INTEGER N,I,M 16 | REAL B_PREV,B 17 | REAL A(N) 18 | REAL A_SORTED(N) 19 | 20 | DO I=1,N 21 | A_SORTED(I)=A(I) 22 | ENDDO 23 | CALL SORT_F(A_SORTED,N,.TRUE.,M) 24 | 25 | NSIG_MIN=0 26 | AGAIN=.TRUE. 27 | DOWHILE(AGAIN) 28 | AGAIN=.FALSE. 29 | NSIG_MIN=NSIG_MIN+1 30 | IF(NSIG_MIN.GT.MAX_SIGNIF)THEN 31 | WRITE(TMMLIB_MESSAGE_UNIT,*)'NSIG_MIN: EXCEEDED MAXIMUM ', 32 | $ 'NUMBER OF SIGNIFICANT DIGITS FOR A REAL NUMBER.' 33 | STOP 34 | ENDIF 35 | B_PREV=ROUND_SIGNIF(A_SORTED(1),NSIG_MIN) 36 | DO I=2,M 37 | B=ROUND_SIGNIF(A_SORTED(I),NSIG_MIN) 38 | IF(B_PREV.EQ.B)THEN 39 | AGAIN=.TRUE. 40 | EXIT 41 | ENDIF 42 | B_PREV=B 43 | ENDDO 44 | ENDDO 45 | RETURN 46 | END 47 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/number_histogram.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE NUMBER_HISTOGRAM(A,N,BADDATA,BIN_MIN,BIN_INC,N_BINS, 2 | $NUMBER_HIST,N_TOT) 3 | 4 | C Thomas Matejka NOAA/NSSL 15 July 1996 5 | 6 | IMPLICIT NONE 7 | INTEGER::N,I,N_TOT,N_BINS,I_BIN 8 | INTEGER,DIMENSION(N_BINS)::NUMBER_HIST 9 | REAL::BADDATA,BIN_MIN,BIN_INC 10 | REAL,DIMENSION(N)::A 11 | 12 | N_TOT=0 13 | DO I_BIN=1,N_BINS 14 | NUMBER_HIST(I_BIN)=0 15 | ENDDO 16 | DO I=1,N 17 | IF(A(I).NE.BADDATA)THEN 18 | N_TOT=N_TOT+1 19 | I_BIN=IFIX((A(I)-BIN_MIN)/BIN_INC)+1 20 | IF(I_BIN.GE.1.AND. 21 | $ I_BIN.LE.N_BINS)THEN 22 | NUMBER_HIST(I_BIN)=NUMBER_HIST(I_BIN)+1 23 | ENDIF 24 | ENDIF 25 | ENDDO 26 | END 27 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/octant1.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE OCTANT1(A_IN,SD_A_IN,MAXX_IN,MAXY_IN,NX,NY,BADDATA, 2 | $MAX_SEARCH_RADIUS,MAX_VALUES_PER_OCTANT,IX,IY,POINTS_FOUND, 3 | $IX_FOUND,IY_FOUND) 4 | 5 | IMPLICIT NONE 6 | INTEGER MAXX_IN,MAXY_IN,NX,NY,IX,IY,IX_SEARCH,IY_SEARCH, 7 | $POINTS_FOUND,MAX_SEARCH_RADIUS,MAX_VALUES_PER_OCTANT 8 | INTEGER IX_FOUND(1),IY_FOUND(1) 9 | REAL BADDATA 10 | REAL A_IN(MAXX_IN,MAXY_IN),SD_A_IN(MAXX_IN,MAXY_IN) 11 | 12 | POINTS_FOUND=0 13 | DO 1 IY_SEARCH=IY+1,IY+MAX_SEARCH_RADIUS 14 | IF(IY_SEARCH.GT.NY)THEN 15 | RETURN 16 | ENDIF 17 | DO 2 IX_SEARCH=IX,IX+IY_SEARCH-IY-1 18 | IF(IX_SEARCH.GT.NX)THEN 19 | GOTO 3 20 | ENDIF 21 | IF(A_IN(IX_SEARCH,IY_SEARCH).NE.BADDATA.AND. 22 | $ SD_A_IN(IX_SEARCH,IY_SEARCH).NE.BADDATA)THEN 23 | POINTS_FOUND=POINTS_FOUND+1 24 | IX_FOUND(POINTS_FOUND)=IX_SEARCH 25 | IY_FOUND(POINTS_FOUND)=IY_SEARCH 26 | IF(POINTS_FOUND.GE.MAX_VALUES_PER_OCTANT)THEN 27 | RETURN 28 | ENDIF 29 | ENDIF 30 | 2 CONTINUE 31 | 3 CONTINUE 32 | 1 CONTINUE 33 | RETURN 34 | END 35 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/octant2.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE OCTANT2(A_IN,SD_A_IN,MAXX_IN,MAXY_IN,NX,NY,BADDATA, 2 | $MAX_SEARCH_RADIUS,MAX_VALUES_PER_OCTANT,IX,IY,POINTS_FOUND, 3 | $IX_FOUND,IY_FOUND) 4 | 5 | IMPLICIT NONE 6 | INTEGER MAXX_IN,MAXY_IN,NX,NY,IX,IY,IX_SEARCH,IY_SEARCH, 7 | $POINTS_FOUND,MAX_SEARCH_RADIUS,MAX_VALUES_PER_OCTANT 8 | INTEGER IX_FOUND(1),IY_FOUND(1) 9 | REAL BADDATA 10 | REAL A_IN(MAXX_IN,MAXY_IN),SD_A_IN(MAXX_IN,MAXY_IN) 11 | 12 | POINTS_FOUND=0 13 | DO 1 IX_SEARCH=IX+1,IX+MAX_SEARCH_RADIUS 14 | IF(IX_SEARCH.GT.NX)THEN 15 | RETURN 16 | ENDIF 17 | DO 2 IY_SEARCH=IY+1,IY+IX_SEARCH-IX 18 | IF(IY_SEARCH.GT.NY)THEN 19 | GOTO 3 20 | ENDIF 21 | IF(A_IN(IX_SEARCH,IY_SEARCH).NE.BADDATA.AND. 22 | $ SD_A_IN(IX_SEARCH,IY_SEARCH).NE.BADDATA)THEN 23 | POINTS_FOUND=POINTS_FOUND+1 24 | IX_FOUND(POINTS_FOUND)=IX_SEARCH 25 | IY_FOUND(POINTS_FOUND)=IY_SEARCH 26 | IF(POINTS_FOUND.GE.MAX_VALUES_PER_OCTANT)THEN 27 | RETURN 28 | ENDIF 29 | ENDIF 30 | 2 CONTINUE 31 | 3 CONTINUE 32 | 1 CONTINUE 33 | RETURN 34 | END 35 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/octant3.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE OCTANT3(A_IN,SD_A_IN,MAXX_IN,MAXY_IN,NX,NY,BADDATA, 2 | $MAX_SEARCH_RADIUS,MAX_VALUES_PER_OCTANT,IX,IY,POINTS_FOUND, 3 | $IX_FOUND,IY_FOUND) 4 | 5 | IMPLICIT NONE 6 | INTEGER MAXX_IN,MAXY_IN,NX,NY,IX,IY,IX_SEARCH,IY_SEARCH, 7 | $POINTS_FOUND,MAX_SEARCH_RADIUS,MAX_VALUES_PER_OCTANT 8 | INTEGER IX_FOUND(1),IY_FOUND(1) 9 | REAL BADDATA 10 | REAL A_IN(MAXX_IN,MAXY_IN),SD_A_IN(MAXX_IN,MAXY_IN) 11 | 12 | POINTS_FOUND=0 13 | DO 1 IX_SEARCH=IX+1,IX+MAX_SEARCH_RADIUS 14 | IF(IX_SEARCH.GT.NX)THEN 15 | RETURN 16 | ENDIF 17 | DO 2 IY_SEARCH=IY,IY-(IX_SEARCH-IX)+1,-1 18 | IF(IY_SEARCH.LT.1)THEN 19 | GOTO 3 20 | ENDIF 21 | IF(A_IN(IX_SEARCH,IY_SEARCH).NE.BADDATA.AND. 22 | $ SD_A_IN(IX_SEARCH,IY_SEARCH).NE.BADDATA)THEN 23 | POINTS_FOUND=POINTS_FOUND+1 24 | IX_FOUND(POINTS_FOUND)=IX_SEARCH 25 | IY_FOUND(POINTS_FOUND)=IY_SEARCH 26 | IF(POINTS_FOUND.GE.MAX_VALUES_PER_OCTANT)THEN 27 | RETURN 28 | ENDIF 29 | ENDIF 30 | 2 CONTINUE 31 | 3 CONTINUE 32 | 1 CONTINUE 33 | RETURN 34 | END 35 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/octant4.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE OCTANT4(A_IN,SD_A_IN,MAXX_IN,MAXY_IN,NX,NY,BADDATA, 2 | $MAX_SEARCH_RADIUS,MAX_VALUES_PER_OCTANT,IX,IY,POINTS_FOUND, 3 | $IX_FOUND,IY_FOUND) 4 | 5 | IMPLICIT NONE 6 | INTEGER MAXX_IN,MAXY_IN,NX,NY,IX,IY,IX_SEARCH,IY_SEARCH, 7 | $POINTS_FOUND,MAX_SEARCH_RADIUS,MAX_VALUES_PER_OCTANT 8 | INTEGER IX_FOUND(1),IY_FOUND(1) 9 | REAL BADDATA 10 | REAL A_IN(MAXX_IN,MAXY_IN),SD_A_IN(MAXX_IN,MAXY_IN) 11 | 12 | POINTS_FOUND=0 13 | DO 1 IY_SEARCH=IY-1,IY-MAX_SEARCH_RADIUS,-1 14 | IF(IY_SEARCH.LT.1)THEN 15 | RETURN 16 | ENDIF 17 | DO 2 IX_SEARCH=IX+1,IX+IY-IY_SEARCH 18 | IF(IX_SEARCH.GT.NX)THEN 19 | GOTO 3 20 | ENDIF 21 | IF(A_IN(IX_SEARCH,IY_SEARCH).NE.BADDATA.AND. 22 | $ SD_A_IN(IX_SEARCH,IY_SEARCH).NE.BADDATA)THEN 23 | POINTS_FOUND=POINTS_FOUND+1 24 | IX_FOUND(POINTS_FOUND)=IX_SEARCH 25 | IY_FOUND(POINTS_FOUND)=IY_SEARCH 26 | IF(POINTS_FOUND.GE.MAX_VALUES_PER_OCTANT)THEN 27 | RETURN 28 | ENDIF 29 | ENDIF 30 | 2 CONTINUE 31 | 3 CONTINUE 32 | 1 CONTINUE 33 | RETURN 34 | END 35 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/octant5.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE OCTANT5(A_IN,SD_A_IN,MAXX_IN,MAXY_IN,NX,NY,BADDATA, 2 | $MAX_SEARCH_RADIUS,MAX_VALUES_PER_OCTANT,IX,IY,POINTS_FOUND, 3 | $IX_FOUND,IY_FOUND) 4 | 5 | IMPLICIT NONE 6 | INTEGER MAXX_IN,MAXY_IN,NX,NY,IX,IY,IX_SEARCH,IY_SEARCH, 7 | $POINTS_FOUND,MAX_SEARCH_RADIUS,MAX_VALUES_PER_OCTANT 8 | INTEGER IX_FOUND(1),IY_FOUND(1) 9 | REAL BADDATA 10 | REAL A_IN(MAXX_IN,MAXY_IN),SD_A_IN(MAXX_IN,MAXY_IN) 11 | 12 | POINTS_FOUND=0 13 | DO 1 IY_SEARCH=IY-1,IY-MAX_SEARCH_RADIUS,-1 14 | IF(IY_SEARCH.LT.1)THEN 15 | RETURN 16 | ENDIF 17 | DO 2 IX_SEARCH=IX,IX-(IY-IY_SEARCH)+1,-1 18 | IF(IX_SEARCH.LT.1)THEN 19 | GOTO 3 20 | ENDIF 21 | IF(A_IN(IX_SEARCH,IY_SEARCH).NE.BADDATA.AND. 22 | $ SD_A_IN(IX_SEARCH,IY_SEARCH).NE.BADDATA)THEN 23 | POINTS_FOUND=POINTS_FOUND+1 24 | IX_FOUND(POINTS_FOUND)=IX_SEARCH 25 | IY_FOUND(POINTS_FOUND)=IY_SEARCH 26 | IF(POINTS_FOUND.GE.MAX_VALUES_PER_OCTANT)THEN 27 | RETURN 28 | ENDIF 29 | ENDIF 30 | 2 CONTINUE 31 | 3 CONTINUE 32 | 1 CONTINUE 33 | RETURN 34 | END 35 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/octant6.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE OCTANT6(A_IN,SD_A_IN,MAXX_IN,MAXY_IN,NX,NY,BADDATA, 2 | $MAX_SEARCH_RADIUS,MAX_VALUES_PER_OCTANT,IX,IY,POINTS_FOUND, 3 | $IX_FOUND,IY_FOUND) 4 | 5 | IMPLICIT NONE 6 | INTEGER MAXX_IN,MAXY_IN,NX,NY,IX,IY,IX_SEARCH,IY_SEARCH, 7 | $POINTS_FOUND,MAX_SEARCH_RADIUS,MAX_VALUES_PER_OCTANT 8 | INTEGER IX_FOUND(1),IY_FOUND(1) 9 | REAL BADDATA 10 | REAL A_IN(MAXX_IN,MAXY_IN),SD_A_IN(MAXX_IN,MAXY_IN) 11 | 12 | POINTS_FOUND=0 13 | DO 1 IX_SEARCH=IX-1,IX-MAX_SEARCH_RADIUS,-1 14 | IF(IX_SEARCH.LT.1)THEN 15 | RETURN 16 | ENDIF 17 | DO 2 IY_SEARCH=IY-1,IY-(IX-IX_SEARCH),-1 18 | IF(IY_SEARCH.LT.1)THEN 19 | GOTO 3 20 | ENDIF 21 | IF(A_IN(IX_SEARCH,IY_SEARCH).NE.BADDATA.AND. 22 | $ SD_A_IN(IX_SEARCH,IY_SEARCH).NE.BADDATA)THEN 23 | POINTS_FOUND=POINTS_FOUND+1 24 | IX_FOUND(POINTS_FOUND)=IX_SEARCH 25 | IY_FOUND(POINTS_FOUND)=IY_SEARCH 26 | IF(POINTS_FOUND.GE.MAX_VALUES_PER_OCTANT)THEN 27 | RETURN 28 | ENDIF 29 | ENDIF 30 | 2 CONTINUE 31 | 3 CONTINUE 32 | 1 CONTINUE 33 | RETURN 34 | END 35 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/octant7.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE OCTANT7(A_IN,SD_A_IN,MAXX_IN,MAXY_IN,NX,NY,BADDATA, 2 | $MAX_SEARCH_RADIUS,MAX_VALUES_PER_OCTANT,IX,IY,POINTS_FOUND, 3 | $IX_FOUND,IY_FOUND) 4 | 5 | IMPLICIT NONE 6 | INTEGER MAXX_IN,MAXY_IN,NX,NY,IX,IY,IX_SEARCH,IY_SEARCH, 7 | $POINTS_FOUND,MAX_SEARCH_RADIUS,MAX_VALUES_PER_OCTANT 8 | INTEGER IX_FOUND(1),IY_FOUND(1) 9 | REAL BADDATA 10 | REAL A_IN(MAXX_IN,MAXY_IN),SD_A_IN(MAXX_IN,MAXY_IN) 11 | 12 | POINTS_FOUND=0 13 | DO 1 IX_SEARCH=IX-1,IX-MAX_SEARCH_RADIUS,-1 14 | IF(IX_SEARCH.LT.1)THEN 15 | RETURN 16 | ENDIF 17 | DO 2 IY_SEARCH=IY,IY+IX-IX_SEARCH-1 18 | IF(IY_SEARCH.GT.NY)THEN 19 | GOTO 3 20 | ENDIF 21 | IF(A_IN(IX_SEARCH,IY_SEARCH).NE.BADDATA.AND. 22 | $ SD_A_IN(IX_SEARCH,IY_SEARCH).NE.BADDATA)THEN 23 | POINTS_FOUND=POINTS_FOUND+1 24 | IX_FOUND(POINTS_FOUND)=IX_SEARCH 25 | IY_FOUND(POINTS_FOUND)=IY_SEARCH 26 | IF(POINTS_FOUND.GE.MAX_VALUES_PER_OCTANT)THEN 27 | RETURN 28 | ENDIF 29 | ENDIF 30 | 2 CONTINUE 31 | 3 CONTINUE 32 | 1 CONTINUE 33 | RETURN 34 | END 35 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/octant8.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE OCTANT8(A_IN,SD_A_IN,MAXX_IN,MAXY_IN,NX,NY,BADDATA, 2 | $MAX_SEARCH_RADIUS,MAX_VALUES_PER_OCTANT,IX,IY,POINTS_FOUND, 3 | $IX_FOUND,IY_FOUND) 4 | 5 | IMPLICIT NONE 6 | INTEGER MAXX_IN,MAXY_IN,NX,NY,IX,IY,IX_SEARCH,IY_SEARCH, 7 | $POINTS_FOUND,MAX_SEARCH_RADIUS,MAX_VALUES_PER_OCTANT 8 | INTEGER IX_FOUND(1),IY_FOUND(1) 9 | REAL BADDATA 10 | REAL A_IN(MAXX_IN,MAXY_IN),SD_A_IN(MAXX_IN,MAXY_IN) 11 | 12 | POINTS_FOUND=0 13 | DO 1 IY_SEARCH=IY+1,IY+MAX_SEARCH_RADIUS 14 | IF(IY_SEARCH.GT.NY)THEN 15 | RETURN 16 | ENDIF 17 | DO 2 IX_SEARCH=IX-1,IX-(IY_SEARCH-IY),-1 18 | IF(IX_SEARCH.LT.1)THEN 19 | GOTO 3 20 | ENDIF 21 | IF(A_IN(IX_SEARCH,IY_SEARCH).NE.BADDATA.AND. 22 | $ SD_A_IN(IX_SEARCH,IY_SEARCH).NE.BADDATA)THEN 23 | POINTS_FOUND=POINTS_FOUND+1 24 | IX_FOUND(POINTS_FOUND)=IX_SEARCH 25 | IY_FOUND(POINTS_FOUND)=IY_SEARCH 26 | IF(POINTS_FOUND.GE.MAX_VALUES_PER_OCTANT)THEN 27 | RETURN 28 | ENDIF 29 | ENDIF 30 | 2 CONTINUE 31 | 3 CONTINUE 32 | 1 CONTINUE 33 | RETURN 34 | END 35 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/pa_from_inhg.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION PA_FROM_INHG(INHG,BADDATA) 2 | 3 | C Thomas Matejka NOAA/NSSL 11 March 1994 4 | 5 | C This function converts a pressure from inches of mercury to Pascals. 6 | 7 | C The function returns BADDATA if INHG = BADDATA. 8 | 9 | IMPLICIT NONE 10 | REAL INHG,BADDATA 11 | 12 | IF(INHG.NE.BADDATA)THEN 13 | PA_FROM_INHG=INHG*3386.39 14 | ELSE 15 | PA_FROM_INHG=BADDATA 16 | ENDIF 17 | RETURN 18 | END 19 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/pa_from_mb.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION PA_FROM_MB(MB,BADDATA) 2 | 3 | C Thomas Matejka NOAA/NSSL 11 March 1994 4 | 5 | C This function converts a pressure from millibars to Pascals. 6 | 7 | C The function returns BADDATA if MB = BADDATA. 8 | 9 | IMPLICIT NONE 10 | REAL MB,BADDATA 11 | 12 | IF(MB.NE.BADDATA)THEN 13 | PA_FROM_MB=MB*100. 14 | ELSE 15 | PA_FROM_MB=BADDATA 16 | ENDIF 17 | RETURN 18 | END 19 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/poisson_2d_mgr.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE POISSON_2D_MGR(F,G,MAXX,MAXY,NX,NY,DELX,DELY,BADDATA, 2 | $DO_CLEAN,CLEAN_THRESHOLD,P,ER1,ER2,N_CLEANED) 3 | 4 | C Thomas Matejka NOAA/NSSL 17 May 1996 5 | 6 | IMPLICIT NONE 7 | LOGICAL::DO_CLEAN 8 | INTEGER::MAXX,MAXY, 9 | $NX,NY, 10 | $N_CLEANED, 11 | $IDUM 12 | REAL::DELX,DELY, 13 | $BADDATA, 14 | $CLEAN_THRESHOLD, 15 | $ER1,ER2 16 | REAL,DIMENSION(MAXX,MAXY)::F,G,P, 17 | $F_TEMP,G_TEMP 18 | 19 | IF(DO_CLEAN)THEN 20 | CALL COPY_3D(F,MAXX,MAXY,1,NX,NY,1,F_TEMP) 21 | CALL COPY_3D(G,MAXX,MAXY,1,NX,NY,1,G_TEMP) 22 | CALL POISSON_2D(F_TEMP,G_TEMP,MAXX,MAXY,NX,NY,DELX,DELY, 23 | $ BADDATA,P) 24 | CALL ER_2D(P,F_TEMP,G_TEMP,MAXX,MAXY,NX,NY,DELX,DELY,BADDATA, 25 | $ .TRUE.,CLEAN_THRESHOLD,ER1,N_CLEANED) 26 | CALL POISSON_2D(F_TEMP,G_TEMP,MAXX,MAXY,NX,NY,DELX,DELY, 27 | $ BADDATA,P) 28 | CALL ER_2D(P,F_TEMP,G_TEMP,MAXX,MAXY,NX,NY,DELX,DELY,BADDATA, 29 | $ .FALSE.,0.,ER2,IDUM) 30 | ELSE 31 | CALL POISSON_2D(F,G,MAXX,MAXY,NX,NY,DELX,DELY,BADDATA,P) 32 | CALL ER_2D(P,F,G,MAXX,MAXY,NX,NY,DELX,DELY,BADDATA,.FALSE.,0., 33 | $ ER1,N_CLEANED) 34 | ENDIF 35 | 36 | END SUBROUTINE POISSON_2D_MGR 37 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/probability_density_histogram.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE PROBABILITY_DENSITY_HISTOGRAM(A,N,BADDATA,BIN_MIN, 2 | $BIN_INC,N_BINS,PROBABILITY_DENSITY_HIST,N_TOT) 3 | 4 | C Thomas Matejka NOAA/NSSL 15 July 1996 5 | 6 | IMPLICIT NONE 7 | INTEGER::N,N_TOT,N_BINS,I_BIN 8 | REAL::BADDATA,BIN_MIN,BIN_INC 9 | REAL,DIMENSION(N)::A 10 | REAL,DIMENSION(N_BINS)::PROBABILITY_HIST,PROBABILITY_DENSITY_HIST 11 | 12 | CALL PROBABILITY_HISTOGRAM(A,N,BADDATA,BIN_MIN,BIN_INC,N_BINS, 13 | $PROBABILITY_HIST,N_TOT) 14 | DO I_BIN=1,N_BINS 15 | PROBABILITY_DENSITY_HIST(I_BIN)=PROBABILITY_HIST(I_BIN)/BIN_INC 16 | ENDDO 17 | END 18 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/probability_histogram.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE PROBABILITY_HISTOGRAM(A,N,BADDATA,BIN_MIN,BIN_INC, 2 | $N_BINS,PROBABILITY_HIST,N_TOT) 3 | 4 | C Thomas Matejka NOAA/NSSL 15 July 1996 5 | 6 | IMPLICIT NONE 7 | INTEGER::N,N_TOT,N_BINS,I_BIN 8 | INTEGER,DIMENSION(N_BINS)::NUMBER_HIST 9 | REAL::BADDATA,BIN_MIN,BIN_INC 10 | REAL,DIMENSION(N)::A 11 | REAL,DIMENSION(N_BINS)::PROBABILITY_HIST 12 | 13 | CALL NUMBER_HISTOGRAM(A,N,BADDATA,BIN_MIN,BIN_INC,N_BINS, 14 | $NUMBER_HIST,N_TOT) 15 | IF(N_TOT.GE.1)THEN 16 | DO I_BIN=1,N_BINS 17 | PROBABILITY_HIST(I_BIN)=FLOAT(NUMBER_HIST(I_BIN))/ 18 | $ FLOAT(N_TOT) 19 | ENDDO 20 | ELSE 21 | DO I_BIN=1,N_BINS 22 | PROBABILITY_HIST(I_BIN)=0. 23 | ENDDO 24 | ENDIF 25 | END 26 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/read_i1.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE READ_I1(C,I4) 2 | 3 | C Thomas Matejka NOAA/NSSL 14 November 1996 4 | 5 | C This subroutine interprets one unformatted byte as a four-byte 6 | C integer. 7 | 8 | C Input: 9 | 10 | C C is a character variable that is to be interpreted as an integer. 11 | 12 | C Output: 13 | 14 | C I4 is the four-byte integer that corresponds to the unformatted byte. 15 | 16 | IMPLICIT NONE 17 | CHARACTER(LEN=1)::C 18 | CHARACTER(LEN=4)::C4 19 | INTEGER*4 I4,J4 20 | EQUIVALENCE(C4,J4) 21 | 22 | C Copy the input byte to equivalenced memory. 23 | J4=0 24 | C4(4:4)=C 25 | 26 | C Copy equivalenced memory to the output four-byte integer. 27 | I4=J4 28 | 29 | C Done. 30 | RETURN 31 | END 32 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/read_i2.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE READ_I2(STRING,I2) 2 | 3 | C Thomas Matejka NOAA/NSSL 25 May 1994 4 | 5 | C This subroutine interprets two unformatted bytes as a two-byte 6 | C integer. 7 | 8 | C Input: 9 | 10 | C STRING is a character string whose first two unformatted bytes are to 11 | C be interpreted as a two-byte integer. 12 | 13 | C Output: 14 | 15 | C I2 is the two-byte integer that corresponds to the two unformatted 16 | C bytes. 17 | 18 | IMPLICIT NONE 19 | CHARACTER*2 C2 20 | CHARACTER*(*) STRING 21 | INTEGER*2 I2,J2 22 | EQUIVALENCE(C2,J2) 23 | 24 | C Copy two input bytes to equivalenced memory. 25 | C2(1:2)=STRING(1:2) 26 | 27 | C Copy equivalenced memory to the output two-byte integer. 28 | I2=J2 29 | 30 | C Done. 31 | RETURN 32 | END 33 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/read_i2_buf.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE READ_I2_BUF(STRING,N,I2BUF) 2 | 3 | C Thomas Matejka NOAA/NSSL 9 February 1996 4 | 5 | C This subroutine interprets a series of sets of two unformatted bytes 6 | C as a one-dimensional array of two-byte integers. 7 | 8 | C Input: 9 | 10 | C STRING is a character string whose first 2*N unformatted bytes are to 11 | C be interpreted as N two-byte integers. 12 | 13 | C N is an integer variable that specifies the number of sets of two 14 | C unformatted bytes in STRING and the number of elements in I2BUF. 15 | 16 | C Output: 17 | 18 | C I2BUF is a one-dimensional integer*2 array. I2BUF(I) is the Ith 19 | C two-byte integer that corresponds to the Ith set of two unformatted 20 | C bytes. 21 | 22 | IMPLICIT NONE 23 | CHARACTER*2 C2 24 | CHARACTER*(*) STRING 25 | INTEGER*2 J2 26 | INTEGER*2 I2BUF(N) 27 | INTEGER N,K 28 | EQUIVALENCE(C2,J2) 29 | 30 | C Loop through the sets of two unformatted bytes. 31 | DO K=1,N 32 | 33 | C Copy two input bytes to equivalenced memory. 34 | C2(1:2)=STRING(2*K-1:2*K) 35 | 36 | C Copy equivalenced memory to the output two-byte integer. 37 | I2BUF(K)=J2 38 | ENDDO 39 | 40 | C Done. 41 | RETURN 42 | END 43 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/read_i4.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE READ_I4(STRING,I4) 2 | 3 | C Thomas Matejka NOAA/NSSL 25 May 1994 4 | 5 | C This subroutine interprets four unformatted bytes as a four-byte 6 | C integer. 7 | 8 | C Input: 9 | 10 | C STRING is a character string whose first four unformatted bytes are 11 | C to be interpreted as a four-byte integer. 12 | 13 | C Output: 14 | 15 | C I4 is the four-byte integer that corresponds to the four unformatted 16 | C bytes. 17 | 18 | IMPLICIT NONE 19 | CHARACTER*4 C4 20 | CHARACTER*(*) STRING 21 | INTEGER*4 I4,J4 22 | EQUIVALENCE(C4,J4) 23 | 24 | C Copy four input bytes to equivalenced memory. 25 | C4(1:4)=STRING(1:4) 26 | 27 | C Copy equivalenced memory to the output four-byte integer. 28 | I4=J4 29 | 30 | C Done. 31 | RETURN 32 | END 33 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/read_i4_buf.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE READ_I4_BUF(STRING,N,I4BUF) 2 | 3 | C Thomas Matejka NOAA/NSSL 9 February 1996 4 | 5 | C This subroutine interprets a series of sets of four unformatted bytes 6 | C as a one-dimensional array of four-byte integers. 7 | 8 | C Input: 9 | 10 | C STRING is a character string whose first 4*N unformatted bytes are to 11 | C be interpreted as N four-byte integers. 12 | 13 | C N is an integer variable that specifies the number of sets of four 14 | C unformatted bytes in STRING and the number of elements in I4BUF. 15 | 16 | C Output: 17 | 18 | C I4BUF is a one-dimensional integer*4 array. I4BUF(I) is the Ith 19 | C four-byte integer that corresponds to the Ith set of four unformatted 20 | C bytes. 21 | 22 | IMPLICIT NONE 23 | CHARACTER*4 C4 24 | CHARACTER*(*) STRING 25 | INTEGER*4 J4 26 | INTEGER*4 I4BUF(N) 27 | INTEGER N,K 28 | EQUIVALENCE(C4,J4) 29 | 30 | C Loop through the sets of four unformatted bytes. 31 | DO K=1,N 32 | 33 | C Copy four input bytes to equivalenced memory. 34 | C4(1:4)=STRING(4*K-3:4*K) 35 | 36 | C Copy equivalenced memory to the output four-byte integer. 37 | I4BUF(K)=J4 38 | ENDDO 39 | 40 | C Done. 41 | RETURN 42 | END 43 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/read_r4.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE READ_R4(STRING,R4) 2 | 3 | C Thomas Matejka NOAA/NSSL 25 May 1994 4 | 5 | C This subroutine interprets four unformatted bytes as a four-byte 6 | C floating-point number. 7 | 8 | C Input: 9 | 10 | C STRING is a character string whose first four unformatted bytes are 11 | C to be interpreted as a four-byte floating-point number. 12 | 13 | C Output: 14 | 15 | C R4 is the four-byte floating-point number that corresponds to the 16 | C four unformatted bytes. 17 | 18 | IMPLICIT NONE 19 | CHARACTER*4 C4 20 | CHARACTER*(*) STRING 21 | REAL*4 R4,S4 22 | EQUIVALENCE(C4,S4) 23 | 24 | C Copy four input bytes to equivalenced memory. 25 | C4(1:4)=STRING(1:4) 26 | 27 | C Copy equivalenced memory to the output four-byte floating-point 28 | C number. 29 | R4=S4 30 | 31 | C Done. 32 | RETURN 33 | END 34 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/read_r4_buf.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE READ_R4_BUF(STRING,N,R4BUF) 2 | 3 | C Thomas Matejka NOAA/NSSL 9 February 1996 4 | 5 | C This subroutine interprets a series of sets of four unformatted bytes 6 | C as a one-dimensional array of four-byte floating-point numbers. 7 | 8 | C Input: 9 | 10 | C STRING is a character string whose first 4*N unformatted bytes are to 11 | C be interpreted as N four-byte floating-point numbers. 12 | 13 | C N is an integer variable that specifies the number of sets of four 14 | C unformatted bytes in STRING and the number of elements in R4BUF. 15 | 16 | C Output: 17 | 18 | C R4BUF is a one-dimensional real*4 array. R4BUF(I) is the Ith 19 | C four-byte floating-point number that corresponds to the Ith set of 20 | C four unformatted bytes. 21 | 22 | IMPLICIT NONE 23 | CHARACTER*4 C4 24 | CHARACTER*(*) STRING 25 | REAL*4 S4 26 | REAL*4 R4BUF(N) 27 | INTEGER N,K 28 | EQUIVALENCE(C4,S4) 29 | 30 | C Loop through the sets of four unformatted bytes. 31 | DO K=1,N 32 | 33 | C Copy four input bytes to equivalenced memory. 34 | C4(1:4)=STRING(4*K-3:4*K) 35 | 36 | C Copy equivalenced memory to the output four-byte floating-point 37 | C number. 38 | R4BUF(K)=S4 39 | ENDDO 40 | 41 | C Done. 42 | RETURN 43 | END 44 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/replace_character.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE REPLACE_CHARACTER(STRING,OLD_CHAR,NEW_CHAR) 2 | 3 | C Thomas Matejka NOAA/NSSL 15 March 1993 4 | 5 | C This subroutine replaces all occurrences of the character OLD_CHAR 6 | C with the character NEW_CHAR in the string STRING. 7 | 8 | IMPLICIT NONE 9 | CHARACTER OLD_CHAR,NEW_CHAR 10 | CHARACTER*(*) STRING 11 | INTEGER IEND,I 12 | 13 | IEND=LEN(STRING) 14 | DO 1 I=1,IEND 15 | IF(STRING(I:I).EQ.OLD_CHAR)THEN 16 | STRING(I:I)=NEW_CHAR 17 | ENDIF 18 | 1 CONTINUE 19 | RETURN 20 | END 21 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/right_justify.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE RIGHT_JUSTIFY(STRING) 2 | 3 | C Thomas Matejka NOAA/NSSL 17 May 2000 4 | 5 | IMPLICIT NONE 6 | CHARACTER(LEN=*)::STRING 7 | INTEGER::I,L 8 | 9 | IF(STRING.NE.'')THEN 10 | L=LEN(STRING) 11 | DO I=L,1,-1 12 | IF(STRING(I:I).NE.'')THEN 13 | EXIT 14 | ENDIF 15 | ENDDO 16 | IF(I.LT.L)THEN 17 | STRING(L-I+1:L)=STRING(1:I) 18 | STRING(1:L-I)='' 19 | ENDIF 20 | ENDIF 21 | 22 | END SUBROUTINE RIGHT_JUSTIFY 23 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/rng01.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE RNG01(INSEED,RN) 2 | 3 | C Thomas Matejka NOAA/NSSL 11 November 1993 4 | 5 | C This subroutine generates RN, a real random number evenly distributed 6 | C between 0. and 1.. INSEED is an integer that is used to initialize 7 | C the algorithm the first time the subroutine is called. 8 | 9 | IMPLICIT NONE 10 | LOGICAL FIRST_TIME 11 | INTEGER*4 INSEED,SEED,M,I 12 | REAL RN,A 13 | DATA FIRST_TIME/.TRUE./ 14 | SAVE FIRST_TIME,SEED,M,A,I 15 | 16 | IF(FIRST_TIME)THEN 17 | FIRST_TIME=.FALSE. 18 | M=2**20 19 | A=FLOAT(M) 20 | I=2**10+3 21 | SEED=100001+IFIX((999999.-100001.)*FLOAT(INSEED-1)/(32767.-1.)) 22 | IF(MOD(SEED,2).EQ.0)THEN 23 | SEED=SEED+1 24 | ENDIF 25 | ENDIF 26 | SEED=MOD(I*SEED,M) 27 | RN=FLOAT(SEED)/A 28 | RETURN 29 | END 30 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/rngab.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE RNGAB(INSEED,RN_MIN,RN_MAX,RN) 2 | 3 | C Thomas Matejka NOAA/NSSL 11 November 1993 4 | 5 | C This subroutine generates RN, a real random number evenly distributed 6 | C between RN_MIN and RN_MAX. INSEED is an integer that is used to 7 | C initialize the algorithm the first time the subroutine is called. 8 | 9 | IMPLICIT NONE 10 | LOGICAL FIRST_TIME 11 | INTEGER*4 INSEED,SEED,M,I 12 | REAL RN_MIN,RN_MAX,RN,A 13 | DATA FIRST_TIME/.TRUE./ 14 | SAVE FIRST_TIME,SEED,M,A,I 15 | 16 | IF(FIRST_TIME)THEN 17 | FIRST_TIME=.FALSE. 18 | M=2**20 19 | A=FLOAT(M) 20 | I=2**10+3 21 | SEED=100001+IFIX((999999.-100001.)*FLOAT(INSEED-1)/(32767.-1.)) 22 | IF(MOD(SEED,2).EQ.0)THEN 23 | SEED=SEED+1 24 | ENDIF 25 | ENDIF 26 | SEED=MOD(I*SEED,M) 27 | RN=FLOAT(SEED)*(RN_MAX-RN_MIN)/A+RN_MIN 28 | RETURN 29 | END 30 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/rngij.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE RNGIJ(INSEED,IRN_MIN,IRN_MAX,IRN) 2 | 3 | C Thomas Matejka NOAA/NSSL 11 November 1993 4 | 5 | C This subroutine generates IRN, an integer random number evenly 6 | C distributed between IRN_MIN and IRN_MAX. INSEED is an integer that 7 | C is used to initialize the algorithm the first time the subroutine is 8 | C called. 9 | 10 | IMPLICIT NONE 11 | LOGICAL FIRST_TIME 12 | INTEGER*4 INSEED,SEED,M,I,IRN_MIN,IRN_MAX,IRN 13 | REAL A,RN 14 | DATA FIRST_TIME/.TRUE./ 15 | SAVE FIRST_TIME,SEED,M,A,I 16 | 17 | IF(FIRST_TIME)THEN 18 | FIRST_TIME=.FALSE. 19 | M=2**20 20 | A=FLOAT(M) 21 | I=2**10+3 22 | SEED=100001+IFIX((999999.-100001.)*FLOAT(INSEED-1)/(32767.-1.)) 23 | IF(MOD(SEED,2).EQ.0)THEN 24 | SEED=SEED+1 25 | ENDIF 26 | ENDIF 27 | SEED=MOD(I*SEED,M) 28 | RN=FLOAT(SEED)*FLOAT(IRN_MAX-IRN_MIN+1)/A+FLOAT(IRN_MIN)-0.5 29 | IRN=IFIX(RN+SIGN(0.5,RN)) 30 | RETURN 31 | END 32 | 33 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/rngn.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE RNGN(INSEED,RN_MEAN,RN_STDEV,RN) 2 | 3 | C Thomas Matejka NOAA/NSSL 11 November 1993 4 | 5 | C This subroutine generates RN, a real random number normally 6 | C distributed around RN_MEAN with a standard devaition RN_STDEV. 7 | C INSEED is an integer that is used to initialize the algorithm the 8 | C first time the subroutine is called. 9 | 10 | IMPLICIT NONE 11 | INCLUDE 'include_constants.inc' 12 | LOGICAL FIRST_TIME 13 | INTEGER*4 INSEED,SEED,M,I 14 | REAL RN_MEAN,RN_STDEV,RN,A,X1,X2 15 | DATA FIRST_TIME/.TRUE./ 16 | SAVE FIRST_TIME,SEED,M,A,I 17 | 18 | IF(FIRST_TIME)THEN 19 | FIRST_TIME=.FALSE. 20 | M=2**20 21 | A=FLOAT(M) 22 | I=2**10+3 23 | SEED=100001+IFIX((999999.-100001.)*FLOAT(INSEED-1)/(32767.-1.)) 24 | IF(MOD(SEED,2).EQ.0)THEN 25 | SEED=SEED+1 26 | ENDIF 27 | ENDIF 28 | SEED=MOD(I*SEED,M) 29 | X1=FLOAT(SEED)/A 30 | SEED=MOD(I*SEED,M) 31 | X2=FLOAT(SEED)/A 32 | RN=RN_STDEV*SQRT(-2.*ALOG(X1))*COS(2.*PI*X2)+RN_MEAN 33 | RETURN 34 | END 35 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/round.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION ROUND(X,Y) 2 | 3 | C Thomas Matejka NOAA/NSSL 18 February 1993 4 | 5 | C This function returns X rounded to the nearest Y. 6 | 7 | IMPLICIT NONE 8 | REAL X,Y,YY 9 | 10 | IF(Y.EQ.0.)THEN 11 | ROUND=X 12 | ELSE 13 | YY=ABS(Y) 14 | ROUND=YY*AINT((X+YY*SIGN(0.5,X))/YY) 15 | ENDIF 16 | RETURN 17 | END 18 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/round_signif.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION ROUND_SIGNIF(A,NSIG) 2 | 3 | C Thomas Matejka NOAA/NSSL 18 February 1993 4 | 5 | C This function returns A rounded so as to include only NSIG 6 | C significant digits. 7 | 8 | IMPLICIT NONE 9 | REAL ROUND 10 | INTEGER NSIG,N,IEXP 11 | REAL A,B 12 | 13 | IF(NSIG.LE.0)THEN 14 | N=1 15 | ELSE 16 | N=NSIG 17 | ENDIF 18 | IF(A.NE.0.)THEN 19 | B=ALOG10(ABS(A)) 20 | IEXP=IFIX(B)+1 21 | IF(B.LT.0..AND. 22 | $ AMOD(B,1.).NE.0.)THEN 23 | IEXP=IEXP-1 24 | ENDIF 25 | ELSE 26 | IEXP=1 27 | ENDIF 28 | ROUND_SIGNIF=ROUND(A/10.**IEXP,10.**(-N))*10.**IEXP 29 | RETURN 30 | END 31 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/s_l.f: -------------------------------------------------------------------------------- 1 | INTEGER FUNCTION S_L(STRING) 2 | 3 | C Thomas Matejka NOAA/NSSL 7 June 2002 4 | 5 | C This function returns the length of the string STRING to the last 6 | C non-blank character. If STRING contains only blanks, then the 7 | C function returns 0. If STRING contains no blanks, then the function 8 | C returns the length of STRING. 9 | 10 | IMPLICIT NONE 11 | CHARACTER(LEN=*)::STRING 12 | INTEGER::I,IEND 13 | 14 | IEND=LEN(STRING) 15 | DO I=IEND,1,-1 16 | IF(STRING(I:I).NE.' ')THEN 17 | S_L=I 18 | RETURN 19 | ENDIF 20 | ENDDO 21 | S_L=0 22 | 23 | END FUNCTION S_L 24 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/sf_f_dp.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE SF_R_DP(A,D,F) 2 | 3 | C Thomas Matejka NOAA/NSSL 17 May 2000 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'tmmlib.inc' 7 | CHARACTER(LEN=*)::F 8 | INTEGER::N,D 9 | REAL::A,B 10 | 11 | IF(D.LT.0)THEN 12 | WRITE(TMMLIB_MESSAGE_UNIT,*)'SF_R_DP: D MUST BE AT LEAST 0.' 13 | STOP 14 | ENDIF 15 | 16 | B=ABS(A) 17 | IF(B.GE.1.)THEN 18 | N=IFIX(ALOG10(B))+2+D 19 | ELSE 20 | N=1+D 21 | ENDIF 22 | IF(A.LT.0.)THEN 23 | N=N+1 24 | ENDIF 25 | 26 | F='' 27 | CALL APPEND_STRING(0,'F',F) 28 | CALL APPEND_INTEGER(0,N,F) 29 | CALL APPEND_STRING(0,'.',F) 30 | CALL APPEND_INTEGER(0,D,F) 31 | 32 | END SUBROUTINE SF_R_DP 33 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/sf_i.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE SF_I(I,F) 2 | 3 | C Thomas Matejka NOAA/NSSL 21 October 1998 4 | 5 | IMPLICIT NONE 6 | CHARACTER(LEN=*)::F 7 | INTEGER::I,N 8 | 9 | IF(I.EQ.0)THEN 10 | N=1 11 | ELSE 12 | N=IFIX(ALOG10(FLOAT(IABS(I))))+1 13 | IF(I.LT.0)THEN 14 | N=N+1 15 | ENDIF 16 | ENDIF 17 | 18 | F='' 19 | CALL APPEND_STRING(0,'I',F) 20 | CALL APPEND_INTEGER(0,N,F) 21 | 22 | END SUBROUTINE SF_I 23 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/sf_r_fix_trunc.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE SF_R_FIX_TRUNC(A,N,D,F) 2 | 3 | C Thomas Matejka NOAA/NSSL 21 October 1998 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'tmmlib.inc' 7 | CHARACTER(LEN=MAX_STRING)::STRING 8 | CHARACTER(LEN=*)::F 9 | INTEGER::N,D,I 10 | REAL::A 11 | 12 | IF(N.LT.1)THEN 13 | WRITE(TMMLIB_MESSAGE_UNIT,*)'SF_R_FIX_TRUNC: N MUST BE AT ', 14 | $ 'LEAST 1.' 15 | STOP 16 | ENDIF 17 | IF(D.LT.0)THEN 18 | WRITE(TMMLIB_MESSAGE_UNIT,*)'SF_R_FIX_TRUNC: D MUST BE AT ', 19 | $ 'LEAST 0.' 20 | STOP 21 | ENDIF 22 | 23 | IF(A.EQ.0.)THEN 24 | F='' 25 | CALL APPEND_STRING(0,'I',F) 26 | CALL APPEND_STRING(0,N,F) 27 | RETURN 28 | ENDIF 29 | 30 | F='' 31 | CALL APPEND_STRING(0,'F',F) 32 | CALL APPEND_INTEGER(0,N,F) 33 | CALL APPEND_STRING(0,'.',F) 34 | CALL APPEND_INTEGER(0,D,F) 35 | 36 | WRITE(STRING,"("//F//")")A 37 | DO I=N,1,-1 38 | IF(STRING(I:I).EQ.'.')THEN 39 | F='' 40 | CALL APPEND_STRING(0,'I',F) 41 | CALL APPEND_INTEGER(0,N,F) 42 | EXIT 43 | ELSEIF(STRING(I:I).NE.'0')THEN 44 | F='' 45 | CALL APPEND_STRING(0,'F',F) 46 | CALL APPEND_INTEGER(0,N,F) 47 | CALL APPEND_STRING(0,'.',F) 48 | CALL APPEND_INTEGER(0,D-N+I,F) 49 | EXIT 50 | ENDIF 51 | ENDDO 52 | 53 | END SUBROUTINE SF_R_FIX_TRUNC 54 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/sf_r_sig.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE SF_R_SIG(A,S,F) 2 | 3 | C Thomas Matejka NOAA/NSSL 21 October 1998 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'tmmlib.inc' 7 | CHARACTER(LEN=*)::F 8 | INTEGER::S,N,D,Q 9 | REAL::A,C 10 | 11 | IF(S.LT.1)THEN 12 | WRITE(TMMLIB_MESSAGE_UNIT,*)'SF_R_SIG: S MUST BE AT LEAST 1.' 13 | STOP 14 | ENDIF 15 | 16 | IF(A.EQ.0.)THEN 17 | N=1+S 18 | D=S 19 | ELSE 20 | C=ALOG10(ABS(A)) 21 | Q=IFIX(C) 22 | IF(C.LT.0..AND. 23 | $ AMOD(C,1.).NE.0.)THEN 24 | Q=Q-1 25 | ENDIF 26 | IF(Q.LT.0)THEN 27 | N=S-Q 28 | D=S-Q-1 29 | ELSEIF(Q.GE.S-1)THEN 30 | N=Q+2 31 | D=0 32 | ELSE 33 | N=S+1 34 | D=S-Q-1 35 | ENDIF 36 | IF(A.LT.0.)THEN 37 | N=N+1 38 | ENDIF 39 | ENDIF 40 | 41 | F='' 42 | CALL APPEND_STRING(0,'F',F) 43 | CALL APPEND_INTEGER(0,N,F) 44 | CALL APPEND_STRING(0,'.',F) 45 | CALL APPEND_INTEGER(0,D,F) 46 | 47 | END SUBROUTINE SF_R_SIG 48 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/sf_r_sig_fix.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE SF_R_SIG_FIX(A,N,S,F) 2 | 3 | C Thomas Matejka NOAA/NSSL 21 October 1998 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'tmmlib.inc' 7 | CHARACTER(LEN=*)::F 8 | INTEGER::S,N,D,Q 9 | REAL::A,C 10 | 11 | IF(S.LT.1)THEN 12 | WRITE(TMMLIB_MESSAGE_UNIT,*)'SF_R_SIG_FIX: S MUST BE AT ', 13 | $ 'LEAST 1.' 14 | STOP 15 | ENDIF 16 | 17 | IF(A.EQ.0.)THEN 18 | D=S 19 | ELSE 20 | C=ALOG10(ABS(A)) 21 | Q=IFIX(C) 22 | IF(C.LT.0..AND. 23 | $ AMOD(C,1.).NE.0.)THEN 24 | Q=Q-1 25 | ENDIF 26 | IF(Q.LT.0)THEN 27 | D=S-Q-1 28 | ELSEIF(Q.GE.S-1)THEN 29 | D=0 30 | ELSE 31 | D=S-Q-1 32 | ENDIF 33 | ENDIF 34 | 35 | F='' 36 | CALL APPEND_STRING(0,'F',F) 37 | CALL APPEND_INTEGER(0,N,F) 38 | CALL APPEND_STRING(0,'.',F) 39 | CALL APPEND_INTEGER(0,D,F) 40 | 41 | END SUBROUTINE SF_R_SIG_FIX 42 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/sf_r_trunc.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE SF_R_TRUNC(A,D,F) 2 | 3 | C Thomas Matejka NOAA/NSSL 21 October 1998 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'tmmlib.inc' 7 | CHARACTER(LEN=MAX_STRING)::STRING 8 | CHARACTER(LEN=*)::F 9 | INTEGER::N,D,I 10 | REAL::A,B 11 | 12 | IF(D.LT.0)THEN 13 | WRITE(TMMLIB_MESSAGE_UNIT,*)'SF_R_TRUNC: D MUST BE AT LEAST ', 14 | $ '0.' 15 | STOP 16 | ENDIF 17 | 18 | IF(A.EQ.0.)THEN 19 | F='I1' 20 | RETURN 21 | ENDIF 22 | 23 | B=ABS(A) 24 | IF(B.GE.1.)THEN 25 | N=IFIX(ALOG10(B))+2+D 26 | ELSE 27 | N=1+D 28 | ENDIF 29 | IF(A.LT.0.)THEN 30 | N=N+1 31 | ENDIF 32 | 33 | F='' 34 | CALL APPEND_STRING(0,'F',F) 35 | CALL APPEND_INTEGER(0,N,F) 36 | CALL APPEND_STRING(0,'.',F) 37 | CALL APPEND_INTEGER(0,D,F) 38 | 39 | WRITE(STRING,"("//F//")")A 40 | DO I=N,1,-1 41 | IF(STRING(I:I).EQ.'.')THEN 42 | F='' 43 | CALL APPEND_STRING(0,'I',F) 44 | CALL APPEND_INTEGER(0,I-1,F) 45 | EXIT 46 | ELSEIF(STRING(I:I).NE.'0')THEN 47 | F='' 48 | CALL APPEND_STRING(0,'F',F) 49 | CALL APPEND_INTEGER(0,I,F) 50 | CALL APPEND_STRING(0,'.',F) 51 | CALL APPEND_INTEGER(0,D-N+I,F) 52 | EXIT 53 | ENDIF 54 | ENDDO 55 | 56 | END SUBROUTINE SF_R_TRUNC 57 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/side1.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE SIDE1(A_IN,SD_A_IN,NX,BADDATA,MAX_SEARCH_RADIUS, 2 | $MAX_VALUES_PER_SIDE,IX,POINTS_FOUND,IX_FOUND) 3 | 4 | IMPLICIT NONE 5 | INTEGER NX,IX,IX_SEARCH,POINTS_FOUND,MAX_SEARCH_RADIUS, 6 | $MAX_VALUES_PER_SIDE 7 | INTEGER IX_FOUND(1) 8 | REAL BADDATA 9 | REAL A_IN(NX),SD_A_IN(NX) 10 | 11 | POINTS_FOUND=0 12 | DO 1 IX_SEARCH=IX-1,IX-MAX_SEARCH_RADIUS 13 | IF(IX_SEARCH.LT.1)THEN 14 | GOTO 3 15 | ENDIF 16 | IF(A_IN(IX_SEARCH).NE.BADDATA.AND. 17 | $ SD_A_IN(IX_SEARCH).NE.BADDATA)THEN 18 | POINTS_FOUND=POINTS_FOUND+1 19 | IX_FOUND(POINTS_FOUND)=IX_SEARCH 20 | IF(POINTS_FOUND.GE.MAX_VALUES_PER_SIDE)THEN 21 | RETURN 22 | ENDIF 23 | ENDIF 24 | 3 CONTINUE 25 | 1 CONTINUE 26 | RETURN 27 | END 28 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/side2.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE SIDE2(A_IN,SD_A_IN,NX,BADDATA,MAX_SEARCH_RADIUS, 2 | $MAX_VALUES_PER_SIDE,IX,POINTS_FOUND,IX_FOUND) 3 | 4 | IMPLICIT NONE 5 | INTEGER NX,IX,IX_SEARCH,POINTS_FOUND,MAX_SEARCH_RADIUS, 6 | $MAX_VALUES_PER_SIDE 7 | INTEGER IX_FOUND(1) 8 | REAL BADDATA 9 | REAL A_IN(NX),SD_A_IN(NX) 10 | 11 | POINTS_FOUND=0 12 | DO 1 IX_SEARCH=IX+1,IX+MAX_SEARCH_RADIUS 13 | IF(IX_SEARCH.GT.NX)THEN 14 | GOTO 3 15 | ENDIF 16 | IF(A_IN(IX_SEARCH).NE.BADDATA.AND. 17 | $ SD_A_IN(IX_SEARCH).NE.BADDATA)THEN 18 | POINTS_FOUND=POINTS_FOUND+1 19 | IX_FOUND(POINTS_FOUND)=IX_SEARCH 20 | IF(POINTS_FOUND.GE.MAX_VALUES_PER_SIDE)THEN 21 | RETURN 22 | ENDIF 23 | ENDIF 24 | 3 CONTINUE 25 | 1 CONTINUE 26 | RETURN 27 | END 28 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/sindeg.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION SINDEG(X) 2 | 3 | C Thomas Matejka NOAA/NSSL 23 February 1993 4 | 5 | C This function returns the sine of X, where X is in degrees. 6 | 7 | IMPLICIT NONE 8 | INCLUDE 'include_constants.inc' 9 | REAL::X 10 | 11 | SINDEG=SIN(X*RADDEG) 12 | 13 | END FUNCTION SINDEG 14 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/smart_integer.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE SMART_INTEGER(I,STRING_OUT) 2 | 3 | C Thomas Matejka NOAA/NSSL 22 May 2000 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'tmmlib.inc' 7 | INTEGER,EXTERNAL::S_L 8 | CHARACTER(LEN=MAX_STRING)::STRING 9 | CHARACTER(LEN=*)::STRING_OUT 10 | INTEGER::I,L,IEND 11 | 12 | C Initialize. 13 | STRING='' 14 | STRING_OUT='' 15 | L=LEN(STRING_OUT) 16 | 17 | WRITE(STRING,*)I 18 | IF(S_L(STRING).GE.MAX_STRING)THEN 19 | WRITE(TMMLIB_MESSAGE_UNIT,*)'SMART_INTEGER: MEMORY EXCEEDED. ', 20 | $ 'INCREASE MAX_STRING.' 21 | STOP 22 | ENDIF 23 | CALL LEFT_JUSTIFY(STRING) 24 | IEND=S_L(STRING) 25 | IF(IEND.GT.L)THEN 26 | WRITE(TMMLIB_MESSAGE_UNIT,*)'SMART_INTEGER: STRING_OUT IS ', 27 | $ 'TOO SHORT.' 28 | STOP 29 | ENDIF 30 | STRING_OUT(1:IEND)=STRING(1:IEND) 31 | 32 | END SUBROUTINE SMART_INTEGER 33 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/string_length.f: -------------------------------------------------------------------------------- 1 | INTEGER FUNCTION STRING_LENGTH(STRING) 2 | 3 | C Thomas Matejka NOAA/NSSL 19 May 2000 4 | 5 | C This function returns the length of the string STRING to the last 6 | C non-blank character. If STRING contains only blanks, then the 7 | C function returns 0. If STRING contains no blanks, then the function 8 | C returns the length of STRING. 9 | 10 | IMPLICIT NONE 11 | CHARACTER(LEN=*)::STRING 12 | INTEGER::I,IEND 13 | 14 | IEND=LEN(STRING) 15 | DO I=IEND,1,-1 16 | IF(STRING(I:I).NE.' ')THEN 17 | STRING_LENGTH=I 18 | RETURN 19 | ENDIF 20 | ENDDO 21 | STRING_LENGTH=0 22 | 23 | END FUNCTION STRING_LENGTH 24 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/surrounded_2d.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE SURROUNDED_2D(FIRST,PHI,SURROUNDED) 2 | 3 | C Thomas Matejka, NOAA/NSSL 18 September 1997 4 | 5 | LOGICAL::FIRST,SURROUNDED 6 | REAL::PHI,PHI_PRIME 7 | REAL,SAVE::PHI_1,PHI_PRIME_L,PHI_PRIME_R 8 | 9 | IF(FIRST)THEN 10 | PHI_1=PHI 11 | PHI_PRIME_L=90. 12 | PHI_PRIME_R=270. 13 | SURROUNDED=.FALSE. 14 | ELSE 15 | PHI_PRIME=PHI-PHI_1 16 | IF(PHI_PRIME.LT.0.)THEN 17 | PHI_PRIME=PHI_PRIME+360. 18 | ENDIF 19 | IF(PHI_PRIME.GT.PHI_PRIME_L-90..AND. 20 | $ PHI_PRIME.LT.PHI_PRIME_L+90.)THEN 21 | PHI_PRIME_L=PHI_PRIME+90. 22 | ELSEIF(PHI_PRIME.GE.PHI_PRIME_R-90..AND. 23 | $ PHI_PRIME.LT.PHI_PRIME_R+90.)THEN 24 | PHI_PRIME_R=PHI_PRIME-90. 25 | ENDIF 26 | IF(PHI_PRIME_L.GT.PHI_PRIME_R)THEN 27 | SURROUNDED=.TRUE. 28 | ELSE 29 | SURROUNDED=.FALSE. 30 | ENDIF 31 | ENDIF 32 | END 33 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/tandeg.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION TANDEG(X) 2 | 3 | C Thomas Matejka NOAA/NSSL 23 Feburary 1993 4 | 5 | C This function returns the tangent of X, where X is in degrees. 6 | 7 | IMPLICIT NONE 8 | INCLUDE 'include_constants.inc' 9 | REAL::X 10 | 11 | TANDEG=TAN(X*RADDEG) 12 | 13 | END FUNCTION TANDEG 14 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/write_i2.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE WRITE_I2(I2,STRING) 2 | 3 | C Thomas Matejka NOAA/NSSL 9 February 1996 4 | 5 | C This subroutine interprets a two-byte integer as two unformatted 6 | C bytes. 7 | 8 | C Input: 9 | 10 | C I2 is a two-byte integer to be interpreted as two unformatted bytes. 11 | 12 | C Output: 13 | 14 | C STRING is the character string whose first two unformatted bytes 15 | C correspond to the two-byte integer. 16 | 17 | IMPLICIT NONE 18 | CHARACTER*2 C2 19 | CHARACTER*(*) STRING 20 | INTEGER*2 I2,J2 21 | EQUIVALENCE(C2,J2) 22 | 23 | C Copy the input two-byte integer to equivalenced memory. 24 | J2=I2 25 | 26 | C Copy equivalenced memory to the two output bytes. 27 | STRING(1:2)=C2(1:2) 28 | 29 | C Done. 30 | RETURN 31 | END 32 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/write_i2_buf.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE WRITE_I2_BUF(I2BUF,N,STRING) 2 | 3 | C Thomas Matejka NOAA/NSSL 9 February 1996 4 | 5 | C This subroutine interprets a one-dimensional array of two-byte 6 | C integers as a series of sets of two unformatted bytes. 7 | 8 | C Input: 9 | 10 | C I2BUF is a one-dimensional integer*2 array. I2BUF(I) is the Ith 11 | C two-byte integer to be interpreted as the Ith set of two unformatted 12 | C bytes. 13 | 14 | C N is an integer variable that specifies the number of elements in 15 | C I2BUF and the number of sets of two unformatted bytes in STRING. 16 | 17 | C Output: 18 | 19 | C STRING is the character string whose first 2*N unformatted bytes 20 | C correspond to N two-byte integers. 21 | 22 | IMPLICIT NONE 23 | CHARACTER*2 C2 24 | CHARACTER*(*) STRING 25 | INTEGER*2 J2 26 | INTEGER*2 I2BUF(N) 27 | INTEGER N,K 28 | EQUIVALENCE(C2,J2) 29 | 30 | C Loop through the sets of two unformatted bytes. 31 | DO K=1,N 32 | 33 | C Copy the input two-byte integer to equivalenced memory. 34 | J2=I2BUF(K) 35 | 36 | C Copy equivalenced memory to the two output bytes. 37 | STRING(2*K-1:2*K)=C2(1:2) 38 | ENDDO 39 | 40 | C Done. 41 | RETURN 42 | END 43 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/write_i4.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE WRITE_I4(I4,STRING) 2 | 3 | C Thomas Matejka NOAA/NSSL 9 February 1996 4 | 5 | C This subroutine interprets a four-byte integer as four unformatted 6 | C bytes. 7 | 8 | C Input: 9 | 10 | C I4 is a four-byte integer to be interpreted as four unformatted 11 | C bytes. 12 | 13 | C Output: 14 | 15 | C STRING is the character string whose first four unformatted bytes 16 | C correspond to the four-byte integer. 17 | 18 | IMPLICIT NONE 19 | CHARACTER*4 C4 20 | CHARACTER*(*) STRING 21 | INTEGER*4 I4,J4 22 | EQUIVALENCE(C4,J4) 23 | 24 | C Copy the input four-byte integer to equivalenced memory. 25 | J4=I4 26 | 27 | C Copy equivalenced memory to the four output bytes. 28 | STRING(1:4)=C4(1:4) 29 | 30 | C Done. 31 | RETURN 32 | END 33 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/write_i4_buf.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE WRITE_I4_BUF(I4BUF,N,STRING) 2 | 3 | C Thomas Matejka NOAA/NSSL 9 February 1996 4 | 5 | C This subroutine interprets a one-dimensional array of four-byte 6 | C integers as a series of sets of four unformatted bytes. 7 | 8 | C Input: 9 | 10 | C I4BUF is a one-dimensional integer*4 array. I4BUF(I) is the Ith 11 | C four-byte integer to be interpreted as the Ith set of four 12 | C unformatted bytes. 13 | 14 | C N is an integer variable that specifies the number of elements in 15 | C I4BUF and the number of sets of four unformatted bytes in STRING. 16 | 17 | C Output: 18 | 19 | C STRING is the character string whose first 4*N unformatted bytes 20 | C correspond to N four-byte integers. 21 | 22 | IMPLICIT NONE 23 | CHARACTER*4 C4 24 | CHARACTER*(*) STRING 25 | INTEGER*4 J4 26 | INTEGER*4 I4BUF(N) 27 | INTEGER N,K 28 | EQUIVALENCE(C4,J4) 29 | 30 | C Loop through the sets of four unformatted bytes. 31 | DO K=1,N 32 | 33 | C Copy the input four-byte integer to equivalenced memory. 34 | J4=I4BUF(K) 35 | 36 | C Copy equivalenced memory to the four output bytes. 37 | STRING(4*K-3:4*K)=C4(1:4) 38 | ENDDO 39 | 40 | C Done. 41 | RETURN 42 | END 43 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/write_r4.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE WRITE_R4(R4,STRING) 2 | 3 | C Thomas Matejka NOAA/NSSL 9 February 1996 4 | 5 | C This subroutine interprets a four-byte floating point number as four 6 | C unformatted bytes. 7 | 8 | C Input: 9 | 10 | C R4 is a four-byte floating point number to be interpreted as four 11 | C unformatted bytes. 12 | 13 | C Output: 14 | 15 | C STRING is the character string whose first four unformatted bytes 16 | C correspond to the four-byte floating point number. 17 | 18 | IMPLICIT NONE 19 | CHARACTER*4 C4 20 | CHARACTER*(*) STRING 21 | REAL*4 R4,S4 22 | EQUIVALENCE(C4,S4) 23 | 24 | C Copy the input four-byte integer to equivalenced memory. 25 | S4=R4 26 | 27 | C Copy equivalenced memory to the four output bytes. 28 | STRING(1:4)=C4(1:4) 29 | 30 | C Done. 31 | RETURN 32 | END 33 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/write_r4_buf.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE WRITE_R4_BUF(R4BUF,N,STRING) 2 | 3 | C Thomas Matejka NOAA/NSSL 9 February 1996 4 | 5 | C This subroutine interprets a one-dimensional array of four-byte 6 | C floating point numbers as a series of sets of four unformatted bytes. 7 | 8 | C Input: 9 | 10 | C R4BUF is a one-dimensional real*4 array. R4BUF(I) is the Ith 11 | C four-byte floating point number to be interpreted as the Ith set of 12 | C four unformatted bytes. 13 | 14 | C N is an integer variable that specifies the number of elements in 15 | C R4BUF and the number of sets of four unformatted bytes in STRING. 16 | 17 | C Output: 18 | 19 | C STRING is the character string whose first 4*N unformatted bytes 20 | C correspond to N four-byte floating-point numbers. 21 | 22 | IMPLICIT NONE 23 | CHARACTER*4 C4 24 | CHARACTER*(*) STRING 25 | REAL*4 S4 26 | REAL*4 R4BUF(N) 27 | INTEGER N,K 28 | EQUIVALENCE(C4,S4) 29 | 30 | C Loop through the sets of four unformatted bytes. 31 | DO K=1,N 32 | 33 | C Copy the input four-byte floating point number to equivalenced 34 | C memory. 35 | S4=R4BUF(K) 36 | 37 | C Copy equivalenced memory to the four output bytes. 38 | STRING(4*K-3:4*K)=C4(1:4) 39 | ENDDO 40 | 41 | C Done. 42 | RETURN 43 | END 44 | -------------------------------------------------------------------------------- /awot/src/libs/libtmg/x_to_dbx.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION X_TO_DBX(X) 2 | 3 | C Thomas Matejka NOAA/NSSL 18 Februrary 1993 4 | 5 | C This function converts X from a linear value to decibels. 6 | 7 | IMPLICIT NONE 8 | REAL X 9 | 10 | X_TO_DBX=10.*ALOG10(X) 11 | RETURN 12 | END 13 | -------------------------------------------------------------------------------- /awot/src/libs/libtmr.so: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nguy/AWOT/cf1a9f7632382a289063ee6e9c401222e2e10791/awot/src/libs/libtmr.so -------------------------------------------------------------------------------- /awot/src/libs/libtmr/dealias.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE DEALIAS(V_IN,V_NYQUIST,V_CENTER,V_OUT,IFOLD) 2 | 3 | C Thomas Matejka 10 January 1995 4 | 5 | C This subroutine dealiases a value. 6 | 7 | C Input: 8 | 9 | C V_IN is a real variable that specifies a possibly aliased value. 10 | 11 | C V_NYQUIST is a real variable that specifies one half of the total 12 | C unambiguous range of V_IN. 13 | 14 | C V_CENTER is a real variable that specifies the center of the 15 | C unambiguous range to dealias V_IN into. 16 | 17 | C Output: 18 | 19 | C V_OUT is a real variable that returns the dealiased value of V_IN. 20 | 21 | C IFOLD is an integer variable that specifies the number of unambiguous 22 | C ranges added to V_IN to dealias it. 23 | 24 | IMPLICIT NONE 25 | INTEGER IFOLD 26 | REAL V_IN,V_OUT,V_CENTER,V_NYQUIST,X 27 | 28 | X=(V_CENTER-V_IN)/(2.*V_NYQUIST) 29 | IFOLD=IFIX(X+SIGN(0.5,X)) 30 | IF(AMOD(V_CENTER-V_IN-SIGN(V_NYQUIST,V_CENTER-V_IN),2.*V_NYQUIST) 31 | $.EQ.0.)THEN 32 | IFOLD=IFOLD-IFIX(SIGN(1.,X)) 33 | ENDIF 34 | V_OUT=V_IN+FLOAT(IFOLD)*2.*V_NYQUIST 35 | RETURN 36 | END 37 | -------------------------------------------------------------------------------- /awot/src/libs/libtmr/echo_power.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION ECHO_POWER(POWER_T,GAIN,BW_AZ,BW_EL,PULSE_DUR, 2 | $WAVELENGTH,K2,RANGE,ZE) 3 | 4 | C Thomas Matejka NOAA/NSSL 22 March 1993 5 | 6 | C This function returns the echo power received at a radar. 7 | 8 | C POWER_T is the transmitted power. 9 | 10 | C GAIN is the antenna gain. 11 | 12 | C BW_AZ is the beam width in the azimuthal direction (deg). 13 | 14 | C BW_EL is the beam width in the elevation direction (deg). 15 | 16 | C PULSE_DUR is the pulse duration. 17 | 18 | C WAVELENGTH is the wavelength. 19 | 20 | C K2 is the term |K|**2 involving the index of refraction of the 21 | C targets. 22 | 23 | C RANGE is the distance to the target. 24 | 25 | C ZE is the equivalent reflectivity factor of the target. 26 | 27 | IMPLICIT NONE 28 | INCLUDE 'include_constants.inc' 29 | REAL POWER_T,GAIN,BW_AZ,BW_EL,PULSE_DUR,WAVELENGTH,K2,RANGE,ZE, 30 | $BW_AZ_RAD,BW_EL_RAD 31 | 32 | BW_AZ_RAD=BW_AZ*RADDEG 33 | BW_EL_RAD=BW_EL*RADDEG 34 | ECHO_POWER=C_LIGHT*PI**3*POWER_T*GAIN**2*BW_AZ_RAD*BW_EL_RAD 35 | $*PULSE_DUR*K2*ZE/(1024.*ALOG(2.)*WAVELENGTH**2*RANGE**2) 36 | RETURN 37 | END 38 | -------------------------------------------------------------------------------- /awot/src/libs/libtmr/reflectivity_factor.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION REFLECTIVITY_FACTOR(POWER_T,GAIN,BW_AZ,BW_EL, 2 | $PULSE_DUR,WAVELENGTH,K2,RANGE,POWER_R) 3 | 4 | C Thomas Matejka NOAA/NSSL 22 March 1993 5 | 6 | C This function returns the equivalent reflectivity factor of a volume 7 | C target. 8 | 9 | C POWER_T is the transmitted power. 10 | 11 | C GAIN is the antenna gain. 12 | 13 | C BW_AZ is the beam width in the azimuthal direction (deg). 14 | 15 | C BW_EL is the beam width in the elevation direction (deg). 16 | 17 | C PULSE_DUR is the pulse duration. 18 | 19 | C WAVELENGTH is the wavelength. 20 | 21 | C K2 is the term |K|**2 involving the index of refraction of the 22 | C targets. 23 | 24 | C RANGE is the distance to the target. 25 | 26 | C POWER_R is the echo power received at the radar. 27 | 28 | IMPLICIT NONE 29 | INCLUDE 'include_constants.inc' 30 | REAL POWER_T,GAIN,BW_AZ,BW_EL,PULSE_DUR,WAVELENGTH,K2,RANGE, 31 | $POWER_R,BW_AZ_RAD,BW_EL_RAD 32 | 33 | BW_AZ_RAD=BW_AZ*RADDEG 34 | BW_EL_RAD=BW_EL*RADDEG 35 | 36 | REFLECTIVITY_FACTOR=1024.*ALOG(2.)*WAVELENGTH**2*RANGE**2*POWER_R/ 37 | $(C_LIGHT*PI**3*POWER_T*GAIN**2*BW_AZ_RAD*BW_EL_RAD*PULSE_DUR*K2) 38 | RETURN 39 | END 40 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt.so: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nguy/AWOT/cf1a9f7632382a289063ee6e9c401222e2e10791/awot/src/libs/libtmt.so -------------------------------------------------------------------------------- /awot/src/libs/libtmt/ahum.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION AHUM(T,TD) 2 | 3 | C Thomas Matejka NOAA/NSSL 8 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | REAL VAPP 8 | REAL T,TD 9 | 10 | AHUM=MW_H2O*VAPP(TD)/UNIV_GAS/T 11 | RETURN 12 | END 13 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/ahums.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION AHUMS(T) 2 | 3 | C Thomas Matejka NOAA/NSSL 8 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | REAL VAPPS 8 | REAL T 9 | 10 | AHUMS=MW_H2O*VAPPS(T)/UNIV_GAS/T 11 | RETURN 12 | END 13 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/ahumsi.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION AHUMSI(T) 2 | 3 | C Thomas Matejka NOAA/NSSL 8 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL VAPPSI 9 | REAL T 10 | 11 | IF(T.LE.T_FREEZE)THEN 12 | AHUMSI=MW_H2O*VAPPSI(T)/UNIV_GAS/T 13 | ELSE 14 | AHUMSI=TMTLIB_BADFLAG 15 | ENDIF 16 | RETURN 17 | END 18 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/aicblb.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION AICBLB(T,TD,P) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL AMIX,AMIXSI,ALHSUB 9 | LOGICAL AGAIN 10 | INTEGER NITER 11 | REAL T,TD,P,W0,TGUESS,TI1,TI2,W 12 | 13 | W0=AMIX(TD,P) 14 | TGUESS=T_FREEZE+(AMIXSI(T_FREEZE,P)-W0)*ALHSUB(T_FREEZE)/ 15 | $(CP_DRY+W0*CP_VAP) 16 | IF(TGUESS.GE.T)THEN 17 | IF(TD.GT.0.)THEN 18 | TI1=0. 19 | TI2=T_FREEZE 20 | AGAIN=.TRUE. 21 | NITER=0 22 | DOWHILE(AGAIN) 23 | NITER=NITER+1 24 | IF(NITER.GT.MAX_ITERS)THEN 25 | WRITE(TMTLIB_MESSAGE_UNIT,*)'AICBLB: EXCEEDED ', 26 | $ 'MAXIMUM ITERATIONS.' 27 | STOP 28 | ENDIF 29 | AICBLB=(TI1+TI2)/2. 30 | W=AMIXSI(AICBLB,P) 31 | TGUESS=AICBLB+(W-W0)*ALHSUB(AICBLB)/(CP_DRY+W0*CP_VAP) 32 | IF(TGUESS.LT.T-TTOL)THEN 33 | TI1=AICBLB 34 | ELSEIF(TGUESS.GT.T+TTOL)THEN 35 | TI2=AICBLB 36 | ELSE 37 | AGAIN=.FALSE. 38 | ENDIF 39 | ENDDO 40 | ELSE 41 | AICBLB=0. 42 | ENDIF 43 | ELSE 44 | AICBLB=TMTLIB_BADFLAG 45 | ENDIF 46 | RETURN 47 | END 48 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/alhsub.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION ALHSUB(T) 2 | 3 | C Thomas Matejka NOAA/NSSL 8 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL T 9 | 10 | IF(T.LE.T_FREEZE)THEN 11 | ALHSUB=LH_SUB_3PT+(CP_VAP-C_ICE)*(T-T_3PT) 12 | ELSE 13 | ALHSUB=TMTLIB_BADFLAG 14 | ENDIF 15 | RETURN 16 | END 17 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/alhvap.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION ALHVAP(T) 2 | 3 | C Thomas Matejka NOAA/NSSL 8 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | REAL T 8 | 9 | ALHVAP=LH_VAP_3PT+(CP_VAP-C_WAT)*(T-T_3PT) 10 | RETURN 11 | END 12 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/amix.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION AMIX(TD,P) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL VAPP 9 | REAL TD,P,E 10 | 11 | E=VAPP(TD) 12 | IF(E.GE.P)THEN 13 | WRITE(TMTLIB_MESSAGE_UNIT,*)'AMIX: E IS GREATER THAN OR ', 14 | $ 'EQUAL TO P.' 15 | STOP 16 | ENDIF 17 | AMIX=E*MW_H2O/(P-E)/MW_DRY 18 | RETURN 19 | END 20 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/amixs.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION AMIXS(T,P) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL VAPPS 9 | REAL T,P,ES 10 | 11 | ES=VAPPS(T) 12 | IF(ES.GE.P)THEN 13 | WRITE(TMTLIB_MESSAGE_UNIT,*)'AMIXS: ES IS GREATER THAN OR ', 14 | $ 'EQUAL TO P.' 15 | STOP 16 | ENDIF 17 | AMIXS=ES*MW_H2O/(P-ES)/MW_DRY 18 | RETURN 19 | END 20 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/amixsi.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION AMIXSI(T,P) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL VAPPSI 9 | REAL T,P,ESI 10 | 11 | IF(T.LE.T_FREEZE)THEN 12 | ESI=VAPPSI(T) 13 | IF(ESI.GE.P)THEN 14 | WRITE(TMTLIB_MESSAGE_UNIT,*)'AMIXSI: ESI IS GREATER THAN ', 15 | $ 'OR EQUAL TO P.' 16 | STOP 17 | ENDIF 18 | AMIXSI=ESI*MW_H2O/(P-ESI)/MW_DRY 19 | ELSE 20 | AMIXSI=TMTLIB_BADFLAG 21 | ENDIF 22 | RETURN 23 | END 24 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/amolwt.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION AMOLWT(TD,P) 2 | 3 | C Thomas Matejka NOAA/NSSL 8 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | REAL SHUM 8 | REAL TD,P,Q 9 | 10 | Q=SHUM(TD,P) 11 | AMOLWT=1./((1.-Q)/MW_DRY+Q/MW_H2O) 12 | RETURN 13 | END 14 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/av_denclr.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION AV_DENCLR(Z1,TV1,Z2,TV2,Z3,DEN3,Z1_LAYER,Z2_LAYER) 2 | 3 | C Thomas Matejka NOAA/NSSL 20 July 1994 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL DENCLR 9 | REAL Z1,TV1,Z2,TV2,Z3,DEN3,GAMMA,Z1_LAYER,Z2_LAYER,ALPHA,BETA 10 | 11 | IF(Z1_LAYER.NE.Z2_LAYER)THEN 12 | IF(Z2.NE.Z1)THEN 13 | IF(TV2.EQ.TV1)THEN 14 | BETA=-E_GRAV*MW_DRY/(UNIV_GAS*TV1) 15 | AV_DENCLR=DEN3*(EXP(BETA*(Z2_LAYER-Z3))- 16 | $ EXP(BETA*(Z1_LAYER-Z3)))/((Z2_LAYER-Z1_LAYER)*BETA) 17 | ELSE 18 | GAMMA=(TV2-TV1)/(Z2-Z1) 19 | ALPHA=-1.-E_GRAV*MW_DRY/(UNIV_GAS*GAMMA) 20 | AV_DENCLR=DEN3*(DBLE(TV1+GAMMA*(Z2_LAYER-Z1))** 21 | $ (ALPHA+1.)-DBLE(TV1+GAMMA*(Z1_LAYER-Z1))**(ALPHA+1.))/ 22 | $ ((Z2_LAYER-Z1_LAYER)*DBLE(TV1+GAMMA*(Z3-Z1))**ALPHA* 23 | $ (ALPHA+1.)*GAMMA) 24 | ENDIF 25 | ELSE 26 | WRITE(TMTLIB_MESSAGE_UNIT,*)'AV_DENCLR: Z1 AND Z2 MUST ', 27 | $ 'NOT BE EQUAL.' 28 | STOP 29 | ENDIF 30 | ELSE 31 | AV_DENCLR=DENCLR(Z1,TV1,Z2,TV2,Z3,DEN3,Z1_LAYER) 32 | ENDIF 33 | RETURN 34 | END 35 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/av_denclr2.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION AV_DENCLR2(Z1,TV1,Z2,TV2,Z3,P3,Z1_LAYER,Z2_LAYER) 2 | 3 | C Thomas Matejka NOAA/NSSL 20 July 1994 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL DENCLR2,TVCLR 9 | REAL Z1,TV1,Z2,TV2,Z3,P3,GAMMA,Z1_LAYER,Z2_LAYER,ALPHA,BETA,TV3, 10 | $DEN3 11 | 12 | IF(Z1_LAYER.NE.Z2_LAYER)THEN 13 | IF(Z2.NE.Z1)THEN 14 | TV3=TVCLR(Z1,TV1,Z2,TV2,Z3) 15 | DEN3=P3*MW_DRY/UNIV_GAS/TV3 16 | IF(TV2.EQ.TV1)THEN 17 | BETA=-E_GRAV*MW_DRY/(UNIV_GAS*TV1) 18 | AV_DENCLR2=DEN3*(EXP(BETA*(Z2_LAYER-Z3))- 19 | $ EXP(BETA*(Z1_LAYER-Z3)))/((Z2_LAYER-Z1_LAYER)*BETA) 20 | ELSE 21 | GAMMA=(TV2-TV1)/(Z2-Z1) 22 | ALPHA=-1.-E_GRAV*MW_DRY/(UNIV_GAS*GAMMA) 23 | AV_DENCLR2=DEN3*(DBLE(TV1+GAMMA*(Z2_LAYER-Z1))** 24 | $ (ALPHA+1.)-DBLE(TV1+GAMMA*(Z1_LAYER-Z1))**(ALPHA+1.))/ 25 | $ ((Z2_LAYER-Z1_LAYER)*DBLE(TV1+GAMMA*(Z3-Z1))**ALPHA* 26 | $ (ALPHA+1.)*GAMMA) 27 | ENDIF 28 | ELSE 29 | WRITE(TMTLIB_MESSAGE_UNIT,*)'AV_DENCLR2: Z1 AND Z2 MUST ', 30 | $ 'NOT BE EQUAL.' 31 | STOP 32 | ENDIF 33 | ELSE 34 | AV_DENCLR2=DENCLR2(Z1,TV1,Z2,TV2,Z3,P3,Z1_LAYER) 35 | ENDIF 36 | RETURN 37 | END 38 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/den.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION DEN(T,TD,P) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL VAPP 9 | REAL T,TD,P,E 10 | 11 | E=VAPP(TD) 12 | IF(E.GE.P)THEN 13 | WRITE(TMTLIB_MESSAGE_UNIT,*)'DEN: E IS GREATER THAN OR ', 14 | $ 'EQUAL TO P.' 15 | STOP 16 | ENDIF 17 | DEN=((P-E)*MW_DRY+E*MW_H2O)/UNIV_GAS/T 18 | RETURN 19 | END 20 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/denclr.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION DENCLR(Z1,TV1,Z2,TV2,Z3,DEN3,Z) 2 | 3 | C Thomas Matejka NOAA/NSSL 9 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL Z1,TV1,Z2,TV2,Z3,DEN3,Z,GAMMA,ALPHA,BETA 9 | 10 | IF(Z2.NE.Z1)THEN 11 | IF(TV2.EQ.TV1)THEN 12 | BETA=-E_GRAV*MW_DRY/(UNIV_GAS*TV1) 13 | DENCLR=DEN3*EXP(BETA*(Z-Z3)) 14 | ELSE 15 | GAMMA=(TV2-TV1)/(Z2-Z1) 16 | ALPHA=-1.-E_GRAV*MW_DRY/(UNIV_GAS*GAMMA) 17 | DENCLR=DEN3*((TV1+GAMMA*(Z-Z1))/(TV1+GAMMA*(Z3-Z1)))**ALPHA 18 | ENDIF 19 | ELSE 20 | WRITE(TMTLIB_MESSAGE_UNIT,*)'DENCLR: Z1 AND Z2 MUST NOT BE ', 21 | $ 'EQUAL.' 22 | STOP 23 | ENDIF 24 | RETURN 25 | END 26 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/denclr2.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION DENCLR2(Z1,TV1,Z2,TV2,Z3,P3,Z) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 May 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL TVCLR 9 | REAL Z1,TV1,Z2,TV2,Z3,P3,TV3,DEN3,Z,GAMMA,ALPHA,BETA 10 | 11 | IF(Z2.NE.Z1)THEN 12 | TV3=TVCLR(Z1,TV1,Z2,TV2,Z3) 13 | DEN3=P3*MW_DRY/UNIV_GAS/TV3 14 | IF(TV2.EQ.TV1)THEN 15 | BETA=-E_GRAV*MW_DRY/(UNIV_GAS*TV1) 16 | DENCLR2=DEN3*EXP(BETA*(Z-Z3)) 17 | ELSE 18 | GAMMA=(TV2-TV1)/(Z2-Z1) 19 | ALPHA=-1.-E_GRAV*MW_DRY/(UNIV_GAS*GAMMA) 20 | DENCLR2=DEN3*((TV1+GAMMA*(Z-Z1))/(TV1+GAMMA*(Z3-Z1)))**ALPHA 21 | ENDIF 22 | ELSE 23 | WRITE(TMTLIB_MESSAGE_UNIT,*)'DENCLR2: Z1 AND Z2 MUST NOT BE ', 24 | $ 'EQUAL.' 25 | STOP 26 | ENDIF 27 | RETURN 28 | END 29 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/dend.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION DEND(T,TD,P) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL VAPP 9 | REAL T,TD,P,E 10 | 11 | E=VAPP(TD) 12 | IF(E.GE.P)THEN 13 | WRITE(TMTLIB_MESSAGE_UNIT,*)'DEND: E IS GREATER THAN OR ', 14 | $ 'EQUAL TO P.' 15 | STOP 16 | ENDIF 17 | DEND=(P-E)*MW_DRY/UNIV_GAS/T 18 | RETURN 19 | END 20 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/dpdzhs.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION DPDZHS(T,TD,P) 2 | 3 | C Thomas Matejka NOAA/NSSL 8 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | REAL DEN 8 | REAL T,TD,P 9 | 10 | DPDZHS=-DEN(T,TD,P)*E_GRAV 11 | RETURN 12 | END 13 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/dpfp.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION DPFP(P,TF) 2 | 3 | C Thomas Matejka NOAA/NSSL 9 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'tmtlib.inc' 7 | REAL AMIXSI,DPMIX 8 | REAL P,TF,W 9 | 10 | W=AMIXSI(TF,P) 11 | IF(W.NE.TMTLIB_BADFLAG)THEN 12 | DPFP=DPMIX(P,W) 13 | ELSE 14 | DPFP=TMTLIB_BADFLAG 15 | ENDIF 16 | RETURN 17 | END 18 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/dpiceb.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION DPICEB(T,P,TI) 2 | 3 | C Thomas Matejka NOAA/NSSL 8 July 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL ALHSUB,AMIXSI,DPMIX 9 | REAL T,P,TI,ALS,W 10 | 11 | IF(TI.GT.0.)THEN 12 | ALS=ALHSUB(TI) 13 | IF(ALS.NE.TMTLIB_BADFLAG)THEN 14 | W=(AMIXSI(TI,P)*ALS-(T-TI)*CP_DRY)/((T-TI)*CP_VAP+ALS) 15 | DPICEB=DPMIX(P,W) 16 | ELSE 17 | DPICEB=TMTLIB_BADFLAG 18 | ENDIF 19 | ELSE 20 | DPICEB=0. 21 | ENDIF 22 | RETURN 23 | END 24 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/dpmix.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION DPMIX(P,W) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'tmtlib.inc' 7 | REAL AMIXS 8 | LOGICAL AGAIN 9 | INTEGER NITER 10 | REAL P,W,TD1,TD2,WS 11 | 12 | IF(W.GT.0.)THEN 13 | TD1=0. 14 | TD2=TD_MAX 15 | AGAIN=.TRUE. 16 | NITER=0 17 | DOWHILE(AGAIN) 18 | NITER=NITER+1 19 | IF(NITER.GT.MAX_ITERS)THEN 20 | WRITE(TMTLIB_MESSAGE_UNIT,*)'DPMIX: EXCEEDED MAXIMUM ', 21 | $ 'ITERATIONS.' 22 | STOP 23 | ENDIF 24 | DPMIX=(TD1+TD2)/2. 25 | WS=AMIXS(DPMIX,P) 26 | IF(WS.LT.W-WTOL)THEN 27 | TD1=DPMIX 28 | ELSEIF(WS.GT.W+WTOL)THEN 29 | TD2=DPMIX 30 | ELSE 31 | AGAIN=.FALSE. 32 | ENDIF 33 | ENDDO 34 | ELSE 35 | DPMIX=0. 36 | ENDIF 37 | RETURN 38 | END 39 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/dprh.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION DPRH(T,P,U) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL VAPPS,DPMIX 9 | REAL T,P,U,E,W 10 | 11 | E=U*VAPPS(T) 12 | IF(E.GE.P)THEN 13 | WRITE(TMTLIB_MESSAGE_UNIT,*)'DPRH: E IS GREATER THAN OR ', 14 | $ 'EQUAL TO P.' 15 | STOP 16 | ENDIF 17 | W=E*MW_H2O/(P-E)/MW_DRY 18 | DPRH=DPMIX(P,W) 19 | RETURN 20 | END 21 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/dprhi.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION DPRHI(T,P,UI) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL VAPPSI,DPMIX 9 | REAL T,P,UI,ESI,E,W 10 | 11 | ESI=VAPPSI(T) 12 | IF(ESI.NE.TMTLIB_BADFLAG)THEN 13 | E=UI*ESI 14 | IF(E.GE.P)THEN 15 | WRITE(TMTLIB_MESSAGE_UNIT,*)'DPRHI: E IS GREATER THAN OR ', 16 | $ 'EQUAL TO P.' 17 | STOP 18 | ENDIF 19 | W=E*MW_H2O/(P-E)/MW_DRY 20 | DPRHI=DPMIX(P,W) 21 | ELSE 22 | DPRHI=TMTLIB_BADFLAG 23 | ENDIF 24 | RETURN 25 | END 26 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/dpshum.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION DPSHUM(P,Q) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'tmtlib.inc' 7 | REAL DPMIX 8 | REAL P,Q,W 9 | 10 | IF(Q.GE.1.)THEN 11 | WRITE(TMTLIB_MESSAGE_UNIT,*)'DPSHUM: Q IS GREATER THAN OR ', 12 | $ 'EQUAL TO 1..' 13 | STOP 14 | ENDIF 15 | W=Q/(1.-Q) 16 | DPSHUM=DPMIX(P,W) 17 | RETURN 18 | END 19 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/dpwetb.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION DPWETB(T,P,TW) 2 | 3 | C Thomas Matejka NOAA/NSSL 7 July 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | REAL ALHVAP,AMIXS,DPMIX 8 | REAL T,P,TW,ALV,W 9 | 10 | IF(TW.GT.0.)THEN 11 | ALV=ALHVAP(TW) 12 | W=(AMIXS(TW,P)*ALV-(T-TW)*CP_DRY)/((T-TW)*CP_VAP+ALV) 13 | DPWETB=DPMIX(P,W) 14 | ELSE 15 | DPWETB=0. 16 | ENDIF 17 | RETURN 18 | END 19 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/dtdpda.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION DTDPDA(T,TD,P) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL VAPP 9 | REAL T,TD,P,E 10 | 11 | E=VAPP(TD) 12 | IF(E.GE.P)THEN 13 | WRITE(TMTLIB_MESSAGE_UNIT,*)'DTDPDA: E IS GREATER THAN OR ', 14 | $ 'EQUAL TO P.' 15 | STOP 16 | ENDIF 17 | DTDPDA=UNIV_GAS*T/(CP_DRY*(P-E)*MW_DRY+CP_VAP*E*MW_H2O) 18 | RETURN 19 | END 20 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/frost.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION FROST(TD,P) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL AMIX,AMIXSI 9 | LOGICAL AGAIN 10 | INTEGER NITER 11 | REAL TD,P,W,TFP1,TFP2,WSI 12 | 13 | W=AMIX(TD,P) 14 | IF(AMIXSI(T_FREEZE,P).GE.W)THEN 15 | IF(TD.GT.0.)THEN 16 | TFP1=0. 17 | TFP2=T_FREEZE 18 | AGAIN=.TRUE. 19 | NITER=0 20 | DOWHILE(AGAIN) 21 | NITER=NITER+1 22 | IF(NITER.GT.MAX_ITERS)THEN 23 | WRITE(TMTLIB_MESSAGE_UNIT,*)'FROST: EXCEEDED ', 24 | $ 'MAXIMUM ITERATIONS.' 25 | STOP 26 | ENDIF 27 | FROST=(TFP1+TFP2)/2. 28 | WSI=AMIXSI(FROST,P) 29 | IF(WSI.LT.W-WTOL)THEN 30 | TFP1=FROST 31 | ELSEIF(WSI.GT.W+WTOL)THEN 32 | TFP2=FROST 33 | ELSE 34 | AGAIN=.FALSE. 35 | ENDIF 36 | ENDDO 37 | ELSE 38 | FROST=0. 39 | ENDIF 40 | ELSE 41 | FROST=TMTLIB_BADFLAG 42 | ENDIF 43 | RETURN 44 | END 45 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/get_tmtlib_badflag.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION GET_TMTLIB_BADFLAG() 2 | 3 | C Thomas Matejka NOAA/NSSL 17 June 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'tmtlib.inc' 7 | 8 | GET_TMTLIB_BADFLAG=TMTLIB_BADFLAG 9 | RETURN 10 | END 11 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/lcl.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE LCL(T0,TD0,P0,TLCL,PLCL) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL VAPP,AMIX,AMIXS 9 | LOGICAL AGAIN 10 | INTEGER NITER 11 | REAL T0,TD0,P0,TLCL,PLCL,E0,ROVCP,W0,PUPPER,PLOWER,WSLCL 12 | 13 | E0=VAPP(TD0) 14 | IF(E0.GE.P0)THEN 15 | WRITE(TMTLIB_MESSAGE_UNIT,*)'LCL: E0 IS GREATER THAN OR ', 16 | $ 'EQUAL TO P0.' 17 | STOP 18 | ENDIF 19 | ROVCP=UNIV_GAS*P0/(CP_DRY*(P0-E0)*MW_DRY+CP_VAP*E0*MW_H2O) 20 | W0=AMIX(TD0,P0) 21 | IF(W0.LT.AMIXS(T0,P0)-WTOL)THEN 22 | PUPPER=0. 23 | PLOWER=P0 24 | AGAIN=.TRUE. 25 | NITER=0 26 | DOWHILE(AGAIN) 27 | NITER=NITER+1 28 | IF(NITER.GT.MAX_ITERS)THEN 29 | WRITE(TMTLIB_MESSAGE_UNIT,*)'LCL: EXCEEDED MAXIMUM ', 30 | $ 'ITERATIONS.' 31 | STOP 32 | ENDIF 33 | PLCL=(PUPPER+PLOWER)/2. 34 | TLCL=T0*(PLCL/P0)**ROVCP 35 | WSLCL=AMIXS(TLCL,PLCL) 36 | IF(WSLCL.GT.W0+WTOL)THEN 37 | PLOWER=PLCL 38 | ELSEIF(WSLCL.LT.W0-WTOL)THEN 39 | PUPPER=PLCL 40 | ELSE 41 | AGAIN=.FALSE. 42 | ENDIF 43 | ENDDO 44 | ELSE 45 | TLCL=T0 46 | PLCL=P0 47 | ENDIF 48 | RETURN 49 | END 50 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/p_sa.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION P_SA(Z) 2 | 3 | C Thomas Matejka NOAA/NSSL 18 November 1997 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL,EXTERNAL::PCLR 9 | REAL::Z,P_TROP_SA 10 | REAL,PARAMETER::DEL_Z=1000. 11 | 12 | IF(Z.LE.Z_TROP_SA)THEN 13 | P_SA=PCLR(Z0_SA,T0_SA,Z0_SA+DEL_Z,T0_SA+GAMMA_TROP_SA*DEL_Z, 14 | $ Z0_SA,P0_SA,Z) 15 | ELSE 16 | P_TROP_SA=PCLR(Z0_SA,T0_SA,Z0_SA+DEL_Z, 17 | $ T0_SA+GAMMA_TROP_SA*DEL_Z,Z0_SA,P0_SA,Z_TROP_SA) 18 | P_SA=PCLR(Z_TROP_SA,T_TROP_SA,Z_TROP_SA+DEL_Z, 19 | $ T_TROP_SA+GAMMA_STRAT_SA*DEL_Z,Z_TROP_SA,P_TROP_SA,Z) 20 | ENDIF 21 | END FUNCTION P_SA 22 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/pclr.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION PCLR(Z1,TV1,Z2,TV2,Z3,P3,Z) 2 | 3 | C Thomas Matejka NOAA/NSSL 9 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL Z1,TV1,Z2,TV2,Z3,P3,Z,GAMMA 9 | 10 | IF(Z2.NE.Z1)THEN 11 | IF(TV2.EQ.TV1)THEN 12 | PCLR=P3*EXP(-E_GRAV*(Z-Z3)*MW_DRY/UNIV_GAS/TV1) 13 | ELSE 14 | GAMMA=(TV2-TV1)/(Z2-Z1) 15 | PCLR=P3*((TV1+GAMMA*(Z-Z1))/(TV1+GAMMA*(Z3-Z1)))** 16 | $ (-(E_GRAV*MW_DRY/UNIV_GAS/GAMMA)) 17 | ENDIF 18 | ELSE 19 | WRITE(TMTLIB_MESSAGE_UNIT,*)'PCLR: Z1 AND Z2 MUST NOT BE ', 20 | $ 'EQUAL.' 21 | STOP 22 | ENDIF 23 | RETURN 24 | END 25 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/pclr2.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION PCLR2(Z1,TV1,Z2,TV2,Z3,DEN3,Z) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 May 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL TVCLR 9 | REAL Z1,TV1,Z2,TV2,Z3,DEN3,TV3,P3,Z,GAMMA 10 | 11 | IF(Z2.NE.Z1)THEN 12 | TV3=TVCLR(Z1,TV1,Z2,TV2,Z3) 13 | P3=DEN3*UNIV_GAS*TV3/MW_DRY 14 | IF(TV2.EQ.TV1)THEN 15 | PCLR2=P3*EXP(-E_GRAV*(Z-Z3)*MW_DRY/UNIV_GAS/TV1) 16 | ELSE 17 | GAMMA=(TV2-TV1)/(Z2-Z1) 18 | PCLR2=P3*((TV1+GAMMA*(Z-Z1))/(TV1+GAMMA*(Z3-Z1)))** 19 | $ (-(E_GRAV*MW_DRY/UNIV_GAS/GAMMA)) 20 | ENDIF 21 | ELSE 22 | WRITE(TMTLIB_MESSAGE_UNIT,*)'PCLR2: Z1 AND Z2 MUST NOT BE ', 23 | $ 'EQUAL.' 24 | STOP 25 | ENDIF 26 | RETURN 27 | END 28 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/pott.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION POTT(T,TD,P) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL VAPP 9 | REAL T,TD,P,E 10 | 11 | E=VAPP(TD) 12 | IF(E.GE.P)THEN 13 | WRITE(TMTLIB_MESSAGE_UNIT,*)'POTT: E IS GREATER THAN OR ', 14 | $ 'EQUAL TO P.' 15 | STOP 16 | ENDIF 17 | POTT=T*(P_REF/P)**(UNIV_GAS*P/(CP_DRY*(P-E)*MW_DRY+ 18 | $CP_VAP*E*MW_H2O)) 19 | RETURN 20 | END 21 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/pottd.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION POTTD(T,TD,P) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL VAPP 9 | REAL T,TD,P,E 10 | 11 | E=VAPP(TD) 12 | IF(E.GE.P)THEN 13 | WRITE(TMTLIB_MESSAGE_UNIT,*)'POTTD: E IS GREATER THAN OR ', 14 | $ 'EQUAL TO P.' 15 | STOP 16 | ENDIF 17 | POTTD=T*(P_REF/(P-E))**(UNIV_GAS/MW_DRY/CP_DRY) 18 | RETURN 19 | END 20 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/pottv.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION POTTV(T,TD,P) 2 | 3 | C Thomas Matejka NOAA/NSSL 8 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | REAL SHUM,POTT 8 | REAL T,TD,P,Q 9 | 10 | Q=SHUM(TD,P) 11 | POTTV=POTT(T,TD,P)*(1.+Q*(MW_DRY/MW_H2O-1.)) 12 | RETURN 13 | END 14 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/preduc.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION PREDUC(T,TD,P,ZSTN,ZREF) 2 | 3 | C Thomas Matejka NOAA/NSSL 8 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | REAL SPGASC,DTDPDA 8 | REAL T,TD,P,ZSTN,ZREF,R,DTDPD,DTDPP,DQSDTP,DQSDPP,GAMMA 9 | 10 | R=SPGASC(TD,P) 11 | DTDPD=DTDPDA(T,TD,P) 12 | CALL PSEUDO(T,P,DTDPP,DQSDTP,DQSDPP) 13 | GAMMA=-(DTDPD+DTDPP)*E_GRAV*P/2./R/T 14 | PREDUC=P*((T-GAMMA*(ZREF-ZSTN))/T)**(E_GRAV/R/GAMMA) 15 | RETURN 16 | END 17 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/pseudi.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE PSEUDI(T,P,DTDPI,DQSIDTI,DQSIDPI) 2 | 3 | C Thomas Matejka NOAA/NSSL 18 June 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL VAPPSI,ALHSUB 9 | REAL T,P,DTDPI,DQSIDTI,DQSIDPI,ESI,ALS,A,B,C,D 10 | 11 | IF(T.LE.T_FREEZE)THEN 12 | ESI=VAPPSI(T) 13 | IF(ESI.GE.P)THEN 14 | WRITE(TMTLIB_MESSAGE_UNIT,*)'PSEUDI: ESI IS GREATER THAN ', 15 | $ 'OR EQUAL TO P.' 16 | STOP 17 | ENDIF 18 | ALS=ALHSUB(T) 19 | A=UNIV_GAS*T/(CP_DRY*(P-ESI)*MW_DRY+CP_VAP*ESI*MW_H2O) 20 | B=-(ALS+UNIV_GAS*T*(1./MW_H2O-1./MW_DRY))* 21 | $ ((P-ESI)*MW_DRY+ESI*MW_H2O)/ 22 | $ (CP_DRY*(P-ESI)*MW_DRY+CP_VAP*ESI*MW_H2O) 23 | C=-MW_H2O*MW_DRY*ESI/((P-ESI)*MW_DRY+ESI*MW_H2O)**2 24 | D=P*MW_DRY*MW_H2O*ALS/((P-ESI)*MW_DRY+ESI*MW_H2O)**2/T/ 25 | $ (UNIV_GAS*T/MW_H2O/ESI-1./RHO_ICE) 26 | DTDPI=(A+B*C)/(1.-B*D) 27 | DQSIDTI=(C+A*D)/(A+B*C) 28 | DQSIDPI=(C+A*D)/(1.-B*D) 29 | ELSE 30 | DTDPI=TMTLIB_BADFLAG 31 | DQSIDTI=TMTLIB_BADFLAG 32 | DQSIDPI=TMTLIB_BADFLAG 33 | ENDIF 34 | RETURN 35 | END 36 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/pseudo.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE PSEUDO(T,P,DTDPP,DQSDTP,DQSDPP) 2 | 3 | C Thomas Matejka NOAA/NSSL 18 June 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL VAPPS,ALHVAP 9 | REAL T,P,DTDPP,DQSDTP,DQSDPP,ES,ALV,A,B,C,D 10 | 11 | ES=VAPPS(T) 12 | IF(ES.GE.P)THEN 13 | WRITE(TMTLIB_MESSAGE_UNIT,*)'PSEUDO: ES IS GREATER THAN OR ', 14 | $ 'EQUAL TO P.' 15 | STOP 16 | ENDIF 17 | ALV=ALHVAP(T) 18 | A=UNIV_GAS*T/(CP_DRY*(P-ES)*MW_DRY+CP_VAP*ES*MW_H2O) 19 | B=-(ALV+UNIV_GAS*T*(1./MW_H2O-1./MW_DRY))* 20 | $((P-ES)*MW_DRY+ES*MW_H2O)/ 21 | $(CP_DRY*(P-ES)*MW_DRY+CP_VAP*ES*MW_H2O) 22 | C=-MW_H2O*MW_DRY*ES/((P-ES)*MW_DRY+ES*MW_H2O)**2 23 | D=P*MW_DRY*MW_H2O*ALV/((P-ES)*MW_DRY+ES*MW_H2O)**2/T/ 24 | $(UNIV_GAS*T/MW_H2O/ES-1./RHO_WAT) 25 | DTDPP=(A+B*C)/(1.-B*D) 26 | DQSDTP=(C+A*D)/(A+B*C) 27 | DQSDPP=(C+A*D)/(1.-B*D) 28 | RETURN 29 | END 30 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/punred.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION PUNRED(T,TD,P,ZSTN,ZREF) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'tmtlib.inc' 7 | REAL PREDUC 8 | LOGICAL AGAIN 9 | INTEGER NITER 10 | REAL T,TD,P,ZSTN,ZREF,PMAX,PMIN,PTRIAL 11 | 12 | IF(ZSTN.EQ.ZREF)THEN 13 | PUNRED=P 14 | ELSE 15 | IF(ZSTN.GT.ZREF)THEN 16 | PMAX=P 17 | PMIN=0. 18 | ELSE 19 | PMAX=P_MAX 20 | PMIN=P 21 | ENDIF 22 | AGAIN=.TRUE. 23 | NITER=0 24 | DOWHILE(AGAIN) 25 | NITER=NITER+1 26 | IF(NITER.GT.MAX_ITERS)THEN 27 | WRITE(TMTLIB_MESSAGE_UNIT,*)'PUNRED: EXCEEDED MAXIMUM ', 28 | $ 'ITERATIONS.' 29 | STOP 30 | ENDIF 31 | PUNRED=(PMAX+PMIN)/2. 32 | PTRIAL=PREDUC(T,TD,PUNRED,ZSTN,ZREF) 33 | IF(PTRIAL.GT.P+PTOL)THEN 34 | PMAX=PUNRED 35 | ELSEIF(PTRIAL.LT.P-PTOL)THEN 36 | PMIN=PUNRED 37 | ELSE 38 | AGAIN=.FALSE. 39 | ENDIF 40 | ENDDO 41 | ENDIF 42 | RETURN 43 | END 44 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/rhum.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION RHUM(T,TD) 2 | 3 | C Thomas Matejka NOAA/NSSL 8 March 1993 4 | 5 | IMPLICIT NONE 6 | REAL VAPP,VAPPS 7 | REAL T,TD 8 | 9 | RHUM=VAPP(TD)/VAPPS(T) 10 | RETURN 11 | END 12 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/rhumi.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION RHUMI(T,TD) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL VAPP,VAPPSI 9 | REAL T,TD 10 | 11 | IF(T.LE.T_FREEZE)THEN 12 | RHUMI=VAPP(TD)/VAPPSI(T) 13 | ELSE 14 | RHUMI=TMTLIB_BADFLAG 15 | ENDIF 16 | RETURN 17 | END 18 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/shum.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION SHUM(TD,P) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL VAPP 9 | REAL TD,P,E 10 | 11 | E=VAPP(TD) 12 | IF(E.GE.P)THEN 13 | WRITE(TMTLIB_MESSAGE_UNIT,*)'SHUM: E IS GREATER THAN OR ', 14 | $ 'EQUAL TO P.' 15 | STOP 16 | ENDIF 17 | SHUM=E*MW_H2O/((P-E)*MW_DRY+E*MW_H2O) 18 | RETURN 19 | END 20 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/shums.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION SHUMS(T,P) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL VAPPS 9 | REAL T,P,ES 10 | 11 | ES=VAPPS(T) 12 | IF(ES.GE.P)THEN 13 | WRITE(TMTLIB_MESSAGE_UNIT,*)'SHUMS: ES IS GREATER THAN OR ', 14 | $ 'EQUAL TO P.' 15 | STOP 16 | ENDIF 17 | SHUMS=ES*MW_H2O/((P-ES)*MW_DRY+ES*MW_H2O) 18 | RETURN 19 | END 20 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/shumsi.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION SHUMSI(T,P) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL VAPPSI 9 | REAL T,P,ESI 10 | 11 | IF(T.LE.T_FREEZE)THEN 12 | ESI=VAPPSI(T) 13 | IF(ESI.GE.P)THEN 14 | WRITE(TMTLIB_MESSAGE_UNIT,*)'SHUMSI: ESI IS GREATER THAN ', 15 | $ 'OR EQUAL TO P.' 16 | STOP 17 | ENDIF 18 | SHUMSI=ESI*MW_H2O/((P-ESI)*MW_DRY+ESI*MW_H2O) 19 | ELSE 20 | SHUMSI=TMTLIB_BADFLAG 21 | ENDIF 22 | RETURN 23 | END 24 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/spgasc.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION SPGASC(TD,P) 2 | 3 | C Thomas Matejka NOAA/NSSL 8 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | REAL SHUM 8 | REAL TD,P,Q 9 | 10 | Q=SHUM(TD,P) 11 | SPGASC=UNIV_GAS*((1.-Q)/MW_DRY+Q/MW_H2O) 12 | RETURN 13 | END 14 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/sphtcp.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION SPHTCP(TD,P) 2 | 3 | C Thomas Matejka NOAA/NSSL 8 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | REAL SHUM 8 | REAL TD,P,Q 9 | 10 | Q=SHUM(TD,P) 11 | SPHTCP=(1.-Q)*CP_DRY+Q*CP_VAP 12 | RETURN 13 | END 14 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/sphtcv.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION SPHTCV(TD,P) 2 | 3 | C Thomas Matejka NOAA/NSSL 8 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | REAL SHUM 8 | REAL TD,P,Q 9 | 10 | Q=SHUM(TD,P) 11 | SPHTCV=(1.-Q)*(CP_DRY-UNIV_GAS/MW_DRY)+Q*(CP_VAP-UNIV_GAS/MW_H2O) 12 | RETURN 13 | END 14 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/state1.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE STATE1(T,TD,P,DEN) 2 | 3 | C Thomas Matejka NOAA/NSSL 9 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL DPSHUM,VAPPS,SPGASC 9 | REAL T,TD,P,DEN,R,Q 10 | 11 | IF(T.EQ.TMTLIB_BADFLAG.AND. 12 | $TD.NE.TMTLIB_BADFLAG.AND. 13 | $P.NE.TMTLIB_BADFLAG.AND. 14 | $DEN.NE.TMTLIB_BADFLAG)THEN 15 | R=SPGASC(TD,P) 16 | T=P/(DEN*R) 17 | ELSEIF(TD.EQ.TMTLIB_BADFLAG.AND. 18 | $T.NE.TMTLIB_BADFLAG.AND. 19 | $P.NE.TMTLIB_BADFLAG.AND. 20 | $DEN.NE.TMTLIB_BADFLAG)THEN 21 | Q=(P*MW_DRY/(DEN*UNIV_GAS*T)-1.)*MW_H2O/(MW_DRY-MW_H2O) 22 | TD=DPSHUM(P,Q) 23 | ELSEIF(P.EQ.TMTLIB_BADFLAG.AND. 24 | $T.NE.TMTLIB_BADFLAG.AND. 25 | $TD.NE.TMTLIB_BADFLAG.AND. 26 | $DEN.NE.TMTLIB_BADFLAG)THEN 27 | P=(DEN*UNIV_GAS*T-VAPPS(TD)*(MW_DRY-MW_H2O))/MW_DRY 28 | ELSEIF(DEN.EQ.TMTLIB_BADFLAG.AND. 29 | $T.NE.TMTLIB_BADFLAG.AND. 30 | $TD.NE.TMTLIB_BADFLAG.AND. 31 | $P.NE.TMTLIB_BADFLAG)THEN 32 | R=SPGASC(TD,P) 33 | DEN=P/(R*T) 34 | ENDIF 35 | RETURN 36 | END 37 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/state2.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE STATE2(TV,P,DEN) 2 | 3 | C Thomas Matejka NOAA/NSSL 5 May 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL TV,P,DEN 9 | 10 | IF(TV.EQ.TMTLIB_BADFLAG.AND. 11 | $P.NE.TMTLIB_BADFLAG.AND. 12 | $DEN.NE.TMTLIB_BADFLAG)THEN 13 | TV=P*MW_DRY/(DEN*UNIV_GAS) 14 | ELSEIF(P.EQ.TMTLIB_BADFLAG.AND. 15 | $TV.NE.TMTLIB_BADFLAG.AND. 16 | $DEN.NE.TMTLIB_BADFLAG)THEN 17 | P=DEN*UNIV_GAS*TV/MW_DRY 18 | ELSEIF(DEN.EQ.TMTLIB_BADFLAG.AND. 19 | $TV.NE.TMTLIB_BADFLAG.AND. 20 | $P.NE.TMTLIB_BADFLAG)THEN 21 | DEN=P*MW_DRY/(UNIV_GAS*TV) 22 | ENDIF 23 | RETURN 24 | END 25 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/tvclr.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION TVCLR(Z1,TV1,Z2,TV2,Z) 2 | 3 | C Thomas Matejka NOAA/NSSL 9 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'tmtlib.inc' 7 | REAL Z1,TV1,Z2,TV2,Z,GAMMA 8 | 9 | IF(Z2.NE.Z1)THEN 10 | IF(TV2.EQ.TV1)THEN 11 | TVCLR=TV1 12 | ELSE 13 | GAMMA=(TV2-TV1)/(Z2-Z1) 14 | TVCLR=TV1+GAMMA*(Z-Z1) 15 | ENDIF 16 | ELSE 17 | WRITE(TMTLIB_MESSAGE_UNIT,*)'TVCLR: Z1 AND Z2 MUST NOT BE ', 18 | $ 'EQUAL.' 19 | STOP 20 | ENDIF 21 | RETURN 22 | END 23 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/vapp.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION VAPP(TD) 2 | 3 | C Thomas Matejka NOAA/NSSL 8 March 1993 4 | 5 | IMPLICIT NONE 6 | REAL VAPPS 7 | REAL TD 8 | 9 | VAPP=VAPPS(TD) 10 | RETURN 11 | END 12 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/vapps.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION VAPPS(T) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | REAL T,A,B 8 | 9 | IF(T.NE.0.)THEN 10 | A=(C_WAT-CP_VAP)*MW_H2O/UNIV_GAS 11 | B=LH_VAP_3PT*MW_H2O/UNIV_GAS/T_3PT 12 | VAPPS=P_3PT*(T_3PT/T)**A*EXP((A+B)*(1.-T_3PT/T)) 13 | ELSE 14 | VAPPS=0. 15 | ENDIF 16 | RETURN 17 | END 18 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/vappsi.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION VAPPSI(T) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL T,A,B 9 | 10 | IF(T.LE.T_FREEZE)THEN 11 | IF(T.NE.0.)THEN 12 | A=(C_ICE-CP_VAP)*MW_H2O/UNIV_GAS 13 | B=LH_SUB_3PT*MW_H2O/UNIV_GAS/T_3PT 14 | VAPPSI=P_3PT*(T_3PT/T)**A*EXP((A+B)*(1.-T_3PT/T)) 15 | ELSE 16 | VAPPSI=0. 17 | ENDIF 18 | ELSE 19 | VAPPSI=TMTLIB_BADFLAG 20 | ENDIF 21 | RETURN 22 | END 23 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/virt.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION VIRT(T,TD,P) 2 | 3 | C Thomas Matejka NOAA/NSSL 8 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | REAL SHUM 8 | REAL T,TD,P,Q 9 | 10 | Q=SHUM(TD,P) 11 | VIRT=T*(1.+Q*(MW_DRY/MW_H2O-1.)) 12 | RETURN 13 | END 14 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/wbpott.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION WBPOTT(T,TD,P) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | LOGICAL AGAIN 9 | INTEGER NINC 10 | REAL T,TD,P,TLCL,PLCL,P2,T2,DELP,P1,T1,PAVE,DTDPP,DQSDTP, 11 | $DQSDPP,TAVE 12 | 13 | CALL LCL(T,TD,P,TLCL,PLCL) 14 | P2=PLCL 15 | T2=TLCL 16 | DELP=SIGN(DELTA_P,P_REF-PLCL) 17 | AGAIN=.TRUE. 18 | NINC=0 19 | DOWHILE(AGAIN) 20 | NINC=NINC+1 21 | IF(NINC.GT.MAX_INCS)THEN 22 | WRITE(TMTLIB_MESSAGE_UNIT,*)'WBPOTT: EXCEEDED MAXIMUM ', 23 | $ 'INCREMENTS.' 24 | STOP 25 | ENDIF 26 | P1=P2 27 | T1=T2 28 | IF(ABS(P1-P_REF).LE.ABS(DELP))THEN 29 | DELP=P_REF-P1 30 | AGAIN=.FALSE. 31 | ENDIF 32 | P2=P1+DELP 33 | PAVE=(P1+P2)/2. 34 | CALL PSEUDO(T1,PAVE,DTDPP,DQSDTP,DQSDPP) 35 | T2=T1+DTDPP*DELP 36 | TAVE=(T1+T2)/2. 37 | CALL PSEUDO(TAVE,PAVE,DTDPP,DQSDTP,DQSDPP) 38 | T2=T1+DTDPP*DELP 39 | ENDDO 40 | WBPOTT=T2 41 | RETURN 42 | END 43 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/wetblb.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION WETBLB(T,TD,P) 2 | 3 | C Thomas Matejka NOAA/NSSL 10 March 1993 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL AMIX,AMIXS,ALHVAP 9 | LOGICAL AGAIN 10 | INTEGER NITER 11 | REAL T,TD,P,W0,TW1,TW2,W,TGUESS 12 | 13 | W0=AMIX(TD,P) 14 | TW1=0. 15 | TW2=T_MAX 16 | AGAIN=.TRUE. 17 | NITER=0 18 | DOWHILE(AGAIN) 19 | NITER=NITER+1 20 | IF(NITER.GT.MAX_ITERS)THEN 21 | WRITE(TMTLIB_MESSAGE_UNIT,*)'WETBLB: EXCEEDED MAXIMUM ', 22 | $ 'ITERATIONS.' 23 | STOP 24 | ENDIF 25 | WETBLB=(TW1+TW2)/2. 26 | W=AMIXS(WETBLB,P) 27 | TGUESS=WETBLB+(W-W0)*ALHVAP(WETBLB)/(CP_DRY+W0*CP_VAP) 28 | IF(TGUESS.LT.T-TTOL)THEN 29 | TW1=WETBLB 30 | ELSEIF(TGUESS.GT.T+TTOL)THEN 31 | TW2=WETBLB 32 | ELSE 33 | AGAIN=.FALSE. 34 | ENDIF 35 | ENDDO 36 | RETURN 37 | END 38 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/z_sa_to_clr.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION Z_SA_TO_CLR(Z1,TV1,Z2,TV2,Z3,P3,Z_SA) 2 | 3 | C Thomas Matejka NOAA/NSSL 18 November 1997 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL,EXTERNAL::P_SA,ZCLR 9 | REAL::Z1,TV1,Z2,TV2,Z3,P3,Z_SA,P 10 | 11 | P=P_SA(Z_SA) 12 | Z_SA_TO_CLR=ZCLR(Z1,TV1,Z2,TV2,Z3,P3,P) 13 | END FUNCTION Z_SA_TO_CLR 14 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/z_sa_to_clr2.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION Z_SA_TO_CLR2(Z1,TV1,Z2,TV2,Z3,DEN3,Z_SA) 2 | 3 | C Thomas Matejka NOAA/NSSL 18 November 1997 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL,EXTERNAL::P_SA,ZCLR,TVCLR 9 | REAL::Z1,TV1,Z2,TV2,Z3,P3,Z_SA,P,TV3,DEN3 10 | 11 | P=P_SA(Z_SA) 12 | TV3=TVCLR(Z1,TV1,Z2,TV2,Z3) 13 | P3=DEN3*UNIV_GAS*TV3/MW_DRY 14 | Z_SA_TO_CLR2=ZCLR(Z1,TV1,Z2,TV2,Z3,P3,P) 15 | END FUNCTION Z_SA_TO_CLR2 16 | -------------------------------------------------------------------------------- /awot/src/libs/libtmt/zclr.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION ZCLR(Z1,TV1,Z2,TV2,Z3,P3,P) 2 | 3 | C Thomas Matejka NOAA/NSSL 18 November 1997 4 | 5 | IMPLICIT NONE 6 | INCLUDE 'include_constants.inc' 7 | INCLUDE 'tmtlib.inc' 8 | REAL::Z1,TV1,Z2,TV2,Z3,P3,GAMMA,P 9 | 10 | IF(Z2.NE.Z1)THEN 11 | IF(TV2.EQ.TV1)THEN 12 | ZCLR=Z3-((UNIV_GAS*TV1)/(MW_DRY*E_GRAV))*ALOG(P/P3) 13 | ELSE 14 | GAMMA=(TV2-TV1)/(Z2-Z1) 15 | ZCLR=Z1+((TV1+GAMMA*(Z3-Z1))*(P/P3)** 16 | $ (-((UNIV_GAS*GAMMA)/(MW_DRY*E_GRAV))-TV1)/GAMMA) 17 | ENDIF 18 | ELSE 19 | WRITE(TMTLIB_MESSAGE_UNIT,*)'PCLR: Z1 AND Z2 MUST NOT BE ', 20 | $ 'EQUAL.' 21 | STOP 22 | ENDIF 23 | END FUNCTION ZCLR 24 | -------------------------------------------------------------------------------- /awot/src/libs/rebuild_libs: -------------------------------------------------------------------------------- 1 | f2py -c -m libdpj libdpj/*.f --fcompiler=gfortran --opt=-O --f77flags=-ffixed-line-length-132 2 | 3 | f2py -c -m libtmg libtmg/*.f --fcompiler=gfortran --opt=-O --f77flags=-ffixed-line-length-132 4 | 5 | f2py -c -m libtmr libtmr/*.f --fcompiler=gfortran --opt=-O --f77flags=-ffixed-line-length-132 6 | 7 | f2py -c -m libtmt libtmt/*.f --fcompiler=gfortran --opt=-O --f77flags=-ffixed-line-length-132 -------------------------------------------------------------------------------- /awot/src/libs/tester: -------------------------------------------------------------------------------- 1 | lkjadsf 2 | 3 | dslr 4 | 5 | tooth 6 | 7 | angle 8 | 9 | Function 10 | 11 | dog 12 | -------------------------------------------------------------------------------- /awot/src/windsyn/fib3.f: -------------------------------------------------------------------------------- 1 | C FILE: FIB3.F 2 | SUBROUTINE FIB(A,N) 3 | C 4 | C CALCULATE FIRST N FIBONACCI NUMBERS 5 | C 6 | INTEGER N 7 | REAL*8 A(N) 8 | Cf2py intent(in) n 9 | Cf2py intent(out) a 10 | Cf2py depend(n) a 11 | DO I=1,N 12 | IF (I.EQ.1) THEN 13 | A(I) = 0.0D0 14 | ELSEIF (I.EQ.2) THEN 15 | A(I) = 1.0D0 16 | ELSE 17 | A(I) = A(I-1) + A(I-2) 18 | ENDIF 19 | ENDDO 20 | END SUBROUTINE FIB 21 | C END FILE FIB3.F -------------------------------------------------------------------------------- /awot/src/windsyn/fib3.so: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nguy/AWOT/cf1a9f7632382a289063ee6e9c401222e2e10791/awot/src/windsyn/fib3.so -------------------------------------------------------------------------------- /awot/util/__init__.py: -------------------------------------------------------------------------------- 1 | """ 2 | awot - Airborne Weather Observations Toolkit 3 | ================================================ 4 | Probe Subpackage (:mod:'awot.util) 5 | ================================================ 6 | 7 | .. currentmodule:: awot.io 8 | """ 9 | 10 | from __future__ import absolute_import 11 | from .matcher import (TrackMatch, FlightLevelMatch, RadarMatch) 12 | 13 | from .convert import (pyart_radar_to_awot, to_awot_flight, build_vardict) 14 | from .helper import (time_subset_awot_dict, add_dict_to_awot, 15 | add_dict_to_awot_fields) 16 | from .track_distance import (calc_ground_distance, calc_air_distance, 17 | great_circle) 18 | from .thermocalcs import ThermoCalcs 19 | from .shearcalcs import ShearCalcs 20 | from .sonde_calcs import (add_thermo_calcs, add_shear_calcs) 21 | from .write_kmz import (write_track_kmz, write_line_kml, write_poly_kml) 22 | 23 | __all__ = [s for s in dir() if not s.startswith('_')] 24 | -------------------------------------------------------------------------------- /setup.py: -------------------------------------------------------------------------------- 1 | """AWOT: Airborne Weather Observations Toolkit. 2 | 3 | AWOT is a toolkit of utilities to analyze and visualize weather 4 | observations taken by aircraft. 5 | 6 | 7 | """ 8 | 9 | # from numpy.distutils.core import setup 10 | from setuptools import setup 11 | import os 12 | import glob 13 | 14 | # - Pull the header into a variable 15 | doclines = __doc__.split("\n") 16 | 17 | # - Versioning 18 | MAJOR = 0 19 | MINOR = 2 20 | MICRO = 13 21 | VERSION = '%d.%d.%d' % (MAJOR, MINOR, MICRO) 22 | 23 | # - Set variables for setup 24 | packages = ['awot', 25 | 'awot.io', 26 | 'awot.display', 27 | 'awot.graph', 28 | 'awot.util'] 29 | package_dirs = {'awot'} 30 | # datafiles = glob.glob(os.path.join(pathout, '*')) 31 | # datafiles = [os.path.join('data', os.path.basename(f)) for f in datafiles] 32 | # package_data = {'awot': datafiles} 33 | 34 | # - Run setup 35 | setup(name='awot', 36 | version=VERSION, 37 | author='Nick Guy', 38 | author_email='nick.guy@uwyo.edu', 39 | packages=packages, 40 | # package_dir=package_dirs, 41 | # package_data=package_data, 42 | url='https://github.com/nguy/AWOT', 43 | license='LICENSE.txt', 44 | description=doclines[0], 45 | long_description="""A toolkit containing utilities to analyze and 46 | visualize observational data collected by aircraft. 47 | """, 48 | ) 49 | --------------------------------------------------------------------------------